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:
107 =item pkgnum - primary key (assigned automatically for new billing items)
109 =item custnum - Customer (see L<FS::cust_main>)
111 =item pkgpart - Billing item definition (see L<FS::part_pkg>)
115 =item bill - date (next bill date)
117 =item last_bill - last bill date
127 =item otaker - order taker (assigned automatically if null, see L<FS::UID>)
129 =item manual_flag - If this field is set to 1, disables the automatic
130 unsuspension of this package when using the B<unsuspendauto> config file.
132 =item quantity - If not set, defaults to 1
136 Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
137 see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
138 conversion functions.
146 Create a new billing item. To add the item to the database, see L<"insert">.
150 sub table { 'cust_pkg'; }
151 sub cust_linked { $_[0]->cust_main_custnum; }
152 sub cust_unlinked_msg {
154 "WARNING: can't find cust_main.custnum ". $self->custnum.
155 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
158 =item insert [ OPTION => VALUE ... ]
160 Adds this billing item to the database ("Orders" the item). If there is an
161 error, returns the error, otherwise returns false.
163 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
164 will be used to look up the package definition and agent restrictions will be
167 If the additional field I<refnum> is defined, an FS::pkg_referral record will
168 be created and inserted. Multiple FS::pkg_referral records can be created by
169 setting I<refnum> to an array reference of refnums or a hash reference with
170 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
171 record will be created corresponding to cust_main.refnum.
173 The following options are available:
179 If set true, supresses any referral credit to a referring customer.
183 cust_pkg_option records will be created
190 my( $self, %options ) = @_;
192 local $SIG{HUP} = 'IGNORE';
193 local $SIG{INT} = 'IGNORE';
194 local $SIG{QUIT} = 'IGNORE';
195 local $SIG{TERM} = 'IGNORE';
196 local $SIG{TSTP} = 'IGNORE';
197 local $SIG{PIPE} = 'IGNORE';
199 my $oldAutoCommit = $FS::UID::AutoCommit;
200 local $FS::UID::AutoCommit = 0;
203 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
205 $dbh->rollback if $oldAutoCommit;
209 $self->refnum($self->cust_main->refnum) unless $self->refnum;
210 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
211 $self->process_m2m( 'link_table' => 'pkg_referral',
212 'target_table' => 'part_referral',
213 'params' => $self->refnum,
216 #if ( $self->reg_code ) {
217 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
218 # $error = $reg_code->delete;
220 # $dbh->rollback if $oldAutoCommit;
225 my $conf = new FS::Conf;
226 my $cust_main = $self->cust_main;
227 my $part_pkg = $self->part_pkg;
228 if ( $conf->exists('referral_credit')
229 && $cust_main->referral_custnum
230 && ! $options{'change'}
231 && $part_pkg->freq !~ /^0\D?$/
234 my $referring_cust_main = $cust_main->referring_cust_main;
235 if ( $referring_cust_main->status ne 'cancelled' ) {
237 if ( $part_pkg->freq !~ /^\d+$/ ) {
238 warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum.
239 ' for package '. $self->pkgnum.
240 ' ( customer '. $self->custnum. ')'.
241 ' - One-time referral credits not (yet) available for '.
242 ' packages with '. $part_pkg->freq_pretty. ' frequency';
245 my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
247 $referring_cust_main->
249 'Referral credit for '.$cust_main->name,
250 'reason_type' => $conf->config('referral_credit_type')
253 $dbh->rollback if $oldAutoCommit;
254 return "Error crediting customer ". $cust_main->referral_custnum.
255 " for referral: $error";
263 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
264 my $queue = new FS::queue {
265 'job' => 'FS::cust_main::queueable_print',
267 $error = $queue->insert(
268 'custnum' => $self->custnum,
269 'template' => 'welcome_letter',
273 warn "can't send welcome letter: $error";
278 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
285 This method now works but you probably shouldn't use it.
287 You don't want to delete billing items, because there would then be no record
288 the customer ever purchased the item. Instead, see the cancel method.
293 # return "Can't delete cust_pkg records!";
296 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
298 Replaces the OLD_RECORD with this one in the database. If there is an error,
299 returns the error, otherwise returns false.
301 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
303 Changing pkgpart may have disasterous effects. See the order subroutine.
305 setup and bill are normally updated by calling the bill method of a customer
306 object (see L<FS::cust_main>).
308 suspend is normally updated by the suspend and unsuspend methods.
310 cancel is normally updated by the cancel method (and also the order subroutine
313 Available options are:
319 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.
323 the access_user (see L<FS::access_user>) providing the reason
327 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
336 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
341 ( ref($_[0]) eq 'HASH' )
345 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
346 return "Can't change otaker!" if $old->otaker ne $new->otaker;
349 #return "Can't change setup once it exists!"
350 # if $old->getfield('setup') &&
351 # $old->getfield('setup') != $new->getfield('setup');
353 #some logic for bill, susp, cancel?
355 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
357 local $SIG{HUP} = 'IGNORE';
358 local $SIG{INT} = 'IGNORE';
359 local $SIG{QUIT} = 'IGNORE';
360 local $SIG{TERM} = 'IGNORE';
361 local $SIG{TSTP} = 'IGNORE';
362 local $SIG{PIPE} = 'IGNORE';
364 my $oldAutoCommit = $FS::UID::AutoCommit;
365 local $FS::UID::AutoCommit = 0;
368 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
369 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
370 my $error = $new->insert_reason(
371 'reason' => $options->{'reason'},
372 'date' => $new->$method,
374 'reason_otaker' => $options->{'reason_otaker'},
377 dbh->rollback if $oldAutoCommit;
378 return "Error inserting cust_pkg_reason: $error";
383 #save off and freeze RADIUS attributes for any associated svc_acct records
385 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
387 #also check for specific exports?
388 # to avoid spurious modify export events
389 @svc_acct = map { $_->svc_x }
390 grep { $_->part_svc->svcdb eq 'svc_acct' }
393 $_->snapshot foreach @svc_acct;
397 my $error = $new->SUPER::replace($old,
398 $options->{options} ? $options->{options} : ()
401 $dbh->rollback if $oldAutoCommit;
405 #for prepaid packages,
406 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
407 foreach my $old_svc_acct ( @svc_acct ) {
408 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
409 my $s_error = $new_svc_acct->replace($old_svc_acct);
411 $dbh->rollback if $oldAutoCommit;
416 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
423 Checks all fields to make sure this is a valid billing item. If there is an
424 error, returns the error, otherwise returns false. Called by the insert and
433 $self->ut_numbern('pkgnum')
434 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
435 || $self->ut_numbern('pkgpart')
436 || $self->ut_numbern('setup')
437 || $self->ut_numbern('bill')
438 || $self->ut_numbern('susp')
439 || $self->ut_numbern('cancel')
440 || $self->ut_numbern('adjourn')
441 || $self->ut_numbern('expire')
443 return $error if $error;
445 if ( $self->reg_code ) {
447 unless ( grep { $self->pkgpart == $_->pkgpart }
448 map { $_->reg_code_pkg }
449 qsearchs( 'reg_code', { 'code' => $self->reg_code,
450 'agentnum' => $self->cust_main->agentnum })
452 return "Unknown registration code";
455 } elsif ( $self->promo_code ) {
458 qsearchs('part_pkg', {
459 'pkgpart' => $self->pkgpart,
460 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
462 return 'Unknown promotional code' unless $promo_part_pkg;
466 unless ( $disable_agentcheck ) {
468 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
469 my $pkgpart_href = $agent->pkgpart_hashref;
470 return "agent ". $agent->agentnum.
471 " can't purchase pkgpart ". $self->pkgpart
472 unless $pkgpart_href->{ $self->pkgpart };
475 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
476 return $error if $error;
480 $self->otaker(getotaker) unless $self->otaker;
481 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
484 if ( $self->dbdef_table->column('manual_flag') ) {
485 $self->manual_flag('') if $self->manual_flag eq ' ';
486 $self->manual_flag =~ /^([01]?)$/
487 or return "Illegal manual_flag ". $self->manual_flag;
488 $self->manual_flag($1);
494 =item cancel [ OPTION => VALUE ... ]
496 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
497 in this package, then cancels the package itself (sets the cancel field to
500 Available options are:
504 =item quiet - can be set true to supress email cancellation notices.
506 =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.
508 =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.
510 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
514 If there is an error, returns the error, otherwise returns false.
519 my( $self, %options ) = @_;
522 warn "cust_pkg::cancel called with options".
523 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
526 local $SIG{HUP} = 'IGNORE';
527 local $SIG{INT} = 'IGNORE';
528 local $SIG{QUIT} = 'IGNORE';
529 local $SIG{TERM} = 'IGNORE';
530 local $SIG{TSTP} = 'IGNORE';
531 local $SIG{PIPE} = 'IGNORE';
533 my $oldAutoCommit = $FS::UID::AutoCommit;
534 local $FS::UID::AutoCommit = 0;
537 my $old = $self->select_for_update;
539 if ( $old->get('cancel') || $self->get('cancel') ) {
540 dbh->rollback if $oldAutoCommit;
541 return ""; # no error
544 my $date = $options{date} if $options{date}; # expire/cancel later
545 $date = '' if ($date && $date <= time); # complain instead?
547 my $cancel_time = $options{'time'} || time;
549 if ( $options{'reason'} ) {
550 $error = $self->insert_reason( 'reason' => $options{'reason'},
551 'action' => $date ? 'expire' : 'cancel',
552 'reason_otaker' => $options{'reason_otaker'},
555 dbh->rollback if $oldAutoCommit;
556 return "Error inserting cust_pkg_reason: $error";
562 foreach my $cust_svc (
565 sort { $a->[1] <=> $b->[1] }
566 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
567 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
570 my $error = $cust_svc->cancel;
573 $dbh->rollback if $oldAutoCommit;
574 return "Error cancelling cust_svc: $error";
578 # Add a credit for remaining service
579 my $remaining_value = $self->calc_remain(time=>$cancel_time);
580 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
581 my $conf = new FS::Conf;
582 my $error = $self->cust_main->credit(
584 'Credit for unused time on '. $self->part_pkg->pkg,
585 'reason_type' => $conf->config('cancel_credit_type'),
588 $dbh->rollback if $oldAutoCommit;
589 return "Error crediting customer \$$remaining_value for unused time on".
590 $self->part_pkg->pkg. ": $error";
595 my %hash = $self->hash;
596 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
597 my $new = new FS::cust_pkg ( \%hash );
598 $error = $new->replace( $self, options => { $self->options } );
600 $dbh->rollback if $oldAutoCommit;
604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
605 return '' if $date; #no errors
607 my $conf = new FS::Conf;
608 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
609 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
610 my $conf = new FS::Conf;
611 my $error = send_email(
612 'from' => $conf->config('invoice_from'),
613 'to' => \@invoicing_list,
614 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
615 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
617 #should this do something on errors?
624 =item cancel_if_expired [ NOW_TIMESTAMP ]
626 Cancels this package if its expire date has been reached.
630 sub cancel_if_expired {
632 my $time = shift || time;
633 return '' unless $self->expire && $self->expire <= $time;
634 my $error = $self->cancel;
636 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
637 $self->custnum. ": $error";
644 Cancels any pending expiration (sets the expire field to null).
646 If there is an error, returns the error, otherwise returns false.
651 my( $self, %options ) = @_;
654 local $SIG{HUP} = 'IGNORE';
655 local $SIG{INT} = 'IGNORE';
656 local $SIG{QUIT} = 'IGNORE';
657 local $SIG{TERM} = 'IGNORE';
658 local $SIG{TSTP} = 'IGNORE';
659 local $SIG{PIPE} = 'IGNORE';
661 my $oldAutoCommit = $FS::UID::AutoCommit;
662 local $FS::UID::AutoCommit = 0;
665 my $old = $self->select_for_update;
667 my $pkgnum = $old->pkgnum;
668 if ( $old->get('cancel') || $self->get('cancel') ) {
669 dbh->rollback if $oldAutoCommit;
670 return "Can't unexpire cancelled package $pkgnum";
671 # or at least it's pointless
674 unless ( $old->get('expire') && $self->get('expire') ) {
675 dbh->rollback if $oldAutoCommit;
676 return ""; # no error
679 my %hash = $self->hash;
680 $hash{'expire'} = '';
681 my $new = new FS::cust_pkg ( \%hash );
682 $error = $new->replace( $self, options => { $self->options } );
684 $dbh->rollback if $oldAutoCommit;
688 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
694 =item suspend [ OPTION => VALUE ... ]
696 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
697 package, then suspends the package itself (sets the susp field to now).
699 Available options are:
703 =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.
705 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
709 If there is an error, returns the error, otherwise returns false.
714 my( $self, %options ) = @_;
717 local $SIG{HUP} = 'IGNORE';
718 local $SIG{INT} = 'IGNORE';
719 local $SIG{QUIT} = 'IGNORE';
720 local $SIG{TERM} = 'IGNORE';
721 local $SIG{TSTP} = 'IGNORE';
722 local $SIG{PIPE} = 'IGNORE';
724 my $oldAutoCommit = $FS::UID::AutoCommit;
725 local $FS::UID::AutoCommit = 0;
728 my $old = $self->select_for_update;
730 my $pkgnum = $old->pkgnum;
731 if ( $old->get('cancel') || $self->get('cancel') ) {
732 dbh->rollback if $oldAutoCommit;
733 return "Can't suspend cancelled package $pkgnum";
736 if ( $old->get('susp') || $self->get('susp') ) {
737 dbh->rollback if $oldAutoCommit;
738 return ""; # no error # complain on adjourn?
741 my $date = $options{date} if $options{date}; # adjourn/suspend later
742 $date = '' if ($date && $date <= time); # complain instead?
744 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
745 dbh->rollback if $oldAutoCommit;
746 return "Package $pkgnum expires before it would be suspended.";
749 if ( $options{'reason'} ) {
750 $error = $self->insert_reason( 'reason' => $options{'reason'},
751 'action' => $date ? 'adjourn' : 'suspend',
752 'reason_otaker' => $options{'reason_otaker'},
755 dbh->rollback if $oldAutoCommit;
756 return "Error inserting cust_pkg_reason: $error";
764 foreach my $cust_svc (
765 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
767 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
769 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
770 $dbh->rollback if $oldAutoCommit;
771 return "Illegal svcdb value in part_svc!";
774 require "FS/$svcdb.pm";
776 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
778 $error = $svc->suspend;
780 $dbh->rollback if $oldAutoCommit;
783 my( $label, $value ) = $cust_svc->label;
784 push @labels, "$label: $value";
788 my $conf = new FS::Conf;
789 if ( $conf->config('suspend_email_admin') ) {
791 my $error = send_email(
792 'from' => $conf->config('invoice_from'), #??? well as good as any
793 'to' => $conf->config('suspend_email_admin'),
794 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
796 "This is an automatic message from your Freeside installation\n",
797 "informing you that the following customer package has been suspended:\n",
799 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
800 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
801 ( map { "Service : $_\n" } @labels ),
806 warn "WARNING: can't send suspension admin email (suspending anyway): ".
814 my %hash = $self->hash;
816 $hash{'adjourn'} = $date;
818 $hash{'susp'} = time;
820 my $new = new FS::cust_pkg ( \%hash );
821 $error = $new->replace( $self, options => { $self->options } );
823 $dbh->rollback if $oldAutoCommit;
827 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
832 =item unsuspend [ OPTION => VALUE ... ]
834 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
835 package, then unsuspends the package itself (clears the susp field and the
836 adjourn field if it is in the past).
838 Available options are:
842 =item adjust_next_bill
844 Can be set true to adjust the next bill date forward by
845 the amount of time the account was inactive. This was set true by default
846 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
847 explicitly requested. Price plans for which this makes sense (anniversary-date
848 based than prorate or subscription) could have an option to enable this
853 If there is an error, returns the error, otherwise returns false.
858 my( $self, %opt ) = @_;
861 local $SIG{HUP} = 'IGNORE';
862 local $SIG{INT} = 'IGNORE';
863 local $SIG{QUIT} = 'IGNORE';
864 local $SIG{TERM} = 'IGNORE';
865 local $SIG{TSTP} = 'IGNORE';
866 local $SIG{PIPE} = 'IGNORE';
868 my $oldAutoCommit = $FS::UID::AutoCommit;
869 local $FS::UID::AutoCommit = 0;
872 my $old = $self->select_for_update;
874 my $pkgnum = $old->pkgnum;
875 if ( $old->get('cancel') || $self->get('cancel') ) {
876 dbh->rollback if $oldAutoCommit;
877 return "Can't unsuspend cancelled package $pkgnum";
880 unless ( $old->get('susp') && $self->get('susp') ) {
881 dbh->rollback if $oldAutoCommit;
882 return ""; # no error # complain instead?
885 foreach my $cust_svc (
886 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
888 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
890 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
891 $dbh->rollback if $oldAutoCommit;
892 return "Illegal svcdb value in part_svc!";
895 require "FS/$svcdb.pm";
897 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
899 $error = $svc->unsuspend;
901 $dbh->rollback if $oldAutoCommit;
908 my %hash = $self->hash;
909 my $inactive = time - $hash{'susp'};
911 my $conf = new FS::Conf;
913 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
914 if ( $opt{'adjust_next_bill'}
915 || $conf->config('unsuspend-always_adjust_next_bill_date') )
916 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
919 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
920 my $new = new FS::cust_pkg ( \%hash );
921 $error = $new->replace( $self, options => { $self->options } );
923 $dbh->rollback if $oldAutoCommit;
927 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
934 Cancels any pending suspension (sets the adjourn field to null).
936 If there is an error, returns the error, otherwise returns false.
941 my( $self, %options ) = @_;
944 local $SIG{HUP} = 'IGNORE';
945 local $SIG{INT} = 'IGNORE';
946 local $SIG{QUIT} = 'IGNORE';
947 local $SIG{TERM} = 'IGNORE';
948 local $SIG{TSTP} = 'IGNORE';
949 local $SIG{PIPE} = 'IGNORE';
951 my $oldAutoCommit = $FS::UID::AutoCommit;
952 local $FS::UID::AutoCommit = 0;
955 my $old = $self->select_for_update;
957 my $pkgnum = $old->pkgnum;
958 if ( $old->get('cancel') || $self->get('cancel') ) {
959 dbh->rollback if $oldAutoCommit;
960 return "Can't unadjourn cancelled package $pkgnum";
961 # or at least it's pointless
964 if ( $old->get('susp') || $self->get('susp') ) {
965 dbh->rollback if $oldAutoCommit;
966 return "Can't unadjourn suspended package $pkgnum";
967 # perhaps this is arbitrary
970 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
971 dbh->rollback if $oldAutoCommit;
972 return ""; # no error
975 my %hash = $self->hash;
976 $hash{'adjourn'} = '';
977 my $new = new FS::cust_pkg ( \%hash );
978 $error = $new->replace( $self, options => { $self->options } );
980 $dbh->rollback if $oldAutoCommit;
984 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
992 Returns the last bill date, or if there is no last bill date, the setup date.
993 Useful for billing metered services.
999 return $self->setfield('last_bill', $_[0]) if @_;
1000 return $self->getfield('last_bill') if $self->getfield('last_bill');
1001 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1002 'edate' => $self->bill, } );
1003 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1006 =item last_cust_pkg_reason ACTION
1008 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1009 Returns false if there is no reason or the package is not currenly ACTION'd
1010 ACTION is one of adjourn, susp, cancel, or expire.
1014 sub last_cust_pkg_reason {
1015 my ( $self, $action ) = ( shift, shift );
1016 my $date = $self->get($action);
1018 'table' => 'cust_pkg_reason',
1019 'hashref' => { 'pkgnum' => $self->pkgnum,
1020 'action' => substr(uc($action), 0, 1),
1023 'order_by' => 'ORDER BY num DESC LIMIT 1',
1027 =item last_reason ACTION
1029 Returns the most recent ACTION FS::reason associated with the package.
1030 Returns false if there is no reason or the package is not currenly ACTION'd
1031 ACTION is one of adjourn, susp, cancel, or expire.
1036 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1037 $cust_pkg_reason->reason
1038 if $cust_pkg_reason;
1043 Returns the definition for this billing item, as an FS::part_pkg object (see
1050 #exists( $self->{'_pkgpart'} )
1052 ? $self->{'_pkgpart'}
1053 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1058 Returns the cancelled package this package was changed from, if any.
1064 return '' unless $self->change_pkgnum;
1065 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1070 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1077 $self->part_pkg->calc_setup($self, @_);
1082 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1089 $self->part_pkg->calc_recur($self, @_);
1094 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1101 $self->part_pkg->calc_remain($self, @_);
1106 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1113 $self->part_pkg->calc_cancel($self, @_);
1118 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1124 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1127 =item cust_pkg_detail [ DETAILTYPE ]
1129 Returns any customer package details for this package (see
1130 L<FS::cust_pkg_detail>).
1132 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1136 sub cust_pkg_detail {
1138 my %hash = ( 'pkgnum' => $self->pkgnum );
1139 $hash{detailtype} = shift if @_;
1141 'table' => 'cust_pkg_detail',
1142 'hashref' => \%hash,
1143 'order_by' => 'ORDER BY weight, pkgdetailnum',
1147 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1149 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1151 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1153 If there is an error, returns the error, otherwise returns false.
1157 sub set_cust_pkg_detail {
1158 my( $self, $detailtype, @details ) = @_;
1160 local $SIG{HUP} = 'IGNORE';
1161 local $SIG{INT} = 'IGNORE';
1162 local $SIG{QUIT} = 'IGNORE';
1163 local $SIG{TERM} = 'IGNORE';
1164 local $SIG{TSTP} = 'IGNORE';
1165 local $SIG{PIPE} = 'IGNORE';
1167 my $oldAutoCommit = $FS::UID::AutoCommit;
1168 local $FS::UID::AutoCommit = 0;
1171 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1172 my $error = $current->delete;
1174 $dbh->rollback if $oldAutoCommit;
1175 return "error removing old detail: $error";
1179 foreach my $detail ( @details ) {
1180 my $cust_pkg_detail = new FS::cust_pkg_detail {
1181 'pkgnum' => $self->pkgnum,
1182 'detailtype' => $detailtype,
1183 'detail' => $detail,
1185 my $error = $cust_pkg_detail->insert;
1187 $dbh->rollback if $oldAutoCommit;
1188 return "error adding new detail: $error";
1193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1200 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1204 #false laziness w/cust_bill.pm
1208 'table' => 'cust_event',
1209 'addl_from' => 'JOIN part_event USING ( eventpart )',
1210 'hashref' => { 'tablenum' => $self->pkgnum },
1211 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1215 =item num_cust_event
1217 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1221 #false laziness w/cust_bill.pm
1222 sub num_cust_event {
1225 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1226 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1227 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1228 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1229 $sth->fetchrow_arrayref->[0];
1232 =item cust_svc [ SVCPART ]
1234 Returns the services for this package, as FS::cust_svc objects (see
1235 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1244 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1245 'svcpart' => shift, } );
1248 #if ( $self->{'_svcnum'} ) {
1249 # values %{ $self->{'_svcnum'}->cache };
1251 $self->_sort_cust_svc(
1252 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1258 =item overlimit [ SVCPART ]
1260 Returns the services for this package which have exceeded their
1261 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1262 is specified, return only the matching services.
1268 grep { $_->overlimit } $self->cust_svc;
1271 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1273 Returns historical services for this package created before END TIMESTAMP and
1274 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1275 (see L<FS::h_cust_svc>).
1282 $self->_sort_cust_svc(
1283 [ qsearch( 'h_cust_svc',
1284 { 'pkgnum' => $self->pkgnum, },
1285 FS::h_cust_svc->sql_h_search(@_),
1291 sub _sort_cust_svc {
1292 my( $self, $arrayref ) = @_;
1295 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1297 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1298 'svcpart' => $_->svcpart } );
1300 $pkg_svc ? $pkg_svc->primary_svc : '',
1301 $pkg_svc ? $pkg_svc->quantity : 0,
1308 =item num_cust_svc [ SVCPART ]
1310 Returns the number of provisioned services for this package. If a svcpart is
1311 specified, counts only the matching services.
1317 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1318 $sql .= ' AND svcpart = ?' if @_;
1319 my $sth = dbh->prepare($sql) or die dbh->errstr;
1320 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1321 $sth->fetchrow_arrayref->[0];
1324 =item available_part_svc
1326 Returns a list of FS::part_svc objects representing services included in this
1327 package but not yet provisioned. Each FS::part_svc object also has an extra
1328 field, I<num_avail>, which specifies the number of available services.
1332 sub available_part_svc {
1334 grep { $_->num_avail > 0 }
1336 my $part_svc = $_->part_svc;
1337 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1338 $_->quantity - $self->num_cust_svc($_->svcpart);
1341 $self->part_pkg->pkg_svc;
1346 Returns a list of FS::part_svc objects representing provisioned and available
1347 services included in this package. Each FS::part_svc object also has the
1348 following extra fields:
1352 =item num_cust_svc (count)
1354 =item num_avail (quantity - count)
1356 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1359 label -> ($cust_svc->label)[1]
1368 #XXX some sort of sort order besides numeric by svcpart...
1369 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1371 my $part_svc = $pkg_svc->part_svc;
1372 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1373 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1374 $part_svc->{'Hash'}{'num_avail'} =
1375 max( 0, $pkg_svc->quantity - $num_cust_svc );
1376 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1378 } $self->part_pkg->pkg_svc;
1381 push @part_svc, map {
1383 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1384 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1385 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1386 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1388 } $self->extra_part_svc;
1394 =item extra_part_svc
1396 Returns a list of FS::part_svc objects corresponding to services in this
1397 package which are still provisioned but not (any longer) available in the
1402 sub extra_part_svc {
1405 my $pkgnum = $self->pkgnum;
1406 my $pkgpart = $self->pkgpart;
1409 'table' => 'part_svc',
1411 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1412 WHERE pkg_svc.svcpart = part_svc.svcpart
1413 AND pkg_svc.pkgpart = $pkgpart
1416 AND 0 < ( SELECT count(*)
1418 LEFT JOIN cust_pkg using ( pkgnum )
1419 WHERE cust_svc.svcpart = part_svc.svcpart
1420 AND pkgnum = $pkgnum
1427 Returns a short status string for this package, currently:
1431 =item not yet billed
1433 =item one-time charge
1448 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1450 return 'cancelled' if $self->get('cancel');
1451 return 'suspended' if $self->susp;
1452 return 'not yet billed' unless $self->setup;
1453 return 'one-time charge' if $freq =~ /^(0|$)/;
1459 Class method that returns the list of possible status strings for packages
1460 (see L<the status method|/status>). For example:
1462 @statuses = FS::cust_pkg->statuses();
1466 tie my %statuscolor, 'Tie::IxHash',
1467 'not yet billed' => '000000',
1468 'one-time charge' => '000000',
1469 'active' => '00CC00',
1470 'suspended' => 'FF9900',
1471 'cancelled' => 'FF0000',
1475 my $self = shift; #could be class...
1476 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1477 # mayble split btw one-time vs. recur
1483 Returns a hex triplet color string for this package's status.
1489 $statuscolor{$self->status};
1494 Returns a list of lists, calling the label method for all services
1495 (see L<FS::cust_svc>) of this billing item.
1501 map { [ $_->label ] } $self->cust_svc;
1504 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1506 Like the labels method, but returns historical information on services that
1507 were active as of END_TIMESTAMP and (optionally) not cancelled before
1510 Returns a list of lists, calling the label method for all (historical) services
1511 (see L<FS::h_cust_svc>) of this billing item.
1517 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1520 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1522 Like h_labels, except returns a simple flat list, and shortens long
1523 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1524 identical services to one line that lists the service label and the number of
1525 individual services rather than individual items.
1529 sub h_labels_short {
1532 my $conf = new FS::Conf;
1533 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1536 #tie %labels, 'Tie::IxHash';
1537 push @{ $labels{$_->[0]} }, $_->[1]
1538 foreach $self->h_labels(@_);
1540 foreach my $label ( keys %labels ) {
1542 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1543 my $num = scalar(@values);
1544 if ( $num > $max_same_services ) {
1545 push @labels, "$label ($num)";
1547 push @labels, map { "$label: $_" } @values;
1557 Returns the parent customer object (see L<FS::cust_main>).
1563 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1566 =item seconds_since TIMESTAMP
1568 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1569 package have been online since TIMESTAMP, according to the session monitor.
1571 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1572 L<Time::Local> and L<Date::Parse> for conversion functions.
1577 my($self, $since) = @_;
1580 foreach my $cust_svc (
1581 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1583 $seconds += $cust_svc->seconds_since($since);
1590 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1592 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1593 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1596 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1597 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1603 sub seconds_since_sqlradacct {
1604 my($self, $start, $end) = @_;
1608 foreach my $cust_svc (
1610 my $part_svc = $_->part_svc;
1611 $part_svc->svcdb eq 'svc_acct'
1612 && scalar($part_svc->part_export('sqlradius'));
1615 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1622 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1624 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1625 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1629 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1630 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1635 sub attribute_since_sqlradacct {
1636 my($self, $start, $end, $attrib) = @_;
1640 foreach my $cust_svc (
1642 my $part_svc = $_->part_svc;
1643 $part_svc->svcdb eq 'svc_acct'
1644 && scalar($part_svc->part_export('sqlradius'));
1647 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1659 my( $self, $value ) = @_;
1660 if ( defined($value) ) {
1661 $self->setfield('quantity', $value);
1663 $self->getfield('quantity') || 1;
1666 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1668 Transfers as many services as possible from this package to another package.
1670 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1671 object. The destination package must already exist.
1673 Services are moved only if the destination allows services with the correct
1674 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1675 this option with caution! No provision is made for export differences
1676 between the old and new service definitions. Probably only should be used
1677 when your exports for all service definitions of a given svcdb are identical.
1678 (attempt a transfer without it first, to move all possible svcpart-matching
1681 Any services that can't be moved remain in the original package.
1683 Returns an error, if there is one; otherwise, returns the number of services
1684 that couldn't be moved.
1689 my ($self, $dest_pkgnum, %opt) = @_;
1695 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1696 $dest = $dest_pkgnum;
1697 $dest_pkgnum = $dest->pkgnum;
1699 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1702 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1704 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1705 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1708 foreach my $cust_svc ($dest->cust_svc) {
1709 $target{$cust_svc->svcpart}--;
1712 my %svcpart2svcparts = ();
1713 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1714 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1715 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1716 next if exists $svcpart2svcparts{$svcpart};
1717 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1718 $svcpart2svcparts{$svcpart} = [
1720 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1722 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1723 'svcpart' => $_ } );
1725 $pkg_svc ? $pkg_svc->primary_svc : '',
1726 $pkg_svc ? $pkg_svc->quantity : 0,
1730 grep { $_ != $svcpart }
1732 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1734 warn "alternates for svcpart $svcpart: ".
1735 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1740 foreach my $cust_svc ($self->cust_svc) {
1741 if($target{$cust_svc->svcpart} > 0) {
1742 $target{$cust_svc->svcpart}--;
1743 my $new = new FS::cust_svc { $cust_svc->hash };
1744 $new->pkgnum($dest_pkgnum);
1745 my $error = $new->replace($cust_svc);
1746 return $error if $error;
1747 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1749 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1750 warn "alternates to consider: ".
1751 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1753 my @alternate = grep {
1754 warn "considering alternate svcpart $_: ".
1755 "$target{$_} available in new package\n"
1758 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1760 warn "alternate(s) found\n" if $DEBUG;
1761 my $change_svcpart = $alternate[0];
1762 $target{$change_svcpart}--;
1763 my $new = new FS::cust_svc { $cust_svc->hash };
1764 $new->svcpart($change_svcpart);
1765 $new->pkgnum($dest_pkgnum);
1766 my $error = $new->replace($cust_svc);
1767 return $error if $error;
1780 This method is deprecated. See the I<depend_jobnum> option to the insert and
1781 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1788 local $SIG{HUP} = 'IGNORE';
1789 local $SIG{INT} = 'IGNORE';
1790 local $SIG{QUIT} = 'IGNORE';
1791 local $SIG{TERM} = 'IGNORE';
1792 local $SIG{TSTP} = 'IGNORE';
1793 local $SIG{PIPE} = 'IGNORE';
1795 my $oldAutoCommit = $FS::UID::AutoCommit;
1796 local $FS::UID::AutoCommit = 0;
1799 foreach my $cust_svc ( $self->cust_svc ) {
1800 #false laziness w/svc_Common::insert
1801 my $svc_x = $cust_svc->svc_x;
1802 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1803 my $error = $part_export->export_insert($svc_x);
1805 $dbh->rollback if $oldAutoCommit;
1811 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1818 =head1 CLASS METHODS
1824 Returns an SQL expression identifying recurring packages.
1828 sub recurring_sql { "
1829 '0' != ( select freq from part_pkg
1830 where cust_pkg.pkgpart = part_pkg.pkgpart )
1835 Returns an SQL expression identifying one-time packages.
1840 '0' = ( select freq from part_pkg
1841 where cust_pkg.pkgpart = part_pkg.pkgpart )
1846 Returns an SQL expression identifying active packages.
1851 ". $_[0]->recurring_sql(). "
1852 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1853 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1858 Returns an SQL expression identifying inactive packages (one-time packages
1859 that are otherwise unsuspended/uncancelled).
1863 sub inactive_sql { "
1864 ". $_[0]->onetime_sql(). "
1865 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1866 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
1872 Returns an SQL expression identifying suspended packages.
1876 sub suspended_sql { susp_sql(@_); }
1878 #$_[0]->recurring_sql(). ' AND '.
1880 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
1881 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
1888 Returns an SQL exprression identifying cancelled packages.
1892 sub cancelled_sql { cancel_sql(@_); }
1894 #$_[0]->recurring_sql(). ' AND '.
1895 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
1898 =item search_sql HASHREF
1902 Returns a qsearch hash expression to search for parameters specified in HASHREF.
1903 Valid parameters are
1911 active, inactive, suspended, cancel (or cancelled)
1915 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
1925 arrayref of beginning and ending epoch date
1929 arrayref of beginning and ending epoch date
1933 arrayref of beginning and ending epoch date
1937 arrayref of beginning and ending epoch date
1941 arrayref of beginning and ending epoch date
1945 arrayref of beginning and ending epoch date
1949 arrayref of beginning and ending epoch date
1953 pkgnum or APKG_pkgnum
1957 a value suited to passing to FS::UI::Web::cust_header
1961 specifies the user for agent virtualization
1968 my ($class, $params) = @_;
1975 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
1977 "cust_main.agentnum = $1";
1984 if ( $params->{'magic'} eq 'active'
1985 || $params->{'status'} eq 'active' ) {
1987 push @where, FS::cust_pkg->active_sql();
1989 } elsif ( $params->{'magic'} eq 'inactive'
1990 || $params->{'status'} eq 'inactive' ) {
1992 push @where, FS::cust_pkg->inactive_sql();
1994 } elsif ( $params->{'magic'} eq 'suspended'
1995 || $params->{'status'} eq 'suspended' ) {
1997 push @where, FS::cust_pkg->suspended_sql();
1999 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2000 || $params->{'status'} =~ /^cancell?ed$/ ) {
2002 push @where, FS::cust_pkg->cancelled_sql();
2004 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
2006 push @where, FS::cust_pkg->inactive_sql();
2011 # parse package class
2014 #false lazinessish w/graph/cust_bill_pkg.cgi
2017 if ( exists($params->{'classnum'})
2018 && $params->{'classnum'} =~ /^(\d*)$/
2022 if ( $classnum ) { #a specific class
2023 push @where, "classnum = $classnum";
2025 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2026 #die "classnum $classnum not found!" unless $pkg_class[0];
2027 #$title .= $pkg_class[0]->classname.' ';
2029 } elsif ( $classnum eq '' ) { #the empty class
2031 push @where, "classnum IS NULL";
2032 #$title .= 'Empty class ';
2033 #@pkg_class = ( '(empty class)' );
2034 } elsif ( $classnum eq '0' ) {
2035 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2036 #push @pkg_class, '(empty class)';
2038 die "illegal classnum";
2047 my $pkgpart = join (' OR pkgpart=',
2048 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2049 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2057 #false laziness w/report_cust_pkg.html
2060 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2061 'active' => { 'susp'=>1, 'cancel'=>1 },
2062 'suspended' => { 'cancel' => 1 },
2067 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2069 next unless exists($params->{$field});
2071 my($beginning, $ending) = @{$params->{$field}};
2073 next if $beginning == 0 && $ending == 4294967295;
2076 "cust_pkg.$field IS NOT NULL",
2077 "cust_pkg.$field >= $beginning",
2078 "cust_pkg.$field <= $ending";
2080 $orderby ||= "ORDER BY cust_pkg.$field";
2084 $orderby ||= 'ORDER BY bill';
2087 # parse magic, legacy, etc.
2090 if ( $params->{'magic'} &&
2091 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2094 $orderby = 'ORDER BY pkgnum';
2096 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2097 push @where, "pkgpart = $1";
2100 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2102 $orderby = 'ORDER BY pkgnum';
2104 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2106 $orderby = 'ORDER BY pkgnum';
2109 SELECT count(*) FROM pkg_svc
2110 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2111 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2112 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2113 AND cust_svc.svcpart = pkg_svc.svcpart
2120 # setup queries, links, subs, etc. for the search
2123 # here is the agent virtualization
2124 if ($params->{CurrentUser}) {
2126 qsearchs('access_user', { username => $params->{CurrentUser} });
2129 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2134 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2137 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2139 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2140 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2141 'LEFT JOIN pkg_class USING ( classnum ) ';
2143 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2146 'table' => 'cust_pkg',
2148 'select' => join(', ',
2150 ( map "part_pkg.$_", qw( pkg freq ) ),
2151 'pkg_class.classname',
2152 'cust_main.custnum as cust_main_custnum',
2153 FS::UI::Web::cust_sql_fields(
2154 $params->{'cust_fields'}
2157 'extra_sql' => "$extra_sql $orderby",
2158 'addl_from' => $addl_from,
2159 'count_query' => $count_query,
2168 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2170 CUSTNUM is a customer (see L<FS::cust_main>)
2172 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2173 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2176 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2177 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2178 new billing items. An error is returned if this is not possible (see
2179 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2182 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2183 newly-created cust_pkg objects.
2185 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2186 and inserted. Multiple FS::pkg_referral records can be created by
2187 setting I<refnum> to an array reference of refnums or a hash reference with
2188 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2189 record will be created corresponding to cust_main.refnum.
2194 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2196 my $conf = new FS::Conf;
2198 # Transactionize this whole mess
2199 local $SIG{HUP} = 'IGNORE';
2200 local $SIG{INT} = 'IGNORE';
2201 local $SIG{QUIT} = 'IGNORE';
2202 local $SIG{TERM} = 'IGNORE';
2203 local $SIG{TSTP} = 'IGNORE';
2204 local $SIG{PIPE} = 'IGNORE';
2206 my $oldAutoCommit = $FS::UID::AutoCommit;
2207 local $FS::UID::AutoCommit = 0;
2211 my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2212 return "Customer not found: $custnum" unless $cust_main;
2214 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2217 my $change = scalar(@old_cust_pkg) != 0;
2220 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2224 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
2226 #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
2227 $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
2229 $hash{'change_date'} = $time;
2230 $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
2233 # Create the new packages.
2234 foreach my $pkgpart (@$pkgparts) {
2235 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2236 pkgpart => $pkgpart,
2240 $error = $cust_pkg->insert( 'change' => $change );
2242 $dbh->rollback if $oldAutoCommit;
2245 push @$return_cust_pkg, $cust_pkg;
2247 # $return_cust_pkg now contains refs to all of the newly
2250 # Transfer services and cancel old packages.
2251 foreach my $old_pkg (@old_cust_pkg) {
2253 foreach my $new_pkg (@$return_cust_pkg) {
2254 $error = $old_pkg->transfer($new_pkg);
2255 if ($error and $error == 0) {
2256 # $old_pkg->transfer failed.
2257 $dbh->rollback if $oldAutoCommit;
2262 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2263 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2264 foreach my $new_pkg (@$return_cust_pkg) {
2265 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2266 if ($error and $error == 0) {
2267 # $old_pkg->transfer failed.
2268 $dbh->rollback if $oldAutoCommit;
2275 # Transfers were successful, but we went through all of the
2276 # new packages and still had services left on the old package.
2277 # We can't cancel the package under the circumstances, so abort.
2278 $dbh->rollback if $oldAutoCommit;
2279 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2281 $error = $old_pkg->cancel( quiet=>1 );
2287 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2291 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2293 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2294 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2297 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2298 replace. The services (see L<FS::cust_svc>) are moved to the
2299 new billing items. An error is returned if this is not possible (see
2302 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2303 newly-created cust_pkg objects.
2308 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2310 # Transactionize this whole mess
2311 local $SIG{HUP} = 'IGNORE';
2312 local $SIG{INT} = 'IGNORE';
2313 local $SIG{QUIT} = 'IGNORE';
2314 local $SIG{TERM} = 'IGNORE';
2315 local $SIG{TSTP} = 'IGNORE';
2316 local $SIG{PIPE} = 'IGNORE';
2318 my $oldAutoCommit = $FS::UID::AutoCommit;
2319 local $FS::UID::AutoCommit = 0;
2323 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2326 while(scalar(@old_cust_pkg)) {
2328 my $custnum = $old_cust_pkg[0]->custnum;
2329 my (@remove) = map { $_->pkgnum }
2330 grep { $_->custnum == $custnum } @old_cust_pkg;
2331 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2333 my $error = order $custnum, $pkgparts, \@remove, \@return;
2335 push @errors, $error
2337 push @$return_cust_pkg, @return;
2340 if (scalar(@errors)) {
2341 $dbh->rollback if $oldAutoCommit;
2342 return join(' / ', @errors);
2345 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2351 Associates this package with a (suspension or cancellation) reason (see
2352 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2355 Available options are:
2361 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.
2365 the access_user (see L<FS::access_user>) providing the reason
2373 the action (cancel, susp, adjourn, expire) associated with the reason
2377 If there is an error, returns the error, otherwise returns false.
2382 my ($self, %options) = @_;
2384 my $otaker = $options{reason_otaker} ||
2385 $FS::CurrentUser::CurrentUser->username;
2388 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2392 } elsif ( ref($options{'reason'}) ) {
2394 return 'Enter a new reason (or select an existing one)'
2395 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2397 my $reason = new FS::reason({
2398 'reason_type' => $options{'reason'}->{'typenum'},
2399 'reason' => $options{'reason'}->{'reason'},
2401 my $error = $reason->insert;
2402 return $error if $error;
2404 $reasonnum = $reason->reasonnum;
2407 return "Unparsable reason: ". $options{'reason'};
2410 my $cust_pkg_reason =
2411 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2412 'reasonnum' => $reasonnum,
2413 'otaker' => $otaker,
2414 'action' => substr(uc($options{'action'}),0,1),
2415 'date' => $options{'date'}
2420 $cust_pkg_reason->insert;
2423 =item set_usage USAGE_VALUE_HASHREF
2425 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2426 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2427 upbytes, downbytes, and totalbytes are appropriate keys.
2429 All svc_accts which are part of this package have their values reset.
2434 my ($self, $valueref) = @_;
2436 foreach my $cust_svc ($self->cust_svc){
2437 my $svc_x = $cust_svc->svc_x;
2438 $svc_x->set_usage($valueref)
2439 if $svc_x->can("set_usage");
2443 =item recharge USAGE_VALUE_HASHREF
2445 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2446 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2447 upbytes, downbytes, and totalbytes are appropriate keys.
2449 All svc_accts which are part of this package have their values incremented.
2454 my ($self, $valueref) = @_;
2456 foreach my $cust_svc ($self->cust_svc){
2457 my $svc_x = $cust_svc->svc_x;
2458 $svc_x->recharge($valueref)
2459 if $svc_x->can("recharge");
2467 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2469 In sub order, the @pkgparts array (passed by reference) is clobbered.
2471 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2472 method to pass dates to the recur_prog expression, it should do so.
2474 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2475 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2476 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2477 configuration values. Probably need a subroutine which decides what to do
2478 based on whether or not we've fetched the user yet, rather than a hash. See
2479 FS::UID and the TODO.
2481 Now that things are transactional should the check in the insert method be
2486 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2487 L<FS::pkg_svc>, schema.html from the base documentation