4 use vars qw(@ISA $disable_agentcheck $DEBUG);
6 use Scalar::Util qw( blessed );
7 use List::Util qw(max);
9 use FS::UID qw( getotaker dbh );
10 use FS::Misc qw( send_email );
11 use FS::Record qw( qsearch qsearchs );
13 use FS::cust_main_Mixin;
17 use FS::cust_location;
19 use FS::cust_bill_pkg;
20 use FS::cust_pkg_detail;
25 use FS::cust_pkg_reason;
29 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
31 # because they load configuration by setting FS::UID::callback (see TODO)
37 # for sending cancel emails in sub cancel
40 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
44 $disable_agentcheck = 0;
48 my ( $hashref, $cache ) = @_;
49 #if ( $hashref->{'pkgpart'} ) {
50 if ( $hashref->{'pkg'} ) {
51 # #@{ $self->{'_pkgnum'} } = ();
52 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
53 # $self->{'_pkgpart'} = $subcache;
54 # #push @{ $self->{'_pkgnum'} },
55 # FS::part_pkg->new_or_cached($hashref, $subcache);
56 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
58 if ( exists $hashref->{'svcnum'} ) {
59 #@{ $self->{'_pkgnum'} } = ();
60 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
61 $self->{'_svcnum'} = $subcache;
62 #push @{ $self->{'_pkgnum'} },
63 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
69 FS::cust_pkg - Object methods for cust_pkg objects
75 $record = new FS::cust_pkg \%hash;
76 $record = new FS::cust_pkg { 'column' => 'value' };
78 $error = $record->insert;
80 $error = $new_record->replace($old_record);
82 $error = $record->delete;
84 $error = $record->check;
86 $error = $record->cancel;
88 $error = $record->suspend;
90 $error = $record->unsuspend;
92 $part_pkg = $record->part_pkg;
94 @labels = $record->labels;
96 $seconds = $record->seconds_since($timestamp);
98 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
99 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
103 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
104 inherits from FS::Record. The following fields are currently supported:
110 Primary key (assigned automatically for new billing items)
114 Customer (see L<FS::cust_main>)
118 Billing item definition (see L<FS::part_pkg>)
122 Optional link to package location (see L<FS::location>)
130 date (next bill date)
154 order taker (assigned automatically if null, see L<FS::UID>)
158 If this field is set to 1, disables the automatic
159 unsuspension of this package when using the B<unsuspendauto> config option.
163 If not set, defaults to 1
167 Date of change from previous package
177 =item change_locationnum
183 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
184 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
185 L<Time::Local> and L<Date::Parse> for conversion functions.
193 Create a new billing item. To add the item to the database, see L<"insert">.
197 sub table { 'cust_pkg'; }
198 sub cust_linked { $_[0]->cust_main_custnum; }
199 sub cust_unlinked_msg {
201 "WARNING: can't find cust_main.custnum ". $self->custnum.
202 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
205 =item insert [ OPTION => VALUE ... ]
207 Adds this billing item to the database ("Orders" the item). If there is an
208 error, returns the error, otherwise returns false.
210 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
211 will be used to look up the package definition and agent restrictions will be
214 If the additional field I<refnum> is defined, an FS::pkg_referral record will
215 be created and inserted. Multiple FS::pkg_referral records can be created by
216 setting I<refnum> to an array reference of refnums or a hash reference with
217 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
218 record will be created corresponding to cust_main.refnum.
220 The following options are available:
226 If set true, supresses any referral credit to a referring customer.
230 cust_pkg_option records will be created
237 my( $self, %options ) = @_;
239 local $SIG{HUP} = 'IGNORE';
240 local $SIG{INT} = 'IGNORE';
241 local $SIG{QUIT} = 'IGNORE';
242 local $SIG{TERM} = 'IGNORE';
243 local $SIG{TSTP} = 'IGNORE';
244 local $SIG{PIPE} = 'IGNORE';
246 my $oldAutoCommit = $FS::UID::AutoCommit;
247 local $FS::UID::AutoCommit = 0;
250 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
252 $dbh->rollback if $oldAutoCommit;
256 $self->refnum($self->cust_main->refnum) unless $self->refnum;
257 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
258 $self->process_m2m( 'link_table' => 'pkg_referral',
259 'target_table' => 'part_referral',
260 'params' => $self->refnum,
263 #if ( $self->reg_code ) {
264 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
265 # $error = $reg_code->delete;
267 # $dbh->rollback if $oldAutoCommit;
272 my $conf = new FS::Conf;
274 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
275 my $queue = new FS::queue {
276 'job' => 'FS::cust_main::queueable_print',
278 $error = $queue->insert(
279 'custnum' => $self->custnum,
280 'template' => 'welcome_letter',
284 warn "can't send welcome letter: $error";
289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
296 This method now works but you probably shouldn't use it.
298 You don't want to delete billing items, because there would then be no record
299 the customer ever purchased the item. Instead, see the cancel method.
304 # return "Can't delete cust_pkg records!";
307 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
309 Replaces the OLD_RECORD with this one in the database. If there is an error,
310 returns the error, otherwise returns false.
312 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
314 Changing pkgpart may have disasterous effects. See the order subroutine.
316 setup and bill are normally updated by calling the bill method of a customer
317 object (see L<FS::cust_main>).
319 suspend is normally updated by the suspend and unsuspend methods.
321 cancel is normally updated by the cancel method (and also the order subroutine
324 Available options are:
330 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.
334 the access_user (see L<FS::access_user>) providing the reason
338 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
347 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
352 ( ref($_[0]) eq 'HASH' )
356 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
357 return "Can't change otaker!" if $old->otaker ne $new->otaker;
360 #return "Can't change setup once it exists!"
361 # if $old->getfield('setup') &&
362 # $old->getfield('setup') != $new->getfield('setup');
364 #some logic for bill, susp, cancel?
366 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
368 local $SIG{HUP} = 'IGNORE';
369 local $SIG{INT} = 'IGNORE';
370 local $SIG{QUIT} = 'IGNORE';
371 local $SIG{TERM} = 'IGNORE';
372 local $SIG{TSTP} = 'IGNORE';
373 local $SIG{PIPE} = 'IGNORE';
375 my $oldAutoCommit = $FS::UID::AutoCommit;
376 local $FS::UID::AutoCommit = 0;
379 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
380 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
381 my $error = $new->insert_reason(
382 'reason' => $options->{'reason'},
383 'date' => $new->$method,
385 'reason_otaker' => $options->{'reason_otaker'},
388 dbh->rollback if $oldAutoCommit;
389 return "Error inserting cust_pkg_reason: $error";
394 #save off and freeze RADIUS attributes for any associated svc_acct records
396 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
398 #also check for specific exports?
399 # to avoid spurious modify export events
400 @svc_acct = map { $_->svc_x }
401 grep { $_->part_svc->svcdb eq 'svc_acct' }
404 $_->snapshot foreach @svc_acct;
408 my $error = $new->SUPER::replace($old,
409 $options->{options} ? $options->{options} : ()
412 $dbh->rollback if $oldAutoCommit;
416 #for prepaid packages,
417 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
418 foreach my $old_svc_acct ( @svc_acct ) {
419 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
420 my $s_error = $new_svc_acct->replace($old_svc_acct);
422 $dbh->rollback if $oldAutoCommit;
427 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
434 Checks all fields to make sure this is a valid billing item. If there is an
435 error, returns the error, otherwise returns false. Called by the insert and
443 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
446 $self->ut_numbern('pkgnum')
447 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
448 || $self->ut_numbern('pkgpart')
449 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
450 || $self->ut_numbern('setup')
451 || $self->ut_numbern('bill')
452 || $self->ut_numbern('susp')
453 || $self->ut_numbern('cancel')
454 || $self->ut_numbern('adjourn')
455 || $self->ut_numbern('expire')
457 return $error if $error;
459 if ( $self->reg_code ) {
461 unless ( grep { $self->pkgpart == $_->pkgpart }
462 map { $_->reg_code_pkg }
463 qsearchs( 'reg_code', { 'code' => $self->reg_code,
464 'agentnum' => $self->cust_main->agentnum })
466 return "Unknown registration code";
469 } elsif ( $self->promo_code ) {
472 qsearchs('part_pkg', {
473 'pkgpart' => $self->pkgpart,
474 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
476 return 'Unknown promotional code' unless $promo_part_pkg;
480 unless ( $disable_agentcheck ) {
482 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
483 return "agent ". $agent->agentnum. ':'. $agent->agent.
484 " can't purchase pkgpart ". $self->pkgpart
485 unless $agent->pkgpart_hashref->{ $self->pkgpart }
486 || $agent->agentnum == $self->part_pkg->agentnum;
489 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
490 return $error if $error;
494 $self->otaker(getotaker) unless $self->otaker;
495 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
498 if ( $self->dbdef_table->column('manual_flag') ) {
499 $self->manual_flag('') if $self->manual_flag eq ' ';
500 $self->manual_flag =~ /^([01]?)$/
501 or return "Illegal manual_flag ". $self->manual_flag;
502 $self->manual_flag($1);
508 =item cancel [ OPTION => VALUE ... ]
510 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
511 in this package, then cancels the package itself (sets the cancel field to
514 Available options are:
518 =item quiet - can be set true to supress email cancellation notices.
520 =item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
522 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
524 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
528 If there is an error, returns the error, otherwise returns false.
533 my( $self, %options ) = @_;
536 warn "cust_pkg::cancel called with options".
537 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
540 local $SIG{HUP} = 'IGNORE';
541 local $SIG{INT} = 'IGNORE';
542 local $SIG{QUIT} = 'IGNORE';
543 local $SIG{TERM} = 'IGNORE';
544 local $SIG{TSTP} = 'IGNORE';
545 local $SIG{PIPE} = 'IGNORE';
547 my $oldAutoCommit = $FS::UID::AutoCommit;
548 local $FS::UID::AutoCommit = 0;
551 my $old = $self->select_for_update;
553 if ( $old->get('cancel') || $self->get('cancel') ) {
554 dbh->rollback if $oldAutoCommit;
555 return ""; # no error
558 my $date = $options{date} if $options{date}; # expire/cancel later
559 $date = '' if ($date && $date <= time); # complain instead?
561 my $cancel_time = $options{'time'} || time;
563 if ( $options{'reason'} ) {
564 $error = $self->insert_reason( 'reason' => $options{'reason'},
565 'action' => $date ? 'expire' : 'cancel',
566 'date' => $date ? $date : $cancel_time,
567 'reason_otaker' => $options{'reason_otaker'},
570 dbh->rollback if $oldAutoCommit;
571 return "Error inserting cust_pkg_reason: $error";
577 foreach my $cust_svc (
580 sort { $a->[1] <=> $b->[1] }
581 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
582 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
585 my $error = $cust_svc->cancel;
588 $dbh->rollback if $oldAutoCommit;
589 return "Error cancelling cust_svc: $error";
593 # Add a credit for remaining service
594 my $remaining_value = $self->calc_remain(time=>$cancel_time);
595 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
596 my $conf = new FS::Conf;
597 my $error = $self->cust_main->credit(
599 'Credit for unused time on '. $self->part_pkg->pkg,
600 'reason_type' => $conf->config('cancel_credit_type'),
603 $dbh->rollback if $oldAutoCommit;
604 return "Error crediting customer \$$remaining_value for unused time on".
605 $self->part_pkg->pkg. ": $error";
610 my %hash = $self->hash;
611 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
612 my $new = new FS::cust_pkg ( \%hash );
613 $error = $new->replace( $self, options => { $self->options } );
615 $dbh->rollback if $oldAutoCommit;
619 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
620 return '' if $date; #no errors
622 my $conf = new FS::Conf;
623 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
624 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
625 my $conf = new FS::Conf;
626 my $error = send_email(
627 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
628 'to' => \@invoicing_list,
629 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
630 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
632 #should this do something on errors?
639 =item cancel_if_expired [ NOW_TIMESTAMP ]
641 Cancels this package if its expire date has been reached.
645 sub cancel_if_expired {
647 my $time = shift || time;
648 return '' unless $self->expire && $self->expire <= $time;
649 my $error = $self->cancel;
651 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
652 $self->custnum. ": $error";
659 Cancels any pending expiration (sets the expire field to null).
661 If there is an error, returns the error, otherwise returns false.
666 my( $self, %options ) = @_;
669 local $SIG{HUP} = 'IGNORE';
670 local $SIG{INT} = 'IGNORE';
671 local $SIG{QUIT} = 'IGNORE';
672 local $SIG{TERM} = 'IGNORE';
673 local $SIG{TSTP} = 'IGNORE';
674 local $SIG{PIPE} = 'IGNORE';
676 my $oldAutoCommit = $FS::UID::AutoCommit;
677 local $FS::UID::AutoCommit = 0;
680 my $old = $self->select_for_update;
682 my $pkgnum = $old->pkgnum;
683 if ( $old->get('cancel') || $self->get('cancel') ) {
684 dbh->rollback if $oldAutoCommit;
685 return "Can't unexpire cancelled package $pkgnum";
686 # or at least it's pointless
689 unless ( $old->get('expire') && $self->get('expire') ) {
690 dbh->rollback if $oldAutoCommit;
691 return ""; # no error
694 my %hash = $self->hash;
695 $hash{'expire'} = '';
696 my $new = new FS::cust_pkg ( \%hash );
697 $error = $new->replace( $self, options => { $self->options } );
699 $dbh->rollback if $oldAutoCommit;
703 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
709 =item suspend [ OPTION => VALUE ... ]
711 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
712 package, then suspends the package itself (sets the susp field to now).
714 Available options are:
718 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
720 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
724 If there is an error, returns the error, otherwise returns false.
729 my( $self, %options ) = @_;
732 local $SIG{HUP} = 'IGNORE';
733 local $SIG{INT} = 'IGNORE';
734 local $SIG{QUIT} = 'IGNORE';
735 local $SIG{TERM} = 'IGNORE';
736 local $SIG{TSTP} = 'IGNORE';
737 local $SIG{PIPE} = 'IGNORE';
739 my $oldAutoCommit = $FS::UID::AutoCommit;
740 local $FS::UID::AutoCommit = 0;
743 my $old = $self->select_for_update;
745 my $pkgnum = $old->pkgnum;
746 if ( $old->get('cancel') || $self->get('cancel') ) {
747 dbh->rollback if $oldAutoCommit;
748 return "Can't suspend cancelled package $pkgnum";
751 if ( $old->get('susp') || $self->get('susp') ) {
752 dbh->rollback if $oldAutoCommit;
753 return ""; # no error # complain on adjourn?
756 my $date = $options{date} if $options{date}; # adjourn/suspend later
757 $date = '' if ($date && $date <= time); # complain instead?
759 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
760 dbh->rollback if $oldAutoCommit;
761 return "Package $pkgnum expires before it would be suspended.";
764 my $suspend_time = $options{'time'} || time;
766 if ( $options{'reason'} ) {
767 $error = $self->insert_reason( 'reason' => $options{'reason'},
768 'action' => $date ? 'adjourn' : 'suspend',
769 'date' => $date ? $date : $suspend_time,
770 'reason_otaker' => $options{'reason_otaker'},
773 dbh->rollback if $oldAutoCommit;
774 return "Error inserting cust_pkg_reason: $error";
782 foreach my $cust_svc (
783 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
785 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
787 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
788 $dbh->rollback if $oldAutoCommit;
789 return "Illegal svcdb value in part_svc!";
792 require "FS/$svcdb.pm";
794 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
796 $error = $svc->suspend;
798 $dbh->rollback if $oldAutoCommit;
801 my( $label, $value ) = $cust_svc->label;
802 push @labels, "$label: $value";
806 my $conf = new FS::Conf;
807 if ( $conf->config('suspend_email_admin') ) {
809 my $error = send_email(
810 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
811 #invoice_from ??? well as good as any
812 'to' => $conf->config('suspend_email_admin'),
813 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
815 "This is an automatic message from your Freeside installation\n",
816 "informing you that the following customer package has been suspended:\n",
818 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
819 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
820 ( map { "Service : $_\n" } @labels ),
825 warn "WARNING: can't send suspension admin email (suspending anyway): ".
833 my %hash = $self->hash;
835 $hash{'adjourn'} = $date;
837 $hash{'susp'} = $suspend_time;
839 my $new = new FS::cust_pkg ( \%hash );
840 $error = $new->replace( $self, options => { $self->options } );
842 $dbh->rollback if $oldAutoCommit;
846 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
851 =item unsuspend [ OPTION => VALUE ... ]
853 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
854 package, then unsuspends the package itself (clears the susp field and the
855 adjourn field if it is in the past).
857 Available options are:
861 =item adjust_next_bill
863 Can be set true to adjust the next bill date forward by
864 the amount of time the account was inactive. This was set true by default
865 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
866 explicitly requested. Price plans for which this makes sense (anniversary-date
867 based than prorate or subscription) could have an option to enable this
872 If there is an error, returns the error, otherwise returns false.
877 my( $self, %opt ) = @_;
880 local $SIG{HUP} = 'IGNORE';
881 local $SIG{INT} = 'IGNORE';
882 local $SIG{QUIT} = 'IGNORE';
883 local $SIG{TERM} = 'IGNORE';
884 local $SIG{TSTP} = 'IGNORE';
885 local $SIG{PIPE} = 'IGNORE';
887 my $oldAutoCommit = $FS::UID::AutoCommit;
888 local $FS::UID::AutoCommit = 0;
891 my $old = $self->select_for_update;
893 my $pkgnum = $old->pkgnum;
894 if ( $old->get('cancel') || $self->get('cancel') ) {
895 dbh->rollback if $oldAutoCommit;
896 return "Can't unsuspend cancelled package $pkgnum";
899 unless ( $old->get('susp') && $self->get('susp') ) {
900 dbh->rollback if $oldAutoCommit;
901 return ""; # no error # complain instead?
904 foreach my $cust_svc (
905 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
907 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
909 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
910 $dbh->rollback if $oldAutoCommit;
911 return "Illegal svcdb value in part_svc!";
914 require "FS/$svcdb.pm";
916 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
918 $error = $svc->unsuspend;
920 $dbh->rollback if $oldAutoCommit;
927 my %hash = $self->hash;
928 my $inactive = time - $hash{'susp'};
930 my $conf = new FS::Conf;
932 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
933 if ( $opt{'adjust_next_bill'}
934 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
935 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
938 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
939 my $new = new FS::cust_pkg ( \%hash );
940 $error = $new->replace( $self, options => { $self->options } );
942 $dbh->rollback if $oldAutoCommit;
946 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
953 Cancels any pending suspension (sets the adjourn field to null).
955 If there is an error, returns the error, otherwise returns false.
960 my( $self, %options ) = @_;
963 local $SIG{HUP} = 'IGNORE';
964 local $SIG{INT} = 'IGNORE';
965 local $SIG{QUIT} = 'IGNORE';
966 local $SIG{TERM} = 'IGNORE';
967 local $SIG{TSTP} = 'IGNORE';
968 local $SIG{PIPE} = 'IGNORE';
970 my $oldAutoCommit = $FS::UID::AutoCommit;
971 local $FS::UID::AutoCommit = 0;
974 my $old = $self->select_for_update;
976 my $pkgnum = $old->pkgnum;
977 if ( $old->get('cancel') || $self->get('cancel') ) {
978 dbh->rollback if $oldAutoCommit;
979 return "Can't unadjourn cancelled package $pkgnum";
980 # or at least it's pointless
983 if ( $old->get('susp') || $self->get('susp') ) {
984 dbh->rollback if $oldAutoCommit;
985 return "Can't unadjourn suspended package $pkgnum";
986 # perhaps this is arbitrary
989 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
990 dbh->rollback if $oldAutoCommit;
991 return ""; # no error
994 my %hash = $self->hash;
995 $hash{'adjourn'} = '';
996 my $new = new FS::cust_pkg ( \%hash );
997 $error = $new->replace( $self, options => { $self->options } );
999 $dbh->rollback if $oldAutoCommit;
1003 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1010 =item change HASHREF | OPTION => VALUE ...
1012 Changes this package: cancels it and creates a new one, with a different
1013 pkgpart or locationnum or both. All services are transferred to the new
1014 package (no change will be made if this is not possible).
1016 Options may be passed as a list of key/value pairs or as a hash reference.
1023 New locationnum, to change the location for this package.
1027 New FS::cust_location object, to create a new location and assign it
1032 New pkgpart (see L<FS::part_pkg>).
1036 New refnum (see L<FS::part_referral>).
1040 At least one option must be specified (otherwise, what's the point?)
1042 Returns either the new FS::cust_pkg object or a scalar error.
1046 my $err_or_new_cust_pkg = $old_cust_pkg->change
1050 #some false laziness w/order
1053 my $opt = ref($_[0]) ? shift : { @_ };
1055 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1058 my $conf = new FS::Conf;
1060 # Transactionize this whole mess
1061 local $SIG{HUP} = 'IGNORE';
1062 local $SIG{INT} = 'IGNORE';
1063 local $SIG{QUIT} = 'IGNORE';
1064 local $SIG{TERM} = 'IGNORE';
1065 local $SIG{TSTP} = 'IGNORE';
1066 local $SIG{PIPE} = 'IGNORE';
1068 my $oldAutoCommit = $FS::UID::AutoCommit;
1069 local $FS::UID::AutoCommit = 0;
1078 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1080 #$hash{$_} = $self->$_() foreach qw( setup );
1082 $hash{'setup'} = $time if $self->setup;
1084 $hash{'change_date'} = $time;
1085 $hash{"change_$_"} = $self->$_()
1086 foreach qw( pkgnum pkgpart locationnum );
1088 if ( $opt->{'cust_location'} &&
1089 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1090 $error = $opt->{'cust_location'}->insert;
1092 $dbh->rollback if $oldAutoCommit;
1093 return "inserting cust_location (transaction rolled back): $error";
1095 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1098 # Create the new package.
1099 my $cust_pkg = new FS::cust_pkg {
1100 custnum => $self->custnum,
1101 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1102 refnum => ( $opt->{'refnum'} || $self->refnum ),
1103 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1107 $error = $cust_pkg->insert( 'change' => 1 );
1109 $dbh->rollback if $oldAutoCommit;
1113 # Transfer services and cancel old package.
1115 $error = $self->transfer($cust_pkg);
1116 if ($error and $error == 0) {
1117 # $old_pkg->transfer failed.
1118 $dbh->rollback if $oldAutoCommit;
1122 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1123 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1124 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1125 if ($error and $error == 0) {
1126 # $old_pkg->transfer failed.
1127 $dbh->rollback if $oldAutoCommit;
1133 # Transfers were successful, but we still had services left on the old
1134 # package. We can't change the package under this circumstances, so abort.
1135 $dbh->rollback if $oldAutoCommit;
1136 return "Unable to transfer all services from package ". $self->pkgnum;
1139 #reset usage if changing pkgpart
1140 if ($self->pkgpart != $cust_pkg->pkgpart) {
1141 my $part_pkg = $cust_pkg->part_pkg;
1142 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1146 if $part_pkg->can('reset_usage');
1149 $dbh->rollback if $oldAutoCommit;
1150 return "Error setting usage values: $error";
1154 #Good to go, cancel old package.
1155 $error = $self->cancel( quiet=>1 );
1161 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1168 Returns the last bill date, or if there is no last bill date, the setup date.
1169 Useful for billing metered services.
1175 return $self->setfield('last_bill', $_[0]) if @_;
1176 return $self->getfield('last_bill') if $self->getfield('last_bill');
1177 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1178 'edate' => $self->bill, } );
1179 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1182 =item last_cust_pkg_reason ACTION
1184 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1185 Returns false if there is no reason or the package is not currenly ACTION'd
1186 ACTION is one of adjourn, susp, cancel, or expire.
1190 sub last_cust_pkg_reason {
1191 my ( $self, $action ) = ( shift, shift );
1192 my $date = $self->get($action);
1194 'table' => 'cust_pkg_reason',
1195 'hashref' => { 'pkgnum' => $self->pkgnum,
1196 'action' => substr(uc($action), 0, 1),
1199 'order_by' => 'ORDER BY num DESC LIMIT 1',
1203 =item last_reason ACTION
1205 Returns the most recent ACTION FS::reason associated with the package.
1206 Returns false if there is no reason or the package is not currenly ACTION'd
1207 ACTION is one of adjourn, susp, cancel, or expire.
1212 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1213 $cust_pkg_reason->reason
1214 if $cust_pkg_reason;
1219 Returns the definition for this billing item, as an FS::part_pkg object (see
1226 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1227 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1228 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1233 Returns the cancelled package this package was changed from, if any.
1239 return '' unless $self->change_pkgnum;
1240 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1245 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1252 $self->part_pkg->calc_setup($self, @_);
1257 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1264 $self->part_pkg->calc_recur($self, @_);
1269 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1276 $self->part_pkg->calc_remain($self, @_);
1281 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1288 $self->part_pkg->calc_cancel($self, @_);
1293 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1299 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1302 =item cust_pkg_detail [ DETAILTYPE ]
1304 Returns any customer package details for this package (see
1305 L<FS::cust_pkg_detail>).
1307 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1311 sub cust_pkg_detail {
1313 my %hash = ( 'pkgnum' => $self->pkgnum );
1314 $hash{detailtype} = shift if @_;
1316 'table' => 'cust_pkg_detail',
1317 'hashref' => \%hash,
1318 'order_by' => 'ORDER BY weight, pkgdetailnum',
1322 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1324 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1326 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1328 If there is an error, returns the error, otherwise returns false.
1332 sub set_cust_pkg_detail {
1333 my( $self, $detailtype, @details ) = @_;
1335 local $SIG{HUP} = 'IGNORE';
1336 local $SIG{INT} = 'IGNORE';
1337 local $SIG{QUIT} = 'IGNORE';
1338 local $SIG{TERM} = 'IGNORE';
1339 local $SIG{TSTP} = 'IGNORE';
1340 local $SIG{PIPE} = 'IGNORE';
1342 my $oldAutoCommit = $FS::UID::AutoCommit;
1343 local $FS::UID::AutoCommit = 0;
1346 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1347 my $error = $current->delete;
1349 $dbh->rollback if $oldAutoCommit;
1350 return "error removing old detail: $error";
1354 foreach my $detail ( @details ) {
1355 my $cust_pkg_detail = new FS::cust_pkg_detail {
1356 'pkgnum' => $self->pkgnum,
1357 'detailtype' => $detailtype,
1358 'detail' => $detail,
1360 my $error = $cust_pkg_detail->insert;
1362 $dbh->rollback if $oldAutoCommit;
1363 return "error adding new detail: $error";
1368 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1375 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1379 #false laziness w/cust_bill.pm
1383 'table' => 'cust_event',
1384 'addl_from' => 'JOIN part_event USING ( eventpart )',
1385 'hashref' => { 'tablenum' => $self->pkgnum },
1386 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1390 =item num_cust_event
1392 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1396 #false laziness w/cust_bill.pm
1397 sub num_cust_event {
1400 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1401 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1402 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1403 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1404 $sth->fetchrow_arrayref->[0];
1407 =item cust_svc [ SVCPART ]
1409 Returns the services for this package, as FS::cust_svc objects (see
1410 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1418 return () unless $self->num_cust_svc(@_);
1421 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1422 'svcpart' => shift, } );
1425 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1427 #if ( $self->{'_svcnum'} ) {
1428 # values %{ $self->{'_svcnum'}->cache };
1430 $self->_sort_cust_svc(
1431 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1437 =item overlimit [ SVCPART ]
1439 Returns the services for this package which have exceeded their
1440 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1441 is specified, return only the matching services.
1447 return () unless $self->num_cust_svc(@_);
1448 grep { $_->overlimit } $self->cust_svc(@_);
1451 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1453 Returns historical services for this package created before END TIMESTAMP and
1454 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1455 (see L<FS::h_cust_svc>).
1462 $self->_sort_cust_svc(
1463 [ qsearch( 'h_cust_svc',
1464 { 'pkgnum' => $self->pkgnum, },
1465 FS::h_cust_svc->sql_h_search(@_),
1471 sub _sort_cust_svc {
1472 my( $self, $arrayref ) = @_;
1475 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1477 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1478 'svcpart' => $_->svcpart } );
1480 $pkg_svc ? $pkg_svc->primary_svc : '',
1481 $pkg_svc ? $pkg_svc->quantity : 0,
1488 =item num_cust_svc [ SVCPART ]
1490 Returns the number of provisioned services for this package. If a svcpart is
1491 specified, counts only the matching services.
1498 return $self->{'_num_cust_svc'}
1500 && exists($self->{'_num_cust_svc'})
1501 && $self->{'_num_cust_svc'} =~ /\d/;
1503 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1506 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1507 $sql .= ' AND svcpart = ?' if @_;
1509 my $sth = dbh->prepare($sql) or die dbh->errstr;
1510 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1511 $sth->fetchrow_arrayref->[0];
1514 =item available_part_svc
1516 Returns a list of FS::part_svc objects representing services included in this
1517 package but not yet provisioned. Each FS::part_svc object also has an extra
1518 field, I<num_avail>, which specifies the number of available services.
1522 sub available_part_svc {
1524 grep { $_->num_avail > 0 }
1526 my $part_svc = $_->part_svc;
1527 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1528 $_->quantity - $self->num_cust_svc($_->svcpart);
1531 $self->part_pkg->pkg_svc;
1536 Returns a list of FS::part_svc objects representing provisioned and available
1537 services included in this package. Each FS::part_svc object also has the
1538 following extra fields:
1542 =item num_cust_svc (count)
1544 =item num_avail (quantity - count)
1546 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1549 label -> ($cust_svc->label)[1]
1558 #XXX some sort of sort order besides numeric by svcpart...
1559 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1561 my $part_svc = $pkg_svc->part_svc;
1562 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1563 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1564 $part_svc->{'Hash'}{'num_avail'} =
1565 max( 0, $pkg_svc->quantity - $num_cust_svc );
1566 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1567 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1569 } $self->part_pkg->pkg_svc;
1572 push @part_svc, map {
1574 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1575 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1576 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1577 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1578 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1580 } $self->extra_part_svc;
1586 =item extra_part_svc
1588 Returns a list of FS::part_svc objects corresponding to services in this
1589 package which are still provisioned but not (any longer) available in the
1594 sub extra_part_svc {
1597 my $pkgnum = $self->pkgnum;
1598 my $pkgpart = $self->pkgpart;
1601 # 'table' => 'part_svc',
1604 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1605 # WHERE pkg_svc.svcpart = part_svc.svcpart
1606 # AND pkg_svc.pkgpart = ?
1609 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1610 # LEFT JOIN cust_pkg USING ( pkgnum )
1611 # WHERE cust_svc.svcpart = part_svc.svcpart
1614 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1617 #seems to benchmark slightly faster...
1619 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1620 'table' => 'part_svc',
1622 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1623 AND pkg_svc.pkgpart = ?
1626 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1627 LEFT JOIN cust_pkg USING ( pkgnum )
1630 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1631 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1637 Returns a short status string for this package, currently:
1641 =item not yet billed
1643 =item one-time charge
1658 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1660 return 'cancelled' if $self->get('cancel');
1661 return 'suspended' if $self->susp;
1662 return 'not yet billed' unless $self->setup;
1663 return 'one-time charge' if $freq =~ /^(0|$)/;
1669 Class method that returns the list of possible status strings for packages
1670 (see L<the status method|/status>). For example:
1672 @statuses = FS::cust_pkg->statuses();
1676 tie my %statuscolor, 'Tie::IxHash',
1677 'not yet billed' => '000000',
1678 'one-time charge' => '000000',
1679 'active' => '00CC00',
1680 'suspended' => 'FF9900',
1681 'cancelled' => 'FF0000',
1685 my $self = shift; #could be class...
1686 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1687 # # mayble split btw one-time vs. recur
1693 Returns a hex triplet color string for this package's status.
1699 $statuscolor{$self->status};
1704 Returns a list of lists, calling the label method for all services
1705 (see L<FS::cust_svc>) of this billing item.
1711 map { [ $_->label ] } $self->cust_svc;
1714 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1716 Like the labels method, but returns historical information on services that
1717 were active as of END_TIMESTAMP and (optionally) not cancelled before
1720 Returns a list of lists, calling the label method for all (historical) services
1721 (see L<FS::h_cust_svc>) of this billing item.
1727 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1730 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1732 Like h_labels, except returns a simple flat list, and shortens long
1733 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1734 identical services to one line that lists the service label and the number of
1735 individual services rather than individual items.
1739 sub h_labels_short {
1742 my $conf = new FS::Conf;
1743 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1746 #tie %labels, 'Tie::IxHash';
1747 push @{ $labels{$_->[0]} }, $_->[1]
1748 foreach $self->h_labels(@_);
1750 foreach my $label ( keys %labels ) {
1752 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1753 my $num = scalar(@values);
1754 if ( $num > $max_same_services ) {
1755 push @labels, "$label ($num)";
1757 push @labels, map { "$label: $_" } @values;
1767 Returns the parent customer object (see L<FS::cust_main>).
1773 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1778 Returns the location object, if any (see L<FS::cust_location>).
1784 return '' unless $self->locationnum;
1785 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1788 =item cust_location_or_main
1790 If this package is associated with a location, returns the locaiton (see
1791 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1795 sub cust_location_or_main {
1797 $self->cust_location || $self->cust_main;
1800 =item seconds_since TIMESTAMP
1802 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1803 package have been online since TIMESTAMP, according to the session monitor.
1805 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1806 L<Time::Local> and L<Date::Parse> for conversion functions.
1811 my($self, $since) = @_;
1814 foreach my $cust_svc (
1815 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1817 $seconds += $cust_svc->seconds_since($since);
1824 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1826 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1827 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1830 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1831 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1837 sub seconds_since_sqlradacct {
1838 my($self, $start, $end) = @_;
1842 foreach my $cust_svc (
1844 my $part_svc = $_->part_svc;
1845 $part_svc->svcdb eq 'svc_acct'
1846 && scalar($part_svc->part_export('sqlradius'));
1849 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1856 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1858 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1859 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1863 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1864 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1869 sub attribute_since_sqlradacct {
1870 my($self, $start, $end, $attrib) = @_;
1874 foreach my $cust_svc (
1876 my $part_svc = $_->part_svc;
1877 $part_svc->svcdb eq 'svc_acct'
1878 && scalar($part_svc->part_export('sqlradius'));
1881 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1893 my( $self, $value ) = @_;
1894 if ( defined($value) ) {
1895 $self->setfield('quantity', $value);
1897 $self->getfield('quantity') || 1;
1900 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1902 Transfers as many services as possible from this package to another package.
1904 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1905 object. The destination package must already exist.
1907 Services are moved only if the destination allows services with the correct
1908 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1909 this option with caution! No provision is made for export differences
1910 between the old and new service definitions. Probably only should be used
1911 when your exports for all service definitions of a given svcdb are identical.
1912 (attempt a transfer without it first, to move all possible svcpart-matching
1915 Any services that can't be moved remain in the original package.
1917 Returns an error, if there is one; otherwise, returns the number of services
1918 that couldn't be moved.
1923 my ($self, $dest_pkgnum, %opt) = @_;
1929 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1930 $dest = $dest_pkgnum;
1931 $dest_pkgnum = $dest->pkgnum;
1933 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1936 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1938 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1939 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1942 foreach my $cust_svc ($dest->cust_svc) {
1943 $target{$cust_svc->svcpart}--;
1946 my %svcpart2svcparts = ();
1947 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1948 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1949 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1950 next if exists $svcpart2svcparts{$svcpart};
1951 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1952 $svcpart2svcparts{$svcpart} = [
1954 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1956 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1957 'svcpart' => $_ } );
1959 $pkg_svc ? $pkg_svc->primary_svc : '',
1960 $pkg_svc ? $pkg_svc->quantity : 0,
1964 grep { $_ != $svcpart }
1966 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1968 warn "alternates for svcpart $svcpart: ".
1969 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1974 foreach my $cust_svc ($self->cust_svc) {
1975 if($target{$cust_svc->svcpart} > 0) {
1976 $target{$cust_svc->svcpart}--;
1977 my $new = new FS::cust_svc { $cust_svc->hash };
1978 $new->pkgnum($dest_pkgnum);
1979 my $error = $new->replace($cust_svc);
1980 return $error if $error;
1981 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1983 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1984 warn "alternates to consider: ".
1985 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1987 my @alternate = grep {
1988 warn "considering alternate svcpart $_: ".
1989 "$target{$_} available in new package\n"
1992 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1994 warn "alternate(s) found\n" if $DEBUG;
1995 my $change_svcpart = $alternate[0];
1996 $target{$change_svcpart}--;
1997 my $new = new FS::cust_svc { $cust_svc->hash };
1998 $new->svcpart($change_svcpart);
1999 $new->pkgnum($dest_pkgnum);
2000 my $error = $new->replace($cust_svc);
2001 return $error if $error;
2014 This method is deprecated. See the I<depend_jobnum> option to the insert and
2015 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2022 local $SIG{HUP} = 'IGNORE';
2023 local $SIG{INT} = 'IGNORE';
2024 local $SIG{QUIT} = 'IGNORE';
2025 local $SIG{TERM} = 'IGNORE';
2026 local $SIG{TSTP} = 'IGNORE';
2027 local $SIG{PIPE} = 'IGNORE';
2029 my $oldAutoCommit = $FS::UID::AutoCommit;
2030 local $FS::UID::AutoCommit = 0;
2033 foreach my $cust_svc ( $self->cust_svc ) {
2034 #false laziness w/svc_Common::insert
2035 my $svc_x = $cust_svc->svc_x;
2036 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2037 my $error = $part_export->export_insert($svc_x);
2039 $dbh->rollback if $oldAutoCommit;
2045 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2052 =head1 CLASS METHODS
2058 Returns an SQL expression identifying recurring packages.
2062 sub recurring_sql { "
2063 '0' != ( select freq from part_pkg
2064 where cust_pkg.pkgpart = part_pkg.pkgpart )
2069 Returns an SQL expression identifying one-time packages.
2074 '0' = ( select freq from part_pkg
2075 where cust_pkg.pkgpart = part_pkg.pkgpart )
2080 Returns an SQL expression identifying active packages.
2085 ". $_[0]->recurring_sql(). "
2086 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2087 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2090 =item not_yet_billed_sql
2092 Returns an SQL expression identifying packages which have not yet been billed.
2096 sub not_yet_billed_sql { "
2097 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2098 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2099 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2104 Returns an SQL expression identifying inactive packages (one-time packages
2105 that are otherwise unsuspended/uncancelled).
2109 sub inactive_sql { "
2110 ". $_[0]->onetime_sql(). "
2111 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2112 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2113 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2119 Returns an SQL expression identifying suspended packages.
2123 sub suspended_sql { susp_sql(@_); }
2125 #$_[0]->recurring_sql(). ' AND '.
2127 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2128 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2135 Returns an SQL exprression identifying cancelled packages.
2139 sub cancelled_sql { cancel_sql(@_); }
2141 #$_[0]->recurring_sql(). ' AND '.
2142 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2145 =item search_sql HASHREF
2149 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2150 Valid parameters are
2158 active, inactive, suspended, cancel (or cancelled)
2162 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2172 arrayref of beginning and ending epoch date
2176 arrayref of beginning and ending epoch date
2180 arrayref of beginning and ending epoch date
2184 arrayref of beginning and ending epoch date
2188 arrayref of beginning and ending epoch date
2192 arrayref of beginning and ending epoch date
2196 arrayref of beginning and ending epoch date
2200 pkgnum or APKG_pkgnum
2204 a value suited to passing to FS::UI::Web::cust_header
2208 specifies the user for agent virtualization
2215 my ($class, $params) = @_;
2222 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2224 "cust_main.agentnum = $1";
2231 if ( $params->{'magic'} eq 'active'
2232 || $params->{'status'} eq 'active' ) {
2234 push @where, FS::cust_pkg->active_sql();
2236 } elsif ( $params->{'magic'} eq 'not yet billed'
2237 || $params->{'status'} eq 'not yet billed' ) {
2239 push @where, FS::cust_pkg->not_yet_billed_sql();
2241 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2242 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2244 push @where, FS::cust_pkg->inactive_sql();
2246 } elsif ( $params->{'magic'} eq 'suspended'
2247 || $params->{'status'} eq 'suspended' ) {
2249 push @where, FS::cust_pkg->suspended_sql();
2251 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2252 || $params->{'status'} =~ /^cancell?ed$/ ) {
2254 push @where, FS::cust_pkg->cancelled_sql();
2259 # parse package class
2262 #false lazinessish w/graph/cust_bill_pkg.cgi
2265 if ( exists($params->{'classnum'})
2266 && $params->{'classnum'} =~ /^(\d*)$/
2270 if ( $classnum ) { #a specific class
2271 push @where, "classnum = $classnum";
2273 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2274 #die "classnum $classnum not found!" unless $pkg_class[0];
2275 #$title .= $pkg_class[0]->classname.' ';
2277 } elsif ( $classnum eq '' ) { #the empty class
2279 push @where, "classnum IS NULL";
2280 #$title .= 'Empty class ';
2281 #@pkg_class = ( '(empty class)' );
2282 } elsif ( $classnum eq '0' ) {
2283 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2284 #push @pkg_class, '(empty class)';
2286 die "illegal classnum";
2295 my $pkgpart = join (' OR pkgpart=',
2296 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2297 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2305 #false laziness w/report_cust_pkg.html
2308 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2309 'active' => { 'susp'=>1, 'cancel'=>1 },
2310 'suspended' => { 'cancel' => 1 },
2315 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2317 next unless exists($params->{$field});
2319 my($beginning, $ending) = @{$params->{$field}};
2321 next if $beginning == 0 && $ending == 4294967295;
2324 "cust_pkg.$field IS NOT NULL",
2325 "cust_pkg.$field >= $beginning",
2326 "cust_pkg.$field <= $ending";
2328 $orderby ||= "ORDER BY cust_pkg.$field";
2332 $orderby ||= 'ORDER BY bill';
2335 # parse magic, legacy, etc.
2338 if ( $params->{'magic'} &&
2339 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2342 $orderby = 'ORDER BY pkgnum';
2344 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2345 push @where, "pkgpart = $1";
2348 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2350 $orderby = 'ORDER BY pkgnum';
2352 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2354 $orderby = 'ORDER BY pkgnum';
2357 SELECT count(*) FROM pkg_svc
2358 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2359 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2360 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2361 AND cust_svc.svcpart = pkg_svc.svcpart
2368 # setup queries, links, subs, etc. for the search
2371 # here is the agent virtualization
2372 if ($params->{CurrentUser}) {
2374 qsearchs('access_user', { username => $params->{CurrentUser} });
2377 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2382 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2385 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2387 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2388 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2389 'LEFT JOIN pkg_class USING ( classnum ) ';
2391 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2394 'table' => 'cust_pkg',
2396 'select' => join(', ',
2398 ( map "part_pkg.$_", qw( pkg freq ) ),
2399 'pkg_class.classname',
2400 'cust_main.custnum as cust_main_custnum',
2401 FS::UI::Web::cust_sql_fields(
2402 $params->{'cust_fields'}
2405 'extra_sql' => "$extra_sql $orderby",
2406 'addl_from' => $addl_from,
2407 'count_query' => $count_query,
2414 Returns a list: the first item is an SQL fragment identifying matching
2415 packages/customers via location (taking into account shipping and package
2416 address taxation, if enabled), and subsequent items are the parameters to
2417 substitute for the placeholders in that fragment.
2422 my($class, %opt) = @_;
2423 my $ornull = $opt{'ornull'};
2425 my $conf = new FS::Conf;
2427 # '?' placeholders in _location_sql_where
2430 @bill_param = qw( county county state state state country );
2432 @bill_param = qw( county state state country );
2434 unshift @bill_param, 'county'; # unless $nec;
2438 if ( $conf->exists('tax-ship_address') ) {
2441 ( ( ship_last IS NULL OR ship_last = '' )
2442 AND ". _location_sql_where('cust_main', '', $ornull ). "
2444 OR ( ship_last IS NOT NULL AND ship_last != ''
2445 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2448 # AND payby != 'COMP'
2450 @main_param = ( @bill_param, @bill_param );
2454 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2455 @main_param = @bill_param;
2461 if ( $conf->exists('tax-pkg_address') ) {
2463 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2466 ( cust_pkg.locationnum IS NULL AND $main_where )
2467 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2470 @param = ( @main_param, @bill_param );
2474 $where = $main_where;
2475 @param = @main_param;
2483 #subroutine, helper for location_sql
2484 sub _location_sql_where {
2486 my $prefix = @_ ? shift : '';
2487 my $ornull = @_ ? shift : '';
2489 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2491 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2493 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2494 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2497 ( $table.${prefix}county = ? $or_empty_county $ornull )
2498 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2499 AND $table.${prefix}country = ?
2507 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2509 CUSTNUM is a customer (see L<FS::cust_main>)
2511 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2512 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2515 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2516 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2517 new billing items. An error is returned if this is not possible (see
2518 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2521 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2522 newly-created cust_pkg objects.
2524 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2525 and inserted. Multiple FS::pkg_referral records can be created by
2526 setting I<refnum> to an array reference of refnums or a hash reference with
2527 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2528 record will be created corresponding to cust_main.refnum.
2533 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2535 my $conf = new FS::Conf;
2537 # Transactionize this whole mess
2538 local $SIG{HUP} = 'IGNORE';
2539 local $SIG{INT} = 'IGNORE';
2540 local $SIG{QUIT} = 'IGNORE';
2541 local $SIG{TERM} = 'IGNORE';
2542 local $SIG{TSTP} = 'IGNORE';
2543 local $SIG{PIPE} = 'IGNORE';
2545 my $oldAutoCommit = $FS::UID::AutoCommit;
2546 local $FS::UID::AutoCommit = 0;
2550 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2551 # return "Customer not found: $custnum" unless $cust_main;
2553 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2556 my $change = scalar(@old_cust_pkg) != 0;
2559 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2561 my $err_or_cust_pkg =
2562 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2563 'refnum' => $refnum,
2566 unless (ref($err_or_cust_pkg)) {
2567 $dbh->rollback if $oldAutoCommit;
2568 return $err_or_cust_pkg;
2571 push @$return_cust_pkg, $err_or_cust_pkg;
2576 # Create the new packages.
2577 foreach my $pkgpart (@$pkgparts) {
2578 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2579 pkgpart => $pkgpart,
2583 $error = $cust_pkg->insert( 'change' => $change );
2585 $dbh->rollback if $oldAutoCommit;
2588 push @$return_cust_pkg, $cust_pkg;
2590 # $return_cust_pkg now contains refs to all of the newly
2593 # Transfer services and cancel old packages.
2594 foreach my $old_pkg (@old_cust_pkg) {
2596 foreach my $new_pkg (@$return_cust_pkg) {
2597 $error = $old_pkg->transfer($new_pkg);
2598 if ($error and $error == 0) {
2599 # $old_pkg->transfer failed.
2600 $dbh->rollback if $oldAutoCommit;
2605 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2606 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2607 foreach my $new_pkg (@$return_cust_pkg) {
2608 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2609 if ($error and $error == 0) {
2610 # $old_pkg->transfer failed.
2611 $dbh->rollback if $oldAutoCommit;
2618 # Transfers were successful, but we went through all of the
2619 # new packages and still had services left on the old package.
2620 # We can't cancel the package under the circumstances, so abort.
2621 $dbh->rollback if $oldAutoCommit;
2622 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2624 $error = $old_pkg->cancel( quiet=>1 );
2630 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2634 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2636 A bulk change method to change packages for multiple customers.
2638 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2639 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2642 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2643 replace. The services (see L<FS::cust_svc>) are moved to the
2644 new billing items. An error is returned if this is not possible (see
2647 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2648 newly-created cust_pkg objects.
2653 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2655 # Transactionize this whole mess
2656 local $SIG{HUP} = 'IGNORE';
2657 local $SIG{INT} = 'IGNORE';
2658 local $SIG{QUIT} = 'IGNORE';
2659 local $SIG{TERM} = 'IGNORE';
2660 local $SIG{TSTP} = 'IGNORE';
2661 local $SIG{PIPE} = 'IGNORE';
2663 my $oldAutoCommit = $FS::UID::AutoCommit;
2664 local $FS::UID::AutoCommit = 0;
2668 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2671 while(scalar(@old_cust_pkg)) {
2673 my $custnum = $old_cust_pkg[0]->custnum;
2674 my (@remove) = map { $_->pkgnum }
2675 grep { $_->custnum == $custnum } @old_cust_pkg;
2676 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2678 my $error = order $custnum, $pkgparts, \@remove, \@return;
2680 push @errors, $error
2682 push @$return_cust_pkg, @return;
2685 if (scalar(@errors)) {
2686 $dbh->rollback if $oldAutoCommit;
2687 return join(' / ', @errors);
2690 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2696 Associates this package with a (suspension or cancellation) reason (see
2697 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2700 Available options are:
2706 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.
2710 the access_user (see L<FS::access_user>) providing the reason
2718 the action (cancel, susp, adjourn, expire) associated with the reason
2722 If there is an error, returns the error, otherwise returns false.
2727 my ($self, %options) = @_;
2729 my $otaker = $options{reason_otaker} ||
2730 $FS::CurrentUser::CurrentUser->username;
2733 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2737 } elsif ( ref($options{'reason'}) ) {
2739 return 'Enter a new reason (or select an existing one)'
2740 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2742 my $reason = new FS::reason({
2743 'reason_type' => $options{'reason'}->{'typenum'},
2744 'reason' => $options{'reason'}->{'reason'},
2746 my $error = $reason->insert;
2747 return $error if $error;
2749 $reasonnum = $reason->reasonnum;
2752 return "Unparsable reason: ". $options{'reason'};
2755 my $cust_pkg_reason =
2756 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2757 'reasonnum' => $reasonnum,
2758 'otaker' => $otaker,
2759 'action' => substr(uc($options{'action'}),0,1),
2760 'date' => $options{'date'}
2765 $cust_pkg_reason->insert;
2768 =item set_usage USAGE_VALUE_HASHREF
2770 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2771 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2772 upbytes, downbytes, and totalbytes are appropriate keys.
2774 All svc_accts which are part of this package have their values reset.
2779 my ($self, $valueref, %opt) = @_;
2781 foreach my $cust_svc ($self->cust_svc){
2782 my $svc_x = $cust_svc->svc_x;
2783 $svc_x->set_usage($valueref, %opt)
2784 if $svc_x->can("set_usage");
2788 =item recharge USAGE_VALUE_HASHREF
2790 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2791 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2792 upbytes, downbytes, and totalbytes are appropriate keys.
2794 All svc_accts which are part of this package have their values incremented.
2799 my ($self, $valueref) = @_;
2801 foreach my $cust_svc ($self->cust_svc){
2802 my $svc_x = $cust_svc->svc_x;
2803 $svc_x->recharge($valueref)
2804 if $svc_x->can("recharge");
2812 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2814 In sub order, the @pkgparts array (passed by reference) is clobbered.
2816 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2817 method to pass dates to the recur_prog expression, it should do so.
2819 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2820 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2821 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2822 configuration values. Probably need a subroutine which decides what to do
2823 based on whether or not we've fetched the user yet, rather than a hash. See
2824 FS::UID and the TODO.
2826 Now that things are transactional should the check in the insert method be
2831 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2832 L<FS::pkg_svc>, schema.html from the base documentation