4 use vars qw(@ISA $disable_agentcheck $DEBUG);
5 use Scalar::Util qw( blessed );
6 use List::Util qw(max);
8 use FS::UID qw( getotaker dbh );
9 use FS::Misc qw( send_email );
10 use FS::Record qw( qsearch qsearchs );
12 use FS::cust_main_Mixin;
16 use FS::cust_location;
19 use FS::cust_bill_pkg;
20 use FS::cust_pkg_detail;
25 use FS::cust_pkg_reason;
29 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
31 # because they load configuration by setting FS::UID::callback (see TODO)
37 # for sending cancel emails in sub cancel
40 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
44 $disable_agentcheck = 0;
48 my ( $hashref, $cache ) = @_;
49 #if ( $hashref->{'pkgpart'} ) {
50 if ( $hashref->{'pkg'} ) {
51 # #@{ $self->{'_pkgnum'} } = ();
52 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
53 # $self->{'_pkgpart'} = $subcache;
54 # #push @{ $self->{'_pkgnum'} },
55 # FS::part_pkg->new_or_cached($hashref, $subcache);
56 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
58 if ( exists $hashref->{'svcnum'} ) {
59 #@{ $self->{'_pkgnum'} } = ();
60 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
61 $self->{'_svcnum'} = $subcache;
62 #push @{ $self->{'_pkgnum'} },
63 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
69 FS::cust_pkg - Object methods for cust_pkg objects
75 $record = new FS::cust_pkg \%hash;
76 $record = new FS::cust_pkg { 'column' => 'value' };
78 $error = $record->insert;
80 $error = $new_record->replace($old_record);
82 $error = $record->delete;
84 $error = $record->check;
86 $error = $record->cancel;
88 $error = $record->suspend;
90 $error = $record->unsuspend;
92 $part_pkg = $record->part_pkg;
94 @labels = $record->labels;
96 $seconds = $record->seconds_since($timestamp);
98 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
99 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
103 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
104 inherits from FS::Record. The following fields are currently supported:
110 Primary key (assigned automatically for new billing items)
114 Customer (see L<FS::cust_main>)
118 Billing item definition (see L<FS::part_pkg>)
122 Optional link to package location (see L<FS::location>)
130 date (next bill date)
154 order taker (assigned automatically if null, see L<FS::UID>)
158 If this field is set to 1, disables the automatic
159 unsuspension of this package when using the B<unsuspendauto> config option.
163 If not set, defaults to 1
167 Date of change from previous package
177 =item change_locationnum
183 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
184 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
185 L<Time::Local> and L<Date::Parse> for conversion functions.
193 Create a new billing item. To add the item to the database, see L<"insert">.
197 sub table { 'cust_pkg'; }
198 sub cust_linked { $_[0]->cust_main_custnum; }
199 sub cust_unlinked_msg {
201 "WARNING: can't find cust_main.custnum ". $self->custnum.
202 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
205 =item insert [ OPTION => VALUE ... ]
207 Adds this billing item to the database ("Orders" the item). If there is an
208 error, returns the error, otherwise returns false.
210 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
211 will be used to look up the package definition and agent restrictions will be
214 If the additional field I<refnum> is defined, an FS::pkg_referral record will
215 be created and inserted. Multiple FS::pkg_referral records can be created by
216 setting I<refnum> to an array reference of refnums or a hash reference with
217 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
218 record will be created corresponding to cust_main.refnum.
220 The following options are available:
226 If set true, supresses any referral credit to a referring customer.
230 cust_pkg_option records will be created
237 my( $self, %options ) = @_;
239 local $SIG{HUP} = 'IGNORE';
240 local $SIG{INT} = 'IGNORE';
241 local $SIG{QUIT} = 'IGNORE';
242 local $SIG{TERM} = 'IGNORE';
243 local $SIG{TSTP} = 'IGNORE';
244 local $SIG{PIPE} = 'IGNORE';
246 my $oldAutoCommit = $FS::UID::AutoCommit;
247 local $FS::UID::AutoCommit = 0;
250 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
252 $dbh->rollback if $oldAutoCommit;
256 $self->refnum($self->cust_main->refnum) unless $self->refnum;
257 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
258 $self->process_m2m( 'link_table' => 'pkg_referral',
259 'target_table' => 'part_referral',
260 'params' => $self->refnum,
263 #if ( $self->reg_code ) {
264 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
265 # $error = $reg_code->delete;
267 # $dbh->rollback if $oldAutoCommit;
272 my $conf = new FS::Conf;
274 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
275 my $queue = new FS::queue {
276 'job' => 'FS::cust_main::queueable_print',
278 $error = $queue->insert(
279 'custnum' => $self->custnum,
280 'template' => 'welcome_letter',
284 warn "can't send welcome letter: $error";
289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
296 This method now works but you probably shouldn't use it.
298 You don't want to delete billing items, because there would then be no record
299 the customer ever purchased the item. Instead, see the cancel method.
304 # return "Can't delete cust_pkg records!";
307 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
309 Replaces the OLD_RECORD with this one in the database. If there is an error,
310 returns the error, otherwise returns false.
312 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
314 Changing pkgpart may have disasterous effects. See the order subroutine.
316 setup and bill are normally updated by calling the bill method of a customer
317 object (see L<FS::cust_main>).
319 suspend is normally updated by the suspend and unsuspend methods.
321 cancel is normally updated by the cancel method (and also the order subroutine
324 Available options are:
330 can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
334 the access_user (see L<FS::access_user>) providing the reason
338 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
347 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
352 ( ref($_[0]) eq 'HASH' )
356 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
357 return "Can't change otaker!" if $old->otaker ne $new->otaker;
360 #return "Can't change setup once it exists!"
361 # if $old->getfield('setup') &&
362 # $old->getfield('setup') != $new->getfield('setup');
364 #some logic for bill, susp, cancel?
366 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
368 local $SIG{HUP} = 'IGNORE';
369 local $SIG{INT} = 'IGNORE';
370 local $SIG{QUIT} = 'IGNORE';
371 local $SIG{TERM} = 'IGNORE';
372 local $SIG{TSTP} = 'IGNORE';
373 local $SIG{PIPE} = 'IGNORE';
375 my $oldAutoCommit = $FS::UID::AutoCommit;
376 local $FS::UID::AutoCommit = 0;
379 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
380 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
381 my $error = $new->insert_reason(
382 'reason' => $options->{'reason'},
383 'date' => $new->$method,
385 'reason_otaker' => $options->{'reason_otaker'},
388 dbh->rollback if $oldAutoCommit;
389 return "Error inserting cust_pkg_reason: $error";
394 #save off and freeze RADIUS attributes for any associated svc_acct records
396 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
398 #also check for specific exports?
399 # to avoid spurious modify export events
400 @svc_acct = map { $_->svc_x }
401 grep { $_->part_svc->svcdb eq 'svc_acct' }
404 $_->snapshot foreach @svc_acct;
408 my $error = $new->SUPER::replace($old,
409 $options->{options} ? $options->{options} : ()
412 $dbh->rollback if $oldAutoCommit;
416 #for prepaid packages,
417 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
418 foreach my $old_svc_acct ( @svc_acct ) {
419 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
420 my $s_error = $new_svc_acct->replace($old_svc_acct);
422 $dbh->rollback if $oldAutoCommit;
427 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
434 Checks all fields to make sure this is a valid billing item. If there is an
435 error, returns the error, otherwise returns false. Called by the insert and
443 $self->locationnum('')
444 if defined($self->locationnum) && length($self->locationnum)
445 && ( $self->locationnum == 0 || $self->locationnum == -1 );
448 $self->ut_numbern('pkgnum')
449 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
450 || $self->ut_numbern('pkgpart')
451 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
452 || $self->ut_numbern('setup')
453 || $self->ut_numbern('bill')
454 || $self->ut_numbern('susp')
455 || $self->ut_numbern('cancel')
456 || $self->ut_numbern('adjourn')
457 || $self->ut_numbern('expire')
459 return $error if $error;
461 if ( $self->reg_code ) {
463 unless ( grep { $self->pkgpart == $_->pkgpart }
464 map { $_->reg_code_pkg }
465 qsearchs( 'reg_code', { 'code' => $self->reg_code,
466 'agentnum' => $self->cust_main->agentnum })
468 return "Unknown registration code";
471 } elsif ( $self->promo_code ) {
474 qsearchs('part_pkg', {
475 'pkgpart' => $self->pkgpart,
476 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
478 return 'Unknown promotional code' unless $promo_part_pkg;
482 unless ( $disable_agentcheck ) {
484 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
485 my $pkgpart_href = $agent->pkgpart_hashref;
486 return "agent ". $agent->agentnum.
487 " can't purchase pkgpart ". $self->pkgpart
488 unless $pkgpart_href->{ $self->pkgpart };
491 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
492 return $error if $error;
496 $self->otaker(getotaker) unless $self->otaker;
497 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
500 if ( $self->dbdef_table->column('manual_flag') ) {
501 $self->manual_flag('') if $self->manual_flag eq ' ';
502 $self->manual_flag =~ /^([01]?)$/
503 or return "Illegal manual_flag ". $self->manual_flag;
504 $self->manual_flag($1);
510 =item cancel [ OPTION => VALUE ... ]
512 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
513 in this package, then cancels the package itself (sets the cancel field to
516 Available options are:
520 =item quiet - can be set true to supress email cancellation notices.
522 =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.
524 =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.
526 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
530 If there is an error, returns the error, otherwise returns false.
535 my( $self, %options ) = @_;
538 warn "cust_pkg::cancel called with options".
539 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
542 local $SIG{HUP} = 'IGNORE';
543 local $SIG{INT} = 'IGNORE';
544 local $SIG{QUIT} = 'IGNORE';
545 local $SIG{TERM} = 'IGNORE';
546 local $SIG{TSTP} = 'IGNORE';
547 local $SIG{PIPE} = 'IGNORE';
549 my $oldAutoCommit = $FS::UID::AutoCommit;
550 local $FS::UID::AutoCommit = 0;
553 my $old = $self->select_for_update;
555 if ( $old->get('cancel') || $self->get('cancel') ) {
556 dbh->rollback if $oldAutoCommit;
557 return ""; # no error
560 my $date = $options{date} if $options{date}; # expire/cancel later
561 $date = '' if ($date && $date <= time); # complain instead?
563 my $cancel_time = $options{'time'} || time;
565 if ( $options{'reason'} ) {
566 $error = $self->insert_reason( 'reason' => $options{'reason'},
567 'action' => $date ? 'expire' : 'cancel',
568 'date' => $date ? $date : $cancel_time,
569 'reason_otaker' => $options{'reason_otaker'},
572 dbh->rollback if $oldAutoCommit;
573 return "Error inserting cust_pkg_reason: $error";
579 foreach my $cust_svc (
582 sort { $a->[1] <=> $b->[1] }
583 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
584 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
587 my $error = $cust_svc->cancel;
590 $dbh->rollback if $oldAutoCommit;
591 return "Error cancelling cust_svc: $error";
595 # Add a credit for remaining service
596 my $remaining_value = $self->calc_remain(time=>$cancel_time);
597 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
598 my $conf = new FS::Conf;
599 my $error = $self->cust_main->credit(
601 'Credit for unused time on '. $self->part_pkg->pkg,
602 'reason_type' => $conf->config('cancel_credit_type'),
605 $dbh->rollback if $oldAutoCommit;
606 return "Error crediting customer \$$remaining_value for unused time on".
607 $self->part_pkg->pkg. ": $error";
612 my %hash = $self->hash;
613 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
614 my $new = new FS::cust_pkg ( \%hash );
615 $error = $new->replace( $self, options => { $self->options } );
617 $dbh->rollback if $oldAutoCommit;
621 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
622 return '' if $date; #no errors
624 my $conf = new FS::Conf;
625 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
626 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
627 my $conf = new FS::Conf;
628 my $error = send_email(
629 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
630 'to' => \@invoicing_list,
631 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
632 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
634 #should this do something on errors?
641 =item cancel_if_expired [ NOW_TIMESTAMP ]
643 Cancels this package if its expire date has been reached.
647 sub cancel_if_expired {
649 my $time = shift || time;
650 return '' unless $self->expire && $self->expire <= $time;
651 my $error = $self->cancel;
653 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
654 $self->custnum. ": $error";
661 Cancels any pending expiration (sets the expire field to null).
663 If there is an error, returns the error, otherwise returns false.
668 my( $self, %options ) = @_;
671 local $SIG{HUP} = 'IGNORE';
672 local $SIG{INT} = 'IGNORE';
673 local $SIG{QUIT} = 'IGNORE';
674 local $SIG{TERM} = 'IGNORE';
675 local $SIG{TSTP} = 'IGNORE';
676 local $SIG{PIPE} = 'IGNORE';
678 my $oldAutoCommit = $FS::UID::AutoCommit;
679 local $FS::UID::AutoCommit = 0;
682 my $old = $self->select_for_update;
684 my $pkgnum = $old->pkgnum;
685 if ( $old->get('cancel') || $self->get('cancel') ) {
686 dbh->rollback if $oldAutoCommit;
687 return "Can't unexpire cancelled package $pkgnum";
688 # or at least it's pointless
691 unless ( $old->get('expire') && $self->get('expire') ) {
692 dbh->rollback if $oldAutoCommit;
693 return ""; # no error
696 my %hash = $self->hash;
697 $hash{'expire'} = '';
698 my $new = new FS::cust_pkg ( \%hash );
699 $error = $new->replace( $self, options => { $self->options } );
701 $dbh->rollback if $oldAutoCommit;
705 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
711 =item suspend [ OPTION => VALUE ... ]
713 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
714 package, then suspends the package itself (sets the susp field to now).
716 Available options are:
720 =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.
722 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
726 If there is an error, returns the error, otherwise returns false.
731 my( $self, %options ) = @_;
734 local $SIG{HUP} = 'IGNORE';
735 local $SIG{INT} = 'IGNORE';
736 local $SIG{QUIT} = 'IGNORE';
737 local $SIG{TERM} = 'IGNORE';
738 local $SIG{TSTP} = 'IGNORE';
739 local $SIG{PIPE} = 'IGNORE';
741 my $oldAutoCommit = $FS::UID::AutoCommit;
742 local $FS::UID::AutoCommit = 0;
745 my $old = $self->select_for_update;
747 my $pkgnum = $old->pkgnum;
748 if ( $old->get('cancel') || $self->get('cancel') ) {
749 dbh->rollback if $oldAutoCommit;
750 return "Can't suspend cancelled package $pkgnum";
753 if ( $old->get('susp') || $self->get('susp') ) {
754 dbh->rollback if $oldAutoCommit;
755 return ""; # no error # complain on adjourn?
758 my $date = $options{date} if $options{date}; # adjourn/suspend later
759 $date = '' if ($date && $date <= time); # complain instead?
761 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
762 dbh->rollback if $oldAutoCommit;
763 return "Package $pkgnum expires before it would be suspended.";
766 my $suspend_time = $options{'time'} || time;
768 if ( $options{'reason'} ) {
769 $error = $self->insert_reason( 'reason' => $options{'reason'},
770 'action' => $date ? 'adjourn' : 'suspend',
771 'date' => $date ? $date : $suspend_time,
772 'reason_otaker' => $options{'reason_otaker'},
775 dbh->rollback if $oldAutoCommit;
776 return "Error inserting cust_pkg_reason: $error";
784 foreach my $cust_svc (
785 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
787 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
789 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
790 $dbh->rollback if $oldAutoCommit;
791 return "Illegal svcdb value in part_svc!";
794 require "FS/$svcdb.pm";
796 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
798 $error = $svc->suspend;
800 $dbh->rollback if $oldAutoCommit;
803 my( $label, $value ) = $cust_svc->label;
804 push @labels, "$label: $value";
808 my $conf = new FS::Conf;
809 if ( $conf->config('suspend_email_admin') ) {
811 my $error = send_email(
812 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
813 #invoice_from ??? well as good as any
814 'to' => $conf->config('suspend_email_admin'),
815 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
817 "This is an automatic message from your Freeside installation\n",
818 "informing you that the following customer package has been suspended:\n",
820 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
821 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
822 ( map { "Service : $_\n" } @labels ),
827 warn "WARNING: can't send suspension admin email (suspending anyway): ".
835 my %hash = $self->hash;
837 $hash{'adjourn'} = $date;
839 $hash{'susp'} = $suspend_time;
841 my $new = new FS::cust_pkg ( \%hash );
842 $error = $new->replace( $self, options => { $self->options } );
844 $dbh->rollback if $oldAutoCommit;
848 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
853 =item unsuspend [ OPTION => VALUE ... ]
855 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
856 package, then unsuspends the package itself (clears the susp field and the
857 adjourn field if it is in the past).
859 Available options are:
863 =item adjust_next_bill
865 Can be set true to adjust the next bill date forward by
866 the amount of time the account was inactive. This was set true by default
867 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
868 explicitly requested. Price plans for which this makes sense (anniversary-date
869 based than prorate or subscription) could have an option to enable this
874 If there is an error, returns the error, otherwise returns false.
879 my( $self, %opt ) = @_;
882 local $SIG{HUP} = 'IGNORE';
883 local $SIG{INT} = 'IGNORE';
884 local $SIG{QUIT} = 'IGNORE';
885 local $SIG{TERM} = 'IGNORE';
886 local $SIG{TSTP} = 'IGNORE';
887 local $SIG{PIPE} = 'IGNORE';
889 my $oldAutoCommit = $FS::UID::AutoCommit;
890 local $FS::UID::AutoCommit = 0;
893 my $old = $self->select_for_update;
895 my $pkgnum = $old->pkgnum;
896 if ( $old->get('cancel') || $self->get('cancel') ) {
897 dbh->rollback if $oldAutoCommit;
898 return "Can't unsuspend cancelled package $pkgnum";
901 unless ( $old->get('susp') && $self->get('susp') ) {
902 dbh->rollback if $oldAutoCommit;
903 return ""; # no error # complain instead?
906 foreach my $cust_svc (
907 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
909 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
911 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
912 $dbh->rollback if $oldAutoCommit;
913 return "Illegal svcdb value in part_svc!";
916 require "FS/$svcdb.pm";
918 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
920 $error = $svc->unsuspend;
922 $dbh->rollback if $oldAutoCommit;
929 my %hash = $self->hash;
930 my $inactive = time - $hash{'susp'};
932 my $conf = new FS::Conf;
934 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
935 if ( $opt{'adjust_next_bill'}
936 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
937 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
940 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
941 my $new = new FS::cust_pkg ( \%hash );
942 $error = $new->replace( $self, options => { $self->options } );
944 $dbh->rollback if $oldAutoCommit;
948 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
955 Cancels any pending suspension (sets the adjourn field to null).
957 If there is an error, returns the error, otherwise returns false.
962 my( $self, %options ) = @_;
965 local $SIG{HUP} = 'IGNORE';
966 local $SIG{INT} = 'IGNORE';
967 local $SIG{QUIT} = 'IGNORE';
968 local $SIG{TERM} = 'IGNORE';
969 local $SIG{TSTP} = 'IGNORE';
970 local $SIG{PIPE} = 'IGNORE';
972 my $oldAutoCommit = $FS::UID::AutoCommit;
973 local $FS::UID::AutoCommit = 0;
976 my $old = $self->select_for_update;
978 my $pkgnum = $old->pkgnum;
979 if ( $old->get('cancel') || $self->get('cancel') ) {
980 dbh->rollback if $oldAutoCommit;
981 return "Can't unadjourn cancelled package $pkgnum";
982 # or at least it's pointless
985 if ( $old->get('susp') || $self->get('susp') ) {
986 dbh->rollback if $oldAutoCommit;
987 return "Can't unadjourn suspended package $pkgnum";
988 # perhaps this is arbitrary
991 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
992 dbh->rollback if $oldAutoCommit;
993 return ""; # no error
996 my %hash = $self->hash;
997 $hash{'adjourn'} = '';
998 my $new = new FS::cust_pkg ( \%hash );
999 $error = $new->replace( $self, options => { $self->options } );
1001 $dbh->rollback if $oldAutoCommit;
1005 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1012 =item change HASHREF | OPTION => VALUE ...
1014 Changes this package: cancels it and creates a new one, with a different
1015 pkgpart or locationnum or both. All services are transferred to the new
1016 package (no change will be made if this is not possible).
1018 Options may be passed as a list of key/value pairs or as a hash reference.
1025 New locationnum, to change the location for this package.
1029 New FS::cust_location object, to create a new location and assign it
1034 New pkgpart (see L<FS::part_pkg>).
1038 New refnum (see L<FS::part_referral>).
1042 At least one option must be specified (otherwise, what's the point?)
1044 Returns either the new FS::cust_pkg object or a scalar error.
1048 my $err_or_new_cust_pkg = $old_cust_pkg->change
1052 #some false laziness w/order
1055 my $opt = ref($_[0]) ? shift : { @_ };
1057 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1060 my $conf = new FS::Conf;
1062 # Transactionize this whole mess
1063 local $SIG{HUP} = 'IGNORE';
1064 local $SIG{INT} = 'IGNORE';
1065 local $SIG{QUIT} = 'IGNORE';
1066 local $SIG{TERM} = 'IGNORE';
1067 local $SIG{TSTP} = 'IGNORE';
1068 local $SIG{PIPE} = 'IGNORE';
1070 my $oldAutoCommit = $FS::UID::AutoCommit;
1071 local $FS::UID::AutoCommit = 0;
1080 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1082 #$hash{$_} = $self->$_() foreach qw( setup );
1084 $hash{'setup'} = $time if $self->setup;
1086 $hash{'change_date'} = $time;
1087 $hash{"change_$_"} = $self->$_()
1088 foreach qw( pkgnum pkgpart locationnum );
1090 if ( $opt->{'cust_location'} &&
1091 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1092 $error = $opt->{'cust_location'}->insert;
1094 $dbh->rollback if $oldAutoCommit;
1095 return "inserting cust_location (transaction rolled back): $error";
1097 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1100 # Create the new package.
1101 my $cust_pkg = new FS::cust_pkg {
1102 custnum => $self->custnum,
1103 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1104 refnum => ( $opt->{'refnum'} || $self->refnum ),
1105 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1109 $error = $cust_pkg->insert( 'change' => 1 );
1111 $dbh->rollback if $oldAutoCommit;
1115 # Transfer services and cancel old package.
1117 $error = $self->transfer($cust_pkg);
1118 if ($error and $error == 0) {
1119 # $old_pkg->transfer failed.
1120 $dbh->rollback if $oldAutoCommit;
1124 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1125 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1126 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1127 if ($error and $error == 0) {
1128 # $old_pkg->transfer failed.
1129 $dbh->rollback if $oldAutoCommit;
1135 # Transfers were successful, but we still had services left on the old
1136 # package. We can't change the package under this circumstances, so abort.
1137 $dbh->rollback if $oldAutoCommit;
1138 return "Unable to transfer all services from package ". $self->pkgnum;
1141 #Good to go, cancel old package.
1142 $error = $self->cancel( quiet=>1 );
1148 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1155 Returns the last bill date, or if there is no last bill date, the setup date.
1156 Useful for billing metered services.
1162 return $self->setfield('last_bill', $_[0]) if @_;
1163 return $self->getfield('last_bill') if $self->getfield('last_bill');
1164 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1165 'edate' => $self->bill, } );
1166 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1169 =item last_cust_pkg_reason ACTION
1171 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1172 Returns false if there is no reason or the package is not currenly ACTION'd
1173 ACTION is one of adjourn, susp, cancel, or expire.
1177 sub last_cust_pkg_reason {
1178 my ( $self, $action ) = ( shift, shift );
1179 my $date = $self->get($action);
1181 'table' => 'cust_pkg_reason',
1182 'hashref' => { 'pkgnum' => $self->pkgnum,
1183 'action' => substr(uc($action), 0, 1),
1186 'order_by' => 'ORDER BY num DESC LIMIT 1',
1190 =item last_reason ACTION
1192 Returns the most recent ACTION FS::reason associated with the package.
1193 Returns false if there is no reason or the package is not currenly ACTION'd
1194 ACTION is one of adjourn, susp, cancel, or expire.
1199 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1200 $cust_pkg_reason->reason
1201 if $cust_pkg_reason;
1206 Returns the definition for this billing item, as an FS::part_pkg object (see
1213 #exists( $self->{'_pkgpart'} )
1215 ? $self->{'_pkgpart'}
1216 : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1221 Returns the cancelled package this package was changed from, if any.
1227 return '' unless $self->change_pkgnum;
1228 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1233 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1240 $self->part_pkg->calc_setup($self, @_);
1245 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1252 $self->part_pkg->calc_recur($self, @_);
1257 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1264 $self->part_pkg->calc_remain($self, @_);
1269 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1276 $self->part_pkg->calc_cancel($self, @_);
1281 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1287 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1290 =item cust_pkg_detail [ DETAILTYPE ]
1292 Returns any customer package details for this package (see
1293 L<FS::cust_pkg_detail>).
1295 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1299 sub cust_pkg_detail {
1301 my %hash = ( 'pkgnum' => $self->pkgnum );
1302 $hash{detailtype} = shift if @_;
1304 'table' => 'cust_pkg_detail',
1305 'hashref' => \%hash,
1306 'order_by' => 'ORDER BY weight, pkgdetailnum',
1310 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1312 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1314 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1316 If there is an error, returns the error, otherwise returns false.
1320 sub set_cust_pkg_detail {
1321 my( $self, $detailtype, @details ) = @_;
1323 local $SIG{HUP} = 'IGNORE';
1324 local $SIG{INT} = 'IGNORE';
1325 local $SIG{QUIT} = 'IGNORE';
1326 local $SIG{TERM} = 'IGNORE';
1327 local $SIG{TSTP} = 'IGNORE';
1328 local $SIG{PIPE} = 'IGNORE';
1330 my $oldAutoCommit = $FS::UID::AutoCommit;
1331 local $FS::UID::AutoCommit = 0;
1334 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1335 my $error = $current->delete;
1337 $dbh->rollback if $oldAutoCommit;
1338 return "error removing old detail: $error";
1342 foreach my $detail ( @details ) {
1343 my $cust_pkg_detail = new FS::cust_pkg_detail {
1344 'pkgnum' => $self->pkgnum,
1345 'detailtype' => $detailtype,
1346 'detail' => $detail,
1348 my $error = $cust_pkg_detail->insert;
1350 $dbh->rollback if $oldAutoCommit;
1351 return "error adding new detail: $error";
1356 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1363 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1367 #false laziness w/cust_bill.pm
1371 'table' => 'cust_event',
1372 'addl_from' => 'JOIN part_event USING ( eventpart )',
1373 'hashref' => { 'tablenum' => $self->pkgnum },
1374 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1378 =item num_cust_event
1380 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1384 #false laziness w/cust_bill.pm
1385 sub num_cust_event {
1388 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1389 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1390 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1391 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1392 $sth->fetchrow_arrayref->[0];
1395 =item cust_svc [ SVCPART ]
1397 Returns the services for this package, as FS::cust_svc objects (see
1398 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1407 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1408 'svcpart' => shift, } );
1411 #if ( $self->{'_svcnum'} ) {
1412 # values %{ $self->{'_svcnum'}->cache };
1414 $self->_sort_cust_svc(
1415 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1421 =item overlimit [ SVCPART ]
1423 Returns the services for this package which have exceeded their
1424 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1425 is specified, return only the matching services.
1431 grep { $_->overlimit } $self->cust_svc;
1434 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1436 Returns historical services for this package created before END TIMESTAMP and
1437 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1438 (see L<FS::h_cust_svc>).
1445 $self->_sort_cust_svc(
1446 [ qsearch( 'h_cust_svc',
1447 { 'pkgnum' => $self->pkgnum, },
1448 FS::h_cust_svc->sql_h_search(@_),
1454 sub _sort_cust_svc {
1455 my( $self, $arrayref ) = @_;
1458 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1460 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1461 'svcpart' => $_->svcpart } );
1463 $pkg_svc ? $pkg_svc->primary_svc : '',
1464 $pkg_svc ? $pkg_svc->quantity : 0,
1471 =item num_cust_svc [ SVCPART ]
1473 Returns the number of provisioned services for this package. If a svcpart is
1474 specified, counts only the matching services.
1480 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1481 $sql .= ' AND svcpart = ?' if @_;
1482 my $sth = dbh->prepare($sql) or die dbh->errstr;
1483 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1484 $sth->fetchrow_arrayref->[0];
1487 =item available_part_svc
1489 Returns a list of FS::part_svc objects representing services included in this
1490 package but not yet provisioned. Each FS::part_svc object also has an extra
1491 field, I<num_avail>, which specifies the number of available services.
1495 sub available_part_svc {
1497 grep { $_->num_avail > 0 }
1499 my $part_svc = $_->part_svc;
1500 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1501 $_->quantity - $self->num_cust_svc($_->svcpart);
1504 $self->part_pkg->pkg_svc;
1509 Returns a list of FS::part_svc objects representing provisioned and available
1510 services included in this package. Each FS::part_svc object also has the
1511 following extra fields:
1515 =item num_cust_svc (count)
1517 =item num_avail (quantity - count)
1519 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1522 label -> ($cust_svc->label)[1]
1531 #XXX some sort of sort order besides numeric by svcpart...
1532 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1534 my $part_svc = $pkg_svc->part_svc;
1535 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1536 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1537 $part_svc->{'Hash'}{'num_avail'} =
1538 max( 0, $pkg_svc->quantity - $num_cust_svc );
1539 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1541 } $self->part_pkg->pkg_svc;
1544 push @part_svc, map {
1546 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1547 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1548 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1549 $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ];
1551 } $self->extra_part_svc;
1557 =item extra_part_svc
1559 Returns a list of FS::part_svc objects corresponding to services in this
1560 package which are still provisioned but not (any longer) available in the
1565 sub extra_part_svc {
1568 my $pkgnum = $self->pkgnum;
1569 my $pkgpart = $self->pkgpart;
1572 'table' => 'part_svc',
1574 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1575 WHERE pkg_svc.svcpart = part_svc.svcpart
1576 AND pkg_svc.pkgpart = $pkgpart
1579 AND 0 < ( SELECT count(*)
1581 LEFT JOIN cust_pkg using ( pkgnum )
1582 WHERE cust_svc.svcpart = part_svc.svcpart
1583 AND pkgnum = $pkgnum
1590 Returns a short status string for this package, currently:
1594 =item not yet billed
1596 =item one-time charge
1611 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1613 return 'cancelled' if $self->get('cancel');
1614 return 'suspended' if $self->susp;
1615 return 'not yet billed' unless $self->setup;
1616 return 'one-time charge' if $freq =~ /^(0|$)/;
1622 Class method that returns the list of possible status strings for packages
1623 (see L<the status method|/status>). For example:
1625 @statuses = FS::cust_pkg->statuses();
1629 tie my %statuscolor, 'Tie::IxHash',
1630 'not yet billed' => '000000',
1631 'one-time charge' => '000000',
1632 'active' => '00CC00',
1633 'suspended' => 'FF9900',
1634 'cancelled' => 'FF0000',
1638 my $self = shift; #could be class...
1639 grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1640 # mayble split btw one-time vs. recur
1646 Returns a hex triplet color string for this package's status.
1652 $statuscolor{$self->status};
1657 Returns a list of lists, calling the label method for all services
1658 (see L<FS::cust_svc>) of this billing item.
1664 map { [ $_->label ] } $self->cust_svc;
1667 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1669 Like the labels method, but returns historical information on services that
1670 were active as of END_TIMESTAMP and (optionally) not cancelled before
1673 Returns a list of lists, calling the label method for all (historical) services
1674 (see L<FS::h_cust_svc>) of this billing item.
1680 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1683 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1685 Like h_labels, except returns a simple flat list, and shortens long
1686 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1687 identical services to one line that lists the service label and the number of
1688 individual services rather than individual items.
1692 sub h_labels_short {
1695 my $conf = new FS::Conf;
1696 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1699 #tie %labels, 'Tie::IxHash';
1700 push @{ $labels{$_->[0]} }, $_->[1]
1701 foreach $self->h_labels(@_);
1703 foreach my $label ( keys %labels ) {
1705 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1706 my $num = scalar(@values);
1707 if ( $num > $max_same_services ) {
1708 push @labels, "$label ($num)";
1710 push @labels, map { "$label: $_" } @values;
1720 Returns the parent customer object (see L<FS::cust_main>).
1726 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1731 Returns the location object, if any (see L<FS::cust_location>).
1737 return '' unless $self->locationnum;
1738 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1741 =item cust_location_or_main
1743 If this package is associated with a location, returns the locaiton (see
1744 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1748 sub cust_location_or_main {
1750 $self->cust_location || $self->cust_main;
1753 =item seconds_since TIMESTAMP
1755 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1756 package have been online since TIMESTAMP, according to the session monitor.
1758 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1759 L<Time::Local> and L<Date::Parse> for conversion functions.
1764 my($self, $since) = @_;
1767 foreach my $cust_svc (
1768 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1770 $seconds += $cust_svc->seconds_since($since);
1777 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
1779 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
1780 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
1783 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1784 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1790 sub seconds_since_sqlradacct {
1791 my($self, $start, $end) = @_;
1795 foreach my $cust_svc (
1797 my $part_svc = $_->part_svc;
1798 $part_svc->svcdb eq 'svc_acct'
1799 && scalar($part_svc->part_export('sqlradius'));
1802 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
1809 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
1811 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
1812 in this package for sessions ending between TIMESTAMP_START (inclusive) and
1816 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
1817 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
1822 sub attribute_since_sqlradacct {
1823 my($self, $start, $end, $attrib) = @_;
1827 foreach my $cust_svc (
1829 my $part_svc = $_->part_svc;
1830 $part_svc->svcdb eq 'svc_acct'
1831 && scalar($part_svc->part_export('sqlradius'));
1834 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
1846 my( $self, $value ) = @_;
1847 if ( defined($value) ) {
1848 $self->setfield('quantity', $value);
1850 $self->getfield('quantity') || 1;
1853 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
1855 Transfers as many services as possible from this package to another package.
1857 The destination package can be specified by pkgnum by passing an FS::cust_pkg
1858 object. The destination package must already exist.
1860 Services are moved only if the destination allows services with the correct
1861 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
1862 this option with caution! No provision is made for export differences
1863 between the old and new service definitions. Probably only should be used
1864 when your exports for all service definitions of a given svcdb are identical.
1865 (attempt a transfer without it first, to move all possible svcpart-matching
1868 Any services that can't be moved remain in the original package.
1870 Returns an error, if there is one; otherwise, returns the number of services
1871 that couldn't be moved.
1876 my ($self, $dest_pkgnum, %opt) = @_;
1882 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
1883 $dest = $dest_pkgnum;
1884 $dest_pkgnum = $dest->pkgnum;
1886 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
1889 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
1891 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
1892 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
1895 foreach my $cust_svc ($dest->cust_svc) {
1896 $target{$cust_svc->svcpart}--;
1899 my %svcpart2svcparts = ();
1900 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1901 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
1902 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
1903 next if exists $svcpart2svcparts{$svcpart};
1904 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
1905 $svcpart2svcparts{$svcpart} = [
1907 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
1909 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
1910 'svcpart' => $_ } );
1912 $pkg_svc ? $pkg_svc->primary_svc : '',
1913 $pkg_svc ? $pkg_svc->quantity : 0,
1917 grep { $_ != $svcpart }
1919 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
1921 warn "alternates for svcpart $svcpart: ".
1922 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
1927 foreach my $cust_svc ($self->cust_svc) {
1928 if($target{$cust_svc->svcpart} > 0) {
1929 $target{$cust_svc->svcpart}--;
1930 my $new = new FS::cust_svc { $cust_svc->hash };
1931 $new->pkgnum($dest_pkgnum);
1932 my $error = $new->replace($cust_svc);
1933 return $error if $error;
1934 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
1936 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
1937 warn "alternates to consider: ".
1938 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
1940 my @alternate = grep {
1941 warn "considering alternate svcpart $_: ".
1942 "$target{$_} available in new package\n"
1945 } @{$svcpart2svcparts{$cust_svc->svcpart}};
1947 warn "alternate(s) found\n" if $DEBUG;
1948 my $change_svcpart = $alternate[0];
1949 $target{$change_svcpart}--;
1950 my $new = new FS::cust_svc { $cust_svc->hash };
1951 $new->svcpart($change_svcpart);
1952 $new->pkgnum($dest_pkgnum);
1953 my $error = $new->replace($cust_svc);
1954 return $error if $error;
1967 This method is deprecated. See the I<depend_jobnum> option to the insert and
1968 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
1975 local $SIG{HUP} = 'IGNORE';
1976 local $SIG{INT} = 'IGNORE';
1977 local $SIG{QUIT} = 'IGNORE';
1978 local $SIG{TERM} = 'IGNORE';
1979 local $SIG{TSTP} = 'IGNORE';
1980 local $SIG{PIPE} = 'IGNORE';
1982 my $oldAutoCommit = $FS::UID::AutoCommit;
1983 local $FS::UID::AutoCommit = 0;
1986 foreach my $cust_svc ( $self->cust_svc ) {
1987 #false laziness w/svc_Common::insert
1988 my $svc_x = $cust_svc->svc_x;
1989 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
1990 my $error = $part_export->export_insert($svc_x);
1992 $dbh->rollback if $oldAutoCommit;
1998 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2005 =head1 CLASS METHODS
2011 Returns an SQL expression identifying recurring packages.
2015 sub recurring_sql { "
2016 '0' != ( select freq from part_pkg
2017 where cust_pkg.pkgpart = part_pkg.pkgpart )
2022 Returns an SQL expression identifying one-time packages.
2027 '0' = ( select freq from part_pkg
2028 where cust_pkg.pkgpart = part_pkg.pkgpart )
2033 Returns an SQL expression identifying active packages.
2038 ". $_[0]->recurring_sql(). "
2039 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2040 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2045 Returns an SQL expression identifying inactive packages (one-time packages
2046 that are otherwise unsuspended/uncancelled).
2050 sub inactive_sql { "
2051 ". $_[0]->onetime_sql(). "
2052 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2053 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2059 Returns an SQL expression identifying suspended packages.
2063 sub suspended_sql { susp_sql(@_); }
2065 #$_[0]->recurring_sql(). ' AND '.
2067 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2068 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2075 Returns an SQL exprression identifying cancelled packages.
2079 sub cancelled_sql { cancel_sql(@_); }
2081 #$_[0]->recurring_sql(). ' AND '.
2082 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2085 =item search_sql HASHREF
2089 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2090 Valid parameters are
2098 active, inactive, suspended, cancel (or cancelled)
2102 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2112 arrayref of beginning and ending epoch date
2116 arrayref of beginning and ending epoch date
2120 arrayref of beginning and ending epoch date
2124 arrayref of beginning and ending epoch date
2128 arrayref of beginning and ending epoch date
2132 arrayref of beginning and ending epoch date
2136 arrayref of beginning and ending epoch date
2140 pkgnum or APKG_pkgnum
2144 a value suited to passing to FS::UI::Web::cust_header
2148 specifies the user for agent virtualization
2155 my ($class, $params) = @_;
2162 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2164 "cust_main.agentnum = $1";
2171 if ( $params->{'magic'} eq 'active'
2172 || $params->{'status'} eq 'active' ) {
2174 push @where, FS::cust_pkg->active_sql();
2176 } elsif ( $params->{'magic'} eq 'inactive'
2177 || $params->{'status'} eq 'inactive' ) {
2179 push @where, FS::cust_pkg->inactive_sql();
2181 } elsif ( $params->{'magic'} eq 'suspended'
2182 || $params->{'status'} eq 'suspended' ) {
2184 push @where, FS::cust_pkg->suspended_sql();
2186 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2187 || $params->{'status'} =~ /^cancell?ed$/ ) {
2189 push @where, FS::cust_pkg->cancelled_sql();
2191 } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
2193 push @where, FS::cust_pkg->inactive_sql();
2198 # parse package class
2201 #false lazinessish w/graph/cust_bill_pkg.cgi
2204 if ( exists($params->{'classnum'})
2205 && $params->{'classnum'} =~ /^(\d*)$/
2209 if ( $classnum ) { #a specific class
2210 push @where, "classnum = $classnum";
2212 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2213 #die "classnum $classnum not found!" unless $pkg_class[0];
2214 #$title .= $pkg_class[0]->classname.' ';
2216 } elsif ( $classnum eq '' ) { #the empty class
2218 push @where, "classnum IS NULL";
2219 #$title .= 'Empty class ';
2220 #@pkg_class = ( '(empty class)' );
2221 } elsif ( $classnum eq '0' ) {
2222 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2223 #push @pkg_class, '(empty class)';
2225 die "illegal classnum";
2234 my $pkgpart = join (' OR pkgpart=',
2235 grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
2236 push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
2244 #false laziness w/report_cust_pkg.html
2247 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2248 'active' => { 'susp'=>1, 'cancel'=>1 },
2249 'suspended' => { 'cancel' => 1 },
2254 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2256 next unless exists($params->{$field});
2258 my($beginning, $ending) = @{$params->{$field}};
2260 next if $beginning == 0 && $ending == 4294967295;
2263 "cust_pkg.$field IS NOT NULL",
2264 "cust_pkg.$field >= $beginning",
2265 "cust_pkg.$field <= $ending";
2267 $orderby ||= "ORDER BY cust_pkg.$field";
2271 $orderby ||= 'ORDER BY bill';
2274 # parse magic, legacy, etc.
2277 if ( $params->{'magic'} &&
2278 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2281 $orderby = 'ORDER BY pkgnum';
2283 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2284 push @where, "pkgpart = $1";
2287 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2289 $orderby = 'ORDER BY pkgnum';
2291 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2293 $orderby = 'ORDER BY pkgnum';
2296 SELECT count(*) FROM pkg_svc
2297 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2298 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2299 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2300 AND cust_svc.svcpart = pkg_svc.svcpart
2307 # setup queries, links, subs, etc. for the search
2310 # here is the agent virtualization
2311 if ($params->{CurrentUser}) {
2313 qsearchs('access_user', { username => $params->{CurrentUser} });
2316 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2321 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2324 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2326 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2327 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2328 'LEFT JOIN pkg_class USING ( classnum ) ';
2330 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2333 'table' => 'cust_pkg',
2335 'select' => join(', ',
2337 ( map "part_pkg.$_", qw( pkg freq ) ),
2338 'pkg_class.classname',
2339 'cust_main.custnum as cust_main_custnum',
2340 FS::UI::Web::cust_sql_fields(
2341 $params->{'cust_fields'}
2344 'extra_sql' => "$extra_sql $orderby",
2345 'addl_from' => $addl_from,
2346 'count_query' => $count_query,
2353 Returns a list: the first item is an SQL fragment identifying matching
2354 packages/customers via location (taking into account shipping and package
2355 address taxation, if enabled), and subsequent items are the parameters to
2356 substitute for the placeholders in that fragment.
2361 my($class, %opt) = @_;
2362 my $ornull = $opt{'ornull'};
2364 my $conf = new FS::Conf;
2366 # '?' placeholders in _location_sql_where
2369 @bill_param = qw( county county county state state state country );
2371 @bill_param = qw( county county state state country );
2376 if ( $conf->exists('tax-ship_address') ) {
2379 ( ( ship_last IS NULL OR ship_last = '' )
2380 AND ". _location_sql_where('cust_main', '', $ornull ). "
2382 OR ( ship_last IS NOT NULL AND ship_last != ''
2383 AND ". _location_sql_where('cust_main', 'ship_', $ornull). "
2386 # AND payby != 'COMP'
2388 @main_param = ( @bill_param, @bill_param );
2392 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2393 @main_param = @bill_param;
2399 if ( $conf->exists('tax-pkg_address') ) {
2402 ( cust_pkg.locationnum IS NULL AND $main_where )
2403 OR ( cust_pkg.locationnum IS NOT NULL AND ". _location_sql_where('cust_location', '', $ornull). " )
2405 @param = ( @main_param, @bill_param );
2409 $where = $main_where;
2410 @param = @main_param;
2418 #subroutine, helper for able
2419 sub _location_sql_where {
2421 my $prefix = @_ ? shift : '';
2422 my $ornull = @_ ? shift : '';
2423 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2425 ( $table.${prefix}county = ? OR ? = '' $ornull )
2426 AND ( $table.${prefix}state = ? OR ? = '' $ornull )
2427 AND $table.${prefix}country = ?
2435 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2437 CUSTNUM is a customer (see L<FS::cust_main>)
2439 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2440 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2443 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2444 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2445 new billing items. An error is returned if this is not possible (see
2446 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2449 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2450 newly-created cust_pkg objects.
2452 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2453 and inserted. Multiple FS::pkg_referral records can be created by
2454 setting I<refnum> to an array reference of refnums or a hash reference with
2455 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2456 record will be created corresponding to cust_main.refnum.
2461 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2463 my $conf = new FS::Conf;
2465 # Transactionize this whole mess
2466 local $SIG{HUP} = 'IGNORE';
2467 local $SIG{INT} = 'IGNORE';
2468 local $SIG{QUIT} = 'IGNORE';
2469 local $SIG{TERM} = 'IGNORE';
2470 local $SIG{TSTP} = 'IGNORE';
2471 local $SIG{PIPE} = 'IGNORE';
2473 my $oldAutoCommit = $FS::UID::AutoCommit;
2474 local $FS::UID::AutoCommit = 0;
2478 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2479 # return "Customer not found: $custnum" unless $cust_main;
2481 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2484 my $change = scalar(@old_cust_pkg) != 0;
2487 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2489 my $err_or_cust_pkg =
2490 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2491 'refnum' => $refnum,
2494 unless (ref($err_or_cust_pkg)) {
2495 $dbh->rollback if $oldAutoCommit;
2496 return $err_or_cust_pkg;
2499 push @$return_cust_pkg, $err_or_cust_pkg;
2504 # Create the new packages.
2505 foreach my $pkgpart (@$pkgparts) {
2506 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
2507 pkgpart => $pkgpart,
2511 $error = $cust_pkg->insert( 'change' => $change );
2513 $dbh->rollback if $oldAutoCommit;
2516 push @$return_cust_pkg, $cust_pkg;
2518 # $return_cust_pkg now contains refs to all of the newly
2521 # Transfer services and cancel old packages.
2522 foreach my $old_pkg (@old_cust_pkg) {
2524 foreach my $new_pkg (@$return_cust_pkg) {
2525 $error = $old_pkg->transfer($new_pkg);
2526 if ($error and $error == 0) {
2527 # $old_pkg->transfer failed.
2528 $dbh->rollback if $oldAutoCommit;
2533 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
2534 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
2535 foreach my $new_pkg (@$return_cust_pkg) {
2536 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
2537 if ($error and $error == 0) {
2538 # $old_pkg->transfer failed.
2539 $dbh->rollback if $oldAutoCommit;
2546 # Transfers were successful, but we went through all of the
2547 # new packages and still had services left on the old package.
2548 # We can't cancel the package under the circumstances, so abort.
2549 $dbh->rollback if $oldAutoCommit;
2550 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
2552 $error = $old_pkg->cancel( quiet=>1 );
2558 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2562 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
2564 A bulk change method to change packages for multiple customers.
2566 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2567 L<FS::part_pkg>) to order for each customer. Duplicates are of course
2570 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
2571 replace. The services (see L<FS::cust_svc>) are moved to the
2572 new billing items. An error is returned if this is not possible (see
2575 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2576 newly-created cust_pkg objects.
2581 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
2583 # Transactionize this whole mess
2584 local $SIG{HUP} = 'IGNORE';
2585 local $SIG{INT} = 'IGNORE';
2586 local $SIG{QUIT} = 'IGNORE';
2587 local $SIG{TERM} = 'IGNORE';
2588 local $SIG{TSTP} = 'IGNORE';
2589 local $SIG{PIPE} = 'IGNORE';
2591 my $oldAutoCommit = $FS::UID::AutoCommit;
2592 local $FS::UID::AutoCommit = 0;
2596 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2599 while(scalar(@old_cust_pkg)) {
2601 my $custnum = $old_cust_pkg[0]->custnum;
2602 my (@remove) = map { $_->pkgnum }
2603 grep { $_->custnum == $custnum } @old_cust_pkg;
2604 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
2606 my $error = order $custnum, $pkgparts, \@remove, \@return;
2608 push @errors, $error
2610 push @$return_cust_pkg, @return;
2613 if (scalar(@errors)) {
2614 $dbh->rollback if $oldAutoCommit;
2615 return join(' / ', @errors);
2618 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2624 Associates this package with a (suspension or cancellation) reason (see
2625 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2628 Available options are:
2634 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.
2638 the access_user (see L<FS::access_user>) providing the reason
2646 the action (cancel, susp, adjourn, expire) associated with the reason
2650 If there is an error, returns the error, otherwise returns false.
2655 my ($self, %options) = @_;
2657 my $otaker = $options{reason_otaker} ||
2658 $FS::CurrentUser::CurrentUser->username;
2661 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2665 } elsif ( ref($options{'reason'}) ) {
2667 return 'Enter a new reason (or select an existing one)'
2668 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2670 my $reason = new FS::reason({
2671 'reason_type' => $options{'reason'}->{'typenum'},
2672 'reason' => $options{'reason'}->{'reason'},
2674 my $error = $reason->insert;
2675 return $error if $error;
2677 $reasonnum = $reason->reasonnum;
2680 return "Unparsable reason: ". $options{'reason'};
2683 my $cust_pkg_reason =
2684 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2685 'reasonnum' => $reasonnum,
2686 'otaker' => $otaker,
2687 'action' => substr(uc($options{'action'}),0,1),
2688 'date' => $options{'date'}
2693 $cust_pkg_reason->insert;
2696 =item set_usage USAGE_VALUE_HASHREF
2698 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2699 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2700 upbytes, downbytes, and totalbytes are appropriate keys.
2702 All svc_accts which are part of this package have their values reset.
2707 my ($self, $valueref) = @_;
2709 foreach my $cust_svc ($self->cust_svc){
2710 my $svc_x = $cust_svc->svc_x;
2711 $svc_x->set_usage($valueref)
2712 if $svc_x->can("set_usage");
2716 =item recharge USAGE_VALUE_HASHREF
2718 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2719 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2720 upbytes, downbytes, and totalbytes are appropriate keys.
2722 All svc_accts which are part of this package have their values incremented.
2727 my ($self, $valueref) = @_;
2729 foreach my $cust_svc ($self->cust_svc){
2730 my $svc_x = $cust_svc->svc_x;
2731 $svc_x->recharge($valueref)
2732 if $svc_x->can("recharge");
2740 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
2742 In sub order, the @pkgparts array (passed by reference) is clobbered.
2744 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
2745 method to pass dates to the recur_prog expression, it should do so.
2747 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
2748 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
2749 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
2750 configuration values. Probably need a subroutine which decides what to do
2751 based on whether or not we've fetched the user yet, rather than a hash. See
2752 FS::UID and the TODO.
2754 Now that things are transactional should the check in the insert method be
2759 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
2760 L<FS::pkg_svc>, schema.html from the base documentation