6 use FS::UID qw(getotaker);
7 use FS::Record qw(fields qsearch qsearchs);
11 @ISA = qw(FS::Record Exporter);
15 FS::cust_pkg - Object methods for cust_pkg objects
21 $record = create FS::cust_pkg \%hash;
22 $record = create FS::cust_pkg { 'column' => 'value' };
24 $error = $record->insert;
26 $error = $new_record->replace($old_record);
28 $error = $record->delete;
30 $error = $record->check;
32 $error = $record->cancel;
34 $error = $record->suspend;
36 $error = $record->unsuspend;
38 $part_pkg = $record->part_pkg;
40 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
41 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
45 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
46 inherits from FS::Record. The following fields are currently supported:
50 =item pkgnum - primary key (assigned automatically for new billing items)
52 =item custnum - Customer (see L<FS::cust_main>)
54 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
66 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
70 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
71 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
80 Create a new billing item. To add the item to the database, see L<"insert">.
85 my($proto,$hashref)=@_;
87 #now in FS::Record::new
89 #foreach $field (fields('cust_pkg')) {
90 # $hashref->{$field}='' unless defined $hashref->{$field};
93 $proto->new('cust_pkg',$hashref);
98 Adds this billing item to the database ("Orders" the item). If there is an
99 error, returns the error, otherwise returns false.
112 Currently unimplemented. You don't want to delete billing items, because there
113 would then be no record the customer ever purchased the item. Instead, see
117 return "Can't delete cust_pkg records!";
120 =item replace OLD_RECORD
122 Replaces the OLD_RECORD with this one in the database. If there is an error,
123 returns the error, otherwise returns false.
125 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
127 pkgpart may not be changed, but see the order subroutine.
129 setup and bill are normally updated by calling the bill method of a customer
130 object (see L<FS::cust_main>).
132 suspend is normally updated by the suspend and unsuspend methods.
134 cancel is normally updated by the cancel method (and also the order subroutine
141 return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
142 return "Can't change pkgnum!"
143 if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
144 return "Can't (yet?) change pkgpart!"
145 if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
146 return "Can't change otaker!"
147 if $old->getfield('otaker') ne $new->getfield('otaker');
148 return "Can't change setup once it exists!"
149 if $old->getfield('setup') &&
150 $old->getfield('setup') != $new->getfield('setup');
151 #some logic for bill, susp, cancel?
159 Checks all fields to make sure this is a valid billing item. If there is an
160 error, returns the error, otherwise returns false. Called by the insert and
167 return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
168 my($recref) = $self->hashref;
170 $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
171 $recref->{pkgnum}=$1;
173 $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
174 $recref->{custnum}=$1;
175 return "Unknown customer"
176 unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
178 $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
179 $recref->{pkgpart}=$1;
180 return "Unknown pkgpart"
181 unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
183 $recref->{otaker} ||= &getotaker;
184 $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
185 $recref->{otaker}=$1;
187 $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
190 $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
193 $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
196 $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
197 $recref->{cancel}=$1;
204 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
205 in this package, then cancels the package itself (sets the cancel field to
208 If there is an error, returns the error, otherwise returns false.
216 local $SIG{HUP} = 'IGNORE';
217 local $SIG{INT} = 'IGNORE';
218 local $SIG{QUIT} = 'IGNORE';
219 local $SIG{TERM} = 'IGNORE';
220 local $SIG{TSTP} = 'IGNORE';
224 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
227 qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
229 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
230 or return "Illegal svcdb value in part_svc!";
232 require "FS/$svcdb.pm";
234 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
236 bless($svc,"FS::$svcdb");
237 $error = $svc->cancel;
238 return "Error cancelling service: $error" if $error;
239 $error = $svc->delete;
240 return "Error deleting service: $error" if $error;
243 bless($cust_svc,"FS::cust_svc");
244 $error = $cust_svc->delete;
245 return "Error deleting cust_svc: $error" if $error;
249 unless ( $self->getfield('cancel') ) {
250 my(%hash) = $self->hash;
252 my($new) = create FS::cust_pkg ( \%hash );
253 $error=$new->replace($self);
254 return $error if $error;
262 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
263 package, then suspends the package itself (sets the susp field to now).
265 If there is an error, returns the error, otherwise returns false.
272 local $SIG{HUP} = 'IGNORE';
273 local $SIG{INT} = 'IGNORE';
274 local $SIG{QUIT} = 'IGNORE';
275 local $SIG{TERM} = 'IGNORE';
276 local $SIG{TSTP} = 'IGNORE';
280 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
283 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
285 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
286 or return "Illegal svcdb value in part_svc!";
288 require "FS/$svcdb.pm";
290 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
293 bless($svc,"FS::$svcdb");
294 $error = $svc->suspend;
295 return $error if $error;
300 unless ( $self->getfield('susp') ) {
301 my(%hash) = $self->hash;
303 my($new) = create FS::cust_pkg ( \%hash );
304 $error=$new->replace($self);
305 return $error if $error;
313 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
314 package, then unsuspends the package itself (clears the susp field).
316 If there is an error, returns the error, otherwise returns false.
324 local $SIG{HUP} = 'IGNORE';
325 local $SIG{INT} = 'IGNORE';
326 local $SIG{QUIT} = 'IGNORE';
327 local $SIG{TERM} = 'IGNORE';
328 local $SIG{TSTP} = 'IGNORE';
332 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
335 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
337 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
338 or return "Illegal svcdb value in part_svc!";
340 require "FS/$svcdb.pm";
342 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
344 bless($svc,"FS::$svcdb");
345 $error = $svc->unsuspend;
346 return $error if $error;
351 unless ( ! $self->getfield('susp') ) {
352 my(%hash) = $self->hash;
354 my($new) = create FS::cust_pkg ( \%hash );
355 $error=$new->replace($self);
356 return $error if $error;
364 Returns the definition for this billing item, as an FS::part_pkg object (see
371 qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart });
380 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
382 CUSTNUM is a customer (see L<FS::cust_main>)
384 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
385 L<FS::part_pkg>) to order for this customer. Duplicates are of course
388 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
389 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
390 new billing items. An error is returned if this is not possible (see
396 my($custnum,$pkgparts,$remove_pkgnums)=@_;
400 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
401 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
402 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
405 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
406 my($pkgpart)=$type_pkgs->pkgpart;
407 $part_pkg{$pkgpart}++;
413 # for those packages being removed:
414 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
415 # objects (table eq 'cust_svc')
417 foreach $pkgnum ( @{$remove_pkgnums} ) {
419 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
420 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
426 # for those packages the customer is purchasing:
427 # @{$pkgparts} is a list of said packages, by pkgpart
428 # @cust_svc is a corresponding list of lists of FS::Record objects
430 foreach $pkgpart ( @{$pkgparts} ) {
431 return "Customer not permitted to purchase pkgpart $pkgpart!"
432 unless $part_pkg{$pkgpart};
435 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
437 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
442 #check for leftover services
443 foreach (keys %svcnum) {
444 next unless @{ $svcnum{$_} };
445 return "Leftover services!";
448 #no leftover services, let's make changes.
450 local $SIG{HUP} = 'IGNORE';
451 local $SIG{INT} = 'IGNORE';
452 local $SIG{QUIT} = 'IGNORE';
453 local $SIG{TERM} = 'IGNORE';
454 local $SIG{TSTP} = 'IGNORE';
456 #first cancel old packages
458 foreach $pkgnum ( @{$remove_pkgnums} ) {
459 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
460 return "Package $pkgnum not found to remove!" unless $old;
461 my(%hash) = $old->hash;
463 my($new) = create FS::cust_pkg ( \%hash );
464 my($error)=$new->replace($old);
465 return $error if $error;
468 #now add new packages, changing cust_svc records if necessary
470 while ($pkgpart=shift @{$pkgparts} ) {
472 my($new) = create FS::cust_pkg ( {
473 'custnum' => $custnum,
474 'pkgpart' => $pkgpart,
476 my($error) = $new->insert;
477 return $error if $error;
478 my($pkgnum)=$new->getfield('pkgnum');
481 foreach $cust_svc ( @{ shift @cust_svc } ) {
482 my(%hash) = $cust_svc->hash;
483 $hash{'pkgnum'}=$pkgnum;
484 my($new) = create FS::cust_svc ( \%hash );
485 my($error)=$new->replace($cust_svc);
486 return $error if $error;
497 It doesn't properly override FS::Record yet.
499 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
501 In sub order, the @pkgparts array (passed by reference) is clobbered.
503 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
504 method to pass dates to the recur_prog expression, it should do so.
508 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
509 , L<FS::pkg_svc>, schema.html from the base documentation
513 ivan@voicenet.com 97-jul-1 - 21
515 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
517 pod ivan@sisd.com 98-sep-21
519 $Log: cust_pkg.pm,v $
520 Revision 1.2 1998-11-12 03:42:45 ivan