5 use FS::UID qw( getotaker );
6 use FS::Record qw( qsearch qsearchs );
12 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
14 # because they load configuraion by setting FS::UID::callback (see TODO)
19 @ISA = qw( FS::Record );
23 FS::cust_pkg - Object methods for cust_pkg objects
29 $record = new FS::cust_pkg \%hash;
30 $record = new FS::cust_pkg { 'column' => 'value' };
32 $error = $record->insert;
34 $error = $new_record->replace($old_record);
36 $error = $record->delete;
38 $error = $record->check;
40 $error = $record->cancel;
42 $error = $record->suspend;
44 $error = $record->unsuspend;
46 $part_pkg = $record->part_pkg;
48 @labels = $record->labels;
50 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
51 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
55 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
56 inherits from FS::Record. The following fields are currently supported:
60 =item pkgnum - primary key (assigned automatically for new billing items)
62 =item custnum - Customer (see L<FS::cust_main>)
64 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
76 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
80 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
81 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
90 Create a new billing item. To add the item to the database, see L<"insert">.
94 sub table { 'cust_pkg'; }
98 Adds this billing item to the database ("Orders" the item). If there is an
99 error, returns the error, otherwise returns false.
104 # custnum might not have have been defined in sub check (for one-shot new
105 # customers), so check it here instead
107 my $error = $self->ut_number('custnum');
108 return $error if $error
110 return "Unknown customer"
111 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
113 $self->SUPER::insert;
119 Currently unimplemented. You don't want to delete billing items, because there
120 would then be no record the customer ever purchased the item. Instead, see
126 return "Can't delete cust_pkg records!";
129 =item replace OLD_RECORD
131 Replaces the OLD_RECORD with this one in the database. If there is an error,
132 returns the error, otherwise returns false.
134 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
136 Changing pkgpart may have disasterous effects. See the order subroutine.
138 setup and bill are normally updated by calling the bill method of a customer
139 object (see L<FS::cust_main>).
141 suspend is normally updated by the suspend and unsuspend methods.
143 cancel is normally updated by the cancel method (and also the order subroutine
149 my( $new, $old ) = ( shift, shift );
151 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
152 return "Can't change otaker!" if $old->otaker ne $new->otaker;
153 return "Can't change setup once it exists!"
154 if $old->getfield('setup') &&
155 $old->getfield('setup') != $new->getfield('setup');
156 #some logic for bill, susp, cancel?
158 $new->SUPER::replace($old);
163 Checks all fields to make sure this is a valid billing item. If there is an
164 error, returns the error, otherwise returns false. Called by the insert and
173 $self->ut_numbern('pkgnum')
174 || $self->ut_numbern('custnum')
175 || $self->ut_number('pkgpart')
176 || $self->ut_numbern('setup')
177 || $self->ut_numbern('bill')
178 || $self->ut_numbern('susp')
179 || $self->ut_numbern('cancel')
181 return $error if $error;
183 if ( $self->custnum ) {
184 return "Unknown customer"
185 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
188 return "Unknown pkgpart"
189 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
191 $self->otaker(getotaker) unless $self->otaker;
192 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
200 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
201 in this package, then cancels the package itself (sets the cancel field to
204 If there is an error, returns the error, otherwise returns false.
212 local $SIG{HUP} = 'IGNORE';
213 local $SIG{INT} = 'IGNORE';
214 local $SIG{QUIT} = 'IGNORE';
215 local $SIG{TERM} = 'IGNORE';
216 local $SIG{TSTP} = 'IGNORE';
217 local $SIG{PIPE} = 'IGNORE';
219 foreach my $cust_svc (
220 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
222 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
224 $part_svc->svcdb =~ /^([\w\-]+)$/
225 or return "Illegal svcdb value in part_svc!";
227 require "FS/$svcdb.pm";
229 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
231 $error = $svc->cancel;
232 return "Error cancelling service: $error" if $error;
233 $error = $svc->delete;
234 return "Error deleting service: $error" if $error;
237 $error = $cust_svc->delete;
238 return "Error deleting cust_svc: $error" if $error;
242 unless ( $self->getfield('cancel') ) {
243 my %hash = $self->hash;
244 $hash{'cancel'} = time;
245 my $new = new FS::cust_pkg ( \%hash );
246 $error = $new->replace($self);
247 return $error if $error;
255 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
256 package, then suspends the package itself (sets the susp field to now).
258 If there is an error, returns the error, otherwise returns false.
266 local $SIG{HUP} = 'IGNORE';
267 local $SIG{INT} = 'IGNORE';
268 local $SIG{QUIT} = 'IGNORE';
269 local $SIG{TERM} = 'IGNORE';
270 local $SIG{TSTP} = 'IGNORE';
271 local $SIG{PIPE} = 'IGNORE';
273 foreach my $cust_svc (
274 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
276 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
278 $part_svc->svcdb =~ /^([\w\-]+)$/
279 or return "Illegal svcdb value in part_svc!";
281 require "FS/$svcdb.pm";
283 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
285 $error = $svc->suspend;
286 return $error if $error;
291 unless ( $self->getfield('susp') ) {
292 my %hash = $self->hash;
293 $hash{'susp'} = time;
294 my $new = new FS::cust_pkg ( \%hash );
295 $error = $new->replace($self);
296 return $error if $error;
304 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
305 package, then unsuspends the package itself (clears the susp field).
307 If there is an error, returns the error, otherwise returns false.
315 local $SIG{HUP} = 'IGNORE';
316 local $SIG{INT} = 'IGNORE';
317 local $SIG{QUIT} = 'IGNORE';
318 local $SIG{TERM} = 'IGNORE';
319 local $SIG{TSTP} = 'IGNORE';
320 local $SIG{PIPE} = 'IGNORE';
322 foreach my $cust_svc (
323 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
325 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
327 $part_svc->svcdb =~ /^([\w\-]+)$/
328 or return "Illegal svcdb value in part_svc!";
330 require "FS/$svcdb.pm";
332 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
334 $error = $svc->unsuspend;
335 return $error if $error;
340 unless ( ! $self->getfield('susp') ) {
341 my %hash = $self->hash;
343 my $new = new FS::cust_pkg ( \%hash );
344 $error = $new->replace($self);
345 return $error if $error;
353 Returns the definition for this billing item, as an FS::part_pkg object (see
360 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
365 Returns a list of lists, calling the label method for all services
366 (see L<FS::cust_svc>) of this billing item.
372 map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
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';
456 local $SIG{PIPE} = 'IGNORE';
458 #first cancel old packages
460 foreach $pkgnum ( @{$remove_pkgnums} ) {
461 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
462 die "Package $pkgnum not found to remove!" unless $old;
463 my(%hash) = $old->hash;
464 $hash{'cancel'}=time;
465 my($new) = new FS::cust_pkg ( \%hash );
466 my($error)=$new->replace($old);
467 die "Couldn't update package $pkgnum: $error" if $error;
470 #now add new packages, changing cust_svc records if necessary
472 while ($pkgpart=shift @{$pkgparts} ) {
474 my($new) = new FS::cust_pkg ( {
475 'custnum' => $custnum,
476 'pkgpart' => $pkgpart,
478 my($error) = $new->insert;
479 die "Couldn't insert new cust_pkg record: $error" if $error;
480 my($pkgnum)=$new->getfield('pkgnum');
483 foreach $cust_svc ( @{ shift @cust_svc } ) {
484 my(%hash) = $cust_svc->hash;
485 $hash{'pkgnum'}=$pkgnum;
486 my($new) = new FS::cust_svc ( \%hash );
487 my($error)=$new->replace($cust_svc);
488 die "Couldn't link old service to new package: $error" if $error;
499 $Id: cust_pkg.pm,v 1.9 1999-03-29 01:11:51 ivan Exp $
503 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
505 In sub order, the @pkgparts array (passed by reference) is clobbered.
507 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
508 method to pass dates to the recur_prog expression, it should do so.
510 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
511 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
512 cancel } because they use %FS::UID::callback to load configuration values.
513 Probably need a subroutine which decides what to do based on whether or not
514 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
518 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
519 , L<FS::pkg_svc>, schema.html from the base documentation
523 ivan@voicenet.com 97-jul-1 - 21
525 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
527 pod ivan@sisd.com 98-sep-21
529 $Log: cust_pkg.pm,v $
530 Revision 1.9 1999-03-29 01:11:51 ivan
533 Revision 1.8 1999/03/25 13:48:14 ivan
534 allow empty custnum in sub check (but call that an error in sub insert),
535 for one-screen new customer entry
537 Revision 1.7 1999/02/09 09:55:06 ivan
538 invoices show line items for each service in a package (see the label method
541 Revision 1.6 1999/01/25 12:26:12 ivan
542 yet more mod_perl stuff
544 Revision 1.5 1999/01/18 21:58:07 ivan
545 esthetic: eq and ne were used in a few places instead of == and !=
547 Revision 1.4 1998/12/29 11:59:45 ivan
548 mostly properly OO, some work still to be done with svc_ stuff
550 Revision 1.3 1998/11/15 13:01:35 ivan
551 allow pkgpart changing (for per-customer custom pricing). warn about it in doc
553 Revision 1.2 1998/11/12 03:42:45 ivan