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)
563 =item nobill - can be set true to skip billing if it might otherwise be done.
567 If there is an error, returns the error, otherwise returns false.
572 my( $self, %options ) = @_;
575 my $conf = new FS::Conf;
577 warn "cust_pkg::cancel called with options".
578 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
581 local $SIG{HUP} = 'IGNORE';
582 local $SIG{INT} = 'IGNORE';
583 local $SIG{QUIT} = 'IGNORE';
584 local $SIG{TERM} = 'IGNORE';
585 local $SIG{TSTP} = 'IGNORE';
586 local $SIG{PIPE} = 'IGNORE';
588 my $oldAutoCommit = $FS::UID::AutoCommit;
589 local $FS::UID::AutoCommit = 0;
592 my $old = $self->select_for_update;
594 if ( $old->get('cancel') || $self->get('cancel') ) {
595 dbh->rollback if $oldAutoCommit;
596 return ""; # no error
599 my $date = $options{date} if $options{date}; # expire/cancel later
600 $date = '' if ($date && $date <= time); # complain instead?
602 #race condition: usage could be ongoing until unprovisioned
603 #resolved by performing a change package instead (which unprovisions) and
605 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
607 $self->cust_main->bill( pkg_list => [ $self ], cancel => 1 );
608 warn "Error billing during cancel, custnum ".
609 #$self->cust_main->custnum. ": $error"
615 my $cancel_time = $options{'time'} || time;
617 if ( $options{'reason'} ) {
618 $error = $self->insert_reason( 'reason' => $options{'reason'},
619 'action' => $date ? 'expire' : 'cancel',
620 'date' => $date ? $date : $cancel_time,
621 'reason_otaker' => $options{'reason_otaker'},
624 dbh->rollback if $oldAutoCommit;
625 return "Error inserting cust_pkg_reason: $error";
631 foreach my $cust_svc (
634 sort { $a->[1] <=> $b->[1] }
635 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
636 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
639 my $error = $cust_svc->cancel;
642 $dbh->rollback if $oldAutoCommit;
643 return "Error cancelling cust_svc: $error";
647 # Add a credit for remaining service
648 my $remaining_value = $self->calc_remain(time=>$cancel_time);
649 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
650 my $error = $self->cust_main->credit(
652 'Credit for unused time on '. $self->part_pkg->pkg,
653 'reason_type' => $conf->config('cancel_credit_type'),
656 $dbh->rollback if $oldAutoCommit;
657 return "Error crediting customer \$$remaining_value for unused time on".
658 $self->part_pkg->pkg. ": $error";
663 my %hash = $self->hash;
664 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
665 my $new = new FS::cust_pkg ( \%hash );
666 $error = $new->replace( $self, options => { $self->options } );
668 $dbh->rollback if $oldAutoCommit;
672 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
673 return '' if $date; #no errors
675 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
676 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
677 my $error = send_email(
678 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
679 'to' => \@invoicing_list,
680 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
681 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
683 #should this do something on errors?
690 =item cancel_if_expired [ NOW_TIMESTAMP ]
692 Cancels this package if its expire date has been reached.
696 sub cancel_if_expired {
698 my $time = shift || time;
699 return '' unless $self->expire && $self->expire <= $time;
700 my $error = $self->cancel;
702 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
703 $self->custnum. ": $error";
710 Cancels any pending expiration (sets the expire field to null).
712 If there is an error, returns the error, otherwise returns false.
717 my( $self, %options ) = @_;
720 local $SIG{HUP} = 'IGNORE';
721 local $SIG{INT} = 'IGNORE';
722 local $SIG{QUIT} = 'IGNORE';
723 local $SIG{TERM} = 'IGNORE';
724 local $SIG{TSTP} = 'IGNORE';
725 local $SIG{PIPE} = 'IGNORE';
727 my $oldAutoCommit = $FS::UID::AutoCommit;
728 local $FS::UID::AutoCommit = 0;
731 my $old = $self->select_for_update;
733 my $pkgnum = $old->pkgnum;
734 if ( $old->get('cancel') || $self->get('cancel') ) {
735 dbh->rollback if $oldAutoCommit;
736 return "Can't unexpire cancelled package $pkgnum";
737 # or at least it's pointless
740 unless ( $old->get('expire') && $self->get('expire') ) {
741 dbh->rollback if $oldAutoCommit;
742 return ""; # no error
745 my %hash = $self->hash;
746 $hash{'expire'} = '';
747 my $new = new FS::cust_pkg ( \%hash );
748 $error = $new->replace( $self, options => { $self->options } );
750 $dbh->rollback if $oldAutoCommit;
754 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
760 =item suspend [ OPTION => VALUE ... ]
762 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
763 package, then suspends the package itself (sets the susp field to now).
765 Available options are:
769 =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.
771 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
775 If there is an error, returns the error, otherwise returns false.
780 my( $self, %options ) = @_;
783 local $SIG{HUP} = 'IGNORE';
784 local $SIG{INT} = 'IGNORE';
785 local $SIG{QUIT} = 'IGNORE';
786 local $SIG{TERM} = 'IGNORE';
787 local $SIG{TSTP} = 'IGNORE';
788 local $SIG{PIPE} = 'IGNORE';
790 my $oldAutoCommit = $FS::UID::AutoCommit;
791 local $FS::UID::AutoCommit = 0;
794 my $old = $self->select_for_update;
796 my $pkgnum = $old->pkgnum;
797 if ( $old->get('cancel') || $self->get('cancel') ) {
798 dbh->rollback if $oldAutoCommit;
799 return "Can't suspend cancelled package $pkgnum";
802 if ( $old->get('susp') || $self->get('susp') ) {
803 dbh->rollback if $oldAutoCommit;
804 return ""; # no error # complain on adjourn?
807 my $date = $options{date} if $options{date}; # adjourn/suspend later
808 $date = '' if ($date && $date <= time); # complain instead?
810 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
811 dbh->rollback if $oldAutoCommit;
812 return "Package $pkgnum expires before it would be suspended.";
815 my $suspend_time = $options{'time'} || time;
817 if ( $options{'reason'} ) {
818 $error = $self->insert_reason( 'reason' => $options{'reason'},
819 'action' => $date ? 'adjourn' : 'suspend',
820 'date' => $date ? $date : $suspend_time,
821 'reason_otaker' => $options{'reason_otaker'},
824 dbh->rollback if $oldAutoCommit;
825 return "Error inserting cust_pkg_reason: $error";
833 foreach my $cust_svc (
834 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
836 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
838 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
839 $dbh->rollback if $oldAutoCommit;
840 return "Illegal svcdb value in part_svc!";
843 require "FS/$svcdb.pm";
845 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
847 $error = $svc->suspend;
849 $dbh->rollback if $oldAutoCommit;
852 my( $label, $value ) = $cust_svc->label;
853 push @labels, "$label: $value";
857 my $conf = new FS::Conf;
858 if ( $conf->config('suspend_email_admin') ) {
860 my $error = send_email(
861 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
862 #invoice_from ??? well as good as any
863 'to' => $conf->config('suspend_email_admin'),
864 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
866 "This is an automatic message from your Freeside installation\n",
867 "informing you that the following customer package has been suspended:\n",
869 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
870 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
871 ( map { "Service : $_\n" } @labels ),
876 warn "WARNING: can't send suspension admin email (suspending anyway): ".
884 my %hash = $self->hash;
886 $hash{'adjourn'} = $date;
888 $hash{'susp'} = $suspend_time;
890 my $new = new FS::cust_pkg ( \%hash );
891 $error = $new->replace( $self, options => { $self->options } );
893 $dbh->rollback if $oldAutoCommit;
897 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
902 =item unsuspend [ OPTION => VALUE ... ]
904 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
905 package, then unsuspends the package itself (clears the susp field and the
906 adjourn field if it is in the past).
908 Available options are:
912 =item adjust_next_bill
914 Can be set true to adjust the next bill date forward by
915 the amount of time the account was inactive. This was set true by default
916 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
917 explicitly requested. Price plans for which this makes sense (anniversary-date
918 based than prorate or subscription) could have an option to enable this
923 If there is an error, returns the error, otherwise returns false.
928 my( $self, %opt ) = @_;
931 local $SIG{HUP} = 'IGNORE';
932 local $SIG{INT} = 'IGNORE';
933 local $SIG{QUIT} = 'IGNORE';
934 local $SIG{TERM} = 'IGNORE';
935 local $SIG{TSTP} = 'IGNORE';
936 local $SIG{PIPE} = 'IGNORE';
938 my $oldAutoCommit = $FS::UID::AutoCommit;
939 local $FS::UID::AutoCommit = 0;
942 my $old = $self->select_for_update;
944 my $pkgnum = $old->pkgnum;
945 if ( $old->get('cancel') || $self->get('cancel') ) {
946 dbh->rollback if $oldAutoCommit;
947 return "Can't unsuspend cancelled package $pkgnum";
950 unless ( $old->get('susp') && $self->get('susp') ) {
951 dbh->rollback if $oldAutoCommit;
952 return ""; # no error # complain instead?
955 foreach my $cust_svc (
956 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
958 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
960 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
961 $dbh->rollback if $oldAutoCommit;
962 return "Illegal svcdb value in part_svc!";
965 require "FS/$svcdb.pm";
967 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
969 $error = $svc->unsuspend;
971 $dbh->rollback if $oldAutoCommit;
978 my %hash = $self->hash;
979 my $inactive = time - $hash{'susp'};
981 my $conf = new FS::Conf;
983 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
984 if ( $opt{'adjust_next_bill'}
985 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
986 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
989 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
990 my $new = new FS::cust_pkg ( \%hash );
991 $error = $new->replace( $self, options => { $self->options } );
993 $dbh->rollback if $oldAutoCommit;
997 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1004 Cancels any pending suspension (sets the adjourn field to null).
1006 If there is an error, returns the error, otherwise returns false.
1011 my( $self, %options ) = @_;
1014 local $SIG{HUP} = 'IGNORE';
1015 local $SIG{INT} = 'IGNORE';
1016 local $SIG{QUIT} = 'IGNORE';
1017 local $SIG{TERM} = 'IGNORE';
1018 local $SIG{TSTP} = 'IGNORE';
1019 local $SIG{PIPE} = 'IGNORE';
1021 my $oldAutoCommit = $FS::UID::AutoCommit;
1022 local $FS::UID::AutoCommit = 0;
1025 my $old = $self->select_for_update;
1027 my $pkgnum = $old->pkgnum;
1028 if ( $old->get('cancel') || $self->get('cancel') ) {
1029 dbh->rollback if $oldAutoCommit;
1030 return "Can't unadjourn cancelled package $pkgnum";
1031 # or at least it's pointless
1034 if ( $old->get('susp') || $self->get('susp') ) {
1035 dbh->rollback if $oldAutoCommit;
1036 return "Can't unadjourn suspended package $pkgnum";
1037 # perhaps this is arbitrary
1040 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1041 dbh->rollback if $oldAutoCommit;
1042 return ""; # no error
1045 my %hash = $self->hash;
1046 $hash{'adjourn'} = '';
1047 my $new = new FS::cust_pkg ( \%hash );
1048 $error = $new->replace( $self, options => { $self->options } );
1050 $dbh->rollback if $oldAutoCommit;
1054 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1061 =item change HASHREF | OPTION => VALUE ...
1063 Changes this package: cancels it and creates a new one, with a different
1064 pkgpart or locationnum or both. All services are transferred to the new
1065 package (no change will be made if this is not possible).
1067 Options may be passed as a list of key/value pairs or as a hash reference.
1074 New locationnum, to change the location for this package.
1078 New FS::cust_location object, to create a new location and assign it
1083 New pkgpart (see L<FS::part_pkg>).
1087 New refnum (see L<FS::part_referral>).
1091 At least one option must be specified (otherwise, what's the point?)
1093 Returns either the new FS::cust_pkg object or a scalar error.
1097 my $err_or_new_cust_pkg = $old_cust_pkg->change
1101 #some false laziness w/order
1104 my $opt = ref($_[0]) ? shift : { @_ };
1106 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1109 my $conf = new FS::Conf;
1111 # Transactionize this whole mess
1112 local $SIG{HUP} = 'IGNORE';
1113 local $SIG{INT} = 'IGNORE';
1114 local $SIG{QUIT} = 'IGNORE';
1115 local $SIG{TERM} = 'IGNORE';
1116 local $SIG{TSTP} = 'IGNORE';
1117 local $SIG{PIPE} = 'IGNORE';
1119 my $oldAutoCommit = $FS::UID::AutoCommit;
1120 local $FS::UID::AutoCommit = 0;
1129 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1131 #$hash{$_} = $self->$_() foreach qw( setup );
1133 $hash{'setup'} = $time if $self->setup;
1135 $hash{'change_date'} = $time;
1136 $hash{"change_$_"} = $self->$_()
1137 foreach qw( pkgnum pkgpart locationnum );
1139 if ( $opt->{'cust_location'} &&
1140 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1141 $error = $opt->{'cust_location'}->insert;
1143 $dbh->rollback if $oldAutoCommit;
1144 return "inserting cust_location (transaction rolled back): $error";
1146 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1149 # Create the new package.
1150 my $cust_pkg = new FS::cust_pkg {
1151 custnum => $self->custnum,
1152 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1153 refnum => ( $opt->{'refnum'} || $self->refnum ),
1154 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1158 $error = $cust_pkg->insert( 'change' => 1 );
1160 $dbh->rollback if $oldAutoCommit;
1164 # Transfer services and cancel old package.
1166 $error = $self->transfer($cust_pkg);
1167 if ($error and $error == 0) {
1168 # $old_pkg->transfer failed.
1169 $dbh->rollback if $oldAutoCommit;
1173 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1174 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1175 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1176 if ($error and $error == 0) {
1177 # $old_pkg->transfer failed.
1178 $dbh->rollback if $oldAutoCommit;
1184 # Transfers were successful, but we still had services left on the old
1185 # package. We can't change the package under this circumstances, so abort.
1186 $dbh->rollback if $oldAutoCommit;
1187 return "Unable to transfer all services from package ". $self->pkgnum;
1190 #reset usage if changing pkgpart
1191 if ($self->pkgpart != $cust_pkg->pkgpart) {
1192 my $part_pkg = $cust_pkg->part_pkg;
1193 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1197 if $part_pkg->can('reset_usage');
1200 $dbh->rollback if $oldAutoCommit;
1201 return "Error setting usage values: $error";
1205 #Good to go, cancel old package.
1206 $error = $self->cancel( quiet=>1 );
1212 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1219 Returns the last bill date, or if there is no last bill date, the setup date.
1220 Useful for billing metered services.
1226 return $self->setfield('last_bill', $_[0]) if @_;
1227 return $self->getfield('last_bill') if $self->getfield('last_bill');
1228 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1229 'edate' => $self->bill, } );
1230 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1233 =item last_cust_pkg_reason ACTION
1235 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1236 Returns false if there is no reason or the package is not currenly ACTION'd
1237 ACTION is one of adjourn, susp, cancel, or expire.
1241 sub last_cust_pkg_reason {
1242 my ( $self, $action ) = ( shift, shift );
1243 my $date = $self->get($action);
1245 'table' => 'cust_pkg_reason',
1246 'hashref' => { 'pkgnum' => $self->pkgnum,
1247 'action' => substr(uc($action), 0, 1),
1250 'order_by' => 'ORDER BY num DESC LIMIT 1',
1254 =item last_reason ACTION
1256 Returns the most recent ACTION FS::reason associated with the package.
1257 Returns false if there is no reason or the package is not currenly ACTION'd
1258 ACTION is one of adjourn, susp, cancel, or expire.
1263 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1264 $cust_pkg_reason->reason
1265 if $cust_pkg_reason;
1270 Returns the definition for this billing item, as an FS::part_pkg object (see
1277 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1278 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1279 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1284 Returns the cancelled package this package was changed from, if any.
1290 return '' unless $self->change_pkgnum;
1291 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1296 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1303 $self->part_pkg->calc_setup($self, @_);
1308 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1315 $self->part_pkg->calc_recur($self, @_);
1320 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1327 $self->part_pkg->calc_remain($self, @_);
1332 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1339 $self->part_pkg->calc_cancel($self, @_);
1344 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1350 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1353 =item cust_pkg_detail [ DETAILTYPE ]
1355 Returns any customer package details for this package (see
1356 L<FS::cust_pkg_detail>).
1358 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1362 sub cust_pkg_detail {
1364 my %hash = ( 'pkgnum' => $self->pkgnum );
1365 $hash{detailtype} = shift if @_;
1367 'table' => 'cust_pkg_detail',
1368 'hashref' => \%hash,
1369 'order_by' => 'ORDER BY weight, pkgdetailnum',
1373 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1375 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1377 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1379 If there is an error, returns the error, otherwise returns false.
1383 sub set_cust_pkg_detail {
1384 my( $self, $detailtype, @details ) = @_;
1386 local $SIG{HUP} = 'IGNORE';
1387 local $SIG{INT} = 'IGNORE';
1388 local $SIG{QUIT} = 'IGNORE';
1389 local $SIG{TERM} = 'IGNORE';
1390 local $SIG{TSTP} = 'IGNORE';
1391 local $SIG{PIPE} = 'IGNORE';
1393 my $oldAutoCommit = $FS::UID::AutoCommit;
1394 local $FS::UID::AutoCommit = 0;
1397 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1398 my $error = $current->delete;
1400 $dbh->rollback if $oldAutoCommit;
1401 return "error removing old detail: $error";
1405 foreach my $detail ( @details ) {
1406 my $cust_pkg_detail = new FS::cust_pkg_detail {
1407 'pkgnum' => $self->pkgnum,
1408 'detailtype' => $detailtype,
1409 'detail' => $detail,
1411 my $error = $cust_pkg_detail->insert;
1413 $dbh->rollback if $oldAutoCommit;
1414 return "error adding new detail: $error";
1419 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1426 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1430 #false laziness w/cust_bill.pm
1434 'table' => 'cust_event',
1435 'addl_from' => 'JOIN part_event USING ( eventpart )',
1436 'hashref' => { 'tablenum' => $self->pkgnum },
1437 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1441 =item num_cust_event
1443 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1447 #false laziness w/cust_bill.pm
1448 sub num_cust_event {
1451 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1452 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1453 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1454 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1455 $sth->fetchrow_arrayref->[0];
1458 =item cust_svc [ SVCPART ]
1460 Returns the services for this package, as FS::cust_svc objects (see
1461 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1469 return () unless $self->num_cust_svc(@_);
1472 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1473 'svcpart' => shift, } );
1476 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1478 #if ( $self->{'_svcnum'} ) {
1479 # values %{ $self->{'_svcnum'}->cache };
1481 $self->_sort_cust_svc(
1482 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1488 =item overlimit [ SVCPART ]
1490 Returns the services for this package which have exceeded their
1491 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1492 is specified, return only the matching services.
1498 return () unless $self->num_cust_svc(@_);
1499 grep { $_->overlimit } $self->cust_svc(@_);
1502 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1504 Returns historical services for this package created before END TIMESTAMP and
1505 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1506 (see L<FS::h_cust_svc>).
1513 $self->_sort_cust_svc(
1514 [ qsearch( 'h_cust_svc',
1515 { 'pkgnum' => $self->pkgnum, },
1516 FS::h_cust_svc->sql_h_search(@_),
1522 sub _sort_cust_svc {
1523 my( $self, $arrayref ) = @_;
1526 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1528 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1529 'svcpart' => $_->svcpart } );
1531 $pkg_svc ? $pkg_svc->primary_svc : '',
1532 $pkg_svc ? $pkg_svc->quantity : 0,
1539 =item num_cust_svc [ SVCPART ]
1541 Returns the number of provisioned services for this package. If a svcpart is
1542 specified, counts only the matching services.
1549 return $self->{'_num_cust_svc'}
1551 && exists($self->{'_num_cust_svc'})
1552 && $self->{'_num_cust_svc'} =~ /\d/;
1554 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1557 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1558 $sql .= ' AND svcpart = ?' if @_;
1560 my $sth = dbh->prepare($sql) or die dbh->errstr;
1561 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1562 $sth->fetchrow_arrayref->[0];
1565 =item available_part_svc
1567 Returns a list of FS::part_svc objects representing services included in this
1568 package but not yet provisioned. Each FS::part_svc object also has an extra
1569 field, I<num_avail>, which specifies the number of available services.
1573 sub available_part_svc {
1575 grep { $_->num_avail > 0 }
1577 my $part_svc = $_->part_svc;
1578 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1579 $_->quantity - $self->num_cust_svc($_->svcpart);
1582 $self->part_pkg->pkg_svc;
1587 Returns a list of FS::part_svc objects representing provisioned and available
1588 services included in this package. Each FS::part_svc object also has the
1589 following extra fields:
1593 =item num_cust_svc (count)
1595 =item num_avail (quantity - count)
1597 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1600 label -> ($cust_svc->label)[1]
1609 #XXX some sort of sort order besides numeric by svcpart...
1610 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1612 my $part_svc = $pkg_svc->part_svc;
1613 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1614 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1615 $part_svc->{'Hash'}{'num_avail'} =
1616 max( 0, $pkg_svc->quantity - $num_cust_svc );
1617 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1618 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1620 } $self->part_pkg->pkg_svc;
1623 push @part_svc, map {
1625 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1626 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1627 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1628 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1629 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1631 } $self->extra_part_svc;
1637 =item extra_part_svc
1639 Returns a list of FS::part_svc objects corresponding to services in this
1640 package which are still provisioned but not (any longer) available in the
1645 sub extra_part_svc {
1648 my $pkgnum = $self->pkgnum;
1649 my $pkgpart = $self->pkgpart;
1652 # 'table' => 'part_svc',
1655 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1656 # WHERE pkg_svc.svcpart = part_svc.svcpart
1657 # AND pkg_svc.pkgpart = ?
1660 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1661 # LEFT JOIN cust_pkg USING ( pkgnum )
1662 # WHERE cust_svc.svcpart = part_svc.svcpart
1665 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1668 #seems to benchmark slightly faster...
1670 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1671 'table' => 'part_svc',
1673 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1674 AND pkg_svc.pkgpart = ?
1677 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1678 LEFT JOIN cust_pkg USING ( pkgnum )
1681 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1682 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1688 Returns a short status string for this package, currently:
1692 =item not yet billed
1694 =item one-time charge
1709 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1711 return 'cancelled' if $self->get('cancel');
1712 return 'suspended' if $self->susp;
1713 return 'not yet billed' unless $self->setup;
1714 return 'one-time charge' if $freq =~ /^(0|$)/;
1720 Class method that returns the list of possible status strings for packages
1721 (see L<the status method|/status>). For example:
1723 @statuses = FS::cust_pkg->statuses();
1727 tie my %statuscolor, 'Tie::IxHash',
1728 'not yet billed' => '000000',
1729 'one-time charge' => '000000',
1730 'active' => '00CC00',
1731 'suspended' => 'FF9900',
1732 'cancelled' => 'FF0000',
1736 my $self = shift; #could be class...
1737 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1738 # # mayble split btw one-time vs. recur
1744 Returns a hex triplet color string for this package's status.
1750 $statuscolor{$self->status};
1755 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1756 "pkg-comment" depending on user preference).
1762 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1763 $label = $self->pkgnum. ": $label"
1764 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1768 =item pkg_label_long
1770 Returns a long label for this package, adding the primary service's label to
1775 sub pkg_label_long {
1777 my $label = $self->pkg_label;
1778 my $cust_svc = $self->primary_cust_svc;
1779 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1783 =item primary_cust_svc
1785 Returns a primary service (as FS::cust_svc object) if one can be identified.
1789 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1791 sub primary_cust_svc {
1794 my @cust_svc = $self->cust_svc;
1796 return '' unless @cust_svc; #no serivces - irrelevant then
1798 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1800 # primary service as specified in the package definition
1801 # or exactly one service definition with quantity one
1802 my $svcpart = $self->part_pkg->svcpart;
1803 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1804 return $cust_svc[0] if scalar(@cust_svc) == 1;
1806 #couldn't identify one thing..
1812 Returns a list of lists, calling the label method for all services
1813 (see L<FS::cust_svc>) of this billing item.
1819 map { [ $_->label ] } $self->cust_svc;
1822 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1824 Like the labels method, but returns historical information on services that
1825 were active as of END_TIMESTAMP and (optionally) not cancelled before
1828 Returns a list of lists, calling the label method for all (historical) services
1829 (see L<FS::h_cust_svc>) of this billing item.
1835 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1838 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1840 Like h_labels, except returns a simple flat list, and shortens long
1841 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1842 identical services to one line that lists the service label and the number of
1843 individual services rather than individual items.
1847 sub h_labels_short {
1850 my $conf = new FS::Conf;
1851 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1854 #tie %labels, 'Tie::IxHash';
1855 push @{ $labels{$_->[0]} }, $_->[1]
1856 foreach $self->h_labels(@_);
1858 foreach my $label ( keys %labels ) {
1860 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1861 my $num = scalar(@values);
1862 if ( $num > $max_same_services ) {
1863 push @labels, "$label ($num)";
1865 push @labels, map { "$label: $_" } @values;
1875 Returns the parent customer object (see L<FS::cust_main>).
1881 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1886 Returns the location object, if any (see L<FS::cust_location>).
1892 return '' unless $self->locationnum;
1893 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1896 =item cust_location_or_main
1898 If this package is associated with a location, returns the locaiton (see
1899 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1903 sub cust_location_or_main {
1905 $self->cust_location || $self->cust_main;
1908 =item seconds_since TIMESTAMP
1910 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1911 package have been online since TIMESTAMP, according to the session monitor.
1913 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1914 L<Time::Local> and L<Date::Parse> for conversion functions.
1919 my($self, $since) = @_;
1922 foreach my $cust_svc (
1923 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1925 $seconds += $cust_svc->seconds_since($since);
1932 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1934 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1935 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1938 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1939 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1945 sub seconds_since_sqlradacct {
1946 my($self, $start, $end) = @_;
1950 foreach my $cust_svc (
1952 my $part_svc = $_->part_svc;
1953 $part_svc->svcdb eq 'svc_acct'
1954 && scalar($part_svc->part_export('sqlradius'));
1957 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1964 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1966 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1967 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1971 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1972 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1977 sub attribute_since_sqlradacct {
1978 my($self, $start, $end, $attrib) = @_;
1982 foreach my $cust_svc (
1984 my $part_svc = $_->part_svc;
1985 $part_svc->svcdb eq 'svc_acct'
1986 && scalar($part_svc->part_export('sqlradius'));
1989 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2001 my( $self, $value ) = @_;
2002 if ( defined($value) ) {
2003 $self->setfield('quantity', $value);
2005 $self->getfield('quantity') || 1;
2008 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2010 Transfers as many services as possible from this package to another package.
2012 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2013 object. The destination package must already exist.
2015 Services are moved only if the destination allows services with the correct
2016 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2017 this option with caution! No provision is made for export differences
2018 between the old and new service definitions. Probably only should be used
2019 when your exports for all service definitions of a given svcdb are identical.
2020 (attempt a transfer without it first, to move all possible svcpart-matching
2023 Any services that can't be moved remain in the original package.
2025 Returns an error, if there is one; otherwise, returns the number of services
2026 that couldn't be moved.
2031 my ($self, $dest_pkgnum, %opt) = @_;
2037 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2038 $dest = $dest_pkgnum;
2039 $dest_pkgnum = $dest->pkgnum;
2041 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2044 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2046 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2047 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2050 foreach my $cust_svc ($dest->cust_svc) {
2051 $target{$cust_svc->svcpart}--;
2054 my %svcpart2svcparts = ();
2055 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2056 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2057 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2058 next if exists $svcpart2svcparts{$svcpart};
2059 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2060 $svcpart2svcparts{$svcpart} = [
2062 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2064 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2065 'svcpart' => $_ } );
2067 $pkg_svc ? $pkg_svc->primary_svc : '',
2068 $pkg_svc ? $pkg_svc->quantity : 0,
2072 grep { $_ != $svcpart }
2074 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2076 warn "alternates for svcpart $svcpart: ".
2077 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2082 foreach my $cust_svc ($self->cust_svc) {
2083 if($target{$cust_svc->svcpart} > 0) {
2084 $target{$cust_svc->svcpart}--;
2085 my $new = new FS::cust_svc { $cust_svc->hash };
2086 $new->pkgnum($dest_pkgnum);
2087 my $error = $new->replace($cust_svc);
2088 return $error if $error;
2089 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2091 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2092 warn "alternates to consider: ".
2093 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2095 my @alternate = grep {
2096 warn "considering alternate svcpart $_: ".
2097 "$target{$_} available in new package\n"
2100 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2102 warn "alternate(s) found\n" if $DEBUG;
2103 my $change_svcpart = $alternate[0];
2104 $target{$change_svcpart}--;
2105 my $new = new FS::cust_svc { $cust_svc->hash };
2106 $new->svcpart($change_svcpart);
2107 $new->pkgnum($dest_pkgnum);
2108 my $error = $new->replace($cust_svc);
2109 return $error if $error;
2122 This method is deprecated. See the I<depend_jobnum> option to the insert and
2123 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2130 local $SIG{HUP} = 'IGNORE';
2131 local $SIG{INT} = 'IGNORE';
2132 local $SIG{QUIT} = 'IGNORE';
2133 local $SIG{TERM} = 'IGNORE';
2134 local $SIG{TSTP} = 'IGNORE';
2135 local $SIG{PIPE} = 'IGNORE';
2137 my $oldAutoCommit = $FS::UID::AutoCommit;
2138 local $FS::UID::AutoCommit = 0;
2141 foreach my $cust_svc ( $self->cust_svc ) {
2142 #false laziness w/svc_Common::insert
2143 my $svc_x = $cust_svc->svc_x;
2144 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2145 my $error = $part_export->export_insert($svc_x);
2147 $dbh->rollback if $oldAutoCommit;
2153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2160 =head1 CLASS METHODS
2166 Returns an SQL expression identifying recurring packages.
2170 sub recurring_sql { "
2171 '0' != ( select freq from part_pkg
2172 where cust_pkg.pkgpart = part_pkg.pkgpart )
2177 Returns an SQL expression identifying one-time packages.
2182 '0' = ( select freq from part_pkg
2183 where cust_pkg.pkgpart = part_pkg.pkgpart )
2188 Returns an SQL expression identifying active packages.
2193 ". $_[0]->recurring_sql(). "
2194 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2195 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2198 =item not_yet_billed_sql
2200 Returns an SQL expression identifying packages which have not yet been billed.
2204 sub not_yet_billed_sql { "
2205 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2206 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2207 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2212 Returns an SQL expression identifying inactive packages (one-time packages
2213 that are otherwise unsuspended/uncancelled).
2217 sub inactive_sql { "
2218 ". $_[0]->onetime_sql(). "
2219 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2220 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2221 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2227 Returns an SQL expression identifying suspended packages.
2231 sub suspended_sql { susp_sql(@_); }
2233 #$_[0]->recurring_sql(). ' AND '.
2235 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2236 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2243 Returns an SQL exprression identifying cancelled packages.
2247 sub cancelled_sql { cancel_sql(@_); }
2249 #$_[0]->recurring_sql(). ' AND '.
2250 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2253 =item search_sql HASHREF
2257 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2258 Valid parameters are
2266 active, inactive, suspended, cancel (or cancelled)
2270 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2274 boolean selects custom packages
2284 arrayref of beginning and ending epoch date
2288 arrayref of beginning and ending epoch date
2292 arrayref of beginning and ending epoch date
2296 arrayref of beginning and ending epoch date
2300 arrayref of beginning and ending epoch date
2304 arrayref of beginning and ending epoch date
2308 arrayref of beginning and ending epoch date
2312 pkgnum or APKG_pkgnum
2316 a value suited to passing to FS::UI::Web::cust_header
2320 specifies the user for agent virtualization
2327 my ($class, $params) = @_;
2334 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2336 "cust_main.agentnum = $1";
2343 if ( $params->{'magic'} eq 'active'
2344 || $params->{'status'} eq 'active' ) {
2346 push @where, FS::cust_pkg->active_sql();
2348 } elsif ( $params->{'magic'} eq 'not yet billed'
2349 || $params->{'status'} eq 'not yet billed' ) {
2351 push @where, FS::cust_pkg->not_yet_billed_sql();
2353 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2354 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2356 push @where, FS::cust_pkg->inactive_sql();
2358 } elsif ( $params->{'magic'} eq 'suspended'
2359 || $params->{'status'} eq 'suspended' ) {
2361 push @where, FS::cust_pkg->suspended_sql();
2363 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2364 || $params->{'status'} =~ /^cancell?ed$/ ) {
2366 push @where, FS::cust_pkg->cancelled_sql();
2371 # parse package class
2374 #false lazinessish w/graph/cust_bill_pkg.cgi
2377 if ( exists($params->{'classnum'})
2378 && $params->{'classnum'} =~ /^(\d*)$/
2382 if ( $classnum ) { #a specific class
2383 push @where, "classnum = $classnum";
2385 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2386 #die "classnum $classnum not found!" unless $pkg_class[0];
2387 #$title .= $pkg_class[0]->classname.' ';
2389 } elsif ( $classnum eq '' ) { #the empty class
2391 push @where, "classnum IS NULL";
2392 #$title .= 'Empty class ';
2393 #@pkg_class = ( '(empty class)' );
2394 } elsif ( $classnum eq '0' ) {
2395 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2396 #push @pkg_class, '(empty class)';
2398 die "illegal classnum";
2404 # parse package report options
2407 my @report_option = ();
2408 if ( exists($params->{'report_option'})
2409 && $params->{'report_option'} =~ /^([,\d]*)$/
2412 @report_option = split(',', $1);
2415 if (@report_option) {
2416 # this will result in the empty set for the dangling comma case as it should
2418 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2419 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2420 AND optionname = 'report_option_$_'
2421 AND optionvalue = '1' )"
2431 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2437 if ( exists($params->{'censustract'}) ) {
2438 $params->{'censustract'} =~ /^([.\d]*)$/;
2439 my $censustract = "cust_main.censustract = '$1'";
2440 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2441 push @where, "( $censustract )";
2448 my $pkgpart = join (' OR pkgpart=',
2449 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2450 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2458 #false laziness w/report_cust_pkg.html
2461 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2462 'active' => { 'susp'=>1, 'cancel'=>1 },
2463 'suspended' => { 'cancel' => 1 },
2468 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2470 next unless exists($params->{$field});
2472 my($beginning, $ending) = @{$params->{$field}};
2474 next if $beginning == 0 && $ending == 4294967295;
2477 "cust_pkg.$field IS NOT NULL",
2478 "cust_pkg.$field >= $beginning",
2479 "cust_pkg.$field <= $ending";
2481 $orderby ||= "ORDER BY cust_pkg.$field";
2485 $orderby ||= 'ORDER BY bill';
2488 # parse magic, legacy, etc.
2491 if ( $params->{'magic'} &&
2492 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2495 $orderby = 'ORDER BY pkgnum';
2497 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2498 push @where, "pkgpart = $1";
2501 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2503 $orderby = 'ORDER BY pkgnum';
2505 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2507 $orderby = 'ORDER BY pkgnum';
2510 SELECT count(*) FROM pkg_svc
2511 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2512 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2513 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2514 AND cust_svc.svcpart = pkg_svc.svcpart
2521 # setup queries, links, subs, etc. for the search
2524 # here is the agent virtualization
2525 if ($params->{CurrentUser}) {
2527 qsearchs('access_user', { username => $params->{CurrentUser} });
2530 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2535 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2538 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2540 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2541 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2542 'LEFT JOIN pkg_class USING ( classnum ) ';
2544 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2547 'table' => 'cust_pkg',
2549 'select' => join(', ',
2551 ( map "part_pkg.$_", qw( pkg freq ) ),
2552 'pkg_class.classname',
2553 'cust_main.custnum as cust_main_custnum',
2554 FS::UI::Web::cust_sql_fields(
2555 $params->{'cust_fields'}
2558 'extra_sql' => "$extra_sql $orderby",
2559 'addl_from' => $addl_from,
2560 'count_query' => $count_query,
2567 Returns a list: the first item is an SQL fragment identifying matching
2568 packages/customers via location (taking into account shipping and package
2569 address taxation, if enabled), and subsequent items are the parameters to
2570 substitute for the placeholders in that fragment.
2575 my($class, %opt) = @_;
2576 my $ornull = $opt{'ornull'};
2578 my $conf = new FS::Conf;
2580 # '?' placeholders in _location_sql_where
2583 @bill_param = qw( county county state state state country );
2585 @bill_param = qw( county state state country );
2587 unshift @bill_param, 'county'; # unless $nec;
2591 if ( $conf->exists('tax-ship_address') ) {
2594 ( ( ship_last IS NULL OR ship_last = '' )
2595 AND ". _location_sql_where('cust_main', '', $ornull ). "
2597 OR ( ship_last IS NOT NULL AND ship_last != ''
2598 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2601 # AND payby != 'COMP'
2603 @main_param = ( @bill_param, @bill_param );
2607 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2608 @main_param = @bill_param;
2614 if ( $conf->exists('tax-pkg_address') ) {
2616 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2619 ( cust_pkg.locationnum IS NULL AND $main_where )
2620 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2623 @param = ( @main_param, @bill_param );
2627 $where = $main_where;
2628 @param = @main_param;
2636 #subroutine, helper for location_sql
2637 sub _location_sql_where {
2639 my $prefix = @_ ? shift : '';
2640 my $ornull = @_ ? shift : '';
2642 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2644 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2646 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2647 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2650 ( $table.${prefix}county = ? $or_empty_county $ornull )
2651 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2652 AND $table.${prefix}country = ?
2660 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2662 CUSTNUM is a customer (see L<FS::cust_main>)
2664 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2665 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2668 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2669 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2670 new billing items. An error is returned if this is not possible (see
2671 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2674 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2675 newly-created cust_pkg objects.
2677 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2678 and inserted. Multiple FS::pkg_referral records can be created by
2679 setting I<refnum> to an array reference of refnums or a hash reference with
2680 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2681 record will be created corresponding to cust_main.refnum.
2686 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2688 my $conf = new FS::Conf;
2690 # Transactionize this whole mess
2691 local $SIG{HUP} = 'IGNORE';
2692 local $SIG{INT} = 'IGNORE';
2693 local $SIG{QUIT} = 'IGNORE';
2694 local $SIG{TERM} = 'IGNORE';
2695 local $SIG{TSTP} = 'IGNORE';
2696 local $SIG{PIPE} = 'IGNORE';
2698 my $oldAutoCommit = $FS::UID::AutoCommit;
2699 local $FS::UID::AutoCommit = 0;
2703 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2704 # return "Customer not found: $custnum" unless $cust_main;
2706 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2709 my $change = scalar(@old_cust_pkg) != 0;
2712 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2714 my $err_or_cust_pkg =
2715 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2716 'refnum' => $refnum,
2719 unless (ref($err_or_cust_pkg)) {
2720 $dbh->rollback if $oldAutoCommit;
2721 return $err_or_cust_pkg;
2724 push @$return_cust_pkg, $err_or_cust_pkg;
2729 # Create the new packages.
2730 foreach my $pkgpart (@$pkgparts) {
2731 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2732 pkgpart => $pkgpart,
2736 $error = $cust_pkg->insert( 'change' => $change );
2738 $dbh->rollback if $oldAutoCommit;
2741 push @$return_cust_pkg, $cust_pkg;
2743 # $return_cust_pkg now contains refs to all of the newly
2746 # Transfer services and cancel old packages.
2747 foreach my $old_pkg (@old_cust_pkg) {
2749 foreach my $new_pkg (@$return_cust_pkg) {
2750 $error = $old_pkg->transfer($new_pkg);
2751 if ($error and $error == 0) {
2752 # $old_pkg->transfer failed.
2753 $dbh->rollback if $oldAutoCommit;
2758 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2759 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2760 foreach my $new_pkg (@$return_cust_pkg) {
2761 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2762 if ($error and $error == 0) {
2763 # $old_pkg->transfer failed.
2764 $dbh->rollback if $oldAutoCommit;
2771 # Transfers were successful, but we went through all of the
2772 # new packages and still had services left on the old package.
2773 # We can't cancel the package under the circumstances, so abort.
2774 $dbh->rollback if $oldAutoCommit;
2775 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2777 $error = $old_pkg->cancel( quiet=>1 );
2783 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2787 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2789 A bulk change method to change packages for multiple customers.
2791 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2792 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2795 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2796 replace. The services (see L<FS::cust_svc>) are moved to the
2797 new billing items. An error is returned if this is not possible (see
2800 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2801 newly-created cust_pkg objects.
2806 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2808 # Transactionize this whole mess
2809 local $SIG{HUP} = 'IGNORE';
2810 local $SIG{INT} = 'IGNORE';
2811 local $SIG{QUIT} = 'IGNORE';
2812 local $SIG{TERM} = 'IGNORE';
2813 local $SIG{TSTP} = 'IGNORE';
2814 local $SIG{PIPE} = 'IGNORE';
2816 my $oldAutoCommit = $FS::UID::AutoCommit;
2817 local $FS::UID::AutoCommit = 0;
2821 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2824 while(scalar(@old_cust_pkg)) {
2826 my $custnum = $old_cust_pkg[0]->custnum;
2827 my (@remove) = map { $_->pkgnum }
2828 grep { $_->custnum == $custnum } @old_cust_pkg;
2829 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2831 my $error = order $custnum, $pkgparts, \@remove, \@return;
2833 push @errors, $error
2835 push @$return_cust_pkg, @return;
2838 if (scalar(@errors)) {
2839 $dbh->rollback if $oldAutoCommit;
2840 return join(' / ', @errors);
2843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2849 Associates this package with a (suspension or cancellation) reason (see
2850 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2853 Available options are:
2859 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.
2863 the access_user (see L<FS::access_user>) providing the reason
2871 the action (cancel, susp, adjourn, expire) associated with the reason
2875 If there is an error, returns the error, otherwise returns false.
2880 my ($self, %options) = @_;
2882 my $otaker = $options{reason_otaker} ||
2883 $FS::CurrentUser::CurrentUser->username;
2886 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2890 } elsif ( ref($options{'reason'}) ) {
2892 return 'Enter a new reason (or select an existing one)'
2893 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2895 my $reason = new FS::reason({
2896 'reason_type' => $options{'reason'}->{'typenum'},
2897 'reason' => $options{'reason'}->{'reason'},
2899 my $error = $reason->insert;
2900 return $error if $error;
2902 $reasonnum = $reason->reasonnum;
2905 return "Unparsable reason: ". $options{'reason'};
2908 my $cust_pkg_reason =
2909 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2910 'reasonnum' => $reasonnum,
2911 'otaker' => $otaker,
2912 'action' => substr(uc($options{'action'}),0,1),
2913 'date' => $options{'date'}
2918 $cust_pkg_reason->insert;
2921 =item set_usage USAGE_VALUE_HASHREF
2923 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2924 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2925 upbytes, downbytes, and totalbytes are appropriate keys.
2927 All svc_accts which are part of this package have their values reset.
2932 my ($self, $valueref, %opt) = @_;
2934 foreach my $cust_svc ($self->cust_svc){
2935 my $svc_x = $cust_svc->svc_x;
2936 $svc_x->set_usage($valueref, %opt)
2937 if $svc_x->can("set_usage");
2941 =item recharge USAGE_VALUE_HASHREF
2943 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2944 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2945 upbytes, downbytes, and totalbytes are appropriate keys.
2947 All svc_accts which are part of this package have their values incremented.
2952 my ($self, $valueref) = @_;
2954 foreach my $cust_svc ($self->cust_svc){
2955 my $svc_x = $cust_svc->svc_x;
2956 $svc_x->recharge($valueref)
2957 if $svc_x->can("recharge");
2965 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2967 In sub order, the @pkgparts array (passed by reference) is clobbered.
2969 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2970 method to pass dates to the recur_prog expression, it should do so.
2972 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2973 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2974 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2975 configuration values. Probably need a subroutine which decides what to do
2976 based on whether or not we've fetched the user yet, rather than a hash. See
2977 FS::UID and the TODO.
2979 Now that things are transactional should the check in the insert method be
2984 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2985 L<FS::pkg_svc>, schema.html from the base documentation