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;
16 use FS::cust_location;
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>)
121 Optional link to package location (see L<FS::location>)
129 date (next bill date)
153 order taker (assigned automatically if null, see L<FS::UID>)
157 If this field is set to 1, disables the automatic
158 unsuspension of this package when using the B<unsuspendauto> config option.
162 If not set, defaults to 1
166 Date of change from previous package
176 =item change_locationnum
182 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
183 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
184 L<Time::Local> and L<Date::Parse> for conversion functions.
192 Create a new billing item. To add the item to the database, see L<"insert">.
196 sub table { 'cust_pkg'; }
197 sub cust_linked { $_[0]->cust_main_custnum; }
198 sub cust_unlinked_msg {
200 "WARNING: can't find cust_main.custnum ". $self->custnum.
201 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
204 =item insert [ OPTION => VALUE ... ]
206 Adds this billing item to the database ("Orders" the item). If there is an
207 error, returns the error, otherwise returns false.
209 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
210 will be used to look up the package definition and agent restrictions will be
213 If the additional field I<refnum> is defined, an FS::pkg_referral record will
214 be created and inserted. Multiple FS::pkg_referral records can be created by
215 setting I<refnum> to an array reference of refnums or a hash reference with
216 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
217 record will be created corresponding to cust_main.refnum.
219 The following options are available:
225 If set true, supresses any referral credit to a referring customer.
229 cust_pkg_option records will be created
236 my( $self, %options ) = @_;
238 local $SIG{HUP} = 'IGNORE';
239 local $SIG{INT} = 'IGNORE';
240 local $SIG{QUIT} = 'IGNORE';
241 local $SIG{TERM} = 'IGNORE';
242 local $SIG{TSTP} = 'IGNORE';
243 local $SIG{PIPE} = 'IGNORE';
245 my $oldAutoCommit = $FS::UID::AutoCommit;
246 local $FS::UID::AutoCommit = 0;
249 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
251 $dbh->rollback if $oldAutoCommit;
255 $self->refnum($self->cust_main->refnum) unless $self->refnum;
256 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
257 $self->process_m2m( 'link_table' => 'pkg_referral',
258 'target_table' => 'part_referral',
259 'params' => $self->refnum,
262 #if ( $self->reg_code ) {
263 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
264 # $error = $reg_code->delete;
266 # $dbh->rollback if $oldAutoCommit;
271 my $conf = new FS::Conf;
273 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
274 my $queue = new FS::queue {
275 'job' => 'FS::cust_main::queueable_print',
277 $error = $queue->insert(
278 'custnum' => $self->custnum,
279 'template' => 'welcome_letter',
283 warn "can't send welcome letter: $error";
288 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
295 This method now works but you probably shouldn't use it.
297 You don't want to delete billing items, because there would then be no record
298 the customer ever purchased the item. Instead, see the cancel method.
303 # return "Can't delete cust_pkg records!";
306 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
308 Replaces the OLD_RECORD with this one in the database. If there is an error,
309 returns the error, otherwise returns false.
311 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
313 Changing pkgpart may have disasterous effects. See the order subroutine.
315 setup and bill are normally updated by calling the bill method of a customer
316 object (see L<FS::cust_main>).
318 suspend is normally updated by the suspend and unsuspend methods.
320 cancel is normally updated by the cancel method (and also the order subroutine
323 Available options are:
329 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.
333 the access_user (see L<FS::access_user>) providing the reason
337 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
346 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
351 ( ref($_[0]) eq 'HASH' )
355 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
356 return "Can't change otaker!" if $old->otaker ne $new->otaker;
359 #return "Can't change setup once it exists!"
360 # if $old->getfield('setup') &&
361 # $old->getfield('setup') != $new->getfield('setup');
363 #some logic for bill, susp, cancel?
365 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
367 local $SIG{HUP} = 'IGNORE';
368 local $SIG{INT} = 'IGNORE';
369 local $SIG{QUIT} = 'IGNORE';
370 local $SIG{TERM} = 'IGNORE';
371 local $SIG{TSTP} = 'IGNORE';
372 local $SIG{PIPE} = 'IGNORE';
374 my $oldAutoCommit = $FS::UID::AutoCommit;
375 local $FS::UID::AutoCommit = 0;
378 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
379 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
380 my $error = $new->insert_reason(
381 'reason' => $options->{'reason'},
382 'date' => $new->$method,
384 'reason_otaker' => $options->{'reason_otaker'},
387 dbh->rollback if $oldAutoCommit;
388 return "Error inserting cust_pkg_reason: $error";
393 #save off and freeze RADIUS attributes for any associated svc_acct records
395 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
397 #also check for specific exports?
398 # to avoid spurious modify export events
399 @svc_acct = map { $_->svc_x }
400 grep { $_->part_svc->svcdb eq 'svc_acct' }
403 $_->snapshot foreach @svc_acct;
407 my $error = $new->SUPER::replace($old,
408 $options->{options} ? $options->{options} : ()
411 $dbh->rollback if $oldAutoCommit;
415 #for prepaid packages,
416 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
417 foreach my $old_svc_acct ( @svc_acct ) {
418 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
419 my $s_error = $new_svc_acct->replace($old_svc_acct);
421 $dbh->rollback if $oldAutoCommit;
426 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
433 Checks all fields to make sure this is a valid billing item. If there is an
434 error, returns the error, otherwise returns false. Called by the insert and
442 $self->locationnum('')
443 if defined($self->locationnum) && length($self->locationnum)
444 && ( $self->locationnum == 0 || $self->locationnum == -1 );
447 $self->ut_numbern('pkgnum')
448 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
449 || $self->ut_numbern('pkgpart')
450 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
451 || $self->ut_numbern('setup')
452 || $self->ut_numbern('bill')
453 || $self->ut_numbern('susp')
454 || $self->ut_numbern('cancel')
455 || $self->ut_numbern('adjourn')
456 || $self->ut_numbern('expire')
458 return $error if $error;
460 if ( $self->reg_code ) {
462 unless ( grep { $self->pkgpart == $_->pkgpart }
463 map { $_->reg_code_pkg }
464 qsearchs( 'reg_code', { 'code' => $self->reg_code,
465 'agentnum' => $self->cust_main->agentnum })
467 return "Unknown registration code";
470 } elsif ( $self->promo_code ) {
473 qsearchs('part_pkg', {
474 'pkgpart' => $self->pkgpart,
475 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
477 return 'Unknown promotional code' unless $promo_part_pkg;
481 unless ( $disable_agentcheck ) {
483 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
484 my $pkgpart_href = $agent->pkgpart_hashref;
485 return "agent ". $agent->agentnum.
486 " can't purchase pkgpart ". $self->pkgpart
487 unless $pkgpart_href->{ $self->pkgpart };
490 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
491 return $error if $error;
495 $self->otaker(getotaker) unless $self->otaker;
496 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
499 if ( $self->dbdef_table->column('manual_flag') ) {
500 $self->manual_flag('') if $self->manual_flag eq ' ';
501 $self->manual_flag =~ /^([01]?)$/
502 or return "Illegal manual_flag ". $self->manual_flag;
503 $self->manual_flag($1);
509 =item cancel [ OPTION => VALUE ... ]
511 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
512 in this package, then cancels the package itself (sets the cancel field to
515 Available options are:
519 =item quiet - can be set true to supress email cancellation notices.
521 =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.
523 =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.
525 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
529 If there is an error, returns the error, otherwise returns false.
534 my( $self, %options ) = @_;
537 warn "cust_pkg::cancel called with options".
538 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
541 local $SIG{HUP} = 'IGNORE';
542 local $SIG{INT} = 'IGNORE';
543 local $SIG{QUIT} = 'IGNORE';
544 local $SIG{TERM} = 'IGNORE';
545 local $SIG{TSTP} = 'IGNORE';
546 local $SIG{PIPE} = 'IGNORE';
548 my $oldAutoCommit = $FS::UID::AutoCommit;
549 local $FS::UID::AutoCommit = 0;
552 my $old = $self->select_for_update;
554 if ( $old->get('cancel') || $self->get('cancel') ) {
555 dbh->rollback if $oldAutoCommit;
556 return ""; # no error
559 my $date = $options{date} if $options{date}; # expire/cancel later
560 $date = '' if ($date && $date <= time); # complain instead?
562 my $cancel_time = $options{'time'} || time;
564 if ( $options{'reason'} ) {
565 $error = $self->insert_reason( 'reason' => $options{'reason'},
566 'action' => $date ? 'expire' : 'cancel',
567 'date' => $date ? $date : $cancel_time,
568 'reason_otaker' => $options{'reason_otaker'},
571 dbh->rollback if $oldAutoCommit;
572 return "Error inserting cust_pkg_reason: $error";
578 foreach my $cust_svc (
581 sort { $a->[1] <=> $b->[1] }
582 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
583 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
586 my $error = $cust_svc->cancel;
589 $dbh->rollback if $oldAutoCommit;
590 return "Error cancelling cust_svc: $error";
594 # Add a credit for remaining service
595 my $remaining_value = $self->calc_remain(time=>$cancel_time);
596 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
597 my $conf = new FS::Conf;
598 my $error = $self->cust_main->credit(
600 'Credit for unused time on '. $self->part_pkg->pkg,
601 'reason_type' => $conf->config('cancel_credit_type'),
604 $dbh->rollback if $oldAutoCommit;
605 return "Error crediting customer \$$remaining_value for unused time on".
606 $self->part_pkg->pkg. ": $error";
611 my %hash = $self->hash;
612 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
613 my $new = new FS::cust_pkg ( \%hash );
614 $error = $new->replace( $self, options => { $self->options } );
616 $dbh->rollback if $oldAutoCommit;
620 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
621 return '' if $date; #no errors
623 my $conf = new FS::Conf;
624 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
625 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
626 my $conf = new FS::Conf;
627 my $error = send_email(
628 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
629 'to' => \@invoicing_list,
630 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
631 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
633 #should this do something on errors?
640 =item cancel_if_expired [ NOW_TIMESTAMP ]
642 Cancels this package if its expire date has been reached.
646 sub cancel_if_expired {
648 my $time = shift || time;
649 return '' unless $self->expire && $self->expire <= $time;
650 my $error = $self->cancel;
652 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
653 $self->custnum. ": $error";
660 Cancels any pending expiration (sets the expire field to null).
662 If there is an error, returns the error, otherwise returns false.
667 my( $self, %options ) = @_;
670 local $SIG{HUP} = 'IGNORE';
671 local $SIG{INT} = 'IGNORE';
672 local $SIG{QUIT} = 'IGNORE';
673 local $SIG{TERM} = 'IGNORE';
674 local $SIG{TSTP} = 'IGNORE';
675 local $SIG{PIPE} = 'IGNORE';
677 my $oldAutoCommit = $FS::UID::AutoCommit;
678 local $FS::UID::AutoCommit = 0;
681 my $old = $self->select_for_update;
683 my $pkgnum = $old->pkgnum;
684 if ( $old->get('cancel') || $self->get('cancel') ) {
685 dbh->rollback if $oldAutoCommit;
686 return "Can't unexpire cancelled package $pkgnum";
687 # or at least it's pointless
690 unless ( $old->get('expire') && $self->get('expire') ) {
691 dbh->rollback if $oldAutoCommit;
692 return ""; # no error
695 my %hash = $self->hash;
696 $hash{'expire'} = '';
697 my $new = new FS::cust_pkg ( \%hash );
698 $error = $new->replace( $self, options => { $self->options } );
700 $dbh->rollback if $oldAutoCommit;
704 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
710 =item suspend [ OPTION => VALUE ... ]
712 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
713 package, then suspends the package itself (sets the susp field to now).
715 Available options are:
719 =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.
721 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
725 If there is an error, returns the error, otherwise returns false.
730 my( $self, %options ) = @_;
733 local $SIG{HUP} = 'IGNORE';
734 local $SIG{INT} = 'IGNORE';
735 local $SIG{QUIT} = 'IGNORE';
736 local $SIG{TERM} = 'IGNORE';
737 local $SIG{TSTP} = 'IGNORE';
738 local $SIG{PIPE} = 'IGNORE';
740 my $oldAutoCommit = $FS::UID::AutoCommit;
741 local $FS::UID::AutoCommit = 0;
744 my $old = $self->select_for_update;
746 my $pkgnum = $old->pkgnum;
747 if ( $old->get('cancel') || $self->get('cancel') ) {
748 dbh->rollback if $oldAutoCommit;
749 return "Can't suspend cancelled package $pkgnum";
752 if ( $old->get('susp') || $self->get('susp') ) {
753 dbh->rollback if $oldAutoCommit;
754 return ""; # no error # complain on adjourn?
757 my $date = $options{date} if $options{date}; # adjourn/suspend later
758 $date = '' if ($date && $date <= time); # complain instead?
760 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
761 dbh->rollback if $oldAutoCommit;
762 return "Package $pkgnum expires before it would be suspended.";
765 my $suspend_time = $options{'time'} || time;
767 if ( $options{'reason'} ) {
768 $error = $self->insert_reason( 'reason' => $options{'reason'},
769 'action' => $date ? 'adjourn' : 'suspend',
770 'date' => $date ? $date : $suspend_time,
771 'reason_otaker' => $options{'reason_otaker'},
774 dbh->rollback if $oldAutoCommit;
775 return "Error inserting cust_pkg_reason: $error";
783 foreach my $cust_svc (
784 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
786 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
788 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
789 $dbh->rollback if $oldAutoCommit;
790 return "Illegal svcdb value in part_svc!";
793 require "FS/$svcdb.pm";
795 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
797 $error = $svc->suspend;
799 $dbh->rollback if $oldAutoCommit;
802 my( $label, $value ) = $cust_svc->label;
803 push @labels, "$label: $value";
807 my $conf = new FS::Conf;
808 if ( $conf->config('suspend_email_admin') ) {
810 my $error = send_email(
811 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
812 #invoice_from ??? well as good as any
813 'to' => $conf->config('suspend_email_admin'),
814 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
816 "This is an automatic message from your Freeside installation\n",
817 "informing you that the following customer package has been suspended:\n",
819 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
820 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
821 ( map { "Service : $_\n" } @labels ),
826 warn "WARNING: can't send suspension admin email (suspending anyway): ".
834 my %hash = $self->hash;
836 $hash{'adjourn'} = $date;
838 $hash{'susp'} = $suspend_time;
840 my $new = new FS::cust_pkg ( \%hash );
841 $error = $new->replace( $self, options => { $self->options } );
843 $dbh->rollback if $oldAutoCommit;
847 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
852 =item unsuspend [ OPTION => VALUE ... ]
854 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
855 package, then unsuspends the package itself (clears the susp field and the
856 adjourn field if it is in the past).
858 Available options are:
862 =item adjust_next_bill
864 Can be set true to adjust the next bill date forward by
865 the amount of time the account was inactive. This was set true by default
866 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
867 explicitly requested. Price plans for which this makes sense (anniversary-date
868 based than prorate or subscription) could have an option to enable this
873 If there is an error, returns the error, otherwise returns false.
878 my( $self, %opt ) = @_;
881 local $SIG{HUP} = 'IGNORE';
882 local $SIG{INT} = 'IGNORE';
883 local $SIG{QUIT} = 'IGNORE';
884 local $SIG{TERM} = 'IGNORE';
885 local $SIG{TSTP} = 'IGNORE';
886 local $SIG{PIPE} = 'IGNORE';
888 my $oldAutoCommit = $FS::UID::AutoCommit;
889 local $FS::UID::AutoCommit = 0;
892 my $old = $self->select_for_update;
894 my $pkgnum = $old->pkgnum;
895 if ( $old->get('cancel') || $self->get('cancel') ) {
896 dbh->rollback if $oldAutoCommit;
897 return "Can't unsuspend cancelled package $pkgnum";
900 unless ( $old->get('susp') && $self->get('susp') ) {
901 dbh->rollback if $oldAutoCommit;
902 return ""; # no error # complain instead?
905 foreach my $cust_svc (
906 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
908 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
910 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
911 $dbh->rollback if $oldAutoCommit;
912 return "Illegal svcdb value in part_svc!";
915 require "FS/$svcdb.pm";
917 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
919 $error = $svc->unsuspend;
921 $dbh->rollback if $oldAutoCommit;
928 my %hash = $self->hash;
929 my $inactive = time - $hash{'susp'};
931 my $conf = new FS::Conf;
933 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
934 if ( $opt{'adjust_next_bill'}
935 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
936 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
939 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
940 my $new = new FS::cust_pkg ( \%hash );
941 $error = $new->replace( $self, options => { $self->options } );
943 $dbh->rollback if $oldAutoCommit;
947 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
954 Cancels any pending suspension (sets the adjourn field to null).
956 If there is an error, returns the error, otherwise returns false.
961 my( $self, %options ) = @_;
964 local $SIG{HUP} = 'IGNORE';
965 local $SIG{INT} = 'IGNORE';
966 local $SIG{QUIT} = 'IGNORE';
967 local $SIG{TERM} = 'IGNORE';
968 local $SIG{TSTP} = 'IGNORE';
969 local $SIG{PIPE} = 'IGNORE';
971 my $oldAutoCommit = $FS::UID::AutoCommit;
972 local $FS::UID::AutoCommit = 0;
975 my $old = $self->select_for_update;
977 my $pkgnum = $old->pkgnum;
978 if ( $old->get('cancel') || $self->get('cancel') ) {
979 dbh->rollback if $oldAutoCommit;
980 return "Can't unadjourn cancelled package $pkgnum";
981 # or at least it's pointless
984 if ( $old->get('susp') || $self->get('susp') ) {
985 dbh->rollback if $oldAutoCommit;
986 return "Can't unadjourn suspended package $pkgnum";
987 # perhaps this is arbitrary
990 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
991 dbh->rollback if $oldAutoCommit;
992 return ""; # no error
995 my %hash = $self->hash;
996 $hash{'adjourn'} = '';
997 my $new = new FS::cust_pkg ( \%hash );
998 $error = $new->replace( $self, options => { $self->options } );
1000 $dbh->rollback if $oldAutoCommit;
1004 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1011 =item change HASHREF | OPTION => VALUE ...
1013 Changes this package: cancels it and creates a new one, with a different
1014 pkgpart or locationnum or both. All services are transferred to the new
1015 package (no change will be made if this is not possible).
1017 Options may be passed as a list of key/value pairs or as a hash reference.
1024 New locationnum, to change the location for this package.
1028 New FS::cust_location object, to create a new location and assign it
1033 New pkgpart (see L<FS::part_pkg>).
1037 New refnum (see L<FS::part_referral>).
1041 At least one option must be specified (otherwise, what's the point?)
1043 Returns either the new FS::cust_pkg object or a scalar error.
1047 my $err_or_new_cust_pkg = $old_cust_pkg->change
1051 #some false laziness w/order
1054 my $opt = ref($_[0]) ? shift : { @_ };
1056 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1059 my $conf = new FS::Conf;
1061 # Transactionize this whole mess
1062 local $SIG{HUP} = 'IGNORE';
1063 local $SIG{INT} = 'IGNORE';
1064 local $SIG{QUIT} = 'IGNORE';
1065 local $SIG{TERM} = 'IGNORE';
1066 local $SIG{TSTP} = 'IGNORE';
1067 local $SIG{PIPE} = 'IGNORE';
1069 my $oldAutoCommit = $FS::UID::AutoCommit;
1070 local $FS::UID::AutoCommit = 0;
1079 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1081 #$hash{$_} = $self->$_() foreach qw( setup );
1083 $hash{'setup'} = $time if $self->setup;
1085 $hash{'change_date'} = $time;
1086 $hash{"change_$_"} = $self->$_()
1087 foreach qw( pkgnum pkgpart locationnum );
1089 if ( $opt->{'cust_location'} &&
1090 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1091 $error = $opt->{'cust_location'}->insert;
1093 $dbh->rollback if $oldAutoCommit;
1094 return "inserting cust_location (transaction rolled back): $error";
1096 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1099 # Create the new package.
1100 my $cust_pkg = new FS::cust_pkg {
1101 custnum => $self->custnum,
1102 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1103 refnum => ( $opt->{'refnum'} || $self->refnum ),
1104 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1108 $error = $cust_pkg->insert( 'change' => 1 );
1110 $dbh->rollback if $oldAutoCommit;
1114 # Transfer services and cancel old package.
1116 $error = $self->transfer($cust_pkg);
1117 if ($error and $error == 0) {
1118 # $old_pkg->transfer failed.
1119 $dbh->rollback if $oldAutoCommit;
1123 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1124 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1125 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1126 if ($error and $error == 0) {
1127 # $old_pkg->transfer failed.
1128 $dbh->rollback if $oldAutoCommit;
1134 # Transfers were successful, but we still had services left on the old
1135 # package. We can't change the package under this circumstances, so abort.
1136 $dbh->rollback if $oldAutoCommit;
1137 return "Unable to transfer all services from package ". $self->pkgnum;
1140 #Good to go, cancel old package.
1141 $error = $self->cancel( quiet=>1 );
1147 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1154 Returns the last bill date, or if there is no last bill date, the setup date.
1155 Useful for billing metered services.
1161 return $self->setfield('last_bill', $_[0]) if @_;
1162 return $self->getfield('last_bill') if $self->getfield('last_bill');
1163 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1164 'edate' => $self->bill, } );
1165 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1168 =item last_cust_pkg_reason ACTION
1170 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1171 Returns false if there is no reason or the package is not currenly ACTION'd
1172 ACTION is one of adjourn, susp, cancel, or expire.
1176 sub last_cust_pkg_reason {
1177 my ( $self, $action ) = ( shift, shift );
1178 my $date = $self->get($action);
1180 'table' => 'cust_pkg_reason',
1181 'hashref' => { 'pkgnum' => $self->pkgnum,
1182 'action' => substr(uc($action), 0, 1),
1185 'order_by' => 'ORDER BY num DESC LIMIT 1',
1189 =item last_reason ACTION
1191 Returns the most recent ACTION FS::reason associated with the package.
1192 Returns false if there is no reason or the package is not currenly ACTION'd
1193 ACTION is one of adjourn, susp, cancel, or expire.
1198 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1199 $cust_pkg_reason->reason
1200 if $cust_pkg_reason;
1205 Returns the definition for this billing item, as an FS::part_pkg object (see
1212 #exists( $self->{'_pkgpart'} )
1214 ? $self->{'_pkgpart'}
1215 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1220 Returns the cancelled package this package was changed from, if any.
1226 return '' unless $self->change_pkgnum;
1227 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1232 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1239 $self->part_pkg->calc_setup($self, @_);
1244 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1251 $self->part_pkg->calc_recur($self, @_);
1256 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1263 $self->part_pkg->calc_remain($self, @_);
1268 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1275 $self->part_pkg->calc_cancel($self, @_);
1280 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1286 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1289 =item cust_pkg_detail [ DETAILTYPE ]
1291 Returns any customer package details for this package (see
1292 L<FS::cust_pkg_detail>).
1294 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1298 sub cust_pkg_detail {
1300 my %hash = ( 'pkgnum' => $self->pkgnum );
1301 $hash{detailtype} = shift if @_;
1303 'table' => 'cust_pkg_detail',
1304 'hashref' => \%hash,
1305 'order_by' => 'ORDER BY weight, pkgdetailnum',
1309 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1311 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1313 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1315 If there is an error, returns the error, otherwise returns false.
1319 sub set_cust_pkg_detail {
1320 my( $self, $detailtype, @details ) = @_;
1322 local $SIG{HUP} = 'IGNORE';
1323 local $SIG{INT} = 'IGNORE';
1324 local $SIG{QUIT} = 'IGNORE';
1325 local $SIG{TERM} = 'IGNORE';
1326 local $SIG{TSTP} = 'IGNORE';
1327 local $SIG{PIPE} = 'IGNORE';
1329 my $oldAutoCommit = $FS::UID::AutoCommit;
1330 local $FS::UID::AutoCommit = 0;
1333 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1334 my $error = $current->delete;
1336 $dbh->rollback if $oldAutoCommit;
1337 return "error removing old detail: $error";
1341 foreach my $detail ( @details ) {
1342 my $cust_pkg_detail = new FS::cust_pkg_detail {
1343 'pkgnum' => $self->pkgnum,
1344 'detailtype' => $detailtype,
1345 'detail' => $detail,
1347 my $error = $cust_pkg_detail->insert;
1349 $dbh->rollback if $oldAutoCommit;
1350 return "error adding new detail: $error";
1355 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1362 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1366 #false laziness w/cust_bill.pm
1370 'table' => 'cust_event',
1371 'addl_from' => 'JOIN part_event USING ( eventpart )',
1372 'hashref' => { 'tablenum' => $self->pkgnum },
1373 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1377 =item num_cust_event
1379 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1383 #false laziness w/cust_bill.pm
1384 sub num_cust_event {
1387 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1388 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1389 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1390 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1391 $sth->fetchrow_arrayref->[0];
1394 =item cust_svc [ SVCPART ]
1396 Returns the services for this package, as FS::cust_svc objects (see
1397 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1406 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1407 'svcpart' => shift, } );
1410 #if ( $self->{'_svcnum'} ) {
1411 # values %{ $self->{'_svcnum'}->cache };
1413 $self->_sort_cust_svc(
1414 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1420 =item overlimit [ SVCPART ]
1422 Returns the services for this package which have exceeded their
1423 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1424 is specified, return only the matching services.
1430 grep { $_->overlimit } $self->cust_svc;
1433 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1435 Returns historical services for this package created before END TIMESTAMP and
1436 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1437 (see L<FS::h_cust_svc>).
1444 $self->_sort_cust_svc(
1445 [ qsearch( 'h_cust_svc',
1446 { 'pkgnum' => $self->pkgnum, },
1447 FS::h_cust_svc->sql_h_search(@_),
1453 sub _sort_cust_svc {
1454 my( $self, $arrayref ) = @_;
1457 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1459 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1460 'svcpart' => $_->svcpart } );
1462 $pkg_svc ? $pkg_svc->primary_svc : '',
1463 $pkg_svc ? $pkg_svc->quantity : 0,
1470 =item num_cust_svc [ SVCPART ]
1472 Returns the number of provisioned services for this package. If a svcpart is
1473 specified, counts only the matching services.
1479 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1480 $sql .= ' AND svcpart = ?' if @_;
1481 my $sth = dbh->prepare($sql) or die dbh->errstr;
1482 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1483 $sth->fetchrow_arrayref->[0];
1486 =item available_part_svc
1488 Returns a list of FS::part_svc objects representing services included in this
1489 package but not yet provisioned. Each FS::part_svc object also has an extra
1490 field, I<num_avail>, which specifies the number of available services.
1494 sub available_part_svc {
1496 grep { $_->num_avail > 0 }
1498 my $part_svc = $_->part_svc;
1499 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1500 $_->quantity - $self->num_cust_svc($_->svcpart);
1503 $self->part_pkg->pkg_svc;
1508 Returns a list of FS::part_svc objects representing provisioned and available
1509 services included in this package. Each FS::part_svc object also has the
1510 following extra fields:
1514 =item num_cust_svc (count)
1516 =item num_avail (quantity - count)
1518 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1521 label -> ($cust_svc->label)[1]
1530 #XXX some sort of sort order besides numeric by svcpart...
1531 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1533 my $part_svc = $pkg_svc->part_svc;
1534 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1535 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1536 $part_svc->{'Hash'}{'num_avail'} =
1537 max( 0, $pkg_svc->quantity - $num_cust_svc );
1538 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1540 } $self->part_pkg->pkg_svc;
1543 push @part_svc, map {
1545 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1546 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1547 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1548 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1550 } $self->extra_part_svc;
1556 =item extra_part_svc
1558 Returns a list of FS::part_svc objects corresponding to services in this
1559 package which are still provisioned but not (any longer) available in the
1564 sub extra_part_svc {
1567 my $pkgnum = $self->pkgnum;
1568 my $pkgpart = $self->pkgpart;
1571 'table' => 'part_svc',
1573 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1574 WHERE pkg_svc.svcpart = part_svc.svcpart
1575 AND pkg_svc.pkgpart = $pkgpart
1578 AND 0 < ( SELECT count(*)
1580 LEFT JOIN cust_pkg using ( pkgnum )
1581 WHERE cust_svc.svcpart = part_svc.svcpart
1582 AND pkgnum = $pkgnum
1589 Returns a short status string for this package, currently:
1593 =item not yet billed
1595 =item one-time charge
1610 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1612 return 'cancelled' if $self->get('cancel');
1613 return 'suspended' if $self->susp;
1614 return 'not yet billed' unless $self->setup;
1615 return 'one-time charge' if $freq =~ /^(0|$)/;
1621 Class method that returns the list of possible status strings for packages
1622 (see L<the status method|/status>). For example:
1624 @statuses = FS::cust_pkg->statuses();
1628 tie my %statuscolor, 'Tie::IxHash',
1629 'not yet billed' => '000000',
1630 'one-time charge' => '000000',
1631 'active' => '00CC00',
1632 'suspended' => 'FF9900',
1633 'cancelled' => 'FF0000',
1637 my $self = shift; #could be class...
1638 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1639 # mayble split btw one-time vs. recur
1645 Returns a hex triplet color string for this package's status.
1651 $statuscolor{$self->status};
1656 Returns a list of lists, calling the label method for all services
1657 (see L<FS::cust_svc>) of this billing item.
1663 map { [ $_->label ] } $self->cust_svc;
1666 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1668 Like the labels method, but returns historical information on services that
1669 were active as of END_TIMESTAMP and (optionally) not cancelled before
1672 Returns a list of lists, calling the label method for all (historical) services
1673 (see L<FS::h_cust_svc>) of this billing item.
1679 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1682 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1684 Like h_labels, except returns a simple flat list, and shortens long
1685 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1686 identical services to one line that lists the service label and the number of
1687 individual services rather than individual items.
1691 sub h_labels_short {
1694 my $conf = new FS::Conf;
1695 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1698 #tie %labels, 'Tie::IxHash';
1699 push @{ $labels{$_->[0]} }, $_->[1]
1700 foreach $self->h_labels(@_);
1702 foreach my $label ( keys %labels ) {
1704 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1705 my $num = scalar(@values);
1706 if ( $num > $max_same_services ) {
1707 push @labels, "$label ($num)";
1709 push @labels, map { "$label: $_" } @values;
1719 Returns the parent customer object (see L<FS::cust_main>).
1725 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1730 Returns the location object, if any (see L<FS::cust_location>).
1736 return '' unless $self->locationnum;
1737 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1740 =item cust_location_or_main
1742 If this package is associated with a location, returns the locaiton (see
1743 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1747 sub cust_location_or_main {
1749 $self->cust_location || $self->cust_main;
1752 =item seconds_since TIMESTAMP
1754 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1755 package have been online since TIMESTAMP, according to the session monitor.
1757 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1758 L<Time::Local> and L<Date::Parse> for conversion functions.
1763 my($self, $since) = @_;
1766 foreach my $cust_svc (
1767 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1769 $seconds += $cust_svc->seconds_since($since);
1776 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1778 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1779 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1782 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1783 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1789 sub seconds_since_sqlradacct {
1790 my($self, $start, $end) = @_;
1794 foreach my $cust_svc (
1796 my $part_svc = $_->part_svc;
1797 $part_svc->svcdb eq 'svc_acct'
1798 && scalar($part_svc->part_export('sqlradius'));
1801 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1808 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1810 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1811 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1815 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1816 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1821 sub attribute_since_sqlradacct {
1822 my($self, $start, $end, $attrib) = @_;
1826 foreach my $cust_svc (
1828 my $part_svc = $_->part_svc;
1829 $part_svc->svcdb eq 'svc_acct'
1830 && scalar($part_svc->part_export('sqlradius'));
1833 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1845 my( $self, $value ) = @_;
1846 if ( defined($value) ) {
1847 $self->setfield('quantity', $value);
1849 $self->getfield('quantity') || 1;
1852 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1854 Transfers as many services as possible from this package to another package.
1856 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1857 object. The destination package must already exist.
1859 Services are moved only if the destination allows services with the correct
1860 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1861 this option with caution! No provision is made for export differences
1862 between the old and new service definitions. Probably only should be used
1863 when your exports for all service definitions of a given svcdb are identical.
1864 (attempt a transfer without it first, to move all possible svcpart-matching
1867 Any services that can't be moved remain in the original package.
1869 Returns an error, if there is one; otherwise, returns the number of services
1870 that couldn't be moved.
1875 my ($self, $dest_pkgnum, %opt) = @_;
1881 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1882 $dest = $dest_pkgnum;
1883 $dest_pkgnum = $dest->pkgnum;
1885 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1888 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1890 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1891 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1894 foreach my $cust_svc ($dest->cust_svc) {
1895 $target{$cust_svc->svcpart}--;
1898 my %svcpart2svcparts = ();
1899 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1900 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1901 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1902 next if exists $svcpart2svcparts{$svcpart};
1903 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1904 $svcpart2svcparts{$svcpart} = [
1906 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1908 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1909 'svcpart' => $_ } );
1911 $pkg_svc ? $pkg_svc->primary_svc : '',
1912 $pkg_svc ? $pkg_svc->quantity : 0,
1916 grep { $_ != $svcpart }
1918 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1920 warn "alternates for svcpart $svcpart: ".
1921 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1926 foreach my $cust_svc ($self->cust_svc) {
1927 if($target{$cust_svc->svcpart} > 0) {
1928 $target{$cust_svc->svcpart}--;
1929 my $new = new FS::cust_svc { $cust_svc->hash };
1930 $new->pkgnum($dest_pkgnum);
1931 my $error = $new->replace($cust_svc);
1932 return $error if $error;
1933 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1935 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1936 warn "alternates to consider: ".
1937 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1939 my @alternate = grep {
1940 warn "considering alternate svcpart $_: ".
1941 "$target{$_} available in new package\n"
1944 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1946 warn "alternate(s) found\n" if $DEBUG;
1947 my $change_svcpart = $alternate[0];
1948 $target{$change_svcpart}--;
1949 my $new = new FS::cust_svc { $cust_svc->hash };
1950 $new->svcpart($change_svcpart);
1951 $new->pkgnum($dest_pkgnum);
1952 my $error = $new->replace($cust_svc);
1953 return $error if $error;
1966 This method is deprecated. See the I<depend_jobnum> option to the insert and
1967 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1974 local $SIG{HUP} = 'IGNORE';
1975 local $SIG{INT} = 'IGNORE';
1976 local $SIG{QUIT} = 'IGNORE';
1977 local $SIG{TERM} = 'IGNORE';
1978 local $SIG{TSTP} = 'IGNORE';
1979 local $SIG{PIPE} = 'IGNORE';
1981 my $oldAutoCommit = $FS::UID::AutoCommit;
1982 local $FS::UID::AutoCommit = 0;
1985 foreach my $cust_svc ( $self->cust_svc ) {
1986 #false laziness w/svc_Common::insert
1987 my $svc_x = $cust_svc->svc_x;
1988 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1989 my $error = $part_export->export_insert($svc_x);
1991 $dbh->rollback if $oldAutoCommit;
1997 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2004 =head1 CLASS METHODS
2010 Returns an SQL expression identifying recurring packages.
2014 sub recurring_sql { "
2015 '0' != ( select freq from part_pkg
2016 where cust_pkg.pkgpart = part_pkg.pkgpart )
2021 Returns an SQL expression identifying one-time packages.
2026 '0' = ( select freq from part_pkg
2027 where cust_pkg.pkgpart = part_pkg.pkgpart )
2032 Returns an SQL expression identifying active packages.
2037 ". $_[0]->recurring_sql(). "
2038 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2039 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2044 Returns an SQL expression identifying inactive packages (one-time packages
2045 that are otherwise unsuspended/uncancelled).
2049 sub inactive_sql { "
2050 ". $_[0]->onetime_sql(). "
2051 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2052 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2058 Returns an SQL expression identifying suspended packages.
2062 sub suspended_sql { susp_sql(@_); }
2064 #$_[0]->recurring_sql(). ' AND '.
2066 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2067 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2074 Returns an SQL exprression identifying cancelled packages.
2078 sub cancelled_sql { cancel_sql(@_); }
2080 #$_[0]->recurring_sql(). ' AND '.
2081 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2084 =item search_sql HASHREF
2088 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2089 Valid parameters are
2097 active, inactive, suspended, cancel (or cancelled)
2101 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2111 arrayref of beginning and ending epoch date
2115 arrayref of beginning and ending epoch date
2119 arrayref of beginning and ending epoch date
2123 arrayref of beginning and ending epoch date
2127 arrayref of beginning and ending epoch date
2131 arrayref of beginning and ending epoch date
2135 arrayref of beginning and ending epoch date
2139 pkgnum or APKG_pkgnum
2143 a value suited to passing to FS::UI::Web::cust_header
2147 specifies the user for agent virtualization
2154 my ($class, $params) = @_;
2161 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2163 "cust_main.agentnum = $1";
2170 if ( $params->{'magic'} eq 'active'
2171 || $params->{'status'} eq 'active' ) {
2173 push @where, FS::cust_pkg->active_sql();
2175 } elsif ( $params->{'magic'} eq 'inactive'
2176 || $params->{'status'} eq 'inactive' ) {
2178 push @where, FS::cust_pkg->inactive_sql();
2180 } elsif ( $params->{'magic'} eq 'suspended'
2181 || $params->{'status'} eq 'suspended' ) {
2183 push @where, FS::cust_pkg->suspended_sql();
2185 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2186 || $params->{'status'} =~ /^cancell?ed$/ ) {
2188 push @where, FS::cust_pkg->cancelled_sql();
2190 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
2192 push @where, FS::cust_pkg->inactive_sql();
2197 # parse package class
2200 #false lazinessish w/graph/cust_bill_pkg.cgi
2203 if ( exists($params->{'classnum'})
2204 && $params->{'classnum'} =~ /^(\d*)$/
2208 if ( $classnum ) { #a specific class
2209 push @where, "classnum = $classnum";
2211 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2212 #die "classnum $classnum not found!" unless $pkg_class[0];
2213 #$title .= $pkg_class[0]->classname.' ';
2215 } elsif ( $classnum eq '' ) { #the empty class
2217 push @where, "classnum IS NULL";
2218 #$title .= 'Empty class ';
2219 #@pkg_class = ( '(empty class)' );
2220 } elsif ( $classnum eq '0' ) {
2221 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2222 #push @pkg_class, '(empty class)';
2224 die "illegal classnum";
2233 my $pkgpart = join (' OR pkgpart=',
2234 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2235 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2243 #false laziness w/report_cust_pkg.html
2246 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2247 'active' => { 'susp'=>1, 'cancel'=>1 },
2248 'suspended' => { 'cancel' => 1 },
2253 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2255 next unless exists($params->{$field});
2257 my($beginning, $ending) = @{$params->{$field}};
2259 next if $beginning == 0 && $ending == 4294967295;
2262 "cust_pkg.$field IS NOT NULL",
2263 "cust_pkg.$field >= $beginning",
2264 "cust_pkg.$field <= $ending";
2266 $orderby ||= "ORDER BY cust_pkg.$field";
2270 $orderby ||= 'ORDER BY bill';
2273 # parse magic, legacy, etc.
2276 if ( $params->{'magic'} &&
2277 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2280 $orderby = 'ORDER BY pkgnum';
2282 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2283 push @where, "pkgpart = $1";
2286 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2288 $orderby = 'ORDER BY pkgnum';
2290 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2292 $orderby = 'ORDER BY pkgnum';
2295 SELECT count(*) FROM pkg_svc
2296 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2297 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2298 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2299 AND cust_svc.svcpart = pkg_svc.svcpart
2306 # setup queries, links, subs, etc. for the search
2309 # here is the agent virtualization
2310 if ($params->{CurrentUser}) {
2312 qsearchs('access_user', { username => $params->{CurrentUser} });
2315 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2320 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2323 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2325 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2326 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2327 'LEFT JOIN pkg_class USING ( classnum ) ';
2329 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2332 'table' => 'cust_pkg',
2334 'select' => join(', ',
2336 ( map "part_pkg.$_", qw( pkg freq ) ),
2337 'pkg_class.classname',
2338 'cust_main.custnum as cust_main_custnum',
2339 FS::UI::Web::cust_sql_fields(
2340 $params->{'cust_fields'}
2343 'extra_sql' => "$extra_sql $orderby",
2344 'addl_from' => $addl_from,
2345 'count_query' => $count_query,
2352 Returns a list: the first item is an SQL fragment identifying matching
2353 packages/customers via location (taking into account shipping and package
2354 address taxation, if enabled), and subsequent items are the parameters to
2355 substitute for the placeholders in that fragment.
2360 my($class, %opt) = @_;
2361 my $ornull = $opt{'ornull'};
2363 my $conf = new FS::Conf;
2365 # '?' placeholders in _location_sql_where
2368 @bill_param = qw( county county state state state country );
2370 @bill_param = qw( county state state country );
2372 unshift @bill_param, 'county'; # unless $nec;
2376 if ( $conf->exists('tax-ship_address') ) {
2379 ( ( ship_last IS NULL OR ship_last = '' )
2380 AND ". _location_sql_where('cust_main', '', $ornull ). "
2382 OR ( ship_last IS NOT NULL AND ship_last != ''
2383 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2386 # AND payby != 'COMP'
2388 @main_param = ( @bill_param, @bill_param );
2392 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2393 @main_param = @bill_param;
2399 if ( $conf->exists('tax-pkg_address') ) {
2401 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2404 ( cust_pkg.locationnum IS NULL AND $main_where )
2405 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2408 @param = ( @main_param, @bill_param );
2412 $where = $main_where;
2413 @param = @main_param;
2421 #subroutine, helper for location_sql
2422 sub _location_sql_where {
2424 my $prefix = @_ ? shift : '';
2425 my $ornull = @_ ? shift : '';
2427 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2429 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2431 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2432 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2435 ( $table.${prefix}county = ? $or_empty_county $ornull )
2436 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2437 AND $table.${prefix}country = ?
2445 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2447 CUSTNUM is a customer (see L<FS::cust_main>)
2449 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2450 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2453 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2454 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2455 new billing items. An error is returned if this is not possible (see
2456 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2459 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2460 newly-created cust_pkg objects.
2462 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2463 and inserted. Multiple FS::pkg_referral records can be created by
2464 setting I<refnum> to an array reference of refnums or a hash reference with
2465 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2466 record will be created corresponding to cust_main.refnum.
2471 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2473 my $conf = new FS::Conf;
2475 # Transactionize this whole mess
2476 local $SIG{HUP} = 'IGNORE';
2477 local $SIG{INT} = 'IGNORE';
2478 local $SIG{QUIT} = 'IGNORE';
2479 local $SIG{TERM} = 'IGNORE';
2480 local $SIG{TSTP} = 'IGNORE';
2481 local $SIG{PIPE} = 'IGNORE';
2483 my $oldAutoCommit = $FS::UID::AutoCommit;
2484 local $FS::UID::AutoCommit = 0;
2488 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2489 # return "Customer not found: $custnum" unless $cust_main;
2491 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2494 my $change = scalar(@old_cust_pkg) != 0;
2497 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2499 my $err_or_cust_pkg =
2500 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2501 'refnum' => $refnum,
2504 unless (ref($err_or_cust_pkg)) {
2505 $dbh->rollback if $oldAutoCommit;
2506 return $err_or_cust_pkg;
2509 push @$return_cust_pkg, $err_or_cust_pkg;
2514 # Create the new packages.
2515 foreach my $pkgpart (@$pkgparts) {
2516 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2517 pkgpart => $pkgpart,
2521 $error = $cust_pkg->insert( 'change' => $change );
2523 $dbh->rollback if $oldAutoCommit;
2526 push @$return_cust_pkg, $cust_pkg;
2528 # $return_cust_pkg now contains refs to all of the newly
2531 # Transfer services and cancel old packages.
2532 foreach my $old_pkg (@old_cust_pkg) {
2534 foreach my $new_pkg (@$return_cust_pkg) {
2535 $error = $old_pkg->transfer($new_pkg);
2536 if ($error and $error == 0) {
2537 # $old_pkg->transfer failed.
2538 $dbh->rollback if $oldAutoCommit;
2543 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2544 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2545 foreach my $new_pkg (@$return_cust_pkg) {
2546 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2547 if ($error and $error == 0) {
2548 # $old_pkg->transfer failed.
2549 $dbh->rollback if $oldAutoCommit;
2556 # Transfers were successful, but we went through all of the
2557 # new packages and still had services left on the old package.
2558 # We can't cancel the package under the circumstances, so abort.
2559 $dbh->rollback if $oldAutoCommit;
2560 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2562 $error = $old_pkg->cancel( quiet=>1 );
2568 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2572 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2574 A bulk change method to change packages for multiple customers.
2576 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2577 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2580 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2581 replace. The services (see L<FS::cust_svc>) are moved to the
2582 new billing items. An error is returned if this is not possible (see
2585 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2586 newly-created cust_pkg objects.
2591 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2593 # Transactionize this whole mess
2594 local $SIG{HUP} = 'IGNORE';
2595 local $SIG{INT} = 'IGNORE';
2596 local $SIG{QUIT} = 'IGNORE';
2597 local $SIG{TERM} = 'IGNORE';
2598 local $SIG{TSTP} = 'IGNORE';
2599 local $SIG{PIPE} = 'IGNORE';
2601 my $oldAutoCommit = $FS::UID::AutoCommit;
2602 local $FS::UID::AutoCommit = 0;
2606 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2609 while(scalar(@old_cust_pkg)) {
2611 my $custnum = $old_cust_pkg[0]->custnum;
2612 my (@remove) = map { $_->pkgnum }
2613 grep { $_->custnum == $custnum } @old_cust_pkg;
2614 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2616 my $error = order $custnum, $pkgparts, \@remove, \@return;
2618 push @errors, $error
2620 push @$return_cust_pkg, @return;
2623 if (scalar(@errors)) {
2624 $dbh->rollback if $oldAutoCommit;
2625 return join(' / ', @errors);
2628 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2634 Associates this package with a (suspension or cancellation) reason (see
2635 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2638 Available options are:
2644 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.
2648 the access_user (see L<FS::access_user>) providing the reason
2656 the action (cancel, susp, adjourn, expire) associated with the reason
2660 If there is an error, returns the error, otherwise returns false.
2665 my ($self, %options) = @_;
2667 my $otaker = $options{reason_otaker} ||
2668 $FS::CurrentUser::CurrentUser->username;
2671 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2675 } elsif ( ref($options{'reason'}) ) {
2677 return 'Enter a new reason (or select an existing one)'
2678 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2680 my $reason = new FS::reason({
2681 'reason_type' => $options{'reason'}->{'typenum'},
2682 'reason' => $options{'reason'}->{'reason'},
2684 my $error = $reason->insert;
2685 return $error if $error;
2687 $reasonnum = $reason->reasonnum;
2690 return "Unparsable reason: ". $options{'reason'};
2693 my $cust_pkg_reason =
2694 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2695 'reasonnum' => $reasonnum,
2696 'otaker' => $otaker,
2697 'action' => substr(uc($options{'action'}),0,1),
2698 'date' => $options{'date'}
2703 $cust_pkg_reason->insert;
2706 =item set_usage USAGE_VALUE_HASHREF
2708 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2709 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2710 upbytes, downbytes, and totalbytes are appropriate keys.
2712 All svc_accts which are part of this package have their values reset.
2717 my ($self, $valueref) = @_;
2719 foreach my $cust_svc ($self->cust_svc){
2720 my $svc_x = $cust_svc->svc_x;
2721 $svc_x->set_usage($valueref)
2722 if $svc_x->can("set_usage");
2726 =item recharge USAGE_VALUE_HASHREF
2728 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2729 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2730 upbytes, downbytes, and totalbytes are appropriate keys.
2732 All svc_accts which are part of this package have their values incremented.
2737 my ($self, $valueref) = @_;
2739 foreach my $cust_svc ($self->cust_svc){
2740 my $svc_x = $cust_svc->svc_x;
2741 $svc_x->recharge($valueref)
2742 if $svc_x->can("recharge");
2750 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2752 In sub order, the @pkgparts array (passed by reference) is clobbered.
2754 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2755 method to pass dates to the recur_prog expression, it should do so.
2757 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2758 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2759 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2760 configuration values. Probably need a subroutine which decides what to do
2761 based on whether or not we've fetched the user yet, rather than a hash. See
2762 FS::UID and the TODO.
2764 Now that things are transactional should the check in the insert method be
2769 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2770 L<FS::pkg_svc>, schema.html from the base documentation