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 if ( $inactive > 0 &&
1015 ( $hash{'bill'} || $hash{'setup'} ) &&
1016 ( $opt{'adjust_next_bill'} ||
1017 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1018 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1021 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1026 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1027 my $new = new FS::cust_pkg ( \%hash );
1028 $error = $new->replace( $self, options => { $self->options } );
1030 $dbh->rollback if $oldAutoCommit;
1034 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1041 Cancels any pending suspension (sets the adjourn field to null).
1043 If there is an error, returns the error, otherwise returns false.
1048 my( $self, %options ) = @_;
1051 local $SIG{HUP} = 'IGNORE';
1052 local $SIG{INT} = 'IGNORE';
1053 local $SIG{QUIT} = 'IGNORE';
1054 local $SIG{TERM} = 'IGNORE';
1055 local $SIG{TSTP} = 'IGNORE';
1056 local $SIG{PIPE} = 'IGNORE';
1058 my $oldAutoCommit = $FS::UID::AutoCommit;
1059 local $FS::UID::AutoCommit = 0;
1062 my $old = $self->select_for_update;
1064 my $pkgnum = $old->pkgnum;
1065 if ( $old->get('cancel') || $self->get('cancel') ) {
1066 dbh->rollback if $oldAutoCommit;
1067 return "Can't unadjourn cancelled package $pkgnum";
1068 # or at least it's pointless
1071 if ( $old->get('susp') || $self->get('susp') ) {
1072 dbh->rollback if $oldAutoCommit;
1073 return "Can't unadjourn suspended package $pkgnum";
1074 # perhaps this is arbitrary
1077 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1078 dbh->rollback if $oldAutoCommit;
1079 return ""; # no error
1082 my %hash = $self->hash;
1083 $hash{'adjourn'} = '';
1084 my $new = new FS::cust_pkg ( \%hash );
1085 $error = $new->replace( $self, options => { $self->options } );
1087 $dbh->rollback if $oldAutoCommit;
1091 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1098 =item change HASHREF | OPTION => VALUE ...
1100 Changes this package: cancels it and creates a new one, with a different
1101 pkgpart or locationnum or both. All services are transferred to the new
1102 package (no change will be made if this is not possible).
1104 Options may be passed as a list of key/value pairs or as a hash reference.
1111 New locationnum, to change the location for this package.
1115 New FS::cust_location object, to create a new location and assign it
1120 New pkgpart (see L<FS::part_pkg>).
1124 New refnum (see L<FS::part_referral>).
1128 At least one option must be specified (otherwise, what's the point?)
1130 Returns either the new FS::cust_pkg object or a scalar error.
1134 my $err_or_new_cust_pkg = $old_cust_pkg->change
1138 #some false laziness w/order
1141 my $opt = ref($_[0]) ? shift : { @_ };
1143 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1146 my $conf = new FS::Conf;
1148 # Transactionize this whole mess
1149 local $SIG{HUP} = 'IGNORE';
1150 local $SIG{INT} = 'IGNORE';
1151 local $SIG{QUIT} = 'IGNORE';
1152 local $SIG{TERM} = 'IGNORE';
1153 local $SIG{TSTP} = 'IGNORE';
1154 local $SIG{PIPE} = 'IGNORE';
1156 my $oldAutoCommit = $FS::UID::AutoCommit;
1157 local $FS::UID::AutoCommit = 0;
1166 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1168 #$hash{$_} = $self->$_() foreach qw( setup );
1170 $hash{'setup'} = $time if $self->setup;
1172 $hash{'change_date'} = $time;
1173 $hash{"change_$_"} = $self->$_()
1174 foreach qw( pkgnum pkgpart locationnum );
1176 if ( $opt->{'cust_location'} &&
1177 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1178 $error = $opt->{'cust_location'}->insert;
1180 $dbh->rollback if $oldAutoCommit;
1181 return "inserting cust_location (transaction rolled back): $error";
1183 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1186 # Create the new package.
1187 my $cust_pkg = new FS::cust_pkg {
1188 custnum => $self->custnum,
1189 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1190 refnum => ( $opt->{'refnum'} || $self->refnum ),
1191 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1195 $error = $cust_pkg->insert( 'change' => 1 );
1197 $dbh->rollback if $oldAutoCommit;
1201 # Transfer services and cancel old package.
1203 $error = $self->transfer($cust_pkg);
1204 if ($error and $error == 0) {
1205 # $old_pkg->transfer failed.
1206 $dbh->rollback if $oldAutoCommit;
1210 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1211 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1212 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1213 if ($error and $error == 0) {
1214 # $old_pkg->transfer failed.
1215 $dbh->rollback if $oldAutoCommit;
1221 # Transfers were successful, but we still had services left on the old
1222 # package. We can't change the package under this circumstances, so abort.
1223 $dbh->rollback if $oldAutoCommit;
1224 return "Unable to transfer all services from package ". $self->pkgnum;
1227 #reset usage if changing pkgpart
1228 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1229 if ($self->pkgpart != $cust_pkg->pkgpart) {
1230 my $part_pkg = $cust_pkg->part_pkg;
1231 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1235 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1238 $dbh->rollback if $oldAutoCommit;
1239 return "Error setting usage values: $error";
1243 #Good to go, cancel old package.
1244 $error = $self->cancel( quiet=>1 );
1246 $dbh->rollback if $oldAutoCommit;
1250 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1252 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1254 $dbh->rollback if $oldAutoCommit;
1259 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1267 Returns the last bill date, or if there is no last bill date, the setup date.
1268 Useful for billing metered services.
1274 return $self->setfield('last_bill', $_[0]) if @_;
1275 return $self->getfield('last_bill') if $self->getfield('last_bill');
1276 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1277 'edate' => $self->bill, } );
1278 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1281 =item last_cust_pkg_reason ACTION
1283 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1284 Returns false if there is no reason or the package is not currenly ACTION'd
1285 ACTION is one of adjourn, susp, cancel, or expire.
1289 sub last_cust_pkg_reason {
1290 my ( $self, $action ) = ( shift, shift );
1291 my $date = $self->get($action);
1293 'table' => 'cust_pkg_reason',
1294 'hashref' => { 'pkgnum' => $self->pkgnum,
1295 'action' => substr(uc($action), 0, 1),
1298 'order_by' => 'ORDER BY num DESC LIMIT 1',
1302 =item last_reason ACTION
1304 Returns the most recent ACTION FS::reason associated with the package.
1305 Returns false if there is no reason or the package is not currenly ACTION'd
1306 ACTION is one of adjourn, susp, cancel, or expire.
1311 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1312 $cust_pkg_reason->reason
1313 if $cust_pkg_reason;
1318 Returns the definition for this billing item, as an FS::part_pkg object (see
1325 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1326 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1327 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1332 Returns the cancelled package this package was changed from, if any.
1338 return '' unless $self->change_pkgnum;
1339 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1344 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1351 $self->part_pkg->calc_setup($self, @_);
1356 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1363 $self->part_pkg->calc_recur($self, @_);
1368 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1375 $self->part_pkg->calc_remain($self, @_);
1380 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1387 $self->part_pkg->calc_cancel($self, @_);
1392 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1398 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1401 =item cust_pkg_detail [ DETAILTYPE ]
1403 Returns any customer package details for this package (see
1404 L<FS::cust_pkg_detail>).
1406 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1410 sub cust_pkg_detail {
1412 my %hash = ( 'pkgnum' => $self->pkgnum );
1413 $hash{detailtype} = shift if @_;
1415 'table' => 'cust_pkg_detail',
1416 'hashref' => \%hash,
1417 'order_by' => 'ORDER BY weight, pkgdetailnum',
1421 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1423 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1425 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1427 If there is an error, returns the error, otherwise returns false.
1431 sub set_cust_pkg_detail {
1432 my( $self, $detailtype, @details ) = @_;
1434 local $SIG{HUP} = 'IGNORE';
1435 local $SIG{INT} = 'IGNORE';
1436 local $SIG{QUIT} = 'IGNORE';
1437 local $SIG{TERM} = 'IGNORE';
1438 local $SIG{TSTP} = 'IGNORE';
1439 local $SIG{PIPE} = 'IGNORE';
1441 my $oldAutoCommit = $FS::UID::AutoCommit;
1442 local $FS::UID::AutoCommit = 0;
1445 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1446 my $error = $current->delete;
1448 $dbh->rollback if $oldAutoCommit;
1449 return "error removing old detail: $error";
1453 foreach my $detail ( @details ) {
1454 my $cust_pkg_detail = new FS::cust_pkg_detail {
1455 'pkgnum' => $self->pkgnum,
1456 'detailtype' => $detailtype,
1457 'detail' => $detail,
1459 my $error = $cust_pkg_detail->insert;
1461 $dbh->rollback if $oldAutoCommit;
1462 return "error adding new detail: $error";
1467 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1474 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1478 #false laziness w/cust_bill.pm
1482 'table' => 'cust_event',
1483 'addl_from' => 'JOIN part_event USING ( eventpart )',
1484 'hashref' => { 'tablenum' => $self->pkgnum },
1485 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1489 =item num_cust_event
1491 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1495 #false laziness w/cust_bill.pm
1496 sub num_cust_event {
1499 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1500 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1501 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1502 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1503 $sth->fetchrow_arrayref->[0];
1506 =item cust_svc [ SVCPART ]
1508 Returns the services for this package, as FS::cust_svc objects (see
1509 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1517 return () unless $self->num_cust_svc(@_);
1520 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1521 'svcpart' => shift, } );
1524 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1526 #if ( $self->{'_svcnum'} ) {
1527 # values %{ $self->{'_svcnum'}->cache };
1529 $self->_sort_cust_svc(
1530 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1536 =item overlimit [ SVCPART ]
1538 Returns the services for this package which have exceeded their
1539 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1540 is specified, return only the matching services.
1546 return () unless $self->num_cust_svc(@_);
1547 grep { $_->overlimit } $self->cust_svc(@_);
1550 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1552 Returns historical services for this package created before END TIMESTAMP and
1553 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1554 (see L<FS::h_cust_svc>).
1561 $self->_sort_cust_svc(
1562 [ qsearch( 'h_cust_svc',
1563 { 'pkgnum' => $self->pkgnum, },
1564 FS::h_cust_svc->sql_h_search(@_),
1570 sub _sort_cust_svc {
1571 my( $self, $arrayref ) = @_;
1574 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1579 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1580 'svcpart' => $_->svcpart } );
1582 $pkg_svc ? $pkg_svc->primary_svc : '',
1583 $pkg_svc ? $pkg_svc->quantity : 0,
1590 =item num_cust_svc [ SVCPART ]
1592 Returns the number of provisioned services for this package. If a svcpart is
1593 specified, counts only the matching services.
1600 return $self->{'_num_cust_svc'}
1602 && exists($self->{'_num_cust_svc'})
1603 && $self->{'_num_cust_svc'} =~ /\d/;
1605 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1608 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1609 $sql .= ' AND svcpart = ?' if @_;
1611 my $sth = dbh->prepare($sql) or die dbh->errstr;
1612 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1613 $sth->fetchrow_arrayref->[0];
1616 =item available_part_svc
1618 Returns a list of FS::part_svc objects representing services included in this
1619 package but not yet provisioned. Each FS::part_svc object also has an extra
1620 field, I<num_avail>, which specifies the number of available services.
1624 sub available_part_svc {
1626 grep { $_->num_avail > 0 }
1628 my $part_svc = $_->part_svc;
1629 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1630 $_->quantity - $self->num_cust_svc($_->svcpart);
1633 $self->part_pkg->pkg_svc;
1638 Returns a list of FS::part_svc objects representing provisioned and available
1639 services included in this package. Each FS::part_svc object also has the
1640 following extra fields:
1644 =item num_cust_svc (count)
1646 =item num_avail (quantity - count)
1648 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1651 label -> ($cust_svc->label)[1]
1660 #XXX some sort of sort order besides numeric by svcpart...
1661 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1663 my $part_svc = $pkg_svc->part_svc;
1664 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1665 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1666 $part_svc->{'Hash'}{'num_avail'} =
1667 max( 0, $pkg_svc->quantity - $num_cust_svc );
1668 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1669 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1671 } $self->part_pkg->pkg_svc;
1674 push @part_svc, map {
1676 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1677 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1678 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1679 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1680 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1682 } $self->extra_part_svc;
1688 =item extra_part_svc
1690 Returns a list of FS::part_svc objects corresponding to services in this
1691 package which are still provisioned but not (any longer) available in the
1696 sub extra_part_svc {
1699 my $pkgnum = $self->pkgnum;
1700 my $pkgpart = $self->pkgpart;
1703 # 'table' => 'part_svc',
1706 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1707 # WHERE pkg_svc.svcpart = part_svc.svcpart
1708 # AND pkg_svc.pkgpart = ?
1711 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1712 # LEFT JOIN cust_pkg USING ( pkgnum )
1713 # WHERE cust_svc.svcpart = part_svc.svcpart
1716 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1719 #seems to benchmark slightly faster...
1721 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1722 #MySQL doesn't grok DISINCT ON
1723 'select' => 'DISTINCT part_svc.*',
1724 'table' => 'part_svc',
1726 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1727 AND pkg_svc.pkgpart = ?
1730 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1731 LEFT JOIN cust_pkg USING ( pkgnum )
1734 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1735 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1741 Returns a short status string for this package, currently:
1745 =item not yet billed
1747 =item one-time charge
1762 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1764 return 'cancelled' if $self->get('cancel');
1765 return 'suspended' if $self->susp;
1766 return 'not yet billed' unless $self->setup;
1767 return 'one-time charge' if $freq =~ /^(0|$)/;
1773 Class method that returns the list of possible status strings for packages
1774 (see L<the status method|/status>). For example:
1776 @statuses = FS::cust_pkg->statuses();
1780 tie my %statuscolor, 'Tie::IxHash',
1781 'not yet billed' => '000000',
1782 'one-time charge' => '000000',
1783 'active' => '00CC00',
1784 'suspended' => 'FF9900',
1785 'cancelled' => 'FF0000',
1789 my $self = shift; #could be class...
1790 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1791 # # mayble split btw one-time vs. recur
1797 Returns a hex triplet color string for this package's status.
1803 $statuscolor{$self->status};
1808 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1809 "pkg-comment" depending on user preference).
1815 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1816 $label = $self->pkgnum. ": $label"
1817 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1821 =item pkg_label_long
1823 Returns a long label for this package, adding the primary service's label to
1828 sub pkg_label_long {
1830 my $label = $self->pkg_label;
1831 my $cust_svc = $self->primary_cust_svc;
1832 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1836 =item primary_cust_svc
1838 Returns a primary service (as FS::cust_svc object) if one can be identified.
1842 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1844 sub primary_cust_svc {
1847 my @cust_svc = $self->cust_svc;
1849 return '' unless @cust_svc; #no serivces - irrelevant then
1851 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1853 # primary service as specified in the package definition
1854 # or exactly one service definition with quantity one
1855 my $svcpart = $self->part_pkg->svcpart;
1856 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1857 return $cust_svc[0] if scalar(@cust_svc) == 1;
1859 #couldn't identify one thing..
1865 Returns a list of lists, calling the label method for all services
1866 (see L<FS::cust_svc>) of this billing item.
1872 map { [ $_->label ] } $self->cust_svc;
1875 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1877 Like the labels method, but returns historical information on services that
1878 were active as of END_TIMESTAMP and (optionally) not cancelled before
1881 Returns a list of lists, calling the label method for all (historical) services
1882 (see L<FS::h_cust_svc>) of this billing item.
1888 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1893 Like labels, except returns a simple flat list, and shortens long
1894 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1895 identical services to one line that lists the service label and the number of
1896 individual services rather than individual items.
1901 shift->_labels_short( 'labels', @_ );
1904 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1906 Like h_labels, except returns a simple flat list, and shortens long
1907 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1908 identical services to one line that lists the service label and the number of
1909 individual services rather than individual items.
1913 sub h_labels_short {
1914 shift->_labels_short( 'h_labels', @_ );
1918 my( $self, $method ) = ( shift, shift );
1920 my $conf = new FS::Conf;
1921 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1924 #tie %labels, 'Tie::IxHash';
1925 push @{ $labels{$_->[0]} }, $_->[1]
1926 foreach $self->$method(@_);
1928 foreach my $label ( keys %labels ) {
1930 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1931 my $num = scalar(@values);
1932 if ( $num > $max_same_services ) {
1933 push @labels, "$label ($num)";
1935 if ( $conf->exists('cust_bill-consolidate_services') ) {
1936 # push @labels, "$label: ". join(', ', @values);
1938 my $detail = "$label: ";
1939 $detail .= shift(@values). ', '
1940 while @values && length($detail.$values[0]) < 78;
1942 push @labels, $detail;
1945 push @labels, map { "$label: $_" } @values;
1956 Returns the parent customer object (see L<FS::cust_main>).
1962 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1965 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
1969 Returns the location object, if any (see L<FS::cust_location>).
1971 =item cust_location_or_main
1973 If this package is associated with a location, returns the locaiton (see
1974 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1976 =item location_label [ OPTION => VALUE ... ]
1978 Returns the label of the location object (see L<FS::cust_location>).
1982 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
1984 =item seconds_since TIMESTAMP
1986 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1987 package have been online since TIMESTAMP, according to the session monitor.
1989 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1990 L<Time::Local> and L<Date::Parse> for conversion functions.
1995 my($self, $since) = @_;
1998 foreach my $cust_svc (
1999 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2001 $seconds += $cust_svc->seconds_since($since);
2008 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2010 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2011 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2014 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2015 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2021 sub seconds_since_sqlradacct {
2022 my($self, $start, $end) = @_;
2026 foreach my $cust_svc (
2028 my $part_svc = $_->part_svc;
2029 $part_svc->svcdb eq 'svc_acct'
2030 && scalar($part_svc->part_export('sqlradius'));
2033 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2040 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2042 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2043 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2047 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2048 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2053 sub attribute_since_sqlradacct {
2054 my($self, $start, $end, $attrib) = @_;
2058 foreach my $cust_svc (
2060 my $part_svc = $_->part_svc;
2061 $part_svc->svcdb eq 'svc_acct'
2062 && scalar($part_svc->part_export('sqlradius'));
2065 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2077 my( $self, $value ) = @_;
2078 if ( defined($value) ) {
2079 $self->setfield('quantity', $value);
2081 $self->getfield('quantity') || 1;
2084 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2086 Transfers as many services as possible from this package to another package.
2088 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2089 object. The destination package must already exist.
2091 Services are moved only if the destination allows services with the correct
2092 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2093 this option with caution! No provision is made for export differences
2094 between the old and new service definitions. Probably only should be used
2095 when your exports for all service definitions of a given svcdb are identical.
2096 (attempt a transfer without it first, to move all possible svcpart-matching
2099 Any services that can't be moved remain in the original package.
2101 Returns an error, if there is one; otherwise, returns the number of services
2102 that couldn't be moved.
2107 my ($self, $dest_pkgnum, %opt) = @_;
2113 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2114 $dest = $dest_pkgnum;
2115 $dest_pkgnum = $dest->pkgnum;
2117 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2120 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2122 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2123 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2126 foreach my $cust_svc ($dest->cust_svc) {
2127 $target{$cust_svc->svcpart}--;
2130 my %svcpart2svcparts = ();
2131 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2132 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2133 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2134 next if exists $svcpart2svcparts{$svcpart};
2135 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2136 $svcpart2svcparts{$svcpart} = [
2138 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2140 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2141 'svcpart' => $_ } );
2143 $pkg_svc ? $pkg_svc->primary_svc : '',
2144 $pkg_svc ? $pkg_svc->quantity : 0,
2148 grep { $_ != $svcpart }
2150 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2152 warn "alternates for svcpart $svcpart: ".
2153 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2158 foreach my $cust_svc ($self->cust_svc) {
2159 if($target{$cust_svc->svcpart} > 0) {
2160 $target{$cust_svc->svcpart}--;
2161 my $new = new FS::cust_svc { $cust_svc->hash };
2162 $new->pkgnum($dest_pkgnum);
2163 my $error = $new->replace($cust_svc);
2164 return $error if $error;
2165 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2167 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2168 warn "alternates to consider: ".
2169 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2171 my @alternate = grep {
2172 warn "considering alternate svcpart $_: ".
2173 "$target{$_} available in new package\n"
2176 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2178 warn "alternate(s) found\n" if $DEBUG;
2179 my $change_svcpart = $alternate[0];
2180 $target{$change_svcpart}--;
2181 my $new = new FS::cust_svc { $cust_svc->hash };
2182 $new->svcpart($change_svcpart);
2183 $new->pkgnum($dest_pkgnum);
2184 my $error = $new->replace($cust_svc);
2185 return $error if $error;
2198 This method is deprecated. See the I<depend_jobnum> option to the insert and
2199 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2206 local $SIG{HUP} = 'IGNORE';
2207 local $SIG{INT} = 'IGNORE';
2208 local $SIG{QUIT} = 'IGNORE';
2209 local $SIG{TERM} = 'IGNORE';
2210 local $SIG{TSTP} = 'IGNORE';
2211 local $SIG{PIPE} = 'IGNORE';
2213 my $oldAutoCommit = $FS::UID::AutoCommit;
2214 local $FS::UID::AutoCommit = 0;
2217 foreach my $cust_svc ( $self->cust_svc ) {
2218 #false laziness w/svc_Common::insert
2219 my $svc_x = $cust_svc->svc_x;
2220 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2221 my $error = $part_export->export_insert($svc_x);
2223 $dbh->rollback if $oldAutoCommit;
2229 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2236 =head1 CLASS METHODS
2242 Returns an SQL expression identifying recurring packages.
2246 sub recurring_sql { "
2247 '0' != ( select freq from part_pkg
2248 where cust_pkg.pkgpart = part_pkg.pkgpart )
2253 Returns an SQL expression identifying one-time packages.
2258 '0' = ( select freq from part_pkg
2259 where cust_pkg.pkgpart = part_pkg.pkgpart )
2264 Returns an SQL expression identifying active packages.
2269 ". $_[0]->recurring_sql(). "
2270 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2271 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2272 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2275 =item not_yet_billed_sql
2277 Returns an SQL expression identifying packages which have not yet been billed.
2281 sub not_yet_billed_sql { "
2282 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2283 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2284 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2289 Returns an SQL expression identifying inactive packages (one-time packages
2290 that are otherwise unsuspended/uncancelled).
2294 sub inactive_sql { "
2295 ". $_[0]->onetime_sql(). "
2296 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2297 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2298 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2304 Returns an SQL expression identifying suspended packages.
2308 sub suspended_sql { susp_sql(@_); }
2310 #$_[0]->recurring_sql(). ' AND '.
2312 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2313 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2320 Returns an SQL exprression identifying cancelled packages.
2324 sub cancelled_sql { cancel_sql(@_); }
2326 #$_[0]->recurring_sql(). ' AND '.
2327 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2330 =item search HASHREF
2334 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2335 Valid parameters are
2343 active, inactive, suspended, cancel (or cancelled)
2347 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2351 boolean selects custom packages
2357 pkgpart or arrayref or hashref of pkgparts
2361 arrayref of beginning and ending epoch date
2365 arrayref of beginning and ending epoch date
2369 arrayref of beginning and ending epoch date
2373 arrayref of beginning and ending epoch date
2377 arrayref of beginning and ending epoch date
2381 arrayref of beginning and ending epoch date
2385 arrayref of beginning and ending epoch date
2389 pkgnum or APKG_pkgnum
2393 a value suited to passing to FS::UI::Web::cust_header
2397 specifies the user for agent virtualization
2401 boolean selects packages containing fcc form 477 telco lines
2408 my ($class, $params) = @_;
2415 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2417 "cust_main.agentnum = $1";
2424 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2426 "cust_pkg.custnum = $1";
2433 if ( $params->{'magic'} eq 'active'
2434 || $params->{'status'} eq 'active' ) {
2436 push @where, FS::cust_pkg->active_sql();
2438 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2439 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2441 push @where, FS::cust_pkg->not_yet_billed_sql();
2443 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2444 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2446 push @where, FS::cust_pkg->inactive_sql();
2448 } elsif ( $params->{'magic'} eq 'suspended'
2449 || $params->{'status'} eq 'suspended' ) {
2451 push @where, FS::cust_pkg->suspended_sql();
2453 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2454 || $params->{'status'} =~ /^cancell?ed$/ ) {
2456 push @where, FS::cust_pkg->cancelled_sql();
2461 # parse package class
2464 #false lazinessish w/graph/cust_bill_pkg.cgi
2467 if ( exists($params->{'classnum'})
2468 && $params->{'classnum'} =~ /^(\d*)$/
2472 if ( $classnum ) { #a specific class
2473 push @where, "part_pkg.classnum = $classnum";
2475 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2476 #die "classnum $classnum not found!" unless $pkg_class[0];
2477 #$title .= $pkg_class[0]->classname.' ';
2479 } elsif ( $classnum eq '' ) { #the empty class
2481 push @where, "part_pkg.classnum IS NULL";
2482 #$title .= 'Empty class ';
2483 #@pkg_class = ( '(empty class)' );
2484 } elsif ( $classnum eq '0' ) {
2485 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2486 #push @pkg_class, '(empty class)';
2488 die "illegal classnum";
2494 # parse package report options
2497 my @report_option = ();
2498 if ( exists($params->{'report_option'})
2499 && $params->{'report_option'} =~ /^([,\d]*)$/
2502 @report_option = split(',', $1);
2505 if (@report_option) {
2506 # this will result in the empty set for the dangling comma case as it should
2508 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2509 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2510 AND optionname = 'report_option_$_'
2511 AND optionvalue = '1' )"
2521 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2527 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2533 if ( exists($params->{'censustract'}) ) {
2534 $params->{'censustract'} =~ /^([.\d]*)$/;
2535 my $censustract = "cust_main.censustract = '$1'";
2536 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2537 push @where, "( $censustract )";
2544 if ( ref($params->{'pkgpart'}) ) {
2547 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2548 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2549 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2550 @pkgpart = @{ $params->{'pkgpart'} };
2552 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2555 @pkgpart = grep /^(\d+)$/, @pkgpart;
2557 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2559 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2560 push @where, "pkgpart = $1";
2569 #false laziness w/report_cust_pkg.html
2572 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2573 'active' => { 'susp'=>1, 'cancel'=>1 },
2574 'suspended' => { 'cancel' => 1 },
2579 if( exists($params->{'active'} ) ) {
2580 # This overrides all the other date-related fields
2581 my($beginning, $ending) = @{$params->{'active'}};
2583 "cust_pkg.setup IS NOT NULL",
2584 "cust_pkg.setup <= $ending",
2585 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2586 "NOT (".FS::cust_pkg->onetime_sql . ")";
2589 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2591 next unless exists($params->{$field});
2593 my($beginning, $ending) = @{$params->{$field}};
2595 next if $beginning == 0 && $ending == 4294967295;
2598 "cust_pkg.$field IS NOT NULL",
2599 "cust_pkg.$field >= $beginning",
2600 "cust_pkg.$field <= $ending";
2602 $orderby ||= "ORDER BY cust_pkg.$field";
2607 $orderby ||= 'ORDER BY bill';
2610 # parse magic, legacy, etc.
2613 if ( $params->{'magic'} &&
2614 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2617 $orderby = 'ORDER BY pkgnum';
2619 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2620 push @where, "pkgpart = $1";
2623 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2625 $orderby = 'ORDER BY pkgnum';
2627 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2629 $orderby = 'ORDER BY pkgnum';
2632 SELECT count(*) FROM pkg_svc
2633 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2634 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2635 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2636 AND cust_svc.svcpart = pkg_svc.svcpart
2643 # setup queries, links, subs, etc. for the search
2646 # here is the agent virtualization
2647 if ($params->{CurrentUser}) {
2649 qsearchs('access_user', { username => $params->{CurrentUser} });
2652 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2657 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2660 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2662 my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2663 'LEFT JOIN pkg_class USING ( classnum ) '.
2664 'LEFT JOIN cust_main USING ( custnum ) ';
2666 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2669 'table' => 'cust_pkg',
2671 'select' => join(', ',
2673 ( map "part_pkg.$_", qw( pkg freq ) ),
2674 'pkg_class.classname',
2675 'cust_main.custnum as cust_main_custnum',
2676 FS::UI::Web::cust_sql_fields(
2677 $params->{'cust_fields'}
2680 'extra_sql' => "$extra_sql $orderby",
2681 'addl_from' => $addl_from,
2682 'count_query' => $count_query,
2689 Returns a list of two package counts. The first is a count of packages
2690 based on the supplied criteria and the second is the count of residential
2691 packages with those same criteria. Criteria are specified as in the search
2697 my ($class, $params) = @_;
2699 my $sql_query = $class->search( $params );
2701 my $count_sql = delete($sql_query->{'count_query'});
2702 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
2703 or die "couldn't parse count_sql";
2705 my $count_sth = dbh->prepare($count_sql)
2706 or die "Error preparing $count_sql: ". dbh->errstr;
2708 or die "Error executing $count_sql: ". $count_sth->errstr;
2709 my $count_arrayref = $count_sth->fetchrow_arrayref;
2711 return ( @$count_arrayref );
2718 Returns a list: the first item is an SQL fragment identifying matching
2719 packages/customers via location (taking into account shipping and package
2720 address taxation, if enabled), and subsequent items are the parameters to
2721 substitute for the placeholders in that fragment.
2726 my($class, %opt) = @_;
2727 my $ornull = $opt{'ornull'};
2729 my $conf = new FS::Conf;
2731 # '?' placeholders in _location_sql_where
2734 @bill_param = qw( county county state state state country );
2736 @bill_param = qw( county state state country );
2738 unshift @bill_param, 'county'; # unless $nec;
2742 if ( $conf->exists('tax-ship_address') ) {
2745 ( ( ship_last IS NULL OR ship_last = '' )
2746 AND ". _location_sql_where('cust_main', '', $ornull ). "
2748 OR ( ship_last IS NOT NULL AND ship_last != ''
2749 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2752 # AND payby != 'COMP'
2754 @main_param = ( @bill_param, @bill_param );
2758 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2759 @main_param = @bill_param;
2765 if ( $conf->exists('tax-pkg_address') ) {
2767 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2770 ( cust_pkg.locationnum IS NULL AND $main_where )
2771 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2774 @param = ( @main_param, @bill_param );
2778 $where = $main_where;
2779 @param = @main_param;
2787 #subroutine, helper for location_sql
2788 sub _location_sql_where {
2790 my $prefix = @_ ? shift : '';
2791 my $ornull = @_ ? shift : '';
2793 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2795 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2797 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2798 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2801 ( $table.${prefix}county = ? $or_empty_county $ornull )
2802 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2803 AND $table.${prefix}country = ?
2811 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2813 CUSTNUM is a customer (see L<FS::cust_main>)
2815 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2816 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2819 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2820 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2821 new billing items. An error is returned if this is not possible (see
2822 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2825 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2826 newly-created cust_pkg objects.
2828 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2829 and inserted. Multiple FS::pkg_referral records can be created by
2830 setting I<refnum> to an array reference of refnums or a hash reference with
2831 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2832 record will be created corresponding to cust_main.refnum.
2837 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2839 my $conf = new FS::Conf;
2841 # Transactionize this whole mess
2842 local $SIG{HUP} = 'IGNORE';
2843 local $SIG{INT} = 'IGNORE';
2844 local $SIG{QUIT} = 'IGNORE';
2845 local $SIG{TERM} = 'IGNORE';
2846 local $SIG{TSTP} = 'IGNORE';
2847 local $SIG{PIPE} = 'IGNORE';
2849 my $oldAutoCommit = $FS::UID::AutoCommit;
2850 local $FS::UID::AutoCommit = 0;
2854 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2855 # return "Customer not found: $custnum" unless $cust_main;
2857 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
2860 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2863 my $change = scalar(@old_cust_pkg) != 0;
2866 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2868 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
2869 " to pkgpart ". $pkgparts->[0]. "\n"
2872 my $err_or_cust_pkg =
2873 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2874 'refnum' => $refnum,
2877 unless (ref($err_or_cust_pkg)) {
2878 $dbh->rollback if $oldAutoCommit;
2879 return $err_or_cust_pkg;
2882 push @$return_cust_pkg, $err_or_cust_pkg;
2883 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2888 # Create the new packages.
2889 foreach my $pkgpart (@$pkgparts) {
2891 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
2893 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2894 pkgpart => $pkgpart,
2898 $error = $cust_pkg->insert( 'change' => $change );
2900 $dbh->rollback if $oldAutoCommit;
2903 push @$return_cust_pkg, $cust_pkg;
2905 # $return_cust_pkg now contains refs to all of the newly
2908 # Transfer services and cancel old packages.
2909 foreach my $old_pkg (@old_cust_pkg) {
2911 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
2914 foreach my $new_pkg (@$return_cust_pkg) {
2915 $error = $old_pkg->transfer($new_pkg);
2916 if ($error and $error == 0) {
2917 # $old_pkg->transfer failed.
2918 $dbh->rollback if $oldAutoCommit;
2923 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2924 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2925 foreach my $new_pkg (@$return_cust_pkg) {
2926 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2927 if ($error and $error == 0) {
2928 # $old_pkg->transfer failed.
2929 $dbh->rollback if $oldAutoCommit;
2936 # Transfers were successful, but we went through all of the
2937 # new packages and still had services left on the old package.
2938 # We can't cancel the package under the circumstances, so abort.
2939 $dbh->rollback if $oldAutoCommit;
2940 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2942 $error = $old_pkg->cancel( quiet=>1 );
2948 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2952 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2954 A bulk change method to change packages for multiple customers.
2956 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2957 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2960 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2961 replace. The services (see L<FS::cust_svc>) are moved to the
2962 new billing items. An error is returned if this is not possible (see
2965 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2966 newly-created cust_pkg objects.
2971 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2973 # Transactionize this whole mess
2974 local $SIG{HUP} = 'IGNORE';
2975 local $SIG{INT} = 'IGNORE';
2976 local $SIG{QUIT} = 'IGNORE';
2977 local $SIG{TERM} = 'IGNORE';
2978 local $SIG{TSTP} = 'IGNORE';
2979 local $SIG{PIPE} = 'IGNORE';
2981 my $oldAutoCommit = $FS::UID::AutoCommit;
2982 local $FS::UID::AutoCommit = 0;
2986 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2989 while(scalar(@old_cust_pkg)) {
2991 my $custnum = $old_cust_pkg[0]->custnum;
2992 my (@remove) = map { $_->pkgnum }
2993 grep { $_->custnum == $custnum } @old_cust_pkg;
2994 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2996 my $error = order $custnum, $pkgparts, \@remove, \@return;
2998 push @errors, $error
3000 push @$return_cust_pkg, @return;
3003 if (scalar(@errors)) {
3004 $dbh->rollback if $oldAutoCommit;
3005 return join(' / ', @errors);
3008 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3014 Associates this package with a (suspension or cancellation) reason (see
3015 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
3018 Available options are:
3024 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.
3028 the access_user (see L<FS::access_user>) providing the reason
3036 the action (cancel, susp, adjourn, expire) associated with the reason
3040 If there is an error, returns the error, otherwise returns false.
3045 my ($self, %options) = @_;
3047 my $otaker = $options{reason_otaker} ||
3048 $FS::CurrentUser::CurrentUser->username;
3051 if ( $options{'reason'} =~ /^(\d+)$/ ) {
3055 } elsif ( ref($options{'reason'}) ) {
3057 return 'Enter a new reason (or select an existing one)'
3058 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
3060 my $reason = new FS::reason({
3061 'reason_type' => $options{'reason'}->{'typenum'},
3062 'reason' => $options{'reason'}->{'reason'},
3064 my $error = $reason->insert;
3065 return $error if $error;
3067 $reasonnum = $reason->reasonnum;
3070 return "Unparsable reason: ". $options{'reason'};
3073 my $cust_pkg_reason =
3074 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
3075 'reasonnum' => $reasonnum,
3076 'otaker' => $otaker,
3077 'action' => substr(uc($options{'action'}),0,1),
3078 'date' => $options{'date'}
3083 $cust_pkg_reason->insert;
3086 =item set_usage USAGE_VALUE_HASHREF
3088 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3089 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3090 upbytes, downbytes, and totalbytes are appropriate keys.
3092 All svc_accts which are part of this package have their values reset.
3097 my ($self, $valueref, %opt) = @_;
3099 foreach my $cust_svc ($self->cust_svc){
3100 my $svc_x = $cust_svc->svc_x;
3101 $svc_x->set_usage($valueref, %opt)
3102 if $svc_x->can("set_usage");
3106 =item recharge USAGE_VALUE_HASHREF
3108 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3109 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3110 upbytes, downbytes, and totalbytes are appropriate keys.
3112 All svc_accts which are part of this package have their values incremented.
3117 my ($self, $valueref) = @_;
3119 foreach my $cust_svc ($self->cust_svc){
3120 my $svc_x = $cust_svc->svc_x;
3121 $svc_x->recharge($valueref)
3122 if $svc_x->can("recharge");
3130 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3132 In sub order, the @pkgparts array (passed by reference) is clobbered.
3134 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3135 method to pass dates to the recur_prog expression, it should do so.
3137 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3138 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3139 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3140 configuration values. Probably need a subroutine which decides what to do
3141 based on whether or not we've fetched the user yet, rather than a hash. See
3142 FS::UID and the TODO.
3144 Now that things are transactional should the check in the insert method be
3149 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3150 L<FS::pkg_svc>, schema.html from the base documentation