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 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
48 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
52 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
53 inherits from FS::Record. The following fields are currently supported:
57 =item pkgnum - primary key (assigned automatically for new billing items)
59 =item custnum - Customer (see L<FS::cust_main>)
61 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
73 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
77 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
78 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
87 Create a new billing item. To add the item to the database, see L<"insert">.
91 sub table { 'cust_pkg'; }
95 Adds this billing item to the database ("Orders" the item). If there is an
96 error, returns the error, otherwise returns false.
100 Currently unimplemented. You don't want to delete billing items, because there
101 would then be no record the customer ever purchased the item. Instead, see
107 return "Can't delete cust_pkg records!";
110 =item replace OLD_RECORD
112 Replaces the OLD_RECORD with this one in the database. If there is an error,
113 returns the error, otherwise returns false.
115 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
117 Changing pkgpart may have disasterous effects. See the order subroutine.
119 setup and bill are normally updated by calling the bill method of a customer
120 object (see L<FS::cust_main>).
122 suspend is normally updated by the suspend and unsuspend methods.
124 cancel is normally updated by the cancel method (and also the order subroutine
130 my( $new, $old ) = ( shift, shift );
132 #return "Can't (yet?) change pkgpart!" if $old->pkgpart ne $new->pkgpart;
133 return "Can't change otaker!" if $old->otaker ne $new->otaker;
134 return "Can't change setup once it exists!"
135 if $old->getfield('setup') &&
136 $old->getfield('setup') != $new->getfield('setup');
137 #some logic for bill, susp, cancel?
139 $new->SUPER::replace($old);
144 Checks all fields to make sure this is a valid billing item. If there is an
145 error, returns the error, otherwise returns false. Called by the insert and
154 $self->ut_numbern('pkgnum')
155 || $self->ut_number('custnum')
156 || $self->ut_number('pkgpart')
157 || $self->ut_numbern('setup')
158 || $self->ut_numbern('bill')
159 || $self->ut_numbern('susp')
160 || $self->ut_numbern('cancel')
162 return $error if $error;
164 return "Unknown customer"
165 unless qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
167 return "Unknown pkgpart"
168 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
170 $self->otaker(getotaker) unless $self->otaker;
171 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
179 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
180 in this package, then cancels the package itself (sets the cancel field to
183 If there is an error, returns the error, otherwise returns false.
191 local $SIG{HUP} = 'IGNORE';
192 local $SIG{INT} = 'IGNORE';
193 local $SIG{QUIT} = 'IGNORE';
194 local $SIG{TERM} = 'IGNORE';
195 local $SIG{TSTP} = 'IGNORE';
197 foreach my $cust_svc (
198 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
200 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
202 $part_svc->svcdb =~ /^([\w\-]+)$/
203 or return "Illegal svcdb value in part_svc!";
205 require "FS/$svcdb.pm";
207 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
209 $error = $svc->cancel;
210 return "Error cancelling service: $error" if $error;
211 $error = $svc->delete;
212 return "Error deleting service: $error" if $error;
215 $error = $cust_svc->delete;
216 return "Error deleting cust_svc: $error" if $error;
220 unless ( $self->getfield('cancel') ) {
221 my %hash = $self->hash;
222 $hash{'cancel'} = $^T;
223 my $new = new FS::cust_pkg ( \%hash );
224 $error = $new->replace($self);
225 return $error if $error;
233 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
234 package, then suspends the package itself (sets the susp field to now).
236 If there is an error, returns the error, otherwise returns false.
244 local $SIG{HUP} = 'IGNORE';
245 local $SIG{INT} = 'IGNORE';
246 local $SIG{QUIT} = 'IGNORE';
247 local $SIG{TERM} = 'IGNORE';
248 local $SIG{TSTP} = 'IGNORE';
250 foreach my $cust_svc (
251 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
253 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
255 $part_svc->svcdb =~ /^([\w\-]+)$/
256 or return "Illegal svcdb value in part_svc!";
258 require "FS/$svcdb.pm";
260 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
262 $error = $svc->suspend;
263 return $error if $error;
268 unless ( $self->getfield('susp') ) {
269 my %hash = $self->hash;
271 my $new = new FS::cust_pkg ( \%hash );
272 $error = $new->replace($self);
273 return $error if $error;
281 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
282 package, then unsuspends the package itself (clears the susp field).
284 If there is an error, returns the error, otherwise returns false.
292 local $SIG{HUP} = 'IGNORE';
293 local $SIG{INT} = 'IGNORE';
294 local $SIG{QUIT} = 'IGNORE';
295 local $SIG{TERM} = 'IGNORE';
296 local $SIG{TSTP} = 'IGNORE';
298 foreach my $cust_svc (
299 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
301 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
303 $part_svc->svcdb =~ /^([\w\-]+)$/
304 or return "Illegal svcdb value in part_svc!";
306 require "FS/$svcdb.pm";
308 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
310 $error = $svc->unsuspend;
311 return $error if $error;
316 unless ( ! $self->getfield('susp') ) {
317 my %hash = $self->hash;
319 my $new = new FS::cust_pkg ( \%hash );
320 $error = $new->replace($self);
321 return $error if $error;
329 Returns the definition for this billing item, as an FS::part_pkg object (see
336 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
345 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF ]
347 CUSTNUM is a customer (see L<FS::cust_main>)
349 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
350 L<FS::part_pkg>) to order for this customer. Duplicates are of course
353 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
354 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
355 new billing items. An error is returned if this is not possible (see
361 my($custnum,$pkgparts,$remove_pkgnums)=@_;
365 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
366 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
367 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
370 foreach $type_pkgs ( qsearch('type_pkgs',{'typenum'=> $agent->typenum }) ) {
371 my($pkgpart)=$type_pkgs->pkgpart;
372 $part_pkg{$pkgpart}++;
378 # for those packages being removed:
379 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
380 # objects (table eq 'cust_svc')
382 foreach $pkgnum ( @{$remove_pkgnums} ) {
384 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
385 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
391 # for those packages the customer is purchasing:
392 # @{$pkgparts} is a list of said packages, by pkgpart
393 # @cust_svc is a corresponding list of lists of FS::Record objects
395 foreach $pkgpart ( @{$pkgparts} ) {
396 return "Customer not permitted to purchase pkgpart $pkgpart!"
397 unless $part_pkg{$pkgpart};
400 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
402 qsearchs('part_pkg',{'pkgpart'=>$pkgpart})->getfield('services')
407 #check for leftover services
408 foreach (keys %svcnum) {
409 next unless @{ $svcnum{$_} };
410 return "Leftover services!";
413 #no leftover services, let's make changes.
415 local $SIG{HUP} = 'IGNORE';
416 local $SIG{INT} = 'IGNORE';
417 local $SIG{QUIT} = 'IGNORE';
418 local $SIG{TERM} = 'IGNORE';
419 local $SIG{TSTP} = 'IGNORE';
421 #first cancel old packages
423 foreach $pkgnum ( @{$remove_pkgnums} ) {
424 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
425 return "Package $pkgnum not found to remove!" unless $old;
426 my(%hash) = $old->hash;
428 my($new) = create FS::cust_pkg ( \%hash );
429 my($error)=$new->replace($old);
430 return $error if $error;
433 #now add new packages, changing cust_svc records if necessary
435 while ($pkgpart=shift @{$pkgparts} ) {
437 my($new) = create FS::cust_pkg ( {
438 'custnum' => $custnum,
439 'pkgpart' => $pkgpart,
441 my($error) = $new->insert;
442 return $error if $error;
443 my($pkgnum)=$new->getfield('pkgnum');
446 foreach $cust_svc ( @{ shift @cust_svc } ) {
447 my(%hash) = $cust_svc->hash;
448 $hash{'pkgnum'}=$pkgnum;
449 my($new) = create FS::cust_svc ( \%hash );
450 my($error)=$new->replace($cust_svc);
451 return $error if $error;
462 $Id: cust_pkg.pm,v 1.4 1998-12-29 11:59:45 ivan Exp $
466 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
468 In sub order, the @pkgparts array (passed by reference) is clobbered.
470 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
471 method to pass dates to the recur_prog expression, it should do so.
473 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
474 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
475 cancel } because they use %FS::UID::callback to load configuration values.
476 Probably need a subroutine which decides what to do based on whether or not
477 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
481 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>
482 , L<FS::pkg_svc>, schema.html from the base documentation
486 ivan@voicenet.com 97-jul-1 - 21
488 fixed for new agent->agent_type->type_pkgs in &order ivan@sisd.com 98-mar-7
490 pod ivan@sisd.com 98-sep-21
492 $Log: cust_pkg.pm,v $
493 Revision 1.4 1998-12-29 11:59:45 ivan
494 mostly properly OO, some work still to be done with svc_ stuff
496 Revision 1.3 1998/11/15 13:01:35 ivan
497 allow pkgpart changing (for per-customer custom pricing). warn about it in doc
499 Revision 1.2 1998/11/12 03:42:45 ivan