4 use vars qw(@ISA $disable_agentcheck $DEBUG);
5 use Scalar::Util qw( blessed );
6 use List::Util qw(max);
8 use FS::UID qw( getotaker dbh );
9 use FS::Misc qw( send_email );
10 use FS::Record qw( qsearch qsearchs );
12 use FS::cust_main_Mixin;
18 use FS::cust_bill_pkg;
19 use FS::cust_pkg_detail;
24 use FS::cust_pkg_reason;
28 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
30 # because they load configuration by setting FS::UID::callback (see TODO)
36 # for sending cancel emails in sub cancel
39 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
43 $disable_agentcheck = 0;
47 my ( $hashref, $cache ) = @_;
48 #if ( $hashref->{'pkgpart'} ) {
49 if ( $hashref->{'pkg'} ) {
50 # #@{ $self->{'_pkgnum'} } = ();
51 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
52 # $self->{'_pkgpart'} = $subcache;
53 # #push @{ $self->{'_pkgnum'} },
54 # FS::part_pkg->new_or_cached($hashref, $subcache);
55 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
57 if ( exists $hashref->{'svcnum'} ) {
58 #@{ $self->{'_pkgnum'} } = ();
59 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
60 $self->{'_svcnum'} = $subcache;
61 #push @{ $self->{'_pkgnum'} },
62 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
68 FS::cust_pkg - Object methods for cust_pkg objects
74 $record = new FS::cust_pkg \%hash;
75 $record = new FS::cust_pkg { 'column' => 'value' };
77 $error = $record->insert;
79 $error = $new_record->replace($old_record);
81 $error = $record->delete;
83 $error = $record->check;
85 $error = $record->cancel;
87 $error = $record->suspend;
89 $error = $record->unsuspend;
91 $part_pkg = $record->part_pkg;
93 @labels = $record->labels;
95 $seconds = $record->seconds_since($timestamp);
97 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
98 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
102 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
103 inherits from FS::Record. The following fields are currently supported:
109 primary key (assigned automatically for new billing items)
113 Customer (see L<FS::cust_main>)
117 Billing item definition (see L<FS::part_pkg>)
125 date (next bill date)
149 order taker (assigned automatically if null, see L<FS::UID>)
153 If this field is set to 1, disables the automatic
154 unsuspension of this package when using the B<unsuspendauto> config option.
158 If not set, defaults to 1
162 Date of change from previous package
174 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
175 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
176 L<Time::Local> and L<Date::Parse> for conversion functions.
184 Create a new billing item. To add the item to the database, see L<"insert">.
188 sub table { 'cust_pkg'; }
189 sub cust_linked { $_[0]->cust_main_custnum; }
190 sub cust_unlinked_msg {
192 "WARNING: can't find cust_main.custnum ". $self->custnum.
193 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
196 =item insert [ OPTION => VALUE ... ]
198 Adds this billing item to the database ("Orders" the item). If there is an
199 error, returns the error, otherwise returns false.
201 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
202 will be used to look up the package definition and agent restrictions will be
205 If the additional field I<refnum> is defined, an FS::pkg_referral record will
206 be created and inserted. Multiple FS::pkg_referral records can be created by
207 setting I<refnum> to an array reference of refnums or a hash reference with
208 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
209 record will be created corresponding to cust_main.refnum.
211 The following options are available:
217 If set true, supresses any referral credit to a referring customer.
221 cust_pkg_option records will be created
228 my( $self, %options ) = @_;
230 local $SIG{HUP} = 'IGNORE';
231 local $SIG{INT} = 'IGNORE';
232 local $SIG{QUIT} = 'IGNORE';
233 local $SIG{TERM} = 'IGNORE';
234 local $SIG{TSTP} = 'IGNORE';
235 local $SIG{PIPE} = 'IGNORE';
237 my $oldAutoCommit = $FS::UID::AutoCommit;
238 local $FS::UID::AutoCommit = 0;
241 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
243 $dbh->rollback if $oldAutoCommit;
247 $self->refnum($self->cust_main->refnum) unless $self->refnum;
248 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
249 $self->process_m2m( 'link_table' => 'pkg_referral',
250 'target_table' => 'part_referral',
251 'params' => $self->refnum,
254 #if ( $self->reg_code ) {
255 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
256 # $error = $reg_code->delete;
258 # $dbh->rollback if $oldAutoCommit;
263 my $conf = new FS::Conf;
265 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
266 my $queue = new FS::queue {
267 'job' => 'FS::cust_main::queueable_print',
269 $error = $queue->insert(
270 'custnum' => $self->custnum,
271 'template' => 'welcome_letter',
275 warn "can't send welcome letter: $error";
280 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
287 This method now works but you probably shouldn't use it.
289 You don't want to delete billing items, because there would then be no record
290 the customer ever purchased the item. Instead, see the cancel method.
295 # return "Can't delete cust_pkg records!";
298 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
300 Replaces the OLD_RECORD with this one in the database. If there is an error,
301 returns the error, otherwise returns false.
303 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
305 Changing pkgpart may have disasterous effects. See the order subroutine.
307 setup and bill are normally updated by calling the bill method of a customer
308 object (see L<FS::cust_main>).
310 suspend is normally updated by the suspend and unsuspend methods.
312 cancel is normally updated by the cancel method (and also the order subroutine
315 Available options are:
321 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.
325 the access_user (see L<FS::access_user>) providing the reason
329 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
338 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
343 ( ref($_[0]) eq 'HASH' )
347 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
348 return "Can't change otaker!" if $old->otaker ne $new->otaker;
351 #return "Can't change setup once it exists!"
352 # if $old->getfield('setup') &&
353 # $old->getfield('setup') != $new->getfield('setup');
355 #some logic for bill, susp, cancel?
357 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
359 local $SIG{HUP} = 'IGNORE';
360 local $SIG{INT} = 'IGNORE';
361 local $SIG{QUIT} = 'IGNORE';
362 local $SIG{TERM} = 'IGNORE';
363 local $SIG{TSTP} = 'IGNORE';
364 local $SIG{PIPE} = 'IGNORE';
366 my $oldAutoCommit = $FS::UID::AutoCommit;
367 local $FS::UID::AutoCommit = 0;
370 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
371 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
372 my $error = $new->insert_reason(
373 'reason' => $options->{'reason'},
374 'date' => $new->$method,
376 'reason_otaker' => $options->{'reason_otaker'},
379 dbh->rollback if $oldAutoCommit;
380 return "Error inserting cust_pkg_reason: $error";
385 #save off and freeze RADIUS attributes for any associated svc_acct records
387 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
389 #also check for specific exports?
390 # to avoid spurious modify export events
391 @svc_acct = map { $_->svc_x }
392 grep { $_->part_svc->svcdb eq 'svc_acct' }
395 $_->snapshot foreach @svc_acct;
399 my $error = $new->SUPER::replace($old,
400 $options->{options} ? $options->{options} : ()
403 $dbh->rollback if $oldAutoCommit;
407 #for prepaid packages,
408 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
409 foreach my $old_svc_acct ( @svc_acct ) {
410 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
411 my $s_error = $new_svc_acct->replace($old_svc_acct);
413 $dbh->rollback if $oldAutoCommit;
418 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
425 Checks all fields to make sure this is a valid billing item. If there is an
426 error, returns the error, otherwise returns false. Called by the insert and
435 $self->ut_numbern('pkgnum')
436 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
437 || $self->ut_numbern('pkgpart')
438 || $self->ut_numbern('setup')
439 || $self->ut_numbern('bill')
440 || $self->ut_numbern('susp')
441 || $self->ut_numbern('cancel')
442 || $self->ut_numbern('adjourn')
443 || $self->ut_numbern('expire')
445 return $error if $error;
447 if ( $self->reg_code ) {
449 unless ( grep { $self->pkgpart == $_->pkgpart }
450 map { $_->reg_code_pkg }
451 qsearchs( 'reg_code', { 'code' => $self->reg_code,
452 'agentnum' => $self->cust_main->agentnum })
454 return "Unknown registration code";
457 } elsif ( $self->promo_code ) {
460 qsearchs('part_pkg', {
461 'pkgpart' => $self->pkgpart,
462 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
464 return 'Unknown promotional code' unless $promo_part_pkg;
468 unless ( $disable_agentcheck ) {
470 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
471 my $pkgpart_href = $agent->pkgpart_hashref;
472 return "agent ". $agent->agentnum.
473 " can't purchase pkgpart ". $self->pkgpart
474 unless $pkgpart_href->{ $self->pkgpart };
477 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
478 return $error if $error;
482 $self->otaker(getotaker) unless $self->otaker;
483 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
486 if ( $self->dbdef_table->column('manual_flag') ) {
487 $self->manual_flag('') if $self->manual_flag eq ' ';
488 $self->manual_flag =~ /^([01]?)$/
489 or return "Illegal manual_flag ". $self->manual_flag;
490 $self->manual_flag($1);
496 =item cancel [ OPTION => VALUE ... ]
498 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
499 in this package, then cancels the package itself (sets the cancel field to
502 Available options are:
506 =item quiet - can be set true to supress email cancellation notices.
508 =item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
510 =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.
512 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
516 If there is an error, returns the error, otherwise returns false.
521 my( $self, %options ) = @_;
524 warn "cust_pkg::cancel called with options".
525 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
528 local $SIG{HUP} = 'IGNORE';
529 local $SIG{INT} = 'IGNORE';
530 local $SIG{QUIT} = 'IGNORE';
531 local $SIG{TERM} = 'IGNORE';
532 local $SIG{TSTP} = 'IGNORE';
533 local $SIG{PIPE} = 'IGNORE';
535 my $oldAutoCommit = $FS::UID::AutoCommit;
536 local $FS::UID::AutoCommit = 0;
539 my $old = $self->select_for_update;
541 if ( $old->get('cancel') || $self->get('cancel') ) {
542 dbh->rollback if $oldAutoCommit;
543 return ""; # no error
546 my $date = $options{date} if $options{date}; # expire/cancel later
547 $date = '' if ($date && $date <= time); # complain instead?
549 my $cancel_time = $options{'time'} || time;
551 if ( $options{'reason'} ) {
552 $error = $self->insert_reason( 'reason' => $options{'reason'},
553 'action' => $date ? 'expire' : 'cancel',
554 'reason_otaker' => $options{'reason_otaker'},
557 dbh->rollback if $oldAutoCommit;
558 return "Error inserting cust_pkg_reason: $error";
564 foreach my $cust_svc (
567 sort { $a->[1] <=> $b->[1] }
568 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
569 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
572 my $error = $cust_svc->cancel;
575 $dbh->rollback if $oldAutoCommit;
576 return "Error cancelling cust_svc: $error";
580 # Add a credit for remaining service
581 my $remaining_value = $self->calc_remain(time=>$cancel_time);
582 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
583 my $conf = new FS::Conf;
584 my $error = $self->cust_main->credit(
586 'Credit for unused time on '. $self->part_pkg->pkg,
587 'reason_type' => $conf->config('cancel_credit_type'),
590 $dbh->rollback if $oldAutoCommit;
591 return "Error crediting customer \$$remaining_value for unused time on".
592 $self->part_pkg->pkg. ": $error";
597 my %hash = $self->hash;
598 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
599 my $new = new FS::cust_pkg ( \%hash );
600 $error = $new->replace( $self, options => { $self->options } );
602 $dbh->rollback if $oldAutoCommit;
606 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
607 return '' if $date; #no errors
609 my $conf = new FS::Conf;
610 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
611 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
612 my $conf = new FS::Conf;
613 my $error = send_email(
614 'from' => $conf->config('invoice_from'),
615 'to' => \@invoicing_list,
616 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
617 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
619 #should this do something on errors?
626 =item cancel_if_expired [ NOW_TIMESTAMP ]
628 Cancels this package if its expire date has been reached.
632 sub cancel_if_expired {
634 my $time = shift || time;
635 return '' unless $self->expire && $self->expire <= $time;
636 my $error = $self->cancel;
638 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
639 $self->custnum. ": $error";
646 Cancels any pending expiration (sets the expire field to null).
648 If there is an error, returns the error, otherwise returns false.
653 my( $self, %options ) = @_;
656 local $SIG{HUP} = 'IGNORE';
657 local $SIG{INT} = 'IGNORE';
658 local $SIG{QUIT} = 'IGNORE';
659 local $SIG{TERM} = 'IGNORE';
660 local $SIG{TSTP} = 'IGNORE';
661 local $SIG{PIPE} = 'IGNORE';
663 my $oldAutoCommit = $FS::UID::AutoCommit;
664 local $FS::UID::AutoCommit = 0;
667 my $old = $self->select_for_update;
669 my $pkgnum = $old->pkgnum;
670 if ( $old->get('cancel') || $self->get('cancel') ) {
671 dbh->rollback if $oldAutoCommit;
672 return "Can't unexpire cancelled package $pkgnum";
673 # or at least it's pointless
676 unless ( $old->get('expire') && $self->get('expire') ) {
677 dbh->rollback if $oldAutoCommit;
678 return ""; # no error
681 my %hash = $self->hash;
682 $hash{'expire'} = '';
683 my $new = new FS::cust_pkg ( \%hash );
684 $error = $new->replace( $self, options => { $self->options } );
686 $dbh->rollback if $oldAutoCommit;
690 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
696 =item suspend [ OPTION => VALUE ... ]
698 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
699 package, then suspends the package itself (sets the susp field to now).
701 Available options are:
705 =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.
707 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
711 If there is an error, returns the error, otherwise returns false.
716 my( $self, %options ) = @_;
719 local $SIG{HUP} = 'IGNORE';
720 local $SIG{INT} = 'IGNORE';
721 local $SIG{QUIT} = 'IGNORE';
722 local $SIG{TERM} = 'IGNORE';
723 local $SIG{TSTP} = 'IGNORE';
724 local $SIG{PIPE} = 'IGNORE';
726 my $oldAutoCommit = $FS::UID::AutoCommit;
727 local $FS::UID::AutoCommit = 0;
730 my $old = $self->select_for_update;
732 my $pkgnum = $old->pkgnum;
733 if ( $old->get('cancel') || $self->get('cancel') ) {
734 dbh->rollback if $oldAutoCommit;
735 return "Can't suspend cancelled package $pkgnum";
738 if ( $old->get('susp') || $self->get('susp') ) {
739 dbh->rollback if $oldAutoCommit;
740 return ""; # no error # complain on adjourn?
743 my $date = $options{date} if $options{date}; # adjourn/suspend later
744 $date = '' if ($date && $date <= time); # complain instead?
746 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
747 dbh->rollback if $oldAutoCommit;
748 return "Package $pkgnum expires before it would be suspended.";
751 if ( $options{'reason'} ) {
752 $error = $self->insert_reason( 'reason' => $options{'reason'},
753 'action' => $date ? 'adjourn' : 'suspend',
754 'reason_otaker' => $options{'reason_otaker'},
757 dbh->rollback if $oldAutoCommit;
758 return "Error inserting cust_pkg_reason: $error";
766 foreach my $cust_svc (
767 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
769 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
771 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
772 $dbh->rollback if $oldAutoCommit;
773 return "Illegal svcdb value in part_svc!";
776 require "FS/$svcdb.pm";
778 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
780 $error = $svc->suspend;
782 $dbh->rollback if $oldAutoCommit;
785 my( $label, $value ) = $cust_svc->label;
786 push @labels, "$label: $value";
790 my $conf = new FS::Conf;
791 if ( $conf->config('suspend_email_admin') ) {
793 my $error = send_email(
794 'from' => $conf->config('invoice_from'), #??? well as good as any
795 'to' => $conf->config('suspend_email_admin'),
796 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
798 "This is an automatic message from your Freeside installation\n",
799 "informing you that the following customer package has been suspended:\n",
801 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
802 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
803 ( map { "Service : $_\n" } @labels ),
808 warn "WARNING: can't send suspension admin email (suspending anyway): ".
816 my %hash = $self->hash;
818 $hash{'adjourn'} = $date;
820 $hash{'susp'} = time;
822 my $new = new FS::cust_pkg ( \%hash );
823 $error = $new->replace( $self, options => { $self->options } );
825 $dbh->rollback if $oldAutoCommit;
829 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
834 =item unsuspend [ OPTION => VALUE ... ]
836 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
837 package, then unsuspends the package itself (clears the susp field and the
838 adjourn field if it is in the past).
840 Available options are:
844 =item adjust_next_bill
846 Can be set true to adjust the next bill date forward by
847 the amount of time the account was inactive. This was set true by default
848 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
849 explicitly requested. Price plans for which this makes sense (anniversary-date
850 based than prorate or subscription) could have an option to enable this
855 If there is an error, returns the error, otherwise returns false.
860 my( $self, %opt ) = @_;
863 local $SIG{HUP} = 'IGNORE';
864 local $SIG{INT} = 'IGNORE';
865 local $SIG{QUIT} = 'IGNORE';
866 local $SIG{TERM} = 'IGNORE';
867 local $SIG{TSTP} = 'IGNORE';
868 local $SIG{PIPE} = 'IGNORE';
870 my $oldAutoCommit = $FS::UID::AutoCommit;
871 local $FS::UID::AutoCommit = 0;
874 my $old = $self->select_for_update;
876 my $pkgnum = $old->pkgnum;
877 if ( $old->get('cancel') || $self->get('cancel') ) {
878 dbh->rollback if $oldAutoCommit;
879 return "Can't unsuspend cancelled package $pkgnum";
882 unless ( $old->get('susp') && $self->get('susp') ) {
883 dbh->rollback if $oldAutoCommit;
884 return ""; # no error # complain instead?
887 foreach my $cust_svc (
888 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
890 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
892 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
893 $dbh->rollback if $oldAutoCommit;
894 return "Illegal svcdb value in part_svc!";
897 require "FS/$svcdb.pm";
899 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
901 $error = $svc->unsuspend;
903 $dbh->rollback if $oldAutoCommit;
910 my %hash = $self->hash;
911 my $inactive = time - $hash{'susp'};
913 my $conf = new FS::Conf;
915 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
916 if ( $opt{'adjust_next_bill'}
917 || $conf->config('unsuspend-always_adjust_next_bill_date') )
918 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
921 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
922 my $new = new FS::cust_pkg ( \%hash );
923 $error = $new->replace( $self, options => { $self->options } );
925 $dbh->rollback if $oldAutoCommit;
929 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
936 Cancels any pending suspension (sets the adjourn field to null).
938 If there is an error, returns the error, otherwise returns false.
943 my( $self, %options ) = @_;
946 local $SIG{HUP} = 'IGNORE';
947 local $SIG{INT} = 'IGNORE';
948 local $SIG{QUIT} = 'IGNORE';
949 local $SIG{TERM} = 'IGNORE';
950 local $SIG{TSTP} = 'IGNORE';
951 local $SIG{PIPE} = 'IGNORE';
953 my $oldAutoCommit = $FS::UID::AutoCommit;
954 local $FS::UID::AutoCommit = 0;
957 my $old = $self->select_for_update;
959 my $pkgnum = $old->pkgnum;
960 if ( $old->get('cancel') || $self->get('cancel') ) {
961 dbh->rollback if $oldAutoCommit;
962 return "Can't unadjourn cancelled package $pkgnum";
963 # or at least it's pointless
966 if ( $old->get('susp') || $self->get('susp') ) {
967 dbh->rollback if $oldAutoCommit;
968 return "Can't unadjourn suspended package $pkgnum";
969 # perhaps this is arbitrary
972 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
973 dbh->rollback if $oldAutoCommit;
974 return ""; # no error
977 my %hash = $self->hash;
978 $hash{'adjourn'} = '';
979 my $new = new FS::cust_pkg ( \%hash );
980 $error = $new->replace( $self, options => { $self->options } );
982 $dbh->rollback if $oldAutoCommit;
986 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
994 Returns the last bill date, or if there is no last bill date, the setup date.
995 Useful for billing metered services.
1001 return $self->setfield('last_bill', $_[0]) if @_;
1002 return $self->getfield('last_bill') if $self->getfield('last_bill');
1003 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1004 'edate' => $self->bill, } );
1005 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1008 =item last_cust_pkg_reason ACTION
1010 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1011 Returns false if there is no reason or the package is not currenly ACTION'd
1012 ACTION is one of adjourn, susp, cancel, or expire.
1016 sub last_cust_pkg_reason {
1017 my ( $self, $action ) = ( shift, shift );
1018 my $date = $self->get($action);
1020 'table' => 'cust_pkg_reason',
1021 'hashref' => { 'pkgnum' => $self->pkgnum,
1022 'action' => substr(uc($action), 0, 1),
1025 'order_by' => 'ORDER BY num DESC LIMIT 1',
1029 =item last_reason ACTION
1031 Returns the most recent ACTION FS::reason associated with the package.
1032 Returns false if there is no reason or the package is not currenly ACTION'd
1033 ACTION is one of adjourn, susp, cancel, or expire.
1038 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1039 $cust_pkg_reason->reason
1040 if $cust_pkg_reason;
1045 Returns the definition for this billing item, as an FS::part_pkg object (see
1052 #exists( $self->{'_pkgpart'} )
1054 ? $self->{'_pkgpart'}
1055 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1060 Returns the cancelled package this package was changed from, if any.
1066 return '' unless $self->change_pkgnum;
1067 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1072 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1079 $self->part_pkg->calc_setup($self, @_);
1084 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1091 $self->part_pkg->calc_recur($self, @_);
1096 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1103 $self->part_pkg->calc_remain($self, @_);
1108 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1115 $self->part_pkg->calc_cancel($self, @_);
1120 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1126 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1129 =item cust_pkg_detail [ DETAILTYPE ]
1131 Returns any customer package details for this package (see
1132 L<FS::cust_pkg_detail>).
1134 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1138 sub cust_pkg_detail {
1140 my %hash = ( 'pkgnum' => $self->pkgnum );
1141 $hash{detailtype} = shift if @_;
1143 'table' => 'cust_pkg_detail',
1144 'hashref' => \%hash,
1145 'order_by' => 'ORDER BY weight, pkgdetailnum',
1149 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1151 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1153 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1155 If there is an error, returns the error, otherwise returns false.
1159 sub set_cust_pkg_detail {
1160 my( $self, $detailtype, @details ) = @_;
1162 local $SIG{HUP} = 'IGNORE';
1163 local $SIG{INT} = 'IGNORE';
1164 local $SIG{QUIT} = 'IGNORE';
1165 local $SIG{TERM} = 'IGNORE';
1166 local $SIG{TSTP} = 'IGNORE';
1167 local $SIG{PIPE} = 'IGNORE';
1169 my $oldAutoCommit = $FS::UID::AutoCommit;
1170 local $FS::UID::AutoCommit = 0;
1173 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1174 my $error = $current->delete;
1176 $dbh->rollback if $oldAutoCommit;
1177 return "error removing old detail: $error";
1181 foreach my $detail ( @details ) {
1182 my $cust_pkg_detail = new FS::cust_pkg_detail {
1183 'pkgnum' => $self->pkgnum,
1184 'detailtype' => $detailtype,
1185 'detail' => $detail,
1187 my $error = $cust_pkg_detail->insert;
1189 $dbh->rollback if $oldAutoCommit;
1190 return "error adding new detail: $error";
1195 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1202 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1206 #false laziness w/cust_bill.pm
1210 'table' => 'cust_event',
1211 'addl_from' => 'JOIN part_event USING ( eventpart )',
1212 'hashref' => { 'tablenum' => $self->pkgnum },
1213 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1217 =item num_cust_event
1219 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1223 #false laziness w/cust_bill.pm
1224 sub num_cust_event {
1227 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1228 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1229 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1230 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1231 $sth->fetchrow_arrayref->[0];
1234 =item cust_svc [ SVCPART ]
1236 Returns the services for this package, as FS::cust_svc objects (see
1237 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1246 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1247 'svcpart' => shift, } );
1250 #if ( $self->{'_svcnum'} ) {
1251 # values %{ $self->{'_svcnum'}->cache };
1253 $self->_sort_cust_svc(
1254 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1260 =item overlimit [ SVCPART ]
1262 Returns the services for this package which have exceeded their
1263 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1264 is specified, return only the matching services.
1270 grep { $_->overlimit } $self->cust_svc;
1273 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1275 Returns historical services for this package created before END TIMESTAMP and
1276 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1277 (see L<FS::h_cust_svc>).
1284 $self->_sort_cust_svc(
1285 [ qsearch( 'h_cust_svc',
1286 { 'pkgnum' => $self->pkgnum, },
1287 FS::h_cust_svc->sql_h_search(@_),
1293 sub _sort_cust_svc {
1294 my( $self, $arrayref ) = @_;
1297 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1299 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1300 'svcpart' => $_->svcpart } );
1302 $pkg_svc ? $pkg_svc->primary_svc : '',
1303 $pkg_svc ? $pkg_svc->quantity : 0,
1310 =item num_cust_svc [ SVCPART ]
1312 Returns the number of provisioned services for this package. If a svcpart is
1313 specified, counts only the matching services.
1319 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1320 $sql .= ' AND svcpart = ?' if @_;
1321 my $sth = dbh->prepare($sql) or die dbh->errstr;
1322 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1323 $sth->fetchrow_arrayref->[0];
1326 =item available_part_svc
1328 Returns a list of FS::part_svc objects representing services included in this
1329 package but not yet provisioned. Each FS::part_svc object also has an extra
1330 field, I<num_avail>, which specifies the number of available services.
1334 sub available_part_svc {
1336 grep { $_->num_avail > 0 }
1338 my $part_svc = $_->part_svc;
1339 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1340 $_->quantity - $self->num_cust_svc($_->svcpart);
1343 $self->part_pkg->pkg_svc;
1348 Returns a list of FS::part_svc objects representing provisioned and available
1349 services included in this package. Each FS::part_svc object also has the
1350 following extra fields:
1354 =item num_cust_svc (count)
1356 =item num_avail (quantity - count)
1358 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1361 label -> ($cust_svc->label)[1]
1370 #XXX some sort of sort order besides numeric by svcpart...
1371 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1373 my $part_svc = $pkg_svc->part_svc;
1374 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1375 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1376 $part_svc->{'Hash'}{'num_avail'} =
1377 max( 0, $pkg_svc->quantity - $num_cust_svc );
1378 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1380 } $self->part_pkg->pkg_svc;
1383 push @part_svc, map {
1385 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1386 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1387 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1388 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1390 } $self->extra_part_svc;
1396 =item extra_part_svc
1398 Returns a list of FS::part_svc objects corresponding to services in this
1399 package which are still provisioned but not (any longer) available in the
1404 sub extra_part_svc {
1407 my $pkgnum = $self->pkgnum;
1408 my $pkgpart = $self->pkgpart;
1411 'table' => 'part_svc',
1413 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1414 WHERE pkg_svc.svcpart = part_svc.svcpart
1415 AND pkg_svc.pkgpart = $pkgpart
1418 AND 0 < ( SELECT count(*)
1420 LEFT JOIN cust_pkg using ( pkgnum )
1421 WHERE cust_svc.svcpart = part_svc.svcpart
1422 AND pkgnum = $pkgnum
1429 Returns a short status string for this package, currently:
1433 =item not yet billed
1435 =item one-time charge
1450 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1452 return 'cancelled' if $self->get('cancel');
1453 return 'suspended' if $self->susp;
1454 return 'not yet billed' unless $self->setup;
1455 return 'one-time charge' if $freq =~ /^(0|$)/;
1461 Class method that returns the list of possible status strings for packages
1462 (see L<the status method|/status>). For example:
1464 @statuses = FS::cust_pkg->statuses();
1468 tie my %statuscolor, 'Tie::IxHash',
1469 'not yet billed' => '000000',
1470 'one-time charge' => '000000',
1471 'active' => '00CC00',
1472 'suspended' => 'FF9900',
1473 'cancelled' => 'FF0000',
1477 my $self = shift; #could be class...
1478 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1479 # mayble split btw one-time vs. recur
1485 Returns a hex triplet color string for this package's status.
1491 $statuscolor{$self->status};
1496 Returns a list of lists, calling the label method for all services
1497 (see L<FS::cust_svc>) of this billing item.
1503 map { [ $_->label ] } $self->cust_svc;
1506 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1508 Like the labels method, but returns historical information on services that
1509 were active as of END_TIMESTAMP and (optionally) not cancelled before
1512 Returns a list of lists, calling the label method for all (historical) services
1513 (see L<FS::h_cust_svc>) of this billing item.
1519 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1522 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1524 Like h_labels, except returns a simple flat list, and shortens long
1525 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1526 identical services to one line that lists the service label and the number of
1527 individual services rather than individual items.
1531 sub h_labels_short {
1534 my $conf = new FS::Conf;
1535 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1538 #tie %labels, 'Tie::IxHash';
1539 push @{ $labels{$_->[0]} }, $_->[1]
1540 foreach $self->h_labels(@_);
1542 foreach my $label ( keys %labels ) {
1544 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1545 my $num = scalar(@values);
1546 if ( $num > $max_same_services ) {
1547 push @labels, "$label ($num)";
1549 push @labels, map { "$label: $_" } @values;
1559 Returns the parent customer object (see L<FS::cust_main>).
1565 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1568 =item seconds_since TIMESTAMP
1570 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1571 package have been online since TIMESTAMP, according to the session monitor.
1573 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1574 L<Time::Local> and L<Date::Parse> for conversion functions.
1579 my($self, $since) = @_;
1582 foreach my $cust_svc (
1583 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1585 $seconds += $cust_svc->seconds_since($since);
1592 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1594 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1595 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1598 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1599 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1605 sub seconds_since_sqlradacct {
1606 my($self, $start, $end) = @_;
1610 foreach my $cust_svc (
1612 my $part_svc = $_->part_svc;
1613 $part_svc->svcdb eq 'svc_acct'
1614 && scalar($part_svc->part_export('sqlradius'));
1617 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1624 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1626 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1627 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1631 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1632 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1637 sub attribute_since_sqlradacct {
1638 my($self, $start, $end, $attrib) = @_;
1642 foreach my $cust_svc (
1644 my $part_svc = $_->part_svc;
1645 $part_svc->svcdb eq 'svc_acct'
1646 && scalar($part_svc->part_export('sqlradius'));
1649 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1661 my( $self, $value ) = @_;
1662 if ( defined($value) ) {
1663 $self->setfield('quantity', $value);
1665 $self->getfield('quantity') || 1;
1668 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1670 Transfers as many services as possible from this package to another package.
1672 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1673 object. The destination package must already exist.
1675 Services are moved only if the destination allows services with the correct
1676 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1677 this option with caution! No provision is made for export differences
1678 between the old and new service definitions. Probably only should be used
1679 when your exports for all service definitions of a given svcdb are identical.
1680 (attempt a transfer without it first, to move all possible svcpart-matching
1683 Any services that can't be moved remain in the original package.
1685 Returns an error, if there is one; otherwise, returns the number of services
1686 that couldn't be moved.
1691 my ($self, $dest_pkgnum, %opt) = @_;
1697 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1698 $dest = $dest_pkgnum;
1699 $dest_pkgnum = $dest->pkgnum;
1701 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1704 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1706 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1707 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1710 foreach my $cust_svc ($dest->cust_svc) {
1711 $target{$cust_svc->svcpart}--;
1714 my %svcpart2svcparts = ();
1715 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1716 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1717 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1718 next if exists $svcpart2svcparts{$svcpart};
1719 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1720 $svcpart2svcparts{$svcpart} = [
1722 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1724 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1725 'svcpart' => $_ } );
1727 $pkg_svc ? $pkg_svc->primary_svc : '',
1728 $pkg_svc ? $pkg_svc->quantity : 0,
1732 grep { $_ != $svcpart }
1734 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1736 warn "alternates for svcpart $svcpart: ".
1737 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1742 foreach my $cust_svc ($self->cust_svc) {
1743 if($target{$cust_svc->svcpart} > 0) {
1744 $target{$cust_svc->svcpart}--;
1745 my $new = new FS::cust_svc { $cust_svc->hash };
1746 $new->pkgnum($dest_pkgnum);
1747 my $error = $new->replace($cust_svc);
1748 return $error if $error;
1749 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1751 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1752 warn "alternates to consider: ".
1753 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1755 my @alternate = grep {
1756 warn "considering alternate svcpart $_: ".
1757 "$target{$_} available in new package\n"
1760 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1762 warn "alternate(s) found\n" if $DEBUG;
1763 my $change_svcpart = $alternate[0];
1764 $target{$change_svcpart}--;
1765 my $new = new FS::cust_svc { $cust_svc->hash };
1766 $new->svcpart($change_svcpart);
1767 $new->pkgnum($dest_pkgnum);
1768 my $error = $new->replace($cust_svc);
1769 return $error if $error;
1782 This method is deprecated. See the I<depend_jobnum> option to the insert and
1783 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1790 local $SIG{HUP} = 'IGNORE';
1791 local $SIG{INT} = 'IGNORE';
1792 local $SIG{QUIT} = 'IGNORE';
1793 local $SIG{TERM} = 'IGNORE';
1794 local $SIG{TSTP} = 'IGNORE';
1795 local $SIG{PIPE} = 'IGNORE';
1797 my $oldAutoCommit = $FS::UID::AutoCommit;
1798 local $FS::UID::AutoCommit = 0;
1801 foreach my $cust_svc ( $self->cust_svc ) {
1802 #false laziness w/svc_Common::insert
1803 my $svc_x = $cust_svc->svc_x;
1804 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1805 my $error = $part_export->export_insert($svc_x);
1807 $dbh->rollback if $oldAutoCommit;
1813 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1820 =head1 CLASS METHODS
1826 Returns an SQL expression identifying recurring packages.
1830 sub recurring_sql { "
1831 '0' != ( select freq from part_pkg
1832 where cust_pkg.pkgpart = part_pkg.pkgpart )
1837 Returns an SQL expression identifying one-time packages.
1842 '0' = ( select freq from part_pkg
1843 where cust_pkg.pkgpart = part_pkg.pkgpart )
1848 Returns an SQL expression identifying active packages.
1853 ". $_[0]->recurring_sql(). "
1854 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1855 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1860 Returns an SQL expression identifying inactive packages (one-time packages
1861 that are otherwise unsuspended/uncancelled).
1865 sub inactive_sql { "
1866 ". $_[0]->onetime_sql(). "
1867 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1868 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1874 Returns an SQL expression identifying suspended packages.
1878 sub suspended_sql { susp_sql(@_); }
1880 #$_[0]->recurring_sql(). ' AND '.
1882 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1883 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
1890 Returns an SQL exprression identifying cancelled packages.
1894 sub cancelled_sql { cancel_sql(@_); }
1896 #$_[0]->recurring_sql(). ' AND '.
1897 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1900 =item search_sql HASHREF
1904 Returns a qsearch hash expression to search for parameters specified in HASHREF.
1905 Valid parameters are
1913 active, inactive, suspended, cancel (or cancelled)
1917 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
1927 arrayref of beginning and ending epoch date
1931 arrayref of beginning and ending epoch date
1935 arrayref of beginning and ending epoch date
1939 arrayref of beginning and ending epoch date
1943 arrayref of beginning and ending epoch date
1947 arrayref of beginning and ending epoch date
1951 arrayref of beginning and ending epoch date
1955 pkgnum or APKG_pkgnum
1959 a value suited to passing to FS::UI::Web::cust_header
1963 specifies the user for agent virtualization
1970 my ($class, $params) = @_;
1977 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1979 "cust_main.agentnum = $1";
1986 if ( $params->{'magic'} eq 'active'
1987 || $params->{'status'} eq 'active' ) {
1989 push @where, FS::cust_pkg->active_sql();
1991 } elsif ( $params->{'magic'} eq 'inactive'
1992 || $params->{'status'} eq 'inactive' ) {
1994 push @where, FS::cust_pkg->inactive_sql();
1996 } elsif ( $params->{'magic'} eq 'suspended'
1997 || $params->{'status'} eq 'suspended' ) {
1999 push @where, FS::cust_pkg->suspended_sql();
2001 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2002 || $params->{'status'} =~ /^cancell?ed$/ ) {
2004 push @where, FS::cust_pkg->cancelled_sql();
2006 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
2008 push @where, FS::cust_pkg->inactive_sql();
2013 # parse package class
2016 #false lazinessish w/graph/cust_bill_pkg.cgi
2019 if ( exists($params->{'classnum'})
2020 && $params->{'classnum'} =~ /^(\d*)$/
2024 if ( $classnum ) { #a specific class
2025 push @where, "classnum = $classnum";
2027 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2028 #die "classnum $classnum not found!" unless $pkg_class[0];
2029 #$title .= $pkg_class[0]->classname.' ';
2031 } elsif ( $classnum eq '' ) { #the empty class
2033 push @where, "classnum IS NULL";
2034 #$title .= 'Empty class ';
2035 #@pkg_class = ( '(empty class)' );
2036 } elsif ( $classnum eq '0' ) {
2037 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2038 #push @pkg_class, '(empty class)';
2040 die "illegal classnum";
2049 my $pkgpart = join (' OR pkgpart=',
2050 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2051 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2059 #false laziness w/report_cust_pkg.html
2062 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2063 'active' => { 'susp'=>1, 'cancel'=>1 },
2064 'suspended' => { 'cancel' => 1 },
2069 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2071 next unless exists($params->{$field});
2073 my($beginning, $ending) = @{$params->{$field}};
2075 next if $beginning == 0 && $ending == 4294967295;
2078 "cust_pkg.$field IS NOT NULL",
2079 "cust_pkg.$field >= $beginning",
2080 "cust_pkg.$field <= $ending";
2082 $orderby ||= "ORDER BY cust_pkg.$field";
2086 $orderby ||= 'ORDER BY bill';
2089 # parse magic, legacy, etc.
2092 if ( $params->{'magic'} &&
2093 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2096 $orderby = 'ORDER BY pkgnum';
2098 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2099 push @where, "pkgpart = $1";
2102 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2104 $orderby = 'ORDER BY pkgnum';
2106 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2108 $orderby = 'ORDER BY pkgnum';
2111 SELECT count(*) FROM pkg_svc
2112 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2113 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2114 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2115 AND cust_svc.svcpart = pkg_svc.svcpart
2122 # setup queries, links, subs, etc. for the search
2125 # here is the agent virtualization
2126 if ($params->{CurrentUser}) {
2128 qsearchs('access_user', { username => $params->{CurrentUser} });
2131 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2136 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2139 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2141 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2142 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2143 'LEFT JOIN pkg_class USING ( classnum ) ';
2145 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2148 'table' => 'cust_pkg',
2150 'select' => join(', ',
2152 ( map "part_pkg.$_", qw( pkg freq ) ),
2153 'pkg_class.classname',
2154 'cust_main.custnum as cust_main_custnum',
2155 FS::UI::Web::cust_sql_fields(
2156 $params->{'cust_fields'}
2159 'extra_sql' => "$extra_sql $orderby",
2160 'addl_from' => $addl_from,
2161 'count_query' => $count_query,
2170 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2172 CUSTNUM is a customer (see L<FS::cust_main>)
2174 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2175 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2178 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2179 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2180 new billing items. An error is returned if this is not possible (see
2181 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2184 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2185 newly-created cust_pkg objects.
2187 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2188 and inserted. Multiple FS::pkg_referral records can be created by
2189 setting I<refnum> to an array reference of refnums or a hash reference with
2190 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2191 record will be created corresponding to cust_main.refnum.
2196 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2198 my $conf = new FS::Conf;
2200 # Transactionize this whole mess
2201 local $SIG{HUP} = 'IGNORE';
2202 local $SIG{INT} = 'IGNORE';
2203 local $SIG{QUIT} = 'IGNORE';
2204 local $SIG{TERM} = 'IGNORE';
2205 local $SIG{TSTP} = 'IGNORE';
2206 local $SIG{PIPE} = 'IGNORE';
2208 my $oldAutoCommit = $FS::UID::AutoCommit;
2209 local $FS::UID::AutoCommit = 0;
2213 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2214 return "Customer not found: $custnum" unless $cust_main;
2216 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2219 my $change = scalar(@old_cust_pkg) != 0;
2222 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2226 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
2228 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
2229 $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
2231 $hash{'change_date'} = $time;
2232 $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
2235 # Create the new packages.
2236 foreach my $pkgpart (@$pkgparts) {
2237 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2238 pkgpart => $pkgpart,
2242 $error = $cust_pkg->insert( 'change' => $change );
2244 $dbh->rollback if $oldAutoCommit;
2247 push @$return_cust_pkg, $cust_pkg;
2249 # $return_cust_pkg now contains refs to all of the newly
2252 # Transfer services and cancel old packages.
2253 foreach my $old_pkg (@old_cust_pkg) {
2255 foreach my $new_pkg (@$return_cust_pkg) {
2256 $error = $old_pkg->transfer($new_pkg);
2257 if ($error and $error == 0) {
2258 # $old_pkg->transfer failed.
2259 $dbh->rollback if $oldAutoCommit;
2264 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2265 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2266 foreach my $new_pkg (@$return_cust_pkg) {
2267 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2268 if ($error and $error == 0) {
2269 # $old_pkg->transfer failed.
2270 $dbh->rollback if $oldAutoCommit;
2277 # Transfers were successful, but we went through all of the
2278 # new packages and still had services left on the old package.
2279 # We can't cancel the package under the circumstances, so abort.
2280 $dbh->rollback if $oldAutoCommit;
2281 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2283 $error = $old_pkg->cancel( quiet=>1 );
2289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2293 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2295 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2296 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2299 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2300 replace. The services (see L<FS::cust_svc>) are moved to the
2301 new billing items. An error is returned if this is not possible (see
2304 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2305 newly-created cust_pkg objects.
2310 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2312 # Transactionize this whole mess
2313 local $SIG{HUP} = 'IGNORE';
2314 local $SIG{INT} = 'IGNORE';
2315 local $SIG{QUIT} = 'IGNORE';
2316 local $SIG{TERM} = 'IGNORE';
2317 local $SIG{TSTP} = 'IGNORE';
2318 local $SIG{PIPE} = 'IGNORE';
2320 my $oldAutoCommit = $FS::UID::AutoCommit;
2321 local $FS::UID::AutoCommit = 0;
2325 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2328 while(scalar(@old_cust_pkg)) {
2330 my $custnum = $old_cust_pkg[0]->custnum;
2331 my (@remove) = map { $_->pkgnum }
2332 grep { $_->custnum == $custnum } @old_cust_pkg;
2333 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2335 my $error = order $custnum, $pkgparts, \@remove, \@return;
2337 push @errors, $error
2339 push @$return_cust_pkg, @return;
2342 if (scalar(@errors)) {
2343 $dbh->rollback if $oldAutoCommit;
2344 return join(' / ', @errors);
2347 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2353 Associates this package with a (suspension or cancellation) reason (see
2354 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2357 Available options are:
2363 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.
2367 the access_user (see L<FS::access_user>) providing the reason
2375 the action (cancel, susp, adjourn, expire) associated with the reason
2379 If there is an error, returns the error, otherwise returns false.
2384 my ($self, %options) = @_;
2386 my $otaker = $options{reason_otaker} ||
2387 $FS::CurrentUser::CurrentUser->username;
2390 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2394 } elsif ( ref($options{'reason'}) ) {
2396 return 'Enter a new reason (or select an existing one)'
2397 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2399 my $reason = new FS::reason({
2400 'reason_type' => $options{'reason'}->{'typenum'},
2401 'reason' => $options{'reason'}->{'reason'},
2403 my $error = $reason->insert;
2404 return $error if $error;
2406 $reasonnum = $reason->reasonnum;
2409 return "Unparsable reason: ". $options{'reason'};
2412 my $cust_pkg_reason =
2413 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2414 'reasonnum' => $reasonnum,
2415 'otaker' => $otaker,
2416 'action' => substr(uc($options{'action'}),0,1),
2417 'date' => $options{'date'}
2422 $cust_pkg_reason->insert;
2425 =item set_usage USAGE_VALUE_HASHREF
2427 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2428 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2429 upbytes, downbytes, and totalbytes are appropriate keys.
2431 All svc_accts which are part of this package have their values reset.
2436 my ($self, $valueref) = @_;
2438 foreach my $cust_svc ($self->cust_svc){
2439 my $svc_x = $cust_svc->svc_x;
2440 $svc_x->set_usage($valueref)
2441 if $svc_x->can("set_usage");
2445 =item recharge USAGE_VALUE_HASHREF
2447 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2448 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2449 upbytes, downbytes, and totalbytes are appropriate keys.
2451 All svc_accts which are part of this package have their values incremented.
2456 my ($self, $valueref) = @_;
2458 foreach my $cust_svc ($self->cust_svc){
2459 my $svc_x = $cust_svc->svc_x;
2460 $svc_x->recharge($valueref)
2461 if $svc_x->can("recharge");
2469 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2471 In sub order, the @pkgparts array (passed by reference) is clobbered.
2473 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2474 method to pass dates to the recur_prog expression, it should do so.
2476 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2477 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2478 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2479 configuration values. Probably need a subroutine which decides what to do
2480 based on whether or not we've fetched the user yet, rather than a hash. See
2481 FS::UID and the TODO.
2483 Now that things are transactional should the check in the insert method be
2488 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2489 L<FS::pkg_svc>, schema.html from the base documentation