4 use base qw( FS::cust_main_Mixin FS::location_Mixin
5 FS::m2m_Common FS::option_Common FS::Record
7 use vars qw(@ISA $disable_agentcheck $DEBUG $me);
9 use Scalar::Util qw( blessed );
10 use List::Util qw(max);
12 use Time::Local qw( timelocal_nocheck );
14 use FS::UID qw( getotaker dbh );
15 use FS::Misc qw( send_email );
16 use FS::Record qw( qsearch qsearchs );
20 use FS::cust_location;
22 use FS::cust_bill_pkg;
23 use FS::cust_pkg_detail;
28 use FS::cust_pkg_reason;
32 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
34 # because they load configuration by setting FS::UID::callback (see TODO)
40 # for sending cancel emails in sub cancel
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 if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
254 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
255 $mon += 1 unless $mday == 1;
256 until ( $mon < 12 ) { $mon -= 12; $year++; }
257 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
260 my $expire_months = $self->part_pkg->option('expire_months', 1);
261 if ( $expire_months && !$self->expire ) {
262 my $start = $self->start_date || $self->setup || time;
264 #false laziness w/part_pkg::add_freq
265 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5];
266 $mon += $expire_months;
267 until ( $mon < 12 ) { $mon -= 12; $year++; }
269 #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) );
270 $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) );
273 local $SIG{HUP} = 'IGNORE';
274 local $SIG{INT} = 'IGNORE';
275 local $SIG{QUIT} = 'IGNORE';
276 local $SIG{TERM} = 'IGNORE';
277 local $SIG{TSTP} = 'IGNORE';
278 local $SIG{PIPE} = 'IGNORE';
280 my $oldAutoCommit = $FS::UID::AutoCommit;
281 local $FS::UID::AutoCommit = 0;
284 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
286 $dbh->rollback if $oldAutoCommit;
290 $self->refnum($self->cust_main->refnum) unless $self->refnum;
291 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
292 $self->process_m2m( 'link_table' => 'pkg_referral',
293 'target_table' => 'part_referral',
294 'params' => $self->refnum,
297 #if ( $self->reg_code ) {
298 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
299 # $error = $reg_code->delete;
301 # $dbh->rollback if $oldAutoCommit;
306 my $conf = new FS::Conf;
308 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
310 use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
317 my $q = new RT::Queue($RT::SystemUser);
318 $q->Load($options{ticket_queue}) if $options{ticket_queue};
319 my $t = new RT::Ticket($RT::SystemUser);
320 my $mime = new MIME::Entity;
321 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
322 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
323 Subject => $options{ticket_subject},
326 $t->AddLink( Type => 'MemberOf',
327 Target => 'freeside://freeside/cust_main/'. $self->custnum,
331 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
332 my $queue = new FS::queue {
333 'job' => 'FS::cust_main::queueable_print',
335 $error = $queue->insert(
336 'custnum' => $self->custnum,
337 'template' => 'welcome_letter',
341 warn "can't send welcome letter: $error";
346 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
353 This method now works but you probably shouldn't use it.
355 You don't want to delete billing items, because there would then be no record
356 the customer ever purchased the item. Instead, see the cancel method.
361 # return "Can't delete cust_pkg records!";
364 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
366 Replaces the OLD_RECORD with this one in the database. If there is an error,
367 returns the error, otherwise returns false.
369 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
371 Changing pkgpart may have disasterous effects. See the order subroutine.
373 setup and bill are normally updated by calling the bill method of a customer
374 object (see L<FS::cust_main>).
376 suspend is normally updated by the suspend and unsuspend methods.
378 cancel is normally updated by the cancel method (and also the order subroutine
381 Available options are:
387 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.
391 the access_user (see L<FS::access_user>) providing the reason
395 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
404 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
409 ( ref($_[0]) eq 'HASH' )
413 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
414 return "Can't change otaker!" if $old->otaker ne $new->otaker;
417 #return "Can't change setup once it exists!"
418 # if $old->getfield('setup') &&
419 # $old->getfield('setup') != $new->getfield('setup');
421 #some logic for bill, susp, cancel?
423 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
425 local $SIG{HUP} = 'IGNORE';
426 local $SIG{INT} = 'IGNORE';
427 local $SIG{QUIT} = 'IGNORE';
428 local $SIG{TERM} = 'IGNORE';
429 local $SIG{TSTP} = 'IGNORE';
430 local $SIG{PIPE} = 'IGNORE';
432 my $oldAutoCommit = $FS::UID::AutoCommit;
433 local $FS::UID::AutoCommit = 0;
436 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
437 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
438 my $error = $new->insert_reason(
439 'reason' => $options->{'reason'},
440 'date' => $new->$method,
442 'reason_otaker' => $options->{'reason_otaker'},
445 dbh->rollback if $oldAutoCommit;
446 return "Error inserting cust_pkg_reason: $error";
451 #save off and freeze RADIUS attributes for any associated svc_acct records
453 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
455 #also check for specific exports?
456 # to avoid spurious modify export events
457 @svc_acct = map { $_->svc_x }
458 grep { $_->part_svc->svcdb eq 'svc_acct' }
461 $_->snapshot foreach @svc_acct;
465 my $error = $new->SUPER::replace($old,
466 $options->{options} ? $options->{options} : ()
469 $dbh->rollback if $oldAutoCommit;
473 #for prepaid packages,
474 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
475 foreach my $old_svc_acct ( @svc_acct ) {
476 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
477 my $s_error = $new_svc_acct->replace($old_svc_acct);
479 $dbh->rollback if $oldAutoCommit;
484 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
491 Checks all fields to make sure this is a valid billing item. If there is an
492 error, returns the error, otherwise returns false. Called by the insert and
500 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
503 $self->ut_numbern('pkgnum')
504 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
505 || $self->ut_numbern('pkgpart')
506 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
507 || $self->ut_numbern('start_date')
508 || $self->ut_numbern('setup')
509 || $self->ut_numbern('bill')
510 || $self->ut_numbern('susp')
511 || $self->ut_numbern('cancel')
512 || $self->ut_numbern('adjourn')
513 || $self->ut_numbern('expire')
515 return $error if $error;
517 if ( $self->reg_code ) {
519 unless ( grep { $self->pkgpart == $_->pkgpart }
520 map { $_->reg_code_pkg }
521 qsearchs( 'reg_code', { 'code' => $self->reg_code,
522 'agentnum' => $self->cust_main->agentnum })
524 return "Unknown registration code";
527 } elsif ( $self->promo_code ) {
530 qsearchs('part_pkg', {
531 'pkgpart' => $self->pkgpart,
532 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
534 return 'Unknown promotional code' unless $promo_part_pkg;
538 unless ( $disable_agentcheck ) {
540 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
541 return "agent ". $agent->agentnum. ':'. $agent->agent.
542 " can't purchase pkgpart ". $self->pkgpart
543 unless $agent->pkgpart_hashref->{ $self->pkgpart }
544 || $agent->agentnum == $self->part_pkg->agentnum;
547 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
548 return $error if $error;
552 $self->otaker(getotaker) unless $self->otaker;
553 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
556 if ( $self->dbdef_table->column('manual_flag') ) {
557 $self->manual_flag('') if $self->manual_flag eq ' ';
558 $self->manual_flag =~ /^([01]?)$/
559 or return "Illegal manual_flag ". $self->manual_flag;
560 $self->manual_flag($1);
566 =item cancel [ OPTION => VALUE ... ]
568 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
569 in this package, then cancels the package itself (sets the cancel field to
572 Available options are:
576 =item quiet - can be set true to supress email cancellation notices.
578 =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.
580 =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.
582 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
584 =item nobill - can be set true to skip billing if it might otherwise be done.
588 If there is an error, returns the error, otherwise returns false.
593 my( $self, %options ) = @_;
596 my $conf = new FS::Conf;
598 warn "cust_pkg::cancel called with options".
599 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
602 local $SIG{HUP} = 'IGNORE';
603 local $SIG{INT} = 'IGNORE';
604 local $SIG{QUIT} = 'IGNORE';
605 local $SIG{TERM} = 'IGNORE';
606 local $SIG{TSTP} = 'IGNORE';
607 local $SIG{PIPE} = 'IGNORE';
609 my $oldAutoCommit = $FS::UID::AutoCommit;
610 local $FS::UID::AutoCommit = 0;
613 my $old = $self->select_for_update;
615 if ( $old->get('cancel') || $self->get('cancel') ) {
616 dbh->rollback if $oldAutoCommit;
617 return ""; # no error
620 my $date = $options{date} if $options{date}; # expire/cancel later
621 $date = '' if ($date && $date <= time); # complain instead?
623 #race condition: usage could be ongoing until unprovisioned
624 #resolved by performing a change package instead (which unprovisions) and
626 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
627 my $copy = $self->new({$self->hash});
629 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
630 warn "Error billing during cancel, custnum ".
631 #$self->cust_main->custnum. ": $error"
637 my $cancel_time = $options{'time'} || time;
639 if ( $options{'reason'} ) {
640 $error = $self->insert_reason( 'reason' => $options{'reason'},
641 'action' => $date ? 'expire' : 'cancel',
642 'date' => $date ? $date : $cancel_time,
643 'reason_otaker' => $options{'reason_otaker'},
646 dbh->rollback if $oldAutoCommit;
647 return "Error inserting cust_pkg_reason: $error";
653 foreach my $cust_svc (
656 sort { $a->[1] <=> $b->[1] }
657 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
658 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
661 my $error = $cust_svc->cancel;
664 $dbh->rollback if $oldAutoCommit;
665 return "Error cancelling cust_svc: $error";
669 # Add a credit for remaining service
670 my $remaining_value = $self->calc_remain(time=>$cancel_time);
671 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
672 my $error = $self->cust_main->credit(
674 'Credit for unused time on '. $self->part_pkg->pkg,
675 'reason_type' => $conf->config('cancel_credit_type'),
678 $dbh->rollback if $oldAutoCommit;
679 return "Error crediting customer \$$remaining_value for unused time on".
680 $self->part_pkg->pkg. ": $error";
685 my %hash = $self->hash;
686 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
687 my $new = new FS::cust_pkg ( \%hash );
688 $error = $new->replace( $self, options => { $self->options } );
690 $dbh->rollback if $oldAutoCommit;
694 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
695 return '' if $date; #no errors
697 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
698 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
699 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
702 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
703 $error = $msg_template->send( 'cust_main' => $self->cust_main,
708 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
709 'to' => \@invoicing_list,
710 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
711 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
714 #should this do something on errors?
721 =item cancel_if_expired [ NOW_TIMESTAMP ]
723 Cancels this package if its expire date has been reached.
727 sub cancel_if_expired {
729 my $time = shift || time;
730 return '' unless $self->expire && $self->expire <= $time;
731 my $error = $self->cancel;
733 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
734 $self->custnum. ": $error";
741 Cancels any pending expiration (sets the expire field to null).
743 If there is an error, returns the error, otherwise returns false.
748 my( $self, %options ) = @_;
751 local $SIG{HUP} = 'IGNORE';
752 local $SIG{INT} = 'IGNORE';
753 local $SIG{QUIT} = 'IGNORE';
754 local $SIG{TERM} = 'IGNORE';
755 local $SIG{TSTP} = 'IGNORE';
756 local $SIG{PIPE} = 'IGNORE';
758 my $oldAutoCommit = $FS::UID::AutoCommit;
759 local $FS::UID::AutoCommit = 0;
762 my $old = $self->select_for_update;
764 my $pkgnum = $old->pkgnum;
765 if ( $old->get('cancel') || $self->get('cancel') ) {
766 dbh->rollback if $oldAutoCommit;
767 return "Can't unexpire cancelled package $pkgnum";
768 # or at least it's pointless
771 unless ( $old->get('expire') && $self->get('expire') ) {
772 dbh->rollback if $oldAutoCommit;
773 return ""; # no error
776 my %hash = $self->hash;
777 $hash{'expire'} = '';
778 my $new = new FS::cust_pkg ( \%hash );
779 $error = $new->replace( $self, options => { $self->options } );
781 $dbh->rollback if $oldAutoCommit;
785 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
791 =item suspend [ OPTION => VALUE ... ]
793 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
794 package, then suspends the package itself (sets the susp field to now).
796 Available options are:
800 =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.
802 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
806 If there is an error, returns the error, otherwise returns false.
811 my( $self, %options ) = @_;
814 local $SIG{HUP} = 'IGNORE';
815 local $SIG{INT} = 'IGNORE';
816 local $SIG{QUIT} = 'IGNORE';
817 local $SIG{TERM} = 'IGNORE';
818 local $SIG{TSTP} = 'IGNORE';
819 local $SIG{PIPE} = 'IGNORE';
821 my $oldAutoCommit = $FS::UID::AutoCommit;
822 local $FS::UID::AutoCommit = 0;
825 my $old = $self->select_for_update;
827 my $pkgnum = $old->pkgnum;
828 if ( $old->get('cancel') || $self->get('cancel') ) {
829 dbh->rollback if $oldAutoCommit;
830 return "Can't suspend cancelled package $pkgnum";
833 if ( $old->get('susp') || $self->get('susp') ) {
834 dbh->rollback if $oldAutoCommit;
835 return ""; # no error # complain on adjourn?
838 my $date = $options{date} if $options{date}; # adjourn/suspend later
839 $date = '' if ($date && $date <= time); # complain instead?
841 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
842 dbh->rollback if $oldAutoCommit;
843 return "Package $pkgnum expires before it would be suspended.";
846 my $suspend_time = $options{'time'} || time;
848 if ( $options{'reason'} ) {
849 $error = $self->insert_reason( 'reason' => $options{'reason'},
850 'action' => $date ? 'adjourn' : 'suspend',
851 'date' => $date ? $date : $suspend_time,
852 'reason_otaker' => $options{'reason_otaker'},
855 dbh->rollback if $oldAutoCommit;
856 return "Error inserting cust_pkg_reason: $error";
864 foreach my $cust_svc (
865 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
867 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
869 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
870 $dbh->rollback if $oldAutoCommit;
871 return "Illegal svcdb value in part_svc!";
874 require "FS/$svcdb.pm";
876 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
878 $error = $svc->suspend;
880 $dbh->rollback if $oldAutoCommit;
883 my( $label, $value ) = $cust_svc->label;
884 push @labels, "$label: $value";
888 my $conf = new FS::Conf;
889 if ( $conf->config('suspend_email_admin') ) {
891 my $error = send_email(
892 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
893 #invoice_from ??? well as good as any
894 'to' => $conf->config('suspend_email_admin'),
895 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
897 "This is an automatic message from your Freeside installation\n",
898 "informing you that the following customer package has been suspended:\n",
900 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
901 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
902 ( map { "Service : $_\n" } @labels ),
907 warn "WARNING: can't send suspension admin email (suspending anyway): ".
915 my %hash = $self->hash;
917 $hash{'adjourn'} = $date;
919 $hash{'susp'} = $suspend_time;
921 my $new = new FS::cust_pkg ( \%hash );
922 $error = $new->replace( $self, options => { $self->options } );
924 $dbh->rollback if $oldAutoCommit;
928 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
933 =item unsuspend [ OPTION => VALUE ... ]
935 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
936 package, then unsuspends the package itself (clears the susp field and the
937 adjourn field if it is in the past).
939 Available options are:
943 =item adjust_next_bill
945 Can be set true to adjust the next bill date forward by
946 the amount of time the account was inactive. This was set true by default
947 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
948 explicitly requested. Price plans for which this makes sense (anniversary-date
949 based than prorate or subscription) could have an option to enable this
954 If there is an error, returns the error, otherwise returns false.
959 my( $self, %opt ) = @_;
962 local $SIG{HUP} = 'IGNORE';
963 local $SIG{INT} = 'IGNORE';
964 local $SIG{QUIT} = 'IGNORE';
965 local $SIG{TERM} = 'IGNORE';
966 local $SIG{TSTP} = 'IGNORE';
967 local $SIG{PIPE} = 'IGNORE';
969 my $oldAutoCommit = $FS::UID::AutoCommit;
970 local $FS::UID::AutoCommit = 0;
973 my $old = $self->select_for_update;
975 my $pkgnum = $old->pkgnum;
976 if ( $old->get('cancel') || $self->get('cancel') ) {
977 dbh->rollback if $oldAutoCommit;
978 return "Can't unsuspend cancelled package $pkgnum";
981 unless ( $old->get('susp') && $self->get('susp') ) {
982 dbh->rollback if $oldAutoCommit;
983 return ""; # no error # complain instead?
986 foreach my $cust_svc (
987 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
989 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
991 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
992 $dbh->rollback if $oldAutoCommit;
993 return "Illegal svcdb value in part_svc!";
996 require "FS/$svcdb.pm";
998 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1000 $error = $svc->unsuspend;
1002 $dbh->rollback if $oldAutoCommit;
1009 my %hash = $self->hash;
1010 my $inactive = time - $hash{'susp'};
1012 my $conf = new FS::Conf;
1014 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
1015 if ( $opt{'adjust_next_bill'}
1016 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
1017 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
1020 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1021 my $new = new FS::cust_pkg ( \%hash );
1022 $error = $new->replace( $self, options => { $self->options } );
1024 $dbh->rollback if $oldAutoCommit;
1028 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1035 Cancels any pending suspension (sets the adjourn field to null).
1037 If there is an error, returns the error, otherwise returns false.
1042 my( $self, %options ) = @_;
1045 local $SIG{HUP} = 'IGNORE';
1046 local $SIG{INT} = 'IGNORE';
1047 local $SIG{QUIT} = 'IGNORE';
1048 local $SIG{TERM} = 'IGNORE';
1049 local $SIG{TSTP} = 'IGNORE';
1050 local $SIG{PIPE} = 'IGNORE';
1052 my $oldAutoCommit = $FS::UID::AutoCommit;
1053 local $FS::UID::AutoCommit = 0;
1056 my $old = $self->select_for_update;
1058 my $pkgnum = $old->pkgnum;
1059 if ( $old->get('cancel') || $self->get('cancel') ) {
1060 dbh->rollback if $oldAutoCommit;
1061 return "Can't unadjourn cancelled package $pkgnum";
1062 # or at least it's pointless
1065 if ( $old->get('susp') || $self->get('susp') ) {
1066 dbh->rollback if $oldAutoCommit;
1067 return "Can't unadjourn suspended package $pkgnum";
1068 # perhaps this is arbitrary
1071 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1072 dbh->rollback if $oldAutoCommit;
1073 return ""; # no error
1076 my %hash = $self->hash;
1077 $hash{'adjourn'} = '';
1078 my $new = new FS::cust_pkg ( \%hash );
1079 $error = $new->replace( $self, options => { $self->options } );
1081 $dbh->rollback if $oldAutoCommit;
1085 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1092 =item change HASHREF | OPTION => VALUE ...
1094 Changes this package: cancels it and creates a new one, with a different
1095 pkgpart or locationnum or both. All services are transferred to the new
1096 package (no change will be made if this is not possible).
1098 Options may be passed as a list of key/value pairs or as a hash reference.
1105 New locationnum, to change the location for this package.
1109 New FS::cust_location object, to create a new location and assign it
1114 New pkgpart (see L<FS::part_pkg>).
1118 New refnum (see L<FS::part_referral>).
1122 At least one option must be specified (otherwise, what's the point?)
1124 Returns either the new FS::cust_pkg object or a scalar error.
1128 my $err_or_new_cust_pkg = $old_cust_pkg->change
1132 #some false laziness w/order
1135 my $opt = ref($_[0]) ? shift : { @_ };
1137 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1140 my $conf = new FS::Conf;
1142 # Transactionize this whole mess
1143 local $SIG{HUP} = 'IGNORE';
1144 local $SIG{INT} = 'IGNORE';
1145 local $SIG{QUIT} = 'IGNORE';
1146 local $SIG{TERM} = 'IGNORE';
1147 local $SIG{TSTP} = 'IGNORE';
1148 local $SIG{PIPE} = 'IGNORE';
1150 my $oldAutoCommit = $FS::UID::AutoCommit;
1151 local $FS::UID::AutoCommit = 0;
1160 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1162 #$hash{$_} = $self->$_() foreach qw( setup );
1164 $hash{'setup'} = $time if $self->setup;
1166 $hash{'change_date'} = $time;
1167 $hash{"change_$_"} = $self->$_()
1168 foreach qw( pkgnum pkgpart locationnum );
1170 if ( $opt->{'cust_location'} &&
1171 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1172 $error = $opt->{'cust_location'}->insert;
1174 $dbh->rollback if $oldAutoCommit;
1175 return "inserting cust_location (transaction rolled back): $error";
1177 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1180 # Create the new package.
1181 my $cust_pkg = new FS::cust_pkg {
1182 custnum => $self->custnum,
1183 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1184 refnum => ( $opt->{'refnum'} || $self->refnum ),
1185 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1189 $error = $cust_pkg->insert( 'change' => 1 );
1191 $dbh->rollback if $oldAutoCommit;
1195 # Transfer services and cancel old package.
1197 $error = $self->transfer($cust_pkg);
1198 if ($error and $error == 0) {
1199 # $old_pkg->transfer failed.
1200 $dbh->rollback if $oldAutoCommit;
1204 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1205 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1206 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1207 if ($error and $error == 0) {
1208 # $old_pkg->transfer failed.
1209 $dbh->rollback if $oldAutoCommit;
1215 # Transfers were successful, but we still had services left on the old
1216 # package. We can't change the package under this circumstances, so abort.
1217 $dbh->rollback if $oldAutoCommit;
1218 return "Unable to transfer all services from package ". $self->pkgnum;
1221 #reset usage if changing pkgpart
1222 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1223 if ($self->pkgpart != $cust_pkg->pkgpart) {
1224 my $part_pkg = $cust_pkg->part_pkg;
1225 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1229 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1232 $dbh->rollback if $oldAutoCommit;
1233 return "Error setting usage values: $error";
1237 #Good to go, cancel old package.
1238 $error = $self->cancel( quiet=>1 );
1240 $dbh->rollback if $oldAutoCommit;
1244 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1246 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1248 $dbh->rollback if $oldAutoCommit;
1253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1261 Returns the last bill date, or if there is no last bill date, the setup date.
1262 Useful for billing metered services.
1268 return $self->setfield('last_bill', $_[0]) if @_;
1269 return $self->getfield('last_bill') if $self->getfield('last_bill');
1270 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1271 'edate' => $self->bill, } );
1272 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1275 =item last_cust_pkg_reason ACTION
1277 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1278 Returns false if there is no reason or the package is not currenly ACTION'd
1279 ACTION is one of adjourn, susp, cancel, or expire.
1283 sub last_cust_pkg_reason {
1284 my ( $self, $action ) = ( shift, shift );
1285 my $date = $self->get($action);
1287 'table' => 'cust_pkg_reason',
1288 'hashref' => { 'pkgnum' => $self->pkgnum,
1289 'action' => substr(uc($action), 0, 1),
1292 'order_by' => 'ORDER BY num DESC LIMIT 1',
1296 =item last_reason ACTION
1298 Returns the most recent ACTION FS::reason associated with the package.
1299 Returns false if there is no reason or the package is not currenly ACTION'd
1300 ACTION is one of adjourn, susp, cancel, or expire.
1305 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1306 $cust_pkg_reason->reason
1307 if $cust_pkg_reason;
1312 Returns the definition for this billing item, as an FS::part_pkg object (see
1319 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1320 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1321 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1326 Returns the cancelled package this package was changed from, if any.
1332 return '' unless $self->change_pkgnum;
1333 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1338 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1345 $self->part_pkg->calc_setup($self, @_);
1350 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1357 $self->part_pkg->calc_recur($self, @_);
1362 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1369 $self->part_pkg->calc_remain($self, @_);
1374 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1381 $self->part_pkg->calc_cancel($self, @_);
1386 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1392 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1395 =item cust_pkg_detail [ DETAILTYPE ]
1397 Returns any customer package details for this package (see
1398 L<FS::cust_pkg_detail>).
1400 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1404 sub cust_pkg_detail {
1406 my %hash = ( 'pkgnum' => $self->pkgnum );
1407 $hash{detailtype} = shift if @_;
1409 'table' => 'cust_pkg_detail',
1410 'hashref' => \%hash,
1411 'order_by' => 'ORDER BY weight, pkgdetailnum',
1415 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1417 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1419 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1421 If there is an error, returns the error, otherwise returns false.
1425 sub set_cust_pkg_detail {
1426 my( $self, $detailtype, @details ) = @_;
1428 local $SIG{HUP} = 'IGNORE';
1429 local $SIG{INT} = 'IGNORE';
1430 local $SIG{QUIT} = 'IGNORE';
1431 local $SIG{TERM} = 'IGNORE';
1432 local $SIG{TSTP} = 'IGNORE';
1433 local $SIG{PIPE} = 'IGNORE';
1435 my $oldAutoCommit = $FS::UID::AutoCommit;
1436 local $FS::UID::AutoCommit = 0;
1439 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1440 my $error = $current->delete;
1442 $dbh->rollback if $oldAutoCommit;
1443 return "error removing old detail: $error";
1447 foreach my $detail ( @details ) {
1448 my $cust_pkg_detail = new FS::cust_pkg_detail {
1449 'pkgnum' => $self->pkgnum,
1450 'detailtype' => $detailtype,
1451 'detail' => $detail,
1453 my $error = $cust_pkg_detail->insert;
1455 $dbh->rollback if $oldAutoCommit;
1456 return "error adding new detail: $error";
1461 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1468 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1472 #false laziness w/cust_bill.pm
1476 'table' => 'cust_event',
1477 'addl_from' => 'JOIN part_event USING ( eventpart )',
1478 'hashref' => { 'tablenum' => $self->pkgnum },
1479 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1483 =item num_cust_event
1485 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1489 #false laziness w/cust_bill.pm
1490 sub num_cust_event {
1493 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1494 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1495 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1496 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1497 $sth->fetchrow_arrayref->[0];
1500 =item cust_svc [ SVCPART ]
1502 Returns the services for this package, as FS::cust_svc objects (see
1503 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1511 return () unless $self->num_cust_svc(@_);
1514 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1515 'svcpart' => shift, } );
1518 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1520 #if ( $self->{'_svcnum'} ) {
1521 # values %{ $self->{'_svcnum'}->cache };
1523 $self->_sort_cust_svc(
1524 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1530 =item overlimit [ SVCPART ]
1532 Returns the services for this package which have exceeded their
1533 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1534 is specified, return only the matching services.
1540 return () unless $self->num_cust_svc(@_);
1541 grep { $_->overlimit } $self->cust_svc(@_);
1544 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1546 Returns historical services for this package created before END TIMESTAMP and
1547 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1548 (see L<FS::h_cust_svc>).
1555 $self->_sort_cust_svc(
1556 [ qsearch( 'h_cust_svc',
1557 { 'pkgnum' => $self->pkgnum, },
1558 FS::h_cust_svc->sql_h_search(@_),
1564 sub _sort_cust_svc {
1565 my( $self, $arrayref ) = @_;
1568 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1573 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1574 'svcpart' => $_->svcpart } );
1576 $pkg_svc ? $pkg_svc->primary_svc : '',
1577 $pkg_svc ? $pkg_svc->quantity : 0,
1584 =item num_cust_svc [ SVCPART ]
1586 Returns the number of provisioned services for this package. If a svcpart is
1587 specified, counts only the matching services.
1594 return $self->{'_num_cust_svc'}
1596 && exists($self->{'_num_cust_svc'})
1597 && $self->{'_num_cust_svc'} =~ /\d/;
1599 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1602 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1603 $sql .= ' AND svcpart = ?' if @_;
1605 my $sth = dbh->prepare($sql) or die dbh->errstr;
1606 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1607 $sth->fetchrow_arrayref->[0];
1610 =item available_part_svc
1612 Returns a list of FS::part_svc objects representing services included in this
1613 package but not yet provisioned. Each FS::part_svc object also has an extra
1614 field, I<num_avail>, which specifies the number of available services.
1618 sub available_part_svc {
1620 grep { $_->num_avail > 0 }
1622 my $part_svc = $_->part_svc;
1623 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1624 $_->quantity - $self->num_cust_svc($_->svcpart);
1627 $self->part_pkg->pkg_svc;
1632 Returns a list of FS::part_svc objects representing provisioned and available
1633 services included in this package. Each FS::part_svc object also has the
1634 following extra fields:
1638 =item num_cust_svc (count)
1640 =item num_avail (quantity - count)
1642 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1645 label -> ($cust_svc->label)[1]
1654 #XXX some sort of sort order besides numeric by svcpart...
1655 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1657 my $part_svc = $pkg_svc->part_svc;
1658 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1659 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1660 $part_svc->{'Hash'}{'num_avail'} =
1661 max( 0, $pkg_svc->quantity - $num_cust_svc );
1662 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1663 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1665 } $self->part_pkg->pkg_svc;
1668 push @part_svc, map {
1670 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1671 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1672 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1673 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1674 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1676 } $self->extra_part_svc;
1682 =item extra_part_svc
1684 Returns a list of FS::part_svc objects corresponding to services in this
1685 package which are still provisioned but not (any longer) available in the
1690 sub extra_part_svc {
1693 my $pkgnum = $self->pkgnum;
1694 my $pkgpart = $self->pkgpart;
1697 # 'table' => 'part_svc',
1700 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1701 # WHERE pkg_svc.svcpart = part_svc.svcpart
1702 # AND pkg_svc.pkgpart = ?
1705 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1706 # LEFT JOIN cust_pkg USING ( pkgnum )
1707 # WHERE cust_svc.svcpart = part_svc.svcpart
1710 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1713 #seems to benchmark slightly faster...
1715 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1716 #MySQL doesn't grok DISINCT ON
1717 'select' => 'DISTINCT part_svc.*',
1718 'table' => 'part_svc',
1720 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1721 AND pkg_svc.pkgpart = ?
1724 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1725 LEFT JOIN cust_pkg USING ( pkgnum )
1728 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1729 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1735 Returns a short status string for this package, currently:
1739 =item not yet billed
1741 =item one-time charge
1756 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1758 return 'cancelled' if $self->get('cancel');
1759 return 'suspended' if $self->susp;
1760 return 'not yet billed' unless $self->setup;
1761 return 'one-time charge' if $freq =~ /^(0|$)/;
1767 Class method that returns the list of possible status strings for packages
1768 (see L<the status method|/status>). For example:
1770 @statuses = FS::cust_pkg->statuses();
1774 tie my %statuscolor, 'Tie::IxHash',
1775 'not yet billed' => '000000',
1776 'one-time charge' => '000000',
1777 'active' => '00CC00',
1778 'suspended' => 'FF9900',
1779 'cancelled' => 'FF0000',
1783 my $self = shift; #could be class...
1784 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1785 # # mayble split btw one-time vs. recur
1791 Returns a hex triplet color string for this package's status.
1797 $statuscolor{$self->status};
1802 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1803 "pkg-comment" depending on user preference).
1809 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1810 $label = $self->pkgnum. ": $label"
1811 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1815 =item pkg_label_long
1817 Returns a long label for this package, adding the primary service's label to
1822 sub pkg_label_long {
1824 my $label = $self->pkg_label;
1825 my $cust_svc = $self->primary_cust_svc;
1826 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1830 =item primary_cust_svc
1832 Returns a primary service (as FS::cust_svc object) if one can be identified.
1836 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1838 sub primary_cust_svc {
1841 my @cust_svc = $self->cust_svc;
1843 return '' unless @cust_svc; #no serivces - irrelevant then
1845 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1847 # primary service as specified in the package definition
1848 # or exactly one service definition with quantity one
1849 my $svcpart = $self->part_pkg->svcpart;
1850 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1851 return $cust_svc[0] if scalar(@cust_svc) == 1;
1853 #couldn't identify one thing..
1859 Returns a list of lists, calling the label method for all services
1860 (see L<FS::cust_svc>) of this billing item.
1866 map { [ $_->label ] } $self->cust_svc;
1869 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1871 Like the labels method, but returns historical information on services that
1872 were active as of END_TIMESTAMP and (optionally) not cancelled before
1875 Returns a list of lists, calling the label method for all (historical) services
1876 (see L<FS::h_cust_svc>) of this billing item.
1882 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1887 Like labels, except returns a simple flat list, and shortens long
1888 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1889 identical services to one line that lists the service label and the number of
1890 individual services rather than individual items.
1895 shift->_labels_short( 'labels', @_ );
1898 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1900 Like h_labels, except returns a simple flat list, and shortens long
1901 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1902 identical services to one line that lists the service label and the number of
1903 individual services rather than individual items.
1907 sub h_labels_short {
1908 shift->_labels_short( 'h_labels', @_ );
1912 my( $self, $method ) = ( shift, shift );
1914 my $conf = new FS::Conf;
1915 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1918 #tie %labels, 'Tie::IxHash';
1919 push @{ $labels{$_->[0]} }, $_->[1]
1920 foreach $self->$method(@_);
1922 foreach my $label ( keys %labels ) {
1924 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1925 my $num = scalar(@values);
1926 if ( $num > $max_same_services ) {
1927 push @labels, "$label ($num)";
1929 if ( $conf->exists('cust_bill-consolidate_services') ) {
1930 # push @labels, "$label: ". join(', ', @values);
1932 my $detail = "$label: ";
1933 $detail .= shift(@values). ', '
1934 while @values && length($detail.$values[0]) < 78;
1936 push @labels, $detail;
1939 push @labels, map { "$label: $_" } @values;
1950 Returns the parent customer object (see L<FS::cust_main>).
1956 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1959 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
1963 Returns the location object, if any (see L<FS::cust_location>).
1965 =item cust_location_or_main
1967 If this package is associated with a location, returns the locaiton (see
1968 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1970 =item location_label [ OPTION => VALUE ... ]
1972 Returns the label of the location object (see L<FS::cust_location>).
1976 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
1978 =item seconds_since TIMESTAMP
1980 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1981 package have been online since TIMESTAMP, according to the session monitor.
1983 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1984 L<Time::Local> and L<Date::Parse> for conversion functions.
1989 my($self, $since) = @_;
1992 foreach my $cust_svc (
1993 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1995 $seconds += $cust_svc->seconds_since($since);
2002 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2004 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2005 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2008 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2009 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2015 sub seconds_since_sqlradacct {
2016 my($self, $start, $end) = @_;
2020 foreach my $cust_svc (
2022 my $part_svc = $_->part_svc;
2023 $part_svc->svcdb eq 'svc_acct'
2024 && scalar($part_svc->part_export('sqlradius'));
2027 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2034 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2036 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2037 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2041 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2042 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2047 sub attribute_since_sqlradacct {
2048 my($self, $start, $end, $attrib) = @_;
2052 foreach my $cust_svc (
2054 my $part_svc = $_->part_svc;
2055 $part_svc->svcdb eq 'svc_acct'
2056 && scalar($part_svc->part_export('sqlradius'));
2059 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2071 my( $self, $value ) = @_;
2072 if ( defined($value) ) {
2073 $self->setfield('quantity', $value);
2075 $self->getfield('quantity') || 1;
2078 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2080 Transfers as many services as possible from this package to another package.
2082 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2083 object. The destination package must already exist.
2085 Services are moved only if the destination allows services with the correct
2086 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2087 this option with caution! No provision is made for export differences
2088 between the old and new service definitions. Probably only should be used
2089 when your exports for all service definitions of a given svcdb are identical.
2090 (attempt a transfer without it first, to move all possible svcpart-matching
2093 Any services that can't be moved remain in the original package.
2095 Returns an error, if there is one; otherwise, returns the number of services
2096 that couldn't be moved.
2101 my ($self, $dest_pkgnum, %opt) = @_;
2107 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2108 $dest = $dest_pkgnum;
2109 $dest_pkgnum = $dest->pkgnum;
2111 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2114 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2116 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2117 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2120 foreach my $cust_svc ($dest->cust_svc) {
2121 $target{$cust_svc->svcpart}--;
2124 my %svcpart2svcparts = ();
2125 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2126 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2127 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2128 next if exists $svcpart2svcparts{$svcpart};
2129 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2130 $svcpart2svcparts{$svcpart} = [
2132 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2134 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2135 'svcpart' => $_ } );
2137 $pkg_svc ? $pkg_svc->primary_svc : '',
2138 $pkg_svc ? $pkg_svc->quantity : 0,
2142 grep { $_ != $svcpart }
2144 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2146 warn "alternates for svcpart $svcpart: ".
2147 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2152 foreach my $cust_svc ($self->cust_svc) {
2153 if($target{$cust_svc->svcpart} > 0) {
2154 $target{$cust_svc->svcpart}--;
2155 my $new = new FS::cust_svc { $cust_svc->hash };
2156 $new->pkgnum($dest_pkgnum);
2157 my $error = $new->replace($cust_svc);
2158 return $error if $error;
2159 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2161 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2162 warn "alternates to consider: ".
2163 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2165 my @alternate = grep {
2166 warn "considering alternate svcpart $_: ".
2167 "$target{$_} available in new package\n"
2170 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2172 warn "alternate(s) found\n" if $DEBUG;
2173 my $change_svcpart = $alternate[0];
2174 $target{$change_svcpart}--;
2175 my $new = new FS::cust_svc { $cust_svc->hash };
2176 $new->svcpart($change_svcpart);
2177 $new->pkgnum($dest_pkgnum);
2178 my $error = $new->replace($cust_svc);
2179 return $error if $error;
2192 This method is deprecated. See the I<depend_jobnum> option to the insert and
2193 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2200 local $SIG{HUP} = 'IGNORE';
2201 local $SIG{INT} = 'IGNORE';
2202 local $SIG{QUIT} = 'IGNORE';
2203 local $SIG{TERM} = 'IGNORE';
2204 local $SIG{TSTP} = 'IGNORE';
2205 local $SIG{PIPE} = 'IGNORE';
2207 my $oldAutoCommit = $FS::UID::AutoCommit;
2208 local $FS::UID::AutoCommit = 0;
2211 foreach my $cust_svc ( $self->cust_svc ) {
2212 #false laziness w/svc_Common::insert
2213 my $svc_x = $cust_svc->svc_x;
2214 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2215 my $error = $part_export->export_insert($svc_x);
2217 $dbh->rollback if $oldAutoCommit;
2223 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2230 =head1 CLASS METHODS
2236 Returns an SQL expression identifying recurring packages.
2240 sub recurring_sql { "
2241 '0' != ( select freq from part_pkg
2242 where cust_pkg.pkgpart = part_pkg.pkgpart )
2247 Returns an SQL expression identifying one-time packages.
2252 '0' = ( select freq from part_pkg
2253 where cust_pkg.pkgpart = part_pkg.pkgpart )
2258 Returns an SQL expression identifying active packages.
2263 ". $_[0]->recurring_sql(). "
2264 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2265 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2266 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2269 =item not_yet_billed_sql
2271 Returns an SQL expression identifying packages which have not yet been billed.
2275 sub not_yet_billed_sql { "
2276 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2277 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2278 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2283 Returns an SQL expression identifying inactive packages (one-time packages
2284 that are otherwise unsuspended/uncancelled).
2288 sub inactive_sql { "
2289 ". $_[0]->onetime_sql(). "
2290 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2291 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2292 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2298 Returns an SQL expression identifying suspended packages.
2302 sub suspended_sql { susp_sql(@_); }
2304 #$_[0]->recurring_sql(). ' AND '.
2306 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2307 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2314 Returns an SQL exprression identifying cancelled packages.
2318 sub cancelled_sql { cancel_sql(@_); }
2320 #$_[0]->recurring_sql(). ' AND '.
2321 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2324 =item search HASHREF
2328 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2329 Valid parameters are
2337 active, inactive, suspended, cancel (or cancelled)
2341 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2345 boolean selects custom packages
2351 pkgpart or arrayref or hashref of pkgparts
2355 arrayref of beginning and ending epoch date
2359 arrayref of beginning and ending epoch date
2363 arrayref of beginning and ending epoch date
2367 arrayref of beginning and ending epoch date
2371 arrayref of beginning and ending epoch date
2375 arrayref of beginning and ending epoch date
2379 arrayref of beginning and ending epoch date
2383 pkgnum or APKG_pkgnum
2387 a value suited to passing to FS::UI::Web::cust_header
2391 specifies the user for agent virtualization
2395 boolean selects packages containing fcc form 477 telco lines
2402 my ($class, $params) = @_;
2409 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2411 "cust_main.agentnum = $1";
2418 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2420 "cust_pkg.custnum = $1";
2427 if ( $params->{'magic'} eq 'active'
2428 || $params->{'status'} eq 'active' ) {
2430 push @where, FS::cust_pkg->active_sql();
2432 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2433 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2435 push @where, FS::cust_pkg->not_yet_billed_sql();
2437 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2438 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2440 push @where, FS::cust_pkg->inactive_sql();
2442 } elsif ( $params->{'magic'} eq 'suspended'
2443 || $params->{'status'} eq 'suspended' ) {
2445 push @where, FS::cust_pkg->suspended_sql();
2447 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2448 || $params->{'status'} =~ /^cancell?ed$/ ) {
2450 push @where, FS::cust_pkg->cancelled_sql();
2455 # parse package class
2458 #false lazinessish w/graph/cust_bill_pkg.cgi
2461 if ( exists($params->{'classnum'})
2462 && $params->{'classnum'} =~ /^(\d*)$/
2466 if ( $classnum ) { #a specific class
2467 push @where, "part_pkg.classnum = $classnum";
2469 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2470 #die "classnum $classnum not found!" unless $pkg_class[0];
2471 #$title .= $pkg_class[0]->classname.' ';
2473 } elsif ( $classnum eq '' ) { #the empty class
2475 push @where, "part_pkg.classnum IS NULL";
2476 #$title .= 'Empty class ';
2477 #@pkg_class = ( '(empty class)' );
2478 } elsif ( $classnum eq '0' ) {
2479 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2480 #push @pkg_class, '(empty class)';
2482 die "illegal classnum";
2488 # parse package report options
2491 my @report_option = ();
2492 if ( exists($params->{'report_option'})
2493 && $params->{'report_option'} =~ /^([,\d]*)$/
2496 @report_option = split(',', $1);
2499 if (@report_option) {
2500 # this will result in the empty set for the dangling comma case as it should
2502 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2503 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2504 AND optionname = 'report_option_$_'
2505 AND optionvalue = '1' )"
2515 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2521 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2527 if ( exists($params->{'censustract'}) ) {
2528 $params->{'censustract'} =~ /^([.\d]*)$/;
2529 my $censustract = "cust_main.censustract = '$1'";
2530 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2531 push @where, "( $censustract )";
2538 if ( ref($params->{'pkgpart'}) ) {
2541 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2542 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2543 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2544 @pkgpart = @{ $params->{'pkgpart'} };
2546 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2549 @pkgpart = grep /^(\d+)$/, @pkgpart;
2551 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2553 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2554 push @where, "pkgpart = $1";
2563 #false laziness w/report_cust_pkg.html
2566 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2567 'active' => { 'susp'=>1, 'cancel'=>1 },
2568 'suspended' => { 'cancel' => 1 },
2573 if( exists($params->{'active'} ) ) {
2574 # This overrides all the other date-related fields
2575 my($beginning, $ending) = @{$params->{'active'}};
2577 "cust_pkg.setup IS NOT NULL",
2578 "cust_pkg.setup <= $ending",
2579 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2580 "NOT (".FS::cust_pkg->onetime_sql . ")";
2583 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2585 next unless exists($params->{$field});
2587 my($beginning, $ending) = @{$params->{$field}};
2589 next if $beginning == 0 && $ending == 4294967295;
2592 "cust_pkg.$field IS NOT NULL",
2593 "cust_pkg.$field >= $beginning",
2594 "cust_pkg.$field <= $ending";
2596 $orderby ||= "ORDER BY cust_pkg.$field";
2601 $orderby ||= 'ORDER BY bill';
2604 # parse magic, legacy, etc.
2607 if ( $params->{'magic'} &&
2608 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2611 $orderby = 'ORDER BY pkgnum';
2613 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2614 push @where, "pkgpart = $1";
2617 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2619 $orderby = 'ORDER BY pkgnum';
2621 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2623 $orderby = 'ORDER BY pkgnum';
2626 SELECT count(*) FROM pkg_svc
2627 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2628 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2629 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2630 AND cust_svc.svcpart = pkg_svc.svcpart
2637 # setup queries, links, subs, etc. for the search
2640 # here is the agent virtualization
2641 if ($params->{CurrentUser}) {
2643 qsearchs('access_user', { username => $params->{CurrentUser} });
2646 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2651 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2654 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2656 my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2657 'LEFT JOIN pkg_class USING ( classnum ) '.
2658 'LEFT JOIN cust_main USING ( custnum ) ';
2660 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2663 'table' => 'cust_pkg',
2665 'select' => join(', ',
2667 ( map "part_pkg.$_", qw( pkg freq ) ),
2668 'pkg_class.classname',
2669 'cust_main.custnum as cust_main_custnum',
2670 FS::UI::Web::cust_sql_fields(
2671 $params->{'cust_fields'}
2674 'extra_sql' => "$extra_sql $orderby",
2675 'addl_from' => $addl_from,
2676 'count_query' => $count_query,
2683 Returns a list of two package counts. The first is a count of packages
2684 based on the supplied criteria and the second is the count of residential
2685 packages with those same criteria. Criteria are specified as in the search
2691 my ($class, $params) = @_;
2693 my $sql_query = $class->search( $params );
2695 my $count_sql = delete($sql_query->{'count_query'});
2696 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
2697 or die "couldn't parse count_sql";
2699 my $count_sth = dbh->prepare($count_sql)
2700 or die "Error preparing $count_sql: ". dbh->errstr;
2702 or die "Error executing $count_sql: ". $count_sth->errstr;
2703 my $count_arrayref = $count_sth->fetchrow_arrayref;
2705 return ( @$count_arrayref );
2712 Returns a list: the first item is an SQL fragment identifying matching
2713 packages/customers via location (taking into account shipping and package
2714 address taxation, if enabled), and subsequent items are the parameters to
2715 substitute for the placeholders in that fragment.
2720 my($class, %opt) = @_;
2721 my $ornull = $opt{'ornull'};
2723 my $conf = new FS::Conf;
2725 # '?' placeholders in _location_sql_where
2728 @bill_param = qw( county county state state state country );
2730 @bill_param = qw( county state state country );
2732 unshift @bill_param, 'county'; # unless $nec;
2736 if ( $conf->exists('tax-ship_address') ) {
2739 ( ( ship_last IS NULL OR ship_last = '' )
2740 AND ". _location_sql_where('cust_main', '', $ornull ). "
2742 OR ( ship_last IS NOT NULL AND ship_last != ''
2743 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2746 # AND payby != 'COMP'
2748 @main_param = ( @bill_param, @bill_param );
2752 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2753 @main_param = @bill_param;
2759 if ( $conf->exists('tax-pkg_address') ) {
2761 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2764 ( cust_pkg.locationnum IS NULL AND $main_where )
2765 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2768 @param = ( @main_param, @bill_param );
2772 $where = $main_where;
2773 @param = @main_param;
2781 #subroutine, helper for location_sql
2782 sub _location_sql_where {
2784 my $prefix = @_ ? shift : '';
2785 my $ornull = @_ ? shift : '';
2787 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2789 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2791 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2792 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2795 ( $table.${prefix}county = ? $or_empty_county $ornull )
2796 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2797 AND $table.${prefix}country = ?
2805 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2807 CUSTNUM is a customer (see L<FS::cust_main>)
2809 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2810 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2813 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2814 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2815 new billing items. An error is returned if this is not possible (see
2816 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2819 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2820 newly-created cust_pkg objects.
2822 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2823 and inserted. Multiple FS::pkg_referral records can be created by
2824 setting I<refnum> to an array reference of refnums or a hash reference with
2825 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2826 record will be created corresponding to cust_main.refnum.
2831 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2833 my $conf = new FS::Conf;
2835 # Transactionize this whole mess
2836 local $SIG{HUP} = 'IGNORE';
2837 local $SIG{INT} = 'IGNORE';
2838 local $SIG{QUIT} = 'IGNORE';
2839 local $SIG{TERM} = 'IGNORE';
2840 local $SIG{TSTP} = 'IGNORE';
2841 local $SIG{PIPE} = 'IGNORE';
2843 my $oldAutoCommit = $FS::UID::AutoCommit;
2844 local $FS::UID::AutoCommit = 0;
2848 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2849 # return "Customer not found: $custnum" unless $cust_main;
2851 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
2854 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2857 my $change = scalar(@old_cust_pkg) != 0;
2860 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2862 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
2863 " to pkgpart ". $pkgparts->[0]. "\n"
2866 my $err_or_cust_pkg =
2867 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2868 'refnum' => $refnum,
2871 unless (ref($err_or_cust_pkg)) {
2872 $dbh->rollback if $oldAutoCommit;
2873 return $err_or_cust_pkg;
2876 push @$return_cust_pkg, $err_or_cust_pkg;
2877 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2882 # Create the new packages.
2883 foreach my $pkgpart (@$pkgparts) {
2885 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
2887 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2888 pkgpart => $pkgpart,
2892 $error = $cust_pkg->insert( 'change' => $change );
2894 $dbh->rollback if $oldAutoCommit;
2897 push @$return_cust_pkg, $cust_pkg;
2899 # $return_cust_pkg now contains refs to all of the newly
2902 # Transfer services and cancel old packages.
2903 foreach my $old_pkg (@old_cust_pkg) {
2905 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
2908 foreach my $new_pkg (@$return_cust_pkg) {
2909 $error = $old_pkg->transfer($new_pkg);
2910 if ($error and $error == 0) {
2911 # $old_pkg->transfer failed.
2912 $dbh->rollback if $oldAutoCommit;
2917 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2918 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2919 foreach my $new_pkg (@$return_cust_pkg) {
2920 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2921 if ($error and $error == 0) {
2922 # $old_pkg->transfer failed.
2923 $dbh->rollback if $oldAutoCommit;
2930 # Transfers were successful, but we went through all of the
2931 # new packages and still had services left on the old package.
2932 # We can't cancel the package under the circumstances, so abort.
2933 $dbh->rollback if $oldAutoCommit;
2934 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2936 $error = $old_pkg->cancel( quiet=>1 );
2942 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2946 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2948 A bulk change method to change packages for multiple customers.
2950 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2951 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2954 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2955 replace. The services (see L<FS::cust_svc>) are moved to the
2956 new billing items. An error is returned if this is not possible (see
2959 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2960 newly-created cust_pkg objects.
2965 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2967 # Transactionize this whole mess
2968 local $SIG{HUP} = 'IGNORE';
2969 local $SIG{INT} = 'IGNORE';
2970 local $SIG{QUIT} = 'IGNORE';
2971 local $SIG{TERM} = 'IGNORE';
2972 local $SIG{TSTP} = 'IGNORE';
2973 local $SIG{PIPE} = 'IGNORE';
2975 my $oldAutoCommit = $FS::UID::AutoCommit;
2976 local $FS::UID::AutoCommit = 0;
2980 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2983 while(scalar(@old_cust_pkg)) {
2985 my $custnum = $old_cust_pkg[0]->custnum;
2986 my (@remove) = map { $_->pkgnum }
2987 grep { $_->custnum == $custnum } @old_cust_pkg;
2988 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2990 my $error = order $custnum, $pkgparts, \@remove, \@return;
2992 push @errors, $error
2994 push @$return_cust_pkg, @return;
2997 if (scalar(@errors)) {
2998 $dbh->rollback if $oldAutoCommit;
2999 return join(' / ', @errors);
3002 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3008 Associates this package with a (suspension or cancellation) reason (see
3009 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
3012 Available options are:
3018 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.
3022 the access_user (see L<FS::access_user>) providing the reason
3030 the action (cancel, susp, adjourn, expire) associated with the reason
3034 If there is an error, returns the error, otherwise returns false.
3039 my ($self, %options) = @_;
3041 my $otaker = $options{reason_otaker} ||
3042 $FS::CurrentUser::CurrentUser->username;
3045 if ( $options{'reason'} =~ /^(\d+)$/ ) {
3049 } elsif ( ref($options{'reason'}) ) {
3051 return 'Enter a new reason (or select an existing one)'
3052 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
3054 my $reason = new FS::reason({
3055 'reason_type' => $options{'reason'}->{'typenum'},
3056 'reason' => $options{'reason'}->{'reason'},
3058 my $error = $reason->insert;
3059 return $error if $error;
3061 $reasonnum = $reason->reasonnum;
3064 return "Unparsable reason: ". $options{'reason'};
3067 my $cust_pkg_reason =
3068 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
3069 'reasonnum' => $reasonnum,
3070 'otaker' => $otaker,
3071 'action' => substr(uc($options{'action'}),0,1),
3072 'date' => $options{'date'}
3077 $cust_pkg_reason->insert;
3080 =item set_usage USAGE_VALUE_HASHREF
3082 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3083 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3084 upbytes, downbytes, and totalbytes are appropriate keys.
3086 All svc_accts which are part of this package have their values reset.
3091 my ($self, $valueref, %opt) = @_;
3093 foreach my $cust_svc ($self->cust_svc){
3094 my $svc_x = $cust_svc->svc_x;
3095 $svc_x->set_usage($valueref, %opt)
3096 if $svc_x->can("set_usage");
3100 =item recharge USAGE_VALUE_HASHREF
3102 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3103 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3104 upbytes, downbytes, and totalbytes are appropriate keys.
3106 All svc_accts which are part of this package have their values incremented.
3111 my ($self, $valueref) = @_;
3113 foreach my $cust_svc ($self->cust_svc){
3114 my $svc_x = $cust_svc->svc_x;
3115 $svc_x->recharge($valueref)
3116 if $svc_x->can("recharge");
3124 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3126 In sub order, the @pkgparts array (passed by reference) is clobbered.
3128 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3129 method to pass dates to the recur_prog expression, it should do so.
3131 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3132 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3133 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3134 configuration values. Probably need a subroutine which decides what to do
3135 based on whether or not we've fetched the user yet, rather than a hash. See
3136 FS::UID and the TODO.
3138 Now that things are transactional should the check in the insert method be
3143 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3144 L<FS::pkg_svc>, schema.html from the base documentation