4 use vars qw(@ISA $disable_agentcheck $DEBUG);
5 use List::Util qw(max);
7 use FS::UID qw( getotaker dbh );
8 use FS::Misc qw( send_email );
9 use FS::Record qw( qsearch qsearchs );
10 use FS::cust_main_Mixin;
16 use FS::cust_bill_pkg;
17 use FS::cust_pkg_detail;
21 use FS::cust_pkg_reason;
25 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
27 # because they load configuration by setting FS::UID::callback (see TODO)
33 # for sending cancel emails in sub cancel
36 @ISA = qw( FS::cust_main_Mixin FS::option_Common FS::Record );
40 $disable_agentcheck = 0;
44 my ( $hashref, $cache ) = @_;
45 #if ( $hashref->{'pkgpart'} ) {
46 if ( $hashref->{'pkg'} ) {
47 # #@{ $self->{'_pkgnum'} } = ();
48 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
49 # $self->{'_pkgpart'} = $subcache;
50 # #push @{ $self->{'_pkgnum'} },
51 # FS::part_pkg->new_or_cached($hashref, $subcache);
52 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
54 if ( exists $hashref->{'svcnum'} ) {
55 #@{ $self->{'_pkgnum'} } = ();
56 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
57 $self->{'_svcnum'} = $subcache;
58 #push @{ $self->{'_pkgnum'} },
59 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
65 FS::cust_pkg - Object methods for cust_pkg objects
71 $record = new FS::cust_pkg \%hash;
72 $record = new FS::cust_pkg { 'column' => 'value' };
74 $error = $record->insert;
76 $error = $new_record->replace($old_record);
78 $error = $record->delete;
80 $error = $record->check;
82 $error = $record->cancel;
84 $error = $record->suspend;
86 $error = $record->unsuspend;
88 $part_pkg = $record->part_pkg;
90 @labels = $record->labels;
92 $seconds = $record->seconds_since($timestamp);
94 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
95 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
99 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
100 inherits from FS::Record. The following fields are currently supported:
104 =item pkgnum - primary key (assigned automatically for new billing items)
106 =item custnum - Customer (see L<FS::cust_main>)
108 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
112 =item bill - date (next bill date)
114 =item last_bill - last bill date
124 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
126 =item manual_flag - If this field is set to 1, disables the automatic
127 unsuspension of this package when using the B<unsuspendauto> config file.
129 =item quantity - If not set, defaults to 1
133 Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
134 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
135 conversion functions.
143 Create a new billing item. To add the item to the database, see L<"insert">.
147 sub table { 'cust_pkg'; }
148 sub cust_linked { $_[0]->cust_main_custnum; }
149 sub cust_unlinked_msg {
151 "WARNING: can't find cust_main.custnum ". $self->custnum.
152 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
155 =item insert [ OPTION => VALUE ... ]
157 Adds this billing item to the database ("Orders" the item). If there is an
158 error, returns the error, otherwise returns false.
160 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
161 will be used to look up the package definition and agent restrictions will be
164 The following options are available: I<change>
166 I<change>, if set true, supresses any referral credit to a referring customer.
171 my( $self, %options ) = @_;
173 local $SIG{HUP} = 'IGNORE';
174 local $SIG{INT} = 'IGNORE';
175 local $SIG{QUIT} = 'IGNORE';
176 local $SIG{TERM} = 'IGNORE';
177 local $SIG{TSTP} = 'IGNORE';
178 local $SIG{PIPE} = 'IGNORE';
180 my $oldAutoCommit = $FS::UID::AutoCommit;
181 local $FS::UID::AutoCommit = 0;
184 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
186 $dbh->rollback if $oldAutoCommit;
190 #if ( $self->reg_code ) {
191 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
192 # $error = $reg_code->delete;
194 # $dbh->rollback if $oldAutoCommit;
199 my $conf = new FS::Conf;
200 my $cust_main = $self->cust_main;
201 my $part_pkg = $self->part_pkg;
202 if ( $conf->exists('referral_credit')
203 && $cust_main->referral_custnum
204 && ! $options{'change'}
205 && $part_pkg->freq !~ /^0\D?$/
208 my $referring_cust_main = $cust_main->referring_cust_main;
209 if ( $referring_cust_main->status ne 'cancelled' ) {
211 if ( $part_pkg->freq !~ /^\d+$/ ) {
212 warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
213 ' for package '. $self->pkgnum.
214 ' ( customer '. $self->custnum. ')'.
215 ' - One-time referral credits not (yet) available for '.
216 ' packages with '. $part_pkg->freq_pretty. ' frequency';
219 my $amount = sprintf( "%.2f", $part_pkg->base_recur($self) / $part_pkg->freq );
221 $referring_cust_main->
223 'Referral credit for '.$cust_main->name,
224 'reason_type' => $conf->config('referral_credit_type')
227 $dbh->rollback if $oldAutoCommit;
228 return "Error crediting customer ". $cust_main->referral_custnum.
229 " for referral: $error";
237 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
238 my $queue = new FS::queue {
239 'job' => 'FS::cust_main::queueable_print',
241 $error = $queue->insert(
242 'custnum' => $self->custnum,
243 'template' => 'welcome_letter',
247 warn "can't send welcome letter: $error";
252 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
259 This method now works but you probably shouldn't use it.
261 You don't want to delete billing items, because there would then be no record
262 the customer ever purchased the item. Instead, see the cancel method.
267 # return "Can't delete cust_pkg records!";
270 =item replace OLD_RECORD
272 Replaces the OLD_RECORD with this one in the database. If there is an error,
273 returns the error, otherwise returns false.
275 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
277 Changing pkgpart may have disasterous effects. See the order subroutine.
279 setup and bill are normally updated by calling the bill method of a customer
280 object (see L<FS::cust_main>).
282 suspend is normally updated by the suspend and unsuspend methods.
284 cancel is normally updated by the cancel method (and also the order subroutine
290 my( $new, $old, %options ) = @_;
292 # We absolutely have to have an old vs. new record to make this work.
293 if (!defined($old)) {
294 $old = qsearchs( 'cust_pkg', { 'pkgnum' => $new->pkgnum } );
296 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
297 return "Can't change otaker!" if $old->otaker ne $new->otaker;
300 #return "Can't change setup once it exists!"
301 # if $old->getfield('setup') &&
302 # $old->getfield('setup') != $new->getfield('setup');
304 #some logic for bill, susp, cancel?
306 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
308 local $SIG{HUP} = 'IGNORE';
309 local $SIG{INT} = 'IGNORE';
310 local $SIG{QUIT} = 'IGNORE';
311 local $SIG{TERM} = 'IGNORE';
312 local $SIG{TSTP} = 'IGNORE';
313 local $SIG{PIPE} = 'IGNORE';
315 my $oldAutoCommit = $FS::UID::AutoCommit;
316 local $FS::UID::AutoCommit = 0;
319 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
320 if ($options{'reason'} && $new->$method && $old->$method ne $new->$method) {
321 my $error = $new->insert_reason(
322 'reason' => $options{'reason'},
323 'date' => $new->$method,
325 'reason_otaker' => $options{'reason_otaker'},
328 dbh->rollback if $oldAutoCommit;
329 return "Error inserting cust_pkg_reason: $error";
334 #save off and freeze RADIUS attributes for any associated svc_acct records
336 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
338 #also check for specific exports?
339 # to avoid spurious modify export events
340 @svc_acct = map { $_->svc_x }
341 grep { $_->part_svc->svcdb eq 'svc_acct' }
344 $_->snapshot foreach @svc_acct;
348 my $error = $new->SUPER::replace($old,
349 $options{options} ? ${options{options}} : ()
352 $dbh->rollback if $oldAutoCommit;
356 #for prepaid packages,
357 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
358 foreach my $old_svc_acct ( @svc_acct ) {
359 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
360 my $s_error = $new_svc_acct->replace($old_svc_acct);
362 $dbh->rollback if $oldAutoCommit;
367 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
374 Checks all fields to make sure this is a valid billing item. If there is an
375 error, returns the error, otherwise returns false. Called by the insert and
384 $self->ut_numbern('pkgnum')
385 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
386 || $self->ut_numbern('pkgpart')
387 || $self->ut_numbern('setup')
388 || $self->ut_numbern('bill')
389 || $self->ut_numbern('susp')
390 || $self->ut_numbern('cancel')
391 || $self->ut_numbern('adjourn')
392 || $self->ut_numbern('expire')
394 return $error if $error;
396 if ( $self->reg_code ) {
398 unless ( grep { $self->pkgpart == $_->pkgpart }
399 map { $_->reg_code_pkg }
400 qsearchs( 'reg_code', { 'code' => $self->reg_code,
401 'agentnum' => $self->cust_main->agentnum })
403 return "Unknown registration code";
406 } elsif ( $self->promo_code ) {
409 qsearchs('part_pkg', {
410 'pkgpart' => $self->pkgpart,
411 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
413 return 'Unknown promotional code' unless $promo_part_pkg;
417 unless ( $disable_agentcheck ) {
419 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
420 my $pkgpart_href = $agent->pkgpart_hashref;
421 return "agent ". $agent->agentnum.
422 " can't purchase pkgpart ". $self->pkgpart
423 unless $pkgpart_href->{ $self->pkgpart };
426 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
427 return $error if $error;
431 $self->otaker(getotaker) unless $self->otaker;
432 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
435 if ( $self->dbdef_table->column('manual_flag') ) {
436 $self->manual_flag('') if $self->manual_flag eq ' ';
437 $self->manual_flag =~ /^([01]?)$/
438 or return "Illegal manual_flag ". $self->manual_flag;
439 $self->manual_flag($1);
445 =item cancel [ OPTION => VALUE ... ]
447 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
448 in this package, then cancels the package itself (sets the cancel field to
451 Available options are: I<quiet> I<reason> I<date>
453 I<quiet> can be set true to supress email cancellation notices.
454 I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action
455 I<date> can be set to a unix style timestamp to specify when to cancel (expire)
457 If there is an error, returns the error, otherwise returns false.
462 my( $self, %options ) = @_;
465 local $SIG{HUP} = 'IGNORE';
466 local $SIG{INT} = 'IGNORE';
467 local $SIG{QUIT} = 'IGNORE';
468 local $SIG{TERM} = 'IGNORE';
469 local $SIG{TSTP} = 'IGNORE';
470 local $SIG{PIPE} = 'IGNORE';
472 my $oldAutoCommit = $FS::UID::AutoCommit;
473 local $FS::UID::AutoCommit = 0;
476 my $old = $self->select_for_update;
478 if ( $old->get('cancel') || $self->get('cancel') ) {
479 dbh->rollback if $oldAutoCommit;
480 return ""; # no error
483 my $date = $options{date} if $options{date}; # expire/cancel later
484 $date = '' if ($date && $date <= time); # complain instead?
486 my $cancel_time = $options{'time'} || time;
488 if ($options{'reason'}) {
489 $error = $self->insert_reason( 'reason' => $options{'reason'},
490 'action' => $date ? 'expire' : 'cancel',
491 'date' => $date ? $date : $cancel_time,
492 'reason_otaker' => $options{'reason_otaker'},
495 dbh->rollback if $oldAutoCommit;
496 return "Error inserting cust_pkg_reason: $error";
502 foreach my $cust_svc (
505 sort { $a->[1] <=> $b->[1] }
506 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
507 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
510 my $error = $cust_svc->cancel;
513 $dbh->rollback if $oldAutoCommit;
514 return "Error cancelling cust_svc: $error";
518 # Add a credit for remaining service
519 my $remaining_value = $self->calc_remain();
520 if ( $remaining_value > 0 ) {
521 my $conf = new FS::Conf;
522 my $error = $self->cust_main->credit(
524 'Credit for unused time on '. $self->part_pkg->pkg,
525 'reason_type' => $conf->config('cancel_credit_type'),
528 $dbh->rollback if $oldAutoCommit;
529 return "Error crediting customer \$$remaining_value for unused time on".
530 $self->part_pkg->pkg. ": $error";
535 my %hash = $self->hash;
536 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
537 my $new = new FS::cust_pkg ( \%hash );
538 $error = $new->replace( $self, options => { $self->options } );
540 $dbh->rollback if $oldAutoCommit;
544 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
545 return '' if $date; #no errors
547 my $conf = new FS::Conf;
548 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
549 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
550 my $conf = new FS::Conf;
551 my $error = send_email(
552 'from' => $conf->config('invoice_from'),
553 'to' => \@invoicing_list,
554 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
555 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
557 #should this do something on errors?
566 Cancels any pending expiration (sets the expire field to null).
568 If there is an error, returns the error, otherwise returns false.
573 my( $self, %options ) = @_;
576 local $SIG{HUP} = 'IGNORE';
577 local $SIG{INT} = 'IGNORE';
578 local $SIG{QUIT} = 'IGNORE';
579 local $SIG{TERM} = 'IGNORE';
580 local $SIG{TSTP} = 'IGNORE';
581 local $SIG{PIPE} = 'IGNORE';
583 my $oldAutoCommit = $FS::UID::AutoCommit;
584 local $FS::UID::AutoCommit = 0;
587 my $old = $self->select_for_update;
589 my $pkgnum = $old->pkgnum;
590 if ( $old->get('cancel') || $self->get('cancel') ) {
591 dbh->rollback if $oldAutoCommit;
592 return "Can't unexpire cancelled package $pkgnum";
593 # or at least it's pointless
596 unless ( $old->get('expire') && $self->get('expire') ) {
597 dbh->rollback if $oldAutoCommit;
598 return ""; # no error
601 my %hash = $self->hash;
602 $hash{'expire'} = '';
603 my $new = new FS::cust_pkg ( \%hash );
604 $error = $new->replace( $self, options => { $self->options } );
606 $dbh->rollback if $oldAutoCommit;
610 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
616 =item suspend [ OPTION => VALUE ... ]
618 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
619 package, then suspends the package itself (sets the susp field to now).
621 Available options are: I<reason> I<date>
623 I<date> can be set to a unix style timestamp to specify when to suspend (adjourn)
624 I<reason> can be set to a reasonnum (see L<FS::reason>) explaining the action
626 If there is an error, returns the error, otherwise returns false.
631 my( $self, %options ) = @_;
634 local $SIG{HUP} = 'IGNORE';
635 local $SIG{INT} = 'IGNORE';
636 local $SIG{QUIT} = 'IGNORE';
637 local $SIG{TERM} = 'IGNORE';
638 local $SIG{TSTP} = 'IGNORE';
639 local $SIG{PIPE} = 'IGNORE';
641 my $oldAutoCommit = $FS::UID::AutoCommit;
642 local $FS::UID::AutoCommit = 0;
645 my $old = $self->select_for_update;
647 my $pkgnum = $old->pkgnum;
648 if ( $old->get('cancel') || $self->get('cancel') ) {
649 dbh->rollback if $oldAutoCommit;
650 return "Can't suspend cancelled package $pkgnum";
653 if ( $old->get('susp') || $self->get('susp') ) {
654 dbh->rollback if $oldAutoCommit;
655 return ""; # no error # complain on adjourn?
658 my $date = $options{date} if $options{date}; # adjourn/suspend later
659 $date = '' if ($date && $date <= time); # complain instead?
661 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
662 dbh->rollback if $oldAutoCommit;
663 return "Package $pkgnum expires before it would be suspended.";
666 my $suspend_time = $options{'time'} || time;
668 if ($options{'reason'}) {
669 $error = $self->insert_reason( 'reason' => $options{'reason'},
670 'action' => $date ? 'adjourn' : 'suspend',
671 'date' => $date ? $date : $suspend_time,
672 'reason_otaker' => $options{'reason_otaker'},
675 dbh->rollback if $oldAutoCommit;
676 return "Error inserting cust_pkg_reason: $error";
684 foreach my $cust_svc (
685 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
687 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
689 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
690 $dbh->rollback if $oldAutoCommit;
691 return "Illegal svcdb value in part_svc!";
694 require "FS/$svcdb.pm";
696 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
698 $error = $svc->suspend;
700 $dbh->rollback if $oldAutoCommit;
703 my( $label, $value ) = $cust_svc->label;
704 push @labels, "$label: $value";
708 my $conf = new FS::Conf;
709 if ( $conf->config('suspend_email_admin') ) {
711 my $error = send_email(
712 'from' => $conf->config('invoice_from'), #??? well as good as any
713 'to' => $conf->config('suspend_email_admin'),
714 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
716 "This is an automatic message from your Freeside installation\n",
717 "informing you that the following customer package has been suspended:\n",
719 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
720 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
721 ( map { "Service : $_\n" } @labels ),
726 warn "WARNING: can't send suspension admin email (suspending anyway): ".
734 my %hash = $self->hash;
736 $hash{'adjourn'} = $date;
738 $hash{'susp'} = $suspend_time;
740 my $new = new FS::cust_pkg ( \%hash );
741 $error = $new->replace( $self, options => { $self->options } );
743 $dbh->rollback if $oldAutoCommit;
747 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
752 =item unsuspend [ OPTION => VALUE ... ]
754 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
755 package, then unsuspends the package itself (clears the susp field and the
756 adjourn field if it is in the past).
758 Available options are: I<adjust_next_bill>.
760 I<adjust_next_bill> can be set true to adjust the next bill date forward by
761 the amount of time the account was inactive. This was set true by default
762 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
763 explicitly requested. Price plans for which this makes sense (anniversary-date
764 based than prorate or subscription) could have an option to enable this
767 If there is an error, returns the error, otherwise returns false.
772 my( $self, %opt ) = @_;
775 local $SIG{HUP} = 'IGNORE';
776 local $SIG{INT} = 'IGNORE';
777 local $SIG{QUIT} = 'IGNORE';
778 local $SIG{TERM} = 'IGNORE';
779 local $SIG{TSTP} = 'IGNORE';
780 local $SIG{PIPE} = 'IGNORE';
782 my $oldAutoCommit = $FS::UID::AutoCommit;
783 local $FS::UID::AutoCommit = 0;
786 my $old = $self->select_for_update;
788 my $pkgnum = $old->pkgnum;
789 if ( $old->get('cancel') || $self->get('cancel') ) {
790 dbh->rollback if $oldAutoCommit;
791 return "Can't unsuspend cancelled package $pkgnum";
794 unless ( $old->get('susp') && $self->get('susp') ) {
795 dbh->rollback if $oldAutoCommit;
796 return ""; # no error # complain instead?
799 foreach my $cust_svc (
800 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
802 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
804 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
805 $dbh->rollback if $oldAutoCommit;
806 return "Illegal svcdb value in part_svc!";
809 require "FS/$svcdb.pm";
811 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
813 $error = $svc->unsuspend;
815 $dbh->rollback if $oldAutoCommit;
822 my %hash = $self->hash;
823 my $inactive = time - $hash{'susp'};
825 my $conf = new FS::Conf;
827 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
828 if ( $opt{'adjust_next_bill'}
829 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
830 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
833 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
834 my $new = new FS::cust_pkg ( \%hash );
835 $error = $new->replace( $self, options => { $self->options } );
837 $dbh->rollback if $oldAutoCommit;
841 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
848 Cancels any pending suspension (sets the adjourn field to null).
850 If there is an error, returns the error, otherwise returns false.
855 my( $self, %options ) = @_;
858 local $SIG{HUP} = 'IGNORE';
859 local $SIG{INT} = 'IGNORE';
860 local $SIG{QUIT} = 'IGNORE';
861 local $SIG{TERM} = 'IGNORE';
862 local $SIG{TSTP} = 'IGNORE';
863 local $SIG{PIPE} = 'IGNORE';
865 my $oldAutoCommit = $FS::UID::AutoCommit;
866 local $FS::UID::AutoCommit = 0;
869 my $old = $self->select_for_update;
871 my $pkgnum = $old->pkgnum;
872 if ( $old->get('cancel') || $self->get('cancel') ) {
873 dbh->rollback if $oldAutoCommit;
874 return "Can't unadjourn cancelled package $pkgnum";
875 # or at least it's pointless
878 if ( $old->get('susp') || $self->get('susp') ) {
879 dbh->rollback if $oldAutoCommit;
880 return "Can't unadjourn suspended package $pkgnum";
881 # perhaps this is arbitrary
884 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
885 dbh->rollback if $oldAutoCommit;
886 return ""; # no error
889 my %hash = $self->hash;
890 $hash{'adjourn'} = '';
891 my $new = new FS::cust_pkg ( \%hash );
892 $error = $new->replace( $self, options => { $self->options } );
894 $dbh->rollback if $oldAutoCommit;
898 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
906 Returns the last bill date, or if there is no last bill date, the setup date.
907 Useful for billing metered services.
913 if ( $self->dbdef_table->column('last_bill') ) {
914 return $self->setfield('last_bill', $_[0]) if @_;
915 return $self->getfield('last_bill') if $self->getfield('last_bill');
917 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
918 'edate' => $self->bill, } );
919 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
922 =item last_cust_pkg_reason ACTION
924 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
925 Returns false if there is no reason or the package is not currenly ACTION'd
926 ACTION is one of adjourn, susp, cancel, or expire.
930 sub last_cust_pkg_reason {
931 my ( $self, $action ) = ( shift, shift );
932 my $date = $self->get($action);
934 'table' => 'cust_pkg_reason',
935 'hashref' => { 'pkgnum' => $self->pkgnum,
936 'action' => substr(uc($action), 0, 1),
939 'order_by' => 'ORDER BY num DESC LIMIT 1',
943 =item last_reason ACTION
945 Returns the most recent ACTION FS::reason associated with the package.
946 Returns false if there is no reason or the package is not currenly ACTION'd
947 ACTION is one of adjourn, susp, cancel, or expire.
952 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
953 $cust_pkg_reason->reason
959 Returns the definition for this billing item, as an FS::part_pkg object (see
966 #exists( $self->{'_pkgpart'} )
968 ? $self->{'_pkgpart'}
969 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
974 Returns the cancelled package this package was changed from, if any.
980 return '' unless $self->change_pkgnum;
981 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
986 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
993 $self->part_pkg->calc_setup($self, @_);
998 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1005 $self->part_pkg->calc_recur($self, @_);
1010 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1017 $self->part_pkg->calc_remain($self, @_);
1022 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1029 $self->part_pkg->calc_cancel($self, @_);
1034 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1040 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1043 =item cust_pkg_detail [ DETAILTYPE ]
1045 Returns any customer package details for this package (see
1046 L<FS::cust_pkg_detail>).
1048 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1052 sub cust_pkg_detail {
1054 my %hash = ( 'pkgnum' => $self->pkgnum );
1055 $hash{detailtype} = shift if @_;
1057 'table' => 'cust_pkg_detail',
1058 'hashref' => \%hash,
1059 'order_by' => 'ORDER BY weight, pkgdetailnum',
1063 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1065 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1067 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1069 If there is an error, returns the error, otherwise returns false.
1073 sub set_cust_pkg_detail {
1074 my( $self, $detailtype, @details ) = @_;
1076 local $SIG{HUP} = 'IGNORE';
1077 local $SIG{INT} = 'IGNORE';
1078 local $SIG{QUIT} = 'IGNORE';
1079 local $SIG{TERM} = 'IGNORE';
1080 local $SIG{TSTP} = 'IGNORE';
1081 local $SIG{PIPE} = 'IGNORE';
1083 my $oldAutoCommit = $FS::UID::AutoCommit;
1084 local $FS::UID::AutoCommit = 0;
1087 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1088 my $error = $current->delete;
1090 $dbh->rollback if $oldAutoCommit;
1091 return "error removing old detail: $error";
1095 foreach my $detail ( @details ) {
1096 my $cust_pkg_detail = new FS::cust_pkg_detail {
1097 'pkgnum' => $self->pkgnum,
1098 'detailtype' => $detailtype,
1099 'detail' => $detail,
1101 my $error = $cust_pkg_detail->insert;
1103 $dbh->rollback if $oldAutoCommit;
1104 return "error adding new detail: $error";
1109 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1114 =item cust_svc [ SVCPART ]
1116 Returns the services for this package, as FS::cust_svc objects (see
1117 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1126 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1127 'svcpart' => shift, } );
1130 #if ( $self->{'_svcnum'} ) {
1131 # values %{ $self->{'_svcnum'}->cache };
1133 $self->_sort_cust_svc(
1134 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1140 =item overlimit [ SVCPART ]
1142 Returns the services for this package which have exceeded their
1143 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1144 is specified, return only the matching services.
1150 grep { $_->overlimit } $self->cust_svc;
1153 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1155 Returns historical services for this package created before END TIMESTAMP and
1156 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1157 (see L<FS::h_cust_svc>).
1164 $self->_sort_cust_svc(
1165 [ qsearch( 'h_cust_svc',
1166 { 'pkgnum' => $self->pkgnum, },
1167 FS::h_cust_svc->sql_h_search(@_),
1173 sub _sort_cust_svc {
1174 my( $self, $arrayref ) = @_;
1177 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1179 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1180 'svcpart' => $_->svcpart } );
1182 $pkg_svc ? $pkg_svc->primary_svc : '',
1183 $pkg_svc ? $pkg_svc->quantity : 0,
1190 =item num_cust_svc [ SVCPART ]
1192 Returns the number of provisioned services for this package. If a svcpart is
1193 specified, counts only the matching services.
1199 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1200 $sql .= ' AND svcpart = ?' if @_;
1201 my $sth = dbh->prepare($sql) or die dbh->errstr;
1202 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1203 $sth->fetchrow_arrayref->[0];
1206 =item available_part_svc
1208 Returns a list of FS::part_svc objects representing services included in this
1209 package but not yet provisioned. Each FS::part_svc object also has an extra
1210 field, I<num_avail>, which specifies the number of available services.
1214 sub available_part_svc {
1216 grep { $_->num_avail > 0 }
1218 my $part_svc = $_->part_svc;
1219 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1220 $_->quantity - $self->num_cust_svc($_->svcpart);
1223 $self->part_pkg->pkg_svc;
1228 Returns a list of FS::part_svc objects representing provisioned and available
1229 services included in this package. Each FS::part_svc object also has the
1230 following extra fields:
1234 =item num_cust_svc (count)
1236 =item num_avail (quantity - count)
1238 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1241 label -> ($cust_svc->label)[1]
1250 #XXX some sort of sort order besides numeric by svcpart...
1251 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1253 my $part_svc = $pkg_svc->part_svc;
1254 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1255 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1256 $part_svc->{'Hash'}{'num_avail'} =
1257 max( 0, $pkg_svc->quantity - $num_cust_svc );
1258 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1260 } $self->part_pkg->pkg_svc;
1263 push @part_svc, map {
1265 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1266 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1267 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1268 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1270 } $self->extra_part_svc;
1276 =item extra_part_svc
1278 Returns a list of FS::part_svc objects corresponding to services in this
1279 package which are still provisioned but not (any longer) available in the
1284 sub extra_part_svc {
1287 my $pkgnum = $self->pkgnum;
1288 my $pkgpart = $self->pkgpart;
1291 'table' => 'part_svc',
1293 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1294 WHERE pkg_svc.svcpart = part_svc.svcpart
1295 AND pkg_svc.pkgpart = $pkgpart
1298 AND 0 < ( SELECT count(*)
1300 LEFT JOIN cust_pkg using ( pkgnum )
1301 WHERE cust_svc.svcpart = part_svc.svcpart
1302 AND pkgnum = $pkgnum
1309 Returns a short status string for this package, currently:
1313 =item not yet billed
1315 =item one-time charge
1330 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1332 return 'cancelled' if $self->get('cancel');
1333 return 'suspended' if $self->susp;
1334 return 'not yet billed' unless $self->setup;
1335 return 'one-time charge' if $freq =~ /^(0|$)/;
1341 Class method that returns the list of possible status strings for pacakges
1342 (see L<the status method|/status>). For example:
1344 @statuses = FS::cust_pkg->statuses();
1348 tie my %statuscolor, 'Tie::IxHash',
1349 'not yet billed' => '000000',
1350 'one-time charge' => '000000',
1351 'active' => '00CC00',
1352 'suspended' => 'FF9900',
1353 'cancelled' => 'FF0000',
1357 my $self = shift; #could be class...
1358 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1359 # mayble split btw one-time vs. recur
1365 Returns a hex triplet color string for this package's status.
1371 $statuscolor{$self->status};
1376 Returns a list of lists, calling the label method for all services
1377 (see L<FS::cust_svc>) of this billing item.
1383 map { [ $_->label ] } $self->cust_svc;
1386 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1388 Like the labels method, but returns historical information on services that
1389 were active as of END_TIMESTAMP and (optionally) not cancelled before
1392 Returns a list of lists, calling the label method for all (historical) services
1393 (see L<FS::h_cust_svc>) of this billing item.
1399 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1402 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1404 Like h_labels, except returns a simple flat list, and shortens long
1405 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1406 identical services to one line that lists the service label and the number of
1407 individual services rather than individual items.
1411 sub h_labels_short {
1414 my $conf = new FS::Conf;
1415 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1418 #tie %labels, 'Tie::IxHash';
1419 push @{ $labels{$_->[0]} }, $_->[1]
1420 foreach $self->h_labels(@_);
1422 foreach my $label ( keys %labels ) {
1424 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1425 my $num = scalar(@values);
1426 if ( $num > $max_same_services ) {
1427 push @labels, "$label ($num)";
1429 push @labels, map { "$label: $_" } @values;
1439 Returns the parent customer object (see L<FS::cust_main>).
1445 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1448 =item seconds_since TIMESTAMP
1450 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1451 package have been online since TIMESTAMP, according to the session monitor.
1453 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1454 L<Time::Local> and L<Date::Parse> for conversion functions.
1459 my($self, $since) = @_;
1462 foreach my $cust_svc (
1463 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1465 $seconds += $cust_svc->seconds_since($since);
1472 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1474 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1475 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1478 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1479 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1485 sub seconds_since_sqlradacct {
1486 my($self, $start, $end) = @_;
1490 foreach my $cust_svc (
1492 my $part_svc = $_->part_svc;
1493 $part_svc->svcdb eq 'svc_acct'
1494 && scalar($part_svc->part_export('sqlradius'));
1497 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1504 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1506 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1507 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1511 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1512 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1517 sub attribute_since_sqlradacct {
1518 my($self, $start, $end, $attrib) = @_;
1522 foreach my $cust_svc (
1524 my $part_svc = $_->part_svc;
1525 $part_svc->svcdb eq 'svc_acct'
1526 && scalar($part_svc->part_export('sqlradius'));
1529 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1541 my( $self, $value ) = @_;
1542 if ( defined($value) ) {
1543 $self->setfield('quantity', $value);
1545 $self->getfield('quantity') || 1;
1548 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1550 Transfers as many services as possible from this package to another package.
1552 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1553 object. The destination package must already exist.
1555 Services are moved only if the destination allows services with the correct
1556 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1557 this option with caution! No provision is made for export differences
1558 between the old and new service definitions. Probably only should be used
1559 when your exports for all service definitions of a given svcdb are identical.
1560 (attempt a transfer without it first, to move all possible svcpart-matching
1563 Any services that can't be moved remain in the original package.
1565 Returns an error, if there is one; otherwise, returns the number of services
1566 that couldn't be moved.
1571 my ($self, $dest_pkgnum, %opt) = @_;
1577 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1578 $dest = $dest_pkgnum;
1579 $dest_pkgnum = $dest->pkgnum;
1581 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1584 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1586 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1587 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1590 foreach my $cust_svc ($dest->cust_svc) {
1591 $target{$cust_svc->svcpart}--;
1594 my %svcpart2svcparts = ();
1595 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1596 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1597 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1598 next if exists $svcpart2svcparts{$svcpart};
1599 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1600 $svcpart2svcparts{$svcpart} = [
1602 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1604 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1605 'svcpart' => $_ } );
1607 $pkg_svc ? $pkg_svc->primary_svc : '',
1608 $pkg_svc ? $pkg_svc->quantity : 0,
1612 grep { $_ != $svcpart }
1614 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1616 warn "alternates for svcpart $svcpart: ".
1617 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1622 foreach my $cust_svc ($self->cust_svc) {
1623 if($target{$cust_svc->svcpart} > 0) {
1624 $target{$cust_svc->svcpart}--;
1625 my $new = new FS::cust_svc { $cust_svc->hash };
1626 $new->pkgnum($dest_pkgnum);
1627 my $error = $new->replace($cust_svc);
1628 return $error if $error;
1629 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1631 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1632 warn "alternates to consider: ".
1633 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1635 my @alternate = grep {
1636 warn "considering alternate svcpart $_: ".
1637 "$target{$_} available in new package\n"
1640 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1642 warn "alternate(s) found\n" if $DEBUG;
1643 my $change_svcpart = $alternate[0];
1644 $target{$change_svcpart}--;
1645 my $new = new FS::cust_svc { $cust_svc->hash };
1646 $new->svcpart($change_svcpart);
1647 $new->pkgnum($dest_pkgnum);
1648 my $error = $new->replace($cust_svc);
1649 return $error if $error;
1662 This method is deprecated. See the I<depend_jobnum> option to the insert and
1663 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1670 local $SIG{HUP} = 'IGNORE';
1671 local $SIG{INT} = 'IGNORE';
1672 local $SIG{QUIT} = 'IGNORE';
1673 local $SIG{TERM} = 'IGNORE';
1674 local $SIG{TSTP} = 'IGNORE';
1675 local $SIG{PIPE} = 'IGNORE';
1677 my $oldAutoCommit = $FS::UID::AutoCommit;
1678 local $FS::UID::AutoCommit = 0;
1681 foreach my $cust_svc ( $self->cust_svc ) {
1682 #false laziness w/svc_Common::insert
1683 my $svc_x = $cust_svc->svc_x;
1684 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1685 my $error = $part_export->export_insert($svc_x);
1687 $dbh->rollback if $oldAutoCommit;
1693 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1700 =head1 CLASS METHODS
1706 Returns an SQL expression identifying recurring packages.
1710 sub recurring_sql { "
1711 '0' != ( select freq from part_pkg
1712 where cust_pkg.pkgpart = part_pkg.pkgpart )
1717 Returns an SQL expression identifying one-time packages.
1722 '0' = ( select freq from part_pkg
1723 where cust_pkg.pkgpart = part_pkg.pkgpart )
1728 Returns an SQL expression identifying active packages.
1733 ". $_[0]->recurring_sql(). "
1734 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1735 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1740 Returns an SQL expression identifying inactive packages (one-time packages
1741 that are otherwise unsuspended/uncancelled).
1745 sub inactive_sql { "
1746 ". $_[0]->onetime_sql(). "
1747 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1748 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1754 Returns an SQL expression identifying suspended packages.
1758 sub suspended_sql { susp_sql(@_); }
1760 #$_[0]->recurring_sql(). ' AND '.
1762 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1763 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
1770 Returns an SQL exprression identifying cancelled packages.
1774 sub cancelled_sql { cancel_sql(@_); }
1776 #$_[0]->recurring_sql(). ' AND '.
1777 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1780 =item search_sql HASHREF
1784 Returns a qsearch hash expression to search for parameters specified in HASHREF.
1785 Valid parameters are
1793 active, inactive, suspended, cancel (or cancelled)
1797 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
1803 pkgpart or arrayref or hashref of pkgparts
1807 arrayref of beginning and ending epoch date
1811 arrayref of beginning and ending epoch date
1815 arrayref of beginning and ending epoch date
1819 arrayref of beginning and ending epoch date
1823 arrayref of beginning and ending epoch date
1827 arrayref of beginning and ending epoch date
1831 arrayref of beginning and ending epoch date
1835 pkgnum or APKG_pkgnum
1839 a value suited to passing to FS::UI::Web::cust_header
1843 specifies the user for agent virtualization
1850 my ($class, $params) = @_;
1857 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1866 if ( $params->{'magic'} eq 'active'
1867 || $params->{'status'} eq 'active' ) {
1869 push @where, FS::cust_pkg->active_sql();
1871 } elsif ( $params->{'magic'} eq 'inactive'
1872 || $params->{'status'} eq 'inactive' ) {
1874 push @where, FS::cust_pkg->inactive_sql();
1876 } elsif ( $params->{'magic'} eq 'suspended'
1877 || $params->{'status'} eq 'suspended' ) {
1879 push @where, FS::cust_pkg->suspended_sql();
1881 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
1882 || $params->{'status'} =~ /^cancell?ed$/ ) {
1884 push @where, FS::cust_pkg->cancelled_sql();
1886 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
1888 push @where, FS::cust_pkg->inactive_sql();
1893 # parse package class
1896 #false lazinessish w/graph/cust_bill_pkg.cgi
1899 if ( exists($params->{'classnum'})
1900 && $params->{'classnum'} =~ /^(\d*)$/
1904 if ( $classnum ) { #a specific class
1905 push @where, "classnum = $classnum";
1907 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
1908 #die "classnum $classnum not found!" unless $pkg_class[0];
1909 #$title .= $pkg_class[0]->classname.' ';
1911 } elsif ( $classnum eq '' ) { #the empty class
1913 push @where, "classnum IS NULL";
1914 #$title .= 'Empty class ';
1915 #@pkg_class = ( '(empty class)' );
1916 } elsif ( $classnum eq '0' ) {
1917 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
1918 #push @pkg_class, '(empty class)';
1920 die "illegal classnum";
1929 if ( ref($params->{'pkgpart'}) ) {
1932 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
1933 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
1934 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
1935 @pkgpart = @{ $params->{'pkgpart'} };
1937 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
1940 @pkgpart = grep /^(\d+)$/, @pkgpart;
1942 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')';
1944 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
1945 push @where, "pkgpart = $1";
1954 #false laziness w/report_cust_pkg.html
1957 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
1958 'active' => { 'susp'=>1, 'cancel'=>1 },
1959 'suspended' => { 'cancel' => 1 },
1964 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
1966 next unless exists($params->{$field});
1968 my($beginning, $ending) = @{$params->{$field}};
1970 next if $beginning == 0 && $ending == 4294967295;
1973 "cust_pkg.$field IS NOT NULL",
1974 "cust_pkg.$field >= $beginning",
1975 "cust_pkg.$field <= $ending";
1977 $orderby ||= "ORDER BY cust_pkg.$field";
1981 $orderby ||= 'ORDER BY bill';
1984 # parse magic, legacy, etc.
1987 if ( $params->{'magic'} &&
1988 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
1991 $orderby = 'ORDER BY pkgnum';
1993 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
1994 push @where, "pkgpart = $1";
1997 } elsif ( $params->{'query'} eq 'pkgnum' ) {
1999 $orderby = 'ORDER BY pkgnum';
2001 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2003 $orderby = 'ORDER BY pkgnum';
2006 SELECT count(*) FROM pkg_svc
2007 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2008 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2009 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2010 AND cust_svc.svcpart = pkg_svc.svcpart
2017 # setup queries, links, subs, etc. for the search
2020 # here is the agent virtualization
2021 if ($params->{CurrentUser}) {
2023 qsearchs('access_user', { username => $params->{CurrentUser} });
2026 push @where, $access_user->agentnums_sql('table' => 'cust_main');
2031 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table' => 'cust_main');
2034 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2036 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2037 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2038 'LEFT JOIN pkg_class USING ( classnum ) ';
2040 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2043 'table' => 'cust_pkg',
2045 'select' => join(', ',
2047 ( map "part_pkg.$_", qw( pkg freq ) ),
2048 'pkg_class.classname',
2049 'cust_main.custnum as cust_main_custnum',
2050 FS::UI::Web::cust_sql_fields(
2051 $params->{'cust_fields'}
2054 'extra_sql' => "$extra_sql $orderby",
2055 'addl_from' => $addl_from,
2056 'count_query' => $count_query,
2065 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
2067 CUSTNUM is a customer (see L<FS::cust_main>)
2069 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2070 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2073 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2074 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2075 new billing items. An error is returned if this is not possible (see
2076 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2079 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2080 newly-created cust_pkg objects.
2085 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2087 my $conf = new FS::Conf;
2089 # Transactionize this whole mess
2090 local $SIG{HUP} = 'IGNORE';
2091 local $SIG{INT} = 'IGNORE';
2092 local $SIG{QUIT} = 'IGNORE';
2093 local $SIG{TERM} = 'IGNORE';
2094 local $SIG{TSTP} = 'IGNORE';
2095 local $SIG{PIPE} = 'IGNORE';
2097 my $oldAutoCommit = $FS::UID::AutoCommit;
2098 local $FS::UID::AutoCommit = 0;
2102 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2103 return "Customer not found: $custnum" unless $cust_main;
2105 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2108 my $change = scalar(@old_cust_pkg) != 0;
2111 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2115 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
2117 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
2118 $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
2120 $hash{'change_date'} = $time;
2121 $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
2124 # Create the new packages.
2125 foreach my $pkgpart (@$pkgparts) {
2126 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2127 pkgpart => $pkgpart,
2130 $error = $cust_pkg->insert( 'change' => $change );
2132 $dbh->rollback if $oldAutoCommit;
2135 push @$return_cust_pkg, $cust_pkg;
2137 # $return_cust_pkg now contains refs to all of the newly
2140 # Transfer services and cancel old packages.
2141 foreach my $old_pkg (@old_cust_pkg) {
2143 foreach my $new_pkg (@$return_cust_pkg) {
2144 $error = $old_pkg->transfer($new_pkg);
2145 if ($error and $error == 0) {
2146 # $old_pkg->transfer failed.
2147 $dbh->rollback if $oldAutoCommit;
2152 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2153 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2154 foreach my $new_pkg (@$return_cust_pkg) {
2155 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2156 if ($error and $error == 0) {
2157 # $old_pkg->transfer failed.
2158 $dbh->rollback if $oldAutoCommit;
2165 # Transfers were successful, but we went through all of the
2166 # new packages and still had services left on the old package.
2167 # We can't cancel the package under the circumstances, so abort.
2168 $dbh->rollback if $oldAutoCommit;
2169 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2172 #reset usage if changing pkgpart
2173 foreach my $new_pkg (@$return_cust_pkg) {
2174 if ($old_pkg->pkgpart != $new_pkg->pkgpart) {
2175 my $part_pkg = $new_pkg->part_pkg;
2176 $error = $part_pkg->reset_usage($new_pkg, $part_pkg->is_prepaid
2180 if $part_pkg->can('reset_usage');
2183 $dbh->rollback if $oldAutoCommit;
2184 return "Error setting usage values: $error";
2189 $error = $old_pkg->cancel( quiet=>1 );
2195 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2199 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2201 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2202 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2205 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2206 replace. The services (see L<FS::cust_svc>) are moved to the
2207 new billing items. An error is returned if this is not possible (see
2210 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2211 newly-created cust_pkg objects.
2216 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2218 # Transactionize this whole mess
2219 local $SIG{HUP} = 'IGNORE';
2220 local $SIG{INT} = 'IGNORE';
2221 local $SIG{QUIT} = 'IGNORE';
2222 local $SIG{TERM} = 'IGNORE';
2223 local $SIG{TSTP} = 'IGNORE';
2224 local $SIG{PIPE} = 'IGNORE';
2226 my $oldAutoCommit = $FS::UID::AutoCommit;
2227 local $FS::UID::AutoCommit = 0;
2231 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2234 while(scalar(@old_cust_pkg)) {
2236 my $custnum = $old_cust_pkg[0]->custnum;
2237 my (@remove) = map { $_->pkgnum }
2238 grep { $_->custnum == $custnum } @old_cust_pkg;
2239 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2241 my $error = order $custnum, $pkgparts, \@remove, \@return;
2243 push @errors, $error
2245 push @$return_cust_pkg, @return;
2248 if (scalar(@errors)) {
2249 $dbh->rollback if $oldAutoCommit;
2250 return join(' / ', @errors);
2253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2259 Associates this package with a (suspension or cancellation) reason (see
2260 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2263 Available options are:
2267 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
2269 =item otaker_reason - the access_user (see L<FS::access_user>) providing the reason
2271 =item date - a unix timestamp
2273 =item action - the action (cancel, susp, adjourn, expire) associated with the reason
2277 If there is an error, returns the error, otherwise returns false.
2282 my ($self, %options) = @_;
2284 my $otaker = $options{reason_otaker} ||
2285 $FS::CurrentUser::CurrentUser->username;
2288 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2292 } elsif ( ref($options{'reason'}) ) {
2294 return 'Enter a new reason (or select an existing one)'
2295 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2297 my $reason = new FS::reason({
2298 'reason_type' => $options{'reason'}->{'typenum'},
2299 'reason' => $options{'reason'}->{'reason'},
2301 my $error = $reason->insert;
2302 return $error if $error;
2304 $reasonnum = $reason->reasonnum;
2307 return "Unparsable reason: ". $options{'reason'};
2310 my $cust_pkg_reason =
2311 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2312 'reasonnum' => $reasonnum,
2313 'otaker' => $otaker,
2314 'action' => substr(uc($options{'action'}),0,1),
2315 'date' => $options{'date'}
2320 $cust_pkg_reason->insert;
2323 =item set_usage USAGE_VALUE_HASHREF
2325 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2326 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2327 upbytes, downbytes, and totalbytes are appropriate keys.
2329 All svc_accts which are part of this package have their values reset.
2334 my ($self, $valueref, %opt) = @_;
2336 foreach my $cust_svc ($self->cust_svc){
2337 my $svc_x = $cust_svc->svc_x;
2338 $svc_x->set_usage($valueref, %opt)
2339 if $svc_x->can("set_usage");
2347 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2349 In sub order, the @pkgparts array (passed by reference) is clobbered.
2351 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2352 method to pass dates to the recur_prog expression, it should do so.
2354 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2355 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2356 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2357 configuration values. Probably need a subroutine which decides what to do
2358 based on whether or not we've fetched the user yet, rather than a hash. See
2359 FS::UID and the TODO.
2361 Now that things are transactional should the check in the insert method be
2366 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2367 L<FS::pkg_svc>, schema.html from the base documentation