6 use FS::UID qw(getotaker);
7 use FS::Record qw(fields qsearch qsearchs);
10 @ISA = qw(FS::Record Exporter);
14 FS::cust_pkg - Object methods for cust_pkg objects
20 $record = create FS::cust_pkg \%hash;
21 $record = create FS::cust_pkg { 'column' => 'value' };
23 $error = $record->insert;
25 $error = $new_record->replace($old_record);
27 $error = $record->delete;
29 $error = $record->check;
31 $error = $record->cancel;
33 $error = $record->suspend;
35 $error = $record->unsuspend;
37 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
38 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
42 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
43 inherits from FS::Record. The following fields are currently supported:
47 =item pkgnum - primary key (assigned automatically for new billing items)
49 =item custnum - Customer (see L<FS::cust_main>)
51 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
63 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
67 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
68 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
77 Create a new billing item. To add the item to the database, see L<"insert">.
82 my($proto,$hashref)=@_;
84 #now in FS::Record::new
86 #foreach $field (fields('cust_pkg')) {
87 # $hashref->{$field}='' unless defined $hashref->{$field};
90 $proto->new('cust_pkg',$hashref);
95 Adds this billing item to the database ("Orders" the item). If there is an
96 error, returns the error, otherwise returns false.
109 Currently unimplemented. You don't want to delete billing items, because there
110 would then be no record the customer ever purchased the item. Instead, see
114 return "Can't delete cust_pkg records!";
117 =item replace OLD_RECORD
119 Replaces the OLD_RECORD with this one in the database. If there is an error,
120 returns the error, otherwise returns false.
122 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
124 pkgpart may not be changed, but see the order subroutine.
126 setup and bill are normally updated by calling the bill method of a customer
127 object (see L<FS::cust_main>).
129 suspend is normally updated by the suspend and unsuspend methods.
131 cancel is normally updated by the cancel method (and also the order subroutine
138 return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
139 return "Can't change pkgnum!"
140 if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
141 return "Can't (yet?) change pkgpart!"
142 if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
143 return "Can't change otaker!"
144 if $old->getfield('otaker') ne $new->getfield('otaker');
145 return "Can't change setup once it exists!"
146 if $old->getfield('setup') &&
147 $old->getfield('setup') != $new->getfield('setup');
148 #some logic for bill, susp, cancel?
156 Checks all fields to make sure this is a valid billing item. If there is an
157 error, returns the error, otherwise returns false. Called by the insert and
164 return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
165 my($recref) = $self->hashref;
167 $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
168 $recref->{pkgnum}=$1;
170 $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
171 $recref->{custnum}=$1;
172 return "Unknown customer"
173 unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
175 $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
176 $recref->{pkgpart}=$1;
177 return "Unknown pkgpart"
178 unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
180 $recref->{otaker} ||= &getotaker;
181 $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
182 $recref->{otaker}=$1;
184 $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
187 $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
190 $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
193 $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
194 $recref->{cancel}=$1;
201 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
202 in this package, then cancels the package itself (sets the cancel field to
205 If there is an error, returns the error, otherwise returns false.
213 local $SIG{HUP} = 'IGNORE';
214 local $SIG{INT} = 'IGNORE';
215 local $SIG{QUIT} = 'IGNORE';
216 local $SIG{TERM} = 'IGNORE';
217 local $SIG{TSTP} = 'IGNORE';
221 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
224 qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
226 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
227 or return "Illegal svcdb value in part_svc!";
229 require "FS/$svcdb.pm";
231 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
233 bless($svc,"FS::$svcdb");
234 $error = $svc->cancel;
235 return "Error cancelling service: $error" if $error;
236 $error = $svc->delete;
237 return "Error deleting service: $error" if $error;
240 bless($cust_svc,"FS::cust_svc");
241 $error = $cust_svc->delete;
242 return "Error deleting cust_svc: $error" if $error;
246 unless ( $self->getfield('cancel') ) {
247 my(%hash) = $self->hash;
249 my($new) = create FS::cust_pkg ( \%hash );
250 $error=$new->replace($self);
251 return $error if $error;
259 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
260 package, then suspends the package itself (sets the susp field to now).
262 If there is an error, returns the error, otherwise returns false.
269 local $SIG{HUP} = 'IGNORE';
270 local $SIG{INT} = 'IGNORE';
271 local $SIG{QUIT} = 'IGNORE';
272 local $SIG{TERM} = 'IGNORE';
273 local $SIG{TSTP} = 'IGNORE';
277 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
280 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
282 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
283 or return "Illegal svcdb value in part_svc!";
285 require "FS/$svcdb.pm";
287 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
290 bless($svc,"FS::$svcdb");
291 $error = $svc->suspend;
292 return $error if $error;
297 unless ( $self->getfield('susp') ) {
298 my(%hash) = $self->hash;
300 my($new) = create FS::cust_pkg ( \%hash );
301 $error=$new->replace($self);
302 return $error if $error;
310 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
311 package, then unsuspends the package itself (clears the susp field).
313 If there is an error, returns the error, otherwise returns false.
321 local $SIG{HUP} = 'IGNORE';
322 local $SIG{INT} = 'IGNORE';
323 local $SIG{QUIT} = 'IGNORE';
324 local $SIG{TERM} = 'IGNORE';
325 local $SIG{TSTP} = 'IGNORE';
329 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
332 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
334 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
335 or return "Illegal svcdb value in part_svc!";
337 require "FS/$svcdb.pm";
339 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
341 bless($svc,"FS::$svcdb");
342 $error = $svc->unsuspend;
343 return $error if $error;
348 unless ( ! $self->getfield('susp') ) {
349 my(%hash) = $self->hash;
351 my($new) = create FS::cust_pkg ( \%hash );
352 $error=$new->replace($self);
353 return $error if $error;
365 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
367 CUSTNUM is a customer (see L<FS::cust_main>)
369 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
370 L<FS::part_pkg>) to order for this customer. Duplicates are of course
373 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
374 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
375 new billing items. An error is returned if this is not possible (see
381 my($custnum,$pkgparts,$remove_pkgnums)=@_;
385 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
386 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
387 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
390 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
391 my($pkgpart)=$type_pkgs->pkgpart;
392 $part_pkg{$pkgpart}++;
398 # for those packages being removed:
399 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
400 # objects (table eq 'cust_svc')
402 foreach $pkgnum ( @{$remove_pkgnums} ) {
404 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
405 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
411 # for those packages the customer is purchasing:
412 # @{$pkgparts} is a list of said packages, by pkgpart
413 # @cust_svc is a corresponding list of lists of FS::Record objects
415 foreach $pkgpart ( @{$pkgparts} ) {
416 return "Customer not permitted to purchase pkgpart $pkgpart!"
417 unless $part_pkg{$pkgpart};
420 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
422 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
427 #check for leftover services
428 foreach (keys %svcnum) {
429 next unless @{ $svcnum{$_} };
430 return "Leftover services!";
433 #no leftover services, let's make changes.
435 local $SIG{HUP} = 'IGNORE';
436 local $SIG{INT} = 'IGNORE';
437 local $SIG{QUIT} = 'IGNORE';
438 local $SIG{TERM} = 'IGNORE';
439 local $SIG{TSTP} = 'IGNORE';
441 #first cancel old packages
443 foreach $pkgnum ( @{$remove_pkgnums} ) {
444 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
445 return "Package $pkgnum not found to remove!" unless $old;
446 my(%hash) = $old->hash;
448 my($new) = create FS::cust_pkg ( \%hash );
449 my($error)=$new->replace($old);
450 return $error if $error;
453 #now add new packages, changing cust_svc records if necessary
455 while ($pkgpart=shift @{$pkgparts} ) {
457 my($new) = create FS::cust_pkg ( {
458 'custnum' => $custnum,
459 'pkgpart' => $pkgpart,
461 my($error) = $new->insert;
462 return $error if $error;
463 my($pkgnum)=$new->getfield('pkgnum');
466 foreach $cust_svc ( @{ shift @cust_svc } ) {
467 my(%hash) = $cust_svc->hash;
468 $hash{'pkgnum'}=$pkgnum;
469 my($new) = create FS::cust_svc ( \%hash );
470 my($error)=$new->replace($cust_svc);
471 return $error if $error;
482 It doesn't properly override FS::Record yet.
484 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
486 In sub order, the @pkgparts array (passed by reference) is clobbered.
488 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
489 method to pass dates to the recur_prog expression, it should do so.
493 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
494 , L<FS::pkg_svc>, schema.html from the base documentation
498 ivan@voicenet.com 97-jul-1 - 21
500 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
502 pod ivan@sisd.com 98-sep-21