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->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
2140 # going to be credited for remaining time, don't keep setup, bill,
2141 # or last_bill dates, and DO pass the flag to cancel() to credit
2143 if ( $opt->{'pkgpart'}
2144 and $opt->{'pkgpart'} != $self->pkgpart
2145 and $self->part_pkg->option('unused_credit_change', 1) ) {
2148 $hash{$_} = '' foreach qw(setup bill last_bill);
2151 if ( $keep_dates ) {
2152 foreach my $date ( qw(setup bill last_bill) ) {
2153 $hash{$date} = $self->getfield($date);
2156 # always keep the following dates
2157 foreach my $date (qw(order_date susp adjourn cancel expire resume
2158 start_date contract_end)) {
2159 $hash{$date} = $self->getfield($date);
2161 # but if contract_end was explicitly specified, that overrides all else
2162 $hash{'contract_end'} = $opt->{'contract_end'}
2163 if $opt->{'contract_end'};
2165 # allow $opt->{'locationnum'} = '' to specifically set it to null
2166 # (i.e. customer default location)
2167 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2169 # usually this doesn't matter. the two cases where it does are:
2170 # 1. unused_credit_change + pkgpart change + setup fee on the new package
2172 # 2. (more importantly) changing a package before it's billed
2173 $hash{'waive_setup'} = $self->waive_setup;
2175 # if this package is scheduled for a future package change, preserve that
2176 $hash{'change_to_pkgnum'} = $self->change_to_pkgnum;
2178 my $custnum = $self->custnum;
2179 if ( $opt->{cust_main} ) {
2180 my $cust_main = $opt->{cust_main};
2181 unless ( $cust_main->custnum ) {
2182 my $error = $cust_main->insert( @{ $opt->{cust_main_insert_args}||[] } );
2184 $dbh->rollback if $oldAutoCommit;
2185 return "inserting customer record: $error";
2188 $custnum = $cust_main->custnum;
2191 $hash{'contactnum'} = $opt->{'contactnum'} if $opt->{'contactnum'};
2194 if ( $opt->{'cust_pkg'} ) {
2195 # The target package already exists; update it to show that it was
2196 # changed from this package.
2197 $cust_pkg = $opt->{'cust_pkg'};
2199 # follow all the above rules for date changes, etc.
2200 foreach (keys %hash) {
2201 $cust_pkg->set($_, $hash{$_});
2203 # except those that implement the future package change behavior
2204 foreach (qw(change_to_pkgnum start_date expire)) {
2205 $cust_pkg->set($_, '');
2208 $error = $cust_pkg->replace;
2211 # Create the new package.
2212 $cust_pkg = new FS::cust_pkg {
2213 custnum => $custnum,
2214 locationnum => $opt->{'locationnum'},
2215 ( map { $_ => ( $opt->{$_} || $self->$_() ) }
2216 qw( pkgpart quantity refnum salesnum )
2220 $error = $cust_pkg->insert( 'change' => 1,
2221 'allow_pkgpart' => $same_pkgpart );
2224 $dbh->rollback if $oldAutoCommit;
2225 return "inserting new package: $error";
2228 # Transfer services and cancel old package.
2229 # Enforce service limits only if this is a pkgpart change.
2230 local $FS::cust_svc::ignore_quantity;
2231 $FS::cust_svc::ignore_quantity = 1 if $same_pkgpart;
2232 $error = $self->transfer($cust_pkg);
2233 if ($error and $error == 0) {
2234 # $old_pkg->transfer failed.
2235 $dbh->rollback if $oldAutoCommit;
2236 return "transferring $error";
2239 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2240 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2241 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
2242 if ($error and $error == 0) {
2243 # $old_pkg->transfer failed.
2244 $dbh->rollback if $oldAutoCommit;
2245 return "converting $error";
2249 # We set unprotect_svcs when executing a "future package change". It's
2250 # not a user-interactive operation, so returning an error means the
2251 # package change will just fail. Rather than have that happen, we'll
2252 # let leftover services be deleted.
2253 if ($error > 0 and !$opt->{'unprotect_svcs'}) {
2254 # Transfers were successful, but we still had services left on the old
2255 # package. We can't change the package under this circumstances, so abort.
2256 $dbh->rollback if $oldAutoCommit;
2257 return "unable to transfer all services";
2260 #reset usage if changing pkgpart
2261 # AND usage rollover is off (otherwise adds twice, now and at package bill)
2262 if ($self->pkgpart != $cust_pkg->pkgpart) {
2263 my $part_pkg = $cust_pkg->part_pkg;
2264 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
2268 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
2271 $dbh->rollback if $oldAutoCommit;
2272 return "setting usage values: $error";
2275 # if NOT changing pkgpart, transfer any usage pools over
2276 foreach my $usage ($self->cust_pkg_usage) {
2277 $usage->set('pkgnum', $cust_pkg->pkgnum);
2278 $error = $usage->replace;
2280 $dbh->rollback if $oldAutoCommit;
2281 return "transferring usage pools: $error";
2286 # transfer discounts, if we're not changing pkgpart
2287 if ( $same_pkgpart ) {
2288 foreach my $old_discount ($self->cust_pkg_discount_active) {
2289 # don't remove the old discount, we may still need to bill that package.
2290 my $new_discount = new FS::cust_pkg_discount {
2291 'pkgnum' => $cust_pkg->pkgnum,
2292 'discountnum' => $old_discount->discountnum,
2293 'months_used' => $old_discount->months_used,
2295 $error = $new_discount->insert;
2297 $dbh->rollback if $oldAutoCommit;
2298 return "transferring discounts: $error";
2303 # transfer (copy) invoice details
2304 foreach my $detail ($self->cust_pkg_detail) {
2305 my $new_detail = FS::cust_pkg_detail->new({ $detail->hash });
2306 $new_detail->set('pkgdetailnum', '');
2307 $new_detail->set('pkgnum', $cust_pkg->pkgnum);
2308 $error = $new_detail->insert;
2310 $dbh->rollback if $oldAutoCommit;
2311 return "transferring package notes: $error";
2317 if ( !$opt->{'cust_pkg'} ) {
2318 # Order any supplemental packages.
2319 my $part_pkg = $cust_pkg->part_pkg;
2320 my @old_supp_pkgs = $self->supplemental_pkgs;
2321 foreach my $link ($part_pkg->supp_part_pkg_link) {
2323 foreach (@old_supp_pkgs) {
2324 if ($_->pkgpart == $link->dst_pkgpart) {
2326 $_->pkgpart(0); # so that it can't match more than once
2330 # false laziness with FS::cust_main::Packages::order_pkg
2331 my $new = FS::cust_pkg->new({
2332 pkgpart => $link->dst_pkgpart,
2333 pkglinknum => $link->pkglinknum,
2334 custnum => $custnum,
2335 main_pkgnum => $cust_pkg->pkgnum,
2336 locationnum => $cust_pkg->locationnum,
2337 start_date => $cust_pkg->start_date,
2338 order_date => $cust_pkg->order_date,
2339 expire => $cust_pkg->expire,
2340 adjourn => $cust_pkg->adjourn,
2341 contract_end => $cust_pkg->contract_end,
2342 refnum => $cust_pkg->refnum,
2343 discountnum => $cust_pkg->discountnum,
2344 waive_setup => $cust_pkg->waive_setup,
2346 if ( $old and $opt->{'keep_dates'} ) {
2347 foreach (qw(setup bill last_bill)) {
2348 $new->set($_, $old->get($_));
2351 $error = $new->insert( allow_pkgpart => $same_pkgpart );
2354 $error ||= $old->transfer($new);
2356 if ( $error and $error > 0 ) {
2357 # no reason why this should ever fail, but still...
2358 $error = "Unable to transfer all services from supplemental package ".
2362 $dbh->rollback if $oldAutoCommit;
2365 push @new_supp_pkgs, $new;
2367 } # if !$opt->{'cust_pkg'}
2368 # because if there is one, then supplemental packages would already
2369 # have been created for it.
2371 #Good to go, cancel old package. Notify 'cancel' of whether to credit
2373 #Don't allow billing the package (preceding period packages and/or
2374 #outstanding usage) if we are keeping dates (i.e. location changing),
2375 #because the new package will be billed for the same date range.
2376 #Supplemental packages are also canceled here.
2378 # during scheduled changes, avoid canceling the package we just
2380 $self->set('change_to_pkgnum' => '');
2382 $error = $self->cancel(
2384 unused_credit => $unused_credit,
2385 nobill => $keep_dates,
2386 change_custnum => ( $self->custnum != $custnum ? $custnum : '' ),
2387 no_delay_cancel => 1,
2390 $dbh->rollback if $oldAutoCommit;
2391 return "canceling old package: $error";
2394 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
2396 my $error = $cust_pkg->cust_main->bill(
2397 'pkg_list' => [ $cust_pkg, @new_supp_pkgs ]
2400 $dbh->rollback if $oldAutoCommit;
2401 return "billing new package: $error";
2405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2411 =item change_later OPTION => VALUE...
2413 Schedule a package change for a later date. This actually orders the new
2414 package immediately, but sets its start date for a future date, and sets
2415 the current package to expire on the same date.
2417 If the package is already scheduled for a change, this can be called with
2418 'start_date' to change the scheduled date, or with pkgpart and/or
2419 locationnum to modify the package change. To cancel the scheduled change
2420 entirely, see C<abort_change>.
2428 The date for the package change. Required, and must be in the future.
2438 The pkgpart, locationnum, quantity and optional contract_end of the new
2439 package, with the same meaning as in C<change>.
2447 my $opt = ref($_[0]) ? shift : { @_ };
2449 # check contract_end, prevent adding/removing
2450 my $error = $self->_check_change($opt);
2451 return $error if $error;
2453 my $oldAutoCommit = $FS::UID::AutoCommit;
2454 local $FS::UID::AutoCommit = 0;
2457 my $cust_main = $self->cust_main;
2459 my $date = delete $opt->{'start_date'} or return 'start_date required';
2461 if ( $date <= time ) {
2462 $dbh->rollback if $oldAutoCommit;
2463 return "start_date $date is in the past";
2466 if ( $self->change_to_pkgnum ) {
2467 my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
2468 my $new_pkgpart = $opt->{'pkgpart'}
2469 if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $change_to->pkgpart;
2470 my $new_locationnum = $opt->{'locationnum'}
2471 if $opt->{'locationnum'} and $opt->{'locationnum'} != $change_to->locationnum;
2472 my $new_quantity = $opt->{'quantity'}
2473 if $opt->{'quantity'} and $opt->{'quantity'} != $change_to->quantity;
2474 my $new_contract_end = $opt->{'contract_end'}
2475 if $opt->{'contract_end'} and $opt->{'contract_end'} != $change_to->contract_end;
2476 if ( $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end ) {
2477 # it hasn't been billed yet, so in principle we could just edit
2478 # it in place (w/o a package change), but that's bad form.
2479 # So change the package according to the new options...
2480 my $err_or_pkg = $change_to->change(%$opt);
2481 if ( ref $err_or_pkg ) {
2482 # Then set that package up for a future start.
2483 $self->set('change_to_pkgnum', $err_or_pkg->pkgnum);
2484 $self->set('expire', $date); # in case it's different
2485 $err_or_pkg->set('start_date', $date);
2486 $err_or_pkg->set('change_date', '');
2487 $err_or_pkg->set('change_pkgnum', '');
2489 $error = $self->replace ||
2490 $err_or_pkg->replace ||
2491 #because change() might've edited existing scheduled change in place
2492 (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' :
2493 $change_to->cancel('no_delay_cancel' => 1) ||
2494 $change_to->delete);
2496 $error = $err_or_pkg;
2498 } else { # change the start date only.
2499 $self->set('expire', $date);
2500 $change_to->set('start_date', $date);
2501 $error = $self->replace || $change_to->replace;
2504 $dbh->rollback if $oldAutoCommit;
2507 $dbh->commit if $oldAutoCommit;
2510 } # if $self->change_to_pkgnum
2512 my $new_pkgpart = $opt->{'pkgpart'}
2513 if $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart;
2514 my $new_locationnum = $opt->{'locationnum'}
2515 if $opt->{'locationnum'} and $opt->{'locationnum'} != $self->locationnum;
2516 my $new_quantity = $opt->{'quantity'}
2517 if $opt->{'quantity'} and $opt->{'quantity'} != $self->quantity;
2518 my $new_contract_end = $opt->{'contract_end'}
2519 if $opt->{'contract_end'} and $opt->{'contract_end'} != $self->contract_end;
2521 return '' unless $new_pkgpart or $new_locationnum or $new_quantity or $new_contract_end; # wouldn't do anything
2523 # allow $opt->{'locationnum'} = '' to specifically set it to null
2524 # (i.e. customer default location)
2525 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
2527 my $new = FS::cust_pkg->new( {
2528 custnum => $self->custnum,
2529 locationnum => $opt->{'locationnum'},
2530 start_date => $date,
2531 map { $_ => ( $opt->{$_} || $self->$_() ) }
2532 qw( pkgpart quantity refnum salesnum contract_end )
2534 $error = $new->insert('change' => 1,
2535 'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
2537 $self->set('change_to_pkgnum', $new->pkgnum);
2538 $self->set('expire', $date);
2539 $error = $self->replace;
2542 $dbh->rollback if $oldAutoCommit;
2544 $dbh->commit if $oldAutoCommit;
2552 Cancels a future package change scheduled by C<change_later>.
2558 my $pkgnum = $self->change_to_pkgnum;
2559 my $change_to = FS::cust_pkg->by_key($pkgnum) if $pkgnum;
2562 $error = $change_to->cancel || $change_to->delete;
2563 return $error if $error;
2565 $self->set('change_to_pkgnum', '');
2566 $self->set('expire', '');
2570 =item set_quantity QUANTITY
2572 Change the package's quantity field. This is one of the few package properties
2573 that can safely be changed without canceling and reordering the package
2574 (because it doesn't affect tax eligibility). Returns an error or an
2581 $self = $self->replace_old; # just to make sure
2582 $self->quantity(shift);
2586 =item set_salesnum SALESNUM
2588 Change the package's salesnum (sales person) field. This is one of the few
2589 package properties that can safely be changed without canceling and reordering
2590 the package (because it doesn't affect tax eligibility). Returns an error or
2597 $self = $self->replace_old; # just to make sure
2598 $self->salesnum(shift);
2600 # XXX this should probably reassign any credit that's already been given
2603 =item modify_charge OPTIONS
2605 Change the properties of a one-time charge. The following properties can
2606 be changed this way:
2607 - pkg: the package description
2608 - classnum: the package class
2609 - additional: arrayref of additional invoice details to add to this package
2611 and, I<if the charge has not yet been billed>:
2612 - start_date: the date when it will be billed
2613 - amount: the setup fee to be charged
2614 - quantity: the multiplier for the setup fee
2615 - separate_bill: whether to put the charge on a separate invoice
2617 If you pass 'adjust_commission' => 1, and the classnum changes, and there are
2618 commission credits linked to this charge, they will be recalculated.
2625 my $part_pkg = $self->part_pkg;
2626 my $pkgnum = $self->pkgnum;
2629 my $oldAutoCommit = $FS::UID::AutoCommit;
2630 local $FS::UID::AutoCommit = 0;
2632 return "Can't use modify_charge except on one-time charges"
2633 unless $part_pkg->freq eq '0';
2635 if ( length($opt{'pkg'}) and $part_pkg->pkg ne $opt{'pkg'} ) {
2636 $part_pkg->set('pkg', $opt{'pkg'});
2639 my %pkg_opt = $part_pkg->options;
2640 my $pkg_opt_modified = 0;
2642 $opt{'additional'} ||= [];
2645 foreach (grep /^additional/, keys %pkg_opt) {
2646 ($i) = ($_ =~ /^additional_info(\d+)$/);
2647 $old_additional[$i] = $pkg_opt{$_} if $i;
2648 delete $pkg_opt{$_};
2651 for ( $i = 0; exists($opt{'additional'}->[$i]); $i++ ) {
2652 $pkg_opt{ "additional_info$i" } = $opt{'additional'}->[$i];
2653 if (!exists($old_additional[$i])
2654 or $old_additional[$i] ne $opt{'additional'}->[$i])
2656 $pkg_opt_modified = 1;
2659 $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
2660 $pkg_opt{'additional_count'} = $i if $i > 0;
2663 if ( exists($opt{'classnum'}) and $part_pkg->classnum ne $opt{'classnum'} )
2666 $old_classnum = $part_pkg->classnum;
2667 $part_pkg->set('classnum', $opt{'classnum'});
2670 if ( !$self->get('setup') ) {
2671 # not yet billed, so allow amount, setup_cost, quantity, start_date,
2674 if ( exists($opt{'amount'})
2675 and $part_pkg->option('setup_fee') != $opt{'amount'}
2676 and $opt{'amount'} > 0 ) {
2678 $pkg_opt{'setup_fee'} = $opt{'amount'};
2679 $pkg_opt_modified = 1;
2682 if ( exists($opt{'setup_cost'})
2683 and $part_pkg->setup_cost != $opt{'setup_cost'}
2684 and $opt{'setup_cost'} > 0 ) {
2686 $part_pkg->set('setup_cost', $opt{'setup_cost'});
2689 if ( exists($opt{'quantity'})
2690 and $opt{'quantity'} != $self->quantity
2691 and $opt{'quantity'} > 0 ) {
2693 $self->set('quantity', $opt{'quantity'});
2696 if ( exists($opt{'start_date'})
2697 and $opt{'start_date'} != $self->start_date ) {
2699 $self->set('start_date', $opt{'start_date'});
2702 if ( exists($opt{'separate_bill'})
2703 and $opt{'separate_bill'} ne $self->separate_bill ) {
2705 $self->set('separate_bill', $opt{'separate_bill'});
2709 } # else simply ignore them; the UI shouldn't allow editing the fields
2711 if ( exists($opt{'taxclass'})
2712 and $part_pkg->taxclass ne $opt{'taxclass'}) {
2714 $part_pkg->set('taxclass', $opt{'taxclass'});
2718 if ( $part_pkg->modified or $pkg_opt_modified ) {
2719 # can we safely modify the package def?
2720 # Yes, if it's not available for purchase, and this is the only instance
2722 if ( $part_pkg->disabled
2723 and FS::cust_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 1
2724 and FS::quotation_pkg->count('pkgpart = '.$part_pkg->pkgpart) == 0
2726 $error = $part_pkg->replace( options => \%pkg_opt );
2729 $part_pkg = $part_pkg->clone;
2730 $part_pkg->set('disabled' => 'Y');
2731 $error = $part_pkg->insert( options => \%pkg_opt );
2732 # and associate this as yet-unbilled package to the new package def
2733 $self->set('pkgpart' => $part_pkg->pkgpart);
2736 $dbh->rollback if $oldAutoCommit;
2741 if ($self->modified) { # for quantity or start_date change, or if we had
2742 # to clone the existing package def
2743 my $error = $self->replace;
2744 return $error if $error;
2746 if (defined $old_classnum) {
2747 # fix invoice grouping records
2748 my $old_catname = $old_classnum
2749 ? FS::pkg_class->by_key($old_classnum)->categoryname
2751 my $new_catname = $opt{'classnum'}
2752 ? $part_pkg->pkg_class->categoryname
2754 if ( $old_catname ne $new_catname ) {
2755 foreach my $cust_bill_pkg ($self->cust_bill_pkg) {
2756 # (there should only be one...)
2757 my @display = qsearch( 'cust_bill_pkg_display', {
2758 'billpkgnum' => $cust_bill_pkg->billpkgnum,
2759 'section' => $old_catname,
2761 foreach (@display) {
2762 $_->set('section', $new_catname);
2763 $error = $_->replace;
2765 $dbh->rollback if $oldAutoCommit;
2769 } # foreach $cust_bill_pkg
2772 if ( $opt{'adjust_commission'} ) {
2773 # fix commission credits...tricky.
2774 foreach my $cust_event ($self->cust_event) {
2775 my $part_event = $cust_event->part_event;
2776 foreach my $table (qw(sales agent)) {
2778 "FS::part_event::Action::Mixin::credit_${table}_pkg_class";
2779 my $credit = qsearchs('cust_credit', {
2780 'eventnum' => $cust_event->eventnum,
2782 if ( $part_event->isa($class) ) {
2783 # Yes, this results in current commission rates being applied
2784 # retroactively to a one-time charge. For accounting purposes
2785 # there ought to be some kind of time limit on doing this.
2786 my $amount = $part_event->_calc_credit($self);
2787 if ( $credit and $credit->amount ne $amount ) {
2788 # Void the old credit.
2789 $error = $credit->void('Package class changed');
2791 $dbh->rollback if $oldAutoCommit;
2792 return "$error (adjusting commission credit)";
2795 # redo the event action to recreate the credit.
2797 eval { $part_event->do_action( $self, $cust_event ) };
2799 $dbh->rollback if $oldAutoCommit;
2802 } # if $part_event->isa($class)
2804 } # foreach $cust_event
2805 } # if $opt{'adjust_commission'}
2806 } # if defined $old_classnum
2808 $dbh->commit if $oldAutoCommit;
2814 use Storable 'thaw';
2817 sub process_bulk_cust_pkg {
2819 my $param = thaw(decode_base64(shift));
2820 warn Dumper($param) if $DEBUG;
2822 my $old_part_pkg = qsearchs('part_pkg',
2823 { pkgpart => $param->{'old_pkgpart'} });
2824 my $new_part_pkg = qsearchs('part_pkg',
2825 { pkgpart => $param->{'new_pkgpart'} });
2826 die "Must select a new package type\n" unless $new_part_pkg;
2827 #my $keep_dates = $param->{'keep_dates'} || 0;
2828 my $keep_dates = 1; # there is no good reason to turn this off
2830 local $SIG{HUP} = 'IGNORE';
2831 local $SIG{INT} = 'IGNORE';
2832 local $SIG{QUIT} = 'IGNORE';
2833 local $SIG{TERM} = 'IGNORE';
2834 local $SIG{TSTP} = 'IGNORE';
2835 local $SIG{PIPE} = 'IGNORE';
2837 my $oldAutoCommit = $FS::UID::AutoCommit;
2838 local $FS::UID::AutoCommit = 0;
2841 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
2844 foreach my $old_cust_pkg ( @cust_pkgs ) {
2846 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
2847 if ( $old_cust_pkg->getfield('cancel') ) {
2848 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
2849 $old_cust_pkg->pkgnum."\n"
2853 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
2855 my $error = $old_cust_pkg->change(
2856 'pkgpart' => $param->{'new_pkgpart'},
2857 'keep_dates' => $keep_dates
2859 if ( !ref($error) ) { # change returns the cust_pkg on success
2861 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
2864 $dbh->commit if $oldAutoCommit;
2870 Returns the last bill date, or if there is no last bill date, the setup date.
2871 Useful for billing metered services.
2877 return $self->setfield('last_bill', $_[0]) if @_;
2878 return $self->getfield('last_bill') if $self->getfield('last_bill');
2879 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
2880 'edate' => $self->bill, } );
2881 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
2884 =item last_cust_pkg_reason ACTION
2886 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
2887 Returns false if there is no reason or the package is not currenly ACTION'd
2888 ACTION is one of adjourn, susp, cancel, or expire.
2892 sub last_cust_pkg_reason {
2893 my ( $self, $action ) = ( shift, shift );
2894 my $date = $self->get($action);
2896 'table' => 'cust_pkg_reason',
2897 'hashref' => { 'pkgnum' => $self->pkgnum,
2898 'action' => substr(uc($action), 0, 1),
2901 'order_by' => 'ORDER BY num DESC LIMIT 1',
2905 =item last_reason ACTION
2907 Returns the most recent ACTION FS::reason associated with the package.
2908 Returns false if there is no reason or the package is not currenly ACTION'd
2909 ACTION is one of adjourn, susp, cancel, or expire.
2914 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
2915 $cust_pkg_reason->reason
2916 if $cust_pkg_reason;
2921 Returns the definition for this billing item, as an FS::part_pkg object (see
2928 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
2929 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
2930 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
2935 Returns the cancelled package this package was changed from, if any.
2941 return '' unless $self->change_pkgnum;
2942 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
2945 =item change_cust_main
2947 Returns the customter this package was detached to, if any.
2951 sub change_cust_main {
2953 return '' unless $self->change_custnum;
2954 qsearchs('cust_main', { 'custnum' => $self->change_custnum } );
2959 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
2966 $self->part_pkg->calc_setup($self, @_);
2971 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
2978 $self->part_pkg->calc_recur($self, @_);
2983 Returns the base setup fee (per unit) of this package, from the package
2988 # minimal version for 3.x; in 4.x this can invoke currency conversion
2992 $self->part_pkg->unit_setup($self);
2997 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
3004 $self->part_pkg->base_recur($self, @_);
3009 Calls the I<calc_remain> of the FS::part_pkg object associated with this
3016 $self->part_pkg->calc_remain($self, @_);
3021 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
3028 $self->part_pkg->calc_cancel($self, @_);
3033 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
3039 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
3042 =item cust_pkg_detail [ DETAILTYPE ]
3044 Returns any customer package details for this package (see
3045 L<FS::cust_pkg_detail>).
3047 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3051 sub cust_pkg_detail {
3053 my %hash = ( 'pkgnum' => $self->pkgnum );
3054 $hash{detailtype} = shift if @_;
3056 'table' => 'cust_pkg_detail',
3057 'hashref' => \%hash,
3058 'order_by' => 'ORDER BY weight, pkgdetailnum',
3062 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
3064 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
3066 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
3068 If there is an error, returns the error, otherwise returns false.
3072 sub set_cust_pkg_detail {
3073 my( $self, $detailtype, @details ) = @_;
3075 local $SIG{HUP} = 'IGNORE';
3076 local $SIG{INT} = 'IGNORE';
3077 local $SIG{QUIT} = 'IGNORE';
3078 local $SIG{TERM} = 'IGNORE';
3079 local $SIG{TSTP} = 'IGNORE';
3080 local $SIG{PIPE} = 'IGNORE';
3082 my $oldAutoCommit = $FS::UID::AutoCommit;
3083 local $FS::UID::AutoCommit = 0;
3086 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
3087 my $error = $current->delete;
3089 $dbh->rollback if $oldAutoCommit;
3090 return "error removing old detail: $error";
3094 foreach my $detail ( @details ) {
3095 my $cust_pkg_detail = new FS::cust_pkg_detail {
3096 'pkgnum' => $self->pkgnum,
3097 'detailtype' => $detailtype,
3098 'detail' => $detail,
3100 my $error = $cust_pkg_detail->insert;
3102 $dbh->rollback if $oldAutoCommit;
3103 return "error adding new detail: $error";
3108 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3115 Returns the customer billing events (see L<FS::cust_event>) for this invoice.
3119 #false laziness w/cust_bill.pm
3123 'table' => 'cust_event',
3124 'addl_from' => 'JOIN part_event USING ( eventpart )',
3125 'hashref' => { 'tablenum' => $self->pkgnum },
3126 'extra_sql' => " AND eventtable = 'cust_pkg' ",
3130 =item num_cust_event
3132 Returns the number of customer billing events (see L<FS::cust_event>) for this package.
3136 #false laziness w/cust_bill.pm
3137 sub num_cust_event {
3139 my $sql = "SELECT COUNT(*) ". $self->_from_cust_event_where;
3140 $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref->[0];
3143 =item exists_cust_event
3145 Returns true if there are customer billing events (see L<FS::cust_event>) for this package. More efficient than using num_cust_event.
3149 sub exists_cust_event {
3151 my $sql = "SELECT 1 ". $self->_from_cust_event_where. " LIMIT 1";
3152 my $row = $self->_prep_ex($sql, $self->pkgnum)->fetchrow_arrayref;
3153 $row ? $row->[0] : '';
3156 sub _from_cust_event_where {
3158 " FROM cust_event JOIN part_event USING ( eventpart ) ".
3159 " WHERE tablenum = ? AND eventtable = 'cust_pkg' ";
3163 my( $self, $sql, @args ) = @_;
3164 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
3165 $sth->execute(@args) or die $sth->errstr. " executing $sql";
3169 =item cust_svc [ SVCPART ] (old, deprecated usage)
3171 =item cust_svc [ OPTION => VALUE ... ] (current usage)
3173 =item cust_svc_unsorted [ OPTION => VALUE ... ]
3175 Returns the services for this package, as FS::cust_svc objects (see
3176 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
3177 spcififed, returns only the matching services.
3179 As an optimization, use the cust_svc_unsorted version if you are not displaying
3186 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
3187 $self->_sort_cust_svc( $self->cust_svc_unsorted_arrayref(@_) );
3190 sub cust_svc_unsorted {
3192 @{ $self->cust_svc_unsorted_arrayref(@_) };
3195 sub cust_svc_unsorted_arrayref {
3198 return [] unless $self->num_cust_svc(@_);
3201 if ( @_ && $_[0] =~ /^\d+/ ) {
3202 $opt{svcpart} = shift;
3203 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3210 'select' => 'cust_svc.*, part_svc.*',
3211 'table' => 'cust_svc',
3212 'hashref' => { 'pkgnum' => $self->pkgnum },
3213 'addl_from' => 'LEFT JOIN part_svc USING ( svcpart )',
3215 $search{hashref}->{svcpart} = $opt{svcpart}
3217 $search{extra_sql} = ' AND svcdb = '. dbh->quote( $opt{svcdb} )
3220 [ qsearch(\%search) ];
3224 =item overlimit [ SVCPART ]
3226 Returns the services for this package which have exceeded their
3227 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
3228 is specified, return only the matching services.
3234 return () unless $self->num_cust_svc(@_);
3235 grep { $_->overlimit } $self->cust_svc(@_);
3238 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3240 Returns historical services for this package created before END TIMESTAMP and
3241 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
3242 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
3243 I<pkg_svc.hidden> flag will be omitted.
3249 warn "$me _h_cust_svc called on $self\n"
3252 my ($end, $start, $mode) = @_;
3253 my @cust_svc = $self->_sort_cust_svc(
3254 [ qsearch( 'h_cust_svc',
3255 { 'pkgnum' => $self->pkgnum, },
3256 FS::h_cust_svc->sql_h_search(@_),
3259 if ( defined($mode) && $mode eq 'I' ) {
3260 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
3261 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
3267 sub _sort_cust_svc {
3268 my( $self, $arrayref ) = @_;
3271 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
3273 my %pkg_svc = map { $_->svcpart => $_ }
3274 qsearch( 'pkg_svc', { 'pkgpart' => $self->pkgpart } );
3279 my $pkg_svc = $pkg_svc{ $_->svcpart } || '';
3281 $pkg_svc ? $pkg_svc->primary_svc : '',
3282 $pkg_svc ? $pkg_svc->quantity : 0,
3289 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
3291 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
3293 Returns the number of services for this package. Available options are svcpart
3294 and svcdb. If either is spcififed, returns only the matching services.
3301 return $self->{'_num_cust_svc'}
3303 && exists($self->{'_num_cust_svc'})
3304 && $self->{'_num_cust_svc'} =~ /\d/;
3306 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
3310 if ( @_ && $_[0] =~ /^\d+/ ) {
3311 $opt{svcpart} = shift;
3312 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
3318 my $select = 'SELECT COUNT(*) FROM cust_svc ';
3319 my $where = ' WHERE pkgnum = ? ';
3320 my @param = ($self->pkgnum);
3322 if ( $opt{'svcpart'} ) {
3323 $where .= ' AND svcpart = ? ';
3324 push @param, $opt{'svcpart'};
3326 if ( $opt{'svcdb'} ) {
3327 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
3328 $where .= ' AND svcdb = ? ';
3329 push @param, $opt{'svcdb'};
3332 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
3333 $sth->execute(@param) or die $sth->errstr;
3334 $sth->fetchrow_arrayref->[0];
3337 =item available_part_svc
3339 Returns a list of FS::part_svc objects representing services included in this
3340 package but not yet provisioned. Each FS::part_svc object also has an extra
3341 field, I<num_avail>, which specifies the number of available services.
3343 Accepts option I<provision_hold>; if true, only returns part_svc for which the
3344 associated pkg_svc has the provision_hold flag set.
3348 sub available_part_svc {
3352 my $pkg_quantity = $self->quantity || 1;
3354 grep { $_->num_avail > 0 }
3356 my $part_svc = $_->part_svc;
3357 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
3358 $pkg_quantity * $_->quantity - $self->num_cust_svc($_->svcpart);
3360 # more evil encapsulation breakage
3361 if ($part_svc->{'Hash'}{'num_avail'} > 0) {
3362 my @exports = $part_svc->part_export_did;
3363 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
3368 grep { $opt{'provision_hold'} ? $_->provision_hold : 1 }
3369 $self->part_pkg->pkg_svc;
3372 =item part_svc [ OPTION => VALUE ... ]
3374 Returns a list of FS::part_svc objects representing provisioned and available
3375 services included in this package. Each FS::part_svc object also has the
3376 following extra fields:
3390 (services) - array reference containing the provisioned services, as cust_svc objects
3394 Accepts two options:
3398 =item summarize_size
3400 If true, will omit the extra cust_pkg_svc option for objects where num_cust_svc
3401 is this size or greater.
3403 =item hide_discontinued
3405 If true, will omit looking for services that are no longer avaialble in the
3413 #label -> ($cust_svc->label)[1]
3419 my $pkg_quantity = $self->quantity || 1;
3421 #XXX some sort of sort order besides numeric by svcpart...
3422 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
3424 my $part_svc = $pkg_svc->part_svc;
3425 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3426 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
3427 $part_svc->{'Hash'}{'num_avail'} =
3428 max( 0, $pkg_quantity * $pkg_svc->quantity - $num_cust_svc );
3429 $part_svc->{'Hash'}{'cust_pkg_svc'} =
3430 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
3431 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
3432 && $num_cust_svc >= $opt{summarize_size};
3433 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
3435 } $self->part_pkg->pkg_svc;
3437 unless ( $opt{hide_discontinued} ) {
3439 push @part_svc, map {
3441 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
3442 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
3443 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
3444 $part_svc->{'Hash'}{'cust_pkg_svc'} =
3445 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
3447 } $self->extra_part_svc;
3454 =item extra_part_svc
3456 Returns a list of FS::part_svc objects corresponding to services in this
3457 package which are still provisioned but not (any longer) available in the
3462 sub extra_part_svc {
3465 my $pkgnum = $self->pkgnum;
3466 #my $pkgpart = $self->pkgpart;
3469 # 'table' => 'part_svc',
3472 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
3473 # WHERE pkg_svc.svcpart = part_svc.svcpart
3474 # AND pkg_svc.pkgpart = ?
3477 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
3478 # LEFT JOIN cust_pkg USING ( pkgnum )
3479 # WHERE cust_svc.svcpart = part_svc.svcpart
3482 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
3485 #seems to benchmark slightly faster... (or did?)
3487 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
3488 my $pkgparts = join(',', @pkgparts);
3491 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
3492 #MySQL doesn't grok DISINCT ON
3493 'select' => 'DISTINCT part_svc.*',
3494 'table' => 'part_svc',
3496 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
3497 AND pkg_svc.pkgpart IN ($pkgparts)
3500 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
3501 LEFT JOIN cust_pkg USING ( pkgnum )
3504 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
3505 'extra_param' => [ [$self->pkgnum=>'int'] ],
3511 Returns a short status string for this package, currently:
3517 =item not yet billed
3519 =item one-time charge
3534 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
3536 return 'cancelled' if $self->get('cancel');
3537 return 'on hold' if $self->susp && ! $self->setup;
3538 return 'suspended' if $self->susp;
3539 return 'not yet billed' unless $self->setup;
3540 return 'one-time charge' if $freq =~ /^(0|$)/;
3544 =item ucfirst_status
3546 Returns the status with the first character capitalized.
3550 sub ucfirst_status {
3551 ucfirst(shift->status);
3556 Class method that returns the list of possible status strings for packages
3557 (see L<the status method|/status>). For example:
3559 @statuses = FS::cust_pkg->statuses();
3563 tie my %statuscolor, 'Tie::IxHash',
3564 'on hold' => 'FF00F5', #brighter purple!
3565 'not yet billed' => '009999', #teal? cyan?
3566 'one-time charge' => '0000CC', #blue #'000000',
3567 'active' => '00CC00',
3568 'suspended' => 'FF9900',
3569 'cancelled' => 'FF0000',
3573 my $self = shift; #could be class...
3574 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
3575 # # mayble split btw one-time vs. recur
3586 Returns a hex triplet color string for this package's status.
3592 $statuscolor{$self->status};
3595 =item is_status_delay_cancel
3597 Returns true if part_pkg has option delay_cancel,
3598 cust_pkg status is 'suspended' and expire is set
3599 to cancel package within the next day (or however
3600 many days are set in global config part_pkg-delay_cancel-days.
3602 Accepts option I<part_pkg-delay_cancel-days> which should be
3603 the value of the config setting, to avoid looking it up again.
3605 This is not a real status, this only meant for hacking display
3606 values, because otherwise treating the package as suspended is
3607 really the whole point of the delay_cancel option.
3611 sub is_status_delay_cancel {
3612 my ($self,%opt) = @_;
3613 if ( $self->main_pkgnum and $self->pkglinknum ) {
3614 return $self->main_pkg->is_status_delay_cancel;
3616 return 0 unless $self->part_pkg->option('delay_cancel',1);
3617 return 0 unless $self->status eq 'suspended';
3618 return 0 unless $self->expire;
3619 my $expdays = $opt{'part_pkg-delay_cancel-days'};
3621 my $conf = new FS::Conf;
3622 $expdays = $conf->config('part_pkg-delay_cancel-days') || 1;
3624 my $expsecs = 60*60*24*$expdays;
3625 return 0 unless $self->expire < time + $expsecs;
3631 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
3632 "pkg - comment" depending on user preference).
3638 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
3639 $label = $self->pkgnum. ": $label"
3640 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
3644 =item pkg_label_long
3646 Returns a long label for this package, adding the primary service's label to
3651 sub pkg_label_long {
3653 my $label = $self->pkg_label;
3654 my $cust_svc = $self->primary_cust_svc;
3655 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
3661 Returns a customer-localized label for this package.
3667 $self->part_pkg->pkg_locale( $self->cust_main->locale );
3670 =item primary_cust_svc
3672 Returns a primary service (as FS::cust_svc object) if one can be identified.
3676 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
3678 sub primary_cust_svc {
3681 my @cust_svc = $self->cust_svc;
3683 return '' unless @cust_svc; #no serivces - irrelevant then
3685 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
3687 # primary service as specified in the package definition
3688 # or exactly one service definition with quantity one
3689 my $svcpart = $self->part_pkg->svcpart;
3690 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
3691 return $cust_svc[0] if scalar(@cust_svc) == 1;
3693 #couldn't identify one thing..
3699 Returns a list of lists, calling the label method for all services
3700 (see L<FS::cust_svc>) of this billing item.
3706 map { [ $_->label ] } $self->cust_svc;
3709 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
3711 Like the labels method, but returns historical information on services that
3712 were active as of END_TIMESTAMP and (optionally) not cancelled before
3713 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
3714 I<pkg_svc.hidden> flag will be omitted.
3716 Returns a list of lists, calling the label method for all (historical) services
3717 (see L<FS::h_cust_svc>) of this billing item.
3723 warn "$me _h_labels called on $self\n"
3725 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
3730 Like labels, except returns a simple flat list, and shortens long
3731 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3732 identical services to one line that lists the service label and the number of
3733 individual services rather than individual items.
3738 shift->_labels_short( 'labels', @_ );
3741 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
3743 Like h_labels, except returns a simple flat list, and shortens long
3744 (currently >5 or the cust_bill-max_same_services configuration value) lists of
3745 identical services to one line that lists the service label and the number of
3746 individual services rather than individual items.
3750 sub h_labels_short {
3751 shift->_labels_short( 'h_labels', @_ );
3755 my( $self, $method ) = ( shift, shift );
3757 warn "$me _labels_short called on $self with $method method\n"
3760 my $conf = new FS::Conf;
3761 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
3763 warn "$me _labels_short populating \%labels\n"
3767 #tie %labels, 'Tie::IxHash';
3768 push @{ $labels{$_->[0]} }, $_->[1]
3769 foreach $self->$method(@_);
3771 warn "$me _labels_short populating \@labels\n"
3775 foreach my $label ( keys %labels ) {
3777 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
3778 my $num = scalar(@values);
3779 warn "$me _labels_short $num items for $label\n"
3782 if ( $num > $max_same_services ) {
3783 warn "$me _labels_short more than $max_same_services, so summarizing\n"
3785 push @labels, "$label ($num)";
3787 if ( $conf->exists('cust_bill-consolidate_services') ) {
3788 warn "$me _labels_short consolidating services\n"
3790 # push @labels, "$label: ". join(', ', @values);
3792 my $detail = "$label: ";
3793 $detail .= shift(@values). ', '
3795 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
3797 push @labels, $detail;
3799 warn "$me _labels_short done consolidating services\n"
3802 warn "$me _labels_short adding service data\n"
3804 push @labels, map { "$label: $_" } @values;
3815 Returns the parent customer object (see L<FS::cust_main>).
3821 cluck 'cust_pkg->cust_main called' if $DEBUG;
3822 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
3827 Returns the balance for this specific package, when using
3828 experimental package balance.
3834 $self->cust_main->balance_pkgnum( $self->pkgnum );
3837 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
3841 Returns the location object, if any (see L<FS::cust_location>).
3843 =item cust_location_or_main
3845 If this package is associated with a location, returns the locaiton (see
3846 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
3848 =item location_label [ OPTION => VALUE ... ]
3850 Returns the label of the location object (see L<FS::cust_location>).
3854 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
3856 =item tax_locationnum
3858 Returns the foreign key to a L<FS::cust_location> object for calculating
3859 tax on this package, as determined by the C<tax-pkg_address> and
3860 C<tax-ship_address> configuration flags.
3864 sub tax_locationnum {
3866 my $conf = FS::Conf->new;
3867 if ( $conf->exists('tax-pkg_address') ) {
3868 return $self->locationnum;
3870 elsif ( $conf->exists('tax-ship_address') ) {
3871 return $self->cust_main->ship_locationnum;
3874 return $self->cust_main->bill_locationnum;
3880 Returns the L<FS::cust_location> object for tax_locationnum.
3886 my $conf = FS::Conf->new;
3887 if ( $conf->exists('tax-pkg_address') and $self->locationnum ) {
3888 return FS::cust_location->by_key($self->locationnum);
3890 elsif ( $conf->exists('tax-ship_address') ) {
3891 return $self->cust_main->ship_location;
3894 return $self->cust_main->bill_location;
3898 =item seconds_since TIMESTAMP
3900 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
3901 package have been online since TIMESTAMP, according to the session monitor.
3903 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
3904 L<Time::Local> and L<Date::Parse> for conversion functions.
3909 my($self, $since) = @_;
3912 foreach my $cust_svc (
3913 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
3915 $seconds += $cust_svc->seconds_since($since);
3922 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
3924 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
3925 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
3928 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3929 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
3935 sub seconds_since_sqlradacct {
3936 my($self, $start, $end) = @_;
3940 foreach my $cust_svc (
3942 my $part_svc = $_->part_svc;
3943 $part_svc->svcdb eq 'svc_acct'
3944 && scalar($part_svc->part_export_usage);
3947 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
3954 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
3956 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
3957 in this package for sessions ending between TIMESTAMP_START (inclusive) and
3961 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
3962 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
3967 sub attribute_since_sqlradacct {
3968 my($self, $start, $end, $attrib) = @_;
3972 foreach my $cust_svc (
3974 my $part_svc = $_->part_svc;
3975 scalar($part_svc->part_export_usage);
3978 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
3990 my( $self, $value ) = @_;
3991 if ( defined($value) ) {
3992 $self->setfield('quantity', $value);
3994 $self->getfield('quantity') || 1;
3997 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
3999 Transfers as many services as possible from this package to another package.
4001 The destination package can be specified by pkgnum by passing an FS::cust_pkg
4002 object. The destination package must already exist.
4004 Services are moved only if the destination allows services with the correct
4005 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
4006 this option with caution! No provision is made for export differences
4007 between the old and new service definitions. Probably only should be used
4008 when your exports for all service definitions of a given svcdb are identical.
4009 (attempt a transfer without it first, to move all possible svcpart-matching
4012 Any services that can't be moved remain in the original package.
4014 Returns an error, if there is one; otherwise, returns the number of services
4015 that couldn't be moved.
4020 my ($self, $dest_pkgnum, %opt) = @_;
4026 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
4027 $dest = $dest_pkgnum;
4028 $dest_pkgnum = $dest->pkgnum;
4030 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
4033 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
4035 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
4036 $target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
4039 foreach my $cust_svc ($dest->cust_svc) {
4040 $target{$cust_svc->svcpart}--;
4043 my %svcpart2svcparts = ();
4044 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4045 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
4046 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
4047 next if exists $svcpart2svcparts{$svcpart};
4048 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
4049 $svcpart2svcparts{$svcpart} = [
4051 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
4053 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
4054 'svcpart' => $_ } );
4056 $pkg_svc ? $pkg_svc->primary_svc : '',
4057 $pkg_svc ? $pkg_svc->quantity : 0,
4061 grep { $_ != $svcpart }
4063 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
4065 warn "alternates for svcpart $svcpart: ".
4066 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
4072 foreach my $cust_svc ($self->cust_svc) {
4073 my $svcnum = $cust_svc->svcnum;
4074 if($target{$cust_svc->svcpart} > 0
4075 or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
4076 $target{$cust_svc->svcpart}--;
4077 my $new = new FS::cust_svc { $cust_svc->hash };
4078 $new->pkgnum($dest_pkgnum);
4079 $error = $new->replace($cust_svc);
4080 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
4082 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
4083 warn "alternates to consider: ".
4084 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
4086 my @alternate = grep {
4087 warn "considering alternate svcpart $_: ".
4088 "$target{$_} available in new package\n"
4091 } @{$svcpart2svcparts{$cust_svc->svcpart}};
4093 warn "alternate(s) found\n" if $DEBUG;
4094 my $change_svcpart = $alternate[0];
4095 $target{$change_svcpart}--;
4096 my $new = new FS::cust_svc { $cust_svc->hash };
4097 $new->svcpart($change_svcpart);
4098 $new->pkgnum($dest_pkgnum);
4099 $error = $new->replace($cust_svc);
4107 my @label = $cust_svc->label;
4108 return "service $label[1]: $error";
4114 =item grab_svcnums SVCNUM, SVCNUM ...
4116 Change the pkgnum for the provided services to this packages. If there is an
4117 error, returns the error, otherwise returns false.
4125 local $SIG{HUP} = 'IGNORE';
4126 local $SIG{INT} = 'IGNORE';
4127 local $SIG{QUIT} = 'IGNORE';
4128 local $SIG{TERM} = 'IGNORE';
4129 local $SIG{TSTP} = 'IGNORE';
4130 local $SIG{PIPE} = 'IGNORE';
4132 my $oldAutoCommit = $FS::UID::AutoCommit;
4133 local $FS::UID::AutoCommit = 0;
4136 foreach my $svcnum (@svcnum) {
4137 my $cust_svc = qsearchs('cust_svc', { svcnum=>$svcnum } ) or do {
4138 $dbh->rollback if $oldAutoCommit;
4139 return "unknown svcnum $svcnum";
4141 $cust_svc->pkgnum( $self->pkgnum );
4142 my $error = $cust_svc->replace;
4144 $dbh->rollback if $oldAutoCommit;
4149 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4156 This method is deprecated. See the I<depend_jobnum> option to the insert and
4157 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
4164 local $SIG{HUP} = 'IGNORE';
4165 local $SIG{INT} = 'IGNORE';
4166 local $SIG{QUIT} = 'IGNORE';
4167 local $SIG{TERM} = 'IGNORE';
4168 local $SIG{TSTP} = 'IGNORE';
4169 local $SIG{PIPE} = 'IGNORE';
4171 my $oldAutoCommit = $FS::UID::AutoCommit;
4172 local $FS::UID::AutoCommit = 0;
4175 foreach my $cust_svc ( $self->cust_svc ) {
4176 #false laziness w/svc_Common::insert
4177 my $svc_x = $cust_svc->svc_x;
4178 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
4179 my $error = $part_export->export_insert($svc_x);
4181 $dbh->rollback if $oldAutoCommit;
4187 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4192 =item export_pkg_change OLD_CUST_PKG
4194 Calls the "pkg_change" export action for all services attached to this package.
4198 sub export_pkg_change {
4199 my( $self, $old ) = ( shift, shift );
4201 local $SIG{HUP} = 'IGNORE';
4202 local $SIG{INT} = 'IGNORE';
4203 local $SIG{QUIT} = 'IGNORE';
4204 local $SIG{TERM} = 'IGNORE';
4205 local $SIG{TSTP} = 'IGNORE';
4206 local $SIG{PIPE} = 'IGNORE';
4208 my $oldAutoCommit = $FS::UID::AutoCommit;
4209 local $FS::UID::AutoCommit = 0;
4212 foreach my $svc_x ( map $_->svc_x, $self->cust_svc ) {
4213 my $error = $svc_x->export('pkg_change', $self, $old);
4215 $dbh->rollback if $oldAutoCommit;
4220 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
4227 Associates this package with a (suspension or cancellation) reason (see
4228 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
4231 Available options are:
4237 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.
4241 the access_user (see L<FS::access_user>) providing the reason
4249 the action (cancel, susp, adjourn, expire) associated with the reason
4253 If there is an error, returns the error, otherwise returns false.
4258 my ($self, %options) = @_;
4260 my $otaker = $options{reason_otaker} ||
4261 $FS::CurrentUser::CurrentUser->username;
4264 if ( $options{'reason'} =~ /^(\d+)$/ ) {
4268 } elsif ( ref($options{'reason'}) ) {
4270 return 'Enter a new reason (or select an existing one)'
4271 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
4273 my $reason = new FS::reason({
4274 'reason_type' => $options{'reason'}->{'typenum'},
4275 'reason' => $options{'reason'}->{'reason'},
4277 my $error = $reason->insert;
4278 return $error if $error;
4280 $reasonnum = $reason->reasonnum;
4283 return "Unparseable reason: ". $options{'reason'};
4286 my $cust_pkg_reason =
4287 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
4288 'reasonnum' => $reasonnum,
4289 'otaker' => $otaker,
4290 'action' => substr(uc($options{'action'}),0,1),
4291 'date' => $options{'date'}
4296 $cust_pkg_reason->insert;
4299 =item insert_discount
4301 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
4302 inserting a new discount on the fly (see L<FS::discount>).
4304 Available options are:
4312 If there is an error, returns the error, otherwise returns false.
4316 sub insert_discount {
4317 #my ($self, %options) = @_;
4320 my $cust_pkg_discount = new FS::cust_pkg_discount {
4321 'pkgnum' => $self->pkgnum,
4322 'discountnum' => $self->discountnum,
4324 'end_date' => '', #XXX
4325 #for the create a new discount case
4326 '_type' => $self->discountnum__type,
4327 'amount' => $self->discountnum_amount,
4328 'percent' => $self->discountnum_percent,
4329 'months' => $self->discountnum_months,
4330 'setup' => $self->discountnum_setup,
4331 #'disabled' => $self->discountnum_disabled,
4334 $cust_pkg_discount->insert;
4337 =item set_usage USAGE_VALUE_HASHREF
4339 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4340 to which they should be set (see L<FS::svc_acct>). Currently seconds,
4341 upbytes, downbytes, and totalbytes are appropriate keys.
4343 All svc_accts which are part of this package have their values reset.
4348 my ($self, $valueref, %opt) = @_;
4350 #only svc_acct can set_usage for now
4351 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4352 my $svc_x = $cust_svc->svc_x;
4353 $svc_x->set_usage($valueref, %opt)
4354 if $svc_x->can("set_usage");
4358 =item recharge USAGE_VALUE_HASHREF
4360 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
4361 to which they should be set (see L<FS::svc_acct>). Currently seconds,
4362 upbytes, downbytes, and totalbytes are appropriate keys.
4364 All svc_accts which are part of this package have their values incremented.
4369 my ($self, $valueref) = @_;
4371 #only svc_acct can set_usage for now
4372 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
4373 my $svc_x = $cust_svc->svc_x;
4374 $svc_x->recharge($valueref)
4375 if $svc_x->can("recharge");
4379 =item cust_pkg_discount
4383 sub cust_pkg_discount {
4385 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
4388 =item cust_pkg_discount_active
4392 sub cust_pkg_discount_active {
4394 grep { $_->status eq 'active' } $self->cust_pkg_discount;
4397 =item cust_pkg_usage
4399 Returns a list of all voice usage counters attached to this package.
4403 sub cust_pkg_usage {
4405 qsearch('cust_pkg_usage', { pkgnum => $self->pkgnum });
4408 =item apply_usage OPTIONS
4410 Takes the following options:
4411 - cdr: a call detail record (L<FS::cdr>)
4412 - rate_detail: the rate determined for this call (L<FS::rate_detail>)
4413 - minutes: the maximum number of minutes to be charged
4415 Finds available usage minutes for a call of this class, and subtracts
4416 up to that many minutes from the usage pool. If the usage pool is empty,
4417 and the C<cdr-minutes_priority> global config option is set, minutes may
4418 be taken from other calls as well. Either way, an allocation record will
4419 be created (L<FS::cdr_cust_pkg_usage>) and this method will return the
4420 number of minutes of usage applied to the call.
4425 my ($self, %opt) = @_;
4426 my $cdr = $opt{cdr};
4427 my $rate_detail = $opt{rate_detail};
4428 my $minutes = $opt{minutes};
4429 my $classnum = $rate_detail->classnum;
4430 my $pkgnum = $self->pkgnum;
4431 my $custnum = $self->custnum;
4433 local $SIG{HUP} = 'IGNORE';
4434 local $SIG{INT} = 'IGNORE';
4435 local $SIG{QUIT} = 'IGNORE';
4436 local $SIG{TERM} = 'IGNORE';
4437 local $SIG{TSTP} = 'IGNORE';
4438 local $SIG{PIPE} = 'IGNORE';
4440 my $oldAutoCommit = $FS::UID::AutoCommit;
4441 local $FS::UID::AutoCommit = 0;
4443 my $order = FS::Conf->new->config('cdr-minutes_priority');
4447 $is_classnum = ' part_pkg_usage_class.classnum = '.$classnum;
4449 $is_classnum = ' part_pkg_usage_class.classnum IS NULL';
4451 my @usage_recs = qsearch({
4452 'table' => 'cust_pkg_usage',
4453 'addl_from' => ' JOIN part_pkg_usage USING (pkgusagepart)'.
4454 ' JOIN cust_pkg USING (pkgnum)'.
4455 ' JOIN part_pkg_usage_class USING (pkgusagepart)',
4456 'select' => 'cust_pkg_usage.*',
4457 'extra_sql' => " WHERE ( cust_pkg.pkgnum = $pkgnum OR ".
4458 " ( cust_pkg.custnum = $custnum AND ".
4459 " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4460 $is_classnum . ' AND '.
4461 " cust_pkg_usage.minutes > 0",
4462 'order_by' => " ORDER BY priority ASC",
4465 my $orig_minutes = $minutes;
4467 while (!$error and $minutes > 0 and @usage_recs) {
4468 my $cust_pkg_usage = shift @usage_recs;
4469 $cust_pkg_usage->select_for_update;
4470 my $cdr_cust_pkg_usage = FS::cdr_cust_pkg_usage->new({
4471 pkgusagenum => $cust_pkg_usage->pkgusagenum,
4472 acctid => $cdr->acctid,
4473 minutes => min($cust_pkg_usage->minutes, $minutes),
4475 $cust_pkg_usage->set('minutes',
4476 $cust_pkg_usage->minutes - $cdr_cust_pkg_usage->minutes
4478 $error = $cust_pkg_usage->replace || $cdr_cust_pkg_usage->insert;
4479 $minutes -= $cdr_cust_pkg_usage->minutes;
4481 if ( $order and $minutes > 0 and !$error ) {
4482 # then try to steal minutes from another call
4484 'table' => 'cdr_cust_pkg_usage',
4485 'addl_from' => ' JOIN cust_pkg_usage USING (pkgusagenum)'.
4486 ' JOIN part_pkg_usage USING (pkgusagepart)'.
4487 ' JOIN cust_pkg USING (pkgnum)'.
4488 ' JOIN part_pkg_usage_class USING (pkgusagepart)'.
4489 ' JOIN cdr USING (acctid)',
4490 'select' => 'cdr_cust_pkg_usage.*',
4491 'extra_sql' => " WHERE cdr.freesidestatus = 'rated' AND ".
4492 " ( cust_pkg.pkgnum = $pkgnum OR ".
4493 " ( cust_pkg.custnum = $custnum AND ".
4494 " part_pkg_usage.shared IS NOT NULL ) ) AND ".
4495 " part_pkg_usage_class.classnum = $classnum",
4496 'order_by' => ' ORDER BY part_pkg_usage.priority ASC',
4498 if ( $order eq 'time' ) {
4499 # find CDRs that are using minutes, but have a later startdate
4501 my $startdate = $cdr->startdate;
4502 if ($startdate !~ /^\d+$/) {
4503 die "bad cdr startdate '$startdate'";
4505 $search{'extra_sql'} .= " AND cdr.startdate > $startdate";
4506 # minimize needless reshuffling
4507 $search{'order_by'} .= ', cdr.startdate DESC';
4509 # XXX may not work correctly with rate_time schedules. Could
4510 # fix this by storing ratedetailnum in cdr_cust_pkg_usage, I
4512 $search{'addl_from'} .=
4513 ' JOIN rate_detail'.
4514 ' ON (cdr.rated_ratedetailnum = rate_detail.ratedetailnum)';
4515 if ( $order eq 'rate_high' ) {
4516 $search{'extra_sql'} .= ' AND rate_detail.min_charge < '.
4517 $rate_detail->min_charge;
4518 $search{'order_by'} .= ', rate_detail.min_charge ASC';
4519 } elsif ( $order eq 'rate_low' ) {
4520 $search{'extra_sql'} .= ' AND rate_detail.min_charge > '.
4521 $rate_detail->min_charge;
4522 $search{'order_by'} .= ', rate_detail.min_charge DESC';
4524 # this should really never happen
4525 die "invalid cdr-minutes_priority value '$order'\n";
4528 my @cdr_usage_recs = qsearch(\%search);
4530 while (!$error and @cdr_usage_recs and $minutes > 0) {
4531 my $cdr_cust_pkg_usage = shift @cdr_usage_recs;
4532 my $cust_pkg_usage = $cdr_cust_pkg_usage->cust_pkg_usage;
4533 my $old_cdr = $cdr_cust_pkg_usage->cdr;
4534 $reproc_cdrs{$old_cdr->acctid} = $old_cdr;
4535 $cdr_cust_pkg_usage->select_for_update;
4536 $old_cdr->select_for_update;
4537 $cust_pkg_usage->select_for_update;
4538 # in case someone else stole the usage from this CDR
4539 # while waiting for the lock...
4540 next if $old_cdr->acctid != $cdr_cust_pkg_usage->acctid;
4541 # steal the usage allocation and flag the old CDR for reprocessing
4542 $cdr_cust_pkg_usage->set('acctid', $cdr->acctid);
4543 # if the allocation is more minutes than we need, adjust it...
4544 my $delta = $cdr_cust_pkg_usage->minutes - $minutes;
4546 $cdr_cust_pkg_usage->set('minutes', $minutes);
4547 $cust_pkg_usage->set('minutes', $cust_pkg_usage->minutes + $delta);
4548 $error = $cust_pkg_usage->replace;
4550 #warn 'CDR '.$cdr->acctid . ' stealing allocation '.$cdr_cust_pkg_usage->cdrusagenum.' from CDR '.$old_cdr->acctid."\n";
4551 $error ||= $cdr_cust_pkg_usage->replace;
4552 # deduct the stolen minutes
4553 $minutes -= $cdr_cust_pkg_usage->minutes;
4555 # after all minute-stealing is done, reset the affected CDRs
4556 foreach (values %reproc_cdrs) {
4557 $error ||= $_->set_status('');
4558 # XXX or should we just call $cdr->rate right here?
4559 # it's not like we can create a loop this way, since the min_charge
4560 # or call time has to go monotonically in one direction.
4561 # we COULD get some very deep recursions going, though...
4563 } # if $order and $minutes
4566 die "error applying included minutes\npkgnum ".$self->pkgnum.", class $classnum, acctid ".$cdr->acctid."\n$error\n"
4568 $dbh->commit if $oldAutoCommit;
4569 return $orig_minutes - $minutes;
4573 =item supplemental_pkgs
4575 Returns a list of all packages supplemental to this one.
4579 sub supplemental_pkgs {
4581 qsearch('cust_pkg', { 'main_pkgnum' => $self->pkgnum });
4586 Returns the package that this one is supplemental to, if any.
4592 if ( $self->main_pkgnum ) {
4593 return FS::cust_pkg->by_key($self->main_pkgnum);
4600 =head1 CLASS METHODS
4606 Returns an SQL expression identifying recurring packages.
4610 sub recurring_sql { "
4611 '0' != ( select freq from part_pkg
4612 where cust_pkg.pkgpart = part_pkg.pkgpart )
4617 Returns an SQL expression identifying one-time packages.
4622 '0' = ( select freq from part_pkg
4623 where cust_pkg.pkgpart = part_pkg.pkgpart )
4628 Returns an SQL expression identifying ordered packages (recurring packages not
4634 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
4639 Returns an SQL expression identifying active packages.
4644 $_[0]->recurring_sql. "
4645 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4646 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4647 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4650 =item not_yet_billed_sql
4652 Returns an SQL expression identifying packages which have not yet been billed.
4656 sub not_yet_billed_sql { "
4657 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
4658 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4659 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4664 Returns an SQL expression identifying inactive packages (one-time packages
4665 that are otherwise unsuspended/uncancelled).
4669 sub inactive_sql { "
4670 ". $_[0]->onetime_sql(). "
4671 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4672 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4673 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
4678 Returns an SQL expression identifying on-hold packages.
4683 #$_[0]->recurring_sql(). ' AND '.
4685 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4686 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
4687 AND ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
4694 Returns an SQL expression identifying suspended packages.
4698 sub suspended_sql { susp_sql(@_); }
4700 #$_[0]->recurring_sql(). ' AND '.
4702 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
4703 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
4704 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
4711 Returns an SQL exprression identifying cancelled packages.
4715 sub cancelled_sql { cancel_sql(@_); }
4717 #$_[0]->recurring_sql(). ' AND '.
4718 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
4723 Returns an SQL expression to give the package status as a string.
4729 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
4730 WHEN ( cust_pkg.susp IS NOT NULL AND cust_pkg.setup IS NULL ) THEN 'on hold'
4731 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
4732 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
4733 WHEN ".onetime_sql()." THEN 'one-time charge'
4738 =item search HASHREF
4742 Returns a qsearch hash expression to search for parameters specified in HASHREF.
4743 Valid parameters are
4751 on hold, active, inactive (or one-time charge), suspended, canceled (or cancelled)
4755 Equivalent to "status", except that "canceled"/"cancelled" will exclude
4756 packages that were changed into a new package with the same pkgpart (i.e.
4757 location or quantity changes).
4761 boolean selects custom packages
4767 pkgpart or arrayref or hashref of pkgparts
4771 arrayref of beginning and ending epoch date
4775 arrayref of beginning and ending epoch date
4779 arrayref of beginning and ending epoch date
4783 arrayref of beginning and ending epoch date
4787 arrayref of beginning and ending epoch date
4791 arrayref of beginning and ending epoch date
4795 arrayref of beginning and ending epoch date
4799 pkgnum or APKG_pkgnum
4803 a value suited to passing to FS::UI::Web::cust_header
4807 specifies the user for agent virtualization
4811 boolean; if true, returns only packages with more than 0 FCC phone lines.
4813 =item state, country
4815 Limit to packages with a service location in the specified state and country.
4816 For FCC 477 reporting, mostly.
4820 Limit to packages whose service locations are the same as the customer's
4821 default service location.
4823 =item location_nocust
4825 Limit to packages whose service locations are not the customer's default
4828 =item location_census
4830 Limit to packages whose service locations have census tracts.
4832 =item location_nocensus
4834 Limit to packages whose service locations do not have a census tract.
4836 =item location_geocode
4838 Limit to packages whose locations have geocodes.
4840 =item location_geocode
4842 Limit to packages whose locations do not have geocodes.
4846 Limit to packages associated with a svc_broadband, associated with a sector,
4847 associated with this towernum (or any of these, if it's an arrayref) (or NO
4848 towernum, if it's zero). This is an extreme niche case.
4850 =item 477part, 477rownum, date
4852 Limit to packages included in a specific row of one of the FCC 477 reports.
4853 '477part' is the section name (see L<FS::Report::FCC_477> methods), 'date'
4854 is the report as-of date (completely unrelated to the package setup/bill/
4855 other date fields), and '477rownum' is the row number of the report starting
4856 with zero. Row numbers have no inherent meaning, so this is useful only
4857 for explaining a 477 report you've already run.
4864 my ($class, $params) = @_;
4871 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
4873 "cust_main.agentnum = $1";
4880 if ( $params->{'cust_status'} =~ /^([a-z]+)$/ ) {
4881 push @where, FS::cust_main->cust_status_sql . " = '$1' ";
4885 # parse customer sales person
4888 if ( $params->{'cust_main_salesnum'} =~ /^(\d+)$/ ) {
4889 push @where, ($1 > 0) ? "cust_main.salesnum = $1"
4890 : 'cust_main.salesnum IS NULL';
4895 # parse sales person
4898 if ( $params->{'salesnum'} =~ /^(\d+)$/ ) {
4899 push @where, ($1 > 0) ? "cust_pkg.salesnum = $1"
4900 : 'cust_pkg.salesnum IS NULL';
4907 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
4909 "cust_pkg.custnum = $1";
4916 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
4918 "cust_pkg.pkgbatch = '$1'";
4925 if ( $params->{'magic'} eq 'active'
4926 || $params->{'status'} eq 'active' ) {
4928 push @where, FS::cust_pkg->active_sql();
4930 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
4931 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
4933 push @where, FS::cust_pkg->not_yet_billed_sql();
4935 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
4936 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
4938 push @where, FS::cust_pkg->inactive_sql();
4940 } elsif ( $params->{'magic'} =~ /^on[ _]hold$/
4941 || $params->{'status'} =~ /^on[ _]hold$/ ) {
4943 push @where, FS::cust_pkg->on_hold_sql();
4946 } elsif ( $params->{'magic'} eq 'suspended'
4947 || $params->{'status'} eq 'suspended' ) {
4949 push @where, FS::cust_pkg->suspended_sql();
4951 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
4952 || $params->{'status'} =~ /^cancell?ed$/ ) {
4954 push @where, FS::cust_pkg->cancelled_sql();
4958 ### special case: "magic" is used in detail links from browse/part_pkg,
4959 # where "cancelled" has the restriction "and not replaced with a package
4960 # of the same pkgpart". Be consistent with that.
4963 if ( $params->{'magic'} =~ /^cancell?ed$/ ) {
4964 my $new_pkgpart = "SELECT pkgpart FROM cust_pkg AS cust_pkg_next ".
4965 "WHERE cust_pkg_next.change_pkgnum = cust_pkg.pkgnum";
4966 # ...may not exist, if this was just canceled and not changed; in that
4967 # case give it a "new pkgpart" that never equals the old pkgpart
4968 push @where, "COALESCE(($new_pkgpart), 0) != cust_pkg.pkgpart";
4972 # parse package class
4975 if ( exists($params->{'classnum'}) ) {
4978 if ( ref($params->{'classnum'}) ) {
4980 if ( ref($params->{'classnum'}) eq 'HASH' ) {
4981 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
4982 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
4983 @classnum = @{ $params->{'classnum'} };
4985 die 'unhandled classnum ref '. $params->{'classnum'};
4989 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
4996 my @nums = grep $_, @classnum;
4997 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
4998 my $null = scalar( grep { $_ eq '' } @classnum );
4999 push @c_where, 'part_pkg.classnum IS NULL' if $null;
5001 if ( scalar(@c_where) == 1 ) {
5002 push @where, @c_where;
5003 } elsif ( @c_where ) {
5004 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
5013 # parse refnum (advertising source)
5016 if ( exists($params->{'refnum'}) ) {
5018 if (ref $params->{'refnum'}) {
5019 @refnum = @{ $params->{'refnum'} };
5021 @refnum = ( $params->{'refnum'} );
5023 my $in = join(',', grep /^\d+$/, @refnum);
5024 push @where, "refnum IN($in)" if length $in;
5028 # parse package report options
5031 my @report_option = ();
5032 if ( exists($params->{'report_option'}) ) {
5033 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
5034 @report_option = @{ $params->{'report_option'} };
5035 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
5036 @report_option = split(',', $1);
5041 if (@report_option) {
5042 # this will result in the empty set for the dangling comma case as it should
5044 map{ "0 < ( SELECT count(*) FROM part_pkg_option
5045 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
5046 AND optionname = 'report_option_$_'
5047 AND optionvalue = '1' )"
5051 foreach my $any ( grep /^report_option_any/, keys %$params ) {
5053 my @report_option_any = ();
5054 if ( ref($params->{$any}) eq 'ARRAY' ) {
5055 @report_option_any = @{ $params->{$any} };
5056 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
5057 @report_option_any = split(',', $1);
5060 if (@report_option_any) {
5061 # this will result in the empty set for the dangling comma case as it should
5062 push @where, ' ( '. join(' OR ',
5063 map{ "0 < ( SELECT count(*) FROM part_pkg_option
5064 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
5065 AND optionname = 'report_option_$_'
5066 AND optionvalue = '1' )"
5067 } @report_option_any
5077 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
5083 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
5084 if $params->{fcc_line};
5090 if ( exists($params->{'censustract'}) ) {
5091 $params->{'censustract'} =~ /^([.\d]*)$/;
5092 my $censustract = "cust_location.censustract = '$1'";
5093 $censustract .= ' OR cust_location.censustract is NULL' unless $1;
5094 push @where, "( $censustract )";
5098 # parse censustract2
5100 if ( exists($params->{'censustract2'})
5101 && $params->{'censustract2'} =~ /^(\d*)$/
5105 push @where, "cust_location.censustract LIKE '$1%'";
5108 "( cust_location.censustract = '' OR cust_location.censustract IS NULL )";
5113 # parse country/state/zip
5115 for (qw(state country)) { # parsing rules are the same for these
5116 if ( exists($params->{$_})
5117 && uc($params->{$_}) =~ /^([A-Z]{2})$/ )
5119 # XXX post-2.3 only--before that, state/country may be in cust_main
5120 push @where, "cust_location.$_ = '$1'";
5123 if ( exists($params->{zip}) ) {
5124 push @where, "cust_location.zip = " . dbh->quote($params->{zip});
5130 if ( $params->{location_cust} xor $params->{location_nocust} ) {
5131 my $op = $params->{location_cust} ? '=' : '!=';
5132 push @where, "cust_location.locationnum $op cust_main.ship_locationnum";
5134 if ( $params->{location_census} xor $params->{location_nocensus} ) {
5135 my $op = $params->{location_census} ? "IS NOT NULL" : "IS NULL";
5136 push @where, "cust_location.censustract $op";
5138 if ( $params->{location_geocode} xor $params->{location_nogeocode} ) {
5139 my $op = $params->{location_geocode} ? "IS NOT NULL" : "IS NULL";
5140 push @where, "cust_location.geocode $op";
5147 if ( ref($params->{'pkgpart'}) ) {
5150 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
5151 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
5152 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
5153 @pkgpart = @{ $params->{'pkgpart'} };
5155 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
5158 @pkgpart = grep /^(\d+)$/, @pkgpart;
5160 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
5162 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
5163 push @where, "pkgpart = $1";
5172 #false laziness w/report_cust_pkg.html
5175 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
5176 'active' => { 'susp'=>1, 'cancel'=>1 },
5177 'suspended' => { 'cancel' => 1 },
5182 if( exists($params->{'active'} ) ) {
5183 # This overrides all the other date-related fields, and includes packages
5184 # that were active at some time during the interval. It excludes:
5185 # - packages that were set up after the end of the interval
5186 # - packages that were canceled before the start of the interval
5187 # - packages that were suspended before the start of the interval
5188 # and are still suspended now
5189 my($beginning, $ending) = @{$params->{'active'}};
5191 "cust_pkg.setup IS NOT NULL",
5192 "cust_pkg.setup <= $ending",
5193 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
5194 "(cust_pkg.susp IS NULL OR cust_pkg.susp >= $beginning )",
5195 "NOT (".FS::cust_pkg->onetime_sql . ")";
5198 my $exclude_change_from = 0;
5199 my $exclude_change_to = 0;
5201 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
5203 next unless exists($params->{$field});
5205 my($beginning, $ending) = @{$params->{$field}};
5207 next if $beginning == 0 && $ending == 4294967295;
5210 "cust_pkg.$field IS NOT NULL",
5211 "cust_pkg.$field >= $beginning",
5212 "cust_pkg.$field <= $ending";
5214 $orderby ||= "ORDER BY cust_pkg.$field";
5216 if ( $field eq 'setup' ) {
5217 $exclude_change_from = 1;
5218 } elsif ( $field eq 'cancel' ) {
5219 $exclude_change_to = 1;
5220 } elsif ( $field eq 'change_date' ) {
5221 # if we are given setup and change_date ranges, and the setup date
5222 # falls in _both_ ranges, then include the package whether it was
5224 $exclude_change_from = 0;
5228 if ($exclude_change_from) {
5229 push @where, "change_pkgnum IS NULL";
5231 if ($exclude_change_to) {
5232 # a join might be more efficient here
5233 push @where, "NOT EXISTS(
5234 SELECT 1 FROM cust_pkg AS changed_to_pkg
5235 WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
5240 $orderby ||= 'ORDER BY bill';
5243 # parse magic, legacy, etc.
5246 if ( $params->{'magic'} &&
5247 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
5250 $orderby = 'ORDER BY pkgnum';
5252 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
5253 push @where, "pkgpart = $1";
5256 } elsif ( $params->{'query'} eq 'pkgnum' ) {
5258 $orderby = 'ORDER BY pkgnum';
5260 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
5262 $orderby = 'ORDER BY pkgnum';
5265 SELECT count(*) FROM pkg_svc
5266 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
5267 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
5268 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
5269 AND cust_svc.svcpart = pkg_svc.svcpart
5276 # parse the extremely weird 'towernum' param
5279 if ($params->{towernum}) {
5280 my $towernum = $params->{towernum};
5281 $towernum = [ $towernum ] if !ref($towernum);
5282 my $in = join(',', grep /^\d+$/, @$towernum);
5284 # inefficient, but this is an obscure feature
5285 eval "use FS::Report::Table";
5286 FS::Report::Table->_init_tower_pkg_cache; # probably does nothing
5287 push @where, "EXISTS(
5288 SELECT 1 FROM tower_pkg_cache
5289 WHERE tower_pkg_cache.pkgnum = cust_pkg.pkgnum
5290 AND tower_pkg_cache.towernum IN ($in)
5296 # parse the 477 report drill-down options
5299 if ($params->{'477part'} =~ /^([a-z]+)$/) {
5301 my ($date, $rownum, $agentnum);
5302 if ($params->{'date'} =~ /^(\d+)$/) {
5305 if ($params->{'477rownum'} =~ /^(\d+)$/) {
5308 if ($params->{'agentnum'} =~ /^(\d+)$/) {
5311 if ($date and defined($rownum)) {
5312 my $report = FS::Report::FCC_477->report($section,
5314 'agentnum' => $agentnum,
5317 my $pkgnums = $report->{detail}->[$rownum]
5318 or die "row $rownum is past the end of the report";
5319 # '0' so that if there are no pkgnums (empty string) it will create
5320 # a valid query that returns nothing
5321 warn "PKGNUMS:\n$pkgnums\n\n"; # XXX debug
5323 # and this overrides everything
5324 @where = ( "cust_pkg.pkgnum IN($pkgnums)" );
5325 } # else we're missing some params, ignore the whole business
5329 # setup queries, links, subs, etc. for the search
5332 # here is the agent virtualization
5333 if ($params->{CurrentUser}) {
5335 qsearchs('access_user', { username => $params->{CurrentUser} });
5338 push @where, $access_user->agentnums_sql('table'=>'cust_main');
5343 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
5346 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
5348 my $addl_from = 'LEFT JOIN part_pkg USING ( pkgpart ) '.
5349 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '.
5350 'LEFT JOIN cust_location USING ( locationnum ) '.
5351 FS::UI::Web::join_cust_main('cust_pkg', 'cust_pkg');
5355 if ( $params->{'select_zip5'} ) {
5356 my $zip = 'cust_location.zip';
5358 $select = "DISTINCT substr($zip,1,5) as zip";
5359 $orderby = "ORDER BY substr($zip,1,5)";
5360 $count_query = "SELECT COUNT( DISTINCT substr($zip,1,5) )";
5362 $select = join(', ',
5364 ( map "part_pkg.$_", qw( pkg freq ) ),
5365 'pkg_class.classname',
5366 'cust_main.custnum AS cust_main_custnum',
5367 FS::UI::Web::cust_sql_fields(
5368 $params->{'cust_fields'}
5371 $count_query = 'SELECT COUNT(*)';
5374 $count_query .= " FROM cust_pkg $addl_from $extra_sql";
5377 'table' => 'cust_pkg',
5379 'select' => $select,
5380 'extra_sql' => $extra_sql,
5381 'order_by' => $orderby,
5382 'addl_from' => $addl_from,
5383 'count_query' => $count_query,
5390 Returns a list of two package counts. The first is a count of packages
5391 based on the supplied criteria and the second is the count of residential
5392 packages with those same criteria. Criteria are specified as in the search
5398 my ($class, $params) = @_;
5400 my $sql_query = $class->search( $params );
5402 my $count_sql = delete($sql_query->{'count_query'});
5403 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
5404 or die "couldn't parse count_sql";
5406 my $count_sth = dbh->prepare($count_sql)
5407 or die "Error preparing $count_sql: ". dbh->errstr;
5409 or die "Error executing $count_sql: ". $count_sth->errstr;
5410 my $count_arrayref = $count_sth->fetchrow_arrayref;
5412 return ( @$count_arrayref );
5416 =item tax_locationnum_sql
5418 Returns an SQL expression for the tax location for a package, based
5419 on the settings of 'tax-pkg_address' and 'tax-ship_address'.
5423 sub tax_locationnum_sql {
5424 my $conf = FS::Conf->new;
5425 if ( $conf->exists('tax-pkg_address') ) {
5426 'cust_pkg.locationnum';
5428 elsif ( $conf->exists('tax-ship_address') ) {
5429 'cust_main.ship_locationnum';
5432 'cust_main.bill_locationnum';
5438 Returns a list: the first item is an SQL fragment identifying matching
5439 packages/customers via location (taking into account shipping and package
5440 address taxation, if enabled), and subsequent items are the parameters to
5441 substitute for the placeholders in that fragment.
5446 my($class, %opt) = @_;
5447 my $ornull = $opt{'ornull'};
5449 my $conf = new FS::Conf;
5451 # '?' placeholders in _location_sql_where
5452 my $x = $ornull ? 3 : 2;
5463 if ( $conf->exists('tax-ship_address') ) {
5466 ( ( ship_last IS NULL OR ship_last = '' )
5467 AND ". _location_sql_where('cust_main', '', $ornull ). "
5469 OR ( ship_last IS NOT NULL AND ship_last != ''
5470 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
5473 # AND payby != 'COMP'
5475 @main_param = ( @bill_param, @bill_param );
5479 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
5480 @main_param = @bill_param;
5486 if ( $conf->exists('tax-pkg_address') ) {
5488 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
5491 ( cust_pkg.locationnum IS NULL AND $main_where )
5492 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
5495 @param = ( @main_param, @bill_param );
5499 $where = $main_where;
5500 @param = @main_param;
5508 #subroutine, helper for location_sql
5509 sub _location_sql_where {
5511 my $prefix = @_ ? shift : '';
5512 my $ornull = @_ ? shift : '';
5514 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
5516 $ornull = $ornull ? ' OR ? IS NULL ' : '';
5518 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
5519 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
5520 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
5522 my $text = (driver_name =~ /^mysql/i) ? 'char' : 'text';
5524 # ( $table.${prefix}city = ? $or_empty_city $ornull )
5526 ( $table.district = ? OR ? = '' OR CAST(? AS $text) IS NULL )
5527 AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS $text) IS NULL )
5528 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
5529 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
5530 AND $table.${prefix}country = ?
5535 my( $self, $what ) = @_;
5537 my $what_show_zero = $what. '_show_zero';
5538 length($self->$what_show_zero())
5539 ? ($self->$what_show_zero() eq 'Y')
5540 : $self->part_pkg->$what_show_zero();
5547 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
5549 Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the
5550 bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
5552 CUSTNUM is a customer (see L<FS::cust_main>)
5554 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5555 L<FS::part_pkg>) to order for this customer. Duplicates are of course
5558 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
5559 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
5560 new billing items. An error is returned if this is not possible (see
5561 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
5564 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5565 newly-created cust_pkg objects.
5567 REFNUM, if specified, will specify the FS::pkg_referral record to be created
5568 and inserted. Multiple FS::pkg_referral records can be created by
5569 setting I<refnum> to an array reference of refnums or a hash reference with
5570 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
5571 record will be created corresponding to cust_main.refnum.
5576 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
5578 my $conf = new FS::Conf;
5580 # Transactionize this whole mess
5581 local $SIG{HUP} = 'IGNORE';
5582 local $SIG{INT} = 'IGNORE';
5583 local $SIG{QUIT} = 'IGNORE';
5584 local $SIG{TERM} = 'IGNORE';
5585 local $SIG{TSTP} = 'IGNORE';
5586 local $SIG{PIPE} = 'IGNORE';
5588 my $oldAutoCommit = $FS::UID::AutoCommit;
5589 local $FS::UID::AutoCommit = 0;
5593 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
5594 # return "Customer not found: $custnum" unless $cust_main;
5596 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
5599 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5602 my $change = scalar(@old_cust_pkg) != 0;
5605 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
5607 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
5608 " to pkgpart ". $pkgparts->[0]. "\n"
5611 my $err_or_cust_pkg =
5612 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
5613 'refnum' => $refnum,
5616 unless (ref($err_or_cust_pkg)) {
5617 $dbh->rollback if $oldAutoCommit;
5618 return $err_or_cust_pkg;
5621 push @$return_cust_pkg, $err_or_cust_pkg;
5622 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5627 # Create the new packages.
5628 foreach my $pkgpart (@$pkgparts) {
5630 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
5632 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
5633 pkgpart => $pkgpart,
5637 $error = $cust_pkg->insert( 'change' => $change );
5638 push @$return_cust_pkg, $cust_pkg;
5640 foreach my $link ($cust_pkg->part_pkg->supp_part_pkg_link) {
5641 my $supp_pkg = FS::cust_pkg->new({
5642 custnum => $custnum,
5643 pkgpart => $link->dst_pkgpart,
5645 main_pkgnum => $cust_pkg->pkgnum,
5648 $error ||= $supp_pkg->insert( 'change' => $change );
5649 push @$return_cust_pkg, $supp_pkg;
5653 $dbh->rollback if $oldAutoCommit;
5658 # $return_cust_pkg now contains refs to all of the newly
5661 # Transfer services and cancel old packages.
5662 foreach my $old_pkg (@old_cust_pkg) {
5664 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
5667 foreach my $new_pkg (@$return_cust_pkg) {
5668 $error = $old_pkg->transfer($new_pkg);
5669 if ($error and $error == 0) {
5670 # $old_pkg->transfer failed.
5671 $dbh->rollback if $oldAutoCommit;
5676 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
5677 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
5678 foreach my $new_pkg (@$return_cust_pkg) {
5679 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
5680 if ($error and $error == 0) {
5681 # $old_pkg->transfer failed.
5682 $dbh->rollback if $oldAutoCommit;
5689 # Transfers were successful, but we went through all of the
5690 # new packages and still had services left on the old package.
5691 # We can't cancel the package under the circumstances, so abort.
5692 $dbh->rollback if $oldAutoCommit;
5693 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
5695 $error = $old_pkg->cancel( quiet=>1, 'no_delay_cancel'=>1 );
5701 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5705 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
5707 A bulk change method to change packages for multiple customers.
5709 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
5710 L<FS::part_pkg>) to order for each customer. Duplicates are of course
5713 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
5714 replace. The services (see L<FS::cust_svc>) are moved to the
5715 new billing items. An error is returned if this is not possible (see
5718 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
5719 newly-created cust_pkg objects.
5724 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
5726 # Transactionize this whole mess
5727 local $SIG{HUP} = 'IGNORE';
5728 local $SIG{INT} = 'IGNORE';
5729 local $SIG{QUIT} = 'IGNORE';
5730 local $SIG{TERM} = 'IGNORE';
5731 local $SIG{TSTP} = 'IGNORE';
5732 local $SIG{PIPE} = 'IGNORE';
5734 my $oldAutoCommit = $FS::UID::AutoCommit;
5735 local $FS::UID::AutoCommit = 0;
5739 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
5742 while(scalar(@old_cust_pkg)) {
5744 my $custnum = $old_cust_pkg[0]->custnum;
5745 my (@remove) = map { $_->pkgnum }
5746 grep { $_->custnum == $custnum } @old_cust_pkg;
5747 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
5749 my $error = order $custnum, $pkgparts, \@remove, \@return;
5751 push @errors, $error
5753 push @$return_cust_pkg, @return;
5756 if (scalar(@errors)) {
5757 $dbh->rollback if $oldAutoCommit;
5758 return join(' / ', @errors);
5761 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
5765 =item forward_emails
5767 Returns a hash of svcnums and corresponding email addresses
5768 for svc_acct services that can be used as source or dest
5769 for svc_forward services provisioned in this package.
5771 Accepts options I<svc_forward> OR I<svcnum> for a svc_forward
5772 service; if included, will ensure the current values of the
5773 specified service are included in the list, even if for some
5774 other reason they wouldn't be. If called as a class method
5775 with a specified service, returns only these current values.
5777 Caution: does not actually check if svc_forward services are
5778 available to be provisioned on this package.
5782 sub forward_emails {
5786 #load optional service, thoroughly validated
5787 die "Use svcnum or svc_forward, not both"
5788 if $opt{'svcnum'} && $opt{'svc_forward'};
5789 my $svc_forward = $opt{'svc_forward'};
5790 $svc_forward ||= qsearchs('svc_forward',{ 'svcnum' => $opt{'svcnum'} })
5792 die "Specified service is not a forward service"
5793 if $svc_forward && (ref($svc_forward) ne 'FS::svc_forward');
5794 die "Specified service not found"
5795 if ($opt{'svcnum'} || $opt{'svc_forward'}) && !$svc_forward;
5799 ## everything below was basically copied from httemplate/edit/svc_forward.cgi
5800 ## with minimal refactoring, not sure why we can't just load all svc_accts for this custnum
5802 #add current values from specified service, if there was one
5804 foreach my $method (qw( srcsvc_acct dstsvc_acct )) {
5805 my $svc_acct = $svc_forward->$method();
5806 $email{$svc_acct->svcnum} = $svc_acct->email if $svc_acct;
5810 if (ref($self) eq 'FS::cust_pkg') {
5812 #and including the rest for this customer
5813 my($u_part_svc,@u_acct_svcparts);
5814 foreach $u_part_svc ( qsearch('part_svc',{'svcdb'=>'svc_acct'}) ) {
5815 push @u_acct_svcparts,$u_part_svc->getfield('svcpart');
5818 my $custnum = $self->getfield('custnum');
5819 foreach my $i_cust_pkg ( qsearch('cust_pkg',{'custnum'=>$custnum}) ) {
5820 my $cust_pkgnum = $i_cust_pkg->getfield('pkgnum');
5821 #now find the corresponding record(s) in cust_svc (for this pkgnum!)
5822 foreach my $acct_svcpart (@u_acct_svcparts) {
5823 foreach my $i_cust_svc (
5824 qsearch( 'cust_svc', { 'pkgnum' => $cust_pkgnum,
5825 'svcpart' => $acct_svcpart } )
5827 my $svc_acct = qsearchs( 'svc_acct', { 'svcnum' => $i_cust_svc->svcnum } );
5828 $email{$svc_acct->svcnum} = $svc_acct->email;
5837 # Used by FS::Upgrade to migrate to a new database.
5838 sub _upgrade_data { # class method
5839 my ($class, %opts) = @_;
5840 $class->_upgrade_otaker(%opts);
5842 # RT#10139, bug resulting in contract_end being set when it shouldn't
5843 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
5844 # RT#10830, bad calculation of prorate date near end of year
5845 # the date range for bill is December 2009, and we move it forward
5846 # one year if it's before the previous bill date (which it should
5848 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
5849 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
5850 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
5851 # RT6628, add order_date to cust_pkg
5852 'update cust_pkg set order_date = (select history_date from h_cust_pkg
5853 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
5854 history_action = \'insert\') where order_date is null',
5856 foreach my $sql (@statements) {
5857 my $sth = dbh->prepare($sql);
5858 $sth->execute or die $sth->errstr;
5861 # RT31194: supplemental package links that are deleted don't clean up
5863 my @pkglinknums = qsearch({
5864 'select' => 'DISTINCT cust_pkg.pkglinknum',
5865 'table' => 'cust_pkg',
5866 'addl_from' => ' LEFT JOIN part_pkg_link USING (pkglinknum) ',
5867 'extra_sql' => ' WHERE cust_pkg.pkglinknum IS NOT NULL
5868 AND part_pkg_link.pkglinknum IS NULL',
5870 foreach (@pkglinknums) {
5871 my $pkglinknum = $_->pkglinknum;
5872 warn "cleaning part_pkg_link #$pkglinknum\n";
5873 my $part_pkg_link = FS::part_pkg_link->new({pkglinknum => $pkglinknum});
5874 my $error = $part_pkg_link->remove_linked;
5875 die $error if $error;
5883 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
5885 In sub order, the @pkgparts array (passed by reference) is clobbered.
5887 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
5888 method to pass dates to the recur_prog expression, it should do so.
5890 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
5891 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
5892 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
5893 configuration values. Probably need a subroutine which decides what to do
5894 based on whether or not we've fetched the user yet, rather than a hash. See
5895 FS::UID and the TODO.
5897 Now that things are transactional should the check in the insert method be
5902 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
5903 L<FS::pkg_svc>, schema.html from the base documentation