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.
102 Currently unimplemented. You don't want to delete billing items, because there
103 would then be no record the customer ever purchased the item. Instead, see
109 return "Can't delete cust_pkg records!";
112 =item replace OLD_RECORD
114 Replaces the OLD_RECORD with this one in the database. If there is an error,
115 returns the error, otherwise returns false.
117 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
119 Changing pkgpart may have disasterous effects. See the order subroutine.
121 setup and bill are normally updated by calling the bill method of a customer
122 object (see L<FS::cust_main>).
124 suspend is normally updated by the suspend and unsuspend methods.
126 cancel is normally updated by the cancel method (and also the order subroutine
132 my( $new, $old ) = ( shift, shift );
134 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
135 return "Can't change otaker!" if $old->otaker ne $new->otaker;
136 return "Can't change setup once it exists!"
137 if $old->getfield('setup') &&
138 $old->getfield('setup') != $new->getfield('setup');
139 #some logic for bill, susp, cancel?
141 $new->SUPER::replace($old);
146 Checks all fields to make sure this is a valid billing item. If there is an
147 error, returns the error, otherwise returns false. Called by the insert and
156 $self->ut_numbern('pkgnum')
157 || $self->ut_number('custnum')
158 || $self->ut_number('pkgpart')
159 || $self->ut_numbern('setup')
160 || $self->ut_numbern('bill')
161 || $self->ut_numbern('susp')
162 || $self->ut_numbern('cancel')
164 return $error if $error;
166 return "Unknown customer"
167 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
169 return "Unknown pkgpart"
170 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
172 $self->otaker(getotaker) unless $self->otaker;
173 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
181 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
182 in this package, then cancels the package itself (sets the cancel field to
185 If there is an error, returns the error, otherwise returns false.
193 local $SIG{HUP} = 'IGNORE';
194 local $SIG{INT} = 'IGNORE';
195 local $SIG{QUIT} = 'IGNORE';
196 local $SIG{TERM} = 'IGNORE';
197 local $SIG{TSTP} = 'IGNORE';
198 local $SIG{PIPE} = 'IGNORE';
200 foreach my $cust_svc (
201 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
203 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
205 $part_svc->svcdb =~ /^([\w\-]+)$/
206 or return "Illegal svcdb value in part_svc!";
208 require "FS/$svcdb.pm";
210 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
212 $error = $svc->cancel;
213 return "Error cancelling service: $error" if $error;
214 $error = $svc->delete;
215 return "Error deleting service: $error" if $error;
218 $error = $cust_svc->delete;
219 return "Error deleting cust_svc: $error" if $error;
223 unless ( $self->getfield('cancel') ) {
224 my %hash = $self->hash;
225 $hash{'cancel'} = time;
226 my $new = new FS::cust_pkg ( \%hash );
227 $error = $new->replace($self);
228 return $error if $error;
236 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
237 package, then suspends the package itself (sets the susp field to now).
239 If there is an error, returns the error, otherwise returns false.
247 local $SIG{HUP} = 'IGNORE';
248 local $SIG{INT} = 'IGNORE';
249 local $SIG{QUIT} = 'IGNORE';
250 local $SIG{TERM} = 'IGNORE';
251 local $SIG{TSTP} = 'IGNORE';
252 local $SIG{PIPE} = 'IGNORE';
254 foreach my $cust_svc (
255 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
257 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
259 $part_svc->svcdb =~ /^([\w\-]+)$/
260 or return "Illegal svcdb value in part_svc!";
262 require "FS/$svcdb.pm";
264 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
266 $error = $svc->suspend;
267 return $error if $error;
272 unless ( $self->getfield('susp') ) {
273 my %hash = $self->hash;
274 $hash{'susp'} = time;
275 my $new = new FS::cust_pkg ( \%hash );
276 $error = $new->replace($self);
277 return $error if $error;
285 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
286 package, then unsuspends the package itself (clears the susp field).
288 If there is an error, returns the error, otherwise returns false.
296 local $SIG{HUP} = 'IGNORE';
297 local $SIG{INT} = 'IGNORE';
298 local $SIG{QUIT} = 'IGNORE';
299 local $SIG{TERM} = 'IGNORE';
300 local $SIG{TSTP} = 'IGNORE';
301 local $SIG{PIPE} = 'IGNORE';
303 foreach my $cust_svc (
304 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
306 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
308 $part_svc->svcdb =~ /^([\w\-]+)$/
309 or return "Illegal svcdb value in part_svc!";
311 require "FS/$svcdb.pm";
313 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
315 $error = $svc->unsuspend;
316 return $error if $error;
321 unless ( ! $self->getfield('susp') ) {
322 my %hash = $self->hash;
324 my $new = new FS::cust_pkg ( \%hash );
325 $error = $new->replace($self);
326 return $error if $error;
334 Returns the definition for this billing item, as an FS::part_pkg object (see
341 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
346 Returns a list of lists, calling the label method for all services
347 (see L<FS::cust_svc>) of this billing item.
353 map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
362 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
364 CUSTNUM is a customer (see L<FS::cust_main>)
366 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
367 L<FS::part_pkg>) to order for this customer. Duplicates are of course
370 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
371 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
372 new billing items. An error is returned if this is not possible (see
378 my($custnum,$pkgparts,$remove_pkgnums)=@_;
382 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
383 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
384 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
387 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
388 my($pkgpart)=$type_pkgs->pkgpart;
389 $part_pkg{$pkgpart}++;
395 # for those packages being removed:
396 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
397 # objects (table eq 'cust_svc')
399 foreach $pkgnum ( @{$remove_pkgnums} ) {
401 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
402 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
408 # for those packages the customer is purchasing:
409 # @{$pkgparts} is a list of said packages, by pkgpart
410 # @cust_svc is a corresponding list of lists of FS::Record objects
412 foreach $pkgpart ( @{$pkgparts} ) {
413 return "Customer not permitted to purchase pkgpart $pkgpart!"
414 unless $part_pkg{$pkgpart};
417 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
419 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
424 #check for leftover services
425 foreach (keys %svcnum) {
426 next unless @{ $svcnum{$_} };
427 return "Leftover services!";
430 #no leftover services, let's make changes.
432 local $SIG{HUP} = 'IGNORE';
433 local $SIG{INT} = 'IGNORE';
434 local $SIG{QUIT} = 'IGNORE';
435 local $SIG{TERM} = 'IGNORE';
436 local $SIG{TSTP} = 'IGNORE';
437 local $SIG{PIPE} = 'IGNORE';
439 #first cancel old packages
441 foreach $pkgnum ( @{$remove_pkgnums} ) {
442 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
443 die "Package $pkgnum not found to remove!" unless $old;
444 my(%hash) = $old->hash;
445 $hash{'cancel'}=time;
446 my($new) = new FS::cust_pkg ( \%hash );
447 my($error)=$new->replace($old);
448 die "Couldn't update package $pkgnum: $error" if $error;
451 #now add new packages, changing cust_svc records if necessary
453 while ($pkgpart=shift @{$pkgparts} ) {
455 my($new) = new FS::cust_pkg ( {
456 'custnum' => $custnum,
457 'pkgpart' => $pkgpart,
459 my($error) = $new->insert;
460 die "Couldn't insert new cust_pkg record: $error" if $error;
461 my($pkgnum)=$new->getfield('pkgnum');
464 foreach $cust_svc ( @{ shift @cust_svc } ) {
465 my(%hash) = $cust_svc->hash;
466 $hash{'pkgnum'}=$pkgnum;
467 my($new) = new FS::cust_svc ( \%hash );
468 my($error)=$new->replace($cust_svc);
469 die "Couldn't link old service to new package: $error" if $error;
480 $Id: cust_pkg.pm,v 1.7 1999-02-09 09:55:06 ivan Exp $
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.
491 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
492 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
493 cancel } because they use %FS::UID::callback to load configuration values.
494 Probably need a subroutine which decides what to do based on whether or not
495 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
499 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
500 , L<FS::pkg_svc>, schema.html from the base documentation
504 ivan@voicenet.com 97-jul-1 - 21
506 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
508 pod ivan@sisd.com 98-sep-21
510 $Log: cust_pkg.pm,v $
511 Revision 1.7 1999-02-09 09:55:06 ivan
512 invoices show line items for each service in a package (see the label method
515 Revision 1.6 1999/01/25 12:26:12 ivan
516 yet more mod_perl stuff
518 Revision 1.5 1999/01/18 21:58:07 ivan
519 esthetic: eq and ne were used in a few places instead of == and !=
521 Revision 1.4 1998/12/29 11:59:45 ivan
522 mostly properly OO, some work still to be done with svc_ stuff
524 Revision 1.3 1998/11/15 13:01:35 ivan
525 allow pkgpart changing (for per-customer custom pricing). warn about it in doc
527 Revision 1.2 1998/11/12 03:42:45 ivan