4 use vars qw(@ISA $disable_agentcheck $DEBUG $me);
6 use Scalar::Util qw( blessed );
7 use List::Util qw(max);
10 use FS::UID qw( getotaker dbh );
11 use FS::Misc qw( send_email );
12 use FS::Record qw( qsearch qsearchs );
14 use FS::cust_main_Mixin;
18 use FS::cust_location;
20 use FS::cust_bill_pkg;
21 use FS::cust_pkg_detail;
26 use FS::cust_pkg_reason;
30 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
32 # because they load configuration by setting FS::UID::callback (see TODO)
38 # for sending cancel emails in sub cancel
41 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
44 $me = '[FS::cust_pkg]';
46 $disable_agentcheck = 0;
50 my ( $hashref, $cache ) = @_;
51 #if ( $hashref->{'pkgpart'} ) {
52 if ( $hashref->{'pkg'} ) {
53 # #@{ $self->{'_pkgnum'} } = ();
54 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
55 # $self->{'_pkgpart'} = $subcache;
56 # #push @{ $self->{'_pkgnum'} },
57 # FS::part_pkg->new_or_cached($hashref, $subcache);
58 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
60 if ( exists $hashref->{'svcnum'} ) {
61 #@{ $self->{'_pkgnum'} } = ();
62 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
63 $self->{'_svcnum'} = $subcache;
64 #push @{ $self->{'_pkgnum'} },
65 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
71 FS::cust_pkg - Object methods for cust_pkg objects
77 $record = new FS::cust_pkg \%hash;
78 $record = new FS::cust_pkg { 'column' => 'value' };
80 $error = $record->insert;
82 $error = $new_record->replace($old_record);
84 $error = $record->delete;
86 $error = $record->check;
88 $error = $record->cancel;
90 $error = $record->suspend;
92 $error = $record->unsuspend;
94 $part_pkg = $record->part_pkg;
96 @labels = $record->labels;
98 $seconds = $record->seconds_since($timestamp);
100 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
101 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
105 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
106 inherits from FS::Record. The following fields are currently supported:
112 Primary key (assigned automatically for new billing items)
116 Customer (see L<FS::cust_main>)
120 Billing item definition (see L<FS::part_pkg>)
124 Optional link to package location (see L<FS::location>)
136 date (next bill date)
160 order taker (assigned automatically if null, see L<FS::UID>)
164 If this field is set to 1, disables the automatic
165 unsuspension of this package when using the B<unsuspendauto> config option.
169 If not set, defaults to 1
173 Date of change from previous package
183 =item change_locationnum
189 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
190 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
191 L<Time::Local> and L<Date::Parse> for conversion functions.
199 Create a new billing item. To add the item to the database, see L<"insert">.
203 sub table { 'cust_pkg'; }
204 sub cust_linked { $_[0]->cust_main_custnum; }
205 sub cust_unlinked_msg {
207 "WARNING: can't find cust_main.custnum ". $self->custnum.
208 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
211 =item insert [ OPTION => VALUE ... ]
213 Adds this billing item to the database ("Orders" the item). If there is an
214 error, returns the error, otherwise returns false.
216 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
217 will be used to look up the package definition and agent restrictions will be
220 If the additional field I<refnum> is defined, an FS::pkg_referral record will
221 be created and inserted. Multiple FS::pkg_referral records can be created by
222 setting I<refnum> to an array reference of refnums or a hash reference with
223 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
224 record will be created corresponding to cust_main.refnum.
226 The following options are available:
232 If set true, supresses any referral credit to a referring customer.
236 cust_pkg_option records will be created
240 a ticket will be added to this customer with this subject
244 an optional queue name for ticket additions
251 my( $self, %options ) = @_;
253 local $SIG{HUP} = 'IGNORE';
254 local $SIG{INT} = 'IGNORE';
255 local $SIG{QUIT} = 'IGNORE';
256 local $SIG{TERM} = 'IGNORE';
257 local $SIG{TSTP} = 'IGNORE';
258 local $SIG{PIPE} = 'IGNORE';
260 my $oldAutoCommit = $FS::UID::AutoCommit;
261 local $FS::UID::AutoCommit = 0;
264 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
266 $dbh->rollback if $oldAutoCommit;
270 $self->refnum($self->cust_main->refnum) unless $self->refnum;
271 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
272 $self->process_m2m( 'link_table' => 'pkg_referral',
273 'target_table' => 'part_referral',
274 'params' => $self->refnum,
277 #if ( $self->reg_code ) {
278 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
279 # $error = $reg_code->delete;
281 # $dbh->rollback if $oldAutoCommit;
286 my $conf = new FS::Conf;
288 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
290 use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
297 my $q = new RT::Queue($RT::SystemUser);
298 $q->Load($options{ticket_queue}) if $options{ticket_queue};
299 my $t = new RT::Ticket($RT::SystemUser);
300 my $mime = new MIME::Entity;
301 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
302 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
303 Subject => $options{ticket_subject},
306 $t->AddLink( Type => 'MemberOf',
307 Target => 'freeside://freeside/cust_main/'. $self->custnum,
311 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
312 my $queue = new FS::queue {
313 'job' => 'FS::cust_main::queueable_print',
315 $error = $queue->insert(
316 'custnum' => $self->custnum,
317 'template' => 'welcome_letter',
321 warn "can't send welcome letter: $error";
326 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
333 This method now works but you probably shouldn't use it.
335 You don't want to delete billing items, because there would then be no record
336 the customer ever purchased the item. Instead, see the cancel method.
341 # return "Can't delete cust_pkg records!";
344 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
346 Replaces the OLD_RECORD with this one in the database. If there is an error,
347 returns the error, otherwise returns false.
349 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
351 Changing pkgpart may have disasterous effects. See the order subroutine.
353 setup and bill are normally updated by calling the bill method of a customer
354 object (see L<FS::cust_main>).
356 suspend is normally updated by the suspend and unsuspend methods.
358 cancel is normally updated by the cancel method (and also the order subroutine
361 Available options are:
367 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.
371 the access_user (see L<FS::access_user>) providing the reason
375 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
384 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
389 ( ref($_[0]) eq 'HASH' )
393 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
394 return "Can't change otaker!" if $old->otaker ne $new->otaker;
397 #return "Can't change setup once it exists!"
398 # if $old->getfield('setup') &&
399 # $old->getfield('setup') != $new->getfield('setup');
401 #some logic for bill, susp, cancel?
403 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
405 local $SIG{HUP} = 'IGNORE';
406 local $SIG{INT} = 'IGNORE';
407 local $SIG{QUIT} = 'IGNORE';
408 local $SIG{TERM} = 'IGNORE';
409 local $SIG{TSTP} = 'IGNORE';
410 local $SIG{PIPE} = 'IGNORE';
412 my $oldAutoCommit = $FS::UID::AutoCommit;
413 local $FS::UID::AutoCommit = 0;
416 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
417 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
418 my $error = $new->insert_reason(
419 'reason' => $options->{'reason'},
420 'date' => $new->$method,
422 'reason_otaker' => $options->{'reason_otaker'},
425 dbh->rollback if $oldAutoCommit;
426 return "Error inserting cust_pkg_reason: $error";
431 #save off and freeze RADIUS attributes for any associated svc_acct records
433 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
435 #also check for specific exports?
436 # to avoid spurious modify export events
437 @svc_acct = map { $_->svc_x }
438 grep { $_->part_svc->svcdb eq 'svc_acct' }
441 $_->snapshot foreach @svc_acct;
445 my $error = $new->SUPER::replace($old,
446 $options->{options} ? $options->{options} : ()
449 $dbh->rollback if $oldAutoCommit;
453 #for prepaid packages,
454 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
455 foreach my $old_svc_acct ( @svc_acct ) {
456 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
457 my $s_error = $new_svc_acct->replace($old_svc_acct);
459 $dbh->rollback if $oldAutoCommit;
464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
471 Checks all fields to make sure this is a valid billing item. If there is an
472 error, returns the error, otherwise returns false. Called by the insert and
480 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
483 $self->ut_numbern('pkgnum')
484 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
485 || $self->ut_numbern('pkgpart')
486 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
487 || $self->ut_numbern('start_date')
488 || $self->ut_numbern('setup')
489 || $self->ut_numbern('bill')
490 || $self->ut_numbern('susp')
491 || $self->ut_numbern('cancel')
492 || $self->ut_numbern('adjourn')
493 || $self->ut_numbern('expire')
495 return $error if $error;
497 if ( $self->reg_code ) {
499 unless ( grep { $self->pkgpart == $_->pkgpart }
500 map { $_->reg_code_pkg }
501 qsearchs( 'reg_code', { 'code' => $self->reg_code,
502 'agentnum' => $self->cust_main->agentnum })
504 return "Unknown registration code";
507 } elsif ( $self->promo_code ) {
510 qsearchs('part_pkg', {
511 'pkgpart' => $self->pkgpart,
512 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
514 return 'Unknown promotional code' unless $promo_part_pkg;
518 unless ( $disable_agentcheck ) {
520 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
521 return "agent ". $agent->agentnum. ':'. $agent->agent.
522 " can't purchase pkgpart ". $self->pkgpart
523 unless $agent->pkgpart_hashref->{ $self->pkgpart }
524 || $agent->agentnum == $self->part_pkg->agentnum;
527 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
528 return $error if $error;
532 $self->otaker(getotaker) unless $self->otaker;
533 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
536 if ( $self->dbdef_table->column('manual_flag') ) {
537 $self->manual_flag('') if $self->manual_flag eq ' ';
538 $self->manual_flag =~ /^([01]?)$/
539 or return "Illegal manual_flag ". $self->manual_flag;
540 $self->manual_flag($1);
546 =item cancel [ OPTION => VALUE ... ]
548 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
549 in this package, then cancels the package itself (sets the cancel field to
552 Available options are:
556 =item quiet - can be set true to supress email cancellation notices.
558 =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.
560 =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.
562 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
564 =item nobill - can be set true to skip billing if it might otherwise be done.
568 If there is an error, returns the error, otherwise returns false.
573 my( $self, %options ) = @_;
576 my $conf = new FS::Conf;
578 warn "cust_pkg::cancel called with options".
579 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
582 local $SIG{HUP} = 'IGNORE';
583 local $SIG{INT} = 'IGNORE';
584 local $SIG{QUIT} = 'IGNORE';
585 local $SIG{TERM} = 'IGNORE';
586 local $SIG{TSTP} = 'IGNORE';
587 local $SIG{PIPE} = 'IGNORE';
589 my $oldAutoCommit = $FS::UID::AutoCommit;
590 local $FS::UID::AutoCommit = 0;
593 my $old = $self->select_for_update;
595 if ( $old->get('cancel') || $self->get('cancel') ) {
596 dbh->rollback if $oldAutoCommit;
597 return ""; # no error
600 my $date = $options{date} if $options{date}; # expire/cancel later
601 $date = '' if ($date && $date <= time); # complain instead?
603 #race condition: usage could be ongoing until unprovisioned
604 #resolved by performing a change package instead (which unprovisions) and
606 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
607 my $copy = $self->new({$self->hash});
609 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
610 warn "Error billing during cancel, custnum ".
611 #$self->cust_main->custnum. ": $error"
617 my $cancel_time = $options{'time'} || time;
619 if ( $options{'reason'} ) {
620 $error = $self->insert_reason( 'reason' => $options{'reason'},
621 'action' => $date ? 'expire' : 'cancel',
622 'date' => $date ? $date : $cancel_time,
623 'reason_otaker' => $options{'reason_otaker'},
626 dbh->rollback if $oldAutoCommit;
627 return "Error inserting cust_pkg_reason: $error";
633 foreach my $cust_svc (
636 sort { $a->[1] <=> $b->[1] }
637 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
638 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
641 my $error = $cust_svc->cancel;
644 $dbh->rollback if $oldAutoCommit;
645 return "Error cancelling cust_svc: $error";
649 # Add a credit for remaining service
650 my $remaining_value = $self->calc_remain(time=>$cancel_time);
651 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
652 my $error = $self->cust_main->credit(
654 'Credit for unused time on '. $self->part_pkg->pkg,
655 'reason_type' => $conf->config('cancel_credit_type'),
658 $dbh->rollback if $oldAutoCommit;
659 return "Error crediting customer \$$remaining_value for unused time on".
660 $self->part_pkg->pkg. ": $error";
665 my %hash = $self->hash;
666 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
667 my $new = new FS::cust_pkg ( \%hash );
668 $error = $new->replace( $self, options => { $self->options } );
670 $dbh->rollback if $oldAutoCommit;
674 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
675 return '' if $date; #no errors
677 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
678 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
679 my $error = send_email(
680 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
681 'to' => \@invoicing_list,
682 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
683 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
685 #should this do something on errors?
692 =item cancel_if_expired [ NOW_TIMESTAMP ]
694 Cancels this package if its expire date has been reached.
698 sub cancel_if_expired {
700 my $time = shift || time;
701 return '' unless $self->expire && $self->expire <= $time;
702 my $error = $self->cancel;
704 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
705 $self->custnum. ": $error";
712 Cancels any pending expiration (sets the expire field to null).
714 If there is an error, returns the error, otherwise returns false.
719 my( $self, %options ) = @_;
722 local $SIG{HUP} = 'IGNORE';
723 local $SIG{INT} = 'IGNORE';
724 local $SIG{QUIT} = 'IGNORE';
725 local $SIG{TERM} = 'IGNORE';
726 local $SIG{TSTP} = 'IGNORE';
727 local $SIG{PIPE} = 'IGNORE';
729 my $oldAutoCommit = $FS::UID::AutoCommit;
730 local $FS::UID::AutoCommit = 0;
733 my $old = $self->select_for_update;
735 my $pkgnum = $old->pkgnum;
736 if ( $old->get('cancel') || $self->get('cancel') ) {
737 dbh->rollback if $oldAutoCommit;
738 return "Can't unexpire cancelled package $pkgnum";
739 # or at least it's pointless
742 unless ( $old->get('expire') && $self->get('expire') ) {
743 dbh->rollback if $oldAutoCommit;
744 return ""; # no error
747 my %hash = $self->hash;
748 $hash{'expire'} = '';
749 my $new = new FS::cust_pkg ( \%hash );
750 $error = $new->replace( $self, options => { $self->options } );
752 $dbh->rollback if $oldAutoCommit;
756 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
762 =item suspend [ OPTION => VALUE ... ]
764 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
765 package, then suspends the package itself (sets the susp field to now).
767 Available options are:
771 =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.
773 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
777 If there is an error, returns the error, otherwise returns false.
782 my( $self, %options ) = @_;
785 local $SIG{HUP} = 'IGNORE';
786 local $SIG{INT} = 'IGNORE';
787 local $SIG{QUIT} = 'IGNORE';
788 local $SIG{TERM} = 'IGNORE';
789 local $SIG{TSTP} = 'IGNORE';
790 local $SIG{PIPE} = 'IGNORE';
792 my $oldAutoCommit = $FS::UID::AutoCommit;
793 local $FS::UID::AutoCommit = 0;
796 my $old = $self->select_for_update;
798 my $pkgnum = $old->pkgnum;
799 if ( $old->get('cancel') || $self->get('cancel') ) {
800 dbh->rollback if $oldAutoCommit;
801 return "Can't suspend cancelled package $pkgnum";
804 if ( $old->get('susp') || $self->get('susp') ) {
805 dbh->rollback if $oldAutoCommit;
806 return ""; # no error # complain on adjourn?
809 my $date = $options{date} if $options{date}; # adjourn/suspend later
810 $date = '' if ($date && $date <= time); # complain instead?
812 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
813 dbh->rollback if $oldAutoCommit;
814 return "Package $pkgnum expires before it would be suspended.";
817 my $suspend_time = $options{'time'} || time;
819 if ( $options{'reason'} ) {
820 $error = $self->insert_reason( 'reason' => $options{'reason'},
821 'action' => $date ? 'adjourn' : 'suspend',
822 'date' => $date ? $date : $suspend_time,
823 'reason_otaker' => $options{'reason_otaker'},
826 dbh->rollback if $oldAutoCommit;
827 return "Error inserting cust_pkg_reason: $error";
835 foreach my $cust_svc (
836 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
838 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
840 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
841 $dbh->rollback if $oldAutoCommit;
842 return "Illegal svcdb value in part_svc!";
845 require "FS/$svcdb.pm";
847 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
849 $error = $svc->suspend;
851 $dbh->rollback if $oldAutoCommit;
854 my( $label, $value ) = $cust_svc->label;
855 push @labels, "$label: $value";
859 my $conf = new FS::Conf;
860 if ( $conf->config('suspend_email_admin') ) {
862 my $error = send_email(
863 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
864 #invoice_from ??? well as good as any
865 'to' => $conf->config('suspend_email_admin'),
866 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
868 "This is an automatic message from your Freeside installation\n",
869 "informing you that the following customer package has been suspended:\n",
871 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
872 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
873 ( map { "Service : $_\n" } @labels ),
878 warn "WARNING: can't send suspension admin email (suspending anyway): ".
886 my %hash = $self->hash;
888 $hash{'adjourn'} = $date;
890 $hash{'susp'} = $suspend_time;
892 my $new = new FS::cust_pkg ( \%hash );
893 $error = $new->replace( $self, options => { $self->options } );
895 $dbh->rollback if $oldAutoCommit;
899 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
904 =item unsuspend [ OPTION => VALUE ... ]
906 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
907 package, then unsuspends the package itself (clears the susp field and the
908 adjourn field if it is in the past).
910 Available options are:
914 =item adjust_next_bill
916 Can be set true to adjust the next bill date forward by
917 the amount of time the account was inactive. This was set true by default
918 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
919 explicitly requested. Price plans for which this makes sense (anniversary-date
920 based than prorate or subscription) could have an option to enable this
925 If there is an error, returns the error, otherwise returns false.
930 my( $self, %opt ) = @_;
933 local $SIG{HUP} = 'IGNORE';
934 local $SIG{INT} = 'IGNORE';
935 local $SIG{QUIT} = 'IGNORE';
936 local $SIG{TERM} = 'IGNORE';
937 local $SIG{TSTP} = 'IGNORE';
938 local $SIG{PIPE} = 'IGNORE';
940 my $oldAutoCommit = $FS::UID::AutoCommit;
941 local $FS::UID::AutoCommit = 0;
944 my $old = $self->select_for_update;
946 my $pkgnum = $old->pkgnum;
947 if ( $old->get('cancel') || $self->get('cancel') ) {
948 dbh->rollback if $oldAutoCommit;
949 return "Can't unsuspend cancelled package $pkgnum";
952 unless ( $old->get('susp') && $self->get('susp') ) {
953 dbh->rollback if $oldAutoCommit;
954 return ""; # no error # complain instead?
957 foreach my $cust_svc (
958 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
960 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
962 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
963 $dbh->rollback if $oldAutoCommit;
964 return "Illegal svcdb value in part_svc!";
967 require "FS/$svcdb.pm";
969 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
971 $error = $svc->unsuspend;
973 $dbh->rollback if $oldAutoCommit;
980 my %hash = $self->hash;
981 my $inactive = time - $hash{'susp'};
983 my $conf = new FS::Conf;
985 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
986 if ( $opt{'adjust_next_bill'}
987 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
988 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
991 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
992 my $new = new FS::cust_pkg ( \%hash );
993 $error = $new->replace( $self, options => { $self->options } );
995 $dbh->rollback if $oldAutoCommit;
999 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1006 Cancels any pending suspension (sets the adjourn field to null).
1008 If there is an error, returns the error, otherwise returns false.
1013 my( $self, %options ) = @_;
1016 local $SIG{HUP} = 'IGNORE';
1017 local $SIG{INT} = 'IGNORE';
1018 local $SIG{QUIT} = 'IGNORE';
1019 local $SIG{TERM} = 'IGNORE';
1020 local $SIG{TSTP} = 'IGNORE';
1021 local $SIG{PIPE} = 'IGNORE';
1023 my $oldAutoCommit = $FS::UID::AutoCommit;
1024 local $FS::UID::AutoCommit = 0;
1027 my $old = $self->select_for_update;
1029 my $pkgnum = $old->pkgnum;
1030 if ( $old->get('cancel') || $self->get('cancel') ) {
1031 dbh->rollback if $oldAutoCommit;
1032 return "Can't unadjourn cancelled package $pkgnum";
1033 # or at least it's pointless
1036 if ( $old->get('susp') || $self->get('susp') ) {
1037 dbh->rollback if $oldAutoCommit;
1038 return "Can't unadjourn suspended package $pkgnum";
1039 # perhaps this is arbitrary
1042 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1043 dbh->rollback if $oldAutoCommit;
1044 return ""; # no error
1047 my %hash = $self->hash;
1048 $hash{'adjourn'} = '';
1049 my $new = new FS::cust_pkg ( \%hash );
1050 $error = $new->replace( $self, options => { $self->options } );
1052 $dbh->rollback if $oldAutoCommit;
1056 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1063 =item change HASHREF | OPTION => VALUE ...
1065 Changes this package: cancels it and creates a new one, with a different
1066 pkgpart or locationnum or both. All services are transferred to the new
1067 package (no change will be made if this is not possible).
1069 Options may be passed as a list of key/value pairs or as a hash reference.
1076 New locationnum, to change the location for this package.
1080 New FS::cust_location object, to create a new location and assign it
1085 New pkgpart (see L<FS::part_pkg>).
1089 New refnum (see L<FS::part_referral>).
1093 At least one option must be specified (otherwise, what's the point?)
1095 Returns either the new FS::cust_pkg object or a scalar error.
1099 my $err_or_new_cust_pkg = $old_cust_pkg->change
1103 #some false laziness w/order
1106 my $opt = ref($_[0]) ? shift : { @_ };
1108 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1111 my $conf = new FS::Conf;
1113 # Transactionize this whole mess
1114 local $SIG{HUP} = 'IGNORE';
1115 local $SIG{INT} = 'IGNORE';
1116 local $SIG{QUIT} = 'IGNORE';
1117 local $SIG{TERM} = 'IGNORE';
1118 local $SIG{TSTP} = 'IGNORE';
1119 local $SIG{PIPE} = 'IGNORE';
1121 my $oldAutoCommit = $FS::UID::AutoCommit;
1122 local $FS::UID::AutoCommit = 0;
1131 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1133 #$hash{$_} = $self->$_() foreach qw( setup );
1135 $hash{'setup'} = $time if $self->setup;
1137 $hash{'change_date'} = $time;
1138 $hash{"change_$_"} = $self->$_()
1139 foreach qw( pkgnum pkgpart locationnum );
1141 if ( $opt->{'cust_location'} &&
1142 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1143 $error = $opt->{'cust_location'}->insert;
1145 $dbh->rollback if $oldAutoCommit;
1146 return "inserting cust_location (transaction rolled back): $error";
1148 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1151 # Create the new package.
1152 my $cust_pkg = new FS::cust_pkg {
1153 custnum => $self->custnum,
1154 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1155 refnum => ( $opt->{'refnum'} || $self->refnum ),
1156 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1160 $error = $cust_pkg->insert( 'change' => 1 );
1162 $dbh->rollback if $oldAutoCommit;
1166 # Transfer services and cancel old package.
1168 $error = $self->transfer($cust_pkg);
1169 if ($error and $error == 0) {
1170 # $old_pkg->transfer failed.
1171 $dbh->rollback if $oldAutoCommit;
1175 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1176 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1177 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1178 if ($error and $error == 0) {
1179 # $old_pkg->transfer failed.
1180 $dbh->rollback if $oldAutoCommit;
1186 # Transfers were successful, but we still had services left on the old
1187 # package. We can't change the package under this circumstances, so abort.
1188 $dbh->rollback if $oldAutoCommit;
1189 return "Unable to transfer all services from package ". $self->pkgnum;
1192 #reset usage if changing pkgpart
1193 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1194 if ($self->pkgpart != $cust_pkg->pkgpart) {
1195 my $part_pkg = $cust_pkg->part_pkg;
1196 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1200 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1203 $dbh->rollback if $oldAutoCommit;
1204 return "Error setting usage values: $error";
1208 #Good to go, cancel old package.
1209 $error = $self->cancel( quiet=>1 );
1211 $dbh->rollback if $oldAutoCommit;
1215 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1217 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1219 $dbh->rollback if $oldAutoCommit;
1224 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1232 Returns the last bill date, or if there is no last bill date, the setup date.
1233 Useful for billing metered services.
1239 return $self->setfield('last_bill', $_[0]) if @_;
1240 return $self->getfield('last_bill') if $self->getfield('last_bill');
1241 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1242 'edate' => $self->bill, } );
1243 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1246 =item last_cust_pkg_reason ACTION
1248 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1249 Returns false if there is no reason or the package is not currenly ACTION'd
1250 ACTION is one of adjourn, susp, cancel, or expire.
1254 sub last_cust_pkg_reason {
1255 my ( $self, $action ) = ( shift, shift );
1256 my $date = $self->get($action);
1258 'table' => 'cust_pkg_reason',
1259 'hashref' => { 'pkgnum' => $self->pkgnum,
1260 'action' => substr(uc($action), 0, 1),
1263 'order_by' => 'ORDER BY num DESC LIMIT 1',
1267 =item last_reason ACTION
1269 Returns the most recent ACTION FS::reason associated with the package.
1270 Returns false if there is no reason or the package is not currenly ACTION'd
1271 ACTION is one of adjourn, susp, cancel, or expire.
1276 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1277 $cust_pkg_reason->reason
1278 if $cust_pkg_reason;
1283 Returns the definition for this billing item, as an FS::part_pkg object (see
1290 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1291 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1292 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1297 Returns the cancelled package this package was changed from, if any.
1303 return '' unless $self->change_pkgnum;
1304 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1309 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1316 $self->part_pkg->calc_setup($self, @_);
1321 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1328 $self->part_pkg->calc_recur($self, @_);
1333 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1340 $self->part_pkg->calc_remain($self, @_);
1345 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1352 $self->part_pkg->calc_cancel($self, @_);
1357 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1363 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1366 =item cust_pkg_detail [ DETAILTYPE ]
1368 Returns any customer package details for this package (see
1369 L<FS::cust_pkg_detail>).
1371 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1375 sub cust_pkg_detail {
1377 my %hash = ( 'pkgnum' => $self->pkgnum );
1378 $hash{detailtype} = shift if @_;
1380 'table' => 'cust_pkg_detail',
1381 'hashref' => \%hash,
1382 'order_by' => 'ORDER BY weight, pkgdetailnum',
1386 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1388 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1390 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1392 If there is an error, returns the error, otherwise returns false.
1396 sub set_cust_pkg_detail {
1397 my( $self, $detailtype, @details ) = @_;
1399 local $SIG{HUP} = 'IGNORE';
1400 local $SIG{INT} = 'IGNORE';
1401 local $SIG{QUIT} = 'IGNORE';
1402 local $SIG{TERM} = 'IGNORE';
1403 local $SIG{TSTP} = 'IGNORE';
1404 local $SIG{PIPE} = 'IGNORE';
1406 my $oldAutoCommit = $FS::UID::AutoCommit;
1407 local $FS::UID::AutoCommit = 0;
1410 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1411 my $error = $current->delete;
1413 $dbh->rollback if $oldAutoCommit;
1414 return "error removing old detail: $error";
1418 foreach my $detail ( @details ) {
1419 my $cust_pkg_detail = new FS::cust_pkg_detail {
1420 'pkgnum' => $self->pkgnum,
1421 'detailtype' => $detailtype,
1422 'detail' => $detail,
1424 my $error = $cust_pkg_detail->insert;
1426 $dbh->rollback if $oldAutoCommit;
1427 return "error adding new detail: $error";
1432 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1439 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1443 #false laziness w/cust_bill.pm
1447 'table' => 'cust_event',
1448 'addl_from' => 'JOIN part_event USING ( eventpart )',
1449 'hashref' => { 'tablenum' => $self->pkgnum },
1450 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1454 =item num_cust_event
1456 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1460 #false laziness w/cust_bill.pm
1461 sub num_cust_event {
1464 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1465 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1466 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1467 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1468 $sth->fetchrow_arrayref->[0];
1471 =item cust_svc [ SVCPART ]
1473 Returns the services for this package, as FS::cust_svc objects (see
1474 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1482 return () unless $self->num_cust_svc(@_);
1485 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1486 'svcpart' => shift, } );
1489 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1491 #if ( $self->{'_svcnum'} ) {
1492 # values %{ $self->{'_svcnum'}->cache };
1494 $self->_sort_cust_svc(
1495 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1501 =item overlimit [ SVCPART ]
1503 Returns the services for this package which have exceeded their
1504 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1505 is specified, return only the matching services.
1511 return () unless $self->num_cust_svc(@_);
1512 grep { $_->overlimit } $self->cust_svc(@_);
1515 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1517 Returns historical services for this package created before END TIMESTAMP and
1518 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1519 (see L<FS::h_cust_svc>).
1526 $self->_sort_cust_svc(
1527 [ qsearch( 'h_cust_svc',
1528 { 'pkgnum' => $self->pkgnum, },
1529 FS::h_cust_svc->sql_h_search(@_),
1535 sub _sort_cust_svc {
1536 my( $self, $arrayref ) = @_;
1539 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1541 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1542 'svcpart' => $_->svcpart } );
1544 $pkg_svc ? $pkg_svc->primary_svc : '',
1545 $pkg_svc ? $pkg_svc->quantity : 0,
1552 =item num_cust_svc [ SVCPART ]
1554 Returns the number of provisioned services for this package. If a svcpart is
1555 specified, counts only the matching services.
1562 return $self->{'_num_cust_svc'}
1564 && exists($self->{'_num_cust_svc'})
1565 && $self->{'_num_cust_svc'} =~ /\d/;
1567 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1570 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1571 $sql .= ' AND svcpart = ?' if @_;
1573 my $sth = dbh->prepare($sql) or die dbh->errstr;
1574 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1575 $sth->fetchrow_arrayref->[0];
1578 =item available_part_svc
1580 Returns a list of FS::part_svc objects representing services included in this
1581 package but not yet provisioned. Each FS::part_svc object also has an extra
1582 field, I<num_avail>, which specifies the number of available services.
1586 sub available_part_svc {
1588 grep { $_->num_avail > 0 }
1590 my $part_svc = $_->part_svc;
1591 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1592 $_->quantity - $self->num_cust_svc($_->svcpart);
1595 $self->part_pkg->pkg_svc;
1600 Returns a list of FS::part_svc objects representing provisioned and available
1601 services included in this package. Each FS::part_svc object also has the
1602 following extra fields:
1606 =item num_cust_svc (count)
1608 =item num_avail (quantity - count)
1610 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1613 label -> ($cust_svc->label)[1]
1622 #XXX some sort of sort order besides numeric by svcpart...
1623 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1625 my $part_svc = $pkg_svc->part_svc;
1626 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1627 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1628 $part_svc->{'Hash'}{'num_avail'} =
1629 max( 0, $pkg_svc->quantity - $num_cust_svc );
1630 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1631 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1633 } $self->part_pkg->pkg_svc;
1636 push @part_svc, map {
1638 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1639 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1640 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1641 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1642 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1644 } $self->extra_part_svc;
1650 =item extra_part_svc
1652 Returns a list of FS::part_svc objects corresponding to services in this
1653 package which are still provisioned but not (any longer) available in the
1658 sub extra_part_svc {
1661 my $pkgnum = $self->pkgnum;
1662 my $pkgpart = $self->pkgpart;
1665 # 'table' => 'part_svc',
1668 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1669 # WHERE pkg_svc.svcpart = part_svc.svcpart
1670 # AND pkg_svc.pkgpart = ?
1673 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1674 # LEFT JOIN cust_pkg USING ( pkgnum )
1675 # WHERE cust_svc.svcpart = part_svc.svcpart
1678 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1681 #seems to benchmark slightly faster...
1683 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1684 'table' => 'part_svc',
1686 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1687 AND pkg_svc.pkgpart = ?
1690 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1691 LEFT JOIN cust_pkg USING ( pkgnum )
1694 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1695 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1701 Returns a short status string for this package, currently:
1705 =item not yet billed
1707 =item one-time charge
1722 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1724 return 'cancelled' if $self->get('cancel');
1725 return 'suspended' if $self->susp;
1726 return 'not yet billed' unless $self->setup;
1727 return 'one-time charge' if $freq =~ /^(0|$)/;
1733 Class method that returns the list of possible status strings for packages
1734 (see L<the status method|/status>). For example:
1736 @statuses = FS::cust_pkg->statuses();
1740 tie my %statuscolor, 'Tie::IxHash',
1741 'not yet billed' => '000000',
1742 'one-time charge' => '000000',
1743 'active' => '00CC00',
1744 'suspended' => 'FF9900',
1745 'cancelled' => 'FF0000',
1749 my $self = shift; #could be class...
1750 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1751 # # mayble split btw one-time vs. recur
1757 Returns a hex triplet color string for this package's status.
1763 $statuscolor{$self->status};
1768 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1769 "pkg-comment" depending on user preference).
1775 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1776 $label = $self->pkgnum. ": $label"
1777 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1781 =item pkg_label_long
1783 Returns a long label for this package, adding the primary service's label to
1788 sub pkg_label_long {
1790 my $label = $self->pkg_label;
1791 my $cust_svc = $self->primary_cust_svc;
1792 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1796 =item primary_cust_svc
1798 Returns a primary service (as FS::cust_svc object) if one can be identified.
1802 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1804 sub primary_cust_svc {
1807 my @cust_svc = $self->cust_svc;
1809 return '' unless @cust_svc; #no serivces - irrelevant then
1811 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1813 # primary service as specified in the package definition
1814 # or exactly one service definition with quantity one
1815 my $svcpart = $self->part_pkg->svcpart;
1816 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1817 return $cust_svc[0] if scalar(@cust_svc) == 1;
1819 #couldn't identify one thing..
1825 Returns a list of lists, calling the label method for all services
1826 (see L<FS::cust_svc>) of this billing item.
1832 map { [ $_->label ] } $self->cust_svc;
1835 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1837 Like the labels method, but returns historical information on services that
1838 were active as of END_TIMESTAMP and (optionally) not cancelled before
1841 Returns a list of lists, calling the label method for all (historical) services
1842 (see L<FS::h_cust_svc>) of this billing item.
1848 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1853 Like labels, except returns a simple flat list, and shortens long
1854 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1855 identical services to one line that lists the service label and the number of
1856 individual services rather than individual items.
1861 shift->_labels_short( 'labels', @_ );
1864 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1866 Like h_labels, except returns a simple flat list, and shortens long
1867 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1868 identical services to one line that lists the service label and the number of
1869 individual services rather than individual items.
1873 sub h_labels_short {
1874 shift->_labels_short( 'h_labels', @_ );
1878 my( $self, $method ) = ( shift, shift );
1880 my $conf = new FS::Conf;
1881 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1884 #tie %labels, 'Tie::IxHash';
1885 push @{ $labels{$_->[0]} }, $_->[1]
1886 foreach $self->h_labels(@_);
1888 foreach my $label ( keys %labels ) {
1890 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1891 my $num = scalar(@values);
1892 if ( $num > $max_same_services ) {
1893 push @labels, "$label ($num)";
1895 if ( $conf->exists('cust_bill-consolidate_services') ) {
1896 # push @labels, "$label: ". join(', ', @values);
1898 my $detail = "$label: ";
1899 $detail .= shift(@values). ', '
1900 while @values && length($detail.$values[0]) < 78;
1902 push @labels, $detail;
1905 push @labels, map { "$label: $_" } @values;
1916 Returns the parent customer object (see L<FS::cust_main>).
1922 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1927 Returns the location object, if any (see L<FS::cust_location>).
1933 return '' unless $self->locationnum;
1934 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1937 =item cust_location_or_main
1939 If this package is associated with a location, returns the locaiton (see
1940 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1944 sub cust_location_or_main {
1946 $self->cust_location || $self->cust_main;
1949 =item location_label [ OPTION => VALUE ... ]
1951 Returns the label of the location object (see L<FS::cust_location>).
1955 sub location_label {
1957 my $object = $self->cust_location_or_main;
1958 $object->location_label(@_);
1961 =item seconds_since TIMESTAMP
1963 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1964 package have been online since TIMESTAMP, according to the session monitor.
1966 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1967 L<Time::Local> and L<Date::Parse> for conversion functions.
1972 my($self, $since) = @_;
1975 foreach my $cust_svc (
1976 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1978 $seconds += $cust_svc->seconds_since($since);
1985 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1987 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1988 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1991 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1992 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1998 sub seconds_since_sqlradacct {
1999 my($self, $start, $end) = @_;
2003 foreach my $cust_svc (
2005 my $part_svc = $_->part_svc;
2006 $part_svc->svcdb eq 'svc_acct'
2007 && scalar($part_svc->part_export('sqlradius'));
2010 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2017 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2019 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2020 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2024 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2025 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2030 sub attribute_since_sqlradacct {
2031 my($self, $start, $end, $attrib) = @_;
2035 foreach my $cust_svc (
2037 my $part_svc = $_->part_svc;
2038 $part_svc->svcdb eq 'svc_acct'
2039 && scalar($part_svc->part_export('sqlradius'));
2042 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2054 my( $self, $value ) = @_;
2055 if ( defined($value) ) {
2056 $self->setfield('quantity', $value);
2058 $self->getfield('quantity') || 1;
2061 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2063 Transfers as many services as possible from this package to another package.
2065 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2066 object. The destination package must already exist.
2068 Services are moved only if the destination allows services with the correct
2069 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2070 this option with caution! No provision is made for export differences
2071 between the old and new service definitions. Probably only should be used
2072 when your exports for all service definitions of a given svcdb are identical.
2073 (attempt a transfer without it first, to move all possible svcpart-matching
2076 Any services that can't be moved remain in the original package.
2078 Returns an error, if there is one; otherwise, returns the number of services
2079 that couldn't be moved.
2084 my ($self, $dest_pkgnum, %opt) = @_;
2090 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2091 $dest = $dest_pkgnum;
2092 $dest_pkgnum = $dest->pkgnum;
2094 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2097 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2099 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2100 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2103 foreach my $cust_svc ($dest->cust_svc) {
2104 $target{$cust_svc->svcpart}--;
2107 my %svcpart2svcparts = ();
2108 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2109 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2110 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2111 next if exists $svcpart2svcparts{$svcpart};
2112 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2113 $svcpart2svcparts{$svcpart} = [
2115 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2117 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2118 'svcpart' => $_ } );
2120 $pkg_svc ? $pkg_svc->primary_svc : '',
2121 $pkg_svc ? $pkg_svc->quantity : 0,
2125 grep { $_ != $svcpart }
2127 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2129 warn "alternates for svcpart $svcpart: ".
2130 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2135 foreach my $cust_svc ($self->cust_svc) {
2136 if($target{$cust_svc->svcpart} > 0) {
2137 $target{$cust_svc->svcpart}--;
2138 my $new = new FS::cust_svc { $cust_svc->hash };
2139 $new->pkgnum($dest_pkgnum);
2140 my $error = $new->replace($cust_svc);
2141 return $error if $error;
2142 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2144 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2145 warn "alternates to consider: ".
2146 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2148 my @alternate = grep {
2149 warn "considering alternate svcpart $_: ".
2150 "$target{$_} available in new package\n"
2153 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2155 warn "alternate(s) found\n" if $DEBUG;
2156 my $change_svcpart = $alternate[0];
2157 $target{$change_svcpart}--;
2158 my $new = new FS::cust_svc { $cust_svc->hash };
2159 $new->svcpart($change_svcpart);
2160 $new->pkgnum($dest_pkgnum);
2161 my $error = $new->replace($cust_svc);
2162 return $error if $error;
2175 This method is deprecated. See the I<depend_jobnum> option to the insert and
2176 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2183 local $SIG{HUP} = 'IGNORE';
2184 local $SIG{INT} = 'IGNORE';
2185 local $SIG{QUIT} = 'IGNORE';
2186 local $SIG{TERM} = 'IGNORE';
2187 local $SIG{TSTP} = 'IGNORE';
2188 local $SIG{PIPE} = 'IGNORE';
2190 my $oldAutoCommit = $FS::UID::AutoCommit;
2191 local $FS::UID::AutoCommit = 0;
2194 foreach my $cust_svc ( $self->cust_svc ) {
2195 #false laziness w/svc_Common::insert
2196 my $svc_x = $cust_svc->svc_x;
2197 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2198 my $error = $part_export->export_insert($svc_x);
2200 $dbh->rollback if $oldAutoCommit;
2206 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2213 =head1 CLASS METHODS
2219 Returns an SQL expression identifying recurring packages.
2223 sub recurring_sql { "
2224 '0' != ( select freq from part_pkg
2225 where cust_pkg.pkgpart = part_pkg.pkgpart )
2230 Returns an SQL expression identifying one-time packages.
2235 '0' = ( select freq from part_pkg
2236 where cust_pkg.pkgpart = part_pkg.pkgpart )
2241 Returns an SQL expression identifying active packages.
2246 ". $_[0]->recurring_sql(). "
2247 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2248 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2249 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2252 =item not_yet_billed_sql
2254 Returns an SQL expression identifying packages which have not yet been billed.
2258 sub not_yet_billed_sql { "
2259 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2260 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2261 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2266 Returns an SQL expression identifying inactive packages (one-time packages
2267 that are otherwise unsuspended/uncancelled).
2271 sub inactive_sql { "
2272 ". $_[0]->onetime_sql(). "
2273 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2274 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2275 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2281 Returns an SQL expression identifying suspended packages.
2285 sub suspended_sql { susp_sql(@_); }
2287 #$_[0]->recurring_sql(). ' AND '.
2289 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2290 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2297 Returns an SQL exprression identifying cancelled packages.
2301 sub cancelled_sql { cancel_sql(@_); }
2303 #$_[0]->recurring_sql(). ' AND '.
2304 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2307 =item search HASHREF
2311 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2312 Valid parameters are
2320 active, inactive, suspended, cancel (or cancelled)
2324 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2328 boolean selects custom packages
2334 pkgpart or arrayref or hashref of pkgparts
2338 arrayref of beginning and ending epoch date
2342 arrayref of beginning and ending epoch date
2346 arrayref of beginning and ending epoch date
2350 arrayref of beginning and ending epoch date
2354 arrayref of beginning and ending epoch date
2358 arrayref of beginning and ending epoch date
2362 arrayref of beginning and ending epoch date
2366 pkgnum or APKG_pkgnum
2370 a value suited to passing to FS::UI::Web::cust_header
2374 specifies the user for agent virtualization
2381 my ($class, $params) = @_;
2388 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2390 "cust_main.agentnum = $1";
2397 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2399 "cust_pkg.custnum = $1";
2406 if ( $params->{'magic'} eq 'active'
2407 || $params->{'status'} eq 'active' ) {
2409 push @where, FS::cust_pkg->active_sql();
2411 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2412 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2414 push @where, FS::cust_pkg->not_yet_billed_sql();
2416 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2417 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2419 push @where, FS::cust_pkg->inactive_sql();
2421 } elsif ( $params->{'magic'} eq 'suspended'
2422 || $params->{'status'} eq 'suspended' ) {
2424 push @where, FS::cust_pkg->suspended_sql();
2426 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2427 || $params->{'status'} =~ /^cancell?ed$/ ) {
2429 push @where, FS::cust_pkg->cancelled_sql();
2434 # parse package class
2437 #false lazinessish w/graph/cust_bill_pkg.cgi
2440 if ( exists($params->{'classnum'})
2441 && $params->{'classnum'} =~ /^(\d*)$/
2445 if ( $classnum ) { #a specific class
2446 push @where, "part_pkg.classnum = $classnum";
2448 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2449 #die "classnum $classnum not found!" unless $pkg_class[0];
2450 #$title .= $pkg_class[0]->classname.' ';
2452 } elsif ( $classnum eq '' ) { #the empty class
2454 push @where, "part_pkg.classnum IS NULL";
2455 #$title .= 'Empty class ';
2456 #@pkg_class = ( '(empty class)' );
2457 } elsif ( $classnum eq '0' ) {
2458 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2459 #push @pkg_class, '(empty class)';
2461 die "illegal classnum";
2467 # parse package report options
2470 my @report_option = ();
2471 if ( exists($params->{'report_option'})
2472 && $params->{'report_option'} =~ /^([,\d]*)$/
2475 @report_option = split(',', $1);
2478 if (@report_option) {
2479 # this will result in the empty set for the dangling comma case as it should
2481 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2482 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2483 AND optionname = 'report_option_$_'
2484 AND optionvalue = '1' )"
2494 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2500 if ( exists($params->{'censustract'}) ) {
2501 $params->{'censustract'} =~ /^([.\d]*)$/;
2502 my $censustract = "cust_main.censustract = '$1'";
2503 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2504 push @where, "( $censustract )";
2511 if ( ref($params->{'pkgpart'}) ) {
2514 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2515 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2516 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2517 @pkgpart = @{ $params->{'pkgpart'} };
2519 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2522 @pkgpart = grep /^(\d+)$/, @pkgpart;
2524 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2526 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2527 push @where, "pkgpart = $1";
2536 #false laziness w/report_cust_pkg.html
2539 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2540 'active' => { 'susp'=>1, 'cancel'=>1 },
2541 'suspended' => { 'cancel' => 1 },
2546 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2548 next unless exists($params->{$field});
2550 my($beginning, $ending) = @{$params->{$field}};
2552 next if $beginning == 0 && $ending == 4294967295;
2555 "cust_pkg.$field IS NOT NULL",
2556 "cust_pkg.$field >= $beginning",
2557 "cust_pkg.$field <= $ending";
2559 $orderby ||= "ORDER BY cust_pkg.$field";
2563 $orderby ||= 'ORDER BY bill';
2566 # parse magic, legacy, etc.
2569 if ( $params->{'magic'} &&
2570 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2573 $orderby = 'ORDER BY pkgnum';
2575 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2576 push @where, "pkgpart = $1";
2579 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2581 $orderby = 'ORDER BY pkgnum';
2583 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2585 $orderby = 'ORDER BY pkgnum';
2588 SELECT count(*) FROM pkg_svc
2589 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2590 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2591 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2592 AND cust_svc.svcpart = pkg_svc.svcpart
2599 # setup queries, links, subs, etc. for the search
2602 # here is the agent virtualization
2603 if ($params->{CurrentUser}) {
2605 qsearchs('access_user', { username => $params->{CurrentUser} });
2608 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2613 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2616 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2618 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2619 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2620 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2622 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2625 'table' => 'cust_pkg',
2627 'select' => join(', ',
2629 ( map "part_pkg.$_", qw( pkg freq ) ),
2630 'pkg_class.classname',
2631 'cust_main.custnum as cust_main_custnum',
2632 FS::UI::Web::cust_sql_fields(
2633 $params->{'cust_fields'}
2636 'extra_sql' => "$extra_sql $orderby",
2637 'addl_from' => $addl_from,
2638 'count_query' => $count_query,
2645 Returns a list: the first item is an SQL fragment identifying matching
2646 packages/customers via location (taking into account shipping and package
2647 address taxation, if enabled), and subsequent items are the parameters to
2648 substitute for the placeholders in that fragment.
2653 my($class, %opt) = @_;
2654 my $ornull = $opt{'ornull'};
2656 my $conf = new FS::Conf;
2658 # '?' placeholders in _location_sql_where
2659 my $x = $ornull ? 3 : 2;
2660 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
2664 if ( $conf->exists('tax-ship_address') ) {
2667 ( ( ship_last IS NULL OR ship_last = '' )
2668 AND ". _location_sql_where('cust_main', '', $ornull ). "
2670 OR ( ship_last IS NOT NULL AND ship_last != ''
2671 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2674 # AND payby != 'COMP'
2676 @main_param = ( @bill_param, @bill_param );
2680 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2681 @main_param = @bill_param;
2687 if ( $conf->exists('tax-pkg_address') ) {
2689 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2692 ( cust_pkg.locationnum IS NULL AND $main_where )
2693 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2696 @param = ( @main_param, @bill_param );
2700 $where = $main_where;
2701 @param = @main_param;
2709 #subroutine, helper for location_sql
2710 sub _location_sql_where {
2712 my $prefix = @_ ? shift : '';
2713 my $ornull = @_ ? shift : '';
2715 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2717 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2719 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
2720 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2721 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2723 # ( $table.${prefix}city = ? $or_empty_city $ornull )
2725 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
2726 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
2727 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2728 AND $table.${prefix}country = ?
2736 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2738 CUSTNUM is a customer (see L<FS::cust_main>)
2740 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2741 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2744 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2745 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2746 new billing items. An error is returned if this is not possible (see
2747 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2750 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2751 newly-created cust_pkg objects.
2753 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2754 and inserted. Multiple FS::pkg_referral records can be created by
2755 setting I<refnum> to an array reference of refnums or a hash reference with
2756 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2757 record will be created corresponding to cust_main.refnum.
2762 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2764 my $conf = new FS::Conf;
2766 # Transactionize this whole mess
2767 local $SIG{HUP} = 'IGNORE';
2768 local $SIG{INT} = 'IGNORE';
2769 local $SIG{QUIT} = 'IGNORE';
2770 local $SIG{TERM} = 'IGNORE';
2771 local $SIG{TSTP} = 'IGNORE';
2772 local $SIG{PIPE} = 'IGNORE';
2774 my $oldAutoCommit = $FS::UID::AutoCommit;
2775 local $FS::UID::AutoCommit = 0;
2779 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2780 # return "Customer not found: $custnum" unless $cust_main;
2782 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
2785 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2788 my $change = scalar(@old_cust_pkg) != 0;
2791 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2793 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
2794 " to pkgpart ". $pkgparts->[0]. "\n"
2797 my $err_or_cust_pkg =
2798 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2799 'refnum' => $refnum,
2802 unless (ref($err_or_cust_pkg)) {
2803 $dbh->rollback if $oldAutoCommit;
2804 return $err_or_cust_pkg;
2807 push @$return_cust_pkg, $err_or_cust_pkg;
2808 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2813 # Create the new packages.
2814 foreach my $pkgpart (@$pkgparts) {
2816 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
2818 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2819 pkgpart => $pkgpart,
2823 $error = $cust_pkg->insert( 'change' => $change );
2825 $dbh->rollback if $oldAutoCommit;
2828 push @$return_cust_pkg, $cust_pkg;
2830 # $return_cust_pkg now contains refs to all of the newly
2833 # Transfer services and cancel old packages.
2834 foreach my $old_pkg (@old_cust_pkg) {
2836 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
2839 foreach my $new_pkg (@$return_cust_pkg) {
2840 $error = $old_pkg->transfer($new_pkg);
2841 if ($error and $error == 0) {
2842 # $old_pkg->transfer failed.
2843 $dbh->rollback if $oldAutoCommit;
2848 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2849 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2850 foreach my $new_pkg (@$return_cust_pkg) {
2851 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2852 if ($error and $error == 0) {
2853 # $old_pkg->transfer failed.
2854 $dbh->rollback if $oldAutoCommit;
2861 # Transfers were successful, but we went through all of the
2862 # new packages and still had services left on the old package.
2863 # We can't cancel the package under the circumstances, so abort.
2864 $dbh->rollback if $oldAutoCommit;
2865 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2867 $error = $old_pkg->cancel( quiet=>1 );
2873 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2877 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2879 A bulk change method to change packages for multiple customers.
2881 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2882 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2885 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2886 replace. The services (see L<FS::cust_svc>) are moved to the
2887 new billing items. An error is returned if this is not possible (see
2890 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2891 newly-created cust_pkg objects.
2896 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2898 # Transactionize this whole mess
2899 local $SIG{HUP} = 'IGNORE';
2900 local $SIG{INT} = 'IGNORE';
2901 local $SIG{QUIT} = 'IGNORE';
2902 local $SIG{TERM} = 'IGNORE';
2903 local $SIG{TSTP} = 'IGNORE';
2904 local $SIG{PIPE} = 'IGNORE';
2906 my $oldAutoCommit = $FS::UID::AutoCommit;
2907 local $FS::UID::AutoCommit = 0;
2911 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2914 while(scalar(@old_cust_pkg)) {
2916 my $custnum = $old_cust_pkg[0]->custnum;
2917 my (@remove) = map { $_->pkgnum }
2918 grep { $_->custnum == $custnum } @old_cust_pkg;
2919 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2921 my $error = order $custnum, $pkgparts, \@remove, \@return;
2923 push @errors, $error
2925 push @$return_cust_pkg, @return;
2928 if (scalar(@errors)) {
2929 $dbh->rollback if $oldAutoCommit;
2930 return join(' / ', @errors);
2933 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2939 Associates this package with a (suspension or cancellation) reason (see
2940 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2943 Available options are:
2949 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.
2953 the access_user (see L<FS::access_user>) providing the reason
2961 the action (cancel, susp, adjourn, expire) associated with the reason
2965 If there is an error, returns the error, otherwise returns false.
2970 my ($self, %options) = @_;
2972 my $otaker = $options{reason_otaker} ||
2973 $FS::CurrentUser::CurrentUser->username;
2976 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2980 } elsif ( ref($options{'reason'}) ) {
2982 return 'Enter a new reason (or select an existing one)'
2983 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2985 my $reason = new FS::reason({
2986 'reason_type' => $options{'reason'}->{'typenum'},
2987 'reason' => $options{'reason'}->{'reason'},
2989 my $error = $reason->insert;
2990 return $error if $error;
2992 $reasonnum = $reason->reasonnum;
2995 return "Unparsable reason: ". $options{'reason'};
2998 my $cust_pkg_reason =
2999 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
3000 'reasonnum' => $reasonnum,
3001 'otaker' => $otaker,
3002 'action' => substr(uc($options{'action'}),0,1),
3003 'date' => $options{'date'}
3008 $cust_pkg_reason->insert;
3011 =item set_usage USAGE_VALUE_HASHREF
3013 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3014 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3015 upbytes, downbytes, and totalbytes are appropriate keys.
3017 All svc_accts which are part of this package have their values reset.
3022 my ($self, $valueref, %opt) = @_;
3024 foreach my $cust_svc ($self->cust_svc){
3025 my $svc_x = $cust_svc->svc_x;
3026 $svc_x->set_usage($valueref, %opt)
3027 if $svc_x->can("set_usage");
3031 =item recharge USAGE_VALUE_HASHREF
3033 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3034 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3035 upbytes, downbytes, and totalbytes are appropriate keys.
3037 All svc_accts which are part of this package have their values incremented.
3042 my ($self, $valueref) = @_;
3044 foreach my $cust_svc ($self->cust_svc){
3045 my $svc_x = $cust_svc->svc_x;
3046 $svc_x->recharge($valueref)
3047 if $svc_x->can("recharge");
3055 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3057 In sub order, the @pkgparts array (passed by reference) is clobbered.
3059 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3060 method to pass dates to the recur_prog expression, it should do so.
3062 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3063 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3064 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3065 configuration values. Probably need a subroutine which decides what to do
3066 based on whether or not we've fetched the user yet, rather than a hash. See
3067 FS::UID and the TODO.
3069 Now that things are transactional should the check in the insert method be
3074 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3075 L<FS::pkg_svc>, schema.html from the base documentation