6 use FS::UID qw(getotaker);
7 use FS::Record qw(fields qsearch qsearchs);
12 @ISA = qw(FS::Record Exporter);
16 FS::cust_pkg - Object methods for cust_pkg objects
22 $record = create FS::cust_pkg \%hash;
23 $record = create FS::cust_pkg { 'column' => 'value' };
25 $error = $record->insert;
27 $error = $new_record->replace($old_record);
29 $error = $record->delete;
31 $error = $record->check;
33 $error = $record->cancel;
35 $error = $record->suspend;
37 $error = $record->unsuspend;
39 $part_pkg = $record->part_pkg;
41 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
42 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
46 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
47 inherits from FS::Record. The following fields are currently supported:
51 =item pkgnum - primary key (assigned automatically for new billing items)
53 =item custnum - Customer (see L<FS::cust_main>)
55 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
67 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
71 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
72 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
81 Create a new billing item. To add the item to the database, see L<"insert">.
86 my($proto,$hashref)=@_;
88 #now in FS::Record::new
90 #foreach $field (fields('cust_pkg')) {
91 # $hashref->{$field}='' unless defined $hashref->{$field};
94 $proto->new('cust_pkg',$hashref);
99 Adds this billing item to the database ("Orders" the item). If there is an
100 error, returns the error, otherwise returns false.
113 Currently unimplemented. You don't want to delete billing items, because there
114 would then be no record the customer ever purchased the item. Instead, see
118 return "Can't delete cust_pkg records!";
121 =item replace OLD_RECORD
123 Replaces the OLD_RECORD with this one in the database. If there is an error,
124 returns the error, otherwise returns false.
126 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
128 Changing pkgpart may have disasterous effects. See the order subroutine.
130 setup and bill are normally updated by calling the bill method of a customer
131 object (see L<FS::cust_main>).
133 suspend is normally updated by the suspend and unsuspend methods.
135 cancel is normally updated by the cancel method (and also the order subroutine
142 return "(Old) Not a cust_pkg record!" if $old->table ne "cust_pkg";
143 return "Can't change pkgnum!"
144 if $old->getfield('pkgnum') ne $new->getfield('pkgnum');
145 #return "Can't (yet?) change pkgpart!"
146 # if $old->getfield('pkgpart') ne $new->getfield('pkgpart');
147 return "Can't change otaker!"
148 if $old->getfield('otaker') ne $new->getfield('otaker');
149 return "Can't change setup once it exists!"
150 if $old->getfield('setup') &&
151 $old->getfield('setup') != $new->getfield('setup');
152 #some logic for bill, susp, cancel?
160 Checks all fields to make sure this is a valid billing item. If there is an
161 error, returns the error, otherwise returns false. Called by the insert and
168 return "Not a cust_pkg record!" if $self->table ne "cust_pkg";
169 my($recref) = $self->hashref;
171 $recref->{pkgnum} =~ /^(\d*)$/ or return "Illegal pkgnum";
172 $recref->{pkgnum}=$1;
174 $recref->{custnum} =~ /^(\d+)$/ or return "Illegal custnum";
175 $recref->{custnum}=$1;
176 return "Unknown customer"
177 unless qsearchs('cust_main',{'custnum'=>$recref->{custnum}});
179 $recref->{pkgpart} =~ /^(\d+)$/ or return "Illegal pkgpart";
180 $recref->{pkgpart}=$1;
181 return "Unknown pkgpart"
182 unless qsearchs('part_pkg',{'pkgpart'=>$recref->{pkgpart}});
184 $recref->{otaker} ||= &getotaker;
185 $recref->{otaker} =~ /^(\w{0,8})$/ or return "Illegal otaker";
186 $recref->{otaker}=$1;
188 $recref->{setup} =~ /^(\d*)$/ or return "Illegal setup date";
191 $recref->{bill} =~ /^(\d*)$/ or return "Illegal bill date";
194 $recref->{susp} =~ /^(\d*)$/ or return "Illegal susp date";
197 $recref->{cancel} =~ /^(\d*)$/ or return "Illegal cancel date";
198 $recref->{cancel}=$1;
205 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
206 in this package, then cancels the package itself (sets the cancel field to
209 If there is an error, returns the error, otherwise returns false.
217 local $SIG{HUP} = 'IGNORE';
218 local $SIG{INT} = 'IGNORE';
219 local $SIG{QUIT} = 'IGNORE';
220 local $SIG{TERM} = 'IGNORE';
221 local $SIG{TSTP} = 'IGNORE';
225 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
228 qsearchs('part_svc',{'svcpart'=> $cust_svc->svcpart } );
230 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
231 or return "Illegal svcdb value in part_svc!";
233 require "FS/$svcdb.pm";
235 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->svcnum } );
237 bless($svc,"FS::$svcdb");
238 $error = $svc->cancel;
239 return "Error cancelling service: $error" if $error;
240 $error = $svc->delete;
241 return "Error deleting service: $error" if $error;
244 bless($cust_svc,"FS::cust_svc");
245 $error = $cust_svc->delete;
246 return "Error deleting cust_svc: $error" if $error;
250 unless ( $self->getfield('cancel') ) {
251 my(%hash) = $self->hash;
253 my($new) = create FS::cust_pkg ( \%hash );
254 $error=$new->replace($self);
255 return $error if $error;
263 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
264 package, then suspends the package itself (sets the susp field to now).
266 If there is an error, returns the error, otherwise returns false.
273 local $SIG{HUP} = 'IGNORE';
274 local $SIG{INT} = 'IGNORE';
275 local $SIG{QUIT} = 'IGNORE';
276 local $SIG{TERM} = 'IGNORE';
277 local $SIG{TSTP} = 'IGNORE';
281 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
284 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
286 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
287 or return "Illegal svcdb value in part_svc!";
289 require "FS/$svcdb.pm";
291 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
294 bless($svc,"FS::$svcdb");
295 $error = $svc->suspend;
296 return $error if $error;
301 unless ( $self->getfield('susp') ) {
302 my(%hash) = $self->hash;
304 my($new) = create FS::cust_pkg ( \%hash );
305 $error=$new->replace($self);
306 return $error if $error;
314 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
315 package, then unsuspends the package itself (clears the susp field).
317 If there is an error, returns the error, otherwise returns false.
325 local $SIG{HUP} = 'IGNORE';
326 local $SIG{INT} = 'IGNORE';
327 local $SIG{QUIT} = 'IGNORE';
328 local $SIG{TERM} = 'IGNORE';
329 local $SIG{TSTP} = 'IGNORE';
333 qsearch('cust_svc',{'pkgnum'=> $self->getfield('pkgnum') } )
336 qsearchs('part_svc',{'svcpart'=> $cust_svc->getfield('svcpart') } );
338 $part_svc->getfield('svcdb') =~ /^([\w\-]+)$/
339 or return "Illegal svcdb value in part_svc!";
341 require "FS/$svcdb.pm";
343 my($svc) = qsearchs($svcdb,{'svcnum' => $cust_svc->getfield('svcnum') } );
345 bless($svc,"FS::$svcdb");
346 $error = $svc->unsuspend;
347 return $error if $error;
352 unless ( ! $self->getfield('susp') ) {
353 my(%hash) = $self->hash;
355 my($new) = create FS::cust_pkg ( \%hash );
356 $error=$new->replace($self);
357 return $error if $error;
365 Returns the definition for this billing item, as an FS::part_pkg object (see
372 qsearchs('part_pkg', { 'pkgpart' => $self->pkgpart });
381 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
383 CUSTNUM is a customer (see L<FS::cust_main>)
385 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
386 L<FS::part_pkg>) to order for this customer. Duplicates are of course
389 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
390 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
391 new billing items. An error is returned if this is not possible (see
397 my($custnum,$pkgparts,$remove_pkgnums)=@_;
401 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
402 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
403 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
406 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
407 my($pkgpart)=$type_pkgs->pkgpart;
408 $part_pkg{$pkgpart}++;
414 # for those packages being removed:
415 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
416 # objects (table eq 'cust_svc')
418 foreach $pkgnum ( @{$remove_pkgnums} ) {
420 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
421 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
427 # for those packages the customer is purchasing:
428 # @{$pkgparts} is a list of said packages, by pkgpart
429 # @cust_svc is a corresponding list of lists of FS::Record objects
431 foreach $pkgpart ( @{$pkgparts} ) {
432 return "Customer not permitted to purchase pkgpart $pkgpart!"
433 unless $part_pkg{$pkgpart};
436 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
438 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
443 #check for leftover services
444 foreach (keys %svcnum) {
445 next unless @{ $svcnum{$_} };
446 return "Leftover services!";
449 #no leftover services, let's make changes.
451 local $SIG{HUP} = 'IGNORE';
452 local $SIG{INT} = 'IGNORE';
453 local $SIG{QUIT} = 'IGNORE';
454 local $SIG{TERM} = 'IGNORE';
455 local $SIG{TSTP} = 'IGNORE';
457 #first cancel old packages
459 foreach $pkgnum ( @{$remove_pkgnums} ) {
460 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
461 return "Package $pkgnum not found to remove!" unless $old;
462 my(%hash) = $old->hash;
464 my($new) = create FS::cust_pkg ( \%hash );
465 my($error)=$new->replace($old);
466 return $error if $error;
469 #now add new packages, changing cust_svc records if necessary
471 while ($pkgpart=shift @{$pkgparts} ) {
473 my($new) = create FS::cust_pkg ( {
474 'custnum' => $custnum,
475 'pkgpart' => $pkgpart,
477 my($error) = $new->insert;
478 return $error if $error;
479 my($pkgnum)=$new->getfield('pkgnum');
482 foreach $cust_svc ( @{ shift @cust_svc } ) {
483 my(%hash) = $cust_svc->hash;
484 $hash{'pkgnum'}=$pkgnum;
485 my($new) = create FS::cust_svc ( \%hash );
486 my($error)=$new->replace($cust_svc);
487 return $error if $error;
498 $Id: cust_pkg.pm,v 1.3 1998-11-15 13:01:35 ivan Exp $
502 It doesn't properly override FS::Record yet.
504 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
506 In sub order, the @pkgparts array (passed by reference) is clobbered.
508 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
509 method to pass dates to the recur_prog expression, it should do so.
513 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
514 , L<FS::pkg_svc>, schema.html from the base documentation
518 ivan@voicenet.com 97-jul-1 - 21
520 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
522 pod ivan@sisd.com 98-sep-21
524 $Log: cust_pkg.pm,v $
525 Revision 1.3 1998-11-15 13:01:35 ivan
526 allow pkgpart changing (for per-customer custom pricing). warn about it in doc
528 Revision 1.2 1998/11/12 03:42:45 ivan