4 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
5 FS::m2m_Common FS::option_Common );
6 use vars qw($disable_agentcheck $DEBUG $me);
8 use Scalar::Util qw( blessed );
9 use List::Util qw(max);
11 use Time::Local qw( timelocal timelocal_nocheck );
13 use FS::UID qw( getotaker dbh driver_name );
14 use FS::Misc qw( send_email );
15 use FS::Record qw( qsearch qsearchs fields );
20 use FS::cust_location;
22 use FS::cust_bill_pkg;
23 use FS::cust_pkg_detail;
28 use FS::cust_pkg_reason;
30 use FS::cust_pkg_discount;
35 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
37 # because they load configuration by setting FS::UID::callback (see TODO)
43 # for sending cancel emails in sub cancel
47 $me = '[FS::cust_pkg]';
49 $disable_agentcheck = 0;
53 my ( $hashref, $cache ) = @_;
54 #if ( $hashref->{'pkgpart'} ) {
55 if ( $hashref->{'pkg'} ) {
56 # #@{ $self->{'_pkgnum'} } = ();
57 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
58 # $self->{'_pkgpart'} = $subcache;
59 # #push @{ $self->{'_pkgnum'} },
60 # FS::part_pkg->new_or_cached($hashref, $subcache);
61 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
63 if ( exists $hashref->{'svcnum'} ) {
64 #@{ $self->{'_pkgnum'} } = ();
65 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
66 $self->{'_svcnum'} = $subcache;
67 #push @{ $self->{'_pkgnum'} },
68 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
74 FS::cust_pkg - Object methods for cust_pkg objects
80 $record = new FS::cust_pkg \%hash;
81 $record = new FS::cust_pkg { 'column' => 'value' };
83 $error = $record->insert;
85 $error = $new_record->replace($old_record);
87 $error = $record->delete;
89 $error = $record->check;
91 $error = $record->cancel;
93 $error = $record->suspend;
95 $error = $record->unsuspend;
97 $part_pkg = $record->part_pkg;
99 @labels = $record->labels;
101 $seconds = $record->seconds_since($timestamp);
103 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
104 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
108 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
109 inherits from FS::Record. The following fields are currently supported:
115 Primary key (assigned automatically for new billing items)
119 Customer (see L<FS::cust_main>)
123 Billing item definition (see L<FS::part_pkg>)
127 Optional link to package location (see L<FS::location>)
131 date package was ordered (also remains same on changes)
143 date (next bill date)
171 order taker (see L<FS::access_user>)
175 If this field is set to 1, disables the automatic
176 unsuspension of this package when using the B<unsuspendauto> config option.
180 If not set, defaults to 1
184 Date of change from previous package
194 =item change_locationnum
202 The pkgnum of the package that this package is supplemental to, if any.
206 The package link (L<FS::part_pkg_link>) that defines this supplemental
207 package, if it is one.
211 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
212 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
213 L<Time::Local> and L<Date::Parse> for conversion functions.
221 Create a new billing item. To add the item to the database, see L<"insert">.
225 sub table { 'cust_pkg'; }
226 sub cust_linked { $_[0]->cust_main_custnum; }
227 sub cust_unlinked_msg {
229 "WARNING: can't find cust_main.custnum ". $self->custnum.
230 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
233 =item insert [ OPTION => VALUE ... ]
235 Adds this billing item to the database ("Orders" the item). If there is an
236 error, returns the error, otherwise returns false.
238 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
239 will be used to look up the package definition and agent restrictions will be
242 If the additional field I<refnum> is defined, an FS::pkg_referral record will
243 be created and inserted. Multiple FS::pkg_referral records can be created by
244 setting I<refnum> to an array reference of refnums or a hash reference with
245 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
246 record will be created corresponding to cust_main.refnum.
248 The following options are available:
254 If set true, supresses any referral credit to a referring customer.
258 cust_pkg_option records will be created
262 a ticket will be added to this customer with this subject
266 an optional queue name for ticket additions
273 my( $self, %options ) = @_;
275 my $error = $self->check_pkgpart;
276 return $error if $error;
278 my $part_pkg = $self->part_pkg;
280 if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
281 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
282 $mon += 1 unless $mday == 1;
283 until ( $mon < 12 ) { $mon -= 12; $year++; }
284 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
287 foreach my $action ( qw(expire adjourn contract_end) ) {
288 my $months = $part_pkg->option("${action}_months",1);
289 if($months and !$self->$action) {
290 my $start = $self->start_date || $self->setup || time;
291 $self->$action( $part_pkg->add_freq($start, $months) );
295 my $free_days = $part_pkg->option('free_days',1);
296 if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
297 my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
298 #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
299 my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
300 $self->start_date($start_date);
303 $self->order_date(time);
305 local $SIG{HUP} = 'IGNORE';
306 local $SIG{INT} = 'IGNORE';
307 local $SIG{QUIT} = 'IGNORE';
308 local $SIG{TERM} = 'IGNORE';
309 local $SIG{TSTP} = 'IGNORE';
310 local $SIG{PIPE} = 'IGNORE';
312 my $oldAutoCommit = $FS::UID::AutoCommit;
313 local $FS::UID::AutoCommit = 0;
316 $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
318 $dbh->rollback if $oldAutoCommit;
322 $self->refnum($self->cust_main->refnum) unless $self->refnum;
323 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
324 $self->process_m2m( 'link_table' => 'pkg_referral',
325 'target_table' => 'part_referral',
326 'params' => $self->refnum,
329 if ( $self->discountnum ) {
330 my $error = $self->insert_discount();
332 $dbh->rollback if $oldAutoCommit;
337 #if ( $self->reg_code ) {
338 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
339 # $error = $reg_code->delete;
341 # $dbh->rollback if $oldAutoCommit;
346 my $conf = new FS::Conf;
348 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
350 #this init stuff is still inefficient, but at least its limited to
351 # the small number (any?) folks using ticket emailing on pkg order
354 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
361 use FS::TicketSystem;
362 FS::TicketSystem->init();
364 my $q = new RT::Queue($RT::SystemUser);
365 $q->Load($options{ticket_queue}) if $options{ticket_queue};
366 my $t = new RT::Ticket($RT::SystemUser);
367 my $mime = new MIME::Entity;
368 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
369 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
370 Subject => $options{ticket_subject},
373 $t->AddLink( Type => 'MemberOf',
374 Target => 'freeside://freeside/cust_main/'. $self->custnum,
378 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
379 my $queue = new FS::queue {
380 'job' => 'FS::cust_main::queueable_print',
382 $error = $queue->insert(
383 'custnum' => $self->custnum,
384 'template' => 'welcome_letter',
388 warn "can't send welcome letter: $error";
393 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
400 This method now works but you probably shouldn't use it.
402 You don't want to delete packages, because there would then be no record
403 the customer ever purchased the package. Instead, see the cancel method and
404 hide cancelled packages.
411 local $SIG{HUP} = 'IGNORE';
412 local $SIG{INT} = 'IGNORE';
413 local $SIG{QUIT} = 'IGNORE';
414 local $SIG{TERM} = 'IGNORE';
415 local $SIG{TSTP} = 'IGNORE';
416 local $SIG{PIPE} = 'IGNORE';
418 my $oldAutoCommit = $FS::UID::AutoCommit;
419 local $FS::UID::AutoCommit = 0;
422 foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
423 my $error = $cust_pkg_discount->delete;
425 $dbh->rollback if $oldAutoCommit;
429 #cust_bill_pkg_discount?
431 foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
432 my $error = $cust_pkg_detail->delete;
434 $dbh->rollback if $oldAutoCommit;
439 foreach my $cust_pkg_reason (
441 'table' => 'cust_pkg_reason',
442 'hashref' => { 'pkgnum' => $self->pkgnum },
446 my $error = $cust_pkg_reason->delete;
448 $dbh->rollback if $oldAutoCommit;
455 my $error = $self->SUPER::delete(@_);
457 $dbh->rollback if $oldAutoCommit;
461 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
467 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
469 Replaces the OLD_RECORD with this one in the database. If there is an error,
470 returns the error, otherwise returns false.
472 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
474 Changing pkgpart may have disasterous effects. See the order subroutine.
476 setup and bill are normally updated by calling the bill method of a customer
477 object (see L<FS::cust_main>).
479 suspend is normally updated by the suspend and unsuspend methods.
481 cancel is normally updated by the cancel method (and also the order subroutine
484 Available options are:
490 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.
494 the access_user (see L<FS::access_user>) providing the reason
498 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
507 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
512 ( ref($_[0]) eq 'HASH' )
516 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
517 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
520 #return "Can't change setup once it exists!"
521 # if $old->getfield('setup') &&
522 # $old->getfield('setup') != $new->getfield('setup');
524 #some logic for bill, susp, cancel?
526 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
528 local $SIG{HUP} = 'IGNORE';
529 local $SIG{INT} = 'IGNORE';
530 local $SIG{QUIT} = 'IGNORE';
531 local $SIG{TERM} = 'IGNORE';
532 local $SIG{TSTP} = 'IGNORE';
533 local $SIG{PIPE} = 'IGNORE';
535 my $oldAutoCommit = $FS::UID::AutoCommit;
536 local $FS::UID::AutoCommit = 0;
539 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
540 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
541 my $error = $new->insert_reason(
542 'reason' => $options->{'reason'},
543 'date' => $new->$method,
545 'reason_otaker' => $options->{'reason_otaker'},
548 dbh->rollback if $oldAutoCommit;
549 return "Error inserting cust_pkg_reason: $error";
554 #save off and freeze RADIUS attributes for any associated svc_acct records
556 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
558 #also check for specific exports?
559 # to avoid spurious modify export events
560 @svc_acct = map { $_->svc_x }
561 grep { $_->part_svc->svcdb eq 'svc_acct' }
564 $_->snapshot foreach @svc_acct;
568 my $error = $new->SUPER::replace($old,
569 $options->{options} ? $options->{options} : ()
572 $dbh->rollback if $oldAutoCommit;
576 #for prepaid packages,
577 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
578 foreach my $old_svc_acct ( @svc_acct ) {
579 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
581 $new_svc_acct->replace( $old_svc_acct,
582 'depend_jobnum' => $options->{depend_jobnum},
585 $dbh->rollback if $oldAutoCommit;
590 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
597 Checks all fields to make sure this is a valid billing item. If there is an
598 error, returns the error, otherwise returns false. Called by the insert and
606 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
609 $self->ut_numbern('pkgnum')
610 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
611 || $self->ut_numbern('pkgpart')
612 || $self->check_pkgpart
613 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
614 || $self->ut_numbern('start_date')
615 || $self->ut_numbern('setup')
616 || $self->ut_numbern('bill')
617 || $self->ut_numbern('susp')
618 || $self->ut_numbern('cancel')
619 || $self->ut_numbern('adjourn')
620 || $self->ut_numbern('resume')
621 || $self->ut_numbern('expire')
622 || $self->ut_numbern('dundate')
623 || $self->ut_enum('no_auto', [ '', 'Y' ])
624 || $self->ut_enum('waive_setup', [ '', 'Y' ])
625 || $self->ut_numbern('agent_pkgid')
626 || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
627 || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
628 || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
629 || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
631 return $error if $error;
633 return "A package with both start date (future start) and setup date (already started) will never bill"
634 if $self->start_date && $self->setup;
636 return "A future unsuspend date can only be set for a package with a suspend date"
637 if $self->resume and !$self->susp and !$self->adjourn;
639 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
641 if ( $self->dbdef_table->column('manual_flag') ) {
642 $self->manual_flag('') if $self->manual_flag eq ' ';
643 $self->manual_flag =~ /^([01]?)$/
644 or return "Illegal manual_flag ". $self->manual_flag;
645 $self->manual_flag($1);
658 my $error = $self->ut_numbern('pkgpart');
659 return $error if $error;
661 if ( $self->reg_code ) {
663 unless ( grep { $self->pkgpart == $_->pkgpart }
664 map { $_->reg_code_pkg }
665 qsearchs( 'reg_code', { 'code' => $self->reg_code,
666 'agentnum' => $self->cust_main->agentnum })
668 return "Unknown registration code";
671 } elsif ( $self->promo_code ) {
674 qsearchs('part_pkg', {
675 'pkgpart' => $self->pkgpart,
676 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
678 return 'Unknown promotional code' unless $promo_part_pkg;
682 unless ( $disable_agentcheck ) {
684 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
685 return "agent ". $agent->agentnum. ':'. $agent->agent.
686 " can't purchase pkgpart ". $self->pkgpart
687 unless $agent->pkgpart_hashref->{ $self->pkgpart }
688 || $agent->agentnum == $self->part_pkg->agentnum;
691 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
692 return $error if $error;
700 =item cancel [ OPTION => VALUE ... ]
702 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
703 in this package, then cancels the package itself (sets the cancel field to
706 Available options are:
710 =item quiet - can be set true to supress email cancellation notices.
712 =item time - can be set to cancel the package based on a specific future or
713 historical date. Using time ensures that the remaining amount is calculated
714 correctly. Note however that this is an immediate cancel and just changes
715 the date. You are PROBABLY looking to expire the account instead of using
718 =item reason - can be set to a cancellation reason (see L<FS:reason>),
719 either a reasonnum of an existing reason, or passing a hashref will create
720 a new reason. The hashref should have the following keys: typenum - Reason
721 type (see L<FS::reason_type>, reason - Text of the new reason.
723 =item date - can be set to a unix style timestamp to specify when to
726 =item nobill - can be set true to skip billing if it might otherwise be done.
728 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
729 not credit it. This must be set (by change()) when changing the package
730 to a different pkgpart or location, and probably shouldn't be in any other
731 case. If it's not set, the 'unused_credit_cancel' part_pkg option will
736 If there is an error, returns the error, otherwise returns false.
741 my( $self, %options ) = @_;
744 # pass all suspend/cancel actions to the main package
745 if ( $self->main_pkgnum and !$options{'from_main'} ) {
746 return $self->main_pkg->cancel(%options);
749 my $conf = new FS::Conf;
751 warn "cust_pkg::cancel called with options".
752 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
755 local $SIG{HUP} = 'IGNORE';
756 local $SIG{INT} = 'IGNORE';
757 local $SIG{QUIT} = 'IGNORE';
758 local $SIG{TERM} = 'IGNORE';
759 local $SIG{TSTP} = 'IGNORE';
760 local $SIG{PIPE} = 'IGNORE';
762 my $oldAutoCommit = $FS::UID::AutoCommit;
763 local $FS::UID::AutoCommit = 0;
766 my $old = $self->select_for_update;
768 if ( $old->get('cancel') || $self->get('cancel') ) {
769 dbh->rollback if $oldAutoCommit;
770 return ""; # no error
773 # XXX possibly set cancel_time to the expire date?
774 my $cancel_time = $options{'time'} || time;
775 my $date = $options{'date'} if $options{'date'}; # expire/cancel later
776 $date = '' if ($date && $date <= $cancel_time); # complain instead?
778 #race condition: usage could be ongoing until unprovisioned
779 #resolved by performing a change package instead (which unprovisions) and
781 if ( !$options{nobill} && !$date ) {
782 # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
783 my $copy = $self->new({$self->hash});
785 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
787 'time' => $cancel_time );
788 warn "Error billing during cancel, custnum ".
789 #$self->cust_main->custnum. ": $error"
794 if ( $options{'reason'} ) {
795 $error = $self->insert_reason( 'reason' => $options{'reason'},
796 'action' => $date ? 'expire' : 'cancel',
797 'date' => $date ? $date : $cancel_time,
798 'reason_otaker' => $options{'reason_otaker'},
801 dbh->rollback if $oldAutoCommit;
802 return "Error inserting cust_pkg_reason: $error";
806 my %svc_cancel_opt = ();
807 $svc_cancel_opt{'date'} = $date if $date;
808 foreach my $cust_svc (
811 sort { $a->[1] <=> $b->[1] }
812 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
813 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
815 my $part_svc = $cust_svc->part_svc;
816 next if ( defined($part_svc) and $part_svc->preserve );
817 my $error = $cust_svc->cancel( %svc_cancel_opt );
820 $dbh->rollback if $oldAutoCommit;
821 return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
827 # credit remaining time if appropriate
829 if ( exists($options{'unused_credit'}) ) {
830 $do_credit = $options{'unused_credit'};
833 $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
836 my $error = $self->credit_remaining('cancel', $cancel_time);
838 $dbh->rollback if $oldAutoCommit;
845 my %hash = $self->hash;
846 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
847 my $new = new FS::cust_pkg ( \%hash );
848 $error = $new->replace( $self, options => { $self->options } );
850 $dbh->rollback if $oldAutoCommit;
854 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
855 $error = $supp_pkg->cancel(%options, 'from_main' => 1);
857 $dbh->rollback if $oldAutoCommit;
858 return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
862 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
863 return '' if $date; #no errors
865 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
866 if ( !$options{'quiet'} &&
867 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
869 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
872 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
873 $error = $msg_template->send( 'cust_main' => $self->cust_main,
878 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
879 'to' => \@invoicing_list,
880 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
881 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
884 #should this do something on errors?
891 =item cancel_if_expired [ NOW_TIMESTAMP ]
893 Cancels this package if its expire date has been reached.
897 sub cancel_if_expired {
899 my $time = shift || time;
900 return '' unless $self->expire && $self->expire <= $time;
901 my $error = $self->cancel;
903 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
904 $self->custnum. ": $error";
911 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
912 locationnum, (other fields?). Attempts to re-provision cancelled services
913 using history information (errors at this stage are not fatal).
915 cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
917 svc_fatal: service provisioning errors are fatal
919 svc_errors: pass an array reference, will be filled in with any provisioning errors
921 main_pkgnum: link the package as a supplemental package of this one. For
927 my( $self, %options ) = @_;
929 #in case you try do do $uncancel-date = $cust_pkg->uncacel
930 return '' unless $self->get('cancel');
932 if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
933 return $self->main_pkg->uncancel(%options);
940 local $SIG{HUP} = 'IGNORE';
941 local $SIG{INT} = 'IGNORE';
942 local $SIG{QUIT} = 'IGNORE';
943 local $SIG{TERM} = 'IGNORE';
944 local $SIG{TSTP} = 'IGNORE';
945 local $SIG{PIPE} = 'IGNORE';
947 my $oldAutoCommit = $FS::UID::AutoCommit;
948 local $FS::UID::AutoCommit = 0;
952 # insert the new package
955 my $cust_pkg = new FS::cust_pkg {
956 last_bill => ( $options{'last_bill'} || $self->get('last_bill') ),
957 bill => ( $options{'bill'} || $self->get('bill') ),
959 uncancel_pkgnum => $self->pkgnum,
960 main_pkgnum => ($options{'main_pkgnum'} || ''),
961 map { $_ => $self->get($_) } qw(
962 custnum pkgpart locationnum
964 susp adjourn resume expire start_date contract_end dundate
965 change_date change_pkgpart change_locationnum
966 manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
970 my $error = $cust_pkg->insert(
971 'change' => 1, #supresses any referral credit to a referring customer
974 $dbh->rollback if $oldAutoCommit;
982 #find historical services within this timeframe before the package cancel
983 # (incompatible with "time" option to cust_pkg->cancel?)
984 my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
985 # too little? (unprovisioing export delay?)
986 my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
987 my @h_cust_svc = $self->h_cust_svc( $end, $start );
990 foreach my $h_cust_svc (@h_cust_svc) {
991 my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
992 #next unless $h_svc_x; #should this happen?
993 (my $table = $h_svc_x->table) =~ s/^h_//;
994 require "FS/$table.pm";
995 my $class = "FS::$table";
996 my $svc_x = $class->new( {
997 'pkgnum' => $cust_pkg->pkgnum,
998 'svcpart' => $h_cust_svc->svcpart,
999 map { $_ => $h_svc_x->get($_) } fields($table)
1003 if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
1004 $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
1007 my $svc_error = $svc_x->insert;
1009 if ( $options{svc_fatal} ) {
1010 $dbh->rollback if $oldAutoCommit;
1013 push @svc_errors, $svc_error;
1014 # is this necessary? svc_Common::insert already deletes the
1015 # cust_svc if inserting svc_x fails.
1016 my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
1018 my $cs_error = $cust_svc->delete;
1020 $dbh->rollback if $oldAutoCommit;
1026 } #foreach $h_cust_svc
1028 #these are pretty rare, but should handle them
1029 # - dsl_device (mac addresses)
1030 # - phone_device (mac addresses)
1031 # - dsl_note (ikano notes)
1032 # - domain_record (i.e. restore DNS information w/domains)
1033 # - inventory_item(?) (inventory w/un-cancelling service?)
1034 # - nas (svc_broaband nas stuff)
1035 #this stuff is unused in the wild afaik
1036 # - mailinglistmember
1038 # - svc_domain.parent_svcnum?
1039 # - acct_snarf (ancient mail fetching config)
1040 # - cgp_rule (communigate)
1041 # - cust_svc_option (used by our Tron stuff)
1042 # - acct_rt_transaction (used by our time worked stuff)
1045 # also move over any services that didn't unprovision at cancellation
1048 foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
1049 $cust_svc->pkgnum( $cust_pkg->pkgnum );
1050 my $error = $cust_svc->replace;
1052 $dbh->rollback if $oldAutoCommit;
1058 # Uncancel any supplemental packages, and make them supplemental to the
1062 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1064 $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
1066 $dbh->rollback if $oldAutoCommit;
1067 return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1075 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1077 ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg});
1078 @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
1085 Cancels any pending expiration (sets the expire field to null).
1087 If there is an error, returns the error, otherwise returns false.
1092 my( $self, %options ) = @_;
1095 local $SIG{HUP} = 'IGNORE';
1096 local $SIG{INT} = 'IGNORE';
1097 local $SIG{QUIT} = 'IGNORE';
1098 local $SIG{TERM} = 'IGNORE';
1099 local $SIG{TSTP} = 'IGNORE';
1100 local $SIG{PIPE} = 'IGNORE';
1102 my $oldAutoCommit = $FS::UID::AutoCommit;
1103 local $FS::UID::AutoCommit = 0;
1106 my $old = $self->select_for_update;
1108 my $pkgnum = $old->pkgnum;
1109 if ( $old->get('cancel') || $self->get('cancel') ) {
1110 dbh->rollback if $oldAutoCommit;
1111 return "Can't unexpire cancelled package $pkgnum";
1112 # or at least it's pointless
1115 unless ( $old->get('expire') && $self->get('expire') ) {
1116 dbh->rollback if $oldAutoCommit;
1117 return ""; # no error
1120 my %hash = $self->hash;
1121 $hash{'expire'} = '';
1122 my $new = new FS::cust_pkg ( \%hash );
1123 $error = $new->replace( $self, options => { $self->options } );
1125 $dbh->rollback if $oldAutoCommit;
1129 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1135 =item suspend [ OPTION => VALUE ... ]
1137 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1138 package, then suspends the package itself (sets the susp field to now).
1140 Available options are:
1144 =item reason - can be set to a cancellation reason (see L<FS:reason>),
1145 either a reasonnum of an existing reason, or passing a hashref will create
1146 a new reason. The hashref should have the following keys:
1147 - typenum - Reason type (see L<FS::reason_type>
1148 - reason - Text of the new reason.
1150 =item date - can be set to a unix style timestamp to specify when to
1153 =item time - can be set to override the current time, for calculation
1154 of final invoices or unused-time credits
1156 =item resume_date - can be set to a time when the package should be
1157 unsuspended. This may be more convenient than calling C<unsuspend()>
1160 =item from_main - allows a supplemental package to be suspended, rather
1161 than redirecting the method call to its main package. For internal use.
1165 If there is an error, returns the error, otherwise returns false.
1170 my( $self, %options ) = @_;
1173 # pass all suspend/cancel actions to the main package
1174 if ( $self->main_pkgnum and !$options{'from_main'} ) {
1175 return $self->main_pkg->suspend(%options);
1178 local $SIG{HUP} = 'IGNORE';
1179 local $SIG{INT} = 'IGNORE';
1180 local $SIG{QUIT} = 'IGNORE';
1181 local $SIG{TERM} = 'IGNORE';
1182 local $SIG{TSTP} = 'IGNORE';
1183 local $SIG{PIPE} = 'IGNORE';
1185 my $oldAutoCommit = $FS::UID::AutoCommit;
1186 local $FS::UID::AutoCommit = 0;
1189 my $old = $self->select_for_update;
1191 my $pkgnum = $old->pkgnum;
1192 if ( $old->get('cancel') || $self->get('cancel') ) {
1193 dbh->rollback if $oldAutoCommit;
1194 return "Can't suspend cancelled package $pkgnum";
1197 if ( $old->get('susp') || $self->get('susp') ) {
1198 dbh->rollback if $oldAutoCommit;
1199 return ""; # no error # complain on adjourn?
1202 my $suspend_time = $options{'time'} || time;
1203 my $date = $options{date} if $options{date}; # adjourn/suspend later
1204 $date = '' if ($date && $date <= $suspend_time); # complain instead?
1206 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
1207 dbh->rollback if $oldAutoCommit;
1208 return "Package $pkgnum expires before it would be suspended.";
1211 # some false laziness with sub cancel
1212 if ( !$options{nobill} && !$date &&
1213 $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1214 # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
1215 # make the entire cust_main->bill path recognize 'suspend' and
1216 # 'cancel' separately.
1217 warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1218 my $copy = $self->new({$self->hash});
1220 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
1222 'time' => $suspend_time );
1223 warn "Error billing during suspend, custnum ".
1224 #$self->cust_main->custnum. ": $error"
1229 if ( $options{'reason'} ) {
1230 $error = $self->insert_reason( 'reason' => $options{'reason'},
1231 'action' => $date ? 'adjourn' : 'suspend',
1232 'date' => $date ? $date : $suspend_time,
1233 'reason_otaker' => $options{'reason_otaker'},
1236 dbh->rollback if $oldAutoCommit;
1237 return "Error inserting cust_pkg_reason: $error";
1241 my %hash = $self->hash;
1243 $hash{'adjourn'} = $date;
1245 $hash{'susp'} = $suspend_time;
1248 my $resume_date = $options{'resume_date'} || 0;
1249 if ( $resume_date > ($date || $suspend_time) ) {
1250 $hash{'resume'} = $resume_date;
1253 $options{options} ||= {};
1255 my $new = new FS::cust_pkg ( \%hash );
1256 $error = $new->replace( $self, options => { $self->options,
1257 %{ $options{options} },
1261 $dbh->rollback if $oldAutoCommit;
1266 # credit remaining time if appropriate
1267 if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
1268 my $error = $self->credit_remaining('suspend', $suspend_time);
1270 $dbh->rollback if $oldAutoCommit;
1277 foreach my $cust_svc (
1278 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
1280 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1282 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1283 $dbh->rollback if $oldAutoCommit;
1284 return "Illegal svcdb value in part_svc!";
1287 require "FS/$svcdb.pm";
1289 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1291 $error = $svc->suspend;
1293 $dbh->rollback if $oldAutoCommit;
1296 my( $label, $value ) = $cust_svc->label;
1297 push @labels, "$label: $value";
1301 my $conf = new FS::Conf;
1302 if ( $conf->config('suspend_email_admin') ) {
1304 my $error = send_email(
1305 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1306 #invoice_from ??? well as good as any
1307 'to' => $conf->config('suspend_email_admin'),
1308 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1310 "This is an automatic message from your Freeside installation\n",
1311 "informing you that the following customer package has been suspended:\n",
1313 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1314 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1315 ( map { "Service : $_\n" } @labels ),
1320 warn "WARNING: can't send suspension admin email (suspending anyway): ".
1328 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1329 $error = $supp_pkg->suspend(%options, 'from_main' => 1);
1331 $dbh->rollback if $oldAutoCommit;
1332 return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1341 =item credit_remaining MODE TIME
1343 Generate a credit for this package for the time remaining in the current
1344 billing period. MODE is either "suspend" or "cancel" (determines the
1345 credit type). TIME is the time of suspension/cancellation. Both arguments
1350 sub credit_remaining {
1351 # Add a credit for remaining service
1352 my ($self, $mode, $time) = @_;
1353 die 'credit_remaining requires suspend or cancel'
1354 unless $mode eq 'suspend' or $mode eq 'cancel';
1355 die 'no suspend/cancel time' unless $time > 0;
1357 my $conf = FS::Conf->new;
1358 my $reason_type = $conf->config($mode.'_credit_type');
1360 my $last_bill = $self->getfield('last_bill') || 0;
1361 my $next_bill = $self->getfield('bill') || 0;
1362 if ( $last_bill > 0 # the package has been billed
1363 and $next_bill > 0 # the package has a next bill date
1364 and $next_bill >= $time # which is in the future
1366 my $remaining_value = $self->calc_remain('time' => $time);
1367 if ( $remaining_value > 0 ) {
1368 warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1370 my $error = $self->cust_main->credit(
1372 'Credit for unused time on '. $self->part_pkg->pkg,
1373 'reason_type' => $reason_type,
1375 return "Error crediting customer \$$remaining_value for unused time".
1376 " on ". $self->part_pkg->pkg. ": $error"
1378 } #if $remaining_value
1379 } #if $last_bill, etc.
1383 =item unsuspend [ OPTION => VALUE ... ]
1385 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1386 package, then unsuspends the package itself (clears the susp field and the
1387 adjourn field if it is in the past). If the suspend reason includes an
1388 unsuspension package, that package will be ordered.
1390 Available options are:
1396 Can be set to a date to unsuspend the package in the future (the 'resume'
1399 =item adjust_next_bill
1401 Can be set true to adjust the next bill date forward by
1402 the amount of time the account was inactive. This was set true by default
1403 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
1404 explicitly requested. Price plans for which this makes sense (anniversary-date
1405 based than prorate or subscription) could have an option to enable this
1410 If there is an error, returns the error, otherwise returns false.
1415 my( $self, %opt ) = @_;
1418 # pass all suspend/cancel actions to the main package
1419 if ( $self->main_pkgnum and !$opt{'from_main'} ) {
1420 return $self->main_pkg->unsuspend(%opt);
1423 local $SIG{HUP} = 'IGNORE';
1424 local $SIG{INT} = 'IGNORE';
1425 local $SIG{QUIT} = 'IGNORE';
1426 local $SIG{TERM} = 'IGNORE';
1427 local $SIG{TSTP} = 'IGNORE';
1428 local $SIG{PIPE} = 'IGNORE';
1430 my $oldAutoCommit = $FS::UID::AutoCommit;
1431 local $FS::UID::AutoCommit = 0;
1434 my $old = $self->select_for_update;
1436 my $pkgnum = $old->pkgnum;
1437 if ( $old->get('cancel') || $self->get('cancel') ) {
1438 $dbh->rollback if $oldAutoCommit;
1439 return "Can't unsuspend cancelled package $pkgnum";
1442 unless ( $old->get('susp') && $self->get('susp') ) {
1443 $dbh->rollback if $oldAutoCommit;
1444 return ""; # no error # complain instead?
1447 my $date = $opt{'date'};
1448 if ( $date and $date > time ) { # return an error if $date <= time?
1450 if ( $old->get('expire') && $old->get('expire') < $date ) {
1451 $dbh->rollback if $oldAutoCommit;
1452 return "Package $pkgnum expires before it would be unsuspended.";
1455 my $new = new FS::cust_pkg { $self->hash };
1456 $new->set('resume', $date);
1457 $error = $new->replace($self, options => $self->options);
1460 $dbh->rollback if $oldAutoCommit;
1464 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1472 foreach my $cust_svc (
1473 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1475 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1477 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1478 $dbh->rollback if $oldAutoCommit;
1479 return "Illegal svcdb value in part_svc!";
1482 require "FS/$svcdb.pm";
1484 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1486 $error = $svc->unsuspend;
1488 $dbh->rollback if $oldAutoCommit;
1491 my( $label, $value ) = $cust_svc->label;
1492 push @labels, "$label: $value";
1497 my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
1498 my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
1500 my %hash = $self->hash;
1501 my $inactive = time - $hash{'susp'};
1503 my $conf = new FS::Conf;
1505 if ( $inactive > 0 &&
1506 ( $hash{'bill'} || $hash{'setup'} ) &&
1507 ( $opt{'adjust_next_bill'} ||
1508 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1509 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1512 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1517 $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
1518 $hash{'resume'} = '' if !$hash{'adjourn'};
1519 my $new = new FS::cust_pkg ( \%hash );
1520 $error = $new->replace( $self, options => { $self->options } );
1522 $dbh->rollback if $oldAutoCommit;
1528 if ( $reason && $reason->unsuspend_pkgpart ) {
1529 my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
1530 or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
1532 my $start_date = $self->cust_main->next_bill_date
1533 if $reason->unsuspend_hold;
1536 $unsusp_pkg = FS::cust_pkg->new({
1537 'custnum' => $self->custnum,
1538 'pkgpart' => $reason->unsuspend_pkgpart,
1539 'start_date' => $start_date,
1540 'locationnum' => $self->locationnum,
1541 # discount? probably not...
1544 $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
1548 $dbh->rollback if $oldAutoCommit;
1553 if ( $conf->config('unsuspend_email_admin') ) {
1555 my $error = send_email(
1556 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1557 #invoice_from ??? well as good as any
1558 'to' => $conf->config('unsuspend_email_admin'),
1559 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
1560 "This is an automatic message from your Freeside installation\n",
1561 "informing you that the following customer package has been unsuspended:\n",
1563 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1564 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1565 ( map { "Service : $_\n" } @labels ),
1567 "An unsuspension fee was charged: ".
1568 $unsusp_pkg->part_pkg->pkg_comment."\n"
1575 warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
1581 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1582 $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
1584 $dbh->rollback if $oldAutoCommit;
1585 return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1589 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1596 Cancels any pending suspension (sets the adjourn field to null).
1598 If there is an error, returns the error, otherwise returns false.
1603 my( $self, %options ) = @_;
1606 local $SIG{HUP} = 'IGNORE';
1607 local $SIG{INT} = 'IGNORE';
1608 local $SIG{QUIT} = 'IGNORE';
1609 local $SIG{TERM} = 'IGNORE';
1610 local $SIG{TSTP} = 'IGNORE';
1611 local $SIG{PIPE} = 'IGNORE';
1613 my $oldAutoCommit = $FS::UID::AutoCommit;
1614 local $FS::UID::AutoCommit = 0;
1617 my $old = $self->select_for_update;
1619 my $pkgnum = $old->pkgnum;
1620 if ( $old->get('cancel') || $self->get('cancel') ) {
1621 dbh->rollback if $oldAutoCommit;
1622 return "Can't unadjourn cancelled package $pkgnum";
1623 # or at least it's pointless
1626 if ( $old->get('susp') || $self->get('susp') ) {
1627 dbh->rollback if $oldAutoCommit;
1628 return "Can't unadjourn suspended package $pkgnum";
1629 # perhaps this is arbitrary
1632 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1633 dbh->rollback if $oldAutoCommit;
1634 return ""; # no error
1637 my %hash = $self->hash;
1638 $hash{'adjourn'} = '';
1639 $hash{'resume'} = '';
1640 my $new = new FS::cust_pkg ( \%hash );
1641 $error = $new->replace( $self, options => { $self->options } );
1643 $dbh->rollback if $oldAutoCommit;
1647 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1654 =item change HASHREF | OPTION => VALUE ...
1656 Changes this package: cancels it and creates a new one, with a different
1657 pkgpart or locationnum or both. All services are transferred to the new
1658 package (no change will be made if this is not possible).
1660 Options may be passed as a list of key/value pairs or as a hash reference.
1667 New locationnum, to change the location for this package.
1671 New FS::cust_location object, to create a new location and assign it
1676 New pkgpart (see L<FS::part_pkg>).
1680 New refnum (see L<FS::part_referral>).
1684 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1685 susp, adjourn, cancel, expire, and contract_end) to the new package.
1689 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1690 (otherwise, what's the point?)
1692 Returns either the new FS::cust_pkg object or a scalar error.
1696 my $err_or_new_cust_pkg = $old_cust_pkg->change
1700 #some false laziness w/order
1703 my $opt = ref($_[0]) ? shift : { @_ };
1705 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1708 my $conf = new FS::Conf;
1710 # Transactionize this whole mess
1711 local $SIG{HUP} = 'IGNORE';
1712 local $SIG{INT} = 'IGNORE';
1713 local $SIG{QUIT} = 'IGNORE';
1714 local $SIG{TERM} = 'IGNORE';
1715 local $SIG{TSTP} = 'IGNORE';
1716 local $SIG{PIPE} = 'IGNORE';
1718 my $oldAutoCommit = $FS::UID::AutoCommit;
1719 local $FS::UID::AutoCommit = 0;
1728 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1730 #$hash{$_} = $self->$_() foreach qw( setup );
1732 $hash{'setup'} = $time if $self->setup;
1734 $hash{'change_date'} = $time;
1735 $hash{"change_$_"} = $self->$_()
1736 foreach qw( pkgnum pkgpart locationnum );
1738 if ( $opt->{'cust_location'} &&
1739 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1740 $error = $opt->{'cust_location'}->insert;
1742 $dbh->rollback if $oldAutoCommit;
1743 return "inserting cust_location (transaction rolled back): $error";
1745 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1748 my $unused_credit = 0;
1749 my $keep_dates = $opt->{'keep_dates'};
1750 # Special case. If the pkgpart is changing, and the customer is
1751 # going to be credited for remaining time, don't keep setup, bill,
1752 # or last_bill dates, and DO pass the flag to cancel() to credit
1754 if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
1756 $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
1757 $hash{$_} = '' foreach qw(setup bill last_bill);
1760 if ( $keep_dates ) {
1761 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1762 resume start_date contract_end ) ) {
1763 $hash{$date} = $self->getfield($date);
1766 # allow $opt->{'locationnum'} = '' to specifically set it to null
1767 # (i.e. customer default location)
1768 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
1770 # Create the new package.
1771 my $cust_pkg = new FS::cust_pkg {
1772 custnum => $self->custnum,
1773 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1774 refnum => ( $opt->{'refnum'} || $self->refnum ),
1775 locationnum => ( $opt->{'locationnum'} ),
1778 $error = $cust_pkg->insert( 'change' => 1 );
1780 $dbh->rollback if $oldAutoCommit;
1784 # Transfer services and cancel old package.
1786 $error = $self->transfer($cust_pkg);
1787 if ($error and $error == 0) {
1788 # $old_pkg->transfer failed.
1789 $dbh->rollback if $oldAutoCommit;
1793 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1794 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1795 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1796 if ($error and $error == 0) {
1797 # $old_pkg->transfer failed.
1798 $dbh->rollback if $oldAutoCommit;
1804 # Transfers were successful, but we still had services left on the old
1805 # package. We can't change the package under this circumstances, so abort.
1806 $dbh->rollback if $oldAutoCommit;
1807 return "Unable to transfer all services from package ". $self->pkgnum;
1810 #reset usage if changing pkgpart
1811 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1812 if ($self->pkgpart != $cust_pkg->pkgpart) {
1813 my $part_pkg = $cust_pkg->part_pkg;
1814 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1818 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1821 $dbh->rollback if $oldAutoCommit;
1822 return "Error setting usage values: $error";
1826 # Order any supplemental packages.
1827 my $part_pkg = $cust_pkg->part_pkg;
1828 my @old_supp_pkgs = $self->supplemental_pkgs;
1830 foreach my $link ($part_pkg->supp_part_pkg_link) {
1832 foreach (@old_supp_pkgs) {
1833 if ($_->pkgpart == $link->dst_pkgpart) {
1835 $_->pkgpart(0); # so that it can't match more than once
1839 # false laziness with FS::cust_main::Packages::order_pkg
1840 my $new = FS::cust_pkg->new({
1841 pkgpart => $link->dst_pkgpart,
1842 pkglinknum => $link->pkglinknum,
1843 custnum => $self->custnum,
1844 main_pkgnum => $cust_pkg->pkgnum,
1845 locationnum => $cust_pkg->locationnum,
1846 start_date => $cust_pkg->start_date,
1847 order_date => $cust_pkg->order_date,
1848 expire => $cust_pkg->expire,
1849 adjourn => $cust_pkg->adjourn,
1850 contract_end => $cust_pkg->contract_end,
1851 refnum => $cust_pkg->refnum,
1852 discountnum => $cust_pkg->discountnum,
1853 waive_setup => $cust_pkg->waive_setup
1855 if ( $old and $opt->{'keep_dates'} ) {
1856 foreach (qw(setup bill last_bill)) {
1857 $new->set($_, $old->get($_));
1860 $error = $new->insert;
1863 $error ||= $old->transfer($new);
1865 if ( $error and $error > 0 ) {
1866 # no reason why this should ever fail, but still...
1867 $error = "Unable to transfer all services from supplemental package ".
1871 $dbh->rollback if $oldAutoCommit;
1874 push @new_supp_pkgs, $new;
1877 #Good to go, cancel old package. Notify 'cancel' of whether to credit
1879 #Don't allow billing the package (preceding period packages and/or
1880 #outstanding usage) if we are keeping dates (i.e. location changing),
1881 #because the new package will be billed for the same date range.
1882 #Supplemental packages are also canceled here.
1883 $error = $self->cancel(
1885 unused_credit => $unused_credit,
1886 nobill => $keep_dates
1889 $dbh->rollback if $oldAutoCommit;
1893 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1895 my $error = $cust_pkg->cust_main->bill(
1896 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
1899 $dbh->rollback if $oldAutoCommit;
1904 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1910 use Storable 'thaw';
1912 sub process_bulk_cust_pkg {
1914 my $param = thaw(decode_base64(shift));
1915 warn Dumper($param) if $DEBUG;
1917 my $old_part_pkg = qsearchs('part_pkg',
1918 { pkgpart => $param->{'old_pkgpart'} });
1919 my $new_part_pkg = qsearchs('part_pkg',
1920 { pkgpart => $param->{'new_pkgpart'} });
1921 die "Must select a new package type\n" unless $new_part_pkg;
1922 #my $keep_dates = $param->{'keep_dates'} || 0;
1923 my $keep_dates = 1; # there is no good reason to turn this off
1925 local $SIG{HUP} = 'IGNORE';
1926 local $SIG{INT} = 'IGNORE';
1927 local $SIG{QUIT} = 'IGNORE';
1928 local $SIG{TERM} = 'IGNORE';
1929 local $SIG{TSTP} = 'IGNORE';
1930 local $SIG{PIPE} = 'IGNORE';
1932 my $oldAutoCommit = $FS::UID::AutoCommit;
1933 local $FS::UID::AutoCommit = 0;
1936 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1939 foreach my $old_cust_pkg ( @cust_pkgs ) {
1941 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1942 if ( $old_cust_pkg->getfield('cancel') ) {
1943 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1944 $old_cust_pkg->pkgnum."\n"
1948 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1950 my $error = $old_cust_pkg->change(
1951 'pkgpart' => $param->{'new_pkgpart'},
1952 'keep_dates' => $keep_dates
1954 if ( !ref($error) ) { # change returns the cust_pkg on success
1956 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1959 $dbh->commit if $oldAutoCommit;
1965 Returns the last bill date, or if there is no last bill date, the setup date.
1966 Useful for billing metered services.
1972 return $self->setfield('last_bill', $_[0]) if @_;
1973 return $self->getfield('last_bill') if $self->getfield('last_bill');
1974 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1975 'edate' => $self->bill, } );
1976 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1979 =item last_cust_pkg_reason ACTION
1981 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1982 Returns false if there is no reason or the package is not currenly ACTION'd
1983 ACTION is one of adjourn, susp, cancel, or expire.
1987 sub last_cust_pkg_reason {
1988 my ( $self, $action ) = ( shift, shift );
1989 my $date = $self->get($action);
1991 'table' => 'cust_pkg_reason',
1992 'hashref' => { 'pkgnum' => $self->pkgnum,
1993 'action' => substr(uc($action), 0, 1),
1996 'order_by' => 'ORDER BY num DESC LIMIT 1',
2000 =item last_reason ACTION
2002 Returns the most recent ACTION FS::reason associated with the package.
2003 Returns false if there is no reason or the package is not currenly ACTION'd
2004 ACTION is one of adjourn, susp, cancel, or expire.
2009 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
2010 $cust_pkg_reason->reason
2011 if $cust_pkg_reason;
2016 Returns the definition for this billing item, as an FS::part_pkg object (see
2023 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
2024 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
2025 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
2030 Returns the cancelled package this package was changed from, if any.
2036 return '' unless $self->change_pkgnum;
2037 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
2042 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
2049 $self->part_pkg->calc_setup($self, @_);
2054 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
2061 $self->part_pkg->calc_recur($self, @_);
2066 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
2073 $self->part_pkg->base_recur($self, @_);
2078 Calls the I<calc_remain> of the FS::part_pkg object associated with this
2085 $self->part_pkg->calc_remain($self, @_);
2090 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
2097 $self->part_pkg->calc_cancel($self, @_);
2102 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
2108 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
2111 =item cust_pkg_detail [ DETAILTYPE ]
2113 Returns any customer package details for this package (see
2114 L<FS::cust_pkg_detail>).
2116 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
2120 sub cust_pkg_detail {
2122 my %hash = ( 'pkgnum' => $self->pkgnum );
2123 $hash{detailtype} = shift if @_;
2125 'table' => 'cust_pkg_detail',
2126 'hashref' => \%hash,
2127 'order_by' => 'ORDER BY weight, pkgdetailnum',
2131 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
2133 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
2135 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
2137 If there is an error, returns the error, otherwise returns false.
2141 sub set_cust_pkg_detail {
2142 my( $self, $detailtype, @details ) = @_;
2144 local $SIG{HUP} = 'IGNORE';
2145 local $SIG{INT} = 'IGNORE';
2146 local $SIG{QUIT} = 'IGNORE';
2147 local $SIG{TERM} = 'IGNORE';
2148 local $SIG{TSTP} = 'IGNORE';
2149 local $SIG{PIPE} = 'IGNORE';
2151 my $oldAutoCommit = $FS::UID::AutoCommit;
2152 local $FS::UID::AutoCommit = 0;
2155 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
2156 my $error = $current->delete;
2158 $dbh->rollback if $oldAutoCommit;
2159 return "error removing old detail: $error";
2163 foreach my $detail ( @details ) {
2164 my $cust_pkg_detail = new FS::cust_pkg_detail {
2165 'pkgnum' => $self->pkgnum,
2166 'detailtype' => $detailtype,
2167 'detail' => $detail,
2169 my $error = $cust_pkg_detail->insert;
2171 $dbh->rollback if $oldAutoCommit;
2172 return "error adding new detail: $error";
2177 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2184 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
2188 #false laziness w/cust_bill.pm
2192 'table' => 'cust_event',
2193 'addl_from' => 'JOIN part_event USING ( eventpart )',
2194 'hashref' => { 'tablenum' => $self->pkgnum },
2195 'extra_sql' => " AND eventtable = 'cust_pkg' ",
2199 =item num_cust_event
2201 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
2205 #false laziness w/cust_bill.pm
2206 sub num_cust_event {
2209 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
2210 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
2211 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
2212 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
2213 $sth->fetchrow_arrayref->[0];
2216 =item cust_svc [ SVCPART ] (old, deprecated usage)
2218 =item cust_svc [ OPTION => VALUE ... ] (current usage)
2220 Returns the services for this package, as FS::cust_svc objects (see
2221 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
2222 spcififed, returns only the matching services.
2229 return () unless $self->num_cust_svc(@_);
2232 if ( @_ && $_[0] =~ /^\d+/ ) {
2233 $opt{svcpart} = shift;
2234 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2241 'table' => 'cust_svc',
2242 'hashref' => { 'pkgnum' => $self->pkgnum },
2244 if ( $opt{svcpart} ) {
2245 $search{hashref}->{svcpart} = $opt{'svcpart'};
2247 if ( $opt{'svcdb'} ) {
2248 $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
2249 $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{'svcdb'} );
2252 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
2254 #if ( $self->{'_svcnum'} ) {
2255 # values %{ $self->{'_svcnum'}->cache };
2257 $self->_sort_cust_svc( [ qsearch(\%search) ] );
2262 =item overlimit [ SVCPART ]
2264 Returns the services for this package which have exceeded their
2265 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
2266 is specified, return only the matching services.
2272 return () unless $self->num_cust_svc(@_);
2273 grep { $_->overlimit } $self->cust_svc(@_);
2276 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2278 Returns historical services for this package created before END TIMESTAMP and
2279 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
2280 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
2281 I<pkg_svc.hidden> flag will be omitted.
2287 warn "$me _h_cust_svc called on $self\n"
2290 my ($end, $start, $mode) = @_;
2291 my @cust_svc = $self->_sort_cust_svc(
2292 [ qsearch( 'h_cust_svc',
2293 { 'pkgnum' => $self->pkgnum, },
2294 FS::h_cust_svc->sql_h_search(@_),
2297 if ( defined($mode) && $mode eq 'I' ) {
2298 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
2299 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
2305 sub _sort_cust_svc {
2306 my( $self, $arrayref ) = @_;
2309 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
2314 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
2315 'svcpart' => $_->svcpart } );
2317 $pkg_svc ? $pkg_svc->primary_svc : '',
2318 $pkg_svc ? $pkg_svc->quantity : 0,
2325 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
2327 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
2329 Returns the number of services for this package. Available options are svcpart
2330 and svcdb. If either is spcififed, returns only the matching services.
2337 return $self->{'_num_cust_svc'}
2339 && exists($self->{'_num_cust_svc'})
2340 && $self->{'_num_cust_svc'} =~ /\d/;
2342 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
2346 if ( @_ && $_[0] =~ /^\d+/ ) {
2347 $opt{svcpart} = shift;
2348 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2354 my $select = 'SELECT COUNT(*) FROM cust_svc ';
2355 my $where = ' WHERE pkgnum = ? ';
2356 my @param = ($self->pkgnum);
2358 if ( $opt{'svcpart'} ) {
2359 $where .= ' AND svcpart = ? ';
2360 push @param, $opt{'svcpart'};
2362 if ( $opt{'svcdb'} ) {
2363 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
2364 $where .= ' AND svcdb = ? ';
2365 push @param, $opt{'svcdb'};
2368 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
2369 $sth->execute(@param) or die $sth->errstr;
2370 $sth->fetchrow_arrayref->[0];
2373 =item available_part_svc
2375 Returns a list of FS::part_svc objects representing services included in this
2376 package but not yet provisioned. Each FS::part_svc object also has an extra
2377 field, I<num_avail>, which specifies the number of available services.
2381 sub available_part_svc {
2384 my $pkg_quantity = $self->quantity || 1;
2386 grep { $_->num_avail > 0 }
2388 my $part_svc = $_->part_svc;
2389 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
2390 $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
2392 # more evil encapsulation breakage
2393 if($part_svc->{'Hash'}{'num_avail'} > 0) {
2394 my @exports = $part_svc->part_export_did;
2395 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
2400 $self->part_pkg->pkg_svc;
2403 =item part_svc [ OPTION => VALUE ... ]
2405 Returns a list of FS::part_svc objects representing provisioned and available
2406 services included in this package. Each FS::part_svc object also has the
2407 following extra fields:
2411 =item num_cust_svc (count)
2413 =item num_avail (quantity - count)
2415 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
2419 Accepts one option: summarize_size. If specified and non-zero, will omit the
2420 extra cust_pkg_svc option for objects where num_cust_svc is this size or
2426 #label -> ($cust_svc->label)[1]
2432 my $pkg_quantity = $self->quantity || 1;
2434 #XXX some sort of sort order besides numeric by svcpart...
2435 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
2437 my $part_svc = $pkg_svc->part_svc;
2438 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2439 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
2440 $part_svc->{'Hash'}{'num_avail'} =
2441 max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
2442 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2443 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
2444 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
2445 && $num_cust_svc >= $opt{summarize_size};
2446 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
2448 } $self->part_pkg->pkg_svc;
2451 push @part_svc, map {
2453 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2454 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
2455 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
2456 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2457 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
2459 } $self->extra_part_svc;
2465 =item extra_part_svc
2467 Returns a list of FS::part_svc objects corresponding to services in this
2468 package which are still provisioned but not (any longer) available in the
2473 sub extra_part_svc {
2476 my $pkgnum = $self->pkgnum;
2477 #my $pkgpart = $self->pkgpart;
2480 # 'table' => 'part_svc',
2483 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
2484 # WHERE pkg_svc.svcpart = part_svc.svcpart
2485 # AND pkg_svc.pkgpart = ?
2488 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
2489 # LEFT JOIN cust_pkg USING ( pkgnum )
2490 # WHERE cust_svc.svcpart = part_svc.svcpart
2493 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
2496 #seems to benchmark slightly faster... (or did?)
2498 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
2499 my $pkgparts = join(',', @pkgparts);
2502 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
2503 #MySQL doesn't grok DISINCT ON
2504 'select' => 'DISTINCT part_svc.*',
2505 'table' => 'part_svc',
2507 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
2508 AND pkg_svc.pkgpart IN ($pkgparts)
2511 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
2512 LEFT JOIN cust_pkg USING ( pkgnum )
2515 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
2516 'extra_param' => [ [$self->pkgnum=>'int'] ],
2522 Returns a short status string for this package, currently:
2526 =item not yet billed
2528 =item one-time charge
2543 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
2545 return 'cancelled' if $self->get('cancel');
2546 return 'suspended' if $self->susp;
2547 return 'not yet billed' unless $self->setup;
2548 return 'one-time charge' if $freq =~ /^(0|$)/;
2552 =item ucfirst_status
2554 Returns the status with the first character capitalized.
2558 sub ucfirst_status {
2559 ucfirst(shift->status);
2564 Class method that returns the list of possible status strings for packages
2565 (see L<the status method|/status>). For example:
2567 @statuses = FS::cust_pkg->statuses();
2571 tie my %statuscolor, 'Tie::IxHash',
2572 'not yet billed' => '009999', #teal? cyan?
2573 'one-time charge' => '000000',
2574 'active' => '00CC00',
2575 'suspended' => 'FF9900',
2576 'cancelled' => 'FF0000',
2580 my $self = shift; #could be class...
2581 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2582 # # mayble split btw one-time vs. recur
2588 Returns a hex triplet color string for this package's status.
2594 $statuscolor{$self->status};
2599 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
2600 "pkg-comment" depending on user preference).
2606 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2607 $label = $self->pkgnum. ": $label"
2608 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2612 =item pkg_label_long
2614 Returns a long label for this package, adding the primary service's label to
2619 sub pkg_label_long {
2621 my $label = $self->pkg_label;
2622 my $cust_svc = $self->primary_cust_svc;
2623 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2627 =item primary_cust_svc
2629 Returns a primary service (as FS::cust_svc object) if one can be identified.
2633 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2635 sub primary_cust_svc {
2638 my @cust_svc = $self->cust_svc;
2640 return '' unless @cust_svc; #no serivces - irrelevant then
2642 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2644 # primary service as specified in the package definition
2645 # or exactly one service definition with quantity one
2646 my $svcpart = $self->part_pkg->svcpart;
2647 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2648 return $cust_svc[0] if scalar(@cust_svc) == 1;
2650 #couldn't identify one thing..
2656 Returns a list of lists, calling the label method for all services
2657 (see L<FS::cust_svc>) of this billing item.
2663 map { [ $_->label ] } $self->cust_svc;
2666 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2668 Like the labels method, but returns historical information on services that
2669 were active as of END_TIMESTAMP and (optionally) not cancelled before
2670 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
2671 I<pkg_svc.hidden> flag will be omitted.
2673 Returns a list of lists, calling the label method for all (historical) services
2674 (see L<FS::h_cust_svc>) of this billing item.
2680 warn "$me _h_labels called on $self\n"
2682 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2687 Like labels, except returns a simple flat list, and shortens long
2688 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2689 identical services to one line that lists the service label and the number of
2690 individual services rather than individual items.
2695 shift->_labels_short( 'labels', @_ );
2698 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2700 Like h_labels, except returns a simple flat list, and shortens long
2701 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2702 identical services to one line that lists the service label and the number of
2703 individual services rather than individual items.
2707 sub h_labels_short {
2708 shift->_labels_short( 'h_labels', @_ );
2712 my( $self, $method ) = ( shift, shift );
2714 warn "$me _labels_short called on $self with $method method\n"
2717 my $conf = new FS::Conf;
2718 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2720 warn "$me _labels_short populating \%labels\n"
2724 #tie %labels, 'Tie::IxHash';
2725 push @{ $labels{$_->[0]} }, $_->[1]
2726 foreach $self->$method(@_);
2728 warn "$me _labels_short populating \@labels\n"
2732 foreach my $label ( keys %labels ) {
2734 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2735 my $num = scalar(@values);
2736 warn "$me _labels_short $num items for $label\n"
2739 if ( $num > $max_same_services ) {
2740 warn "$me _labels_short more than $max_same_services, so summarizing\n"
2742 push @labels, "$label ($num)";
2744 if ( $conf->exists('cust_bill-consolidate_services') ) {
2745 warn "$me _labels_short consolidating services\n"
2747 # push @labels, "$label: ". join(', ', @values);
2749 my $detail = "$label: ";
2750 $detail .= shift(@values). ', '
2752 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
2754 push @labels, $detail;
2756 warn "$me _labels_short done consolidating services\n"
2759 warn "$me _labels_short adding service data\n"
2761 push @labels, map { "$label: $_" } @values;
2772 Returns the parent customer object (see L<FS::cust_main>).
2778 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2783 Returns the balance for this specific package, when using
2784 experimental package balance.
2790 $self->cust_main->balance_pkgnum( $self->pkgnum );
2793 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2797 Returns the location object, if any (see L<FS::cust_location>).
2799 =item cust_location_or_main
2801 If this package is associated with a location, returns the locaiton (see
2802 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2804 =item location_label [ OPTION => VALUE ... ]
2806 Returns the label of the location object (see L<FS::cust_location>).
2810 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2812 =item tax_locationnum
2814 Returns the foreign key to a L<FS::cust_location> object for calculating
2815 tax on this package, as determined by the C<tax-pkg_address> and
2816 C<tax-ship_address> configuration flags.
2820 sub tax_locationnum {
2822 my $conf = FS::Conf->new;
2823 if ( $conf->exists('tax-pkg_address') ) {
2824 return $self->locationnum;
2826 elsif ( $conf->exists('tax-ship_address') ) {
2827 return $self->cust_main->ship_locationnum;
2830 return $self->cust_main->bill_locationnum;
2836 Returns the L<FS::cust_location> object for tax_locationnum.
2842 FS::cust_location->by_key( $self->tax_locationnum )
2845 =item seconds_since TIMESTAMP
2847 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2848 package have been online since TIMESTAMP, according to the session monitor.
2850 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2851 L<Time::Local> and L<Date::Parse> for conversion functions.
2856 my($self, $since) = @_;
2859 foreach my $cust_svc (
2860 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2862 $seconds += $cust_svc->seconds_since($since);
2869 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2871 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2872 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2875 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2876 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2882 sub seconds_since_sqlradacct {
2883 my($self, $start, $end) = @_;
2887 foreach my $cust_svc (
2889 my $part_svc = $_->part_svc;
2890 $part_svc->svcdb eq 'svc_acct'
2891 && scalar($part_svc->part_export_usage);
2894 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2901 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2903 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2904 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2908 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2909 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2914 sub attribute_since_sqlradacct {
2915 my($self, $start, $end, $attrib) = @_;
2919 foreach my $cust_svc (
2921 my $part_svc = $_->part_svc;
2922 $part_svc->svcdb eq 'svc_acct'
2923 && scalar($part_svc->part_export_usage);
2926 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2938 my( $self, $value ) = @_;
2939 if ( defined($value) ) {
2940 $self->setfield('quantity', $value);
2942 $self->getfield('quantity') || 1;
2945 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2947 Transfers as many services as possible from this package to another package.
2949 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2950 object. The destination package must already exist.
2952 Services are moved only if the destination allows services with the correct
2953 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2954 this option with caution! No provision is made for export differences
2955 between the old and new service definitions. Probably only should be used
2956 when your exports for all service definitions of a given svcdb are identical.
2957 (attempt a transfer without it first, to move all possible svcpart-matching
2960 Any services that can't be moved remain in the original package.
2962 Returns an error, if there is one; otherwise, returns the number of services
2963 that couldn't be moved.
2968 my ($self, $dest_pkgnum, %opt) = @_;
2974 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2975 $dest = $dest_pkgnum;
2976 $dest_pkgnum = $dest->pkgnum;
2978 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2981 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2983 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2984 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2987 foreach my $cust_svc ($dest->cust_svc) {
2988 $target{$cust_svc->svcpart}--;
2991 my %svcpart2svcparts = ();
2992 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2993 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2994 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2995 next if exists $svcpart2svcparts{$svcpart};
2996 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2997 $svcpart2svcparts{$svcpart} = [
2999 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
3001 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
3002 'svcpart' => $_ } );
3004 $pkg_svc ? $pkg_svc->primary_svc : '',
3005 $pkg_svc ? $pkg_svc->quantity : 0,
3009 grep { $_ != $svcpart }
3011 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
3013 warn "alternates for svcpart $svcpart: ".
3014 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
3019 foreach my $cust_svc ($self->cust_svc) {
3020 if($target{$cust_svc->svcpart} > 0
3021 or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
3022 $target{$cust_svc->svcpart}--;
3023 my $new = new FS::cust_svc { $cust_svc->hash };
3024 $new->pkgnum($dest_pkgnum);
3025 my $error = $new->replace($cust_svc);
3026 return $error if $error;
3027 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
3029 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
3030 warn "alternates to consider: ".
3031 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
3033 my @alternate = grep {
3034 warn "considering alternate svcpart $_: ".
3035 "$target{$_} available in new package\n"
3038 } @{$svcpart2svcparts{$cust_svc->svcpart}};
3040 warn "alternate(s) found\n" if $DEBUG;
3041 my $change_svcpart = $alternate[0];
3042 $target{$change_svcpart}--;
3043 my $new = new FS::cust_svc { $cust_svc->hash };
3044 $new->svcpart($change_svcpart);
3045 $new->pkgnum($dest_pkgnum);
3046 my $error = $new->replace($cust_svc);
3047 return $error if $error;
3060 This method is deprecated. See the I<depend_jobnum> option to the insert and
3061 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
3068 local $SIG{HUP} = 'IGNORE';
3069 local $SIG{INT} = 'IGNORE';
3070 local $SIG{QUIT} = 'IGNORE';
3071 local $SIG{TERM} = 'IGNORE';
3072 local $SIG{TSTP} = 'IGNORE';
3073 local $SIG{PIPE} = 'IGNORE';
3075 my $oldAutoCommit = $FS::UID::AutoCommit;
3076 local $FS::UID::AutoCommit = 0;
3079 foreach my $cust_svc ( $self->cust_svc ) {
3080 #false laziness w/svc_Common::insert
3081 my $svc_x = $cust_svc->svc_x;
3082 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
3083 my $error = $part_export->export_insert($svc_x);
3085 $dbh->rollback if $oldAutoCommit;
3091 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3098 Associates this package with a (suspension or cancellation) reason (see
3099 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
3102 Available options are:
3108 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.
3112 the access_user (see L<FS::access_user>) providing the reason
3120 the action (cancel, susp, adjourn, expire) associated with the reason
3124 If there is an error, returns the error, otherwise returns false.
3129 my ($self, %options) = @_;
3131 my $otaker = $options{reason_otaker} ||
3132 $FS::CurrentUser::CurrentUser->username;
3135 if ( $options{'reason'} =~ /^(\d+)$/ ) {
3139 } elsif ( ref($options{'reason'}) ) {
3141 return 'Enter a new reason (or select an existing one)'
3142 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
3144 my $reason = new FS::reason({
3145 'reason_type' => $options{'reason'}->{'typenum'},
3146 'reason' => $options{'reason'}->{'reason'},
3148 my $error = $reason->insert;
3149 return $error if $error;
3151 $reasonnum = $reason->reasonnum;
3154 return "Unparsable reason: ". $options{'reason'};
3157 my $cust_pkg_reason =
3158 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
3159 'reasonnum' => $reasonnum,
3160 'otaker' => $otaker,
3161 'action' => substr(uc($options{'action'}),0,1),
3162 'date' => $options{'date'}
3167 $cust_pkg_reason->insert;
3170 =item insert_discount
3172 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
3173 inserting a new discount on the fly (see L<FS::discount>).
3175 Available options are:
3183 If there is an error, returns the error, otherwise returns false.
3187 sub insert_discount {
3188 #my ($self, %options) = @_;
3191 my $cust_pkg_discount = new FS::cust_pkg_discount {
3192 'pkgnum' => $self->pkgnum,
3193 'discountnum' => $self->discountnum,
3195 'end_date' => '', #XXX
3196 #for the create a new discount case
3197 '_type' => $self->discountnum__type,
3198 'amount' => $self->discountnum_amount,
3199 'percent' => $self->discountnum_percent,
3200 'months' => $self->discountnum_months,
3201 'setup' => $self->discountnum_setup,
3202 #'disabled' => $self->discountnum_disabled,
3205 $cust_pkg_discount->insert;
3208 =item set_usage USAGE_VALUE_HASHREF
3210 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3211 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3212 upbytes, downbytes, and totalbytes are appropriate keys.
3214 All svc_accts which are part of this package have their values reset.
3219 my ($self, $valueref, %opt) = @_;
3221 #only svc_acct can set_usage for now
3222 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
3223 my $svc_x = $cust_svc->svc_x;
3224 $svc_x->set_usage($valueref, %opt)
3225 if $svc_x->can("set_usage");
3229 =item recharge USAGE_VALUE_HASHREF
3231 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
3232 to which they should be set (see L<FS::svc_acct>). Currently seconds,
3233 upbytes, downbytes, and totalbytes are appropriate keys.
3235 All svc_accts which are part of this package have their values incremented.
3240 my ($self, $valueref) = @_;
3242 #only svc_acct can set_usage for now
3243 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
3244 my $svc_x = $cust_svc->svc_x;
3245 $svc_x->recharge($valueref)
3246 if $svc_x->can("recharge");
3250 =item cust_pkg_discount
3254 sub cust_pkg_discount {
3256 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
3259 =item cust_pkg_discount_active
3263 sub cust_pkg_discount_active {
3265 grep { $_->status eq 'active' } $self->cust_pkg_discount;
3270 =item supplemental_pkgs
3272 Returns a list of all packages supplemental to this one.
3276 sub supplemental_pkgs {
3278 qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
3283 Returns the package that this one is supplemental to, if any.
3289 if ( $self->main_pkgnum ) {
3290 return FS::cust_pkg->by_key($self->main_pkgnum);
3295 =head1 CLASS METHODS
3301 Returns an SQL expression identifying recurring packages.
3305 sub recurring_sql { "
3306 '0' != ( select freq from part_pkg
3307 where cust_pkg.pkgpart = part_pkg.pkgpart )
3312 Returns an SQL expression identifying one-time packages.
3317 '0' = ( select freq from part_pkg
3318 where cust_pkg.pkgpart = part_pkg.pkgpart )
3323 Returns an SQL expression identifying ordered packages (recurring packages not
3329 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
3334 Returns an SQL expression identifying active packages.
3339 $_[0]->recurring_sql. "
3340 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
3341 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3342 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3345 =item not_yet_billed_sql
3347 Returns an SQL expression identifying packages which have not yet been billed.
3351 sub not_yet_billed_sql { "
3352 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
3353 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3354 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3359 Returns an SQL expression identifying inactive packages (one-time packages
3360 that are otherwise unsuspended/uncancelled).
3364 sub inactive_sql { "
3365 ". $_[0]->onetime_sql(). "
3366 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
3367 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3368 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3374 Returns an SQL expression identifying suspended packages.
3378 sub suspended_sql { susp_sql(@_); }
3380 #$_[0]->recurring_sql(). ' AND '.
3382 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3383 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
3390 Returns an SQL exprression identifying cancelled packages.
3394 sub cancelled_sql { cancel_sql(@_); }
3396 #$_[0]->recurring_sql(). ' AND '.
3397 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
3402 Returns an SQL expression to give the package status as a string.
3408 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
3409 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
3410 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
3411 WHEN ".onetime_sql()." THEN 'one-time charge'
3416 =item search HASHREF
3420 Returns a qsearch hash expression to search for parameters specified in HASHREF.
3421 Valid parameters are
3429 active, inactive, suspended, cancel (or cancelled)
3433 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
3437 boolean selects custom packages
3443 pkgpart or arrayref or hashref of pkgparts
3447 arrayref of beginning and ending epoch date
3451 arrayref of beginning and ending epoch date
3455 arrayref of beginning and ending epoch date
3459 arrayref of beginning and ending epoch date
3463 arrayref of beginning and ending epoch date
3467 arrayref of beginning and ending epoch date
3471 arrayref of beginning and ending epoch date
3475 pkgnum or APKG_pkgnum
3479 a value suited to passing to FS::UI::Web::cust_header
3483 specifies the user for agent virtualization
3487 boolean; if true, returns only packages with more than 0 FCC phone lines.
3489 =item state, country
3491 Limit to packages with a service location in the specified state and country.
3492 For FCC 477 reporting, mostly.
3499 my ($class, $params) = @_;
3506 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
3508 "cust_main.agentnum = $1";
3515 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
3517 "cust_pkg.custnum = $1";
3524 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
3526 "cust_pkg.pkgbatch = '$1'";
3533 if ( $params->{'magic'} eq 'active'
3534 || $params->{'status'} eq 'active' ) {
3536 push @where, FS::cust_pkg->active_sql();
3538 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
3539 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
3541 push @where, FS::cust_pkg->not_yet_billed_sql();
3543 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
3544 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
3546 push @where, FS::cust_pkg->inactive_sql();
3548 } elsif ( $params->{'magic'} eq 'suspended'
3549 || $params->{'status'} eq 'suspended' ) {
3551 push @where, FS::cust_pkg->suspended_sql();
3553 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
3554 || $params->{'status'} =~ /^cancell?ed$/ ) {
3556 push @where, FS::cust_pkg->cancelled_sql();
3561 # parse package class
3564 if ( exists($params->{'classnum'}) ) {
3567 if ( ref($params->{'classnum'}) ) {
3569 if ( ref($params->{'classnum'}) eq 'HASH' ) {
3570 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
3571 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
3572 @classnum = @{ $params->{'classnum'} };
3574 die 'unhandled classnum ref '. $params->{'classnum'};
3578 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
3585 my @nums = grep $_, @classnum;
3586 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
3587 my $null = scalar( grep { $_ eq '' } @classnum );
3588 push @c_where, 'part_pkg.classnum IS NULL' if $null;
3590 if ( scalar(@c_where) == 1 ) {
3591 push @where, @c_where;
3592 } elsif ( @c_where ) {
3593 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
3602 # parse package report options
3605 my @report_option = ();
3606 if ( exists($params->{'report_option'}) ) {
3607 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
3608 @report_option = @{ $params->{'report_option'} };
3609 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
3610 @report_option = split(',', $1);
3615 if (@report_option) {
3616 # this will result in the empty set for the dangling comma case as it should
3618 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3619 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3620 AND optionname = 'report_option_$_'
3621 AND optionvalue = '1' )"
3625 foreach my $any ( grep /^report_option_any/, keys %$params ) {
3627 my @report_option_any = ();
3628 if ( ref($params->{$any}) eq 'ARRAY' ) {
3629 @report_option_any = @{ $params->{$any} };
3630 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
3631 @report_option_any = split(',', $1);
3634 if (@report_option_any) {
3635 # this will result in the empty set for the dangling comma case as it should
3636 push @where, ' ( '. join(' OR ',
3637 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3638 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3639 AND optionname = 'report_option_$_'
3640 AND optionvalue = '1' )"
3641 } @report_option_any
3651 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
3657 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
3658 if $params->{fcc_line};
3664 if ( exists($params->{'censustract'}) ) {
3665 $params->{'censustract'} =~ /^([.\d]*)$/;
3666 my $censustract = "cust_location.censustract = '$1'";
3667 $censustract .= ' OR cust_location.censustract is NULL' unless $1;
3668 push @where, "( $censustract )";
3672 # parse censustract2
3674 if ( exists($params->{'censustract2'})
3675 && $params->{'censustract2'} =~ /^(\d*)$/
3679 push @where, "cust_location.censustract LIKE '$1%'";
3682 "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
3687 # parse country/state
3689 for (qw(state country)) { # parsing rules are the same for these
3690 if ( exists($params->{$_})
3691 && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
3693 # XXX post-2.3 only--before that, state/country may be in cust_main
3694 push @where, "cust_location.$_ = '$1'";
3702 if ( ref($params->{'pkgpart'}) ) {
3705 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3706 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3707 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3708 @pkgpart = @{ $params->{'pkgpart'} };
3710 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3713 @pkgpart = grep /^(\d+)$/, @pkgpart;
3715 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3717 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3718 push @where, "pkgpart = $1";
3727 #false laziness w/report_cust_pkg.html
3730 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3731 'active' => { 'susp'=>1, 'cancel'=>1 },
3732 'suspended' => { 'cancel' => 1 },
3737 if( exists($params->{'active'} ) ) {
3738 # This overrides all the other date-related fields
3739 my($beginning, $ending) = @{$params->{'active'}};
3741 "cust_pkg.setup IS NOT NULL",
3742 "cust_pkg.setup <= $ending",
3743 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3744 "NOT (".FS::cust_pkg->onetime_sql . ")";
3747 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
3749 next unless exists($params->{$field});
3751 my($beginning, $ending) = @{$params->{$field}};
3753 next if $beginning == 0 && $ending == 4294967295;
3756 "cust_pkg.$field IS NOT NULL",
3757 "cust_pkg.$field >= $beginning",
3758 "cust_pkg.$field <= $ending";
3760 $orderby ||= "ORDER BY cust_pkg.$field";
3765 $orderby ||= 'ORDER BY bill';
3768 # parse magic, legacy, etc.
3771 if ( $params->{'magic'} &&
3772 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3775 $orderby = 'ORDER BY pkgnum';
3777 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3778 push @where, "pkgpart = $1";
3781 } elsif ( $params->{'query'} eq 'pkgnum' ) {
3783 $orderby = 'ORDER BY pkgnum';
3785 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3787 $orderby = 'ORDER BY pkgnum';
3790 SELECT count(*) FROM pkg_svc
3791 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
3792 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3793 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
3794 AND cust_svc.svcpart = pkg_svc.svcpart
3801 # setup queries, links, subs, etc. for the search
3804 # here is the agent virtualization
3805 if ($params->{CurrentUser}) {
3807 qsearchs('access_user', { username => $params->{CurrentUser} });
3810 push @where, $access_user->agentnums_sql('table'=>'cust_main');
3815 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3818 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3820 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
3821 'LEFT JOIN part_pkg USING ( pkgpart ) '.
3822 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
3823 'LEFT JOIN cust_location USING ( locationnum ) ';
3827 if ( $params->{'select_zip5'} ) {
3828 my $zip = 'cust_location.zip';
3830 $select = "DISTINCT substr($zip,1,5) as zip";
3831 $orderby = "ORDER BY substr($zip,1,5)";
3832 $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
3834 $select = join(', ',
3836 ( map "part_pkg.$_", qw( pkg freq ) ),
3837 'pkg_class.classname',
3838 'cust_main.custnum AS cust_main_custnum',
3839 FS::UI::Web::cust_sql_fields(
3840 $params->{'cust_fields'}
3843 $count_query = 'SELECT COUNT(*)';
3846 $count_query .= " FROM cust_pkg $addl_from $extra_sql";
3849 'table' => 'cust_pkg',
3851 'select' => $select,
3852 'extra_sql' => $extra_sql,
3853 'order_by' => $orderby,
3854 'addl_from' => $addl_from,
3855 'count_query' => $count_query,
3862 Returns a list of two package counts. The first is a count of packages
3863 based on the supplied criteria and the second is the count of residential
3864 packages with those same criteria. Criteria are specified as in the search
3870 my ($class, $params) = @_;
3872 my $sql_query = $class->search( $params );
3874 my $count_sql = delete($sql_query->{'count_query'});
3875 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3876 or die "couldn't parse count_sql";
3878 my $count_sth = dbh->prepare($count_sql)
3879 or die "Error preparing $count_sql: ". dbh->errstr;
3881 or die "Error executing $count_sql: ". $count_sth->errstr;
3882 my $count_arrayref = $count_sth->fetchrow_arrayref;
3884 return ( @$count_arrayref );
3888 =item tax_locationnum_sql
3890 Returns an SQL expression for the tax location for a package, based
3891 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
3895 sub tax_locationnum_sql {
3896 my $conf = FS::Conf->new;
3897 if ( $conf->exists('tax-pkg_address') ) {
3898 'cust_pkg.locationnum';
3900 elsif ( $conf->exists('tax-ship_address') ) {
3901 'cust_main.ship_locationnum';
3904 'cust_main.bill_locationnum';
3910 Returns a list: the first item is an SQL fragment identifying matching
3911 packages/customers via location (taking into account shipping and package
3912 address taxation, if enabled), and subsequent items are the parameters to
3913 substitute for the placeholders in that fragment.
3918 my($class, %opt) = @_;
3919 my $ornull = $opt{'ornull'};
3921 my $conf = new FS::Conf;
3923 # '?' placeholders in _location_sql_where
3924 my $x = $ornull ? 3 : 2;
3935 if ( $conf->exists('tax-ship_address') ) {
3938 ( ( ship_last IS NULL OR ship_last = '' )
3939 AND ". _location_sql_where('cust_main', '', $ornull ). "
3941 OR ( ship_last IS NOT NULL AND ship_last != ''
3942 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3945 # AND payby != 'COMP'
3947 @main_param = ( @bill_param, @bill_param );
3951 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3952 @main_param = @bill_param;
3958 if ( $conf->exists('tax-pkg_address') ) {
3960 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3963 ( cust_pkg.locationnum IS NULL AND $main_where )
3964 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3967 @param = ( @main_param, @bill_param );
3971 $where = $main_where;
3972 @param = @main_param;
3980 #subroutine, helper for location_sql
3981 sub _location_sql_where {
3983 my $prefix = @_ ? shift : '';
3984 my $ornull = @_ ? shift : '';
3986 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3988 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3990 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
3991 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
3992 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
3994 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
3996 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3998 ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
3999 AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL )
4000 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
4001 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
4002 AND $table.${prefix}country = ?
4007 my( $self, $what ) = @_;
4009 my $what_show_zero = $what. '_show_zero';
4010 length($self->$what_show_zero())
4011 ? ($self->$what_show_zero() eq 'Y')
4012 : $self->part_pkg->$what_show_zero();
4019 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
4021 CUSTNUM is a customer (see L<FS::cust_main>)
4023 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4024 L<FS::part_pkg>) to order for this customer. Duplicates are of course
4027 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
4028 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
4029 new billing items. An error is returned if this is not possible (see
4030 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
4033 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
4034 newly-created cust_pkg objects.
4036 REFNUM, if specified, will specify the FS::pkg_referral record to be created
4037 and inserted. Multiple FS::pkg_referral records can be created by
4038 setting I<refnum> to an array reference of refnums or a hash reference with
4039 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
4040 record will be created corresponding to cust_main.refnum.
4045 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
4047 my $conf = new FS::Conf;
4049 # Transactionize this whole mess
4050 local $SIG{HUP} = 'IGNORE';
4051 local $SIG{INT} = 'IGNORE';
4052 local $SIG{QUIT} = 'IGNORE';
4053 local $SIG{TERM} = 'IGNORE';
4054 local $SIG{TSTP} = 'IGNORE';
4055 local $SIG{PIPE} = 'IGNORE';
4057 my $oldAutoCommit = $FS::UID::AutoCommit;
4058 local $FS::UID::AutoCommit = 0;
4062 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
4063 # return "Customer not found: $custnum" unless $cust_main;
4065 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
4068 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
4071 my $change = scalar(@old_cust_pkg) != 0;
4074 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
4076 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
4077 " to pkgpart ". $pkgparts->[0]. "\n"
4080 my $err_or_cust_pkg =
4081 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
4082 'refnum' => $refnum,
4085 unless (ref($err_or_cust_pkg)) {
4086 $dbh->rollback if $oldAutoCommit;
4087 return $err_or_cust_pkg;
4090 push @$return_cust_pkg, $err_or_cust_pkg;
4091 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4096 # Create the new packages.
4097 foreach my $pkgpart (@$pkgparts) {
4099 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
4101 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
4102 pkgpart => $pkgpart,
4106 $error = $cust_pkg->insert( 'change' => $change );
4107 push @$return_cust_pkg, $cust_pkg;
4109 foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
4110 my $supp_pkg = FS::cust_pkg->new({
4111 custnum => $custnum,
4112 pkgpart => $link->dst_pkgpart,
4114 main_pkgnum => $cust_pkg->pkgnum,
4117 $error ||= $supp_pkg->insert( 'change' => $change );
4118 push @$return_cust_pkg, $supp_pkg;
4122 $dbh->rollback if $oldAutoCommit;
4127 # $return_cust_pkg now contains refs to all of the newly
4130 # Transfer services and cancel old packages.
4131 foreach my $old_pkg (@old_cust_pkg) {
4133 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
4136 foreach my $new_pkg (@$return_cust_pkg) {
4137 $error = $old_pkg->transfer($new_pkg);
4138 if ($error and $error == 0) {
4139 # $old_pkg->transfer failed.
4140 $dbh->rollback if $oldAutoCommit;
4145 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
4146 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
4147 foreach my $new_pkg (@$return_cust_pkg) {
4148 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
4149 if ($error and $error == 0) {
4150 # $old_pkg->transfer failed.
4151 $dbh->rollback if $oldAutoCommit;
4158 # Transfers were successful, but we went through all of the
4159 # new packages and still had services left on the old package.
4160 # We can't cancel the package under the circumstances, so abort.
4161 $dbh->rollback if $oldAutoCommit;
4162 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
4164 $error = $old_pkg->cancel( quiet=>1 );
4170 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4174 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
4176 A bulk change method to change packages for multiple customers.
4178 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
4179 L<FS::part_pkg>) to order for each customer. Duplicates are of course
4182 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
4183 replace. The services (see L<FS::cust_svc>) are moved to the
4184 new billing items. An error is returned if this is not possible (see
4187 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
4188 newly-created cust_pkg objects.
4193 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
4195 # Transactionize this whole mess
4196 local $SIG{HUP} = 'IGNORE';
4197 local $SIG{INT} = 'IGNORE';
4198 local $SIG{QUIT} = 'IGNORE';
4199 local $SIG{TERM} = 'IGNORE';
4200 local $SIG{TSTP} = 'IGNORE';
4201 local $SIG{PIPE} = 'IGNORE';
4203 my $oldAutoCommit = $FS::UID::AutoCommit;
4204 local $FS::UID::AutoCommit = 0;
4208 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
4211 while(scalar(@old_cust_pkg)) {
4213 my $custnum = $old_cust_pkg[0]->custnum;
4214 my (@remove) = map { $_->pkgnum }
4215 grep { $_->custnum == $custnum } @old_cust_pkg;
4216 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
4218 my $error = order $custnum, $pkgparts, \@remove, \@return;
4220 push @errors, $error
4222 push @$return_cust_pkg, @return;
4225 if (scalar(@errors)) {
4226 $dbh->rollback if $oldAutoCommit;
4227 return join(' / ', @errors);
4230 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4234 # Used by FS::Upgrade to migrate to a new database.
4235 sub _upgrade_data { # class method
4236 my ($class, %opts) = @_;
4237 $class->_upgrade_otaker(%opts);
4239 # RT#10139, bug resulting in contract_end being set when it shouldn't
4240 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
4241 # RT#10830, bad calculation of prorate date near end of year
4242 # the date range for bill is December 2009, and we move it forward
4243 # one year if it's before the previous bill date (which it should
4245 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
4246 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
4247 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
4248 # RT6628, add order_date to cust_pkg
4249 'update cust_pkg set order_date = (select history_date from h_cust_pkg
4250 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
4251 history_action = \'insert\') where order_date is null',
4253 foreach my $sql (@statements) {
4254 my $sth = dbh->prepare($sql);
4255 $sth->execute or die $sth->errstr;
4263 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
4265 In sub order, the @pkgparts array (passed by reference) is clobbered.
4267 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
4268 method to pass dates to the recur_prog expression, it should do so.
4270 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
4271 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
4272 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
4273 configuration values. Probably need a subroutine which decides what to do
4274 based on whether or not we've fetched the user yet, rather than a hash. See
4275 FS::UID and the TODO.
4277 Now that things are transactional should the check in the insert method be
4282 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
4283 L<FS::pkg_svc>, schema.html from the base documentation