5 use FS::UID qw( getotaker );
6 use FS::Record qw( qsearch qsearchs );
13 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
15 # because they load configuraion by setting FS::UID::callback (see TODO)
21 @ISA = qw( FS::Record );
25 FS::cust_pkg - Object methods for cust_pkg objects
31 $record = new FS::cust_pkg \%hash;
32 $record = new FS::cust_pkg { 'column' => 'value' };
34 $error = $record->insert;
36 $error = $new_record->replace($old_record);
38 $error = $record->delete;
40 $error = $record->check;
42 $error = $record->cancel;
44 $error = $record->suspend;
46 $error = $record->unsuspend;
48 $part_pkg = $record->part_pkg;
50 @labels = $record->labels;
52 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
53 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
57 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
58 inherits from FS::Record. The following fields are currently supported:
62 =item pkgnum - primary key (assigned automatically for new billing items)
64 =item custnum - Customer (see L<FS::cust_main>)
66 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
78 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
82 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
83 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
92 Create a new billing item. To add the item to the database, see L<"insert">.
96 sub table { 'cust_pkg'; }
100 Adds this billing item to the database ("Orders" the item). If there is an
101 error, returns the error, otherwise returns false.
106 # custnum might not have have been defined in sub check (for one-shot new
107 # customers), so check it here instead
109 my $error = $self->ut_number('custnum');
110 return $error if $error
112 return "Unknown customer"
113 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
115 $self->SUPER::insert;
121 Currently unimplemented. You don't want to delete billing items, because there
122 would then be no record the customer ever purchased the item. Instead, see
128 return "Can't delete cust_pkg records!";
131 =item replace OLD_RECORD
133 Replaces the OLD_RECORD with this one in the database. If there is an error,
134 returns the error, otherwise returns false.
136 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
138 Changing pkgpart may have disasterous effects. See the order subroutine.
140 setup and bill are normally updated by calling the bill method of a customer
141 object (see L<FS::cust_main>).
143 suspend is normally updated by the suspend and unsuspend methods.
145 cancel is normally updated by the cancel method (and also the order subroutine
151 my( $new, $old ) = ( shift, shift );
153 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
154 return "Can't change otaker!" if $old->otaker ne $new->otaker;
155 return "Can't change setup once it exists!"
156 if $old->getfield('setup') &&
157 $old->getfield('setup') != $new->getfield('setup');
158 #some logic for bill, susp, cancel?
160 $new->SUPER::replace($old);
165 Checks all fields to make sure this is a valid billing item. If there is an
166 error, returns the error, otherwise returns false. Called by the insert and
175 $self->ut_numbern('pkgnum')
176 || $self->ut_numbern('custnum')
177 || $self->ut_number('pkgpart')
178 || $self->ut_numbern('setup')
179 || $self->ut_numbern('bill')
180 || $self->ut_numbern('susp')
181 || $self->ut_numbern('cancel')
183 return $error if $error;
185 if ( $self->custnum ) {
186 return "Unknown customer"
187 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
190 return "Unknown pkgpart"
191 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
193 $self->otaker(getotaker) unless $self->otaker;
194 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
202 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
203 in this package, then cancels the package itself (sets the cancel field to
206 If there is an error, returns the error, otherwise returns false.
214 local $SIG{HUP} = 'IGNORE';
215 local $SIG{INT} = 'IGNORE';
216 local $SIG{QUIT} = 'IGNORE';
217 local $SIG{TERM} = 'IGNORE';
218 local $SIG{TSTP} = 'IGNORE';
219 local $SIG{PIPE} = 'IGNORE';
221 foreach my $cust_svc (
222 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
224 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
226 $part_svc->svcdb =~ /^([\w\-]+)$/
227 or return "Illegal svcdb value in part_svc!";
229 require "FS/$svcdb.pm";
231 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
233 $error = $svc->cancel;
234 return "Error cancelling service: $error" if $error;
235 $error = $svc->delete;
236 return "Error deleting service: $error" if $error;
239 $error = $cust_svc->delete;
240 return "Error deleting cust_svc: $error" if $error;
244 unless ( $self->getfield('cancel') ) {
245 my %hash = $self->hash;
246 $hash{'cancel'} = time;
247 my $new = new FS::cust_pkg ( \%hash );
248 $error = $new->replace($self);
249 return $error if $error;
257 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
258 package, then suspends the package itself (sets the susp field to now).
260 If there is an error, returns the error, otherwise returns false.
268 local $SIG{HUP} = 'IGNORE';
269 local $SIG{INT} = 'IGNORE';
270 local $SIG{QUIT} = 'IGNORE';
271 local $SIG{TERM} = 'IGNORE';
272 local $SIG{TSTP} = 'IGNORE';
273 local $SIG{PIPE} = 'IGNORE';
275 foreach my $cust_svc (
276 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
278 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
280 $part_svc->svcdb =~ /^([\w\-]+)$/
281 or return "Illegal svcdb value in part_svc!";
283 require "FS/$svcdb.pm";
285 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
287 $error = $svc->suspend;
288 return $error if $error;
293 unless ( $self->getfield('susp') ) {
294 my %hash = $self->hash;
295 $hash{'susp'} = time;
296 my $new = new FS::cust_pkg ( \%hash );
297 $error = $new->replace($self);
298 return $error if $error;
306 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
307 package, then unsuspends the package itself (clears the susp field).
309 If there is an error, returns the error, otherwise returns false.
317 local $SIG{HUP} = 'IGNORE';
318 local $SIG{INT} = 'IGNORE';
319 local $SIG{QUIT} = 'IGNORE';
320 local $SIG{TERM} = 'IGNORE';
321 local $SIG{TSTP} = 'IGNORE';
322 local $SIG{PIPE} = 'IGNORE';
324 foreach my $cust_svc (
325 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
327 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
329 $part_svc->svcdb =~ /^([\w\-]+)$/
330 or return "Illegal svcdb value in part_svc!";
332 require "FS/$svcdb.pm";
334 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
336 $error = $svc->unsuspend;
337 return $error if $error;
342 unless ( ! $self->getfield('susp') ) {
343 my %hash = $self->hash;
345 my $new = new FS::cust_pkg ( \%hash );
346 $error = $new->replace($self);
347 return $error if $error;
355 Returns the definition for this billing item, as an FS::part_pkg object (see
362 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
367 Returns a list of lists, calling the label method for all services
368 (see L<FS::cust_svc>) of this billing item.
374 map { [ $_->label ] } qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
383 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
385 CUSTNUM is a customer (see L<FS::cust_main>)
387 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
388 L<FS::part_pkg>) to order for this customer. Duplicates are of course
391 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
392 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
393 new billing items. An error is returned if this is not possible (see
399 my($custnum,$pkgparts,$remove_pkgnums)=@_;
402 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
404 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
405 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
406 my %part_pkg = %{ $agent->pkgpart_hashref };
410 # for those packages being removed:
411 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
412 # objects (table eq 'cust_svc')
414 foreach $pkgnum ( @{$remove_pkgnums} ) {
416 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
417 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
423 # for those packages the customer is purchasing:
424 # @{$pkgparts} is a list of said packages, by pkgpart
425 # @cust_svc is a corresponding list of lists of FS::Record objects
427 foreach $pkgpart ( @{$pkgparts} ) {
428 return "Customer not permitted to purchase pkgpart $pkgpart!"
429 unless $part_pkg{$pkgpart};
432 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
433 } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
437 #check for leftover services
438 foreach (keys %svcnum) {
439 next unless @{ $svcnum{$_} };
440 return "Leftover services, svcpart $_: svcnum ".
441 join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
444 #no leftover services, let's make changes.
446 local $SIG{HUP} = 'IGNORE';
447 local $SIG{INT} = 'IGNORE';
448 local $SIG{QUIT} = 'IGNORE';
449 local $SIG{TERM} = 'IGNORE';
450 local $SIG{TSTP} = 'IGNORE';
451 local $SIG{PIPE} = 'IGNORE';
453 #first cancel old packages
455 foreach $pkgnum ( @{$remove_pkgnums} ) {
456 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
457 die "Package $pkgnum not found to remove!" unless $old;
458 my(%hash) = $old->hash;
459 $hash{'cancel'}=time;
460 my($new) = new FS::cust_pkg ( \%hash );
461 my($error)=$new->replace($old);
462 die "Couldn't update package $pkgnum: $error" if $error;
465 #now add new packages, changing cust_svc records if necessary
467 while ($pkgpart=shift @{$pkgparts} ) {
469 my($new) = new FS::cust_pkg ( {
470 'custnum' => $custnum,
471 'pkgpart' => $pkgpart,
473 my($error) = $new->insert;
474 die "Couldn't insert new cust_pkg record: $error" if $error;
475 my($pkgnum)=$new->getfield('pkgnum');
478 foreach $cust_svc ( @{ shift @cust_svc } ) {
479 my(%hash) = $cust_svc->hash;
480 $hash{'pkgnum'}=$pkgnum;
481 my($new) = new FS::cust_svc ( \%hash );
482 my($error)=$new->replace($cust_svc);
483 die "Couldn't link old service to new package: $error" if $error;
494 $Id: cust_pkg.pm,v 1.4 2000-02-03 05:16:52 ivan Exp $
498 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
500 In sub order, the @pkgparts array (passed by reference) is clobbered.
502 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
503 method to pass dates to the recur_prog expression, it should do so.
505 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
506 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
507 cancel } because they use %FS::UID::callback to load configuration values.
508 Probably need a subroutine which decides what to do based on whether or not
509 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
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