5 use FS::UID qw( getotaker );
6 use FS::Record qw( qsearch qsearchs );
11 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
13 # because they load configuraion by setting FS::UID::callback (see TODO)
18 @ISA = qw( FS::Record );
22 FS::cust_pkg - Object methods for cust_pkg objects
28 $record = new FS::cust_pkg \%hash;
29 $record = new FS::cust_pkg { 'column' => 'value' };
31 $error = $record->insert;
33 $error = $new_record->replace($old_record);
35 $error = $record->delete;
37 $error = $record->check;
39 $error = $record->cancel;
41 $error = $record->suspend;
43 $error = $record->unsuspend;
45 $part_pkg = $record->part_pkg;
47 @labels = $record->labels;
49 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
50 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
54 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
55 inherits from FS::Record. The following fields are currently supported:
59 =item pkgnum - primary key (assigned automatically for new billing items)
61 =item custnum - Customer (see L<FS::cust_main>)
63 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
75 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
79 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
80 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
89 Create a new billing item. To add the item to the database, see L<"insert">.
93 sub table { 'cust_pkg'; }
97 Adds this billing item to the database ("Orders" the item). If there is an
98 error, returns the error, otherwise returns false.
103 # custnum might not have have been defined in sub check (for one-shot new
104 # customers), so check it here instead
106 my $error = $self->ut_number('custnum');
107 return $error if $error
109 return "Unknown customer"
110 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
112 $self->SUPER::insert;
118 Currently unimplemented. You don't want to delete billing items, because there
119 would then be no record the customer ever purchased the item. Instead, see
125 return "Can't delete cust_pkg records!";
128 =item replace OLD_RECORD
130 Replaces the OLD_RECORD with this one in the database. If there is an error,
131 returns the error, otherwise returns false.
133 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
135 Changing pkgpart may have disasterous effects. See the order subroutine.
137 setup and bill are normally updated by calling the bill method of a customer
138 object (see L<FS::cust_main>).
140 suspend is normally updated by the suspend and unsuspend methods.
142 cancel is normally updated by the cancel method (and also the order subroutine
148 my( $new, $old ) = ( shift, shift );
150 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
151 return "Can't change otaker!" if $old->otaker ne $new->otaker;
152 return "Can't change setup once it exists!"
153 if $old->getfield('setup') &&
154 $old->getfield('setup') != $new->getfield('setup');
155 #some logic for bill, susp, cancel?
157 $new->SUPER::replace($old);
162 Checks all fields to make sure this is a valid billing item. If there is an
163 error, returns the error, otherwise returns false. Called by the insert and
172 $self->ut_numbern('pkgnum')
173 || $self->ut_numbern('custnum')
174 || $self->ut_number('pkgpart')
175 || $self->ut_numbern('setup')
176 || $self->ut_numbern('bill')
177 || $self->ut_numbern('susp')
178 || $self->ut_numbern('cancel')
180 return $error if $error;
182 if ( $self->custnum ) {
183 return "Unknown customer"
184 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
187 return "Unknown pkgpart"
188 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
190 $self->otaker(getotaker) unless $self->otaker;
191 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
199 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
200 in this package, then cancels the package itself (sets the cancel field to
203 If there is an error, returns the error, otherwise returns false.
211 local $SIG{HUP} = 'IGNORE';
212 local $SIG{INT} = 'IGNORE';
213 local $SIG{QUIT} = 'IGNORE';
214 local $SIG{TERM} = 'IGNORE';
215 local $SIG{TSTP} = 'IGNORE';
216 local $SIG{PIPE} = 'IGNORE';
218 foreach my $cust_svc (
219 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
221 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
223 $part_svc->svcdb =~ /^([\w\-]+)$/
224 or return "Illegal svcdb value in part_svc!";
226 require "FS/$svcdb.pm";
228 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
230 $error = $svc->cancel;
231 return "Error cancelling service: $error" if $error;
232 $error = $svc->delete;
233 return "Error deleting service: $error" if $error;
236 $error = $cust_svc->delete;
237 return "Error deleting cust_svc: $error" if $error;
241 unless ( $self->getfield('cancel') ) {
242 my %hash = $self->hash;
243 $hash{'cancel'} = time;
244 my $new = new FS::cust_pkg ( \%hash );
245 $error = $new->replace($self);
246 return $error if $error;
254 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
255 package, then suspends the package itself (sets the susp field to now).
257 If there is an error, returns the error, otherwise returns false.
265 local $SIG{HUP} = 'IGNORE';
266 local $SIG{INT} = 'IGNORE';
267 local $SIG{QUIT} = 'IGNORE';
268 local $SIG{TERM} = 'IGNORE';
269 local $SIG{TSTP} = 'IGNORE';
270 local $SIG{PIPE} = 'IGNORE';
272 foreach my $cust_svc (
273 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
275 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
277 $part_svc->svcdb =~ /^([\w\-]+)$/
278 or return "Illegal svcdb value in part_svc!";
280 require "FS/$svcdb.pm";
282 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
284 $error = $svc->suspend;
285 return $error if $error;
290 unless ( $self->getfield('susp') ) {
291 my %hash = $self->hash;
292 $hash{'susp'} = time;
293 my $new = new FS::cust_pkg ( \%hash );
294 $error = $new->replace($self);
295 return $error if $error;
303 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
304 package, then unsuspends the package itself (clears the susp field).
306 If there is an error, returns the error, otherwise returns false.
314 local $SIG{HUP} = 'IGNORE';
315 local $SIG{INT} = 'IGNORE';
316 local $SIG{QUIT} = 'IGNORE';
317 local $SIG{TERM} = 'IGNORE';
318 local $SIG{TSTP} = 'IGNORE';
319 local $SIG{PIPE} = 'IGNORE';
321 foreach my $cust_svc (
322 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
324 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
326 $part_svc->svcdb =~ /^([\w\-]+)$/
327 or return "Illegal svcdb value in part_svc!";
329 require "FS/$svcdb.pm";
331 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
333 $error = $svc->unsuspend;
334 return $error if $error;
339 unless ( ! $self->getfield('susp') ) {
340 my %hash = $self->hash;
342 my $new = new FS::cust_pkg ( \%hash );
343 $error = $new->replace($self);
344 return $error if $error;
352 Returns the definition for this billing item, as an FS::part_pkg object (see
359 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
364 Returns a list of lists, calling the label method for all services
365 (see L<FS::cust_svc>) of this billing item.
371 map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
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';
455 local $SIG{PIPE} = 'IGNORE';
457 #first cancel old packages
459 foreach $pkgnum ( @{$remove_pkgnums} ) {
460 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
461 die "Package $pkgnum not found to remove!" unless $old;
462 my(%hash) = $old->hash;
463 $hash{'cancel'}=time;
464 my($new) = new FS::cust_pkg ( \%hash );
465 my($error)=$new->replace($old);
466 die "Couldn't update package $pkgnum: $error" if $error;
469 #now add new packages, changing cust_svc records if necessary
471 while ($pkgpart=shift @{$pkgparts} ) {
473 my($new) = new FS::cust_pkg ( {
474 'custnum' => $custnum,
475 'pkgpart' => $pkgpart,
477 my($error) = $new->insert;
478 die "Couldn't insert new cust_pkg record: $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) = new FS::cust_svc ( \%hash );
486 my($error)=$new->replace($cust_svc);
487 die "Couldn't link old service to new package: $error" if $error;
498 $Id: cust_pkg.pm,v 1.8 1999-03-25 13:48:14 ivan Exp $
502 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
504 In sub order, the @pkgparts array (passed by reference) is clobbered.
506 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
507 method to pass dates to the recur_prog expression, it should do so.
509 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
510 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
511 cancel } because they use %FS::UID::callback to load configuration values.
512 Probably need a subroutine which decides what to do based on whether or not
513 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
517 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
518 , L<FS::pkg_svc>, schema.html from the base documentation
522 ivan@voicenet.com 97-jul-1 - 21
524 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
526 pod ivan@sisd.com 98-sep-21
528 $Log: cust_pkg.pm,v $
529 Revision 1.8 1999-03-25 13:48:14 ivan
530 allow empty custnum in sub check (but call that an error in sub insert),
531 for one-screen new customer entry
533 Revision 1.7 1999/02/09 09:55:06 ivan
534 invoices show line items for each service in a package (see the label method
537 Revision 1.6 1999/01/25 12:26:12 ivan
538 yet more mod_perl stuff
540 Revision 1.5 1999/01/18 21:58:07 ivan
541 esthetic: eq and ne were used in a few places instead of == and !=
543 Revision 1.4 1998/12/29 11:59:45 ivan
544 mostly properly OO, some work still to be done with svc_ stuff
546 Revision 1.3 1998/11/15 13:01:35 ivan
547 allow pkgpart changing (for per-customer custom pricing). warn about it in doc
549 Revision 1.2 1998/11/12 03:42:45 ivan