2 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::Sales_Mixin
3 FS::contact_Mixin FS::location_Mixin
4 FS::m2m_Common FS::option_Common );
7 use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
9 use Scalar::Util qw( blessed );
10 use List::Util qw(min max);
12 use Time::Local qw( timelocal timelocal_nocheck );
14 use FS::UID qw( getotaker dbh driver_name );
15 use FS::Misc qw( send_email );
16 use FS::Record qw( qsearch qsearchs fields );
22 use FS::cust_location;
24 use FS::cust_bill_pkg;
25 use FS::cust_pkg_detail;
26 use FS::cust_pkg_usage;
27 use FS::cdr_cust_pkg_usage;
32 use FS::cust_pkg_reason;
34 use FS::cust_pkg_discount;
41 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
43 # because they load configuration by setting FS::UID::callback (see TODO)
49 # for sending cancel emails in sub cancel
53 $me = '[FS::cust_pkg]';
55 $disable_agentcheck = 0;
57 $upgrade = 0; #go away after setup+start dates cleaned up for old customers
59 our $cache_enabled = 0;
62 my( $self, $hashref ) = @_;
63 if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
64 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
70 my ( $hashref, $cache ) = @_;
71 # #if ( $hashref->{'pkgpart'} ) {
72 # if ( $hashref->{'pkg'} ) {
73 # # #@{ $self->{'_pkgnum'} } = ();
74 # # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
75 # # $self->{'_pkgpart'} = $subcache;
76 # # #push @{ $self->{'_pkgnum'} },
77 # # FS::part_pkg->new_or_cached($hashref, $subcache);
78 # $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
80 if ( exists $hashref->{'svcnum'} ) {
81 #@{ $self->{'_pkgnum'} } = ();
82 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
83 $self->{'_svcnum'} = $subcache;
84 #push @{ $self->{'_pkgnum'} },
85 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
91 FS::cust_pkg - Object methods for cust_pkg objects
97 $record = new FS::cust_pkg \%hash;
98 $record = new FS::cust_pkg { 'column' => 'value' };
100 $error = $record->insert;
102 $error = $new_record->replace($old_record);
104 $error = $record->delete;
106 $error = $record->check;
108 $error = $record->cancel;
110 $error = $record->suspend;
112 $error = $record->unsuspend;
114 $part_pkg = $record->part_pkg;
116 @labels = $record->labels;
118 $seconds = $record->seconds_since($timestamp);
120 #bulk cancel+order... perhaps slightly deprecated, only used by the bulk
121 # cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
122 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
123 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
127 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
128 inherits from FS::Record. The following fields are currently supported:
134 Primary key (assigned automatically for new billing items)
138 Customer (see L<FS::cust_main>)
142 Billing item definition (see L<FS::part_pkg>)
146 Optional link to package location (see L<FS::location>)
150 date package was ordered (also remains same on changes)
162 date (next bill date)
190 order taker (see L<FS::access_user>)
194 If not set, defaults to 1
198 Date of change from previous package
208 =item change_locationnum
216 The pkgnum of the package that this package is supplemental to, if any.
220 The package link (L<FS::part_pkg_link>) that defines this supplemental
221 package, if it is one.
223 =item change_to_pkgnum
225 The pkgnum of the package this one will be "changed to" in the future
226 (on its expiration date).
230 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
231 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
232 L<Time::Local> and L<Date::Parse> for conversion functions.
240 Create a new billing item. To add the item to the database, see L<"insert">.
244 sub table { 'cust_pkg'; }
245 sub cust_linked { $_[0]->cust_main_custnum || $_[0]->custnum }
246 sub cust_unlinked_msg {
248 "WARNING: can't find cust_main.custnum ". $self->custnum.
249 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
252 =item set_initial_timers
254 If required by the package definition, sets any automatic expire, adjourn,
255 or contract_end timers to some number of months after the start date
256 (or setup date, if the package has already been setup). If the package has
257 a delayed setup fee after a period of "free days", will also set the
258 start date to the end of that period.
262 sub set_initial_timers {
264 my $part_pkg = $self->part_pkg;
265 foreach my $action ( qw(expire adjourn contract_end) ) {
266 my $months = $part_pkg->option("${action}_months",1);
267 if($months and !$self->get($action)) {
268 my $start = $self->start_date || $self->setup || time;
269 $self->set($action, $part_pkg->add_freq($start, $months) );
273 # if this package has "free days" and delayed setup fee, then
274 # set start date that many days in the future.
275 # (this should have been set in the UI, but enforce it here)
276 if ( $part_pkg->option('free_days',1)
277 && $part_pkg->option('delay_setup',1)
280 $self->start_date( $part_pkg->default_start_date );
285 =item insert [ OPTION => VALUE ... ]
287 Adds this billing item to the database ("Orders" the item). If there is an
288 error, returns the error, otherwise returns false.
290 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
291 will be used to look up the package definition and agent restrictions will be
294 If the additional field I<refnum> is defined, an FS::pkg_referral record will
295 be created and inserted. Multiple FS::pkg_referral records can be created by
296 setting I<refnum> to an array reference of refnums or a hash reference with
297 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
298 record will be created corresponding to cust_main.refnum.
300 The following options are available:
306 If set true, supresses actions that should only be taken for new package
307 orders. (Currently this includes: intro periods when delay_setup is on,
308 auto-adding a 1st start date, auto-adding expiration/adjourn/contract_end dates)
312 cust_pkg_option records will be created
316 a ticket will be added to this customer with this subject
320 an optional queue name for ticket additions
324 Don't check the legality of the package definition. This should be used
325 when performing a package change that doesn't change the pkgpart (i.e.
333 my( $self, %options ) = @_;
336 $error = $self->check_pkgpart unless $options{'allow_pkgpart'};
337 return $error if $error;
339 my $part_pkg = $self->part_pkg;
341 if ( ! $options{'change'} ) {
343 # set order date to now
344 $self->order_date(time);
346 # if the package def says to start only on the first of the month:
347 if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
348 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
349 $mon += 1 unless $mday == 1;
350 until ( $mon < 12 ) { $mon -= 12; $year++; }
351 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
354 if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
355 # if the package was ordered on hold:
357 # - don't set the start date (it will be started manually)
358 $self->set('susp', $self->order_date);
359 $self->set('start_date', '');
361 # set expire/adjourn/contract_end timers, and free days, if appropriate
362 $self->set_initial_timers;
364 } # else this is a package change, and shouldn't have "new package" behavior
366 local $SIG{HUP} = 'IGNORE';
367 local $SIG{INT} = 'IGNORE';
368 local $SIG{QUIT} = 'IGNORE';
369 local $SIG{TERM} = 'IGNORE';
370 local $SIG{TSTP} = 'IGNORE';
371 local $SIG{PIPE} = 'IGNORE';
373 my $oldAutoCommit = $FS::UID::AutoCommit;
374 local $FS::UID::AutoCommit = 0;
377 $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
379 $dbh->rollback if $oldAutoCommit;
383 $self->refnum($self->cust_main->refnum) unless $self->refnum;
384 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
385 $self->process_m2m( 'link_table' => 'pkg_referral',
386 'target_table' => 'part_referral',
387 'params' => $self->refnum,
390 if ( $self->discountnum ) {
391 my $error = $self->insert_discount();
393 $dbh->rollback if $oldAutoCommit;
398 my $conf = new FS::Conf;
400 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
402 #this init stuff is still inefficient, but at least its limited to
403 # the small number (any?) folks using ticket emailing on pkg order
406 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
413 use FS::TicketSystem;
414 FS::TicketSystem->init();
416 my $q = new RT::Queue($RT::SystemUser);
417 $q->Load($options{ticket_queue}) if $options{ticket_queue};
418 my $t = new RT::Ticket($RT::SystemUser);
419 my $mime = new MIME::Entity;
420 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
421 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
422 Subject => $options{ticket_subject},
425 $t->AddLink( Type => 'MemberOf',
426 Target => 'freeside://freeside/cust_main/'. $self->custnum,
430 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
431 my $queue = new FS::queue {
432 'job' => 'FS::cust_main::queueable_print',
434 $error = $queue->insert(
435 'custnum' => $self->custnum,
436 'template' => 'welcome_letter',
440 warn "can't send welcome letter: $error";
445 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
452 This method now works but you probably shouldn't use it.
454 You don't want to delete packages, because there would then be no record
455 the customer ever purchased the package. Instead, see the cancel method and
456 hide cancelled packages.
463 local $SIG{HUP} = 'IGNORE';
464 local $SIG{INT} = 'IGNORE';
465 local $SIG{QUIT} = 'IGNORE';
466 local $SIG{TERM} = 'IGNORE';
467 local $SIG{TSTP} = 'IGNORE';
468 local $SIG{PIPE} = 'IGNORE';
470 my $oldAutoCommit = $FS::UID::AutoCommit;
471 local $FS::UID::AutoCommit = 0;
474 foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
475 my $error = $cust_pkg_discount->delete;
477 $dbh->rollback if $oldAutoCommit;
481 #cust_bill_pkg_discount?
483 foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
484 my $error = $cust_pkg_detail->delete;
486 $dbh->rollback if $oldAutoCommit;
491 foreach my $cust_pkg_reason (
493 'table' => 'cust_pkg_reason',
494 'hashref' => { 'pkgnum' => $self->pkgnum },
498 my $error = $cust_pkg_reason->delete;
500 $dbh->rollback if $oldAutoCommit;
507 my $error = $self->SUPER::delete(@_);
509 $dbh->rollback if $oldAutoCommit;
513 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
519 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
521 Replaces the OLD_RECORD with this one in the database. If there is an error,
522 returns the error, otherwise returns false.
524 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
526 Changing pkgpart may have disasterous effects. See the order subroutine.
528 setup and bill are normally updated by calling the bill method of a customer
529 object (see L<FS::cust_main>).
531 suspend is normally updated by the suspend and unsuspend methods.
533 cancel is normally updated by the cancel method (and also the order subroutine
536 Available options are:
542 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.
546 the access_user (see L<FS::access_user>) providing the reason
550 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
559 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
564 ( ref($_[0]) eq 'HASH' )
568 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
569 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
572 #return "Can't change setup once it exists!"
573 # if $old->getfield('setup') &&
574 # $old->getfield('setup') != $new->getfield('setup');
576 #some logic for bill, susp, cancel?
578 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
580 local $SIG{HUP} = 'IGNORE';
581 local $SIG{INT} = 'IGNORE';
582 local $SIG{QUIT} = 'IGNORE';
583 local $SIG{TERM} = 'IGNORE';
584 local $SIG{TSTP} = 'IGNORE';
585 local $SIG{PIPE} = 'IGNORE';
587 my $oldAutoCommit = $FS::UID::AutoCommit;
588 local $FS::UID::AutoCommit = 0;
591 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
592 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
593 my $error = $new->insert_reason(
594 'reason' => $options->{'reason'},
595 'date' => $new->$method,
597 'reason_otaker' => $options->{'reason_otaker'},
600 dbh->rollback if $oldAutoCommit;
601 return "Error inserting cust_pkg_reason: $error";
606 #save off and freeze RADIUS attributes for any associated svc_acct records
608 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
610 #also check for specific exports?
611 # to avoid spurious modify export events
612 @svc_acct = map { $_->svc_x }
613 grep { $_->part_svc->svcdb eq 'svc_acct' }
616 $_->snapshot foreach @svc_acct;
620 my $error = $new->export_pkg_change($old)
621 || $new->SUPER::replace( $old,
623 ? $options->{options}
627 $dbh->rollback if $oldAutoCommit;
631 #for prepaid packages,
632 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
633 foreach my $old_svc_acct ( @svc_acct ) {
634 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
636 $new_svc_acct->replace( $old_svc_acct,
637 'depend_jobnum' => $options->{depend_jobnum},
640 $dbh->rollback if $oldAutoCommit;
645 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
652 Checks all fields to make sure this is a valid billing item. If there is an
653 error, returns the error, otherwise returns false. Called by the insert and
661 if ( !$self->locationnum or $self->locationnum == -1 ) {
662 $self->set('locationnum', $self->cust_main->ship_locationnum);
666 $self->ut_numbern('pkgnum')
667 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
668 || $self->ut_numbern('pkgpart')
669 || $self->ut_foreign_keyn('contactnum', 'contact', 'contactnum' )
670 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
671 || $self->ut_foreign_keyn('salesnum', 'sales', 'salesnum')
672 || $self->ut_numbern('quantity')
673 || $self->ut_numbern('start_date')
674 || $self->ut_numbern('setup')
675 || $self->ut_numbern('bill')
676 || $self->ut_numbern('susp')
677 || $self->ut_numbern('cancel')
678 || $self->ut_numbern('adjourn')
679 || $self->ut_numbern('resume')
680 || $self->ut_numbern('expire')
681 || $self->ut_numbern('dundate')
682 || $self->ut_flag('no_auto', [ '', 'Y' ])
683 || $self->ut_flag('waive_setup', [ '', 'Y' ])
684 || $self->ut_flag('separate_bill')
685 || $self->ut_textn('agent_pkgid')
686 || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
687 || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
688 || $self->ut_foreign_keyn('main_pkgnum', 'cust_pkg', 'pkgnum')
689 || $self->ut_foreign_keyn('pkglinknum', 'part_pkg_link', 'pkglinknum')
690 || $self->ut_foreign_keyn('change_to_pkgnum', 'cust_pkg', 'pkgnum')
692 return $error if $error;
694 return "A package with both start date (future start) and setup date (already started) will never bill"
695 if $self->start_date && $self->setup && ! $upgrade;
697 return "A future unsuspend date can only be set for a package with a suspend date"
698 if $self->resume and !$self->susp and !$self->adjourn;
700 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
702 if ( $self->dbdef_table->column('manual_flag') ) {
703 $self->manual_flag('') if $self->manual_flag eq ' ';
704 $self->manual_flag =~ /^([01]?)$/
705 or return "Illegal manual_flag ". $self->manual_flag;
706 $self->manual_flag($1);
714 Check the pkgpart to make sure it's allowed with the reg_code and/or
715 promo_code of the package (if present) and with the customer's agent.
716 Called from C<insert>, unless we are doing a package change that doesn't
724 # my $error = $self->ut_numbern('pkgpart'); # already done
727 if ( $self->reg_code ) {
729 unless ( grep { $self->pkgpart == $_->pkgpart }
730 map { $_->reg_code_pkg }
731 qsearchs( 'reg_code', { 'code' => $self->reg_code,
732 'agentnum' => $self->cust_main->agentnum })
734 return "Unknown registration code";
737 } elsif ( $self->promo_code ) {
740 qsearchs('part_pkg', {
741 'pkgpart' => $self->pkgpart,
742 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
744 return 'Unknown promotional code' unless $promo_part_pkg;
748 unless ( $disable_agentcheck ) {
750 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
751 return "agent ". $agent->agentnum. ':'. $agent->agent.
752 " can't purchase pkgpart ". $self->pkgpart
753 unless $agent->pkgpart_hashref->{ $self->pkgpart }
754 || $agent->agentnum == $self->part_pkg->agentnum;
757 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
758 return $error if $error;
766 =item cancel [ OPTION => VALUE ... ]
768 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
769 in this package, then cancels the package itself (sets the cancel field to
772 Available options are:
776 =item quiet - can be set true to supress email cancellation notices.
778 =item time - can be set to cancel the package based on a specific future or
779 historical date. Using time ensures that the remaining amount is calculated
780 correctly. Note however that this is an immediate cancel and just changes
781 the date. You are PROBABLY looking to expire the account instead of using
784 =item reason - can be set to a cancellation reason (see L<FS:reason>),
785 either a reasonnum of an existing reason, or passing a hashref will create
786 a new reason. The hashref should have the following keys: typenum - Reason
787 type (see L<FS::reason_type>, reason - Text of the new reason.
789 =item date - can be set to a unix style timestamp to specify when to
792 =item nobill - can be set true to skip billing if it might otherwise be done.
794 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
795 not credit it. This must be set (by change()) when changing the package
796 to a different pkgpart or location, and probably shouldn't be in any other
797 case. If it's not set, the 'unused_credit_cancel' part_pkg option will
800 =item no_delay_cancel - prevents delay_cancel behavior
801 no matter what other options say, for use when changing packages (or any
802 other time you're really sure you want an immediate cancel)
806 If there is an error, returns the error, otherwise returns false.
810 #NOT DOCUMENTING - this should only be used when calling recursively
811 #=item delay_cancel - for internal use, to allow proper handling of
812 #supplemental packages when the main package is flagged to suspend
813 #before cancelling, probably shouldn't be used otherwise (set the
814 #corresponding package option instead)
817 my( $self, %options ) = @_;
820 # pass all suspend/cancel actions to the main package
821 # (unless the pkglinknum has been removed, then the link is defunct and
822 # this package can be canceled on its own)
823 if ( $self->main_pkgnum and $self->pkglinknum and !$options{'from_main'} ) {
824 return $self->main_pkg->cancel(%options);
827 my $conf = new FS::Conf;
829 warn "cust_pkg::cancel called with options".
830 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
833 local $SIG{HUP} = 'IGNORE';
834 local $SIG{INT} = 'IGNORE';
835 local $SIG{QUIT} = 'IGNORE';
836 local $SIG{TERM} = 'IGNORE';
837 local $SIG{TSTP} = 'IGNORE';
838 local $SIG{PIPE} = 'IGNORE';
840 my $oldAutoCommit = $FS::UID::AutoCommit;
841 local $FS::UID::AutoCommit = 0;
844 my $old = $self->select_for_update;
846 if ( $old->get('cancel') || $self->get('cancel') ) {
847 dbh->rollback if $oldAutoCommit;
848 return ""; # no error
851 # XXX possibly set cancel_time to the expire date?
852 my $cancel_time = $options{'time'} || time;
853 my $date = $options{'date'} if $options{'date'}; # expire/cancel later
854 $date = '' if ($date && $date <= $cancel_time); # complain instead?
856 my $delay_cancel = $options{'no_delay_cancel'} ? 0 : $options{'delay_cancel'};
857 if ( !$date && $self->part_pkg->option('delay_cancel',1)
858 && (($self->status eq 'active') || ($self->status eq 'suspended'))
859 && !$options{'no_delay_cancel'}
861 my $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
862 my $expsecs = 60*60*24*$expdays;
863 my $suspfor = $self->susp ? $cancel_time - $self->susp : 0;
864 $expsecs = $expsecs - $suspfor if $suspfor;
865 unless ($expsecs <= 0) { #if it's already been suspended long enough, don't re-suspend
867 $date = $cancel_time + $expsecs;
871 #race condition: usage could be ongoing until unprovisioned
872 #resolved by performing a change package instead (which unprovisions) and
874 if ( !$options{nobill} && !$date ) {
875 # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
876 my $copy = $self->new({$self->hash});
878 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
880 'time' => $cancel_time );
881 warn "Error billing during cancel, custnum ".
882 #$self->cust_main->custnum. ": $error"
887 if ( $options{'reason'} ) {
888 $error = $self->insert_reason( 'reason' => $options{'reason'},
889 'action' => $date ? 'expire' : 'cancel',
890 'date' => $date ? $date : $cancel_time,
891 'reason_otaker' => $options{'reason_otaker'},
894 dbh->rollback if $oldAutoCommit;
895 return "Error inserting cust_pkg_reason: $error";
899 my %svc_cancel_opt = ();
900 $svc_cancel_opt{'date'} = $date if $date;
901 foreach my $cust_svc (
904 sort { $a->[1] <=> $b->[1] }
905 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
906 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
908 my $part_svc = $cust_svc->part_svc;
909 next if ( defined($part_svc) and $part_svc->preserve );
910 my $error = $cust_svc->cancel( %svc_cancel_opt );
913 $dbh->rollback if $oldAutoCommit;
914 return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
919 # if a reasonnum was passed, get the actual reason object so we can check
923 if ($options{'reason'} =~ /^\d+$/) {
924 $reason = FS::reason->by_key($options{'reason'});
928 # credit remaining time if any of these are true:
929 # - unused_credit => 1 was passed (this happens when canceling a package
930 # for a package change when unused_credit_change is set)
931 # - no unused_credit option, and there is a cancel reason, and the cancel
932 # reason says to credit the package
933 # - no unused_credit option, and the package definition says to credit the
934 # package on cancellation
936 if ( exists($options{'unused_credit'}) ) {
937 $do_credit = $options{'unused_credit'};
938 } elsif ( defined($reason) && $reason->unused_credit ) {
941 $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
944 my $error = $self->credit_remaining('cancel', $cancel_time);
946 $dbh->rollback if $oldAutoCommit;
952 my %hash = $self->hash;
954 $hash{'expire'} = $date;
956 # just to be sure these are clear
957 $hash{'adjourn'} = undef;
958 $hash{'resume'} = undef;
961 $hash{'cancel'} = $cancel_time;
963 $hash{'change_custnum'} = $options{'change_custnum'};
965 # if this is a supplemental package that's lost its part_pkg_link, and it's
966 # being canceled for real, unlink it completely
967 if ( !$date and ! $self->pkglinknum ) {
968 $hash{main_pkgnum} = '';
971 my $new = new FS::cust_pkg ( \%hash );
972 $error = $new->replace( $self, options => { $self->options } );
973 if ( $self->change_to_pkgnum ) {
974 my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
975 $error ||= $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete;
978 $dbh->rollback if $oldAutoCommit;
982 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
983 $error = $supp_pkg->cancel(%options,
985 'date' => $date, #in case it got changed by delay_cancel
986 'delay_cancel' => $delay_cancel,
989 $dbh->rollback if $oldAutoCommit;
990 return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
994 if ($delay_cancel && !$options{'from_main'}) {
995 $error = $new->suspend(
997 'time' => $cancel_time
1002 foreach my $usage ( $self->cust_pkg_usage ) {
1003 $error = $usage->delete;
1005 $dbh->rollback if $oldAutoCommit;
1006 return "deleting usage pools: $error";
1011 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1012 return '' if $date; #no errors
1014 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
1015 if ( !$options{'quiet'} &&
1016 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
1018 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
1021 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
1022 $error = $msg_template->send( 'cust_main' => $self->cust_main,
1023 'object' => $self );
1026 $error = send_email(
1027 'from' => $conf->invoice_from_full( $self->cust_main->agentnum ),
1028 'to' => \@invoicing_list,
1029 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
1030 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
1031 'custnum' => $self->custnum,
1032 'msgtype' => '', #admin?
1035 #should this do something on errors?
1042 =item cancel_if_expired [ NOW_TIMESTAMP ]
1044 Cancels this package if its expire date has been reached.
1048 sub cancel_if_expired {
1050 my $time = shift || time;
1051 return '' unless $self->expire && $self->expire <= $time;
1052 my $error = $self->cancel;
1054 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
1055 $self->custnum. ": $error";
1062 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
1063 locationnum, (other fields?). Attempts to re-provision cancelled services
1064 using history information (errors at this stage are not fatal).
1066 cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
1068 svc_fatal: service provisioning errors are fatal
1070 svc_errors: pass an array reference, will be filled in with any provisioning errors
1072 main_pkgnum: link the package as a supplemental package of this one. For
1078 my( $self, %options ) = @_;
1080 #in case you try do do $uncancel-date = $cust_pkg->uncacel
1081 return '' unless $self->get('cancel');
1083 if ( $self->main_pkgnum and !$options{'main_pkgnum'} ) {
1084 return $self->main_pkg->uncancel(%options);
1091 local $SIG{HUP} = 'IGNORE';
1092 local $SIG{INT} = 'IGNORE';
1093 local $SIG{QUIT} = 'IGNORE';
1094 local $SIG{TERM} = 'IGNORE';
1095 local $SIG{TSTP} = 'IGNORE';
1096 local $SIG{PIPE} = 'IGNORE';
1098 my $oldAutoCommit = $FS::UID::AutoCommit;
1099 local $FS::UID::AutoCommit = 0;
1103 # insert the new package
1106 my $cust_pkg = new FS::cust_pkg {
1107 last_bill => ( $options{'last_bill'} || $self->get('last_bill') ),
1108 bill => ( $options{'bill'} || $self->get('bill') ),
1110 uncancel_pkgnum => $self->pkgnum,
1111 main_pkgnum => ($options{'main_pkgnum'} || ''),
1112 map { $_ => $self->get($_) } qw(
1113 custnum pkgpart locationnum
1115 susp adjourn resume expire start_date contract_end dundate
1116 change_date change_pkgpart change_locationnum
1117 manual_flag no_auto separate_bill quantity agent_pkgid
1118 recur_show_zero setup_show_zero
1122 my $error = $cust_pkg->insert(
1123 'change' => 1, #supresses any referral credit to a referring customer
1124 'allow_pkgpart' => 1, # allow this even if the package def is disabled
1127 $dbh->rollback if $oldAutoCommit;
1135 #find historical services within this timeframe before the package cancel
1136 # (incompatible with "time" option to cust_pkg->cancel?)
1137 my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
1138 # too little? (unprovisioing export delay?)
1139 my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
1140 my @h_cust_svc = $self->h_cust_svc( $end, $start );
1143 foreach my $h_cust_svc (@h_cust_svc) {
1144 my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
1145 #next unless $h_svc_x; #should this happen?
1146 (my $table = $h_svc_x->table) =~ s/^h_//;
1147 require "FS/$table.pm";
1148 my $class = "FS::$table";
1149 my $svc_x = $class->new( {
1150 'pkgnum' => $cust_pkg->pkgnum,
1151 'svcpart' => $h_cust_svc->svcpart,
1152 map { $_ => $h_svc_x->get($_) } fields($table)
1156 if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
1157 $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
1160 my $svc_error = $svc_x->insert;
1162 if ( $options{svc_fatal} ) {
1163 $dbh->rollback if $oldAutoCommit;
1166 # if we've failed to insert the svc_x object, svc_Common->insert
1167 # will have removed the cust_svc already. if not, then both records
1168 # were inserted but we failed for some other reason (export, most
1169 # likely). in that case, report the error and delete the records.
1170 push @svc_errors, $svc_error;
1171 my $cust_svc = qsearchs('cust_svc', { 'svcnum' => $svc_x->svcnum });
1173 # except if export_insert failed, export_delete probably won't be
1175 local $FS::svc_Common::noexport_hack = 1;
1176 my $cleanup_error = $svc_x->delete; # also deletes cust_svc
1177 if ( $cleanup_error ) { # and if THAT fails, then run away
1178 $dbh->rollback if $oldAutoCommit;
1179 return $cleanup_error;
1184 } #foreach $h_cust_svc
1186 #these are pretty rare, but should handle them
1187 # - dsl_device (mac addresses)
1188 # - phone_device (mac addresses)
1189 # - dsl_note (ikano notes)
1190 # - domain_record (i.e. restore DNS information w/domains)
1191 # - inventory_item(?) (inventory w/un-cancelling service?)
1192 # - nas (svc_broaband nas stuff)
1193 #this stuff is unused in the wild afaik
1194 # - mailinglistmember
1196 # - svc_domain.parent_svcnum?
1197 # - acct_snarf (ancient mail fetching config)
1198 # - cgp_rule (communigate)
1199 # - cust_svc_option (used by our Tron stuff)
1200 # - acct_rt_transaction (used by our time worked stuff)
1203 # also move over any services that didn't unprovision at cancellation
1206 foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
1207 $cust_svc->pkgnum( $cust_pkg->pkgnum );
1208 my $error = $cust_svc->replace;
1210 $dbh->rollback if $oldAutoCommit;
1216 # Uncancel any supplemental packages, and make them supplemental to the
1220 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1222 $error = $supp_pkg->uncancel(%options, 'main_pkgnum' => $cust_pkg->pkgnum);
1224 $dbh->rollback if $oldAutoCommit;
1225 return "canceling supplemental pkg#".$supp_pkg->pkgnum.": $error";
1233 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1235 ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg});
1236 @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
1243 Cancels any pending expiration (sets the expire field to null).
1245 If there is an error, returns the error, otherwise returns false.
1250 my( $self, %options ) = @_;
1253 local $SIG{HUP} = 'IGNORE';
1254 local $SIG{INT} = 'IGNORE';
1255 local $SIG{QUIT} = 'IGNORE';
1256 local $SIG{TERM} = 'IGNORE';
1257 local $SIG{TSTP} = 'IGNORE';
1258 local $SIG{PIPE} = 'IGNORE';
1260 my $oldAutoCommit = $FS::UID::AutoCommit;
1261 local $FS::UID::AutoCommit = 0;
1264 my $old = $self->select_for_update;
1266 my $pkgnum = $old->pkgnum;
1267 if ( $old->get('cancel') || $self->get('cancel') ) {
1268 dbh->rollback if $oldAutoCommit;
1269 return "Can't unexpire cancelled package $pkgnum";
1270 # or at least it's pointless
1273 unless ( $old->get('expire') && $self->get('expire') ) {
1274 dbh->rollback if $oldAutoCommit;
1275 return ""; # no error
1278 my %hash = $self->hash;
1279 $hash{'expire'} = '';
1280 my $new = new FS::cust_pkg ( \%hash );
1281 $error = $new->replace( $self, options => { $self->options } );
1283 $dbh->rollback if $oldAutoCommit;
1287 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1293 =item suspend [ OPTION => VALUE ... ]
1295 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1296 package, then suspends the package itself (sets the susp field to now).
1298 Available options are:
1302 =item reason - can be set to a cancellation reason (see L<FS:reason>),
1303 either a reasonnum of an existing reason, or passing a hashref will create
1304 a new reason. The hashref should have the following keys:
1305 - typenum - Reason type (see L<FS::reason_type>
1306 - reason - Text of the new reason.
1308 =item date - can be set to a unix style timestamp to specify when to
1311 =item time - can be set to override the current time, for calculation
1312 of final invoices or unused-time credits
1314 =item resume_date - can be set to a time when the package should be
1315 unsuspended. This may be more convenient than calling C<unsuspend()>
1318 =item from_main - allows a supplemental package to be suspended, rather
1319 than redirecting the method call to its main package. For internal use.
1321 =item from_cancel - used when suspending from the cancel method, forces
1322 this to skip everything besides basic suspension. For internal use.
1326 If there is an error, returns the error, otherwise returns false.
1331 my( $self, %options ) = @_;
1334 # pass all suspend/cancel actions to the main package
1335 if ( $self->main_pkgnum and !$options{'from_main'} ) {
1336 return $self->main_pkg->suspend(%options);
1339 local $SIG{HUP} = 'IGNORE';
1340 local $SIG{INT} = 'IGNORE';
1341 local $SIG{QUIT} = 'IGNORE';
1342 local $SIG{TERM} = 'IGNORE';
1343 local $SIG{TSTP} = 'IGNORE';
1344 local $SIG{PIPE} = 'IGNORE';
1346 my $oldAutoCommit = $FS::UID::AutoCommit;
1347 local $FS::UID::AutoCommit = 0;
1350 my $old = $self->select_for_update;
1352 my $pkgnum = $old->pkgnum;
1353 if ( $old->get('cancel') || $self->get('cancel') ) {
1354 dbh->rollback if $oldAutoCommit;
1355 return "Can't suspend cancelled package $pkgnum";
1358 if ( $old->get('susp') || $self->get('susp') ) {
1359 dbh->rollback if $oldAutoCommit;
1360 return ""; # no error # complain on adjourn?
1363 my $suspend_time = $options{'time'} || time;
1364 my $date = $options{date} if $options{date}; # adjourn/suspend later
1365 $date = '' if ($date && $date <= $suspend_time); # complain instead?
1367 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
1368 dbh->rollback if $oldAutoCommit;
1369 return "Package $pkgnum expires before it would be suspended.";
1372 # some false laziness with sub cancel
1373 if ( !$options{nobill} && !$date && !$options{'from_cancel'} &&
1374 $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1375 # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
1376 # make the entire cust_main->bill path recognize 'suspend' and
1377 # 'cancel' separately.
1378 warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1379 my $copy = $self->new({$self->hash});
1381 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
1383 'time' => $suspend_time );
1384 warn "Error billing during suspend, custnum ".
1385 #$self->cust_main->custnum. ": $error"
1390 my $cust_pkg_reason;
1391 if ( $options{'reason'} ) {
1392 $error = $self->insert_reason( 'reason' => $options{'reason'},
1393 'action' => $date ? 'adjourn' : 'suspend',
1394 'date' => $date ? $date : $suspend_time,
1395 'reason_otaker' => $options{'reason_otaker'},
1398 dbh->rollback if $oldAutoCommit;
1399 return "Error inserting cust_pkg_reason: $error";
1401 $cust_pkg_reason = qsearchs('cust_pkg_reason', {
1402 'date' => $date ? $date : $suspend_time,
1403 'action' => $date ? 'A' : 'S',
1404 'pkgnum' => $self->pkgnum,
1408 # if a reasonnum was passed, get the actual reason object so we can check
1410 # (passing a reason hashref is still allowed, but it can't be used with
1411 # the fancy behavioral options.)
1414 if ($options{'reason'} =~ /^\d+$/) {
1415 $reason = FS::reason->by_key($options{'reason'});
1418 my %hash = $self->hash;
1420 $hash{'adjourn'} = $date;
1422 $hash{'susp'} = $suspend_time;
1425 my $resume_date = $options{'resume_date'} || 0;
1426 if ( $resume_date > ($date || $suspend_time) ) {
1427 $hash{'resume'} = $resume_date;
1430 $options{options} ||= {};
1432 my $new = new FS::cust_pkg ( \%hash );
1433 $error = $new->replace( $self, options => { $self->options,
1434 %{ $options{options} },
1438 $dbh->rollback if $oldAutoCommit;
1442 unless ( $date ) { # then we are suspending now
1444 unless ($options{'from_cancel'}) {
1445 # credit remaining time if appropriate
1446 # (if required by the package def, or the suspend reason)
1447 my $unused_credit = $self->part_pkg->option('unused_credit_suspend',1)
1448 || ( defined($reason) && $reason->unused_credit );
1450 if ( $unused_credit ) {
1451 warn "crediting unused time on pkg#".$self->pkgnum."\n" if $DEBUG;
1452 my $error = $self->credit_remaining('suspend', $suspend_time);
1454 $dbh->rollback if $oldAutoCommit;
1462 foreach my $cust_svc (
1463 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
1465 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1467 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1468 $dbh->rollback if $oldAutoCommit;
1469 return "Illegal svcdb value in part_svc!";
1472 require "FS/$svcdb.pm";
1474 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1476 $error = $svc->suspend;
1478 $dbh->rollback if $oldAutoCommit;
1481 my( $label, $value ) = $cust_svc->label;
1482 push @labels, "$label: $value";
1486 # suspension fees: if there is a feepart, and it's not an unsuspend fee,
1487 # and this is not a suspend-before-cancel
1488 if ( $cust_pkg_reason ) {
1489 my $reason_obj = $cust_pkg_reason->reason;
1490 if ( $reason_obj->feepart and
1491 ! $reason_obj->fee_on_unsuspend and
1492 ! $options{'from_cancel'} ) {
1494 # register the need to charge a fee, cust_main->bill will do the rest
1495 warn "registering suspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
1497 my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
1498 'pkgreasonnum' => $cust_pkg_reason->num,
1499 'pkgnum' => $self->pkgnum,
1500 'feepart' => $reason->feepart,
1501 'nextbill' => $reason->fee_hold,
1503 $error ||= $cust_pkg_reason_fee->insert;
1507 my $conf = new FS::Conf;
1508 if ( $conf->config('suspend_email_admin') && !$options{'from_cancel'} ) {
1510 my $error = send_email(
1511 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1512 #invoice_from ??? well as good as any
1513 'to' => $conf->config('suspend_email_admin'),
1514 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1516 "This is an automatic message from your Freeside installation\n",
1517 "informing you that the following customer package has been suspended:\n",
1519 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1520 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1521 ( map { "Service : $_\n" } @labels ),
1523 'custnum' => $self->custnum,
1524 'msgtype' => 'admin'
1528 warn "WARNING: can't send suspension admin email (suspending anyway): ".
1536 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1537 $error = $supp_pkg->suspend(%options, 'from_main' => 1);
1539 $dbh->rollback if $oldAutoCommit;
1540 return "suspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1544 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1549 =item credit_remaining MODE TIME
1551 Generate a credit for this package for the time remaining in the current
1552 billing period. MODE is either "suspend" or "cancel" (determines the
1553 credit type). TIME is the time of suspension/cancellation. Both arguments
1558 # Implementation note:
1560 # If you pkgpart-change a package that has been billed, and it's set to give
1561 # credit on package change, then this method gets called and then the new
1562 # package will have no last_bill date. Therefore the customer will be credited
1563 # only once (per billing period) even if there are multiple package changes.
1565 # If you location-change a package that has been billed, this method will NOT
1566 # be called and the new package WILL have the last bill date of the old
1569 # If the new package is then canceled within the same billing cycle,
1570 # credit_remaining needs to run calc_remain on the OLD package to determine
1571 # the amount of unused time to credit.
1573 sub credit_remaining {
1574 # Add a credit for remaining service
1575 my ($self, $mode, $time) = @_;
1576 die 'credit_remaining requires suspend or cancel'
1577 unless $mode eq 'suspend' or $mode eq 'cancel';
1578 die 'no suspend/cancel time' unless $time > 0;
1580 my $conf = FS::Conf->new;
1581 my $reason_type = $conf->config($mode.'_credit_type');
1583 my $last_bill = $self->getfield('last_bill') || 0;
1584 my $next_bill = $self->getfield('bill') || 0;
1585 if ( $last_bill > 0 # the package has been billed
1586 and $next_bill > 0 # the package has a next bill date
1587 and $next_bill >= $time # which is in the future
1589 my $remaining_value = 0;
1591 my $remain_pkg = $self;
1592 $remaining_value = $remain_pkg->calc_remain('time' => $time);
1594 # we may have to walk back past some package changes to get to the
1595 # one that actually has unused time
1596 while ( $remaining_value == 0 ) {
1597 if ( $remain_pkg->change_pkgnum ) {
1598 $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum);
1600 # the package has really never been billed
1603 $remaining_value = $remain_pkg->calc_remain('time' => $time);
1606 if ( $remaining_value > 0 ) {
1607 warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1609 my $error = $self->cust_main->credit(
1611 'Credit for unused time on '. $self->part_pkg->pkg,
1612 'reason_type' => $reason_type,
1614 return "Error crediting customer \$$remaining_value for unused time".
1615 " on ". $self->part_pkg->pkg. ": $error"
1617 } #if $remaining_value
1618 } #if $last_bill, etc.
1622 =item unsuspend [ OPTION => VALUE ... ]
1624 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1625 package, then unsuspends the package itself (clears the susp field and the
1626 adjourn field if it is in the past). If the suspend reason includes an
1627 unsuspension package, that package will be ordered.
1629 Available options are:
1635 Can be set to a date to unsuspend the package in the future (the 'resume'
1638 =item adjust_next_bill
1640 Can be set true to adjust the next bill date forward by
1641 the amount of time the account was inactive. This was set true by default
1642 in the past (from 1.4.2 and 1.5.0pre6 through 1.7.0), but now needs to be
1643 explicitly requested with this option or in the price plan.
1647 If there is an error, returns the error, otherwise returns false.
1652 my( $self, %opt ) = @_;
1655 # pass all suspend/cancel actions to the main package
1656 if ( $self->main_pkgnum and !$opt{'from_main'} ) {
1657 return $self->main_pkg->unsuspend(%opt);
1660 local $SIG{HUP} = 'IGNORE';
1661 local $SIG{INT} = 'IGNORE';
1662 local $SIG{QUIT} = 'IGNORE';
1663 local $SIG{TERM} = 'IGNORE';
1664 local $SIG{TSTP} = 'IGNORE';
1665 local $SIG{PIPE} = 'IGNORE';
1667 my $oldAutoCommit = $FS::UID::AutoCommit;
1668 local $FS::UID::AutoCommit = 0;
1671 my $old = $self->select_for_update;
1673 my $pkgnum = $old->pkgnum;
1674 if ( $old->get('cancel') || $self->get('cancel') ) {
1675 $dbh->rollback if $oldAutoCommit;
1676 return "Can't unsuspend cancelled package $pkgnum";
1679 unless ( $old->get('susp') && $self->get('susp') ) {
1680 $dbh->rollback if $oldAutoCommit;
1681 return ""; # no error # complain instead?
1684 # handle the case of setting a future unsuspend (resume) date
1685 # and do not continue to actually unsuspend the package
1686 my $date = $opt{'date'};
1687 if ( $date and $date > time ) { # return an error if $date <= time?
1689 if ( $old->get('expire') && $old->get('expire') < $date ) {
1690 $dbh->rollback if $oldAutoCommit;
1691 return "Package $pkgnum expires before it would be unsuspended.";
1694 my $new = new FS::cust_pkg { $self->hash };
1695 $new->set('resume', $date);
1696 $error = $new->replace($self, options => $self->options);
1699 $dbh->rollback if $oldAutoCommit;
1703 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1709 if (!$self->setup) {
1710 # then this package is being released from on-hold status
1711 $self->set_initial_timers;
1716 foreach my $cust_svc (
1717 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1719 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1721 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1722 $dbh->rollback if $oldAutoCommit;
1723 return "Illegal svcdb value in part_svc!";
1726 require "FS/$svcdb.pm";
1728 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1730 $error = $svc->unsuspend;
1732 $dbh->rollback if $oldAutoCommit;
1735 my( $label, $value ) = $cust_svc->label;
1736 push @labels, "$label: $value";
1741 my $cust_pkg_reason = $self->last_cust_pkg_reason('susp');
1742 my $reason = $cust_pkg_reason ? $cust_pkg_reason->reason : '';
1744 my %hash = $self->hash;
1745 my $inactive = time - $hash{'susp'};
1747 my $conf = new FS::Conf;
1749 # increment next bill date if certain conditions are met:
1750 # - it was due to be billed at some point
1751 # - either the global or local config says to do this
1752 my $adjust_bill = 0;
1755 && ( $hash{'bill'} || $hash{'setup'} )
1756 && ( $opt{'adjust_next_bill'}
1757 || $conf->exists('unsuspend-always_adjust_next_bill_date')
1758 || $self->part_pkg->option('unsuspend_adjust_bill', 1)
1765 # - the package billed during suspension
1766 # - or it was ordered on hold
1767 # - or the customer was credited for the unused time
1769 if ( $self->option('suspend_bill',1)
1770 or ( $self->part_pkg->option('suspend_bill',1)
1771 and ! $self->option('no_suspend_bill',1)
1773 or $hash{'order_date'} == $hash{'susp'}
1778 if ( $adjust_bill ) {
1779 if ( $self->part_pkg->option('unused_credit_suspend')
1780 or ( $reason and $reason->unused_credit ) ) {
1781 # then the customer was credited for the unused time before suspending,
1782 # so their next bill should be immediate.
1783 $hash{'bill'} = time;
1785 # add the length of time suspended to the bill date
1786 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1791 $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
1792 $hash{'resume'} = '' if !$hash{'adjourn'};
1793 my $new = new FS::cust_pkg ( \%hash );
1794 $error = $new->replace( $self, options => { $self->options } );
1796 $dbh->rollback if $oldAutoCommit;
1803 if ( $reason->unsuspend_pkgpart ) {
1804 #warn "Suspend reason '".$reason->reason."' uses deprecated unsuspend_pkgpart feature.\n"; # in 4.x
1805 my $part_pkg = FS::part_pkg->by_key($reason->unsuspend_pkgpart)
1806 or $error = "Unsuspend package definition ".$reason->unsuspend_pkgpart.
1808 my $start_date = $self->cust_main->next_bill_date
1809 if $reason->unsuspend_hold;
1812 $unsusp_pkg = FS::cust_pkg->new({
1813 'custnum' => $self->custnum,
1814 'pkgpart' => $reason->unsuspend_pkgpart,
1815 'start_date' => $start_date,
1816 'locationnum' => $self->locationnum,
1817 # discount? probably not...
1820 $error ||= $self->cust_main->order_pkg( 'cust_pkg' => $unsusp_pkg );
1823 # new way, using fees
1824 if ( $reason->feepart and $reason->fee_on_unsuspend ) {
1825 # register the need to charge a fee, cust_main->bill will do the rest
1826 warn "registering unsuspend fee: pkgnum ".$self->pkgnum.", feepart ".$reason->feepart."\n"
1828 my $cust_pkg_reason_fee = FS::cust_pkg_reason_fee->new({
1829 'pkgreasonnum' => $cust_pkg_reason->num,
1830 'pkgnum' => $self->pkgnum,
1831 'feepart' => $reason->feepart,
1832 'nextbill' => $reason->fee_hold,
1834 $error ||= $cust_pkg_reason_fee->insert;
1838 $dbh->rollback if $oldAutoCommit;
1843 if ( $conf->config('unsuspend_email_admin') ) {
1845 my $error = send_email(
1846 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1847 #invoice_from ??? well as good as any
1848 'to' => $conf->config('unsuspend_email_admin'),
1849 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
1850 "This is an automatic message from your Freeside installation\n",
1851 "informing you that the following customer package has been unsuspended:\n",
1853 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1854 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1855 ( map { "Service : $_\n" } @labels ),
1857 "An unsuspension fee was charged: ".
1858 $unsusp_pkg->part_pkg->pkg_comment."\n"
1862 'custnum' => $self->custnum,
1863 'msgtype' => 'admin',
1867 warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
1873 foreach my $supp_pkg ( $self->supplemental_pkgs ) {
1874 $error = $supp_pkg->unsuspend(%opt, 'from_main' => 1);
1876 $dbh->rollback if $oldAutoCommit;
1877 return "unsuspending supplemental pkg#".$supp_pkg->pkgnum.": $error";
1881 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1888 Cancels any pending suspension (sets the adjourn field to null).
1890 If there is an error, returns the error, otherwise returns false.
1895 my( $self, %options ) = @_;
1898 local $SIG{HUP} = 'IGNORE';
1899 local $SIG{INT} = 'IGNORE';
1900 local $SIG{QUIT} = 'IGNORE';
1901 local $SIG{TERM} = 'IGNORE';
1902 local $SIG{TSTP} = 'IGNORE';
1903 local $SIG{PIPE} = 'IGNORE';
1905 my $oldAutoCommit = $FS::UID::AutoCommit;
1906 local $FS::UID::AutoCommit = 0;
1909 my $old = $self->select_for_update;
1911 my $pkgnum = $old->pkgnum;
1912 if ( $old->get('cancel') || $self->get('cancel') ) {
1913 dbh->rollback if $oldAutoCommit;
1914 return "Can't unadjourn cancelled package $pkgnum";
1915 # or at least it's pointless
1918 if ( $old->get('susp') || $self->get('susp') ) {
1919 dbh->rollback if $oldAutoCommit;
1920 return "Can't unadjourn suspended package $pkgnum";
1921 # perhaps this is arbitrary
1924 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1925 dbh->rollback if $oldAutoCommit;
1926 return ""; # no error
1929 my %hash = $self->hash;
1930 $hash{'adjourn'} = '';
1931 $hash{'resume'} = '';
1932 my $new = new FS::cust_pkg ( \%hash );
1933 $error = $new->replace( $self, options => { $self->options } );
1935 $dbh->rollback if $oldAutoCommit;
1939 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1946 =item change HASHREF | OPTION => VALUE ...
1948 Changes this package: cancels it and creates a new one, with a different
1949 pkgpart or locationnum or both. All services are transferred to the new
1950 package (no change will be made if this is not possible).
1952 Options may be passed as a list of key/value pairs or as a hash reference.
1959 New locationnum, to change the location for this package.
1963 New FS::cust_location object, to create a new location and assign it
1968 New FS::cust_main object, to create a new customer and assign the new package
1973 New pkgpart (see L<FS::part_pkg>).
1977 New refnum (see L<FS::part_referral>).
1981 New quantity; if unspecified, the new package will have the same quantity
1986 "New" (existing) FS::cust_pkg object. The package's services and other
1987 attributes will be transferred to this package.
1991 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1992 susp, adjourn, cancel, expire, and contract_end) to the new package.
1994 =item unprotect_svcs
1996 Normally, change() will rollback and return an error if some services
1997 can't be transferred (also see the I<cust_pkg-change_svcpart> config option).
1998 If unprotect_svcs is true, this method will transfer as many services as
1999 it can and then unconditionally cancel the old package.
2003 If specified, sets this value for the contract_end date on the new package
2004 (without regard for keep_dates or the usual date-preservation behavior.)
2005 Will throw an error if defined but false; the UI doesn't allow editing
2006 this unless it already exists, making removal impossible to undo.
2010 At least one of locationnum, cust_location, pkgpart, refnum, cust_main, or
2011 cust_pkg must be specified (otherwise, what's the point?)
2013 Returns either the new FS::cust_pkg object or a scalar error.
2017 my $err_or_new_cust_pkg = $old_cust_pkg->change
2021 #used by change and change_later
2022 #didn't put with documented check methods because it depends on change-specific opts
2023 #and it also possibly edits the value of opts
2027 if ( defined($opt->{'contract_end'}) ) {
2028 my $current_contract_end = $self->get('contract_end');
2029 unless ($opt->{'contract_end'}) {
2030 if ($current_contract_end) {
2031 return "Cannot remove contract end date when changing packages";
2033 #shouldn't even pass this option if there's not a current value
2034 #but can be handled gracefully if the option is empty
2035 warn "Contract end date passed unexpectedly";
2036 delete $opt->{'contract_end'};
2040 unless ($current_contract_end) {
2041 #option shouldn't be passed, throw error if it's non-empty
2042 return "Cannot add contract end date when changing packages " . $self->pkgnum;
2048 #some false laziness w/order
2051 my $opt = ref($_[0]) ? shift : { @_ };
2053 my $conf = new FS::Conf;
2055 # handle contract_end on cust_pkg same as passed option
2056 if ( $opt->{'cust_pkg'} ) {
2057 $opt->{'contract_end'} = $opt->{'cust_pkg'}->contract_end;
2058 delete $opt->{'contract_end'} unless $opt->{'contract_end'};
2061 # check contract_end, prevent adding/removing
2062 my $error = $self->_check_change($opt);
2063 return $error if $error;
2065 # Transactionize this whole mess
2066 local $SIG{HUP} = 'IGNORE';
2067 local $SIG{INT} = 'IGNORE';
2068 local $SIG{QUIT} = 'IGNORE';
2069 local $SIG{TERM} = 'IGNORE';
2070 local $SIG{TSTP} = 'IGNORE';
2071 local $SIG{PIPE} = 'IGNORE';
2073 my $oldAutoCommit = $FS::UID::AutoCommit;
2074 local $FS::UID::AutoCommit = 0;
2077 if ( $opt->{'cust_location'} ) {
2078 $error = $opt->{'cust_location'}->find_or_insert;
2080 $dbh->rollback if $oldAutoCommit;
2081 return "creating location record: $error";
2083 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
2086 # Before going any further here: if the package is still in the pre-setup
2087 # state, it's safe to modify it in place. No need to charge/credit for
2088 # partial period, transfer services, transfer usage pools, copy invoice
2089 # details, or change any dates.
2090 if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) {
2091 foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) {
2092 if ( length($opt->{$_}) ) {
2093 $self->set($_, $opt->{$_});
2096 # almost. if the new pkgpart specifies start/adjourn/expire timers,
2098 if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
2099 $self->set_initial_timers;
2101 # but if contract_end was explicitly specified, that overrides all else
2102 $self->set('contract_end', $opt->{'contract_end'})
2103 if $opt->{'contract_end'};
2104 $error = $self->replace;
2106 $dbh->rollback if $oldAutoCommit;
2107 return "modifying package: $error";
2109 $dbh->commit if $oldAutoCommit;
2118 $hash{'setup'} = $time if $self->get('setup');
2120 $hash{'change_date'} = $time;
2121 $hash{"change_$_"} = $self->$_()
2122 foreach qw( pkgnum pkgpart locationnum );
2124 if ( $opt->{'cust_pkg'} ) {
2125 # treat changing to a package with a different pkgpart as a
2126 # pkgpart change (because it is)
2127 $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart;
2130 # whether to override pkgpart checking on the new package
2131 my $same_pkgpart = 1;
2132 if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) {
2136 my $unused_credit = 0;
2137 my $keep_dates = $opt->{'keep_dates'};
2139 # Special case. If the pkgpart is changing, and the customer is going to be
2140 # credited for remaining time, don't keep setup, bill, or last_bill dates,
2141 # and DO pass the flag to cancel() to credit the customer. If the old
2142 # package had a setup date, set the new package's setup to the package
2143 # change date so that it has the same status as before.
2144 if ( $opt->{'pkgpart'}
2145 and $opt->{'pkgpart'} != $self->pkgpart
2146 and $self->part_pkg->option('unused_credit_change', 1) ) {
2149 $hash{'last_bill'} = '';
2153 if ( $keep_dates ) {
2154 foreach my $date ( qw(setup bill last_bill) ) {
2155 $hash{$date} = $self->getfield($date);
2158 # always keep the following dates
2159 foreach my $date (qw(order_date susp adjourn cancel expire resume
2160 start_date contract_end)) {
2161 $hash{$date} = $self->getfield($date);
2163 # but if contract_end was explicitly specified, that overrides all else
2164 $hash{'contract_end'} = $opt->{'contract_end'}
2165 if $opt->{'contract_end'};
2167 # allow $opt->{'locationnum'} = '' to specifically set it to null
2168 # (i.e. customer default location)
2169 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2171 # usually this doesn't matter. the two cases where it does are:
2172 # 1. unused_credit_change + pkgpart change + setup fee on the new package
2174 # 2. (more importantly) changing a package before it's billed
2175 $hash{'waive_setup'} = $self->waive_setup;
2177 # if this package is scheduled for a future package change, preserve that
2178 $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
2180 my $custnum = $self->custnum;
2181 if ( $opt->{cust_main} ) {
2182 my $cust_main = $opt->{cust_main};
2183 unless ( $cust_main->custnum ) {
2184 my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
2186 $dbh->rollback if $oldAutoCommit;
2187 return "inserting customer record: $error";
2190 $custnum = $cust_main->custnum;
2193 $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
2196 if ( $opt->{'cust_pkg'} ) {
2197 # The target package already exists; update it to show that it was
2198 # changed from this package.
2199 $cust_pkg = $opt->{'cust_pkg'};
2201 # follow all the above rules for date changes, etc.
2202 foreach (keys %hash) {
2203 $cust_pkg->set($_, $hash{$_});
2205 # except those that implement the future package change behavior
2206 foreach (qw(change_to_pkgnum start_date expire)) {
2207 $cust_pkg->set($_, '');
2210 $error = $cust_pkg->replace;
2213 # Create the new package.
2214 $cust_pkg = new FS::cust_pkg {
2215 custnum => $custnum,
2216 locationnum => $opt->{'locationnum'},
2217 ( map { $_ => ( $opt->{$_} || $self->$_() ) }
2218 qw( pkgpart quantity refnum salesnum )
2222 $error = $cust_pkg->insert( 'change' => 1,
2223 'allow_pkgpart' => $same_pkgpart );
2226 $dbh->rollback if $oldAutoCommit;
2227 return "inserting new package: $error";
2230 # Transfer services and cancel old package.
2231 # Enforce service limits only if this is a pkgpart change.
2232 local $FS::cust_svc::ignore_quantity;
2233 $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
2234 $error = $self->transfer($cust_pkg);
2235 if ($error and $error == 0) {
2236 # $old_pkg->transfer failed.
2237 $dbh->rollback if $oldAutoCommit;
2238 return "transferring $error";
2241 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2242 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2243 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
2244 if ($error and $error == 0) {
2245 # $old_pkg->transfer failed.
2246 $dbh->rollback if $oldAutoCommit;
2247 return "converting $error";
2251 # We set unprotect_svcs when executing a "future package change". It's
2252 # not a user-interactive operation, so returning an error means the
2253 # package change will just fail. Rather than have that happen, we'll
2254 # let leftover services be deleted.
2255 if ($error > 0 and !$opt->{'unprotect_svcs'}) {
2256 # Transfers were successful, but we still had services left on the old
2257 # package. We can't change the package under this circumstances, so abort.
2258 $dbh->rollback if $oldAutoCommit;
2259 return "unable to transfer all services";
2262 #reset usage if changing pkgpart
2263 # AND usage rollover is off (otherwise adds twice, now and at package bill)
2264 if ($self->pkgpart != $cust_pkg->pkgpart) {
2265 my $part_pkg = $cust_pkg->part_pkg;
2266 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
2270 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
2273 $dbh->rollback if $oldAutoCommit;
2274 return "setting usage values: $error";
2277 # if NOT changing pkgpart, transfer any usage pools over
2278 foreach my $usage ($self->cust_pkg_usage) {
2279 $usage->set('pkgnum', $cust_pkg->pkgnum);
2280 $error = $usage->replace;
2282 $dbh->rollback if $oldAutoCommit;
2283 return "transferring usage pools: $error";
2288 # transfer discounts, if we're not changing pkgpart
2289 if ( $same_pkgpart ) {
2290 foreach my $old_discount ($self->cust_pkg_discount_active) {
2291 # don't remove the old discount, we may still need to bill that package.
2292 my $new_discount = new FS::cust_pkg_discount {
2293 'pkgnum' => $cust_pkg->pkgnum,
2294 'discountnum' => $old_discount->discountnum,
2295 'months_used' => $old_discount->months_used,
2297 $error = $new_discount->insert;
2299 $dbh->rollback if $oldAutoCommit;
2300 return "transferring discounts: $error";
2305 # transfer (copy) invoice details
2306 foreach my $detail ($self->cust_pkg_detail) {
2307 my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
2308 $new_detail->set('pkgdetailnum', '');
2309 $new_detail->set('pkgnum', $cust_pkg->pkgnum);
2310 $error = $new_detail->insert;
2312 $dbh->rollback if $oldAutoCommit;
2313 return "transferring package notes: $error";
2319 if ( !$opt->{'cust_pkg'} ) {
2320 # Order any supplemental packages.
2321 my $part_pkg = $cust_pkg->part_pkg;
2322 my @old_supp_pkgs = $self->supplemental_pkgs;
2323 foreach my $link ($part_pkg->supp_part_pkg_link) {
2325 foreach (@old_supp_pkgs) {
2326 if ($_->pkgpart == $link->dst_pkgpart) {
2328 $_->pkgpart(0); # so that it can't match more than once
2332 # false laziness with FS::cust_main::Packages::order_pkg
2333 my $new = FS::cust_pkg->new({
2334 pkgpart => $link->dst_pkgpart,
2335 pkglinknum => $link->pkglinknum,
2336 custnum => $custnum,
2337 main_pkgnum => $cust_pkg->pkgnum,
2338 locationnum => $cust_pkg->locationnum,
2339 start_date => $cust_pkg->start_date,
2340 order_date => $cust_pkg->order_date,
2341 expire => $cust_pkg->expire,
2342 adjourn => $cust_pkg->adjourn,
2343 contract_end => $cust_pkg->contract_end,
2344 refnum => $cust_pkg->refnum,
2345 discountnum => $cust_pkg->discountnum,
2346 waive_setup => $cust_pkg->waive_setup,
2348 if ( $old and $opt->{'keep_dates'} ) {
2349 foreach (qw(setup bill last_bill)) {
2350 $new->set($_, $old->get($_));
2353 $error = $new->insert( allow_pkgpart => $same_pkgpart );
2356 $error ||= $old->transfer($new);
2358 if ( $error and $error > 0 ) {
2359 # no reason why this should ever fail, but still...
2360 $error = "Unable to transfer all services from supplemental package ".
2364 $dbh->rollback if $oldAutoCommit;
2367 push @new_supp_pkgs, $new;
2369 } # if !$opt->{'cust_pkg'}
2370 # because if there is one, then supplemental packages would already
2371 # have been created for it.
2373 #Good to go, cancel old package. Notify 'cancel' of whether to credit
2375 #Don't allow billing the package (preceding period packages and/or
2376 #outstanding usage) if we are keeping dates (i.e. location changing),
2377 #because the new package will be billed for the same date range.
2378 #Supplemental packages are also canceled here.
2380 # during scheduled changes, avoid canceling the package we just
2382 $self->set('change_to_pkgnum' => '');
2384 $error = $self->cancel(
2386 unused_credit => $unused_credit,
2387 nobill => $keep_dates,
2388 change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
2389 no_delay_cancel => 1,
2392 $dbh->rollback if $oldAutoCommit;
2393 return "canceling old package: $error";
2396 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
2398 my $error = $cust_pkg->cust_main->bill(
2399 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
2402 $dbh->rollback if $oldAutoCommit;
2403 return "billing new package: $error";
2407 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2413 =item change_later OPTION => VALUE...
2415 Schedule a package change for a later date. This actually orders the new
2416 package immediately, but sets its start date for a future date, and sets
2417 the current package to expire on the same date.
2419 If the package is already scheduled for a change, this can be called with
2420 'start_date' to change the scheduled date, or with pkgpart and/or
2421 locationnum to modify the package change. To cancel the scheduled change
2422 entirely, see C<abort_change>.
2430 The date for the package change. Required, and must be in the future.
2440 The pkgpart, locationnum, quantity and optional contract_end of the new
2441 package, with the same meaning as in C<change>.
2449 my $opt = ref($_[0]) ? shift : { @_ };
2451 # check contract_end, prevent adding/removing
2452 my $error = $self->_check_change($opt);
2453 return $error if $error;
2455 my $oldAutoCommit = $FS::UID::AutoCommit;
2456 local $FS::UID::AutoCommit = 0;
2459 my $cust_main = $self->cust_main;
2461 my $date = delete $opt->{'start_date'} or return 'start_date required';
2463 if ( $date <= time ) {
2464 $dbh->rollback if $oldAutoCommit;
2465 return "start_date $date is in the past";
2468 if ( $self->change_to_pkgnum ) {
2469 my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
2470 my $new_pkgpart = $opt->{'pkgpart'}
2471 if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
2472 my $new_locationnum = $opt->{'locationnum'}
2473 if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
2474 my $new_quantity = $opt->{'quantity'}
2475 if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
2476 my $new_contract_end = $opt->{'contract_end'}
2477 if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
2478 if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
2479 # it hasn't been billed yet, so in principle we could just edit
2480 # it in place (w/o a package change), but that's bad form.
2481 # So change the package according to the new options...
2482 my $err_or_pkg = $change_to->change(%$opt);
2483 if ( ref $err_or_pkg ) {
2484 # Then set that package up for a future start.
2485 $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
2486 $self->set('expire', $date); # in case it's different
2487 $err_or_pkg->set('start_date', $date);
2488 $err_or_pkg->set('change_date', '');
2489 $err_or_pkg->set('change_pkgnum', '');
2491 $error = $self->replace ||
2492 $err_or_pkg->replace ||
2493 #because change() might've edited existing scheduled change in place
2494 (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
2495 $change_to->cancel('no_delay_cancel' => 1) ||
2496 $change_to->delete);
2498 $error = $err_or_pkg;
2500 } else { # change the start date only.
2501 $self->set('expire', $date);
2502 $change_to->set('start_date', $date);
2503 $error = $self->replace || $change_to->replace;
2506 $dbh->rollback if $oldAutoCommit;
2509 $dbh->commit if $oldAutoCommit;
2512 } # if $self->change_to_pkgnum
2514 my $new_pkgpart = $opt->{'pkgpart'}
2515 if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
2516 my $new_locationnum = $opt->{'locationnum'}
2517 if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
2518 my $new_quantity = $opt->{'quantity'}
2519 if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
2520 my $new_contract_end = $opt->{'contract_end'}
2521 if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
2523 return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
2525 # allow $opt->{'locationnum'} = '' to specifically set it to null
2526 # (i.e. customer default location)
2527 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2529 my $new = FS::cust_pkg->new( {
2530 custnum => $self->custnum,
2531 locationnum => $opt->{'locationnum'},
2532 start_date => $date,
2533 map { $_ => ( $opt->{$_} || $self->$_() ) }
2534 qw( pkgpart quantity refnum salesnum contract_end )
2536 $error = $new->insert('change' => 1,
2537 'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
2539 $self->set('change_to_pkgnum', $new->pkgnum);
2540 $self->set('expire', $date);
2541 $error = $self->replace;
2544 $dbh->rollback if $oldAutoCommit;
2546 $dbh->commit if $oldAutoCommit;
2554 Cancels a future package change scheduled by C<change_later>.
2560 my $pkgnum = $self->change_to_pkgnum;
2561 my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
2564 $error = $change_to->cancel || $change_to->delete;
2565 return $error if $error;
2567 $self->set('change_to_pkgnum', '');
2568 $self->set('expire', '');
2572 =item set_quantity QUANTITY
2574 Change the package's quantity field. This is one of the few package properties
2575 that can safely be changed without canceling and reordering the package
2576 (because it doesn't affect tax eligibility). Returns an error or an
2583 $self = $self->replace_old; # just to make sure
2584 $self->quantity(shift);
2588 =item set_salesnum SALESNUM
2590 Change the package's salesnum (sales person) field. This is one of the few
2591 package properties that can safely be changed without canceling and reordering
2592 the package (because it doesn't affect tax eligibility). Returns an error or
2599 $self = $self->replace_old; # just to make sure
2600 $self->salesnum(shift);
2602 # XXX this should probably reassign any credit that's already been given
2605 =item modify_charge OPTIONS
2607 Change the properties of a one-time charge. The following properties can
2608 be changed this way:
2609 - pkg: the package description
2610 - classnum: the package class
2611 - additional: arrayref of additional invoice details to add to this package
2613 and, I<if the charge has not yet been billed>:
2614 - start_date: the date when it will be billed
2615 - amount: the setup fee to be charged
2616 - quantity: the multiplier for the setup fee
2617 - separate_bill: whether to put the charge on a separate invoice
2619 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
2620 commission credits linked to this charge, they will be recalculated.
2627 my $part_pkg = $self->part_pkg;
2628 my $pkgnum = $self->pkgnum;
2631 my $oldAutoCommit = $FS::UID::AutoCommit;
2632 local $FS::UID::AutoCommit = 0;
2634 return "Can't use modify_charge except on one-time charges"
2635 unless $part_pkg->freq eq '0';
2637 if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
2638 $part_pkg->set('pkg', $opt{'pkg'});
2641 my %pkg_opt = $part_pkg->options;
2642 my $pkg_opt_modified = 0;
2644 $opt{'additional'} ||= [];
2647 foreach (grep /^additional/, keys %pkg_opt) {
2648 ($i) = ($_ =~ /^additional_info(\d+)$/);
2649 $old_additional[$i] = $pkg_opt{$_} if $i;
2650 delete $pkg_opt{$_};
2653 for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
2654 $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
2655 if (!exists($old_additional[$i])
2656 or $old_additional[$i] ne $opt{'additional'}->[$i])
2658 $pkg_opt_modified = 1;
2661 $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
2662 $pkg_opt{'additional_count'} = $i if $i > 0;
2665 if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
2668 $old_classnum = $part_pkg->classnum;
2669 $part_pkg->set('classnum', $opt{'classnum'});
2672 if ( !$self->get('setup') ) {
2673 # not yet billed, so allow amount, setup_cost, quantity, start_date,
2676 if ( exists($opt{'amount'})
2677 and $part_pkg->option('setup_fee') != $opt{'amount'}
2678 and $opt{'amount'} > 0 ) {
2680 $pkg_opt{'setup_fee'} = $opt{'amount'};
2681 $pkg_opt_modified = 1;
2684 if ( exists($opt{'setup_cost'})
2685 and $part_pkg->setup_cost != $opt{'setup_cost'}
2686 and $opt{'setup_cost'} > 0 ) {
2688 $part_pkg->set('setup_cost', $opt{'setup_cost'});
2691 if ( exists($opt{'quantity'})
2692 and $opt{'quantity'} != $self->quantity
2693 and $opt{'quantity'} > 0 ) {
2695 $self->set('quantity', $opt{'quantity'});
2698 if ( exists($opt{'start_date'})
2699 and $opt{'start_date'} != $self->start_date ) {
2701 $self->set('start_date', $opt{'start_date'});
2704 if ( exists($opt{'separate_bill'})
2705 and $opt{'separate_bill'} ne $self->separate_bill ) {
2707 $self->set('separate_bill', $opt{'separate_bill'});
2711 } # else simply ignore them; the UI shouldn't allow editing the fields
2713 if ( exists($opt{'taxclass'})
2714 and $part_pkg->taxclass ne $opt{'taxclass'}) {
2716 $part_pkg->set('taxclass', $opt{'taxclass'});
2720 if ( $part_pkg->modified or $pkg_opt_modified ) {
2721 # can we safely modify the package def?
2722 # Yes, if it's not available for purchase, and this is the only instance
2724 if ( $part_pkg->disabled
2725 and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
2726 and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
2728 $error = $part_pkg->replace( options => \%pkg_opt );
2731 $part_pkg = $part_pkg->clone;
2732 $part_pkg->set('disabled' => 'Y');
2733 $error = $part_pkg->insert( options => \%pkg_opt );
2734 # and associate this as yet-unbilled package to the new package def
2735 $self->set('pkgpart' => $part_pkg->pkgpart);
2738 $dbh->rollback if $oldAutoCommit;
2743 if ($self->modified) { # for quantity or start_date change, or if we had
2744 # to clone the existing package def
2745 my $error = $self->replace;
2746 return $error if $error;
2748 if (defined $old_classnum) {
2749 # fix invoice grouping records
2750 my $old_catname = $old_classnum
2751 ? FS::pkg_class->by_key($old_classnum)->categoryname
2753 my $new_catname = $opt{'classnum'}
2754 ? $part_pkg->pkg_class->categoryname
2756 if ( $old_catname ne $new_catname ) {
2757 foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
2758 # (there should only be one...)
2759 my @display = qsearch( 'cust_bill_pkg_display', {
2760 'billpkgnum' => $cust_bill_pkg->billpkgnum,
2761 'section' => $old_catname,
2763 foreach (@display) {
2764 $_->set('section', $new_catname);
2765 $error = $_->replace;
2767 $dbh->rollback if $oldAutoCommit;
2771 } # foreach $cust_bill_pkg
2774 if ( $opt{'adjust_commission'} ) {
2775 # fix commission credits...tricky.
2776 foreach my $cust_event ($self->cust_event) {
2777 my $part_event = $cust_event->part_event;
2778 foreach my $table (qw(sales agent)) {
2780 "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
2781 my $credit = qsearchs('cust_credit', {
2782 'eventnum' => $cust_event->eventnum,
2784 if ( $part_event->isa($class) ) {
2785 # Yes, this results in current commission rates being applied
2786 # retroactively to a one-time charge. For accounting purposes
2787 # there ought to be some kind of time limit on doing this.
2788 my $amount = $part_event->_calc_credit($self);
2789 if ( $credit and $credit->amount ne $amount ) {
2790 # Void the old credit.
2791 $error = $credit->void('Package class changed');
2793 $dbh->rollback if $oldAutoCommit;
2794 return "$error (adjusting commission credit)";
2797 # redo the event action to recreate the credit.
2799 eval { $part_event->do_action( $self, $cust_event ) };
2801 $dbh->rollback if $oldAutoCommit;
2804 } # if $part_event->isa($class)
2806 } # foreach $cust_event
2807 } # if $opt{'adjust_commission'}
2808 } # if defined $old_classnum
2810 $dbh->commit if $oldAutoCommit;
2816 use Storable 'thaw';
2819 sub process_bulk_cust_pkg {
2821 my $param = thaw(decode_base64(shift));
2822 warn Dumper($param) if $DEBUG;
2824 my $old_part_pkg = qsearchs('part_pkg',
2825 { pkgpart => $param->{'old_pkgpart'} });
2826 my $new_part_pkg = qsearchs('part_pkg',
2827 { pkgpart => $param->{'new_pkgpart'} });
2828 die "Must select a new package type\n" unless $new_part_pkg;
2829 #my $keep_dates = $param->{'keep_dates'} || 0;
2830 my $keep_dates = 1; # there is no good reason to turn this off
2832 local $SIG{HUP} = 'IGNORE';
2833 local $SIG{INT} = 'IGNORE';
2834 local $SIG{QUIT} = 'IGNORE';
2835 local $SIG{TERM} = 'IGNORE';
2836 local $SIG{TSTP} = 'IGNORE';
2837 local $SIG{PIPE} = 'IGNORE';
2839 my $oldAutoCommit = $FS::UID::AutoCommit;
2840 local $FS::UID::AutoCommit = 0;
2843 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
2846 foreach my $old_cust_pkg ( @cust_pkgs ) {
2848 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
2849 if ( $old_cust_pkg->getfield('cancel') ) {
2850 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
2851 $old_cust_pkg->pkgnum."\n"
2855 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
2857 my $error = $old_cust_pkg->change(
2858 'pkgpart' => $param->{'new_pkgpart'},
2859 'keep_dates' => $keep_dates
2861 if ( !ref($error) ) { # change returns the cust_pkg on success
2863 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
2866 $dbh->commit if $oldAutoCommit;
2872 Returns the last bill date, or if there is no last bill date, the setup date.
2873 Useful for billing metered services.
2879 return $self->setfield('last_bill', $_[0]) if @_;
2880 return $self->getfield('last_bill') if $self->getfield('last_bill');
2881 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
2882 'edate' => $self->bill, } );
2883 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
2886 =item last_cust_pkg_reason ACTION
2888 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
2889 Returns false if there is no reason or the package is not currenly ACTION'd
2890 ACTION is one of adjourn, susp, cancel, or expire.
2894 sub last_cust_pkg_reason {
2895 my ( $self, $action ) = ( shift, shift );
2896 my $date = $self->get($action);
2898 'table' => 'cust_pkg_reason',
2899 'hashref' => { 'pkgnum' => $self->pkgnum,
2900 'action' => substr(uc($action), 0, 1),
2903 'order_by' => 'ORDER BY num DESC LIMIT 1',
2907 =item last_reason ACTION
2909 Returns the most recent ACTION FS::reason associated with the package.
2910 Returns false if there is no reason or the package is not currenly ACTION'd
2911 ACTION is one of adjourn, susp, cancel, or expire.
2916 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
2917 $cust_pkg_reason->reason
2918 if $cust_pkg_reason;
2923 Returns the definition for this billing item, as an FS::part_pkg object (see
2930 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
2931 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
2932 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
2937 Returns the cancelled package this package was changed from, if any.
2943 return '' unless $self->change_pkgnum;
2944 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
2947 =item change_cust_main
2949 Returns the customter this package was detached to, if any.
2953 sub change_cust_main {
2955 return '' unless $self->change_custnum;
2956 qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
2961 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
2968 $self->part_pkg->calc_setup($self, @_);
2973 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
2980 $self->part_pkg->calc_recur($self, @_);
2985 Returns the base setup fee (per unit) of this package, from the package
2990 # minimal version for 3.x; in 4.x this can invoke currency conversion
2994 $self->part_pkg->unit_setup($self);
2999 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
3006 $self->part_pkg->base_recur($self, @_);
3011 Calls the I<calc_remain> of the FS::part_pkg object associated with this
3018 $self->part_pkg->calc_remain($self, @_);
3023 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
3030 $self->part_pkg->calc_cancel($self, @_);
3035 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
3041 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
3044 =item cust_pkg_detail [ DETAILTYPE ]
3046 Returns any customer package details for this package (see
3047 L<FS::cust_pkg_detail>).
3049 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3053 sub cust_pkg_detail {
3055 my %hash = ( 'pkgnum' => $self->pkgnum );
3056 $hash{detailtype} = shift if @_;
3058 'table' => 'cust_pkg_detail',
3059 'hashref' => \%hash,
3060 'order_by' => 'ORDER BY weight, pkgdetailnum',
3064 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
3066 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
3068 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3070 If there is an error, returns the error, otherwise returns false.
3074 sub set_cust_pkg_detail {
3075 my( $self, $detailtype, @details ) = @_;
3077 local $SIG{HUP} = 'IGNORE';
3078 local $SIG{INT} = 'IGNORE';
3079 local $SIG{QUIT} = 'IGNORE';
3080 local $SIG{TERM} = 'IGNORE';
3081 local $SIG{TSTP} = 'IGNORE';
3082 local $SIG{PIPE} = 'IGNORE';
3084 my $oldAutoCommit = $FS::UID::AutoCommit;
3085 local $FS::UID::AutoCommit = 0;
3088 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
3089 my $error = $current->delete;
3091 $dbh->rollback if $oldAutoCommit;
3092 return "error removing old detail: $error";
3096 foreach my $detail ( @details ) {
3097 my $cust_pkg_detail = new FS::cust_pkg_detail {
3098 'pkgnum' => $self->pkgnum,
3099 'detailtype' => $detailtype,
3100 'detail' => $detail,
3102 my $error = $cust_pkg_detail->insert;
3104 $dbh->rollback if $oldAutoCommit;
3105 return "error adding new detail: $error";
3110 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3117 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
3121 #false laziness w/cust_bill.pm
3125 'table' => 'cust_event',
3126 'addl_from' => 'JOIN part_event USING ( eventpart )',
3127 'hashref' => { 'tablenum' => $self->pkgnum },
3128 'extra_sql' => " AND eventtable = 'cust_pkg' ",
3132 =item num_cust_event
3134 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
3138 #false laziness w/cust_bill.pm
3139 sub num_cust_event {
3141 my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
3142 $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
3145 =item exists_cust_event
3147 Returns true if there are customer billing events (see L<FS::cust_event>) for this package. More efficient than using num_cust_event.
3151 sub exists_cust_event {
3153 my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
3154 my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
3155 $row ? $row->[0] : '';
3158 sub _from_cust_event_where {
3160 " FROM cust_event JOIN part_event USING ( eventpart ) ".
3161 " WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
3165 my( $self, $sql, @args ) = @_;
3166 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
3167 $sth->execute(@args) or die $sth->errstr. " executing $sql";
3171 =item cust_svc [ SVCPART ] (old, deprecated usage)
3173 =item cust_svc [ OPTION => VALUE ... ] (current usage)
3175 =item cust_svc_unsorted [ OPTION => VALUE ... ]
3177 Returns the services for this package, as FS::cust_svc objects (see
3178 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
3179 spcififed, returns only the matching services.
3181 As an optimization, use the cust_svc_unsorted version if you are not displaying
3188 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
3189 $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
3192 sub cust_svc_unsorted {
3194 @{ $self->cust_svc_unsorted_arrayref(@_) };
3197 sub cust_svc_unsorted_arrayref {
3200 return [] unless $self->num_cust_svc(@_);
3203 if ( @_ && $_[0] =~ /^\d+/ ) {
3204 $opt{svcpart} = shift;
3205 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3212 'select' => 'cust_svc.*, part_svc.*',
3213 'table' => 'cust_svc',
3214 'hashref' => { 'pkgnum' => $self->pkgnum },
3215 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
3217 $search{hashref}->{svcpart} = $opt{svcpart}
3219 $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
3222 [ qsearch(\%search) ];
3226 =item overlimit [ SVCPART ]
3228 Returns the services for this package which have exceeded their
3229 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
3230 is specified, return only the matching services.
3236 return () unless $self->num_cust_svc(@_);
3237 grep { $_->overlimit } $self->cust_svc(@_);
3240 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3242 Returns historical services for this package created before END TIMESTAMP and
3243 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
3244 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
3245 I<pkg_svc.hidden> flag will be omitted.
3251 warn "$me _h_cust_svc called on $self\n"
3254 my ($end, $start, $mode) = @_;
3255 my @cust_svc = $self->_sort_cust_svc(
3256 [ qsearch( 'h_cust_svc',
3257 { 'pkgnum' => $self->pkgnum, },
3258 FS::h_cust_svc->sql_h_search(@_),
3261 if ( defined($mode) && $mode eq 'I' ) {
3262 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
3263 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
3269 sub _sort_cust_svc {
3270 my( $self, $arrayref ) = @_;
3273 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
3275 my %pkg_svc = map { $_->svcpart => $_ }
3276 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
3281 my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
3283 $pkg_svc ? $pkg_svc->primary_svc : '',
3284 $pkg_svc ? $pkg_svc->quantity : 0,
3291 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
3293 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
3295 Returns the number of services for this package. Available options are svcpart
3296 and svcdb. If either is spcififed, returns only the matching services.
3303 return $self->{'_num_cust_svc'}
3305 && exists($self->{'_num_cust_svc'})
3306 && $self->{'_num_cust_svc'} =~ /\d/;
3308 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
3312 if ( @_ && $_[0] =~ /^\d+/ ) {
3313 $opt{svcpart} = shift;
3314 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3320 my $select = 'SELECT COUNT(*) FROM cust_svc ';
3321 my $where = ' WHERE pkgnum = ? ';
3322 my @param = ($self->pkgnum);
3324 if ( $opt{'svcpart'} ) {
3325 $where .= ' AND svcpart = ? ';
3326 push @param, $opt{'svcpart'};
3328 if ( $opt{'svcdb'} ) {
3329 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
3330 $where .= ' AND svcdb = ? ';
3331 push @param, $opt{'svcdb'};
3334 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
3335 $sth->execute(@param) or die $sth->errstr;
3336 $sth->fetchrow_arrayref->[0];
3339 =item available_part_svc
3341 Returns a list of FS::part_svc objects representing services included in this
3342 package but not yet provisioned. Each FS::part_svc object also has an extra
3343 field, I<num_avail>, which specifies the number of available services.
3345 Accepts option I<provision_hold>; if true, only returns part_svc for which the
3346 associated pkg_svc has the provision_hold flag set.
3350 sub available_part_svc {
3354 my $pkg_quantity = $self->quantity || 1;
3356 grep { $_->num_avail > 0 }
3358 my $part_svc = $_->part_svc;
3359 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3360 $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3362 # more evil encapsulation breakage
3363 if ($part_svc->{'Hash'}{'num_avail'} > 0) {
3364 my @exports = $part_svc->part_export_did;
3365 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3370 grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
3371 $self->part_pkg->pkg_svc;
3374 =item part_svc [ OPTION => VALUE ... ]
3376 Returns a list of FS::part_svc objects representing provisioned and available
3377 services included in this package. Each FS::part_svc object also has the
3378 following extra fields:
3392 (services) - array reference containing the provisioned services, as cust_svc objects
3396 Accepts two options:
3400 =item summarize_size
3402 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3403 is this size or greater.
3405 =item hide_discontinued
3407 If true, will omit looking for services that are no longer avaialble in the
3415 #label -> ($cust_svc->label)[1]
3421 my $pkg_quantity = $self->quantity || 1;
3423 #XXX some sort of sort order besides numeric by svcpart...
3424 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3426 my $part_svc = $pkg_svc->part_svc;
3427 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3428 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3429 $part_svc->{'Hash'}{'num_avail'} =
3430 max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3431 $part_svc->{'Hash'}{'cust_pkg_svc'} =
3432 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3433 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3434 && $num_cust_svc >= $opt{summarize_size};
3435 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3437 } $self->part_pkg->pkg_svc;
3439 unless ( $opt{hide_discontinued} ) {
3441 push @part_svc, map {
3443 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3444 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3445 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
3446 $part_svc->{'Hash'}{'cust_pkg_svc'} =
3447 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3449 } $self->extra_part_svc;
3456 =item extra_part_svc
3458 Returns a list of FS::part_svc objects corresponding to services in this
3459 package which are still provisioned but not (any longer) available in the
3464 sub extra_part_svc {
3467 my $pkgnum = $self->pkgnum;
3468 #my $pkgpart = $self->pkgpart;
3471 # 'table' => 'part_svc',
3474 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
3475 # WHERE pkg_svc.svcpart = part_svc.svcpart
3476 # AND pkg_svc.pkgpart = ?
3479 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
3480 # LEFT JOIN cust_pkg USING ( pkgnum )
3481 # WHERE cust_svc.svcpart = part_svc.svcpart
3484 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3487 #seems to benchmark slightly faster... (or did?)
3489 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3490 my $pkgparts = join(',', @pkgparts);
3493 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
3494 #MySQL doesn't grok DISINCT ON
3495 'select' => 'DISTINCT part_svc.*',
3496 'table' => 'part_svc',
3498 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
3499 AND pkg_svc.pkgpart IN ($pkgparts)
3502 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
3503 LEFT JOIN cust_pkg USING ( pkgnum )
3506 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3507 'extra_param' => [ [$self->pkgnum=>'int'] ],
3513 Returns a short status string for this package, currently:
3519 =item not yet billed
3521 =item one-time charge
3536 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3538 return 'cancelled' if $self->get('cancel');
3539 return 'on hold' if $self->susp && ! $self->setup;
3540 return 'suspended' if $self->susp;
3541 return 'not yet billed' unless $self->setup;
3542 return 'one-time charge' if $freq =~ /^(0|$)/;
3546 =item ucfirst_status
3548 Returns the status with the first character capitalized.
3552 sub ucfirst_status {
3553 ucfirst(shift->status);
3558 Class method that returns the list of possible status strings for packages
3559 (see L<the status method|/status>). For example:
3561 @statuses = FS::cust_pkg->statuses();
3565 tie my %statuscolor, 'Tie::IxHash',
3566 'on hold' => 'FF00F5', #brighter purple!
3567 'not yet billed' => '009999', #teal? cyan?
3568 'one-time charge' => '0000CC', #blue #'000000',
3569 'active' => '00CC00',
3570 'suspended' => 'FF9900',
3571 'cancelled' => 'FF0000',
3575 my $self = shift; #could be class...
3576 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3577 # # mayble split btw one-time vs. recur
3588 Returns a hex triplet color string for this package's status.
3594 $statuscolor{$self->status};
3597 =item is_status_delay_cancel
3599 Returns true if part_pkg has option delay_cancel,
3600 cust_pkg status is 'suspended' and expire is set
3601 to cancel package within the next day (or however
3602 many days are set in global config part_pkg-delay_cancel-days.
3604 Accepts option I<part_pkg-delay_cancel-days> which should be
3605 the value of the config setting, to avoid looking it up again.
3607 This is not a real status, this only meant for hacking display
3608 values, because otherwise treating the package as suspended is
3609 really the whole point of the delay_cancel option.
3613 sub is_status_delay_cancel {
3614 my ($self,%opt) = @_;
3615 if ( $self->main_pkgnum and $self->pkglinknum ) {
3616 return $self->main_pkg->is_status_delay_cancel;
3618 return 0 unless $self->part_pkg->option('delay_cancel',1);
3619 return 0 unless $self->status eq 'suspended';
3620 return 0 unless $self->expire;
3621 my $expdays = $opt{'part_pkg-delay_cancel-days'};
3623 my $conf = new FS::Conf;
3624 $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
3626 my $expsecs = 60*60*24*$expdays;
3627 return 0 unless $self->expire < time + $expsecs;
3633 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
3634 "pkg - comment" depending on user preference).
3640 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
3641 $label = $self->pkgnum. ": $label"
3642 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3646 =item pkg_label_long
3648 Returns a long label for this package, adding the primary service's label to
3653 sub pkg_label_long {
3655 my $label = $self->pkg_label;
3656 my $cust_svc = $self->primary_cust_svc;
3657 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
3663 Returns a customer-localized label for this package.
3669 $self->part_pkg->pkg_locale( $self->cust_main->locale );
3672 =item primary_cust_svc
3674 Returns a primary service (as FS::cust_svc object) if one can be identified.
3678 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
3680 sub primary_cust_svc {
3683 my @cust_svc = $self->cust_svc;
3685 return '' unless @cust_svc; #no serivces - irrelevant then
3687 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
3689 # primary service as specified in the package definition
3690 # or exactly one service definition with quantity one
3691 my $svcpart = $self->part_pkg->svcpart;
3692 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
3693 return $cust_svc[0] if scalar(@cust_svc) == 1;
3695 #couldn't identify one thing..
3701 Returns a list of lists, calling the label method for all services
3702 (see L<FS::cust_svc>) of this billing item.
3708 map { [ $_->label ] } $self->cust_svc;
3711 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3713 Like the labels method, but returns historical information on services that
3714 were active as of END_TIMESTAMP and (optionally) not cancelled before
3715 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
3716 I<pkg_svc.hidden> flag will be omitted.
3718 Returns a list of lists, calling the label method for all (historical) services
3719 (see L<FS::h_cust_svc>) of this billing item.
3725 warn "$me _h_labels called on $self\n"
3727 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
3732 Like labels, except returns a simple flat list, and shortens long
3733 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3734 identical services to one line that lists the service label and the number of
3735 individual services rather than individual items.
3740 shift->_labels_short( 'labels', @_ );
3743 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
3745 Like h_labels, except returns a simple flat list, and shortens long
3746 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3747 identical services to one line that lists the service label and the number of
3748 individual services rather than individual items.
3752 sub h_labels_short {
3753 shift->_labels_short( 'h_labels', @_ );
3757 my( $self, $method ) = ( shift, shift );
3759 warn "$me _labels_short called on $self with $method method\n"
3762 my $conf = new FS::Conf;
3763 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
3765 warn "$me _labels_short populating \%labels\n"
3769 #tie %labels, 'Tie::IxHash';
3770 push @{ $labels{$_->[0]} }, $_->[1]
3771 foreach $self->$method(@_);
3773 warn "$me _labels_short populating \@labels\n"
3777 foreach my $label ( keys %labels ) {
3779 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
3780 my $num = scalar(@values);
3781 warn "$me _labels_short $num items for $label\n"
3784 if ( $num > $max_same_services ) {
3785 warn "$me _labels_short more than $max_same_services, so summarizing\n"
3787 push @labels, "$label ($num)";
3789 if ( $conf->exists('cust_bill-consolidate_services') ) {
3790 warn "$me _labels_short consolidating services\n"
3792 # push @labels, "$label: ". join(', ', @values);
3794 my $detail = "$label: ";
3795 $detail .= shift(@values). ', '
3797 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
3799 push @labels, $detail;
3801 warn "$me _labels_short done consolidating services\n"
3804 warn "$me _labels_short adding service data\n"
3806 push @labels, map { "$label: $_" } @values;
3817 Returns the parent customer object (see L<FS::cust_main>).
3823 cluck 'cust_pkg->cust_main called' if $DEBUG;
3824 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
3829 Returns the balance for this specific package, when using
3830 experimental package balance.
3836 $self->cust_main->balance_pkgnum( $self->pkgnum );
3839 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
3843 Returns the location object, if any (see L<FS::cust_location>).
3845 =item cust_location_or_main
3847 If this package is associated with a location, returns the locaiton (see
3848 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
3850 =item location_label [ OPTION => VALUE ... ]
3852 Returns the label of the location object (see L<FS::cust_location>).
3856 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
3858 =item tax_locationnum
3860 Returns the foreign key to a L<FS::cust_location> object for calculating
3861 tax on this package, as determined by the C<tax-pkg_address> and
3862 C<tax-ship_address> configuration flags.
3866 sub tax_locationnum {
3868 my $conf = FS::Conf->new;
3869 if ( $conf->exists('tax-pkg_address') ) {
3870 return $self->locationnum;
3872 elsif ( $conf->exists('tax-ship_address') ) {
3873 return $self->cust_main->ship_locationnum;
3876 return $self->cust_main->bill_locationnum;
3882 Returns the L<FS::cust_location> object for tax_locationnum.
3888 my $conf = FS::Conf->new;
3889 if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
3890 return FS::cust_location->by_key($self->locationnum);
3892 elsif ( $conf->exists('tax-ship_address') ) {
3893 return $self->cust_main->ship_location;
3896 return $self->cust_main->bill_location;
3900 =item seconds_since TIMESTAMP
3902 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
3903 package have been online since TIMESTAMP, according to the session monitor.
3905 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
3906 L<Time::Local> and L<Date::Parse> for conversion functions.
3911 my($self, $since) = @_;
3914 foreach my $cust_svc (
3915 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
3917 $seconds += $cust_svc->seconds_since($since);
3924 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
3926 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
3927 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
3930 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3931 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
3937 sub seconds_since_sqlradacct {
3938 my($self, $start, $end) = @_;
3942 foreach my $cust_svc (
3944 my $part_svc = $_->part_svc;
3945 $part_svc->svcdb eq 'svc_acct'
3946 && scalar($part_svc->part_export_usage);
3949 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
3956 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
3958 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
3959 in this package for sessions ending between TIMESTAMP_START (inclusive) and
3963 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3964 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
3969 sub attribute_since_sqlradacct {
3970 my($self, $start, $end, $attrib) = @_;
3974 foreach my $cust_svc (
3976 my $part_svc = $_->part_svc;
3977 scalar($part_svc->part_export_usage);
3980 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
3992 my( $self, $value ) = @_;
3993 if ( defined($value) ) {
3994 $self->setfield('quantity', $value);
3996 $self->getfield('quantity') || 1;
3999 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
4001 Transfers as many services as possible from this package to another package.
4003 The destination package can be specified by pkgnum by passing an FS::cust_pkg
4004 object. The destination package must already exist.
4006 Services are moved only if the destination allows services with the correct
4007 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
4008 this option with caution! No provision is made for export differences
4009 between the old and new service definitions. Probably only should be used
4010 when your exports for all service definitions of a given svcdb are identical.
4011 (attempt a transfer without it first, to move all possible svcpart-matching
4014 Any services that can't be moved remain in the original package.
4016 Returns an error, if there is one; otherwise, returns the number of services
4017 that couldn't be moved.
4022 my ($self, $dest_pkgnum, %opt) = @_;
4028 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
4029 $dest = $dest_pkgnum;
4030 $dest_pkgnum = $dest->pkgnum;
4032 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
4035 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
4037 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
4038 $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
4041 foreach my $cust_svc ($dest->cust_svc) {
4042 $target{$cust_svc->svcpart}--;
4045 my %svcpart2svcparts = ();
4046 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4047 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
4048 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
4049 next if exists $svcpart2svcparts{$svcpart};
4050 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
4051 $svcpart2svcparts{$svcpart} = [
4053 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
4055 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
4056 'svcpart' => $_ } );
4058 $pkg_svc ? $pkg_svc->primary_svc : '',
4059 $pkg_svc ? $pkg_svc->quantity : 0,
4063 grep { $_ != $svcpart }
4065 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
4067 warn "alternates for svcpart $svcpart: ".
4068 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
4074 foreach my $cust_svc ($self->cust_svc) {
4075 my $svcnum = $cust_svc->svcnum;
4076 if($target{$cust_svc->svcpart} > 0
4077 or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
4078 $target{$cust_svc->svcpart}--;
4079 my $new = new FS::cust_svc { $cust_svc->hash };
4080 $new->pkgnum($dest_pkgnum);
4081 $error = $new->replace($cust_svc);
4082 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4084 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
4085 warn "alternates to consider: ".
4086 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
4088 my @alternate = grep {
4089 warn "considering alternate svcpart $_: ".
4090 "$target{$_} available in new package\n"
4093 } @{$svcpart2svcparts{$cust_svc->svcpart}};
4095 warn "alternate(s) found\n" if $DEBUG;
4096 my $change_svcpart = $alternate[0];
4097 $target{$change_svcpart}--;
4098 my $new = new FS::cust_svc { $cust_svc->hash };
4099 $new->svcpart($change_svcpart);
4100 $new->pkgnum($dest_pkgnum);
4101 $error = $new->replace($cust_svc);
4109 my @label = $cust_svc->label;
4110 return "service $label[1]: $error";
4116 =item grab_svcnums SVCNUM, SVCNUM ...
4118 Change the pkgnum for the provided services to this packages. If there is an
4119 error, returns the error, otherwise returns false.
4127 local $SIG{HUP} = 'IGNORE';
4128 local $SIG{INT} = 'IGNORE';
4129 local $SIG{QUIT} = 'IGNORE';
4130 local $SIG{TERM} = 'IGNORE';
4131 local $SIG{TSTP} = 'IGNORE';
4132 local $SIG{PIPE} = 'IGNORE';
4134 my $oldAutoCommit = $FS::UID::AutoCommit;
4135 local $FS::UID::AutoCommit = 0;
4138 foreach my $svcnum (@svcnum) {
4139 my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
4140 $dbh->rollback if $oldAutoCommit;
4141 return "unknown svcnum $svcnum";
4143 $cust_svc->pkgnum( $self->pkgnum );
4144 my $error = $cust_svc->replace;
4146 $dbh->rollback if $oldAutoCommit;
4151 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4158 This method is deprecated. See the I<depend_jobnum> option to the insert and
4159 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
4166 local $SIG{HUP} = 'IGNORE';
4167 local $SIG{INT} = 'IGNORE';
4168 local $SIG{QUIT} = 'IGNORE';
4169 local $SIG{TERM} = 'IGNORE';
4170 local $SIG{TSTP} = 'IGNORE';
4171 local $SIG{PIPE} = 'IGNORE';
4173 my $oldAutoCommit = $FS::UID::AutoCommit;
4174 local $FS::UID::AutoCommit = 0;
4177 foreach my $cust_svc ( $self->cust_svc ) {
4178 #false laziness w/svc_Common::insert
4179 my $svc_x = $cust_svc->svc_x;
4180 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
4181 my $error = $part_export->export_insert($svc_x);
4183 $dbh->rollback if $oldAutoCommit;
4189 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4194 =item export_pkg_change OLD_CUST_PKG
4196 Calls the "pkg_change" export action for all services attached to this package.
4200 sub export_pkg_change {
4201 my( $self, $old ) = ( shift, shift );
4203 local $SIG{HUP} = 'IGNORE';
4204 local $SIG{INT} = 'IGNORE';
4205 local $SIG{QUIT} = 'IGNORE';
4206 local $SIG{TERM} = 'IGNORE';
4207 local $SIG{TSTP} = 'IGNORE';
4208 local $SIG{PIPE} = 'IGNORE';
4210 my $oldAutoCommit = $FS::UID::AutoCommit;
4211 local $FS::UID::AutoCommit = 0;
4214 foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
4215 my $error = $svc_x->export('pkg_change', $self, $old);
4217 $dbh->rollback if $oldAutoCommit;
4222 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4229 Associates this package with a (suspension or cancellation) reason (see
4230 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
4233 Available options are:
4239 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.
4243 the access_user (see L<FS::access_user>) providing the reason
4251 the action (cancel, susp, adjourn, expire) associated with the reason
4255 If there is an error, returns the error, otherwise returns false.
4260 my ($self, %options) = @_;
4262 my $otaker = $options{reason_otaker} ||
4263 $FS::CurrentUser::CurrentUser->username;
4266 if ( $options{'reason'} =~ /^(\d+)$/ ) {
4270 } elsif ( ref($options{'reason'}) ) {
4272 return 'Enter a new reason (or select an existing one)'
4273 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
4275 my $reason = new FS::reason({
4276 'reason_type' => $options{'reason'}->{'typenum'},
4277 'reason' => $options{'reason'}->{'reason'},
4279 my $error = $reason->insert;
4280 return $error if $error;
4282 $reasonnum = $reason->reasonnum;
4285 return "Unparseable reason: ". $options{'reason'};
4288 my $cust_pkg_reason =
4289 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
4290 'reasonnum' => $reasonnum,
4291 'otaker' => $otaker,
4292 'action' => substr(uc($options{'action'}),0,1),
4293 'date' => $options{'date'}
4298 $cust_pkg_reason->insert;
4301 =item insert_discount
4303 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
4304 inserting a new discount on the fly (see L<FS::discount>).
4306 Available options are:
4314 If there is an error, returns the error, otherwise returns false.
4318 sub insert_discount {
4319 #my ($self, %options) = @_;
4322 my $cust_pkg_discount = new FS::cust_pkg_discount {
4323 'pkgnum' => $self->pkgnum,
4324 'discountnum' => $self->discountnum,
4326 'end_date' => '', #XXX
4327 #for the create a new discount case
4328 '_type' => $self->discountnum__type,
4329 'amount' => $self->discountnum_amount,
4330 'percent' => $self->discountnum_percent,
4331 'months' => $self->discountnum_months,
4332 'setup' => $self->discountnum_setup,
4333 #'disabled' => $self->discountnum_disabled,
4336 $cust_pkg_discount->insert;
4339 =item set_usage USAGE_VALUE_HASHREF
4341 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4342 to which they should be set (see L<FS::svc_acct>). Currently seconds,
4343 upbytes, downbytes, and totalbytes are appropriate keys.
4345 All svc_accts which are part of this package have their values reset.
4350 my ($self, $valueref, %opt) = @_;
4352 #only svc_acct can set_usage for now
4353 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4354 my $svc_x = $cust_svc->svc_x;
4355 $svc_x->set_usage($valueref, %opt)
4356 if $svc_x->can("set_usage");
4360 =item recharge USAGE_VALUE_HASHREF
4362 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4363 to which they should be set (see L<FS::svc_acct>). Currently seconds,
4364 upbytes, downbytes, and totalbytes are appropriate keys.
4366 All svc_accts which are part of this package have their values incremented.
4371 my ($self, $valueref) = @_;
4373 #only svc_acct can set_usage for now
4374 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4375 my $svc_x = $cust_svc->svc_x;
4376 $svc_x->recharge($valueref)
4377 if $svc_x->can("recharge");
4381 =item cust_pkg_discount
4385 sub cust_pkg_discount {
4387 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
4390 =item cust_pkg_discount_active
4394 sub cust_pkg_discount_active {
4396 grep { $_->status eq 'active' } $self->cust_pkg_discount;
4399 =item cust_pkg_usage
4401 Returns a list of all voice usage counters attached to this package.
4405 sub cust_pkg_usage {
4407 qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum });
4410 =item apply_usage OPTIONS
4412 Takes the following options:
4413 - cdr: a call detail record (L<FS::cdr>)
4414 - rate_detail: the rate determined for this call (L<FS::rate_detail>)
4415 - minutes: the maximum number of minutes to be charged
4417 Finds available usage minutes for a call of this class, and subtracts
4418 up to that many minutes from the usage pool. If the usage pool is empty,
4419 and the C<cdr-minutes_priority> global config option is set, minutes may
4420 be taken from other calls as well. Either way, an allocation record will
4421 be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
4422 number of minutes of usage applied to the call.
4427 my ($self, %opt) = @_;
4428 my $cdr = $opt{cdr};
4429 my $rate_detail = $opt{rate_detail};
4430 my $minutes = $opt{minutes};
4431 my $classnum = $rate_detail->classnum;
4432 my $pkgnum = $self->pkgnum;
4433 my $custnum = $self->custnum;
4435 local $SIG{HUP} = 'IGNORE';
4436 local $SIG{INT} = 'IGNORE';
4437 local $SIG{QUIT} = 'IGNORE';
4438 local $SIG{TERM} = 'IGNORE';
4439 local $SIG{TSTP} = 'IGNORE';
4440 local $SIG{PIPE} = 'IGNORE';
4442 my $oldAutoCommit = $FS::UID::AutoCommit;
4443 local $FS::UID::AutoCommit = 0;
4445 my $order = FS::Conf->new->config('cdr-minutes_priority');
4449 $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
4451 $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
4453 my @usage_recs = qsearch({
4454 'table' => 'cust_pkg_usage',
4455 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'.
4456 ' JOIN cust_pkg USING (pkgnum)'.
4457 ' JOIN part_pkg_usage_class USING (pkgusagepart)',
4458 'select' => 'cust_pkg_usage.*',
4459 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
4460 " ( cust_pkg.custnum = $custnum AND ".
4461 " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4462 $is_classnum . ' AND '.
4463 " cust_pkg_usage.minutes > 0",
4464 'order_by' => " ORDER BY priority ASC",
4467 my $orig_minutes = $minutes;
4469 while (!$error and $minutes > 0 and @usage_recs) {
4470 my $cust_pkg_usage = shift @usage_recs;
4471 $cust_pkg_usage->select_for_update;
4472 my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
4473 pkgusagenum => $cust_pkg_usage->pkgusagenum,
4474 acctid => $cdr->acctid,
4475 minutes => min($cust_pkg_usage->minutes, $minutes),
4477 $cust_pkg_usage->set('minutes',
4478 $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
4480 $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
4481 $minutes -= $cdr_cust_pkg_usage->minutes;
4483 if ( $order and $minutes > 0 and !$error ) {
4484 # then try to steal minutes from another call
4486 'table' => 'cdr_cust_pkg_usage',
4487 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'.
4488 ' JOIN part_pkg_usage USING (pkgusagepart)'.
4489 ' JOIN cust_pkg USING (pkgnum)'.
4490 ' JOIN part_pkg_usage_class USING (pkgusagepart)'.
4491 ' JOIN cdr USING (acctid)',
4492 'select' => 'cdr_cust_pkg_usage.*',
4493 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
4494 " ( cust_pkg.pkgnum = $pkgnum OR ".
4495 " ( cust_pkg.custnum = $custnum AND ".
4496 " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4497 " part_pkg_usage_class.classnum = $classnum",
4498 'order_by' => ' ORDER BY part_pkg_usage.priority ASC',
4500 if ( $order eq 'time' ) {
4501 # find CDRs that are using minutes, but have a later startdate
4503 my $startdate = $cdr->startdate;
4504 if ($startdate !~ /^\d+$/) {
4505 die "bad cdr startdate '$startdate'";
4507 $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
4508 # minimize needless reshuffling
4509 $search{'order_by'} .= ', cdr.startdate DESC';
4511 # XXX may not work correctly with rate_time schedules. Could
4512 # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
4514 $search{'addl_from'} .=
4515 ' JOIN rate_detail'.
4516 ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
4517 if ( $order eq 'rate_high' ) {
4518 $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
4519 $rate_detail->min_charge;
4520 $search{'order_by'} .= ', rate_detail.min_charge ASC';
4521 } elsif ( $order eq 'rate_low' ) {
4522 $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
4523 $rate_detail->min_charge;
4524 $search{'order_by'} .= ', rate_detail.min_charge DESC';
4526 # this should really never happen
4527 die "invalid cdr-minutes_priority value '$order'\n";
4530 my @cdr_usage_recs = qsearch(\%search);
4532 while (!$error and @cdr_usage_recs and $minutes > 0) {
4533 my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
4534 my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
4535 my $old_cdr = $cdr_cust_pkg_usage->cdr;
4536 $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
4537 $cdr_cust_pkg_usage->select_for_update;
4538 $old_cdr->select_for_update;
4539 $cust_pkg_usage->select_for_update;
4540 # in case someone else stole the usage from this CDR
4541 # while waiting for the lock...
4542 next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
4543 # steal the usage allocation and flag the old CDR for reprocessing
4544 $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
4545 # if the allocation is more minutes than we need, adjust it...
4546 my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
4548 $cdr_cust_pkg_usage->set('minutes', $minutes);
4549 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
4550 $error = $cust_pkg_usage->replace;
4552 #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
4553 $error ||= $cdr_cust_pkg_usage->replace;
4554 # deduct the stolen minutes
4555 $minutes -= $cdr_cust_pkg_usage->minutes;
4557 # after all minute-stealing is done, reset the affected CDRs
4558 foreach (values %reproc_cdrs) {
4559 $error ||= $_->set_status('');
4560 # XXX or should we just call $cdr->rate right here?
4561 # it's not like we can create a loop this way, since the min_charge
4562 # or call time has to go monotonically in one direction.
4563 # we COULD get some very deep recursions going, though...
4565 } # if $order and $minutes
4568 die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
4570 $dbh->commit if $oldAutoCommit;
4571 return $orig_minutes - $minutes;
4575 =item supplemental_pkgs
4577 Returns a list of all packages supplemental to this one.
4581 sub supplemental_pkgs {
4583 qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
4588 Returns the package that this one is supplemental to, if any.
4594 if ( $self->main_pkgnum ) {
4595 return FS::cust_pkg->by_key($self->main_pkgnum);
4602 =head1 CLASS METHODS
4608 Returns an SQL expression identifying recurring packages.
4612 sub recurring_sql { "
4613 '0' != ( select freq from part_pkg
4614 where cust_pkg.pkgpart = part_pkg.pkgpart )
4619 Returns an SQL expression identifying one-time packages.
4624 '0' = ( select freq from part_pkg
4625 where cust_pkg.pkgpart = part_pkg.pkgpart )
4630 Returns an SQL expression identifying ordered packages (recurring packages not
4636 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
4641 Returns an SQL expression identifying active packages.
4646 $_[0]->recurring_sql. "
4647 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4648 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4649 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4652 =item not_yet_billed_sql
4654 Returns an SQL expression identifying packages which have not yet been billed.
4658 sub not_yet_billed_sql { "
4659 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
4660 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4661 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4666 Returns an SQL expression identifying inactive packages (one-time packages
4667 that are otherwise unsuspended/uncancelled).
4671 sub inactive_sql { "
4672 ". $_[0]->onetime_sql(). "
4673 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4674 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4675 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4680 Returns an SQL expression identifying on-hold packages.
4685 #$_[0]->recurring_sql(). ' AND '.
4687 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4688 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
4689 AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
4696 Returns an SQL expression identifying suspended packages.
4700 sub suspended_sql { susp_sql(@_); }
4702 #$_[0]->recurring_sql(). ' AND '.
4704 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4705 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
4706 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4713 Returns an SQL exprression identifying cancelled packages.
4717 sub cancelled_sql { cancel_sql(@_); }
4719 #$_[0]->recurring_sql(). ' AND '.
4720 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
4725 Returns an SQL expression to give the package status as a string.
4731 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
4732 WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
4733 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
4734 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
4735 WHEN ".onetime_sql()." THEN 'one-time charge'
4740 =item search HASHREF
4744 Returns a qsearch hash expression to search for parameters specified in HASHREF.
4745 Valid parameters are
4753 on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled)
4757 Equivalent to "status", except that "canceled"/"cancelled" will exclude
4758 packages that were changed into a new package with the same pkgpart (i.e.
4759 location or quantity changes).
4763 boolean selects custom packages
4769 pkgpart or arrayref or hashref of pkgparts
4773 arrayref of beginning and ending epoch date
4777 arrayref of beginning and ending epoch date
4781 arrayref of beginning and ending epoch date
4785 arrayref of beginning and ending epoch date
4789 arrayref of beginning and ending epoch date
4793 arrayref of beginning and ending epoch date
4797 arrayref of beginning and ending epoch date
4801 pkgnum or APKG_pkgnum
4805 a value suited to passing to FS::UI::Web::cust_header
4809 specifies the user for agent virtualization
4813 boolean; if true, returns only packages with more than 0 FCC phone lines.
4815 =item state, country
4817 Limit to packages with a service location in the specified state and country.
4818 For FCC 477 reporting, mostly.
4822 Limit to packages whose service locations are the same as the customer's
4823 default service location.
4825 =item location_nocust
4827 Limit to packages whose service locations are not the customer's default
4830 =item location_census
4832 Limit to packages whose service locations have census tracts.
4834 =item location_nocensus
4836 Limit to packages whose service locations do not have a census tract.
4838 =item location_geocode
4840 Limit to packages whose locations have geocodes.
4842 =item location_geocode
4844 Limit to packages whose locations do not have geocodes.
4848 Limit to packages associated with a svc_broadband, associated with a sector,
4849 associated with this towernum (or any of these, if it's an arrayref) (or NO
4850 towernum, if it's zero). This is an extreme niche case.
4852 =item 477part, 477rownum, date
4854 Limit to packages included in a specific row of one of the FCC 477 reports.
4855 '477part' is the section name (see L<FS::Report::FCC_477> methods), 'date'
4856 is the report as-of date (completely unrelated to the package setup/bill/
4857 other date fields), and '477rownum' is the row number of the report starting
4858 with zero. Row numbers have no inherent meaning, so this is useful only
4859 for explaining a 477 report you've already run.
4866 my ($class, $params) = @_;
4873 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
4875 "cust_main.agentnum = $1";
4882 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
4883 push @where, FS::cust_main->cust_status_sql . " = '$1' ";
4887 # parse customer sales person
4890 if ( $params->{'cust_main_salesnum'} =~ /^(\d+)$/ ) {
4891 push @where, ($1 > 0) ? "cust_main.salesnum = $1"
4892 : 'cust_main.salesnum IS NULL';
4897 # parse sales person
4900 if ( $params->{'salesnum'} =~ /^(\d+)$/ ) {
4901 push @where, ($1 > 0) ? "cust_pkg.salesnum = $1"
4902 : 'cust_pkg.salesnum IS NULL';
4909 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
4911 "cust_pkg.custnum = $1";
4918 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
4920 "cust_pkg.pkgbatch = '$1'";
4927 if ( $params->{'magic'} eq 'active'
4928 || $params->{'status'} eq 'active' ) {
4930 push @where, FS::cust_pkg->active_sql();
4932 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
4933 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
4935 push @where, FS::cust_pkg->not_yet_billed_sql();
4937 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
4938 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
4940 push @where, FS::cust_pkg->inactive_sql();
4942 } elsif ( $params->{'magic'} =~ /^on[ _]hold$/
4943 || $params->{'status'} =~ /^on[ _]hold$/ ) {
4945 push @where, FS::cust_pkg->on_hold_sql();
4948 } elsif ( $params->{'magic'} eq 'suspended'
4949 || $params->{'status'} eq 'suspended' ) {
4951 push @where, FS::cust_pkg->suspended_sql();
4953 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
4954 || $params->{'status'} =~ /^cancell?ed$/ ) {
4956 push @where, FS::cust_pkg->cancelled_sql();
4960 ### special case: "magic" is used in detail links from browse/part_pkg,
4961 # where "cancelled" has the restriction "and not replaced with a package
4962 # of the same pkgpart". Be consistent with that.
4965 if ( $params->{'magic'} =~ /^cancell?ed$/ ) {
4966 my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ".
4967 "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum";
4968 # ...may not exist, if this was just canceled and not changed; in that
4969 # case give it a "new pkgpart" that never equals the old pkgpart
4970 push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart";
4974 # parse package class
4977 if ( exists($params->{'classnum'}) ) {
4980 if ( ref($params->{'classnum'}) ) {
4982 if ( ref($params->{'classnum'}) eq 'HASH' ) {
4983 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
4984 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
4985 @classnum = @{ $params->{'classnum'} };
4987 die 'unhandled classnum ref '. $params->{'classnum'};
4991 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
4998 my @nums = grep $_, @classnum;
4999 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
5000 my $null = scalar( grep { $_ eq '' } @classnum );
5001 push @c_where, 'part_pkg.classnum IS NULL' if $null;
5003 if ( scalar(@c_where) == 1 ) {
5004 push @where, @c_where;
5005 } elsif ( @c_where ) {
5006 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
5015 # parse refnum (advertising source)
5018 if ( exists($params->{'refnum'}) ) {
5020 if (ref $params->{'refnum'}) {
5021 @refnum = @{ $params->{'refnum'} };
5023 @refnum = ( $params->{'refnum'} );
5025 my $in = join(',', grep /^\d+$/, @refnum);
5026 push @where, "refnum IN($in)" if length $in;
5030 # parse package report options
5033 my @report_option = ();
5034 if ( exists($params->{'report_option'}) ) {
5035 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
5036 @report_option = @{ $params->{'report_option'} };
5037 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
5038 @report_option = split(',', $1);
5043 if (@report_option) {
5044 # this will result in the empty set for the dangling comma case as it should
5046 map{ "0 < ( SELECT count(*) FROM part_pkg_option
5047 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
5048 AND optionname = 'report_option_$_'
5049 AND optionvalue = '1' )"
5053 foreach my $any ( grep /^report_option_any/, keys %$params ) {
5055 my @report_option_any = ();
5056 if ( ref($params->{$any}) eq 'ARRAY' ) {
5057 @report_option_any = @{ $params->{$any} };
5058 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
5059 @report_option_any = split(',', $1);
5062 if (@report_option_any) {
5063 # this will result in the empty set for the dangling comma case as it should
5064 push @where, ' ( '. join(' OR ',
5065 map{ "0 < ( SELECT count(*) FROM part_pkg_option
5066 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
5067 AND optionname = 'report_option_$_'
5068 AND optionvalue = '1' )"
5069 } @report_option_any
5079 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
5085 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
5086 if $params->{fcc_line};
5092 if ( exists($params->{'censustract'}) ) {
5093 $params->{'censustract'} =~ /^([.\d]*)$/;
5094 my $censustract = "cust_location.censustract = '$1'";
5095 $censustract .= ' OR cust_location.censustract is NULL' unless $1;
5096 push @where, "( $censustract )";
5100 # parse censustract2
5102 if ( exists($params->{'censustract2'})
5103 && $params->{'censustract2'} =~ /^(\d*)$/
5107 push @where, "cust_location.censustract LIKE '$1%'";
5110 "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
5115 # parse country/state/zip
5117 for (qw(state country)) { # parsing rules are the same for these
5118 if ( exists($params->{$_})
5119 && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
5121 # XXX post-2.3 only--before that, state/country may be in cust_main
5122 push @where, "cust_location.$_ = '$1'";
5125 if ( exists($params->{zip}) ) {
5126 push @where, "cust_location.zip = " . dbh->quote($params->{zip});
5132 if ( $params->{location_cust} xor $params->{location_nocust} ) {
5133 my $op = $params->{location_cust} ? '=' : '!=';
5134 push @where, "cust_location.locationnum $op cust_main.ship_locationnum";
5136 if ( $params->{location_census} xor $params->{location_nocensus} ) {
5137 my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL";
5138 push @where, "cust_location.censustract $op";
5140 if ( $params->{location_geocode} xor $params->{location_nogeocode} ) {
5141 my $op = $params->{location_geocode} ? "IS NOT NULL" : "IS NULL";
5142 push @where, "cust_location.geocode $op";
5149 if ( ref($params->{'pkgpart'}) ) {
5152 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
5153 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
5154 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
5155 @pkgpart = @{ $params->{'pkgpart'} };
5157 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
5160 @pkgpart = grep /^(\d+)$/, @pkgpart;
5162 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
5164 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
5165 push @where, "pkgpart = $1";
5174 #false laziness w/report_cust_pkg.html
5177 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
5178 'active' => { 'susp'=>1, 'cancel'=>1 },
5179 'suspended' => { 'cancel' => 1 },
5184 if( exists($params->{'active'} ) ) {
5185 # This overrides all the other date-related fields, and includes packages
5186 # that were active at some time during the interval. It excludes:
5187 # - packages that were set up after the end of the interval
5188 # - packages that were canceled before the start of the interval
5189 # - packages that were suspended before the start of the interval
5190 # and are still suspended now
5191 my($beginning, $ending) = @{$params->{'active'}};
5193 "cust_pkg.setup IS NOT NULL",
5194 "cust_pkg.setup <= $ending",
5195 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
5196 "(cust_pkg.susp IS NULL OR cust_pkg.susp >= $beginning )",
5197 "NOT (".FS::cust_pkg->onetime_sql . ")";
5200 my $exclude_change_from = 0;
5201 my $exclude_change_to = 0;
5203 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
5205 next unless exists($params->{$field});
5207 my($beginning, $ending) = @{$params->{$field}};
5209 next if $beginning == 0 && $ending == 4294967295;
5212 "cust_pkg.$field IS NOT NULL",
5213 "cust_pkg.$field >= $beginning",
5214 "cust_pkg.$field <= $ending";
5216 $orderby ||= "ORDER BY cust_pkg.$field";
5218 if ( $field eq 'setup' ) {
5219 $exclude_change_from = 1;
5220 } elsif ( $field eq 'cancel' ) {
5221 $exclude_change_to = 1;
5222 } elsif ( $field eq 'change_date' ) {
5223 # if we are given setup and change_date ranges, and the setup date
5224 # falls in _both_ ranges, then include the package whether it was
5226 $exclude_change_from = 0;
5230 if ($exclude_change_from) {
5231 push @where, "change_pkgnum IS NULL";
5233 if ($exclude_change_to) {
5234 # a join might be more efficient here
5235 push @where, "NOT EXISTS(
5236 SELECT 1 FROM cust_pkg AS changed_to_pkg
5237 WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
5242 $orderby ||= 'ORDER BY bill';
5245 # parse magic, legacy, etc.
5248 if ( $params->{'magic'} &&
5249 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
5252 $orderby = 'ORDER BY pkgnum';
5254 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
5255 push @where, "pkgpart = $1";
5258 } elsif ( $params->{'query'} eq 'pkgnum' ) {
5260 $orderby = 'ORDER BY pkgnum';
5262 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
5264 $orderby = 'ORDER BY pkgnum';
5267 SELECT count(*) FROM pkg_svc
5268 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
5269 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
5270 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
5271 AND cust_svc.svcpart = pkg_svc.svcpart
5278 # parse the extremely weird 'towernum' param
5281 if ($params->{towernum}) {
5282 my $towernum = $params->{towernum};
5283 $towernum = [ $towernum ] if !ref($towernum);
5284 my $in = join(',', grep /^\d+$/, @$towernum);
5286 # inefficient, but this is an obscure feature
5287 eval "use FS::Report::Table";
5288 FS::Report::Table->_init_tower_pkg_cache; # probably does nothing
5289 push @where, "EXISTS(
5290 SELECT 1 FROM tower_pkg_cache
5291 WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum
5292 AND tower_pkg_cache.towernum IN ($in)
5298 # parse the 477 report drill-down options
5301 if ($params->{'477part'} =~ /^([a-z]+)$/) {
5303 my ($date, $rownum, $agentnum);
5304 if ($params->{'date'} =~ /^(\d+)$/) {
5307 if ($params->{'477rownum'} =~ /^(\d+)$/) {
5310 if ($params->{'agentnum'} =~ /^(\d+)$/) {
5313 if ($date and defined($rownum)) {
5314 my $report = FS::Report::FCC_477->report($section,
5316 'agentnum' => $agentnum,
5319 my $pkgnums = $report->{detail}->[$rownum]
5320 or die "row $rownum is past the end of the report";
5321 # '0' so that if there are no pkgnums (empty string) it will create
5322 # a valid query that returns nothing
5323 warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
5325 # and this overrides everything
5326 @where = ( "cust_pkg.pkgnum IN($pkgnums)" );
5327 } # else we're missing some params, ignore the whole business
5331 # setup queries, links, subs, etc. for the search
5334 # here is the agent virtualization
5335 if ($params->{CurrentUser}) {
5337 qsearchs('access_user', { username => $params->{CurrentUser} });
5340 push @where, $access_user->agentnums_sql('table'=>'cust_main');
5345 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
5348 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5350 my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
5351 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
5352 'LEFT JOIN cust_location USING ( locationnum ) '.
5353 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
5357 if ( $params->{'select_zip5'} ) {
5358 my $zip = 'cust_location.zip';
5360 $select = "DISTINCT substr($zip,1,5) as zip";
5361 $orderby = "ORDER BY substr($zip,1,5)";
5362 $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
5364 $select = join(', ',
5366 ( map "part_pkg.$_", qw( pkg freq ) ),
5367 'pkg_class.classname',
5368 'cust_main.custnum AS cust_main_custnum',
5369 FS::UI::Web::cust_sql_fields(
5370 $params->{'cust_fields'}
5373 $count_query = 'SELECT COUNT(*)';
5376 $count_query .= " FROM cust_pkg $addl_from $extra_sql";
5379 'table' => 'cust_pkg',
5381 'select' => $select,
5382 'extra_sql' => $extra_sql,
5383 'order_by' => $orderby,
5384 'addl_from' => $addl_from,
5385 'count_query' => $count_query,
5392 Returns a list of two package counts. The first is a count of packages
5393 based on the supplied criteria and the second is the count of residential
5394 packages with those same criteria. Criteria are specified as in the search
5400 my ($class, $params) = @_;
5402 my $sql_query = $class->search( $params );
5404 my $count_sql = delete($sql_query->{'count_query'});
5405 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
5406 or die "couldn't parse count_sql";
5408 my $count_sth = dbh->prepare($count_sql)
5409 or die "Error preparing $count_sql: ". dbh->errstr;
5411 or die "Error executing $count_sql: ". $count_sth->errstr;
5412 my $count_arrayref = $count_sth->fetchrow_arrayref;
5414 return ( @$count_arrayref );
5418 =item tax_locationnum_sql
5420 Returns an SQL expression for the tax location for a package, based
5421 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
5425 sub tax_locationnum_sql {
5426 my $conf = FS::Conf->new;
5427 if ( $conf->exists('tax-pkg_address') ) {
5428 'cust_pkg.locationnum';
5430 elsif ( $conf->exists('tax-ship_address') ) {
5431 'cust_main.ship_locationnum';
5434 'cust_main.bill_locationnum';
5440 Returns a list: the first item is an SQL fragment identifying matching
5441 packages/customers via location (taking into account shipping and package
5442 address taxation, if enabled), and subsequent items are the parameters to
5443 substitute for the placeholders in that fragment.
5448 my($class, %opt) = @_;
5449 my $ornull = $opt{'ornull'};
5451 my $conf = new FS::Conf;
5453 # '?' placeholders in _location_sql_where
5454 my $x = $ornull ? 3 : 2;
5465 if ( $conf->exists('tax-ship_address') ) {
5468 ( ( ship_last IS NULL OR ship_last = '' )
5469 AND ". _location_sql_where('cust_main', '', $ornull ). "
5471 OR ( ship_last IS NOT NULL AND ship_last != ''
5472 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
5475 # AND payby != 'COMP'
5477 @main_param = ( @bill_param, @bill_param );
5481 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
5482 @main_param = @bill_param;
5488 if ( $conf->exists('tax-pkg_address') ) {
5490 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
5493 ( cust_pkg.locationnum IS NULL AND $main_where )
5494 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
5497 @param = ( @main_param, @bill_param );
5501 $where = $main_where;
5502 @param = @main_param;
5510 #subroutine, helper for location_sql
5511 sub _location_sql_where {
5513 my $prefix = @_ ? shift : '';
5514 my $ornull = @_ ? shift : '';
5516 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
5518 $ornull = $ornull ? ' OR ? IS NULL ' : '';
5520 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
5521 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
5522 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
5524 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
5526 # ( $table.${prefix}city = ? $or_empty_city $ornull )
5528 ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
5529 AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL )
5530 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
5531 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
5532 AND $table.${prefix}country = ?
5537 my( $self, $what ) = @_;
5539 my $what_show_zero = $what. '_show_zero';
5540 length($self->$what_show_zero())
5541 ? ($self->$what_show_zero() eq 'Y')
5542 : $self->part_pkg->$what_show_zero();
5549 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
5551 Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the
5552 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
5554 CUSTNUM is a customer (see L<FS::cust_main>)
5556 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5557 L<FS::part_pkg>) to order for this customer. Duplicates are of course
5560 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
5561 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
5562 new billing items. An error is returned if this is not possible (see
5563 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
5566 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5567 newly-created cust_pkg objects.
5569 REFNUM, if specified, will specify the FS::pkg_referral record to be created
5570 and inserted. Multiple FS::pkg_referral records can be created by
5571 setting I<refnum> to an array reference of refnums or a hash reference with
5572 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
5573 record will be created corresponding to cust_main.refnum.
5578 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
5580 my $conf = new FS::Conf;
5582 # Transactionize this whole mess
5583 local $SIG{HUP} = 'IGNORE';
5584 local $SIG{INT} = 'IGNORE';
5585 local $SIG{QUIT} = 'IGNORE';
5586 local $SIG{TERM} = 'IGNORE';
5587 local $SIG{TSTP} = 'IGNORE';
5588 local $SIG{PIPE} = 'IGNORE';
5590 my $oldAutoCommit = $FS::UID::AutoCommit;
5591 local $FS::UID::AutoCommit = 0;
5595 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
5596 # return "Customer not found: $custnum" unless $cust_main;
5598 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
5601 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5604 my $change = scalar(@old_cust_pkg) != 0;
5607 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
5609 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
5610 " to pkgpart ". $pkgparts->[0]. "\n"
5613 my $err_or_cust_pkg =
5614 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
5615 'refnum' => $refnum,
5618 unless (ref($err_or_cust_pkg)) {
5619 $dbh->rollback if $oldAutoCommit;
5620 return $err_or_cust_pkg;
5623 push @$return_cust_pkg, $err_or_cust_pkg;
5624 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5629 # Create the new packages.
5630 foreach my $pkgpart (@$pkgparts) {
5632 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
5634 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
5635 pkgpart => $pkgpart,
5639 $error = $cust_pkg->insert( 'change' => $change );
5640 push @$return_cust_pkg, $cust_pkg;
5642 foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
5643 my $supp_pkg = FS::cust_pkg->new({
5644 custnum => $custnum,
5645 pkgpart => $link->dst_pkgpart,
5647 main_pkgnum => $cust_pkg->pkgnum,
5650 $error ||= $supp_pkg->insert( 'change' => $change );
5651 push @$return_cust_pkg, $supp_pkg;
5655 $dbh->rollback if $oldAutoCommit;
5660 # $return_cust_pkg now contains refs to all of the newly
5663 # Transfer services and cancel old packages.
5664 foreach my $old_pkg (@old_cust_pkg) {
5666 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
5669 foreach my $new_pkg (@$return_cust_pkg) {
5670 $error = $old_pkg->transfer($new_pkg);
5671 if ($error and $error == 0) {
5672 # $old_pkg->transfer failed.
5673 $dbh->rollback if $oldAutoCommit;
5678 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
5679 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
5680 foreach my $new_pkg (@$return_cust_pkg) {
5681 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
5682 if ($error and $error == 0) {
5683 # $old_pkg->transfer failed.
5684 $dbh->rollback if $oldAutoCommit;
5691 # Transfers were successful, but we went through all of the
5692 # new packages and still had services left on the old package.
5693 # We can't cancel the package under the circumstances, so abort.
5694 $dbh->rollback if $oldAutoCommit;
5695 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
5697 $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
5703 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5707 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
5709 A bulk change method to change packages for multiple customers.
5711 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5712 L<FS::part_pkg>) to order for each customer. Duplicates are of course
5715 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
5716 replace. The services (see L<FS::cust_svc>) are moved to the
5717 new billing items. An error is returned if this is not possible (see
5720 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5721 newly-created cust_pkg objects.
5726 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
5728 # Transactionize this whole mess
5729 local $SIG{HUP} = 'IGNORE';
5730 local $SIG{INT} = 'IGNORE';
5731 local $SIG{QUIT} = 'IGNORE';
5732 local $SIG{TERM} = 'IGNORE';
5733 local $SIG{TSTP} = 'IGNORE';
5734 local $SIG{PIPE} = 'IGNORE';
5736 my $oldAutoCommit = $FS::UID::AutoCommit;
5737 local $FS::UID::AutoCommit = 0;
5741 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5744 while(scalar(@old_cust_pkg)) {
5746 my $custnum = $old_cust_pkg[0]->custnum;
5747 my (@remove) = map { $_->pkgnum }
5748 grep { $_->custnum == $custnum } @old_cust_pkg;
5749 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
5751 my $error = order $custnum, $pkgparts, \@remove, \@return;
5753 push @errors, $error
5755 push @$return_cust_pkg, @return;
5758 if (scalar(@errors)) {
5759 $dbh->rollback if $oldAutoCommit;
5760 return join(' / ', @errors);
5763 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5767 =item forward_emails
5769 Returns a hash of svcnums and corresponding email addresses
5770 for svc_acct services that can be used as source or dest
5771 for svc_forward services provisioned in this package.
5773 Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
5774 service; if included, will ensure the current values of the
5775 specified service are included in the list, even if for some
5776 other reason they wouldn't be. If called as a class method
5777 with a specified service, returns only these current values.
5779 Caution: does not actually check if svc_forward services are
5780 available to be provisioned on this package.
5784 sub forward_emails {
5788 #load optional service, thoroughly validated
5789 die "Use svcnum or svc_forward, not both"
5790 if $opt{'svcnum'} && $opt{'svc_forward'};
5791 my $svc_forward = $opt{'svc_forward'};
5792 $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
5794 die "Specified service is not a forward service"
5795 if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
5796 die "Specified service not found"
5797 if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
5801 ## everything below was basically copied from httemplate/edit/svc_forward.cgi
5802 ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
5804 #add current values from specified service, if there was one
5806 foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
5807 my $svc_acct = $svc_forward->$method();
5808 $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
5812 if (ref($self) eq 'FS::cust_pkg') {
5814 #and including the rest for this customer
5815 my($u_part_svc,@u_acct_svcparts);
5816 foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
5817 push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
5820 my $custnum = $self->getfield('custnum');
5821 foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
5822 my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
5823 #now find the corresponding record(s) in cust_svc (for this pkgnum!)
5824 foreach my $acct_svcpart (@u_acct_svcparts) {
5825 foreach my $i_cust_svc (
5826 qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
5827 'svcpart' => $acct_svcpart } )
5829 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
5830 $email{$svc_acct->svcnum} = $svc_acct->email;
5839 # Used by FS::Upgrade to migrate to a new database.
5840 sub _upgrade_data { # class method
5841 my ($class, %opts) = @_;
5842 $class->_upgrade_otaker(%opts);
5844 # RT#10139, bug resulting in contract_end being set when it shouldn't
5845 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
5846 # RT#10830, bad calculation of prorate date near end of year
5847 # the date range for bill is December 2009, and we move it forward
5848 # one year if it's before the previous bill date (which it should
5850 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
5851 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
5852 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
5853 # RT6628, add order_date to cust_pkg
5854 'update cust_pkg set order_date = (select history_date from h_cust_pkg
5855 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
5856 history_action = \'insert\') where order_date is null',
5858 foreach my $sql (@statements) {
5859 my $sth = dbh->prepare($sql);
5860 $sth->execute or die $sth->errstr;
5863 # RT31194: supplemental package links that are deleted don't clean up
5865 my @pkglinknums = qsearch({
5866 'select' => 'DISTINCT cust_pkg.pkglinknum',
5867 'table' => 'cust_pkg',
5868 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
5869 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
5870 AND part_pkg_link.pkglinknum IS NULL',
5872 foreach (@pkglinknums) {
5873 my $pkglinknum = $_->pkglinknum;
5874 warn "cleaning part_pkg_link #$pkglinknum\n";
5875 my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
5876 my $error = $part_pkg_link->remove_linked;
5877 die $error if $error;
5885 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
5887 In sub order, the @pkgparts array (passed by reference) is clobbered.
5889 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
5890 method to pass dates to the recur_prog expression, it should do so.
5892 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
5893 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
5894 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
5895 configuration values. Probably need a subroutine which decides what to do
5896 based on whether or not we've fetched the user yet, rather than a hash. See
5897 FS::UID and the TODO.
5899 Now that things are transactional should the check in the insert method be
5904 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
5905 L<FS::pkg_svc>, schema.html from the base documentation