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>)
135 date (next bill date)
159 order taker (assigned automatically if null, see L<FS::UID>)
163 If this field is set to 1, disables the automatic
164 unsuspension of this package when using the B<unsuspendauto> config option.
168 If not set, defaults to 1
172 Date of change from previous package
182 =item change_locationnum
188 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
189 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
190 L<Time::Local> and L<Date::Parse> for conversion functions.
198 Create a new billing item. To add the item to the database, see L<"insert">.
202 sub table { 'cust_pkg'; }
203 sub cust_linked { $_[0]->cust_main_custnum; }
204 sub cust_unlinked_msg {
206 "WARNING: can't find cust_main.custnum ". $self->custnum.
207 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
210 =item insert [ OPTION => VALUE ... ]
212 Adds this billing item to the database ("Orders" the item). If there is an
213 error, returns the error, otherwise returns false.
215 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
216 will be used to look up the package definition and agent restrictions will be
219 If the additional field I<refnum> is defined, an FS::pkg_referral record will
220 be created and inserted. Multiple FS::pkg_referral records can be created by
221 setting I<refnum> to an array reference of refnums or a hash reference with
222 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
223 record will be created corresponding to cust_main.refnum.
225 The following options are available:
231 If set true, supresses any referral credit to a referring customer.
235 cust_pkg_option records will be created
239 a ticket will be added to this customer with this subject
243 an optional queue name for ticket additions
250 my( $self, %options ) = @_;
252 local $SIG{HUP} = 'IGNORE';
253 local $SIG{INT} = 'IGNORE';
254 local $SIG{QUIT} = 'IGNORE';
255 local $SIG{TERM} = 'IGNORE';
256 local $SIG{TSTP} = 'IGNORE';
257 local $SIG{PIPE} = 'IGNORE';
259 my $oldAutoCommit = $FS::UID::AutoCommit;
260 local $FS::UID::AutoCommit = 0;
263 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
265 $dbh->rollback if $oldAutoCommit;
269 $self->refnum($self->cust_main->refnum) unless $self->refnum;
270 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
271 $self->process_m2m( 'link_table' => 'pkg_referral',
272 'target_table' => 'part_referral',
273 'params' => $self->refnum,
276 #if ( $self->reg_code ) {
277 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
278 # $error = $reg_code->delete;
280 # $dbh->rollback if $oldAutoCommit;
285 my $conf = new FS::Conf;
287 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
289 use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
296 my $q = new RT::Queue($RT::SystemUser);
297 $q->Load($options{ticket_queue}) if $options{ticket_queue};
298 my $t = new RT::Ticket($RT::SystemUser);
299 my $mime = new MIME::Entity;
300 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
301 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
302 Subject => $options{ticket_subject},
305 $t->AddLink( Type => 'MemberOf',
306 Target => 'freeside://freeside/cust_main/'. $self->custnum,
310 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
311 my $queue = new FS::queue {
312 'job' => 'FS::cust_main::queueable_print',
314 $error = $queue->insert(
315 'custnum' => $self->custnum,
316 'template' => 'welcome_letter',
320 warn "can't send welcome letter: $error";
325 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
332 This method now works but you probably shouldn't use it.
334 You don't want to delete billing items, because there would then be no record
335 the customer ever purchased the item. Instead, see the cancel method.
340 # return "Can't delete cust_pkg records!";
343 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
345 Replaces the OLD_RECORD with this one in the database. If there is an error,
346 returns the error, otherwise returns false.
348 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
350 Changing pkgpart may have disasterous effects. See the order subroutine.
352 setup and bill are normally updated by calling the bill method of a customer
353 object (see L<FS::cust_main>).
355 suspend is normally updated by the suspend and unsuspend methods.
357 cancel is normally updated by the cancel method (and also the order subroutine
360 Available options are:
366 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.
370 the access_user (see L<FS::access_user>) providing the reason
374 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
383 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
388 ( ref($_[0]) eq 'HASH' )
392 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
393 return "Can't change otaker!" if $old->otaker ne $new->otaker;
396 #return "Can't change setup once it exists!"
397 # if $old->getfield('setup') &&
398 # $old->getfield('setup') != $new->getfield('setup');
400 #some logic for bill, susp, cancel?
402 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
404 local $SIG{HUP} = 'IGNORE';
405 local $SIG{INT} = 'IGNORE';
406 local $SIG{QUIT} = 'IGNORE';
407 local $SIG{TERM} = 'IGNORE';
408 local $SIG{TSTP} = 'IGNORE';
409 local $SIG{PIPE} = 'IGNORE';
411 my $oldAutoCommit = $FS::UID::AutoCommit;
412 local $FS::UID::AutoCommit = 0;
415 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
416 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
417 my $error = $new->insert_reason(
418 'reason' => $options->{'reason'},
419 'date' => $new->$method,
421 'reason_otaker' => $options->{'reason_otaker'},
424 dbh->rollback if $oldAutoCommit;
425 return "Error inserting cust_pkg_reason: $error";
430 #save off and freeze RADIUS attributes for any associated svc_acct records
432 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
434 #also check for specific exports?
435 # to avoid spurious modify export events
436 @svc_acct = map { $_->svc_x }
437 grep { $_->part_svc->svcdb eq 'svc_acct' }
440 $_->snapshot foreach @svc_acct;
444 my $error = $new->SUPER::replace($old,
445 $options->{options} ? $options->{options} : ()
448 $dbh->rollback if $oldAutoCommit;
452 #for prepaid packages,
453 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
454 foreach my $old_svc_acct ( @svc_acct ) {
455 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
456 my $s_error = $new_svc_acct->replace($old_svc_acct);
458 $dbh->rollback if $oldAutoCommit;
463 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
470 Checks all fields to make sure this is a valid billing item. If there is an
471 error, returns the error, otherwise returns false. Called by the insert and
479 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
482 $self->ut_numbern('pkgnum')
483 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
484 || $self->ut_numbern('pkgpart')
485 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
486 || $self->ut_numbern('start_date')
487 || $self->ut_numbern('setup')
488 || $self->ut_numbern('bill')
489 || $self->ut_numbern('susp')
490 || $self->ut_numbern('cancel')
491 || $self->ut_numbern('adjourn')
492 || $self->ut_numbern('expire')
494 return $error if $error;
496 if ( $self->reg_code ) {
498 unless ( grep { $self->pkgpart == $_->pkgpart }
499 map { $_->reg_code_pkg }
500 qsearchs( 'reg_code', { 'code' => $self->reg_code,
501 'agentnum' => $self->cust_main->agentnum })
503 return "Unknown registration code";
506 } elsif ( $self->promo_code ) {
509 qsearchs('part_pkg', {
510 'pkgpart' => $self->pkgpart,
511 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
513 return 'Unknown promotional code' unless $promo_part_pkg;
517 unless ( $disable_agentcheck ) {
519 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
520 return "agent ". $agent->agentnum. ':'. $agent->agent.
521 " can't purchase pkgpart ". $self->pkgpart
522 unless $agent->pkgpart_hashref->{ $self->pkgpart }
523 || $agent->agentnum == $self->part_pkg->agentnum;
526 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
527 return $error if $error;
531 $self->otaker(getotaker) unless $self->otaker;
532 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
535 if ( $self->dbdef_table->column('manual_flag') ) {
536 $self->manual_flag('') if $self->manual_flag eq ' ';
537 $self->manual_flag =~ /^([01]?)$/
538 or return "Illegal manual_flag ". $self->manual_flag;
539 $self->manual_flag($1);
545 =item cancel [ OPTION => VALUE ... ]
547 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
548 in this package, then cancels the package itself (sets the cancel field to
551 Available options are:
555 =item quiet - can be set true to supress email cancellation notices.
557 =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.
559 =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.
561 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
565 If there is an error, returns the error, otherwise returns false.
570 my( $self, %options ) = @_;
573 warn "cust_pkg::cancel called with options".
574 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
577 local $SIG{HUP} = 'IGNORE';
578 local $SIG{INT} = 'IGNORE';
579 local $SIG{QUIT} = 'IGNORE';
580 local $SIG{TERM} = 'IGNORE';
581 local $SIG{TSTP} = 'IGNORE';
582 local $SIG{PIPE} = 'IGNORE';
584 my $oldAutoCommit = $FS::UID::AutoCommit;
585 local $FS::UID::AutoCommit = 0;
588 my $old = $self->select_for_update;
590 if ( $old->get('cancel') || $self->get('cancel') ) {
591 dbh->rollback if $oldAutoCommit;
592 return ""; # no error
595 my $date = $options{date} if $options{date}; # expire/cancel later
596 $date = '' if ($date && $date <= time); # complain instead?
598 my $cancel_time = $options{'time'} || time;
600 if ( $options{'reason'} ) {
601 $error = $self->insert_reason( 'reason' => $options{'reason'},
602 'action' => $date ? 'expire' : 'cancel',
603 'date' => $date ? $date : $cancel_time,
604 'reason_otaker' => $options{'reason_otaker'},
607 dbh->rollback if $oldAutoCommit;
608 return "Error inserting cust_pkg_reason: $error";
614 foreach my $cust_svc (
617 sort { $a->[1] <=> $b->[1] }
618 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
619 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
622 my $error = $cust_svc->cancel;
625 $dbh->rollback if $oldAutoCommit;
626 return "Error cancelling cust_svc: $error";
630 # Add a credit for remaining service
631 my $remaining_value = $self->calc_remain(time=>$cancel_time);
632 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
633 my $conf = new FS::Conf;
634 my $error = $self->cust_main->credit(
636 'Credit for unused time on '. $self->part_pkg->pkg,
637 'reason_type' => $conf->config('cancel_credit_type'),
640 $dbh->rollback if $oldAutoCommit;
641 return "Error crediting customer \$$remaining_value for unused time on".
642 $self->part_pkg->pkg. ": $error";
647 my %hash = $self->hash;
648 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
649 my $new = new FS::cust_pkg ( \%hash );
650 $error = $new->replace( $self, options => { $self->options } );
652 $dbh->rollback if $oldAutoCommit;
656 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
657 return '' if $date; #no errors
659 my $conf = new FS::Conf;
660 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
661 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
662 my $conf = new FS::Conf;
663 my $error = send_email(
664 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
665 'to' => \@invoicing_list,
666 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
667 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
669 #should this do something on errors?
676 =item cancel_if_expired [ NOW_TIMESTAMP ]
678 Cancels this package if its expire date has been reached.
682 sub cancel_if_expired {
684 my $time = shift || time;
685 return '' unless $self->expire && $self->expire <= $time;
686 my $error = $self->cancel;
688 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
689 $self->custnum. ": $error";
696 Cancels any pending expiration (sets the expire field to null).
698 If there is an error, returns the error, otherwise returns false.
703 my( $self, %options ) = @_;
706 local $SIG{HUP} = 'IGNORE';
707 local $SIG{INT} = 'IGNORE';
708 local $SIG{QUIT} = 'IGNORE';
709 local $SIG{TERM} = 'IGNORE';
710 local $SIG{TSTP} = 'IGNORE';
711 local $SIG{PIPE} = 'IGNORE';
713 my $oldAutoCommit = $FS::UID::AutoCommit;
714 local $FS::UID::AutoCommit = 0;
717 my $old = $self->select_for_update;
719 my $pkgnum = $old->pkgnum;
720 if ( $old->get('cancel') || $self->get('cancel') ) {
721 dbh->rollback if $oldAutoCommit;
722 return "Can't unexpire cancelled package $pkgnum";
723 # or at least it's pointless
726 unless ( $old->get('expire') && $self->get('expire') ) {
727 dbh->rollback if $oldAutoCommit;
728 return ""; # no error
731 my %hash = $self->hash;
732 $hash{'expire'} = '';
733 my $new = new FS::cust_pkg ( \%hash );
734 $error = $new->replace( $self, options => { $self->options } );
736 $dbh->rollback if $oldAutoCommit;
740 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
746 =item suspend [ OPTION => VALUE ... ]
748 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
749 package, then suspends the package itself (sets the susp field to now).
751 Available options are:
755 =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.
757 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
761 If there is an error, returns the error, otherwise returns false.
766 my( $self, %options ) = @_;
769 local $SIG{HUP} = 'IGNORE';
770 local $SIG{INT} = 'IGNORE';
771 local $SIG{QUIT} = 'IGNORE';
772 local $SIG{TERM} = 'IGNORE';
773 local $SIG{TSTP} = 'IGNORE';
774 local $SIG{PIPE} = 'IGNORE';
776 my $oldAutoCommit = $FS::UID::AutoCommit;
777 local $FS::UID::AutoCommit = 0;
780 my $old = $self->select_for_update;
782 my $pkgnum = $old->pkgnum;
783 if ( $old->get('cancel') || $self->get('cancel') ) {
784 dbh->rollback if $oldAutoCommit;
785 return "Can't suspend cancelled package $pkgnum";
788 if ( $old->get('susp') || $self->get('susp') ) {
789 dbh->rollback if $oldAutoCommit;
790 return ""; # no error # complain on adjourn?
793 my $date = $options{date} if $options{date}; # adjourn/suspend later
794 $date = '' if ($date && $date <= time); # complain instead?
796 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
797 dbh->rollback if $oldAutoCommit;
798 return "Package $pkgnum expires before it would be suspended.";
801 my $suspend_time = $options{'time'} || time;
803 if ( $options{'reason'} ) {
804 $error = $self->insert_reason( 'reason' => $options{'reason'},
805 'action' => $date ? 'adjourn' : 'suspend',
806 'date' => $date ? $date : $suspend_time,
807 'reason_otaker' => $options{'reason_otaker'},
810 dbh->rollback if $oldAutoCommit;
811 return "Error inserting cust_pkg_reason: $error";
819 foreach my $cust_svc (
820 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
822 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
824 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
825 $dbh->rollback if $oldAutoCommit;
826 return "Illegal svcdb value in part_svc!";
829 require "FS/$svcdb.pm";
831 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
833 $error = $svc->suspend;
835 $dbh->rollback if $oldAutoCommit;
838 my( $label, $value ) = $cust_svc->label;
839 push @labels, "$label: $value";
843 my $conf = new FS::Conf;
844 if ( $conf->config('suspend_email_admin') ) {
846 my $error = send_email(
847 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
848 #invoice_from ??? well as good as any
849 'to' => $conf->config('suspend_email_admin'),
850 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
852 "This is an automatic message from your Freeside installation\n",
853 "informing you that the following customer package has been suspended:\n",
855 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
856 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
857 ( map { "Service : $_\n" } @labels ),
862 warn "WARNING: can't send suspension admin email (suspending anyway): ".
870 my %hash = $self->hash;
872 $hash{'adjourn'} = $date;
874 $hash{'susp'} = $suspend_time;
876 my $new = new FS::cust_pkg ( \%hash );
877 $error = $new->replace( $self, options => { $self->options } );
879 $dbh->rollback if $oldAutoCommit;
883 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
888 =item unsuspend [ OPTION => VALUE ... ]
890 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
891 package, then unsuspends the package itself (clears the susp field and the
892 adjourn field if it is in the past).
894 Available options are:
898 =item adjust_next_bill
900 Can be set true to adjust the next bill date forward by
901 the amount of time the account was inactive. This was set true by default
902 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
903 explicitly requested. Price plans for which this makes sense (anniversary-date
904 based than prorate or subscription) could have an option to enable this
909 If there is an error, returns the error, otherwise returns false.
914 my( $self, %opt ) = @_;
917 local $SIG{HUP} = 'IGNORE';
918 local $SIG{INT} = 'IGNORE';
919 local $SIG{QUIT} = 'IGNORE';
920 local $SIG{TERM} = 'IGNORE';
921 local $SIG{TSTP} = 'IGNORE';
922 local $SIG{PIPE} = 'IGNORE';
924 my $oldAutoCommit = $FS::UID::AutoCommit;
925 local $FS::UID::AutoCommit = 0;
928 my $old = $self->select_for_update;
930 my $pkgnum = $old->pkgnum;
931 if ( $old->get('cancel') || $self->get('cancel') ) {
932 dbh->rollback if $oldAutoCommit;
933 return "Can't unsuspend cancelled package $pkgnum";
936 unless ( $old->get('susp') && $self->get('susp') ) {
937 dbh->rollback if $oldAutoCommit;
938 return ""; # no error # complain instead?
941 foreach my $cust_svc (
942 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
944 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
946 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
947 $dbh->rollback if $oldAutoCommit;
948 return "Illegal svcdb value in part_svc!";
951 require "FS/$svcdb.pm";
953 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
955 $error = $svc->unsuspend;
957 $dbh->rollback if $oldAutoCommit;
964 my %hash = $self->hash;
965 my $inactive = time - $hash{'susp'};
967 my $conf = new FS::Conf;
969 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
970 if ( $opt{'adjust_next_bill'}
971 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
972 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
975 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
976 my $new = new FS::cust_pkg ( \%hash );
977 $error = $new->replace( $self, options => { $self->options } );
979 $dbh->rollback if $oldAutoCommit;
983 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
990 Cancels any pending suspension (sets the adjourn field to null).
992 If there is an error, returns the error, otherwise returns false.
997 my( $self, %options ) = @_;
1000 local $SIG{HUP} = 'IGNORE';
1001 local $SIG{INT} = 'IGNORE';
1002 local $SIG{QUIT} = 'IGNORE';
1003 local $SIG{TERM} = 'IGNORE';
1004 local $SIG{TSTP} = 'IGNORE';
1005 local $SIG{PIPE} = 'IGNORE';
1007 my $oldAutoCommit = $FS::UID::AutoCommit;
1008 local $FS::UID::AutoCommit = 0;
1011 my $old = $self->select_for_update;
1013 my $pkgnum = $old->pkgnum;
1014 if ( $old->get('cancel') || $self->get('cancel') ) {
1015 dbh->rollback if $oldAutoCommit;
1016 return "Can't unadjourn cancelled package $pkgnum";
1017 # or at least it's pointless
1020 if ( $old->get('susp') || $self->get('susp') ) {
1021 dbh->rollback if $oldAutoCommit;
1022 return "Can't unadjourn suspended package $pkgnum";
1023 # perhaps this is arbitrary
1026 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1027 dbh->rollback if $oldAutoCommit;
1028 return ""; # no error
1031 my %hash = $self->hash;
1032 $hash{'adjourn'} = '';
1033 my $new = new FS::cust_pkg ( \%hash );
1034 $error = $new->replace( $self, options => { $self->options } );
1036 $dbh->rollback if $oldAutoCommit;
1040 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1047 =item change HASHREF | OPTION => VALUE ...
1049 Changes this package: cancels it and creates a new one, with a different
1050 pkgpart or locationnum or both. All services are transferred to the new
1051 package (no change will be made if this is not possible).
1053 Options may be passed as a list of key/value pairs or as a hash reference.
1060 New locationnum, to change the location for this package.
1064 New FS::cust_location object, to create a new location and assign it
1069 New pkgpart (see L<FS::part_pkg>).
1073 New refnum (see L<FS::part_referral>).
1077 At least one option must be specified (otherwise, what's the point?)
1079 Returns either the new FS::cust_pkg object or a scalar error.
1083 my $err_or_new_cust_pkg = $old_cust_pkg->change
1087 #some false laziness w/order
1090 my $opt = ref($_[0]) ? shift : { @_ };
1092 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1095 my $conf = new FS::Conf;
1097 # Transactionize this whole mess
1098 local $SIG{HUP} = 'IGNORE';
1099 local $SIG{INT} = 'IGNORE';
1100 local $SIG{QUIT} = 'IGNORE';
1101 local $SIG{TERM} = 'IGNORE';
1102 local $SIG{TSTP} = 'IGNORE';
1103 local $SIG{PIPE} = 'IGNORE';
1105 my $oldAutoCommit = $FS::UID::AutoCommit;
1106 local $FS::UID::AutoCommit = 0;
1115 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1117 #$hash{$_} = $self->$_() foreach qw( setup );
1119 $hash{'setup'} = $time if $self->setup;
1121 $hash{'change_date'} = $time;
1122 $hash{"change_$_"} = $self->$_()
1123 foreach qw( pkgnum pkgpart locationnum );
1125 if ( $opt->{'cust_location'} &&
1126 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1127 $error = $opt->{'cust_location'}->insert;
1129 $dbh->rollback if $oldAutoCommit;
1130 return "inserting cust_location (transaction rolled back): $error";
1132 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1135 # Create the new package.
1136 my $cust_pkg = new FS::cust_pkg {
1137 custnum => $self->custnum,
1138 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1139 refnum => ( $opt->{'refnum'} || $self->refnum ),
1140 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1144 $error = $cust_pkg->insert( 'change' => 1 );
1146 $dbh->rollback if $oldAutoCommit;
1150 # Transfer services and cancel old package.
1152 $error = $self->transfer($cust_pkg);
1153 if ($error and $error == 0) {
1154 # $old_pkg->transfer failed.
1155 $dbh->rollback if $oldAutoCommit;
1159 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1160 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1161 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1162 if ($error and $error == 0) {
1163 # $old_pkg->transfer failed.
1164 $dbh->rollback if $oldAutoCommit;
1170 # Transfers were successful, but we still had services left on the old
1171 # package. We can't change the package under this circumstances, so abort.
1172 $dbh->rollback if $oldAutoCommit;
1173 return "Unable to transfer all services from package ". $self->pkgnum;
1176 #reset usage if changing pkgpart
1177 if ($self->pkgpart != $cust_pkg->pkgpart) {
1178 my $part_pkg = $cust_pkg->part_pkg;
1179 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1183 if $part_pkg->can('reset_usage');
1186 $dbh->rollback if $oldAutoCommit;
1187 return "Error setting usage values: $error";
1191 #Good to go, cancel old package.
1192 $error = $self->cancel( quiet=>1 );
1198 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1205 Returns the last bill date, or if there is no last bill date, the setup date.
1206 Useful for billing metered services.
1212 return $self->setfield('last_bill', $_[0]) if @_;
1213 return $self->getfield('last_bill') if $self->getfield('last_bill');
1214 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1215 'edate' => $self->bill, } );
1216 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1219 =item last_cust_pkg_reason ACTION
1221 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1222 Returns false if there is no reason or the package is not currenly ACTION'd
1223 ACTION is one of adjourn, susp, cancel, or expire.
1227 sub last_cust_pkg_reason {
1228 my ( $self, $action ) = ( shift, shift );
1229 my $date = $self->get($action);
1231 'table' => 'cust_pkg_reason',
1232 'hashref' => { 'pkgnum' => $self->pkgnum,
1233 'action' => substr(uc($action), 0, 1),
1236 'order_by' => 'ORDER BY num DESC LIMIT 1',
1240 =item last_reason ACTION
1242 Returns the most recent ACTION FS::reason associated with the package.
1243 Returns false if there is no reason or the package is not currenly ACTION'd
1244 ACTION is one of adjourn, susp, cancel, or expire.
1249 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1250 $cust_pkg_reason->reason
1251 if $cust_pkg_reason;
1256 Returns the definition for this billing item, as an FS::part_pkg object (see
1263 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1264 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1265 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1270 Returns the cancelled package this package was changed from, if any.
1276 return '' unless $self->change_pkgnum;
1277 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1282 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1289 $self->part_pkg->calc_setup($self, @_);
1294 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1301 $self->part_pkg->calc_recur($self, @_);
1306 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1313 $self->part_pkg->calc_remain($self, @_);
1318 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1325 $self->part_pkg->calc_cancel($self, @_);
1330 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1336 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1339 =item cust_pkg_detail [ DETAILTYPE ]
1341 Returns any customer package details for this package (see
1342 L<FS::cust_pkg_detail>).
1344 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1348 sub cust_pkg_detail {
1350 my %hash = ( 'pkgnum' => $self->pkgnum );
1351 $hash{detailtype} = shift if @_;
1353 'table' => 'cust_pkg_detail',
1354 'hashref' => \%hash,
1355 'order_by' => 'ORDER BY weight, pkgdetailnum',
1359 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1361 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1363 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1365 If there is an error, returns the error, otherwise returns false.
1369 sub set_cust_pkg_detail {
1370 my( $self, $detailtype, @details ) = @_;
1372 local $SIG{HUP} = 'IGNORE';
1373 local $SIG{INT} = 'IGNORE';
1374 local $SIG{QUIT} = 'IGNORE';
1375 local $SIG{TERM} = 'IGNORE';
1376 local $SIG{TSTP} = 'IGNORE';
1377 local $SIG{PIPE} = 'IGNORE';
1379 my $oldAutoCommit = $FS::UID::AutoCommit;
1380 local $FS::UID::AutoCommit = 0;
1383 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1384 my $error = $current->delete;
1386 $dbh->rollback if $oldAutoCommit;
1387 return "error removing old detail: $error";
1391 foreach my $detail ( @details ) {
1392 my $cust_pkg_detail = new FS::cust_pkg_detail {
1393 'pkgnum' => $self->pkgnum,
1394 'detailtype' => $detailtype,
1395 'detail' => $detail,
1397 my $error = $cust_pkg_detail->insert;
1399 $dbh->rollback if $oldAutoCommit;
1400 return "error adding new detail: $error";
1405 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1412 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1416 #false laziness w/cust_bill.pm
1420 'table' => 'cust_event',
1421 'addl_from' => 'JOIN part_event USING ( eventpart )',
1422 'hashref' => { 'tablenum' => $self->pkgnum },
1423 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1427 =item num_cust_event
1429 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1433 #false laziness w/cust_bill.pm
1434 sub num_cust_event {
1437 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1438 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1439 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1440 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1441 $sth->fetchrow_arrayref->[0];
1444 =item cust_svc [ SVCPART ]
1446 Returns the services for this package, as FS::cust_svc objects (see
1447 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1455 return () unless $self->num_cust_svc(@_);
1458 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1459 'svcpart' => shift, } );
1462 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1464 #if ( $self->{'_svcnum'} ) {
1465 # values %{ $self->{'_svcnum'}->cache };
1467 $self->_sort_cust_svc(
1468 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1474 =item overlimit [ SVCPART ]
1476 Returns the services for this package which have exceeded their
1477 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1478 is specified, return only the matching services.
1484 return () unless $self->num_cust_svc(@_);
1485 grep { $_->overlimit } $self->cust_svc(@_);
1488 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1490 Returns historical services for this package created before END TIMESTAMP and
1491 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1492 (see L<FS::h_cust_svc>).
1499 $self->_sort_cust_svc(
1500 [ qsearch( 'h_cust_svc',
1501 { 'pkgnum' => $self->pkgnum, },
1502 FS::h_cust_svc->sql_h_search(@_),
1508 sub _sort_cust_svc {
1509 my( $self, $arrayref ) = @_;
1512 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1514 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1515 'svcpart' => $_->svcpart } );
1517 $pkg_svc ? $pkg_svc->primary_svc : '',
1518 $pkg_svc ? $pkg_svc->quantity : 0,
1525 =item num_cust_svc [ SVCPART ]
1527 Returns the number of provisioned services for this package. If a svcpart is
1528 specified, counts only the matching services.
1535 return $self->{'_num_cust_svc'}
1537 && exists($self->{'_num_cust_svc'})
1538 && $self->{'_num_cust_svc'} =~ /\d/;
1540 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1543 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1544 $sql .= ' AND svcpart = ?' if @_;
1546 my $sth = dbh->prepare($sql) or die dbh->errstr;
1547 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1548 $sth->fetchrow_arrayref->[0];
1551 =item available_part_svc
1553 Returns a list of FS::part_svc objects representing services included in this
1554 package but not yet provisioned. Each FS::part_svc object also has an extra
1555 field, I<num_avail>, which specifies the number of available services.
1559 sub available_part_svc {
1561 grep { $_->num_avail > 0 }
1563 my $part_svc = $_->part_svc;
1564 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1565 $_->quantity - $self->num_cust_svc($_->svcpart);
1568 $self->part_pkg->pkg_svc;
1573 Returns a list of FS::part_svc objects representing provisioned and available
1574 services included in this package. Each FS::part_svc object also has the
1575 following extra fields:
1579 =item num_cust_svc (count)
1581 =item num_avail (quantity - count)
1583 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1586 label -> ($cust_svc->label)[1]
1595 #XXX some sort of sort order besides numeric by svcpart...
1596 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1598 my $part_svc = $pkg_svc->part_svc;
1599 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1600 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1601 $part_svc->{'Hash'}{'num_avail'} =
1602 max( 0, $pkg_svc->quantity - $num_cust_svc );
1603 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1604 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1606 } $self->part_pkg->pkg_svc;
1609 push @part_svc, map {
1611 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1612 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1613 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1614 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1615 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1617 } $self->extra_part_svc;
1623 =item extra_part_svc
1625 Returns a list of FS::part_svc objects corresponding to services in this
1626 package which are still provisioned but not (any longer) available in the
1631 sub extra_part_svc {
1634 my $pkgnum = $self->pkgnum;
1635 my $pkgpart = $self->pkgpart;
1638 # 'table' => 'part_svc',
1641 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1642 # WHERE pkg_svc.svcpart = part_svc.svcpart
1643 # AND pkg_svc.pkgpart = ?
1646 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1647 # LEFT JOIN cust_pkg USING ( pkgnum )
1648 # WHERE cust_svc.svcpart = part_svc.svcpart
1651 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1654 #seems to benchmark slightly faster...
1656 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1657 'table' => 'part_svc',
1659 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1660 AND pkg_svc.pkgpart = ?
1663 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1664 LEFT JOIN cust_pkg USING ( pkgnum )
1667 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1668 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1674 Returns a short status string for this package, currently:
1678 =item not yet billed
1680 =item one-time charge
1695 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1697 return 'cancelled' if $self->get('cancel');
1698 return 'suspended' if $self->susp;
1699 return 'not yet billed' unless $self->setup;
1700 return 'one-time charge' if $freq =~ /^(0|$)/;
1706 Class method that returns the list of possible status strings for packages
1707 (see L<the status method|/status>). For example:
1709 @statuses = FS::cust_pkg->statuses();
1713 tie my %statuscolor, 'Tie::IxHash',
1714 'not yet billed' => '000000',
1715 'one-time charge' => '000000',
1716 'active' => '00CC00',
1717 'suspended' => 'FF9900',
1718 'cancelled' => 'FF0000',
1722 my $self = shift; #could be class...
1723 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1724 # # mayble split btw one-time vs. recur
1730 Returns a hex triplet color string for this package's status.
1736 $statuscolor{$self->status};
1741 Returns a list of lists, calling the label method for all services
1742 (see L<FS::cust_svc>) of this billing item.
1748 map { [ $_->label ] } $self->cust_svc;
1751 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1753 Like the labels method, but returns historical information on services that
1754 were active as of END_TIMESTAMP and (optionally) not cancelled before
1757 Returns a list of lists, calling the label method for all (historical) services
1758 (see L<FS::h_cust_svc>) of this billing item.
1764 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1767 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1769 Like h_labels, except returns a simple flat list, and shortens long
1770 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1771 identical services to one line that lists the service label and the number of
1772 individual services rather than individual items.
1776 sub h_labels_short {
1779 my $conf = new FS::Conf;
1780 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1783 #tie %labels, 'Tie::IxHash';
1784 push @{ $labels{$_->[0]} }, $_->[1]
1785 foreach $self->h_labels(@_);
1787 foreach my $label ( keys %labels ) {
1789 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1790 my $num = scalar(@values);
1791 if ( $num > $max_same_services ) {
1792 push @labels, "$label ($num)";
1794 push @labels, map { "$label: $_" } @values;
1804 Returns the parent customer object (see L<FS::cust_main>).
1810 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1815 Returns the location object, if any (see L<FS::cust_location>).
1821 return '' unless $self->locationnum;
1822 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1825 =item cust_location_or_main
1827 If this package is associated with a location, returns the locaiton (see
1828 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1832 sub cust_location_or_main {
1834 $self->cust_location || $self->cust_main;
1837 =item seconds_since TIMESTAMP
1839 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1840 package have been online since TIMESTAMP, according to the session monitor.
1842 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1843 L<Time::Local> and L<Date::Parse> for conversion functions.
1848 my($self, $since) = @_;
1851 foreach my $cust_svc (
1852 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1854 $seconds += $cust_svc->seconds_since($since);
1861 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1863 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1864 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1867 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1868 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1874 sub seconds_since_sqlradacct {
1875 my($self, $start, $end) = @_;
1879 foreach my $cust_svc (
1881 my $part_svc = $_->part_svc;
1882 $part_svc->svcdb eq 'svc_acct'
1883 && scalar($part_svc->part_export('sqlradius'));
1886 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1893 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1895 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1896 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1900 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1901 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1906 sub attribute_since_sqlradacct {
1907 my($self, $start, $end, $attrib) = @_;
1911 foreach my $cust_svc (
1913 my $part_svc = $_->part_svc;
1914 $part_svc->svcdb eq 'svc_acct'
1915 && scalar($part_svc->part_export('sqlradius'));
1918 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1930 my( $self, $value ) = @_;
1931 if ( defined($value) ) {
1932 $self->setfield('quantity', $value);
1934 $self->getfield('quantity') || 1;
1937 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1939 Transfers as many services as possible from this package to another package.
1941 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1942 object. The destination package must already exist.
1944 Services are moved only if the destination allows services with the correct
1945 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1946 this option with caution! No provision is made for export differences
1947 between the old and new service definitions. Probably only should be used
1948 when your exports for all service definitions of a given svcdb are identical.
1949 (attempt a transfer without it first, to move all possible svcpart-matching
1952 Any services that can't be moved remain in the original package.
1954 Returns an error, if there is one; otherwise, returns the number of services
1955 that couldn't be moved.
1960 my ($self, $dest_pkgnum, %opt) = @_;
1966 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1967 $dest = $dest_pkgnum;
1968 $dest_pkgnum = $dest->pkgnum;
1970 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1973 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1975 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1976 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1979 foreach my $cust_svc ($dest->cust_svc) {
1980 $target{$cust_svc->svcpart}--;
1983 my %svcpart2svcparts = ();
1984 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1985 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1986 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1987 next if exists $svcpart2svcparts{$svcpart};
1988 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1989 $svcpart2svcparts{$svcpart} = [
1991 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1993 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1994 'svcpart' => $_ } );
1996 $pkg_svc ? $pkg_svc->primary_svc : '',
1997 $pkg_svc ? $pkg_svc->quantity : 0,
2001 grep { $_ != $svcpart }
2003 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2005 warn "alternates for svcpart $svcpart: ".
2006 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2011 foreach my $cust_svc ($self->cust_svc) {
2012 if($target{$cust_svc->svcpart} > 0) {
2013 $target{$cust_svc->svcpart}--;
2014 my $new = new FS::cust_svc { $cust_svc->hash };
2015 $new->pkgnum($dest_pkgnum);
2016 my $error = $new->replace($cust_svc);
2017 return $error if $error;
2018 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2020 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2021 warn "alternates to consider: ".
2022 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2024 my @alternate = grep {
2025 warn "considering alternate svcpart $_: ".
2026 "$target{$_} available in new package\n"
2029 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2031 warn "alternate(s) found\n" if $DEBUG;
2032 my $change_svcpart = $alternate[0];
2033 $target{$change_svcpart}--;
2034 my $new = new FS::cust_svc { $cust_svc->hash };
2035 $new->svcpart($change_svcpart);
2036 $new->pkgnum($dest_pkgnum);
2037 my $error = $new->replace($cust_svc);
2038 return $error if $error;
2051 This method is deprecated. See the I<depend_jobnum> option to the insert and
2052 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2059 local $SIG{HUP} = 'IGNORE';
2060 local $SIG{INT} = 'IGNORE';
2061 local $SIG{QUIT} = 'IGNORE';
2062 local $SIG{TERM} = 'IGNORE';
2063 local $SIG{TSTP} = 'IGNORE';
2064 local $SIG{PIPE} = 'IGNORE';
2066 my $oldAutoCommit = $FS::UID::AutoCommit;
2067 local $FS::UID::AutoCommit = 0;
2070 foreach my $cust_svc ( $self->cust_svc ) {
2071 #false laziness w/svc_Common::insert
2072 my $svc_x = $cust_svc->svc_x;
2073 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2074 my $error = $part_export->export_insert($svc_x);
2076 $dbh->rollback if $oldAutoCommit;
2082 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2089 =head1 CLASS METHODS
2095 Returns an SQL expression identifying recurring packages.
2099 sub recurring_sql { "
2100 '0' != ( select freq from part_pkg
2101 where cust_pkg.pkgpart = part_pkg.pkgpart )
2106 Returns an SQL expression identifying one-time packages.
2111 '0' = ( select freq from part_pkg
2112 where cust_pkg.pkgpart = part_pkg.pkgpart )
2117 Returns an SQL expression identifying active packages.
2122 ". $_[0]->recurring_sql(). "
2123 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2124 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2127 =item not_yet_billed_sql
2129 Returns an SQL expression identifying packages which have not yet been billed.
2133 sub not_yet_billed_sql { "
2134 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2135 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2136 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2141 Returns an SQL expression identifying inactive packages (one-time packages
2142 that are otherwise unsuspended/uncancelled).
2146 sub inactive_sql { "
2147 ". $_[0]->onetime_sql(). "
2148 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2149 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2150 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2156 Returns an SQL expression identifying suspended packages.
2160 sub suspended_sql { susp_sql(@_); }
2162 #$_[0]->recurring_sql(). ' AND '.
2164 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2165 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2172 Returns an SQL exprression identifying cancelled packages.
2176 sub cancelled_sql { cancel_sql(@_); }
2178 #$_[0]->recurring_sql(). ' AND '.
2179 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2182 =item search_sql HASHREF
2186 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2187 Valid parameters are
2195 active, inactive, suspended, cancel (or cancelled)
2199 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2203 boolean selects custom packages
2213 arrayref of beginning and ending epoch date
2217 arrayref of beginning and ending epoch date
2221 arrayref of beginning and ending epoch date
2225 arrayref of beginning and ending epoch date
2229 arrayref of beginning and ending epoch date
2233 arrayref of beginning and ending epoch date
2237 arrayref of beginning and ending epoch date
2241 pkgnum or APKG_pkgnum
2245 a value suited to passing to FS::UI::Web::cust_header
2249 specifies the user for agent virtualization
2256 my ($class, $params) = @_;
2263 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2265 "cust_main.agentnum = $1";
2272 if ( $params->{'magic'} eq 'active'
2273 || $params->{'status'} eq 'active' ) {
2275 push @where, FS::cust_pkg->active_sql();
2277 } elsif ( $params->{'magic'} eq 'not yet billed'
2278 || $params->{'status'} eq 'not yet billed' ) {
2280 push @where, FS::cust_pkg->not_yet_billed_sql();
2282 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2283 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2285 push @where, FS::cust_pkg->inactive_sql();
2287 } elsif ( $params->{'magic'} eq 'suspended'
2288 || $params->{'status'} eq 'suspended' ) {
2290 push @where, FS::cust_pkg->suspended_sql();
2292 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2293 || $params->{'status'} =~ /^cancell?ed$/ ) {
2295 push @where, FS::cust_pkg->cancelled_sql();
2300 # parse package class
2303 #false lazinessish w/graph/cust_bill_pkg.cgi
2306 if ( exists($params->{'classnum'})
2307 && $params->{'classnum'} =~ /^(\d*)$/
2311 if ( $classnum ) { #a specific class
2312 push @where, "classnum = $classnum";
2314 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2315 #die "classnum $classnum not found!" unless $pkg_class[0];
2316 #$title .= $pkg_class[0]->classname.' ';
2318 } elsif ( $classnum eq '' ) { #the empty class
2320 push @where, "classnum IS NULL";
2321 #$title .= 'Empty class ';
2322 #@pkg_class = ( '(empty class)' );
2323 } elsif ( $classnum eq '0' ) {
2324 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2325 #push @pkg_class, '(empty class)';
2327 die "illegal classnum";
2333 # parse package report options
2336 my @report_option = ();
2337 if ( exists($params->{'report_option'})
2338 && $params->{'report_option'} =~ /^([,\d]*)$/
2341 @report_option = split(',', $1);
2344 if (@report_option) {
2345 # this will result in the empty set for the dangling comma case as it should
2347 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2348 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2349 AND optionname = 'report_option_$_'
2350 AND optionvalue = '1' )"
2360 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2366 if ( $params->{'censustract'} =~ /^([.\d]+)$/ and $1 ) {
2367 push @where, "cust_main.censustract = '". $params->{censustract}. "'";
2374 my $pkgpart = join (' OR pkgpart=',
2375 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2376 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2384 #false laziness w/report_cust_pkg.html
2387 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2388 'active' => { 'susp'=>1, 'cancel'=>1 },
2389 'suspended' => { 'cancel' => 1 },
2394 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2396 next unless exists($params->{$field});
2398 my($beginning, $ending) = @{$params->{$field}};
2400 next if $beginning == 0 && $ending == 4294967295;
2403 "cust_pkg.$field IS NOT NULL",
2404 "cust_pkg.$field >= $beginning",
2405 "cust_pkg.$field <= $ending";
2407 $orderby ||= "ORDER BY cust_pkg.$field";
2411 $orderby ||= 'ORDER BY bill';
2414 # parse magic, legacy, etc.
2417 if ( $params->{'magic'} &&
2418 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2421 $orderby = 'ORDER BY pkgnum';
2423 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2424 push @where, "pkgpart = $1";
2427 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2429 $orderby = 'ORDER BY pkgnum';
2431 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2433 $orderby = 'ORDER BY pkgnum';
2436 SELECT count(*) FROM pkg_svc
2437 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2438 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2439 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2440 AND cust_svc.svcpart = pkg_svc.svcpart
2447 # setup queries, links, subs, etc. for the search
2450 # here is the agent virtualization
2451 if ($params->{CurrentUser}) {
2453 qsearchs('access_user', { username => $params->{CurrentUser} });
2456 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2461 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2464 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2466 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2467 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2468 'LEFT JOIN pkg_class USING ( classnum ) ';
2470 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2473 'table' => 'cust_pkg',
2475 'select' => join(', ',
2477 ( map "part_pkg.$_", qw( pkg freq ) ),
2478 'pkg_class.classname',
2479 'cust_main.custnum as cust_main_custnum',
2480 FS::UI::Web::cust_sql_fields(
2481 $params->{'cust_fields'}
2484 'extra_sql' => "$extra_sql $orderby",
2485 'addl_from' => $addl_from,
2486 'count_query' => $count_query,
2493 Returns a list: the first item is an SQL fragment identifying matching
2494 packages/customers via location (taking into account shipping and package
2495 address taxation, if enabled), and subsequent items are the parameters to
2496 substitute for the placeholders in that fragment.
2501 my($class, %opt) = @_;
2502 my $ornull = $opt{'ornull'};
2504 my $conf = new FS::Conf;
2506 # '?' placeholders in _location_sql_where
2509 @bill_param = qw( county county state state state country );
2511 @bill_param = qw( county state state country );
2513 unshift @bill_param, 'county'; # unless $nec;
2517 if ( $conf->exists('tax-ship_address') ) {
2520 ( ( ship_last IS NULL OR ship_last = '' )
2521 AND ". _location_sql_where('cust_main', '', $ornull ). "
2523 OR ( ship_last IS NOT NULL AND ship_last != ''
2524 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2527 # AND payby != 'COMP'
2529 @main_param = ( @bill_param, @bill_param );
2533 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2534 @main_param = @bill_param;
2540 if ( $conf->exists('tax-pkg_address') ) {
2542 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2545 ( cust_pkg.locationnum IS NULL AND $main_where )
2546 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2549 @param = ( @main_param, @bill_param );
2553 $where = $main_where;
2554 @param = @main_param;
2562 #subroutine, helper for location_sql
2563 sub _location_sql_where {
2565 my $prefix = @_ ? shift : '';
2566 my $ornull = @_ ? shift : '';
2568 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2570 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2572 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2573 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2576 ( $table.${prefix}county = ? $or_empty_county $ornull )
2577 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2578 AND $table.${prefix}country = ?
2586 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2588 CUSTNUM is a customer (see L<FS::cust_main>)
2590 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2591 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2594 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2595 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2596 new billing items. An error is returned if this is not possible (see
2597 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2600 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2601 newly-created cust_pkg objects.
2603 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2604 and inserted. Multiple FS::pkg_referral records can be created by
2605 setting I<refnum> to an array reference of refnums or a hash reference with
2606 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2607 record will be created corresponding to cust_main.refnum.
2612 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2614 my $conf = new FS::Conf;
2616 # Transactionize this whole mess
2617 local $SIG{HUP} = 'IGNORE';
2618 local $SIG{INT} = 'IGNORE';
2619 local $SIG{QUIT} = 'IGNORE';
2620 local $SIG{TERM} = 'IGNORE';
2621 local $SIG{TSTP} = 'IGNORE';
2622 local $SIG{PIPE} = 'IGNORE';
2624 my $oldAutoCommit = $FS::UID::AutoCommit;
2625 local $FS::UID::AutoCommit = 0;
2629 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2630 # return "Customer not found: $custnum" unless $cust_main;
2632 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2635 my $change = scalar(@old_cust_pkg) != 0;
2638 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2640 my $err_or_cust_pkg =
2641 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2642 'refnum' => $refnum,
2645 unless (ref($err_or_cust_pkg)) {
2646 $dbh->rollback if $oldAutoCommit;
2647 return $err_or_cust_pkg;
2650 push @$return_cust_pkg, $err_or_cust_pkg;
2655 # Create the new packages.
2656 foreach my $pkgpart (@$pkgparts) {
2657 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2658 pkgpart => $pkgpart,
2662 $error = $cust_pkg->insert( 'change' => $change );
2664 $dbh->rollback if $oldAutoCommit;
2667 push @$return_cust_pkg, $cust_pkg;
2669 # $return_cust_pkg now contains refs to all of the newly
2672 # Transfer services and cancel old packages.
2673 foreach my $old_pkg (@old_cust_pkg) {
2675 foreach my $new_pkg (@$return_cust_pkg) {
2676 $error = $old_pkg->transfer($new_pkg);
2677 if ($error and $error == 0) {
2678 # $old_pkg->transfer failed.
2679 $dbh->rollback if $oldAutoCommit;
2684 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2685 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2686 foreach my $new_pkg (@$return_cust_pkg) {
2687 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2688 if ($error and $error == 0) {
2689 # $old_pkg->transfer failed.
2690 $dbh->rollback if $oldAutoCommit;
2697 # Transfers were successful, but we went through all of the
2698 # new packages and still had services left on the old package.
2699 # We can't cancel the package under the circumstances, so abort.
2700 $dbh->rollback if $oldAutoCommit;
2701 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2703 $error = $old_pkg->cancel( quiet=>1 );
2709 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2713 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2715 A bulk change method to change packages for multiple customers.
2717 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2718 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2721 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2722 replace. The services (see L<FS::cust_svc>) are moved to the
2723 new billing items. An error is returned if this is not possible (see
2726 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2727 newly-created cust_pkg objects.
2732 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2734 # Transactionize this whole mess
2735 local $SIG{HUP} = 'IGNORE';
2736 local $SIG{INT} = 'IGNORE';
2737 local $SIG{QUIT} = 'IGNORE';
2738 local $SIG{TERM} = 'IGNORE';
2739 local $SIG{TSTP} = 'IGNORE';
2740 local $SIG{PIPE} = 'IGNORE';
2742 my $oldAutoCommit = $FS::UID::AutoCommit;
2743 local $FS::UID::AutoCommit = 0;
2747 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2750 while(scalar(@old_cust_pkg)) {
2752 my $custnum = $old_cust_pkg[0]->custnum;
2753 my (@remove) = map { $_->pkgnum }
2754 grep { $_->custnum == $custnum } @old_cust_pkg;
2755 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2757 my $error = order $custnum, $pkgparts, \@remove, \@return;
2759 push @errors, $error
2761 push @$return_cust_pkg, @return;
2764 if (scalar(@errors)) {
2765 $dbh->rollback if $oldAutoCommit;
2766 return join(' / ', @errors);
2769 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2775 Associates this package with a (suspension or cancellation) reason (see
2776 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2779 Available options are:
2785 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.
2789 the access_user (see L<FS::access_user>) providing the reason
2797 the action (cancel, susp, adjourn, expire) associated with the reason
2801 If there is an error, returns the error, otherwise returns false.
2806 my ($self, %options) = @_;
2808 my $otaker = $options{reason_otaker} ||
2809 $FS::CurrentUser::CurrentUser->username;
2812 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2816 } elsif ( ref($options{'reason'}) ) {
2818 return 'Enter a new reason (or select an existing one)'
2819 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2821 my $reason = new FS::reason({
2822 'reason_type' => $options{'reason'}->{'typenum'},
2823 'reason' => $options{'reason'}->{'reason'},
2825 my $error = $reason->insert;
2826 return $error if $error;
2828 $reasonnum = $reason->reasonnum;
2831 return "Unparsable reason: ". $options{'reason'};
2834 my $cust_pkg_reason =
2835 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2836 'reasonnum' => $reasonnum,
2837 'otaker' => $otaker,
2838 'action' => substr(uc($options{'action'}),0,1),
2839 'date' => $options{'date'}
2844 $cust_pkg_reason->insert;
2847 =item set_usage USAGE_VALUE_HASHREF
2849 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2850 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2851 upbytes, downbytes, and totalbytes are appropriate keys.
2853 All svc_accts which are part of this package have their values reset.
2858 my ($self, $valueref, %opt) = @_;
2860 foreach my $cust_svc ($self->cust_svc){
2861 my $svc_x = $cust_svc->svc_x;
2862 $svc_x->set_usage($valueref, %opt)
2863 if $svc_x->can("set_usage");
2867 =item recharge USAGE_VALUE_HASHREF
2869 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2870 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2871 upbytes, downbytes, and totalbytes are appropriate keys.
2873 All svc_accts which are part of this package have their values incremented.
2878 my ($self, $valueref) = @_;
2880 foreach my $cust_svc ($self->cust_svc){
2881 my $svc_x = $cust_svc->svc_x;
2882 $svc_x->recharge($valueref)
2883 if $svc_x->can("recharge");
2891 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2893 In sub order, the @pkgparts array (passed by reference) is clobbered.
2895 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2896 method to pass dates to the recur_prog expression, it should do so.
2898 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2899 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2900 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2901 configuration values. Probably need a subroutine which decides what to do
2902 based on whether or not we've fetched the user yet, rather than a hash. See
2903 FS::UID and the TODO.
2905 Now that things are transactional should the check in the insert method be
2910 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2911 L<FS::pkg_svc>, schema.html from the base documentation