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)=@_;
400 # $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 });
404 my %part_pkg = %{ $agent->pkgpart_hashref };
408 # for those packages being removed:
409 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
410 # objects (table eq 'cust_svc')
412 foreach $pkgnum ( @{$remove_pkgnums} ) {
414 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
415 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
421 # for those packages the customer is purchasing:
422 # @{$pkgparts} is a list of said packages, by pkgpart
423 # @cust_svc is a corresponding list of lists of FS::Record objects
425 foreach $pkgpart ( @{$pkgparts} ) {
426 return "Customer not permitted to purchase pkgpart $pkgpart!"
427 unless $part_pkg{$pkgpart};
430 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
432 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
437 #check for leftover services
438 foreach (keys %svcnum) {
439 next unless @{ $svcnum{$_} };
440 return "Leftover services!";
443 #no leftover services, let's make changes.
445 local $SIG{HUP} = 'IGNORE';
446 local $SIG{INT} = 'IGNORE';
447 local $SIG{QUIT} = 'IGNORE';
448 local $SIG{TERM} = 'IGNORE';
449 local $SIG{TSTP} = 'IGNORE';
450 local $SIG{PIPE} = 'IGNORE';
452 #first cancel old packages
454 foreach $pkgnum ( @{$remove_pkgnums} ) {
455 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
456 die "Package $pkgnum not found to remove!" unless $old;
457 my(%hash) = $old->hash;
458 $hash{'cancel'}=time;
459 my($new) = new FS::cust_pkg ( \%hash );
460 my($error)=$new->replace($old);
461 die "Couldn't update package $pkgnum: $error" if $error;
464 #now add new packages, changing cust_svc records if necessary
466 while ($pkgpart=shift @{$pkgparts} ) {
468 my($new) = new FS::cust_pkg ( {
469 'custnum' => $custnum,
470 'pkgpart' => $pkgpart,
472 my($error) = $new->insert;
473 die "Couldn't insert new cust_pkg record: $error" if $error;
474 my($pkgnum)=$new->getfield('pkgnum');
477 foreach $cust_svc ( @{ shift @cust_svc } ) {
478 my(%hash) = $cust_svc->hash;
479 $hash{'pkgnum'}=$pkgnum;
480 my($new) = new FS::cust_svc ( \%hash );
481 my($error)=$new->replace($cust_svc);
482 die "Couldn't link old service to new package: $error" if $error;
493 $Id: cust_pkg.pm,v 1.2 1999-08-04 11:50:41 ivan Exp $
497 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
499 In sub order, the @pkgparts array (passed by reference) is clobbered.
501 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
502 method to pass dates to the recur_prog expression, it should do so.
504 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
505 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
506 cancel } because they use %FS::UID::callback to load configuration values.
507 Probably need a subroutine which decides what to do based on whether or not
508 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
512 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
513 , L<FS::pkg_svc>, schema.html from the base documentation