5 use FS::UID qw( getotaker dbh );
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)
22 @ISA = qw( FS::Record );
26 my ( $hashref, $cache ) = @_;
27 #if ( $hashref->{'pkgpart'} ) {
28 if ( $hashref->{'pkg'} ) {
29 # #@{ $self->{'_pkgnum'} } = ();
30 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
31 # $self->{'_pkgpart'} = $subcache;
32 # #push @{ $self->{'_pkgnum'} },
33 # FS::part_pkg->new_or_cached($hashref, $subcache);
34 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
36 if ( exists $hashref->{'svcnum'} ) {
37 #@{ $self->{'_pkgnum'} } = ();
38 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
39 $self->{'_svcnum'} = $subcache;
40 #push @{ $self->{'_pkgnum'} },
41 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
47 FS::cust_pkg - Object methods for cust_pkg objects
53 $record = new FS::cust_pkg \%hash;
54 $record = new FS::cust_pkg { 'column' => 'value' };
56 $error = $record->insert;
58 $error = $new_record->replace($old_record);
60 $error = $record->delete;
62 $error = $record->check;
64 $error = $record->cancel;
66 $error = $record->suspend;
68 $error = $record->unsuspend;
70 $part_pkg = $record->part_pkg;
72 @labels = $record->labels;
74 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
75 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
79 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
80 inherits from FS::Record. The following fields are currently supported:
84 =item pkgnum - primary key (assigned automatically for new billing items)
86 =item custnum - Customer (see L<FS::cust_main>)
88 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
100 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
102 =item manual_flag - If this field is set to 1, disables the automatic
103 unsuspension of this package when using the B<unsuspendauto> config file.
107 Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
108 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
109 conversion functions.
117 Create a new billing item. To add the item to the database, see L<"insert">.
121 sub table { 'cust_pkg'; }
125 Adds this billing item to the database ("Orders" the item). If there is an
126 error, returns the error, otherwise returns false.
133 # custnum might not have have been defined in sub check (for one-shot new
134 # customers), so check it here instead
135 # (is this still necessary with transactions?)
137 my $error = $self->ut_number('custnum');
138 return $error if $error;
140 return "Unknown customer ". $self->custnum unless $self->cust_main;
142 $self->SUPER::insert;
148 This method now works but you probably shouldn't use it.
150 You don't want to delete billing items, because there would then be no record
151 the customer ever purchased the item. Instead, see the cancel method.
156 # return "Can't delete cust_pkg records!";
159 =item replace OLD_RECORD
161 Replaces the OLD_RECORD with this one in the database. If there is an error,
162 returns the error, otherwise returns false.
164 Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
166 Changing pkgpart may have disasterous effects. See the order subroutine.
168 setup and bill are normally updated by calling the bill method of a customer
169 object (see L<FS::cust_main>).
171 suspend is normally updated by the suspend and unsuspend methods.
173 cancel is normally updated by the cancel method (and also the order subroutine
179 my( $new, $old ) = ( shift, shift );
181 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
182 return "Can't change otaker!" if $old->otaker ne $new->otaker;
185 #return "Can't change setup once it exists!"
186 # if $old->getfield('setup') &&
187 # $old->getfield('setup') != $new->getfield('setup');
189 #some logic for bill, susp, cancel?
191 $new->SUPER::replace($old);
196 Checks all fields to make sure this is a valid billing item. If there is an
197 error, returns the error, otherwise returns false. Called by the insert and
206 $self->ut_numbern('pkgnum')
207 || $self->ut_numbern('custnum')
208 || $self->ut_number('pkgpart')
209 || $self->ut_numbern('setup')
210 || $self->ut_numbern('bill')
211 || $self->ut_numbern('susp')
212 || $self->ut_numbern('cancel')
214 return $error if $error;
216 if ( $self->custnum ) {
217 return "Unknown customer ". $self->custnum unless $self->cust_main;
220 return "Unknown pkgpart"
221 unless qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
223 $self->otaker(getotaker) unless $self->otaker;
224 $self->otaker =~ /^(\w{0,16})$/ or return "Illegal otaker";
227 if ( $self->dbdef_table->column('manual_flag') ) {
228 $self->manual_flag =~ /^([01]?)$/ or return "Illegal manual_flag";
229 $self->manual_flag($1);
237 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
238 in this package, then cancels the package itself (sets the cancel field to
241 If there is an error, returns the error, otherwise returns false.
249 local $SIG{HUP} = 'IGNORE';
250 local $SIG{INT} = 'IGNORE';
251 local $SIG{QUIT} = 'IGNORE';
252 local $SIG{TERM} = 'IGNORE';
253 local $SIG{TSTP} = 'IGNORE';
254 local $SIG{PIPE} = 'IGNORE';
256 my $oldAutoCommit = $FS::UID::AutoCommit;
257 local $FS::UID::AutoCommit = 0;
260 foreach my $cust_svc (
261 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
263 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
265 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
266 $dbh->rollback if $oldAutoCommit;
267 return "Illegal svcdb value in part_svc!";
270 require "FS/$svcdb.pm";
272 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
274 $error = $svc->cancel;
276 $dbh->rollback if $oldAutoCommit;
277 return "Error cancelling service: $error"
279 $error = $svc->delete;
281 $dbh->rollback if $oldAutoCommit;
282 return "Error deleting service: $error";
286 $error = $cust_svc->delete;
288 $dbh->rollback if $oldAutoCommit;
289 return "Error deleting cust_svc: $error";
294 unless ( $self->getfield('cancel') ) {
295 my %hash = $self->hash;
296 $hash{'cancel'} = time;
297 my $new = new FS::cust_pkg ( \%hash );
298 $error = $new->replace($self);
300 $dbh->rollback if $oldAutoCommit;
305 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
312 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
313 package, then suspends the package itself (sets the susp field to now).
315 If there is an error, returns the error, otherwise returns false.
323 local $SIG{HUP} = 'IGNORE';
324 local $SIG{INT} = 'IGNORE';
325 local $SIG{QUIT} = 'IGNORE';
326 local $SIG{TERM} = 'IGNORE';
327 local $SIG{TSTP} = 'IGNORE';
328 local $SIG{PIPE} = 'IGNORE';
330 my $oldAutoCommit = $FS::UID::AutoCommit;
331 local $FS::UID::AutoCommit = 0;
334 foreach my $cust_svc (
335 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
337 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
339 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
340 $dbh->rollback if $oldAutoCommit;
341 return "Illegal svcdb value in part_svc!";
344 require "FS/$svcdb.pm";
346 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
348 $error = $svc->suspend;
350 $dbh->rollback if $oldAutoCommit;
357 unless ( $self->getfield('susp') ) {
358 my %hash = $self->hash;
359 $hash{'susp'} = time;
360 my $new = new FS::cust_pkg ( \%hash );
361 $error = $new->replace($self);
363 $dbh->rollback if $oldAutoCommit;
368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
375 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
376 package, then unsuspends the package itself (clears the susp field).
378 If there is an error, returns the error, otherwise returns false.
386 local $SIG{HUP} = 'IGNORE';
387 local $SIG{INT} = 'IGNORE';
388 local $SIG{QUIT} = 'IGNORE';
389 local $SIG{TERM} = 'IGNORE';
390 local $SIG{TSTP} = 'IGNORE';
391 local $SIG{PIPE} = 'IGNORE';
393 my $oldAutoCommit = $FS::UID::AutoCommit;
394 local $FS::UID::AutoCommit = 0;
397 foreach my $cust_svc (
398 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
400 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
402 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
403 $dbh->rollback if $oldAutoCommit;
404 return "Illegal svcdb value in part_svc!";
407 require "FS/$svcdb.pm";
409 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
411 $error = $svc->unsuspend;
413 $dbh->rollback if $oldAutoCommit;
420 unless ( ! $self->getfield('susp') ) {
421 my %hash = $self->hash;
423 my $new = new FS::cust_pkg ( \%hash );
424 $error = $new->replace($self);
426 $dbh->rollback if $oldAutoCommit;
431 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
438 Returns the definition for this billing item, as an FS::part_pkg object (see
445 #exists( $self->{'_pkgpart'} )
447 ? $self->{'_pkgpart'}
448 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
453 Returns the services for this package, as FS::cust_svc objects (see
460 if ( $self->{'_svcnum'} ) {
461 values %{ $self->{'_svcnum'}->cache };
463 qsearch ( 'cust_svc', { 'pkgnum' => $self->pkgnum } );
469 Returns a list of lists, calling the label method for all services
470 (see L<FS::cust_svc>) of this billing item.
476 map { [ $_->label ] } $self->cust_svc;
481 Returns the parent customer object (see L<FS::cust_main>).
487 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
496 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
498 CUSTNUM is a customer (see L<FS::cust_main>)
500 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
501 L<FS::part_pkg>) to order for this customer. Duplicates are of course
504 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
505 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
506 new billing items. An error is returned if this is not possible (see
507 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
510 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
511 newly-created cust_pkg objects.
516 my($custnum, $pkgparts, $remove_pkgnums, $return_cust_pkg) = @_;
517 $remove_pkgnums = [] unless defined($remove_pkgnums);
519 my $oldAutoCommit = $FS::UID::AutoCommit;
520 local $FS::UID::AutoCommit = 0;
524 # $part_pkg{$pkgpart} is true iff $custnum may purchase $pkgpart
526 my($cust_main)=qsearchs('cust_main',{'custnum'=>$custnum});
527 my($agent)=qsearchs('agent',{'agentnum'=> $cust_main->agentnum });
528 my %part_pkg = %{ $agent->pkgpart_hashref };
532 # for those packages being removed:
533 #@{ $svcnum{$svcpart} } goes from a svcpart to a list of FS::Record
534 # objects (table eq 'cust_svc')
536 foreach $pkgnum ( @{$remove_pkgnums} ) {
538 foreach $cust_svc (qsearch('cust_svc',{'pkgnum'=>$pkgnum})) {
539 push @{ $svcnum{$cust_svc->getfield('svcpart')} }, $cust_svc;
545 # for those packages the customer is purchasing:
546 # @{$pkgparts} is a list of said packages, by pkgpart
547 # @cust_svc is a corresponding list of lists of FS::Record objects
549 foreach $pkgpart ( @{$pkgparts} ) {
550 unless ( $part_pkg{$pkgpart} ) {
551 $dbh->rollback if $oldAutoCommit;
552 return "Customer not permitted to purchase pkgpart $pkgpart!";
556 ( $svcnum{$_} && @{ $svcnum{$_} } ) ? shift @{ $svcnum{$_} } : ();
557 } map { $_->svcpart } qsearch('pkg_svc', { 'pkgpart' => $pkgpart })
561 #check for leftover services
562 foreach (keys %svcnum) {
563 next unless @{ $svcnum{$_} };
564 $dbh->rollback if $oldAutoCommit;
565 return "Leftover services, svcpart $_: svcnum ".
566 join(', ', map { $_->svcnum } @{ $svcnum{$_} } );
569 #no leftover services, let's make changes.
571 local $SIG{HUP} = 'IGNORE';
572 local $SIG{INT} = 'IGNORE';
573 local $SIG{QUIT} = 'IGNORE';
574 local $SIG{TERM} = 'IGNORE';
575 local $SIG{TSTP} = 'IGNORE';
576 local $SIG{PIPE} = 'IGNORE';
578 #first cancel old packages
580 foreach $pkgnum ( @{$remove_pkgnums} ) {
581 my($old) = qsearchs('cust_pkg',{'pkgnum'=>$pkgnum});
583 $dbh->rollback if $oldAutoCommit;
584 return "Package $pkgnum not found to remove!";
586 my(%hash) = $old->hash;
587 $hash{'cancel'}=time;
588 my($new) = new FS::cust_pkg ( \%hash );
589 my($error)=$new->replace($old);
591 $dbh->rollback if $oldAutoCommit;
592 return "Couldn't update package $pkgnum: $error";
596 #now add new packages, changing cust_svc records if necessary
598 while ($pkgpart=shift @{$pkgparts} ) {
600 my $new = new FS::cust_pkg {
601 'custnum' => $custnum,
602 'pkgpart' => $pkgpart,
604 my $error = $new->insert;
606 $dbh->rollback if $oldAutoCommit;
607 return "Couldn't insert new cust_pkg record: $error";
609 push @{$return_cust_pkg}, $new if $return_cust_pkg;
610 my $pkgnum = $new->pkgnum;
612 foreach my $cust_svc ( @{ shift @cust_svc } ) {
613 my(%hash) = $cust_svc->hash;
614 $hash{'pkgnum'}=$pkgnum;
615 my($new) = new FS::cust_svc ( \%hash );
616 my($error)=$new->replace($cust_svc);
618 $dbh->rollback if $oldAutoCommit;
619 return "Couldn't link old service to new package: $error";
624 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
633 $Id: cust_pkg.pm,v 1.15 2002-01-21 11:30:17 ivan Exp $
637 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
639 In sub order, the @pkgparts array (passed by reference) is clobbered.
641 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
642 method to pass dates to the recur_prog expression, it should do so.
644 FS::svc_acct, FS::svc_acct_sm, and FS::svc_domain are loaded via 'use' at
645 compile time, rather than via 'require' in sub { setup, suspend, unsuspend,
646 cancel } because they use %FS::UID::callback to load configuration values.
647 Probably need a subroutine which decides what to do based on whether or not
648 we've fetched the user yet, rather than a hash. See FS::UID and the TODO.
650 Now that things are transactional should the check in the insert method be
655 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
656 L<FS::pkg_svc>, schema.html from the base documentation