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 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1192 if ($self->pkgpart != $cust_pkg->pkgpart) {
1193 my $part_pkg = $cust_pkg->part_pkg;
1194 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1198 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1201 $dbh->rollback if $oldAutoCommit;
1202 return "Error setting usage values: $error";
1206 #Good to go, cancel old package.
1207 $error = $self->cancel( quiet=>1 );
1213 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1220 Returns the last bill date, or if there is no last bill date, the setup date.
1221 Useful for billing metered services.
1227 return $self->setfield('last_bill', $_[0]) if @_;
1228 return $self->getfield('last_bill') if $self->getfield('last_bill');
1229 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1230 'edate' => $self->bill, } );
1231 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1234 =item last_cust_pkg_reason ACTION
1236 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1237 Returns false if there is no reason or the package is not currenly ACTION'd
1238 ACTION is one of adjourn, susp, cancel, or expire.
1242 sub last_cust_pkg_reason {
1243 my ( $self, $action ) = ( shift, shift );
1244 my $date = $self->get($action);
1246 'table' => 'cust_pkg_reason',
1247 'hashref' => { 'pkgnum' => $self->pkgnum,
1248 'action' => substr(uc($action), 0, 1),
1251 'order_by' => 'ORDER BY num DESC LIMIT 1',
1255 =item last_reason ACTION
1257 Returns the most recent ACTION FS::reason associated with the package.
1258 Returns false if there is no reason or the package is not currenly ACTION'd
1259 ACTION is one of adjourn, susp, cancel, or expire.
1264 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1265 $cust_pkg_reason->reason
1266 if $cust_pkg_reason;
1271 Returns the definition for this billing item, as an FS::part_pkg object (see
1278 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1279 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1280 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1285 Returns the cancelled package this package was changed from, if any.
1291 return '' unless $self->change_pkgnum;
1292 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1297 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1304 $self->part_pkg->calc_setup($self, @_);
1309 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1316 $self->part_pkg->calc_recur($self, @_);
1321 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1328 $self->part_pkg->calc_remain($self, @_);
1333 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1340 $self->part_pkg->calc_cancel($self, @_);
1345 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1351 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1354 =item cust_pkg_detail [ DETAILTYPE ]
1356 Returns any customer package details for this package (see
1357 L<FS::cust_pkg_detail>).
1359 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1363 sub cust_pkg_detail {
1365 my %hash = ( 'pkgnum' => $self->pkgnum );
1366 $hash{detailtype} = shift if @_;
1368 'table' => 'cust_pkg_detail',
1369 'hashref' => \%hash,
1370 'order_by' => 'ORDER BY weight, pkgdetailnum',
1374 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1376 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1378 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1380 If there is an error, returns the error, otherwise returns false.
1384 sub set_cust_pkg_detail {
1385 my( $self, $detailtype, @details ) = @_;
1387 local $SIG{HUP} = 'IGNORE';
1388 local $SIG{INT} = 'IGNORE';
1389 local $SIG{QUIT} = 'IGNORE';
1390 local $SIG{TERM} = 'IGNORE';
1391 local $SIG{TSTP} = 'IGNORE';
1392 local $SIG{PIPE} = 'IGNORE';
1394 my $oldAutoCommit = $FS::UID::AutoCommit;
1395 local $FS::UID::AutoCommit = 0;
1398 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1399 my $error = $current->delete;
1401 $dbh->rollback if $oldAutoCommit;
1402 return "error removing old detail: $error";
1406 foreach my $detail ( @details ) {
1407 my $cust_pkg_detail = new FS::cust_pkg_detail {
1408 'pkgnum' => $self->pkgnum,
1409 'detailtype' => $detailtype,
1410 'detail' => $detail,
1412 my $error = $cust_pkg_detail->insert;
1414 $dbh->rollback if $oldAutoCommit;
1415 return "error adding new detail: $error";
1420 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1427 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1431 #false laziness w/cust_bill.pm
1435 'table' => 'cust_event',
1436 'addl_from' => 'JOIN part_event USING ( eventpart )',
1437 'hashref' => { 'tablenum' => $self->pkgnum },
1438 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1442 =item num_cust_event
1444 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1448 #false laziness w/cust_bill.pm
1449 sub num_cust_event {
1452 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1453 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1454 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1455 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1456 $sth->fetchrow_arrayref->[0];
1459 =item cust_svc [ SVCPART ]
1461 Returns the services for this package, as FS::cust_svc objects (see
1462 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1470 return () unless $self->num_cust_svc(@_);
1473 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1474 'svcpart' => shift, } );
1477 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1479 #if ( $self->{'_svcnum'} ) {
1480 # values %{ $self->{'_svcnum'}->cache };
1482 $self->_sort_cust_svc(
1483 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1489 =item overlimit [ SVCPART ]
1491 Returns the services for this package which have exceeded their
1492 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1493 is specified, return only the matching services.
1499 return () unless $self->num_cust_svc(@_);
1500 grep { $_->overlimit } $self->cust_svc(@_);
1503 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1505 Returns historical services for this package created before END TIMESTAMP and
1506 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1507 (see L<FS::h_cust_svc>).
1514 $self->_sort_cust_svc(
1515 [ qsearch( 'h_cust_svc',
1516 { 'pkgnum' => $self->pkgnum, },
1517 FS::h_cust_svc->sql_h_search(@_),
1523 sub _sort_cust_svc {
1524 my( $self, $arrayref ) = @_;
1527 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1529 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1530 'svcpart' => $_->svcpart } );
1532 $pkg_svc ? $pkg_svc->primary_svc : '',
1533 $pkg_svc ? $pkg_svc->quantity : 0,
1540 =item num_cust_svc [ SVCPART ]
1542 Returns the number of provisioned services for this package. If a svcpart is
1543 specified, counts only the matching services.
1550 return $self->{'_num_cust_svc'}
1552 && exists($self->{'_num_cust_svc'})
1553 && $self->{'_num_cust_svc'} =~ /\d/;
1555 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1558 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1559 $sql .= ' AND svcpart = ?' if @_;
1561 my $sth = dbh->prepare($sql) or die dbh->errstr;
1562 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1563 $sth->fetchrow_arrayref->[0];
1566 =item available_part_svc
1568 Returns a list of FS::part_svc objects representing services included in this
1569 package but not yet provisioned. Each FS::part_svc object also has an extra
1570 field, I<num_avail>, which specifies the number of available services.
1574 sub available_part_svc {
1576 grep { $_->num_avail > 0 }
1578 my $part_svc = $_->part_svc;
1579 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1580 $_->quantity - $self->num_cust_svc($_->svcpart);
1583 $self->part_pkg->pkg_svc;
1588 Returns a list of FS::part_svc objects representing provisioned and available
1589 services included in this package. Each FS::part_svc object also has the
1590 following extra fields:
1594 =item num_cust_svc (count)
1596 =item num_avail (quantity - count)
1598 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1601 label -> ($cust_svc->label)[1]
1610 #XXX some sort of sort order besides numeric by svcpart...
1611 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1613 my $part_svc = $pkg_svc->part_svc;
1614 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1615 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1616 $part_svc->{'Hash'}{'num_avail'} =
1617 max( 0, $pkg_svc->quantity - $num_cust_svc );
1618 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1619 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1621 } $self->part_pkg->pkg_svc;
1624 push @part_svc, map {
1626 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1627 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1628 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1629 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1630 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1632 } $self->extra_part_svc;
1638 =item extra_part_svc
1640 Returns a list of FS::part_svc objects corresponding to services in this
1641 package which are still provisioned but not (any longer) available in the
1646 sub extra_part_svc {
1649 my $pkgnum = $self->pkgnum;
1650 my $pkgpart = $self->pkgpart;
1653 # 'table' => 'part_svc',
1656 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1657 # WHERE pkg_svc.svcpart = part_svc.svcpart
1658 # AND pkg_svc.pkgpart = ?
1661 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1662 # LEFT JOIN cust_pkg USING ( pkgnum )
1663 # WHERE cust_svc.svcpart = part_svc.svcpart
1666 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1669 #seems to benchmark slightly faster...
1671 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1672 'table' => 'part_svc',
1674 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1675 AND pkg_svc.pkgpart = ?
1678 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1679 LEFT JOIN cust_pkg USING ( pkgnum )
1682 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1683 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1689 Returns a short status string for this package, currently:
1693 =item not yet billed
1695 =item one-time charge
1710 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1712 return 'cancelled' if $self->get('cancel');
1713 return 'suspended' if $self->susp;
1714 return 'not yet billed' unless $self->setup;
1715 return 'one-time charge' if $freq =~ /^(0|$)/;
1721 Class method that returns the list of possible status strings for packages
1722 (see L<the status method|/status>). For example:
1724 @statuses = FS::cust_pkg->statuses();
1728 tie my %statuscolor, 'Tie::IxHash',
1729 'not yet billed' => '000000',
1730 'one-time charge' => '000000',
1731 'active' => '00CC00',
1732 'suspended' => 'FF9900',
1733 'cancelled' => 'FF0000',
1737 my $self = shift; #could be class...
1738 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1739 # # mayble split btw one-time vs. recur
1745 Returns a hex triplet color string for this package's status.
1751 $statuscolor{$self->status};
1756 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1757 "pkg-comment" depending on user preference).
1763 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1764 $label = $self->pkgnum. ": $label"
1765 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1769 =item pkg_label_long
1771 Returns a long label for this package, adding the primary service's label to
1776 sub pkg_label_long {
1778 my $label = $self->pkg_label;
1779 my $cust_svc = $self->primary_cust_svc;
1780 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1784 =item primary_cust_svc
1786 Returns a primary service (as FS::cust_svc object) if one can be identified.
1790 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1792 sub primary_cust_svc {
1795 my @cust_svc = $self->cust_svc;
1797 return '' unless @cust_svc; #no serivces - irrelevant then
1799 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1801 # primary service as specified in the package definition
1802 # or exactly one service definition with quantity one
1803 my $svcpart = $self->part_pkg->svcpart;
1804 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1805 return $cust_svc[0] if scalar(@cust_svc) == 1;
1807 #couldn't identify one thing..
1813 Returns a list of lists, calling the label method for all services
1814 (see L<FS::cust_svc>) of this billing item.
1820 map { [ $_->label ] } $self->cust_svc;
1823 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1825 Like the labels method, but returns historical information on services that
1826 were active as of END_TIMESTAMP and (optionally) not cancelled before
1829 Returns a list of lists, calling the label method for all (historical) services
1830 (see L<FS::h_cust_svc>) of this billing item.
1836 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1841 Like labels, except returns a simple flat list, and shortens long
1842 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1843 identical services to one line that lists the service label and the number of
1844 individual services rather than individual items.
1849 shift->_labels_short( 'labels', @_ );
1852 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1854 Like h_labels, except returns a simple flat list, and shortens long
1855 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1856 identical services to one line that lists the service label and the number of
1857 individual services rather than individual items.
1861 sub h_labels_short {
1862 shift->_labels_short( 'h_labels', @_ );
1866 my( $self, $method ) = ( shift, shift );
1868 my $conf = new FS::Conf;
1869 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1872 #tie %labels, 'Tie::IxHash';
1873 push @{ $labels{$_->[0]} }, $_->[1]
1874 foreach $self->h_labels(@_);
1876 foreach my $label ( keys %labels ) {
1878 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1879 my $num = scalar(@values);
1880 if ( $num > $max_same_services ) {
1881 push @labels, "$label ($num)";
1883 push @labels, map { "$label: $_" } @values;
1893 Returns the parent customer object (see L<FS::cust_main>).
1899 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1904 Returns the location object, if any (see L<FS::cust_location>).
1910 return '' unless $self->locationnum;
1911 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1914 =item cust_location_or_main
1916 If this package is associated with a location, returns the locaiton (see
1917 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1921 sub cust_location_or_main {
1923 $self->cust_location || $self->cust_main;
1926 =item seconds_since TIMESTAMP
1928 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1929 package have been online since TIMESTAMP, according to the session monitor.
1931 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1932 L<Time::Local> and L<Date::Parse> for conversion functions.
1937 my($self, $since) = @_;
1940 foreach my $cust_svc (
1941 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1943 $seconds += $cust_svc->seconds_since($since);
1950 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1952 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1953 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1956 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1957 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1963 sub seconds_since_sqlradacct {
1964 my($self, $start, $end) = @_;
1968 foreach my $cust_svc (
1970 my $part_svc = $_->part_svc;
1971 $part_svc->svcdb eq 'svc_acct'
1972 && scalar($part_svc->part_export('sqlradius'));
1975 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1982 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1984 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1985 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1989 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1990 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1995 sub attribute_since_sqlradacct {
1996 my($self, $start, $end, $attrib) = @_;
2000 foreach my $cust_svc (
2002 my $part_svc = $_->part_svc;
2003 $part_svc->svcdb eq 'svc_acct'
2004 && scalar($part_svc->part_export('sqlradius'));
2007 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2019 my( $self, $value ) = @_;
2020 if ( defined($value) ) {
2021 $self->setfield('quantity', $value);
2023 $self->getfield('quantity') || 1;
2026 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2028 Transfers as many services as possible from this package to another package.
2030 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2031 object. The destination package must already exist.
2033 Services are moved only if the destination allows services with the correct
2034 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2035 this option with caution! No provision is made for export differences
2036 between the old and new service definitions. Probably only should be used
2037 when your exports for all service definitions of a given svcdb are identical.
2038 (attempt a transfer without it first, to move all possible svcpart-matching
2041 Any services that can't be moved remain in the original package.
2043 Returns an error, if there is one; otherwise, returns the number of services
2044 that couldn't be moved.
2049 my ($self, $dest_pkgnum, %opt) = @_;
2055 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2056 $dest = $dest_pkgnum;
2057 $dest_pkgnum = $dest->pkgnum;
2059 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2062 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2064 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2065 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2068 foreach my $cust_svc ($dest->cust_svc) {
2069 $target{$cust_svc->svcpart}--;
2072 my %svcpart2svcparts = ();
2073 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2074 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2075 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2076 next if exists $svcpart2svcparts{$svcpart};
2077 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2078 $svcpart2svcparts{$svcpart} = [
2080 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2082 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2083 'svcpart' => $_ } );
2085 $pkg_svc ? $pkg_svc->primary_svc : '',
2086 $pkg_svc ? $pkg_svc->quantity : 0,
2090 grep { $_ != $svcpart }
2092 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2094 warn "alternates for svcpart $svcpart: ".
2095 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2100 foreach my $cust_svc ($self->cust_svc) {
2101 if($target{$cust_svc->svcpart} > 0) {
2102 $target{$cust_svc->svcpart}--;
2103 my $new = new FS::cust_svc { $cust_svc->hash };
2104 $new->pkgnum($dest_pkgnum);
2105 my $error = $new->replace($cust_svc);
2106 return $error if $error;
2107 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2109 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2110 warn "alternates to consider: ".
2111 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2113 my @alternate = grep {
2114 warn "considering alternate svcpart $_: ".
2115 "$target{$_} available in new package\n"
2118 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2120 warn "alternate(s) found\n" if $DEBUG;
2121 my $change_svcpart = $alternate[0];
2122 $target{$change_svcpart}--;
2123 my $new = new FS::cust_svc { $cust_svc->hash };
2124 $new->svcpart($change_svcpart);
2125 $new->pkgnum($dest_pkgnum);
2126 my $error = $new->replace($cust_svc);
2127 return $error if $error;
2140 This method is deprecated. See the I<depend_jobnum> option to the insert and
2141 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2148 local $SIG{HUP} = 'IGNORE';
2149 local $SIG{INT} = 'IGNORE';
2150 local $SIG{QUIT} = 'IGNORE';
2151 local $SIG{TERM} = 'IGNORE';
2152 local $SIG{TSTP} = 'IGNORE';
2153 local $SIG{PIPE} = 'IGNORE';
2155 my $oldAutoCommit = $FS::UID::AutoCommit;
2156 local $FS::UID::AutoCommit = 0;
2159 foreach my $cust_svc ( $self->cust_svc ) {
2160 #false laziness w/svc_Common::insert
2161 my $svc_x = $cust_svc->svc_x;
2162 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2163 my $error = $part_export->export_insert($svc_x);
2165 $dbh->rollback if $oldAutoCommit;
2171 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2178 =head1 CLASS METHODS
2184 Returns an SQL expression identifying recurring packages.
2188 sub recurring_sql { "
2189 '0' != ( select freq from part_pkg
2190 where cust_pkg.pkgpart = part_pkg.pkgpart )
2195 Returns an SQL expression identifying one-time packages.
2200 '0' = ( select freq from part_pkg
2201 where cust_pkg.pkgpart = part_pkg.pkgpart )
2206 Returns an SQL expression identifying active packages.
2211 ". $_[0]->recurring_sql(). "
2212 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2213 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2216 =item not_yet_billed_sql
2218 Returns an SQL expression identifying packages which have not yet been billed.
2222 sub not_yet_billed_sql { "
2223 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2224 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2225 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2230 Returns an SQL expression identifying inactive packages (one-time packages
2231 that are otherwise unsuspended/uncancelled).
2235 sub inactive_sql { "
2236 ". $_[0]->onetime_sql(). "
2237 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2238 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2239 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2245 Returns an SQL expression identifying suspended packages.
2249 sub suspended_sql { susp_sql(@_); }
2251 #$_[0]->recurring_sql(). ' AND '.
2253 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2254 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2261 Returns an SQL exprression identifying cancelled packages.
2265 sub cancelled_sql { cancel_sql(@_); }
2267 #$_[0]->recurring_sql(). ' AND '.
2268 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2271 =item search_sql HASHREF
2275 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2276 Valid parameters are
2284 active, inactive, suspended, cancel (or cancelled)
2288 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2292 boolean selects custom packages
2298 pkgpart or arrayref or hashref of pkgparts
2302 arrayref of beginning and ending epoch date
2306 arrayref of beginning and ending epoch date
2310 arrayref of beginning and ending epoch date
2314 arrayref of beginning and ending epoch date
2318 arrayref of beginning and ending epoch date
2322 arrayref of beginning and ending epoch date
2326 arrayref of beginning and ending epoch date
2330 pkgnum or APKG_pkgnum
2334 a value suited to passing to FS::UI::Web::cust_header
2338 specifies the user for agent virtualization
2345 my ($class, $params) = @_;
2352 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2354 "cust_main.agentnum = $1";
2361 if ( $params->{'magic'} eq 'active'
2362 || $params->{'status'} eq 'active' ) {
2364 push @where, FS::cust_pkg->active_sql();
2366 } elsif ( $params->{'magic'} eq 'not yet billed'
2367 || $params->{'status'} eq 'not yet billed' ) {
2369 push @where, FS::cust_pkg->not_yet_billed_sql();
2371 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2372 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2374 push @where, FS::cust_pkg->inactive_sql();
2376 } elsif ( $params->{'magic'} eq 'suspended'
2377 || $params->{'status'} eq 'suspended' ) {
2379 push @where, FS::cust_pkg->suspended_sql();
2381 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2382 || $params->{'status'} =~ /^cancell?ed$/ ) {
2384 push @where, FS::cust_pkg->cancelled_sql();
2389 # parse package class
2392 #false lazinessish w/graph/cust_bill_pkg.cgi
2395 if ( exists($params->{'classnum'})
2396 && $params->{'classnum'} =~ /^(\d*)$/
2400 if ( $classnum ) { #a specific class
2401 push @where, "classnum = $classnum";
2403 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2404 #die "classnum $classnum not found!" unless $pkg_class[0];
2405 #$title .= $pkg_class[0]->classname.' ';
2407 } elsif ( $classnum eq '' ) { #the empty class
2409 push @where, "classnum IS NULL";
2410 #$title .= 'Empty class ';
2411 #@pkg_class = ( '(empty class)' );
2412 } elsif ( $classnum eq '0' ) {
2413 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2414 #push @pkg_class, '(empty class)';
2416 die "illegal classnum";
2422 # parse package report options
2425 my @report_option = ();
2426 if ( exists($params->{'report_option'})
2427 && $params->{'report_option'} =~ /^([,\d]*)$/
2430 @report_option = split(',', $1);
2433 if (@report_option) {
2434 # this will result in the empty set for the dangling comma case as it should
2436 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2437 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2438 AND optionname = 'report_option_$_'
2439 AND optionvalue = '1' )"
2449 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2455 if ( exists($params->{'censustract'}) ) {
2456 $params->{'censustract'} =~ /^([.\d]*)$/;
2457 my $censustract = "cust_main.censustract = '$1'";
2458 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2459 push @where, "( $censustract )";
2466 if ( ref($params->{'pkgpart'}) ) {
2469 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2470 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2471 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2472 @pkgpart = @{ $params->{'pkgpart'} };
2474 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2477 @pkgpart = grep /^(\d+)$/, @pkgpart;
2479 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')';
2481 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2482 push @where, "pkgpart = $1";
2491 #false laziness w/report_cust_pkg.html
2494 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2495 'active' => { 'susp'=>1, 'cancel'=>1 },
2496 'suspended' => { 'cancel' => 1 },
2501 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2503 next unless exists($params->{$field});
2505 my($beginning, $ending) = @{$params->{$field}};
2507 next if $beginning == 0 && $ending == 4294967295;
2510 "cust_pkg.$field IS NOT NULL",
2511 "cust_pkg.$field >= $beginning",
2512 "cust_pkg.$field <= $ending";
2514 $orderby ||= "ORDER BY cust_pkg.$field";
2518 $orderby ||= 'ORDER BY bill';
2521 # parse magic, legacy, etc.
2524 if ( $params->{'magic'} &&
2525 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2528 $orderby = 'ORDER BY pkgnum';
2530 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2531 push @where, "pkgpart = $1";
2534 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2536 $orderby = 'ORDER BY pkgnum';
2538 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2540 $orderby = 'ORDER BY pkgnum';
2543 SELECT count(*) FROM pkg_svc
2544 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2545 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2546 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2547 AND cust_svc.svcpart = pkg_svc.svcpart
2554 # setup queries, links, subs, etc. for the search
2557 # here is the agent virtualization
2558 if ($params->{CurrentUser}) {
2560 qsearchs('access_user', { username => $params->{CurrentUser} });
2563 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2568 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2571 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2573 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2574 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2575 'LEFT JOIN pkg_class USING ( classnum ) ';
2577 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2580 'table' => 'cust_pkg',
2582 'select' => join(', ',
2584 ( map "part_pkg.$_", qw( pkg freq ) ),
2585 'pkg_class.classname',
2586 'cust_main.custnum as cust_main_custnum',
2587 FS::UI::Web::cust_sql_fields(
2588 $params->{'cust_fields'}
2591 'extra_sql' => "$extra_sql $orderby",
2592 'addl_from' => $addl_from,
2593 'count_query' => $count_query,
2600 Returns a list: the first item is an SQL fragment identifying matching
2601 packages/customers via location (taking into account shipping and package
2602 address taxation, if enabled), and subsequent items are the parameters to
2603 substitute for the placeholders in that fragment.
2608 my($class, %opt) = @_;
2609 my $ornull = $opt{'ornull'};
2611 my $conf = new FS::Conf;
2613 # '?' placeholders in _location_sql_where
2616 @bill_param = qw( county county state state state country );
2618 @bill_param = qw( county state state country );
2620 unshift @bill_param, 'county'; # unless $nec;
2624 if ( $conf->exists('tax-ship_address') ) {
2627 ( ( ship_last IS NULL OR ship_last = '' )
2628 AND ". _location_sql_where('cust_main', '', $ornull ). "
2630 OR ( ship_last IS NOT NULL AND ship_last != ''
2631 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2634 # AND payby != 'COMP'
2636 @main_param = ( @bill_param, @bill_param );
2640 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2641 @main_param = @bill_param;
2647 if ( $conf->exists('tax-pkg_address') ) {
2649 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2652 ( cust_pkg.locationnum IS NULL AND $main_where )
2653 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2656 @param = ( @main_param, @bill_param );
2660 $where = $main_where;
2661 @param = @main_param;
2669 #subroutine, helper for location_sql
2670 sub _location_sql_where {
2672 my $prefix = @_ ? shift : '';
2673 my $ornull = @_ ? shift : '';
2675 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2677 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2679 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2680 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2683 ( $table.${prefix}county = ? $or_empty_county $ornull )
2684 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2685 AND $table.${prefix}country = ?
2693 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2695 CUSTNUM is a customer (see L<FS::cust_main>)
2697 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2698 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2701 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2702 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2703 new billing items. An error is returned if this is not possible (see
2704 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2707 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2708 newly-created cust_pkg objects.
2710 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2711 and inserted. Multiple FS::pkg_referral records can be created by
2712 setting I<refnum> to an array reference of refnums or a hash reference with
2713 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2714 record will be created corresponding to cust_main.refnum.
2719 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2721 my $conf = new FS::Conf;
2723 # Transactionize this whole mess
2724 local $SIG{HUP} = 'IGNORE';
2725 local $SIG{INT} = 'IGNORE';
2726 local $SIG{QUIT} = 'IGNORE';
2727 local $SIG{TERM} = 'IGNORE';
2728 local $SIG{TSTP} = 'IGNORE';
2729 local $SIG{PIPE} = 'IGNORE';
2731 my $oldAutoCommit = $FS::UID::AutoCommit;
2732 local $FS::UID::AutoCommit = 0;
2736 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2737 # return "Customer not found: $custnum" unless $cust_main;
2739 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2742 my $change = scalar(@old_cust_pkg) != 0;
2745 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2747 my $err_or_cust_pkg =
2748 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2749 'refnum' => $refnum,
2752 unless (ref($err_or_cust_pkg)) {
2753 $dbh->rollback if $oldAutoCommit;
2754 return $err_or_cust_pkg;
2757 push @$return_cust_pkg, $err_or_cust_pkg;
2762 # Create the new packages.
2763 foreach my $pkgpart (@$pkgparts) {
2764 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2765 pkgpart => $pkgpart,
2769 $error = $cust_pkg->insert( 'change' => $change );
2771 $dbh->rollback if $oldAutoCommit;
2774 push @$return_cust_pkg, $cust_pkg;
2776 # $return_cust_pkg now contains refs to all of the newly
2779 # Transfer services and cancel old packages.
2780 foreach my $old_pkg (@old_cust_pkg) {
2782 foreach my $new_pkg (@$return_cust_pkg) {
2783 $error = $old_pkg->transfer($new_pkg);
2784 if ($error and $error == 0) {
2785 # $old_pkg->transfer failed.
2786 $dbh->rollback if $oldAutoCommit;
2791 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2792 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2793 foreach my $new_pkg (@$return_cust_pkg) {
2794 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2795 if ($error and $error == 0) {
2796 # $old_pkg->transfer failed.
2797 $dbh->rollback if $oldAutoCommit;
2804 # Transfers were successful, but we went through all of the
2805 # new packages and still had services left on the old package.
2806 # We can't cancel the package under the circumstances, so abort.
2807 $dbh->rollback if $oldAutoCommit;
2808 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2810 $error = $old_pkg->cancel( quiet=>1 );
2816 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2820 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2822 A bulk change method to change packages for multiple customers.
2824 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2825 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2828 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2829 replace. The services (see L<FS::cust_svc>) are moved to the
2830 new billing items. An error is returned if this is not possible (see
2833 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2834 newly-created cust_pkg objects.
2839 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2841 # Transactionize this whole mess
2842 local $SIG{HUP} = 'IGNORE';
2843 local $SIG{INT} = 'IGNORE';
2844 local $SIG{QUIT} = 'IGNORE';
2845 local $SIG{TERM} = 'IGNORE';
2846 local $SIG{TSTP} = 'IGNORE';
2847 local $SIG{PIPE} = 'IGNORE';
2849 my $oldAutoCommit = $FS::UID::AutoCommit;
2850 local $FS::UID::AutoCommit = 0;
2854 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2857 while(scalar(@old_cust_pkg)) {
2859 my $custnum = $old_cust_pkg[0]->custnum;
2860 my (@remove) = map { $_->pkgnum }
2861 grep { $_->custnum == $custnum } @old_cust_pkg;
2862 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2864 my $error = order $custnum, $pkgparts, \@remove, \@return;
2866 push @errors, $error
2868 push @$return_cust_pkg, @return;
2871 if (scalar(@errors)) {
2872 $dbh->rollback if $oldAutoCommit;
2873 return join(' / ', @errors);
2876 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2882 Associates this package with a (suspension or cancellation) reason (see
2883 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2886 Available options are:
2892 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.
2896 the access_user (see L<FS::access_user>) providing the reason
2904 the action (cancel, susp, adjourn, expire) associated with the reason
2908 If there is an error, returns the error, otherwise returns false.
2913 my ($self, %options) = @_;
2915 my $otaker = $options{reason_otaker} ||
2916 $FS::CurrentUser::CurrentUser->username;
2919 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2923 } elsif ( ref($options{'reason'}) ) {
2925 return 'Enter a new reason (or select an existing one)'
2926 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2928 my $reason = new FS::reason({
2929 'reason_type' => $options{'reason'}->{'typenum'},
2930 'reason' => $options{'reason'}->{'reason'},
2932 my $error = $reason->insert;
2933 return $error if $error;
2935 $reasonnum = $reason->reasonnum;
2938 return "Unparsable reason: ". $options{'reason'};
2941 my $cust_pkg_reason =
2942 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2943 'reasonnum' => $reasonnum,
2944 'otaker' => $otaker,
2945 'action' => substr(uc($options{'action'}),0,1),
2946 'date' => $options{'date'}
2951 $cust_pkg_reason->insert;
2954 =item set_usage USAGE_VALUE_HASHREF
2956 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2957 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2958 upbytes, downbytes, and totalbytes are appropriate keys.
2960 All svc_accts which are part of this package have their values reset.
2965 my ($self, $valueref, %opt) = @_;
2967 foreach my $cust_svc ($self->cust_svc){
2968 my $svc_x = $cust_svc->svc_x;
2969 $svc_x->set_usage($valueref, %opt)
2970 if $svc_x->can("set_usage");
2974 =item recharge USAGE_VALUE_HASHREF
2976 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2977 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2978 upbytes, downbytes, and totalbytes are appropriate keys.
2980 All svc_accts which are part of this package have their values incremented.
2985 my ($self, $valueref) = @_;
2987 foreach my $cust_svc ($self->cust_svc){
2988 my $svc_x = $cust_svc->svc_x;
2989 $svc_x->recharge($valueref)
2990 if $svc_x->can("recharge");
2998 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3000 In sub order, the @pkgparts array (passed by reference) is clobbered.
3002 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3003 method to pass dates to the recur_prog expression, it should do so.
3005 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3006 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3007 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3008 configuration values. Probably need a subroutine which decides what to do
3009 based on whether or not we've fetched the user yet, rather than a hash. See
3010 FS::UID and the TODO.
3012 Now that things are transactional should the check in the insert method be
3017 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3018 L<FS::pkg_svc>, schema.html from the base documentation