4 use vars qw(@ISA $disable_agentcheck $DEBUG);
6 use Scalar::Util qw( blessed );
7 use List::Util qw(max);
10 use FS::UID qw( getotaker dbh );
11 use FS::Misc qw( send_email );
12 use FS::Record qw( qsearch qsearchs );
14 use FS::cust_main_Mixin;
18 use FS::cust_location;
20 use FS::cust_bill_pkg;
21 use FS::cust_pkg_detail;
26 use FS::cust_pkg_reason;
30 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
32 # because they load configuration by setting FS::UID::callback (see TODO)
38 # for sending cancel emails in sub cancel
41 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
45 $disable_agentcheck = 0;
49 my ( $hashref, $cache ) = @_;
50 #if ( $hashref->{'pkgpart'} ) {
51 if ( $hashref->{'pkg'} ) {
52 # #@{ $self->{'_pkgnum'} } = ();
53 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
54 # $self->{'_pkgpart'} = $subcache;
55 # #push @{ $self->{'_pkgnum'} },
56 # FS::part_pkg->new_or_cached($hashref, $subcache);
57 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
59 if ( exists $hashref->{'svcnum'} ) {
60 #@{ $self->{'_pkgnum'} } = ();
61 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
62 $self->{'_svcnum'} = $subcache;
63 #push @{ $self->{'_pkgnum'} },
64 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
70 FS::cust_pkg - Object methods for cust_pkg objects
76 $record = new FS::cust_pkg \%hash;
77 $record = new FS::cust_pkg { 'column' => 'value' };
79 $error = $record->insert;
81 $error = $new_record->replace($old_record);
83 $error = $record->delete;
85 $error = $record->check;
87 $error = $record->cancel;
89 $error = $record->suspend;
91 $error = $record->unsuspend;
93 $part_pkg = $record->part_pkg;
95 @labels = $record->labels;
97 $seconds = $record->seconds_since($timestamp);
99 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
100 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
104 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
105 inherits from FS::Record. The following fields are currently supported:
111 Primary key (assigned automatically for new billing items)
115 Customer (see L<FS::cust_main>)
119 Billing item definition (see L<FS::part_pkg>)
123 Optional link to package location (see L<FS::location>)
131 date (next bill date)
155 order taker (assigned automatically if null, see L<FS::UID>)
159 If this field is set to 1, disables the automatic
160 unsuspension of this package when using the B<unsuspendauto> config option.
164 If not set, defaults to 1
168 Date of change from previous package
178 =item change_locationnum
184 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
185 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
186 L<Time::Local> and L<Date::Parse> for conversion functions.
194 Create a new billing item. To add the item to the database, see L<"insert">.
198 sub table { 'cust_pkg'; }
199 sub cust_linked { $_[0]->cust_main_custnum; }
200 sub cust_unlinked_msg {
202 "WARNING: can't find cust_main.custnum ". $self->custnum.
203 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
206 =item insert [ OPTION => VALUE ... ]
208 Adds this billing item to the database ("Orders" the item). If there is an
209 error, returns the error, otherwise returns false.
211 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
212 will be used to look up the package definition and agent restrictions will be
215 If the additional field I<refnum> is defined, an FS::pkg_referral record will
216 be created and inserted. Multiple FS::pkg_referral records can be created by
217 setting I<refnum> to an array reference of refnums or a hash reference with
218 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
219 record will be created corresponding to cust_main.refnum.
221 The following options are available:
227 If set true, supresses any referral credit to a referring customer.
231 cust_pkg_option records will be created
235 a ticket will be added to this customer with this subject
239 an optional queue name for ticket additions
246 my( $self, %options ) = @_;
248 local $SIG{HUP} = 'IGNORE';
249 local $SIG{INT} = 'IGNORE';
250 local $SIG{QUIT} = 'IGNORE';
251 local $SIG{TERM} = 'IGNORE';
252 local $SIG{TSTP} = 'IGNORE';
253 local $SIG{PIPE} = 'IGNORE';
255 my $oldAutoCommit = $FS::UID::AutoCommit;
256 local $FS::UID::AutoCommit = 0;
259 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
261 $dbh->rollback if $oldAutoCommit;
265 $self->refnum($self->cust_main->refnum) unless $self->refnum;
266 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
267 $self->process_m2m( 'link_table' => 'pkg_referral',
268 'target_table' => 'part_referral',
269 'params' => $self->refnum,
272 #if ( $self->reg_code ) {
273 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
274 # $error = $reg_code->delete;
276 # $dbh->rollback if $oldAutoCommit;
281 my $conf = new FS::Conf;
283 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
285 use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
292 my $q = new RT::Queue($RT::SystemUser);
293 $q->Load($options{ticket_queue}) if $options{ticket_queue};
294 my $t = new RT::Ticket($RT::SystemUser);
295 my $mime = new MIME::Entity;
296 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
297 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
298 Subject => $options{ticket_subject},
301 $t->AddLink( Type => 'MemberOf',
302 Target => 'freeside://freeside/cust_main/'. $self->custnum,
306 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
307 my $queue = new FS::queue {
308 'job' => 'FS::cust_main::queueable_print',
310 $error = $queue->insert(
311 'custnum' => $self->custnum,
312 'template' => 'welcome_letter',
316 warn "can't send welcome letter: $error";
321 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
328 This method now works but you probably shouldn't use it.
330 You don't want to delete billing items, because there would then be no record
331 the customer ever purchased the item. Instead, see the cancel method.
336 # return "Can't delete cust_pkg records!";
339 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
341 Replaces the OLD_RECORD with this one in the database. If there is an error,
342 returns the error, otherwise returns false.
344 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
346 Changing pkgpart may have disasterous effects. See the order subroutine.
348 setup and bill are normally updated by calling the bill method of a customer
349 object (see L<FS::cust_main>).
351 suspend is normally updated by the suspend and unsuspend methods.
353 cancel is normally updated by the cancel method (and also the order subroutine
356 Available options are:
362 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.
366 the access_user (see L<FS::access_user>) providing the reason
370 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
379 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
384 ( ref($_[0]) eq 'HASH' )
388 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
389 return "Can't change otaker!" if $old->otaker ne $new->otaker;
392 #return "Can't change setup once it exists!"
393 # if $old->getfield('setup') &&
394 # $old->getfield('setup') != $new->getfield('setup');
396 #some logic for bill, susp, cancel?
398 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
400 local $SIG{HUP} = 'IGNORE';
401 local $SIG{INT} = 'IGNORE';
402 local $SIG{QUIT} = 'IGNORE';
403 local $SIG{TERM} = 'IGNORE';
404 local $SIG{TSTP} = 'IGNORE';
405 local $SIG{PIPE} = 'IGNORE';
407 my $oldAutoCommit = $FS::UID::AutoCommit;
408 local $FS::UID::AutoCommit = 0;
411 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
412 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
413 my $error = $new->insert_reason(
414 'reason' => $options->{'reason'},
415 'date' => $new->$method,
417 'reason_otaker' => $options->{'reason_otaker'},
420 dbh->rollback if $oldAutoCommit;
421 return "Error inserting cust_pkg_reason: $error";
426 #save off and freeze RADIUS attributes for any associated svc_acct records
428 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
430 #also check for specific exports?
431 # to avoid spurious modify export events
432 @svc_acct = map { $_->svc_x }
433 grep { $_->part_svc->svcdb eq 'svc_acct' }
436 $_->snapshot foreach @svc_acct;
440 my $error = $new->SUPER::replace($old,
441 $options->{options} ? $options->{options} : ()
444 $dbh->rollback if $oldAutoCommit;
448 #for prepaid packages,
449 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
450 foreach my $old_svc_acct ( @svc_acct ) {
451 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
452 my $s_error = $new_svc_acct->replace($old_svc_acct);
454 $dbh->rollback if $oldAutoCommit;
459 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
466 Checks all fields to make sure this is a valid billing item. If there is an
467 error, returns the error, otherwise returns false. Called by the insert and
475 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
478 $self->ut_numbern('pkgnum')
479 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
480 || $self->ut_numbern('pkgpart')
481 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
482 || $self->ut_numbern('setup')
483 || $self->ut_numbern('bill')
484 || $self->ut_numbern('susp')
485 || $self->ut_numbern('cancel')
486 || $self->ut_numbern('adjourn')
487 || $self->ut_numbern('expire')
489 return $error if $error;
491 if ( $self->reg_code ) {
493 unless ( grep { $self->pkgpart == $_->pkgpart }
494 map { $_->reg_code_pkg }
495 qsearchs( 'reg_code', { 'code' => $self->reg_code,
496 'agentnum' => $self->cust_main->agentnum })
498 return "Unknown registration code";
501 } elsif ( $self->promo_code ) {
504 qsearchs('part_pkg', {
505 'pkgpart' => $self->pkgpart,
506 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
508 return 'Unknown promotional code' unless $promo_part_pkg;
512 unless ( $disable_agentcheck ) {
514 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
515 return "agent ". $agent->agentnum. ':'. $agent->agent.
516 " can't purchase pkgpart ". $self->pkgpart
517 unless $agent->pkgpart_hashref->{ $self->pkgpart }
518 || $agent->agentnum == $self->part_pkg->agentnum;
521 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
522 return $error if $error;
526 $self->otaker(getotaker) unless $self->otaker;
527 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
530 if ( $self->dbdef_table->column('manual_flag') ) {
531 $self->manual_flag('') if $self->manual_flag eq ' ';
532 $self->manual_flag =~ /^([01]?)$/
533 or return "Illegal manual_flag ". $self->manual_flag;
534 $self->manual_flag($1);
540 =item cancel [ OPTION => VALUE ... ]
542 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
543 in this package, then cancels the package itself (sets the cancel field to
546 Available options are:
550 =item quiet - can be set true to supress email cancellation notices.
552 =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.
554 =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.
556 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
560 If there is an error, returns the error, otherwise returns false.
565 my( $self, %options ) = @_;
568 warn "cust_pkg::cancel called with options".
569 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
572 local $SIG{HUP} = 'IGNORE';
573 local $SIG{INT} = 'IGNORE';
574 local $SIG{QUIT} = 'IGNORE';
575 local $SIG{TERM} = 'IGNORE';
576 local $SIG{TSTP} = 'IGNORE';
577 local $SIG{PIPE} = 'IGNORE';
579 my $oldAutoCommit = $FS::UID::AutoCommit;
580 local $FS::UID::AutoCommit = 0;
583 my $old = $self->select_for_update;
585 if ( $old->get('cancel') || $self->get('cancel') ) {
586 dbh->rollback if $oldAutoCommit;
587 return ""; # no error
590 my $date = $options{date} if $options{date}; # expire/cancel later
591 $date = '' if ($date && $date <= time); # complain instead?
593 my $cancel_time = $options{'time'} || time;
595 if ( $options{'reason'} ) {
596 $error = $self->insert_reason( 'reason' => $options{'reason'},
597 'action' => $date ? 'expire' : 'cancel',
598 'date' => $date ? $date : $cancel_time,
599 'reason_otaker' => $options{'reason_otaker'},
602 dbh->rollback if $oldAutoCommit;
603 return "Error inserting cust_pkg_reason: $error";
609 foreach my $cust_svc (
612 sort { $a->[1] <=> $b->[1] }
613 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
614 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
617 my $error = $cust_svc->cancel;
620 $dbh->rollback if $oldAutoCommit;
621 return "Error cancelling cust_svc: $error";
625 # Add a credit for remaining service
626 my $remaining_value = $self->calc_remain(time=>$cancel_time);
627 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
628 my $conf = new FS::Conf;
629 my $error = $self->cust_main->credit(
631 'Credit for unused time on '. $self->part_pkg->pkg,
632 'reason_type' => $conf->config('cancel_credit_type'),
635 $dbh->rollback if $oldAutoCommit;
636 return "Error crediting customer \$$remaining_value for unused time on".
637 $self->part_pkg->pkg. ": $error";
642 my %hash = $self->hash;
643 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
644 my $new = new FS::cust_pkg ( \%hash );
645 $error = $new->replace( $self, options => { $self->options } );
647 $dbh->rollback if $oldAutoCommit;
651 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
652 return '' if $date; #no errors
654 my $conf = new FS::Conf;
655 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
656 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
657 my $conf = new FS::Conf;
658 my $error = send_email(
659 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
660 'to' => \@invoicing_list,
661 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
662 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
664 #should this do something on errors?
671 =item cancel_if_expired [ NOW_TIMESTAMP ]
673 Cancels this package if its expire date has been reached.
677 sub cancel_if_expired {
679 my $time = shift || time;
680 return '' unless $self->expire && $self->expire <= $time;
681 my $error = $self->cancel;
683 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
684 $self->custnum. ": $error";
691 Cancels any pending expiration (sets the expire field to null).
693 If there is an error, returns the error, otherwise returns false.
698 my( $self, %options ) = @_;
701 local $SIG{HUP} = 'IGNORE';
702 local $SIG{INT} = 'IGNORE';
703 local $SIG{QUIT} = 'IGNORE';
704 local $SIG{TERM} = 'IGNORE';
705 local $SIG{TSTP} = 'IGNORE';
706 local $SIG{PIPE} = 'IGNORE';
708 my $oldAutoCommit = $FS::UID::AutoCommit;
709 local $FS::UID::AutoCommit = 0;
712 my $old = $self->select_for_update;
714 my $pkgnum = $old->pkgnum;
715 if ( $old->get('cancel') || $self->get('cancel') ) {
716 dbh->rollback if $oldAutoCommit;
717 return "Can't unexpire cancelled package $pkgnum";
718 # or at least it's pointless
721 unless ( $old->get('expire') && $self->get('expire') ) {
722 dbh->rollback if $oldAutoCommit;
723 return ""; # no error
726 my %hash = $self->hash;
727 $hash{'expire'} = '';
728 my $new = new FS::cust_pkg ( \%hash );
729 $error = $new->replace( $self, options => { $self->options } );
731 $dbh->rollback if $oldAutoCommit;
735 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
741 =item suspend [ OPTION => VALUE ... ]
743 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
744 package, then suspends the package itself (sets the susp field to now).
746 Available options are:
750 =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.
752 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
756 If there is an error, returns the error, otherwise returns false.
761 my( $self, %options ) = @_;
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
775 my $old = $self->select_for_update;
777 my $pkgnum = $old->pkgnum;
778 if ( $old->get('cancel') || $self->get('cancel') ) {
779 dbh->rollback if $oldAutoCommit;
780 return "Can't suspend cancelled package $pkgnum";
783 if ( $old->get('susp') || $self->get('susp') ) {
784 dbh->rollback if $oldAutoCommit;
785 return ""; # no error # complain on adjourn?
788 my $date = $options{date} if $options{date}; # adjourn/suspend later
789 $date = '' if ($date && $date <= time); # complain instead?
791 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
792 dbh->rollback if $oldAutoCommit;
793 return "Package $pkgnum expires before it would be suspended.";
796 my $suspend_time = $options{'time'} || time;
798 if ( $options{'reason'} ) {
799 $error = $self->insert_reason( 'reason' => $options{'reason'},
800 'action' => $date ? 'adjourn' : 'suspend',
801 'date' => $date ? $date : $suspend_time,
802 'reason_otaker' => $options{'reason_otaker'},
805 dbh->rollback if $oldAutoCommit;
806 return "Error inserting cust_pkg_reason: $error";
814 foreach my $cust_svc (
815 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
817 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
819 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
820 $dbh->rollback if $oldAutoCommit;
821 return "Illegal svcdb value in part_svc!";
824 require "FS/$svcdb.pm";
826 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
828 $error = $svc->suspend;
830 $dbh->rollback if $oldAutoCommit;
833 my( $label, $value ) = $cust_svc->label;
834 push @labels, "$label: $value";
838 my $conf = new FS::Conf;
839 if ( $conf->config('suspend_email_admin') ) {
841 my $error = send_email(
842 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
843 #invoice_from ??? well as good as any
844 'to' => $conf->config('suspend_email_admin'),
845 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
847 "This is an automatic message from your Freeside installation\n",
848 "informing you that the following customer package has been suspended:\n",
850 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
851 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
852 ( map { "Service : $_\n" } @labels ),
857 warn "WARNING: can't send suspension admin email (suspending anyway): ".
865 my %hash = $self->hash;
867 $hash{'adjourn'} = $date;
869 $hash{'susp'} = $suspend_time;
871 my $new = new FS::cust_pkg ( \%hash );
872 $error = $new->replace( $self, options => { $self->options } );
874 $dbh->rollback if $oldAutoCommit;
878 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
883 =item unsuspend [ OPTION => VALUE ... ]
885 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
886 package, then unsuspends the package itself (clears the susp field and the
887 adjourn field if it is in the past).
889 Available options are:
893 =item adjust_next_bill
895 Can be set true to adjust the next bill date forward by
896 the amount of time the account was inactive. This was set true by default
897 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
898 explicitly requested. Price plans for which this makes sense (anniversary-date
899 based than prorate or subscription) could have an option to enable this
904 If there is an error, returns the error, otherwise returns false.
909 my( $self, %opt ) = @_;
912 local $SIG{HUP} = 'IGNORE';
913 local $SIG{INT} = 'IGNORE';
914 local $SIG{QUIT} = 'IGNORE';
915 local $SIG{TERM} = 'IGNORE';
916 local $SIG{TSTP} = 'IGNORE';
917 local $SIG{PIPE} = 'IGNORE';
919 my $oldAutoCommit = $FS::UID::AutoCommit;
920 local $FS::UID::AutoCommit = 0;
923 my $old = $self->select_for_update;
925 my $pkgnum = $old->pkgnum;
926 if ( $old->get('cancel') || $self->get('cancel') ) {
927 dbh->rollback if $oldAutoCommit;
928 return "Can't unsuspend cancelled package $pkgnum";
931 unless ( $old->get('susp') && $self->get('susp') ) {
932 dbh->rollback if $oldAutoCommit;
933 return ""; # no error # complain instead?
936 foreach my $cust_svc (
937 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
939 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
941 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
942 $dbh->rollback if $oldAutoCommit;
943 return "Illegal svcdb value in part_svc!";
946 require "FS/$svcdb.pm";
948 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
950 $error = $svc->unsuspend;
952 $dbh->rollback if $oldAutoCommit;
959 my %hash = $self->hash;
960 my $inactive = time - $hash{'susp'};
962 my $conf = new FS::Conf;
964 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
965 if ( $opt{'adjust_next_bill'}
966 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
967 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
970 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
971 my $new = new FS::cust_pkg ( \%hash );
972 $error = $new->replace( $self, options => { $self->options } );
974 $dbh->rollback if $oldAutoCommit;
978 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
985 Cancels any pending suspension (sets the adjourn field to null).
987 If there is an error, returns the error, otherwise returns false.
992 my( $self, %options ) = @_;
995 local $SIG{HUP} = 'IGNORE';
996 local $SIG{INT} = 'IGNORE';
997 local $SIG{QUIT} = 'IGNORE';
998 local $SIG{TERM} = 'IGNORE';
999 local $SIG{TSTP} = 'IGNORE';
1000 local $SIG{PIPE} = 'IGNORE';
1002 my $oldAutoCommit = $FS::UID::AutoCommit;
1003 local $FS::UID::AutoCommit = 0;
1006 my $old = $self->select_for_update;
1008 my $pkgnum = $old->pkgnum;
1009 if ( $old->get('cancel') || $self->get('cancel') ) {
1010 dbh->rollback if $oldAutoCommit;
1011 return "Can't unadjourn cancelled package $pkgnum";
1012 # or at least it's pointless
1015 if ( $old->get('susp') || $self->get('susp') ) {
1016 dbh->rollback if $oldAutoCommit;
1017 return "Can't unadjourn suspended package $pkgnum";
1018 # perhaps this is arbitrary
1021 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1022 dbh->rollback if $oldAutoCommit;
1023 return ""; # no error
1026 my %hash = $self->hash;
1027 $hash{'adjourn'} = '';
1028 my $new = new FS::cust_pkg ( \%hash );
1029 $error = $new->replace( $self, options => { $self->options } );
1031 $dbh->rollback if $oldAutoCommit;
1035 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1042 =item change HASHREF | OPTION => VALUE ...
1044 Changes this package: cancels it and creates a new one, with a different
1045 pkgpart or locationnum or both. All services are transferred to the new
1046 package (no change will be made if this is not possible).
1048 Options may be passed as a list of key/value pairs or as a hash reference.
1055 New locationnum, to change the location for this package.
1059 New FS::cust_location object, to create a new location and assign it
1064 New pkgpart (see L<FS::part_pkg>).
1068 New refnum (see L<FS::part_referral>).
1072 At least one option must be specified (otherwise, what's the point?)
1074 Returns either the new FS::cust_pkg object or a scalar error.
1078 my $err_or_new_cust_pkg = $old_cust_pkg->change
1082 #some false laziness w/order
1085 my $opt = ref($_[0]) ? shift : { @_ };
1087 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1090 my $conf = new FS::Conf;
1092 # Transactionize this whole mess
1093 local $SIG{HUP} = 'IGNORE';
1094 local $SIG{INT} = 'IGNORE';
1095 local $SIG{QUIT} = 'IGNORE';
1096 local $SIG{TERM} = 'IGNORE';
1097 local $SIG{TSTP} = 'IGNORE';
1098 local $SIG{PIPE} = 'IGNORE';
1100 my $oldAutoCommit = $FS::UID::AutoCommit;
1101 local $FS::UID::AutoCommit = 0;
1110 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1112 #$hash{$_} = $self->$_() foreach qw( setup );
1114 $hash{'setup'} = $time if $self->setup;
1116 $hash{'change_date'} = $time;
1117 $hash{"change_$_"} = $self->$_()
1118 foreach qw( pkgnum pkgpart locationnum );
1120 if ( $opt->{'cust_location'} &&
1121 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1122 $error = $opt->{'cust_location'}->insert;
1124 $dbh->rollback if $oldAutoCommit;
1125 return "inserting cust_location (transaction rolled back): $error";
1127 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1130 # Create the new package.
1131 my $cust_pkg = new FS::cust_pkg {
1132 custnum => $self->custnum,
1133 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1134 refnum => ( $opt->{'refnum'} || $self->refnum ),
1135 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1139 $error = $cust_pkg->insert( 'change' => 1 );
1141 $dbh->rollback if $oldAutoCommit;
1145 # Transfer services and cancel old package.
1147 $error = $self->transfer($cust_pkg);
1148 if ($error and $error == 0) {
1149 # $old_pkg->transfer failed.
1150 $dbh->rollback if $oldAutoCommit;
1154 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1155 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1156 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1157 if ($error and $error == 0) {
1158 # $old_pkg->transfer failed.
1159 $dbh->rollback if $oldAutoCommit;
1165 # Transfers were successful, but we still had services left on the old
1166 # package. We can't change the package under this circumstances, so abort.
1167 $dbh->rollback if $oldAutoCommit;
1168 return "Unable to transfer all services from package ". $self->pkgnum;
1171 #reset usage if changing pkgpart
1172 if ($self->pkgpart != $cust_pkg->pkgpart) {
1173 my $part_pkg = $cust_pkg->part_pkg;
1174 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1178 if $part_pkg->can('reset_usage');
1181 $dbh->rollback if $oldAutoCommit;
1182 return "Error setting usage values: $error";
1186 #Good to go, cancel old package.
1187 $error = $self->cancel( quiet=>1 );
1193 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1200 Returns the last bill date, or if there is no last bill date, the setup date.
1201 Useful for billing metered services.
1207 return $self->setfield('last_bill', $_[0]) if @_;
1208 return $self->getfield('last_bill') if $self->getfield('last_bill');
1209 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1210 'edate' => $self->bill, } );
1211 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1214 =item last_cust_pkg_reason ACTION
1216 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1217 Returns false if there is no reason or the package is not currenly ACTION'd
1218 ACTION is one of adjourn, susp, cancel, or expire.
1222 sub last_cust_pkg_reason {
1223 my ( $self, $action ) = ( shift, shift );
1224 my $date = $self->get($action);
1226 'table' => 'cust_pkg_reason',
1227 'hashref' => { 'pkgnum' => $self->pkgnum,
1228 'action' => substr(uc($action), 0, 1),
1231 'order_by' => 'ORDER BY num DESC LIMIT 1',
1235 =item last_reason ACTION
1237 Returns the most recent ACTION FS::reason associated with the package.
1238 Returns false if there is no reason or the package is not currenly ACTION'd
1239 ACTION is one of adjourn, susp, cancel, or expire.
1244 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1245 $cust_pkg_reason->reason
1246 if $cust_pkg_reason;
1251 Returns the definition for this billing item, as an FS::part_pkg object (see
1258 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1259 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1260 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1265 Returns the cancelled package this package was changed from, if any.
1271 return '' unless $self->change_pkgnum;
1272 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1277 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1284 $self->part_pkg->calc_setup($self, @_);
1289 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1296 $self->part_pkg->calc_recur($self, @_);
1301 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1308 $self->part_pkg->calc_remain($self, @_);
1313 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1320 $self->part_pkg->calc_cancel($self, @_);
1325 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1331 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1334 =item cust_pkg_detail [ DETAILTYPE ]
1336 Returns any customer package details for this package (see
1337 L<FS::cust_pkg_detail>).
1339 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1343 sub cust_pkg_detail {
1345 my %hash = ( 'pkgnum' => $self->pkgnum );
1346 $hash{detailtype} = shift if @_;
1348 'table' => 'cust_pkg_detail',
1349 'hashref' => \%hash,
1350 'order_by' => 'ORDER BY weight, pkgdetailnum',
1354 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1356 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1358 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1360 If there is an error, returns the error, otherwise returns false.
1364 sub set_cust_pkg_detail {
1365 my( $self, $detailtype, @details ) = @_;
1367 local $SIG{HUP} = 'IGNORE';
1368 local $SIG{INT} = 'IGNORE';
1369 local $SIG{QUIT} = 'IGNORE';
1370 local $SIG{TERM} = 'IGNORE';
1371 local $SIG{TSTP} = 'IGNORE';
1372 local $SIG{PIPE} = 'IGNORE';
1374 my $oldAutoCommit = $FS::UID::AutoCommit;
1375 local $FS::UID::AutoCommit = 0;
1378 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1379 my $error = $current->delete;
1381 $dbh->rollback if $oldAutoCommit;
1382 return "error removing old detail: $error";
1386 foreach my $detail ( @details ) {
1387 my $cust_pkg_detail = new FS::cust_pkg_detail {
1388 'pkgnum' => $self->pkgnum,
1389 'detailtype' => $detailtype,
1390 'detail' => $detail,
1392 my $error = $cust_pkg_detail->insert;
1394 $dbh->rollback if $oldAutoCommit;
1395 return "error adding new detail: $error";
1400 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1407 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1411 #false laziness w/cust_bill.pm
1415 'table' => 'cust_event',
1416 'addl_from' => 'JOIN part_event USING ( eventpart )',
1417 'hashref' => { 'tablenum' => $self->pkgnum },
1418 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1422 =item num_cust_event
1424 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1428 #false laziness w/cust_bill.pm
1429 sub num_cust_event {
1432 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1433 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1434 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1435 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1436 $sth->fetchrow_arrayref->[0];
1439 =item cust_svc [ SVCPART ]
1441 Returns the services for this package, as FS::cust_svc objects (see
1442 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1450 return () unless $self->num_cust_svc(@_);
1453 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1454 'svcpart' => shift, } );
1457 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1459 #if ( $self->{'_svcnum'} ) {
1460 # values %{ $self->{'_svcnum'}->cache };
1462 $self->_sort_cust_svc(
1463 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1469 =item overlimit [ SVCPART ]
1471 Returns the services for this package which have exceeded their
1472 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1473 is specified, return only the matching services.
1479 return () unless $self->num_cust_svc(@_);
1480 grep { $_->overlimit } $self->cust_svc(@_);
1483 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1485 Returns historical services for this package created before END TIMESTAMP and
1486 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1487 (see L<FS::h_cust_svc>).
1494 $self->_sort_cust_svc(
1495 [ qsearch( 'h_cust_svc',
1496 { 'pkgnum' => $self->pkgnum, },
1497 FS::h_cust_svc->sql_h_search(@_),
1503 sub _sort_cust_svc {
1504 my( $self, $arrayref ) = @_;
1507 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1509 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1510 'svcpart' => $_->svcpart } );
1512 $pkg_svc ? $pkg_svc->primary_svc : '',
1513 $pkg_svc ? $pkg_svc->quantity : 0,
1520 =item num_cust_svc [ SVCPART ]
1522 Returns the number of provisioned services for this package. If a svcpart is
1523 specified, counts only the matching services.
1530 return $self->{'_num_cust_svc'}
1532 && exists($self->{'_num_cust_svc'})
1533 && $self->{'_num_cust_svc'} =~ /\d/;
1535 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1538 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1539 $sql .= ' AND svcpart = ?' if @_;
1541 my $sth = dbh->prepare($sql) or die dbh->errstr;
1542 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1543 $sth->fetchrow_arrayref->[0];
1546 =item available_part_svc
1548 Returns a list of FS::part_svc objects representing services included in this
1549 package but not yet provisioned. Each FS::part_svc object also has an extra
1550 field, I<num_avail>, which specifies the number of available services.
1554 sub available_part_svc {
1556 grep { $_->num_avail > 0 }
1558 my $part_svc = $_->part_svc;
1559 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1560 $_->quantity - $self->num_cust_svc($_->svcpart);
1563 $self->part_pkg->pkg_svc;
1568 Returns a list of FS::part_svc objects representing provisioned and available
1569 services included in this package. Each FS::part_svc object also has the
1570 following extra fields:
1574 =item num_cust_svc (count)
1576 =item num_avail (quantity - count)
1578 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1581 label -> ($cust_svc->label)[1]
1590 #XXX some sort of sort order besides numeric by svcpart...
1591 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1593 my $part_svc = $pkg_svc->part_svc;
1594 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1595 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1596 $part_svc->{'Hash'}{'num_avail'} =
1597 max( 0, $pkg_svc->quantity - $num_cust_svc );
1598 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1599 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1601 } $self->part_pkg->pkg_svc;
1604 push @part_svc, map {
1606 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1607 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1608 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1609 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1610 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1612 } $self->extra_part_svc;
1618 =item extra_part_svc
1620 Returns a list of FS::part_svc objects corresponding to services in this
1621 package which are still provisioned but not (any longer) available in the
1626 sub extra_part_svc {
1629 my $pkgnum = $self->pkgnum;
1630 my $pkgpart = $self->pkgpart;
1633 # 'table' => 'part_svc',
1636 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1637 # WHERE pkg_svc.svcpart = part_svc.svcpart
1638 # AND pkg_svc.pkgpart = ?
1641 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1642 # LEFT JOIN cust_pkg USING ( pkgnum )
1643 # WHERE cust_svc.svcpart = part_svc.svcpart
1646 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1649 #seems to benchmark slightly faster...
1651 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1652 'table' => 'part_svc',
1654 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1655 AND pkg_svc.pkgpart = ?
1658 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1659 LEFT JOIN cust_pkg USING ( pkgnum )
1662 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1663 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1669 Returns a short status string for this package, currently:
1673 =item not yet billed
1675 =item one-time charge
1690 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1692 return 'cancelled' if $self->get('cancel');
1693 return 'suspended' if $self->susp;
1694 return 'not yet billed' unless $self->setup;
1695 return 'one-time charge' if $freq =~ /^(0|$)/;
1701 Class method that returns the list of possible status strings for packages
1702 (see L<the status method|/status>). For example:
1704 @statuses = FS::cust_pkg->statuses();
1708 tie my %statuscolor, 'Tie::IxHash',
1709 'not yet billed' => '000000',
1710 'one-time charge' => '000000',
1711 'active' => '00CC00',
1712 'suspended' => 'FF9900',
1713 'cancelled' => 'FF0000',
1717 my $self = shift; #could be class...
1718 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1719 # # mayble split btw one-time vs. recur
1725 Returns a hex triplet color string for this package's status.
1731 $statuscolor{$self->status};
1736 Returns a list of lists, calling the label method for all services
1737 (see L<FS::cust_svc>) of this billing item.
1743 map { [ $_->label ] } $self->cust_svc;
1746 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1748 Like the labels method, but returns historical information on services that
1749 were active as of END_TIMESTAMP and (optionally) not cancelled before
1752 Returns a list of lists, calling the label method for all (historical) services
1753 (see L<FS::h_cust_svc>) of this billing item.
1759 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1762 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1764 Like h_labels, except returns a simple flat list, and shortens long
1765 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1766 identical services to one line that lists the service label and the number of
1767 individual services rather than individual items.
1771 sub h_labels_short {
1774 my $conf = new FS::Conf;
1775 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1778 #tie %labels, 'Tie::IxHash';
1779 push @{ $labels{$_->[0]} }, $_->[1]
1780 foreach $self->h_labels(@_);
1782 foreach my $label ( keys %labels ) {
1784 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1785 my $num = scalar(@values);
1786 if ( $num > $max_same_services ) {
1787 push @labels, "$label ($num)";
1789 push @labels, map { "$label: $_" } @values;
1799 Returns the parent customer object (see L<FS::cust_main>).
1805 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1810 Returns the location object, if any (see L<FS::cust_location>).
1816 return '' unless $self->locationnum;
1817 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1820 =item cust_location_or_main
1822 If this package is associated with a location, returns the locaiton (see
1823 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1827 sub cust_location_or_main {
1829 $self->cust_location || $self->cust_main;
1832 =item seconds_since TIMESTAMP
1834 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1835 package have been online since TIMESTAMP, according to the session monitor.
1837 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1838 L<Time::Local> and L<Date::Parse> for conversion functions.
1843 my($self, $since) = @_;
1846 foreach my $cust_svc (
1847 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1849 $seconds += $cust_svc->seconds_since($since);
1856 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1858 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1859 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1862 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1863 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1869 sub seconds_since_sqlradacct {
1870 my($self, $start, $end) = @_;
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 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1888 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1890 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1891 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1895 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1896 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1901 sub attribute_since_sqlradacct {
1902 my($self, $start, $end, $attrib) = @_;
1906 foreach my $cust_svc (
1908 my $part_svc = $_->part_svc;
1909 $part_svc->svcdb eq 'svc_acct'
1910 && scalar($part_svc->part_export('sqlradius'));
1913 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1925 my( $self, $value ) = @_;
1926 if ( defined($value) ) {
1927 $self->setfield('quantity', $value);
1929 $self->getfield('quantity') || 1;
1932 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1934 Transfers as many services as possible from this package to another package.
1936 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1937 object. The destination package must already exist.
1939 Services are moved only if the destination allows services with the correct
1940 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1941 this option with caution! No provision is made for export differences
1942 between the old and new service definitions. Probably only should be used
1943 when your exports for all service definitions of a given svcdb are identical.
1944 (attempt a transfer without it first, to move all possible svcpart-matching
1947 Any services that can't be moved remain in the original package.
1949 Returns an error, if there is one; otherwise, returns the number of services
1950 that couldn't be moved.
1955 my ($self, $dest_pkgnum, %opt) = @_;
1961 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1962 $dest = $dest_pkgnum;
1963 $dest_pkgnum = $dest->pkgnum;
1965 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1968 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1970 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1971 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1974 foreach my $cust_svc ($dest->cust_svc) {
1975 $target{$cust_svc->svcpart}--;
1978 my %svcpart2svcparts = ();
1979 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1980 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1981 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1982 next if exists $svcpart2svcparts{$svcpart};
1983 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1984 $svcpart2svcparts{$svcpart} = [
1986 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1988 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1989 'svcpart' => $_ } );
1991 $pkg_svc ? $pkg_svc->primary_svc : '',
1992 $pkg_svc ? $pkg_svc->quantity : 0,
1996 grep { $_ != $svcpart }
1998 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2000 warn "alternates for svcpart $svcpart: ".
2001 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2006 foreach my $cust_svc ($self->cust_svc) {
2007 if($target{$cust_svc->svcpart} > 0) {
2008 $target{$cust_svc->svcpart}--;
2009 my $new = new FS::cust_svc { $cust_svc->hash };
2010 $new->pkgnum($dest_pkgnum);
2011 my $error = $new->replace($cust_svc);
2012 return $error if $error;
2013 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2015 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2016 warn "alternates to consider: ".
2017 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2019 my @alternate = grep {
2020 warn "considering alternate svcpart $_: ".
2021 "$target{$_} available in new package\n"
2024 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2026 warn "alternate(s) found\n" if $DEBUG;
2027 my $change_svcpart = $alternate[0];
2028 $target{$change_svcpart}--;
2029 my $new = new FS::cust_svc { $cust_svc->hash };
2030 $new->svcpart($change_svcpart);
2031 $new->pkgnum($dest_pkgnum);
2032 my $error = $new->replace($cust_svc);
2033 return $error if $error;
2046 This method is deprecated. See the I<depend_jobnum> option to the insert and
2047 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2054 local $SIG{HUP} = 'IGNORE';
2055 local $SIG{INT} = 'IGNORE';
2056 local $SIG{QUIT} = 'IGNORE';
2057 local $SIG{TERM} = 'IGNORE';
2058 local $SIG{TSTP} = 'IGNORE';
2059 local $SIG{PIPE} = 'IGNORE';
2061 my $oldAutoCommit = $FS::UID::AutoCommit;
2062 local $FS::UID::AutoCommit = 0;
2065 foreach my $cust_svc ( $self->cust_svc ) {
2066 #false laziness w/svc_Common::insert
2067 my $svc_x = $cust_svc->svc_x;
2068 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2069 my $error = $part_export->export_insert($svc_x);
2071 $dbh->rollback if $oldAutoCommit;
2077 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2084 =head1 CLASS METHODS
2090 Returns an SQL expression identifying recurring packages.
2094 sub recurring_sql { "
2095 '0' != ( select freq from part_pkg
2096 where cust_pkg.pkgpart = part_pkg.pkgpart )
2101 Returns an SQL expression identifying one-time packages.
2106 '0' = ( select freq from part_pkg
2107 where cust_pkg.pkgpart = part_pkg.pkgpart )
2112 Returns an SQL expression identifying active packages.
2117 ". $_[0]->recurring_sql(). "
2118 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2119 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2122 =item not_yet_billed_sql
2124 Returns an SQL expression identifying packages which have not yet been billed.
2128 sub not_yet_billed_sql { "
2129 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2130 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2131 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2136 Returns an SQL expression identifying inactive packages (one-time packages
2137 that are otherwise unsuspended/uncancelled).
2141 sub inactive_sql { "
2142 ". $_[0]->onetime_sql(). "
2143 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2144 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2145 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2151 Returns an SQL expression identifying suspended packages.
2155 sub suspended_sql { susp_sql(@_); }
2157 #$_[0]->recurring_sql(). ' AND '.
2159 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2160 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2167 Returns an SQL exprression identifying cancelled packages.
2171 sub cancelled_sql { cancel_sql(@_); }
2173 #$_[0]->recurring_sql(). ' AND '.
2174 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2177 =item search_sql HASHREF
2181 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2182 Valid parameters are
2190 active, inactive, suspended, cancel (or cancelled)
2194 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2204 arrayref of beginning and ending epoch date
2208 arrayref of beginning and ending epoch date
2212 arrayref of beginning and ending epoch date
2216 arrayref of beginning and ending epoch date
2220 arrayref of beginning and ending epoch date
2224 arrayref of beginning and ending epoch date
2228 arrayref of beginning and ending epoch date
2232 pkgnum or APKG_pkgnum
2236 a value suited to passing to FS::UI::Web::cust_header
2240 specifies the user for agent virtualization
2247 my ($class, $params) = @_;
2254 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2256 "cust_main.agentnum = $1";
2263 if ( $params->{'magic'} eq 'active'
2264 || $params->{'status'} eq 'active' ) {
2266 push @where, FS::cust_pkg->active_sql();
2268 } elsif ( $params->{'magic'} eq 'not yet billed'
2269 || $params->{'status'} eq 'not yet billed' ) {
2271 push @where, FS::cust_pkg->not_yet_billed_sql();
2273 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2274 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2276 push @where, FS::cust_pkg->inactive_sql();
2278 } elsif ( $params->{'magic'} eq 'suspended'
2279 || $params->{'status'} eq 'suspended' ) {
2281 push @where, FS::cust_pkg->suspended_sql();
2283 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2284 || $params->{'status'} =~ /^cancell?ed$/ ) {
2286 push @where, FS::cust_pkg->cancelled_sql();
2291 # parse package class
2294 #false lazinessish w/graph/cust_bill_pkg.cgi
2297 if ( exists($params->{'classnum'})
2298 && $params->{'classnum'} =~ /^(\d*)$/
2302 if ( $classnum ) { #a specific class
2303 push @where, "classnum = $classnum";
2305 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2306 #die "classnum $classnum not found!" unless $pkg_class[0];
2307 #$title .= $pkg_class[0]->classname.' ';
2309 } elsif ( $classnum eq '' ) { #the empty class
2311 push @where, "classnum IS NULL";
2312 #$title .= 'Empty class ';
2313 #@pkg_class = ( '(empty class)' );
2314 } elsif ( $classnum eq '0' ) {
2315 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2316 #push @pkg_class, '(empty class)';
2318 die "illegal classnum";
2327 my $pkgpart = join (' OR pkgpart=',
2328 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2329 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2337 #false laziness w/report_cust_pkg.html
2340 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2341 'active' => { 'susp'=>1, 'cancel'=>1 },
2342 'suspended' => { 'cancel' => 1 },
2347 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2349 next unless exists($params->{$field});
2351 my($beginning, $ending) = @{$params->{$field}};
2353 next if $beginning == 0 && $ending == 4294967295;
2356 "cust_pkg.$field IS NOT NULL",
2357 "cust_pkg.$field >= $beginning",
2358 "cust_pkg.$field <= $ending";
2360 $orderby ||= "ORDER BY cust_pkg.$field";
2364 $orderby ||= 'ORDER BY bill';
2367 # parse magic, legacy, etc.
2370 if ( $params->{'magic'} &&
2371 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2374 $orderby = 'ORDER BY pkgnum';
2376 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2377 push @where, "pkgpart = $1";
2380 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2382 $orderby = 'ORDER BY pkgnum';
2384 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2386 $orderby = 'ORDER BY pkgnum';
2389 SELECT count(*) FROM pkg_svc
2390 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2391 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2392 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2393 AND cust_svc.svcpart = pkg_svc.svcpart
2400 # setup queries, links, subs, etc. for the search
2403 # here is the agent virtualization
2404 if ($params->{CurrentUser}) {
2406 qsearchs('access_user', { username => $params->{CurrentUser} });
2409 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2414 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2417 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2419 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2420 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2421 'LEFT JOIN pkg_class USING ( classnum ) ';
2423 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2426 'table' => 'cust_pkg',
2428 'select' => join(', ',
2430 ( map "part_pkg.$_", qw( pkg freq ) ),
2431 'pkg_class.classname',
2432 'cust_main.custnum as cust_main_custnum',
2433 FS::UI::Web::cust_sql_fields(
2434 $params->{'cust_fields'}
2437 'extra_sql' => "$extra_sql $orderby",
2438 'addl_from' => $addl_from,
2439 'count_query' => $count_query,
2446 Returns a list: the first item is an SQL fragment identifying matching
2447 packages/customers via location (taking into account shipping and package
2448 address taxation, if enabled), and subsequent items are the parameters to
2449 substitute for the placeholders in that fragment.
2454 my($class, %opt) = @_;
2455 my $ornull = $opt{'ornull'};
2457 my $conf = new FS::Conf;
2459 # '?' placeholders in _location_sql_where
2462 @bill_param = qw( county county state state state country );
2464 @bill_param = qw( county state state country );
2466 unshift @bill_param, 'county'; # unless $nec;
2470 if ( $conf->exists('tax-ship_address') ) {
2473 ( ( ship_last IS NULL OR ship_last = '' )
2474 AND ". _location_sql_where('cust_main', '', $ornull ). "
2476 OR ( ship_last IS NOT NULL AND ship_last != ''
2477 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2480 # AND payby != 'COMP'
2482 @main_param = ( @bill_param, @bill_param );
2486 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2487 @main_param = @bill_param;
2493 if ( $conf->exists('tax-pkg_address') ) {
2495 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2498 ( cust_pkg.locationnum IS NULL AND $main_where )
2499 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2502 @param = ( @main_param, @bill_param );
2506 $where = $main_where;
2507 @param = @main_param;
2515 #subroutine, helper for location_sql
2516 sub _location_sql_where {
2518 my $prefix = @_ ? shift : '';
2519 my $ornull = @_ ? shift : '';
2521 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2523 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2525 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2526 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2529 ( $table.${prefix}county = ? $or_empty_county $ornull )
2530 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2531 AND $table.${prefix}country = ?
2539 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2541 CUSTNUM is a customer (see L<FS::cust_main>)
2543 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2544 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2547 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2548 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2549 new billing items. An error is returned if this is not possible (see
2550 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2553 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2554 newly-created cust_pkg objects.
2556 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2557 and inserted. Multiple FS::pkg_referral records can be created by
2558 setting I<refnum> to an array reference of refnums or a hash reference with
2559 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2560 record will be created corresponding to cust_main.refnum.
2565 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2567 my $conf = new FS::Conf;
2569 # Transactionize this whole mess
2570 local $SIG{HUP} = 'IGNORE';
2571 local $SIG{INT} = 'IGNORE';
2572 local $SIG{QUIT} = 'IGNORE';
2573 local $SIG{TERM} = 'IGNORE';
2574 local $SIG{TSTP} = 'IGNORE';
2575 local $SIG{PIPE} = 'IGNORE';
2577 my $oldAutoCommit = $FS::UID::AutoCommit;
2578 local $FS::UID::AutoCommit = 0;
2582 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2583 # return "Customer not found: $custnum" unless $cust_main;
2585 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2588 my $change = scalar(@old_cust_pkg) != 0;
2591 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2593 my $err_or_cust_pkg =
2594 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2595 'refnum' => $refnum,
2598 unless (ref($err_or_cust_pkg)) {
2599 $dbh->rollback if $oldAutoCommit;
2600 return $err_or_cust_pkg;
2603 push @$return_cust_pkg, $err_or_cust_pkg;
2608 # Create the new packages.
2609 foreach my $pkgpart (@$pkgparts) {
2610 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2611 pkgpart => $pkgpart,
2615 $error = $cust_pkg->insert( 'change' => $change );
2617 $dbh->rollback if $oldAutoCommit;
2620 push @$return_cust_pkg, $cust_pkg;
2622 # $return_cust_pkg now contains refs to all of the newly
2625 # Transfer services and cancel old packages.
2626 foreach my $old_pkg (@old_cust_pkg) {
2628 foreach my $new_pkg (@$return_cust_pkg) {
2629 $error = $old_pkg->transfer($new_pkg);
2630 if ($error and $error == 0) {
2631 # $old_pkg->transfer failed.
2632 $dbh->rollback if $oldAutoCommit;
2637 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2638 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2639 foreach my $new_pkg (@$return_cust_pkg) {
2640 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2641 if ($error and $error == 0) {
2642 # $old_pkg->transfer failed.
2643 $dbh->rollback if $oldAutoCommit;
2650 # Transfers were successful, but we went through all of the
2651 # new packages and still had services left on the old package.
2652 # We can't cancel the package under the circumstances, so abort.
2653 $dbh->rollback if $oldAutoCommit;
2654 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2656 $error = $old_pkg->cancel( quiet=>1 );
2662 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2666 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2668 A bulk change method to change packages for multiple customers.
2670 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2671 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2674 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2675 replace. The services (see L<FS::cust_svc>) are moved to the
2676 new billing items. An error is returned if this is not possible (see
2679 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2680 newly-created cust_pkg objects.
2685 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2687 # Transactionize this whole mess
2688 local $SIG{HUP} = 'IGNORE';
2689 local $SIG{INT} = 'IGNORE';
2690 local $SIG{QUIT} = 'IGNORE';
2691 local $SIG{TERM} = 'IGNORE';
2692 local $SIG{TSTP} = 'IGNORE';
2693 local $SIG{PIPE} = 'IGNORE';
2695 my $oldAutoCommit = $FS::UID::AutoCommit;
2696 local $FS::UID::AutoCommit = 0;
2700 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2703 while(scalar(@old_cust_pkg)) {
2705 my $custnum = $old_cust_pkg[0]->custnum;
2706 my (@remove) = map { $_->pkgnum }
2707 grep { $_->custnum == $custnum } @old_cust_pkg;
2708 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2710 my $error = order $custnum, $pkgparts, \@remove, \@return;
2712 push @errors, $error
2714 push @$return_cust_pkg, @return;
2717 if (scalar(@errors)) {
2718 $dbh->rollback if $oldAutoCommit;
2719 return join(' / ', @errors);
2722 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2728 Associates this package with a (suspension or cancellation) reason (see
2729 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2732 Available options are:
2738 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.
2742 the access_user (see L<FS::access_user>) providing the reason
2750 the action (cancel, susp, adjourn, expire) associated with the reason
2754 If there is an error, returns the error, otherwise returns false.
2759 my ($self, %options) = @_;
2761 my $otaker = $options{reason_otaker} ||
2762 $FS::CurrentUser::CurrentUser->username;
2765 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2769 } elsif ( ref($options{'reason'}) ) {
2771 return 'Enter a new reason (or select an existing one)'
2772 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2774 my $reason = new FS::reason({
2775 'reason_type' => $options{'reason'}->{'typenum'},
2776 'reason' => $options{'reason'}->{'reason'},
2778 my $error = $reason->insert;
2779 return $error if $error;
2781 $reasonnum = $reason->reasonnum;
2784 return "Unparsable reason: ". $options{'reason'};
2787 my $cust_pkg_reason =
2788 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2789 'reasonnum' => $reasonnum,
2790 'otaker' => $otaker,
2791 'action' => substr(uc($options{'action'}),0,1),
2792 'date' => $options{'date'}
2797 $cust_pkg_reason->insert;
2800 =item set_usage USAGE_VALUE_HASHREF
2802 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2803 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2804 upbytes, downbytes, and totalbytes are appropriate keys.
2806 All svc_accts which are part of this package have their values reset.
2811 my ($self, $valueref, %opt) = @_;
2813 foreach my $cust_svc ($self->cust_svc){
2814 my $svc_x = $cust_svc->svc_x;
2815 $svc_x->set_usage($valueref, %opt)
2816 if $svc_x->can("set_usage");
2820 =item recharge USAGE_VALUE_HASHREF
2822 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2823 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2824 upbytes, downbytes, and totalbytes are appropriate keys.
2826 All svc_accts which are part of this package have their values incremented.
2831 my ($self, $valueref) = @_;
2833 foreach my $cust_svc ($self->cust_svc){
2834 my $svc_x = $cust_svc->svc_x;
2835 $svc_x->recharge($valueref)
2836 if $svc_x->can("recharge");
2844 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2846 In sub order, the @pkgparts array (passed by reference) is clobbered.
2848 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2849 method to pass dates to the recur_prog expression, it should do so.
2851 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2852 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2853 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2854 configuration values. Probably need a subroutine which decides what to do
2855 based on whether or not we've fetched the user yet, rather than a hash. See
2856 FS::UID and the TODO.
2858 Now that things are transactional should the check in the insert method be
2863 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2864 L<FS::pkg_svc>, schema.html from the base documentation