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 'date' => $date ? $date : $cancel_time,
555 'reason_otaker' => $options{'reason_otaker'},
558 dbh->rollback if $oldAutoCommit;
559 return "Error inserting cust_pkg_reason: $error";
565 foreach my $cust_svc (
568 sort { $a->[1] <=> $b->[1] }
569 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
570 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
573 my $error = $cust_svc->cancel;
576 $dbh->rollback if $oldAutoCommit;
577 return "Error cancelling cust_svc: $error";
581 # Add a credit for remaining service
582 my $remaining_value = $self->calc_remain(time=>$cancel_time);
583 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
584 my $conf = new FS::Conf;
585 my $error = $self->cust_main->credit(
587 'Credit for unused time on '. $self->part_pkg->pkg,
588 'reason_type' => $conf->config('cancel_credit_type'),
591 $dbh->rollback if $oldAutoCommit;
592 return "Error crediting customer \$$remaining_value for unused time on".
593 $self->part_pkg->pkg. ": $error";
598 my %hash = $self->hash;
599 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
600 my $new = new FS::cust_pkg ( \%hash );
601 $error = $new->replace( $self, options => { $self->options } );
603 $dbh->rollback if $oldAutoCommit;
607 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
608 return '' if $date; #no errors
610 my $conf = new FS::Conf;
611 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
612 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
613 my $conf = new FS::Conf;
614 my $error = send_email(
615 'from' => $conf->config('invoice_from'),
616 'to' => \@invoicing_list,
617 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
618 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
620 #should this do something on errors?
627 =item cancel_if_expired [ NOW_TIMESTAMP ]
629 Cancels this package if its expire date has been reached.
633 sub cancel_if_expired {
635 my $time = shift || time;
636 return '' unless $self->expire && $self->expire <= $time;
637 my $error = $self->cancel;
639 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
640 $self->custnum. ": $error";
647 Cancels any pending expiration (sets the expire field to null).
649 If there is an error, returns the error, otherwise returns false.
654 my( $self, %options ) = @_;
657 local $SIG{HUP} = 'IGNORE';
658 local $SIG{INT} = 'IGNORE';
659 local $SIG{QUIT} = 'IGNORE';
660 local $SIG{TERM} = 'IGNORE';
661 local $SIG{TSTP} = 'IGNORE';
662 local $SIG{PIPE} = 'IGNORE';
664 my $oldAutoCommit = $FS::UID::AutoCommit;
665 local $FS::UID::AutoCommit = 0;
668 my $old = $self->select_for_update;
670 my $pkgnum = $old->pkgnum;
671 if ( $old->get('cancel') || $self->get('cancel') ) {
672 dbh->rollback if $oldAutoCommit;
673 return "Can't unexpire cancelled package $pkgnum";
674 # or at least it's pointless
677 unless ( $old->get('expire') && $self->get('expire') ) {
678 dbh->rollback if $oldAutoCommit;
679 return ""; # no error
682 my %hash = $self->hash;
683 $hash{'expire'} = '';
684 my $new = new FS::cust_pkg ( \%hash );
685 $error = $new->replace( $self, options => { $self->options } );
687 $dbh->rollback if $oldAutoCommit;
691 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
697 =item suspend [ OPTION => VALUE ... ]
699 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
700 package, then suspends the package itself (sets the susp field to now).
702 Available options are:
706 =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.
708 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
712 If there is an error, returns the error, otherwise returns false.
717 my( $self, %options ) = @_;
720 local $SIG{HUP} = 'IGNORE';
721 local $SIG{INT} = 'IGNORE';
722 local $SIG{QUIT} = 'IGNORE';
723 local $SIG{TERM} = 'IGNORE';
724 local $SIG{TSTP} = 'IGNORE';
725 local $SIG{PIPE} = 'IGNORE';
727 my $oldAutoCommit = $FS::UID::AutoCommit;
728 local $FS::UID::AutoCommit = 0;
731 my $old = $self->select_for_update;
733 my $pkgnum = $old->pkgnum;
734 if ( $old->get('cancel') || $self->get('cancel') ) {
735 dbh->rollback if $oldAutoCommit;
736 return "Can't suspend cancelled package $pkgnum";
739 if ( $old->get('susp') || $self->get('susp') ) {
740 dbh->rollback if $oldAutoCommit;
741 return ""; # no error # complain on adjourn?
744 my $date = $options{date} if $options{date}; # adjourn/suspend later
745 $date = '' if ($date && $date <= time); # complain instead?
747 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
748 dbh->rollback if $oldAutoCommit;
749 return "Package $pkgnum expires before it would be suspended.";
752 my $suspend_time = $options{'time'} || time;
754 if ( $options{'reason'} ) {
755 $error = $self->insert_reason( 'reason' => $options{'reason'},
756 'action' => $date ? 'adjourn' : 'suspend',
757 'date' => $date ? $date : $suspend_time,
758 'reason_otaker' => $options{'reason_otaker'},
761 dbh->rollback if $oldAutoCommit;
762 return "Error inserting cust_pkg_reason: $error";
770 foreach my $cust_svc (
771 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
773 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
775 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
776 $dbh->rollback if $oldAutoCommit;
777 return "Illegal svcdb value in part_svc!";
780 require "FS/$svcdb.pm";
782 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
784 $error = $svc->suspend;
786 $dbh->rollback if $oldAutoCommit;
789 my( $label, $value ) = $cust_svc->label;
790 push @labels, "$label: $value";
794 my $conf = new FS::Conf;
795 if ( $conf->config('suspend_email_admin') ) {
797 my $error = send_email(
798 'from' => $conf->config('invoice_from'), #??? well as good as any
799 'to' => $conf->config('suspend_email_admin'),
800 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
802 "This is an automatic message from your Freeside installation\n",
803 "informing you that the following customer package has been suspended:\n",
805 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
806 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
807 ( map { "Service : $_\n" } @labels ),
812 warn "WARNING: can't send suspension admin email (suspending anyway): ".
820 my %hash = $self->hash;
822 $hash{'adjourn'} = $date;
824 $hash{'susp'} = $suspend_time;
826 my $new = new FS::cust_pkg ( \%hash );
827 $error = $new->replace( $self, options => { $self->options } );
829 $dbh->rollback if $oldAutoCommit;
833 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
838 =item unsuspend [ OPTION => VALUE ... ]
840 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
841 package, then unsuspends the package itself (clears the susp field and the
842 adjourn field if it is in the past).
844 Available options are:
848 =item adjust_next_bill
850 Can be set true to adjust the next bill date forward by
851 the amount of time the account was inactive. This was set true by default
852 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
853 explicitly requested. Price plans for which this makes sense (anniversary-date
854 based than prorate or subscription) could have an option to enable this
859 If there is an error, returns the error, otherwise returns false.
864 my( $self, %opt ) = @_;
867 local $SIG{HUP} = 'IGNORE';
868 local $SIG{INT} = 'IGNORE';
869 local $SIG{QUIT} = 'IGNORE';
870 local $SIG{TERM} = 'IGNORE';
871 local $SIG{TSTP} = 'IGNORE';
872 local $SIG{PIPE} = 'IGNORE';
874 my $oldAutoCommit = $FS::UID::AutoCommit;
875 local $FS::UID::AutoCommit = 0;
878 my $old = $self->select_for_update;
880 my $pkgnum = $old->pkgnum;
881 if ( $old->get('cancel') || $self->get('cancel') ) {
882 dbh->rollback if $oldAutoCommit;
883 return "Can't unsuspend cancelled package $pkgnum";
886 unless ( $old->get('susp') && $self->get('susp') ) {
887 dbh->rollback if $oldAutoCommit;
888 return ""; # no error # complain instead?
891 foreach my $cust_svc (
892 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
894 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
896 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
897 $dbh->rollback if $oldAutoCommit;
898 return "Illegal svcdb value in part_svc!";
901 require "FS/$svcdb.pm";
903 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
905 $error = $svc->unsuspend;
907 $dbh->rollback if $oldAutoCommit;
914 my %hash = $self->hash;
915 my $inactive = time - $hash{'susp'};
917 my $conf = new FS::Conf;
919 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
920 if ( $opt{'adjust_next_bill'}
921 || $conf->config('unsuspend-always_adjust_next_bill_date') )
922 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
925 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
926 my $new = new FS::cust_pkg ( \%hash );
927 $error = $new->replace( $self, options => { $self->options } );
929 $dbh->rollback if $oldAutoCommit;
933 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
940 Cancels any pending suspension (sets the adjourn field to null).
942 If there is an error, returns the error, otherwise returns false.
947 my( $self, %options ) = @_;
950 local $SIG{HUP} = 'IGNORE';
951 local $SIG{INT} = 'IGNORE';
952 local $SIG{QUIT} = 'IGNORE';
953 local $SIG{TERM} = 'IGNORE';
954 local $SIG{TSTP} = 'IGNORE';
955 local $SIG{PIPE} = 'IGNORE';
957 my $oldAutoCommit = $FS::UID::AutoCommit;
958 local $FS::UID::AutoCommit = 0;
961 my $old = $self->select_for_update;
963 my $pkgnum = $old->pkgnum;
964 if ( $old->get('cancel') || $self->get('cancel') ) {
965 dbh->rollback if $oldAutoCommit;
966 return "Can't unadjourn cancelled package $pkgnum";
967 # or at least it's pointless
970 if ( $old->get('susp') || $self->get('susp') ) {
971 dbh->rollback if $oldAutoCommit;
972 return "Can't unadjourn suspended package $pkgnum";
973 # perhaps this is arbitrary
976 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
977 dbh->rollback if $oldAutoCommit;
978 return ""; # no error
981 my %hash = $self->hash;
982 $hash{'adjourn'} = '';
983 my $new = new FS::cust_pkg ( \%hash );
984 $error = $new->replace( $self, options => { $self->options } );
986 $dbh->rollback if $oldAutoCommit;
990 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
998 Returns the last bill date, or if there is no last bill date, the setup date.
999 Useful for billing metered services.
1005 return $self->setfield('last_bill', $_[0]) if @_;
1006 return $self->getfield('last_bill') if $self->getfield('last_bill');
1007 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1008 'edate' => $self->bill, } );
1009 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1012 =item last_cust_pkg_reason ACTION
1014 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1015 Returns false if there is no reason or the package is not currenly ACTION'd
1016 ACTION is one of adjourn, susp, cancel, or expire.
1020 sub last_cust_pkg_reason {
1021 my ( $self, $action ) = ( shift, shift );
1022 my $date = $self->get($action);
1024 'table' => 'cust_pkg_reason',
1025 'hashref' => { 'pkgnum' => $self->pkgnum,
1026 'action' => substr(uc($action), 0, 1),
1029 'order_by' => 'ORDER BY num DESC LIMIT 1',
1033 =item last_reason ACTION
1035 Returns the most recent ACTION FS::reason associated with the package.
1036 Returns false if there is no reason or the package is not currenly ACTION'd
1037 ACTION is one of adjourn, susp, cancel, or expire.
1042 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1043 $cust_pkg_reason->reason
1044 if $cust_pkg_reason;
1049 Returns the definition for this billing item, as an FS::part_pkg object (see
1056 #exists( $self->{'_pkgpart'} )
1058 ? $self->{'_pkgpart'}
1059 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1064 Returns the cancelled package this package was changed from, if any.
1070 return '' unless $self->change_pkgnum;
1071 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1076 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1083 $self->part_pkg->calc_setup($self, @_);
1088 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1095 $self->part_pkg->calc_recur($self, @_);
1100 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1107 $self->part_pkg->calc_remain($self, @_);
1112 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1119 $self->part_pkg->calc_cancel($self, @_);
1124 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1130 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1133 =item cust_pkg_detail [ DETAILTYPE ]
1135 Returns any customer package details for this package (see
1136 L<FS::cust_pkg_detail>).
1138 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1142 sub cust_pkg_detail {
1144 my %hash = ( 'pkgnum' => $self->pkgnum );
1145 $hash{detailtype} = shift if @_;
1147 'table' => 'cust_pkg_detail',
1148 'hashref' => \%hash,
1149 'order_by' => 'ORDER BY weight, pkgdetailnum',
1153 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1155 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1157 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1159 If there is an error, returns the error, otherwise returns false.
1163 sub set_cust_pkg_detail {
1164 my( $self, $detailtype, @details ) = @_;
1166 local $SIG{HUP} = 'IGNORE';
1167 local $SIG{INT} = 'IGNORE';
1168 local $SIG{QUIT} = 'IGNORE';
1169 local $SIG{TERM} = 'IGNORE';
1170 local $SIG{TSTP} = 'IGNORE';
1171 local $SIG{PIPE} = 'IGNORE';
1173 my $oldAutoCommit = $FS::UID::AutoCommit;
1174 local $FS::UID::AutoCommit = 0;
1177 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1178 my $error = $current->delete;
1180 $dbh->rollback if $oldAutoCommit;
1181 return "error removing old detail: $error";
1185 foreach my $detail ( @details ) {
1186 my $cust_pkg_detail = new FS::cust_pkg_detail {
1187 'pkgnum' => $self->pkgnum,
1188 'detailtype' => $detailtype,
1189 'detail' => $detail,
1191 my $error = $cust_pkg_detail->insert;
1193 $dbh->rollback if $oldAutoCommit;
1194 return "error adding new detail: $error";
1199 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1206 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1210 #false laziness w/cust_bill.pm
1214 'table' => 'cust_event',
1215 'addl_from' => 'JOIN part_event USING ( eventpart )',
1216 'hashref' => { 'tablenum' => $self->pkgnum },
1217 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1221 =item num_cust_event
1223 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1227 #false laziness w/cust_bill.pm
1228 sub num_cust_event {
1231 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1232 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1233 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1234 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1235 $sth->fetchrow_arrayref->[0];
1238 =item cust_svc [ SVCPART ]
1240 Returns the services for this package, as FS::cust_svc objects (see
1241 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1250 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1251 'svcpart' => shift, } );
1254 #if ( $self->{'_svcnum'} ) {
1255 # values %{ $self->{'_svcnum'}->cache };
1257 $self->_sort_cust_svc(
1258 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1264 =item overlimit [ SVCPART ]
1266 Returns the services for this package which have exceeded their
1267 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1268 is specified, return only the matching services.
1274 grep { $_->overlimit } $self->cust_svc;
1277 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1279 Returns historical services for this package created before END TIMESTAMP and
1280 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1281 (see L<FS::h_cust_svc>).
1288 $self->_sort_cust_svc(
1289 [ qsearch( 'h_cust_svc',
1290 { 'pkgnum' => $self->pkgnum, },
1291 FS::h_cust_svc->sql_h_search(@_),
1297 sub _sort_cust_svc {
1298 my( $self, $arrayref ) = @_;
1301 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1303 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1304 'svcpart' => $_->svcpart } );
1306 $pkg_svc ? $pkg_svc->primary_svc : '',
1307 $pkg_svc ? $pkg_svc->quantity : 0,
1314 =item num_cust_svc [ SVCPART ]
1316 Returns the number of provisioned services for this package. If a svcpart is
1317 specified, counts only the matching services.
1323 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1324 $sql .= ' AND svcpart = ?' if @_;
1325 my $sth = dbh->prepare($sql) or die dbh->errstr;
1326 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1327 $sth->fetchrow_arrayref->[0];
1330 =item available_part_svc
1332 Returns a list of FS::part_svc objects representing services included in this
1333 package but not yet provisioned. Each FS::part_svc object also has an extra
1334 field, I<num_avail>, which specifies the number of available services.
1338 sub available_part_svc {
1340 grep { $_->num_avail > 0 }
1342 my $part_svc = $_->part_svc;
1343 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1344 $_->quantity - $self->num_cust_svc($_->svcpart);
1347 $self->part_pkg->pkg_svc;
1352 Returns a list of FS::part_svc objects representing provisioned and available
1353 services included in this package. Each FS::part_svc object also has the
1354 following extra fields:
1358 =item num_cust_svc (count)
1360 =item num_avail (quantity - count)
1362 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1365 label -> ($cust_svc->label)[1]
1374 #XXX some sort of sort order besides numeric by svcpart...
1375 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1377 my $part_svc = $pkg_svc->part_svc;
1378 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1379 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1380 $part_svc->{'Hash'}{'num_avail'} =
1381 max( 0, $pkg_svc->quantity - $num_cust_svc );
1382 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1384 } $self->part_pkg->pkg_svc;
1387 push @part_svc, map {
1389 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1390 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1391 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1392 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1394 } $self->extra_part_svc;
1400 =item extra_part_svc
1402 Returns a list of FS::part_svc objects corresponding to services in this
1403 package which are still provisioned but not (any longer) available in the
1408 sub extra_part_svc {
1411 my $pkgnum = $self->pkgnum;
1412 my $pkgpart = $self->pkgpart;
1415 'table' => 'part_svc',
1417 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1418 WHERE pkg_svc.svcpart = part_svc.svcpart
1419 AND pkg_svc.pkgpart = $pkgpart
1422 AND 0 < ( SELECT count(*)
1424 LEFT JOIN cust_pkg using ( pkgnum )
1425 WHERE cust_svc.svcpart = part_svc.svcpart
1426 AND pkgnum = $pkgnum
1433 Returns a short status string for this package, currently:
1437 =item not yet billed
1439 =item one-time charge
1454 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1456 return 'cancelled' if $self->get('cancel');
1457 return 'suspended' if $self->susp;
1458 return 'not yet billed' unless $self->setup;
1459 return 'one-time charge' if $freq =~ /^(0|$)/;
1465 Class method that returns the list of possible status strings for packages
1466 (see L<the status method|/status>). For example:
1468 @statuses = FS::cust_pkg->statuses();
1472 tie my %statuscolor, 'Tie::IxHash',
1473 'not yet billed' => '000000',
1474 'one-time charge' => '000000',
1475 'active' => '00CC00',
1476 'suspended' => 'FF9900',
1477 'cancelled' => 'FF0000',
1481 my $self = shift; #could be class...
1482 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1483 # mayble split btw one-time vs. recur
1489 Returns a hex triplet color string for this package's status.
1495 $statuscolor{$self->status};
1500 Returns a list of lists, calling the label method for all services
1501 (see L<FS::cust_svc>) of this billing item.
1507 map { [ $_->label ] } $self->cust_svc;
1510 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1512 Like the labels method, but returns historical information on services that
1513 were active as of END_TIMESTAMP and (optionally) not cancelled before
1516 Returns a list of lists, calling the label method for all (historical) services
1517 (see L<FS::h_cust_svc>) of this billing item.
1523 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1526 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1528 Like h_labels, except returns a simple flat list, and shortens long
1529 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1530 identical services to one line that lists the service label and the number of
1531 individual services rather than individual items.
1535 sub h_labels_short {
1538 my $conf = new FS::Conf;
1539 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1542 #tie %labels, 'Tie::IxHash';
1543 push @{ $labels{$_->[0]} }, $_->[1]
1544 foreach $self->h_labels(@_);
1546 foreach my $label ( keys %labels ) {
1548 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1549 my $num = scalar(@values);
1550 if ( $num > $max_same_services ) {
1551 push @labels, "$label ($num)";
1553 push @labels, map { "$label: $_" } @values;
1563 Returns the parent customer object (see L<FS::cust_main>).
1569 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1572 =item seconds_since TIMESTAMP
1574 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1575 package have been online since TIMESTAMP, according to the session monitor.
1577 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1578 L<Time::Local> and L<Date::Parse> for conversion functions.
1583 my($self, $since) = @_;
1586 foreach my $cust_svc (
1587 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1589 $seconds += $cust_svc->seconds_since($since);
1596 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1598 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1599 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1602 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1603 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1609 sub seconds_since_sqlradacct {
1610 my($self, $start, $end) = @_;
1614 foreach my $cust_svc (
1616 my $part_svc = $_->part_svc;
1617 $part_svc->svcdb eq 'svc_acct'
1618 && scalar($part_svc->part_export('sqlradius'));
1621 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1628 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1630 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1631 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1635 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1636 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1641 sub attribute_since_sqlradacct {
1642 my($self, $start, $end, $attrib) = @_;
1646 foreach my $cust_svc (
1648 my $part_svc = $_->part_svc;
1649 $part_svc->svcdb eq 'svc_acct'
1650 && scalar($part_svc->part_export('sqlradius'));
1653 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1665 my( $self, $value ) = @_;
1666 if ( defined($value) ) {
1667 $self->setfield('quantity', $value);
1669 $self->getfield('quantity') || 1;
1672 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1674 Transfers as many services as possible from this package to another package.
1676 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1677 object. The destination package must already exist.
1679 Services are moved only if the destination allows services with the correct
1680 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1681 this option with caution! No provision is made for export differences
1682 between the old and new service definitions. Probably only should be used
1683 when your exports for all service definitions of a given svcdb are identical.
1684 (attempt a transfer without it first, to move all possible svcpart-matching
1687 Any services that can't be moved remain in the original package.
1689 Returns an error, if there is one; otherwise, returns the number of services
1690 that couldn't be moved.
1695 my ($self, $dest_pkgnum, %opt) = @_;
1701 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1702 $dest = $dest_pkgnum;
1703 $dest_pkgnum = $dest->pkgnum;
1705 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1708 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1710 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1711 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1714 foreach my $cust_svc ($dest->cust_svc) {
1715 $target{$cust_svc->svcpart}--;
1718 my %svcpart2svcparts = ();
1719 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1720 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1721 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1722 next if exists $svcpart2svcparts{$svcpart};
1723 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1724 $svcpart2svcparts{$svcpart} = [
1726 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1728 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1729 'svcpart' => $_ } );
1731 $pkg_svc ? $pkg_svc->primary_svc : '',
1732 $pkg_svc ? $pkg_svc->quantity : 0,
1736 grep { $_ != $svcpart }
1738 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1740 warn "alternates for svcpart $svcpart: ".
1741 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1746 foreach my $cust_svc ($self->cust_svc) {
1747 if($target{$cust_svc->svcpart} > 0) {
1748 $target{$cust_svc->svcpart}--;
1749 my $new = new FS::cust_svc { $cust_svc->hash };
1750 $new->pkgnum($dest_pkgnum);
1751 my $error = $new->replace($cust_svc);
1752 return $error if $error;
1753 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1755 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1756 warn "alternates to consider: ".
1757 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1759 my @alternate = grep {
1760 warn "considering alternate svcpart $_: ".
1761 "$target{$_} available in new package\n"
1764 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1766 warn "alternate(s) found\n" if $DEBUG;
1767 my $change_svcpart = $alternate[0];
1768 $target{$change_svcpart}--;
1769 my $new = new FS::cust_svc { $cust_svc->hash };
1770 $new->svcpart($change_svcpart);
1771 $new->pkgnum($dest_pkgnum);
1772 my $error = $new->replace($cust_svc);
1773 return $error if $error;
1786 This method is deprecated. See the I<depend_jobnum> option to the insert and
1787 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1794 local $SIG{HUP} = 'IGNORE';
1795 local $SIG{INT} = 'IGNORE';
1796 local $SIG{QUIT} = 'IGNORE';
1797 local $SIG{TERM} = 'IGNORE';
1798 local $SIG{TSTP} = 'IGNORE';
1799 local $SIG{PIPE} = 'IGNORE';
1801 my $oldAutoCommit = $FS::UID::AutoCommit;
1802 local $FS::UID::AutoCommit = 0;
1805 foreach my $cust_svc ( $self->cust_svc ) {
1806 #false laziness w/svc_Common::insert
1807 my $svc_x = $cust_svc->svc_x;
1808 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1809 my $error = $part_export->export_insert($svc_x);
1811 $dbh->rollback if $oldAutoCommit;
1817 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1824 =head1 CLASS METHODS
1830 Returns an SQL expression identifying recurring packages.
1834 sub recurring_sql { "
1835 '0' != ( select freq from part_pkg
1836 where cust_pkg.pkgpart = part_pkg.pkgpart )
1841 Returns an SQL expression identifying one-time packages.
1846 '0' = ( select freq from part_pkg
1847 where cust_pkg.pkgpart = part_pkg.pkgpart )
1852 Returns an SQL expression identifying active packages.
1857 ". $_[0]->recurring_sql(). "
1858 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1859 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1864 Returns an SQL expression identifying inactive packages (one-time packages
1865 that are otherwise unsuspended/uncancelled).
1869 sub inactive_sql { "
1870 ". $_[0]->onetime_sql(). "
1871 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1872 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1878 Returns an SQL expression identifying suspended packages.
1882 sub suspended_sql { susp_sql(@_); }
1884 #$_[0]->recurring_sql(). ' AND '.
1886 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1887 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
1894 Returns an SQL exprression identifying cancelled packages.
1898 sub cancelled_sql { cancel_sql(@_); }
1900 #$_[0]->recurring_sql(). ' AND '.
1901 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1904 =item search_sql HASHREF
1908 Returns a qsearch hash expression to search for parameters specified in HASHREF.
1909 Valid parameters are
1917 active, inactive, suspended, cancel (or cancelled)
1921 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
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 arrayref of beginning and ending epoch date
1959 pkgnum or APKG_pkgnum
1963 a value suited to passing to FS::UI::Web::cust_header
1967 specifies the user for agent virtualization
1974 my ($class, $params) = @_;
1981 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1983 "cust_main.agentnum = $1";
1990 if ( $params->{'magic'} eq 'active'
1991 || $params->{'status'} eq 'active' ) {
1993 push @where, FS::cust_pkg->active_sql();
1995 } elsif ( $params->{'magic'} eq 'inactive'
1996 || $params->{'status'} eq 'inactive' ) {
1998 push @where, FS::cust_pkg->inactive_sql();
2000 } elsif ( $params->{'magic'} eq 'suspended'
2001 || $params->{'status'} eq 'suspended' ) {
2003 push @where, FS::cust_pkg->suspended_sql();
2005 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2006 || $params->{'status'} =~ /^cancell?ed$/ ) {
2008 push @where, FS::cust_pkg->cancelled_sql();
2010 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
2012 push @where, FS::cust_pkg->inactive_sql();
2017 # parse package class
2020 #false lazinessish w/graph/cust_bill_pkg.cgi
2023 if ( exists($params->{'classnum'})
2024 && $params->{'classnum'} =~ /^(\d*)$/
2028 if ( $classnum ) { #a specific class
2029 push @where, "classnum = $classnum";
2031 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2032 #die "classnum $classnum not found!" unless $pkg_class[0];
2033 #$title .= $pkg_class[0]->classname.' ';
2035 } elsif ( $classnum eq '' ) { #the empty class
2037 push @where, "classnum IS NULL";
2038 #$title .= 'Empty class ';
2039 #@pkg_class = ( '(empty class)' );
2040 } elsif ( $classnum eq '0' ) {
2041 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2042 #push @pkg_class, '(empty class)';
2044 die "illegal classnum";
2053 my $pkgpart = join (' OR pkgpart=',
2054 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2055 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2063 #false laziness w/report_cust_pkg.html
2066 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2067 'active' => { 'susp'=>1, 'cancel'=>1 },
2068 'suspended' => { 'cancel' => 1 },
2073 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2075 next unless exists($params->{$field});
2077 my($beginning, $ending) = @{$params->{$field}};
2079 next if $beginning == 0 && $ending == 4294967295;
2082 "cust_pkg.$field IS NOT NULL",
2083 "cust_pkg.$field >= $beginning",
2084 "cust_pkg.$field <= $ending";
2086 $orderby ||= "ORDER BY cust_pkg.$field";
2090 $orderby ||= 'ORDER BY bill';
2093 # parse magic, legacy, etc.
2096 if ( $params->{'magic'} &&
2097 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2100 $orderby = 'ORDER BY pkgnum';
2102 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2103 push @where, "pkgpart = $1";
2106 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2108 $orderby = 'ORDER BY pkgnum';
2110 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2112 $orderby = 'ORDER BY pkgnum';
2115 SELECT count(*) FROM pkg_svc
2116 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2117 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2118 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2119 AND cust_svc.svcpart = pkg_svc.svcpart
2126 # setup queries, links, subs, etc. for the search
2129 # here is the agent virtualization
2130 if ($params->{CurrentUser}) {
2132 qsearchs('access_user', { username => $params->{CurrentUser} });
2135 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2140 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2143 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2145 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2146 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2147 'LEFT JOIN pkg_class USING ( classnum ) ';
2149 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2152 'table' => 'cust_pkg',
2154 'select' => join(', ',
2156 ( map "part_pkg.$_", qw( pkg freq ) ),
2157 'pkg_class.classname',
2158 'cust_main.custnum as cust_main_custnum',
2159 FS::UI::Web::cust_sql_fields(
2160 $params->{'cust_fields'}
2163 'extra_sql' => "$extra_sql $orderby",
2164 'addl_from' => $addl_from,
2165 'count_query' => $count_query,
2174 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2176 CUSTNUM is a customer (see L<FS::cust_main>)
2178 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2179 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2182 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2183 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2184 new billing items. An error is returned if this is not possible (see
2185 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2188 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2189 newly-created cust_pkg objects.
2191 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2192 and inserted. Multiple FS::pkg_referral records can be created by
2193 setting I<refnum> to an array reference of refnums or a hash reference with
2194 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2195 record will be created corresponding to cust_main.refnum.
2200 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2202 my $conf = new FS::Conf;
2204 # Transactionize this whole mess
2205 local $SIG{HUP} = 'IGNORE';
2206 local $SIG{INT} = 'IGNORE';
2207 local $SIG{QUIT} = 'IGNORE';
2208 local $SIG{TERM} = 'IGNORE';
2209 local $SIG{TSTP} = 'IGNORE';
2210 local $SIG{PIPE} = 'IGNORE';
2212 my $oldAutoCommit = $FS::UID::AutoCommit;
2213 local $FS::UID::AutoCommit = 0;
2217 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2218 return "Customer not found: $custnum" unless $cust_main;
2220 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2223 my $change = scalar(@old_cust_pkg) != 0;
2226 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2230 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
2232 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
2233 $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
2235 $hash{'change_date'} = $time;
2236 $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
2239 # Create the new packages.
2240 foreach my $pkgpart (@$pkgparts) {
2241 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2242 pkgpart => $pkgpart,
2246 $error = $cust_pkg->insert( 'change' => $change );
2248 $dbh->rollback if $oldAutoCommit;
2251 push @$return_cust_pkg, $cust_pkg;
2253 # $return_cust_pkg now contains refs to all of the newly
2256 # Transfer services and cancel old packages.
2257 foreach my $old_pkg (@old_cust_pkg) {
2259 foreach my $new_pkg (@$return_cust_pkg) {
2260 $error = $old_pkg->transfer($new_pkg);
2261 if ($error and $error == 0) {
2262 # $old_pkg->transfer failed.
2263 $dbh->rollback if $oldAutoCommit;
2268 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2269 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2270 foreach my $new_pkg (@$return_cust_pkg) {
2271 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2272 if ($error and $error == 0) {
2273 # $old_pkg->transfer failed.
2274 $dbh->rollback if $oldAutoCommit;
2281 # Transfers were successful, but we went through all of the
2282 # new packages and still had services left on the old package.
2283 # We can't cancel the package under the circumstances, so abort.
2284 $dbh->rollback if $oldAutoCommit;
2285 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2287 $error = $old_pkg->cancel( quiet=>1 );
2293 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2297 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2299 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2300 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2303 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2304 replace. The services (see L<FS::cust_svc>) are moved to the
2305 new billing items. An error is returned if this is not possible (see
2308 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2309 newly-created cust_pkg objects.
2314 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2316 # Transactionize this whole mess
2317 local $SIG{HUP} = 'IGNORE';
2318 local $SIG{INT} = 'IGNORE';
2319 local $SIG{QUIT} = 'IGNORE';
2320 local $SIG{TERM} = 'IGNORE';
2321 local $SIG{TSTP} = 'IGNORE';
2322 local $SIG{PIPE} = 'IGNORE';
2324 my $oldAutoCommit = $FS::UID::AutoCommit;
2325 local $FS::UID::AutoCommit = 0;
2329 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2332 while(scalar(@old_cust_pkg)) {
2334 my $custnum = $old_cust_pkg[0]->custnum;
2335 my (@remove) = map { $_->pkgnum }
2336 grep { $_->custnum == $custnum } @old_cust_pkg;
2337 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2339 my $error = order $custnum, $pkgparts, \@remove, \@return;
2341 push @errors, $error
2343 push @$return_cust_pkg, @return;
2346 if (scalar(@errors)) {
2347 $dbh->rollback if $oldAutoCommit;
2348 return join(' / ', @errors);
2351 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2357 Associates this package with a (suspension or cancellation) reason (see
2358 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2361 Available options are:
2367 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.
2371 the access_user (see L<FS::access_user>) providing the reason
2379 the action (cancel, susp, adjourn, expire) associated with the reason
2383 If there is an error, returns the error, otherwise returns false.
2388 my ($self, %options) = @_;
2390 my $otaker = $options{reason_otaker} ||
2391 $FS::CurrentUser::CurrentUser->username;
2394 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2398 } elsif ( ref($options{'reason'}) ) {
2400 return 'Enter a new reason (or select an existing one)'
2401 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2403 my $reason = new FS::reason({
2404 'reason_type' => $options{'reason'}->{'typenum'},
2405 'reason' => $options{'reason'}->{'reason'},
2407 my $error = $reason->insert;
2408 return $error if $error;
2410 $reasonnum = $reason->reasonnum;
2413 return "Unparsable reason: ". $options{'reason'};
2416 my $cust_pkg_reason =
2417 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2418 'reasonnum' => $reasonnum,
2419 'otaker' => $otaker,
2420 'action' => substr(uc($options{'action'}),0,1),
2421 'date' => $options{'date'}
2426 $cust_pkg_reason->insert;
2429 =item set_usage USAGE_VALUE_HASHREF
2431 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2432 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2433 upbytes, downbytes, and totalbytes are appropriate keys.
2435 All svc_accts which are part of this package have their values reset.
2440 my ($self, $valueref) = @_;
2442 foreach my $cust_svc ($self->cust_svc){
2443 my $svc_x = $cust_svc->svc_x;
2444 $svc_x->set_usage($valueref)
2445 if $svc_x->can("set_usage");
2449 =item recharge USAGE_VALUE_HASHREF
2451 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2452 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2453 upbytes, downbytes, and totalbytes are appropriate keys.
2455 All svc_accts which are part of this package have their values incremented.
2460 my ($self, $valueref) = @_;
2462 foreach my $cust_svc ($self->cust_svc){
2463 my $svc_x = $cust_svc->svc_x;
2464 $svc_x->recharge($valueref)
2465 if $svc_x->can("recharge");
2473 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2475 In sub order, the @pkgparts array (passed by reference) is clobbered.
2477 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2478 method to pass dates to the recur_prog expression, it should do so.
2480 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2481 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2482 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2483 configuration values. Probably need a subroutine which decides what to do
2484 based on whether or not we've fetched the user yet, rather than a hash. See
2485 FS::UID and the TODO.
2487 Now that things are transactional should the check in the insert method be
2492 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2493 L<FS::pkg_svc>, schema.html from the base documentation