4 use vars qw(@ISA $disable_agentcheck $DEBUG $me);
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;
28 use FS::cust_pkg_discount;
32 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
34 # because they load configuration by setting FS::UID::callback (see TODO)
40 # for sending cancel emails in sub cancel
43 @ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
46 $me = '[FS::cust_pkg]';
48 $disable_agentcheck = 0;
52 my ( $hashref, $cache ) = @_;
53 #if ( $hashref->{'pkgpart'} ) {
54 if ( $hashref->{'pkg'} ) {
55 # #@{ $self->{'_pkgnum'} } = ();
56 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
57 # $self->{'_pkgpart'} = $subcache;
58 # #push @{ $self->{'_pkgnum'} },
59 # FS::part_pkg->new_or_cached($hashref, $subcache);
60 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
62 if ( exists $hashref->{'svcnum'} ) {
63 #@{ $self->{'_pkgnum'} } = ();
64 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
65 $self->{'_svcnum'} = $subcache;
66 #push @{ $self->{'_pkgnum'} },
67 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
73 FS::cust_pkg - Object methods for cust_pkg objects
79 $record = new FS::cust_pkg \%hash;
80 $record = new FS::cust_pkg { 'column' => 'value' };
82 $error = $record->insert;
84 $error = $new_record->replace($old_record);
86 $error = $record->delete;
88 $error = $record->check;
90 $error = $record->cancel;
92 $error = $record->suspend;
94 $error = $record->unsuspend;
96 $part_pkg = $record->part_pkg;
98 @labels = $record->labels;
100 $seconds = $record->seconds_since($timestamp);
102 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
103 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
107 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
108 inherits from FS::Record. The following fields are currently supported:
114 Primary key (assigned automatically for new billing items)
118 Customer (see L<FS::cust_main>)
122 Billing item definition (see L<FS::part_pkg>)
126 Optional link to package location (see L<FS::location>)
138 date (next bill date)
162 order taker (assigned automatically if null, see L<FS::UID>)
166 If this field is set to 1, disables the automatic
167 unsuspension of this package when using the B<unsuspendauto> config option.
171 If not set, defaults to 1
175 Date of change from previous package
185 =item change_locationnum
191 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
192 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
193 L<Time::Local> and L<Date::Parse> for conversion functions.
201 Create a new billing item. To add the item to the database, see L<"insert">.
205 sub table { 'cust_pkg'; }
206 sub cust_linked { $_[0]->cust_main_custnum; }
207 sub cust_unlinked_msg {
209 "WARNING: can't find cust_main.custnum ". $self->custnum.
210 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
213 =item insert [ OPTION => VALUE ... ]
215 Adds this billing item to the database ("Orders" the item). If there is an
216 error, returns the error, otherwise returns false.
218 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
219 will be used to look up the package definition and agent restrictions will be
222 If the additional field I<refnum> is defined, an FS::pkg_referral record will
223 be created and inserted. Multiple FS::pkg_referral records can be created by
224 setting I<refnum> to an array reference of refnums or a hash reference with
225 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
226 record will be created corresponding to cust_main.refnum.
228 The following options are available:
234 If set true, supresses any referral credit to a referring customer.
238 cust_pkg_option records will be created
242 a ticket will be added to this customer with this subject
246 an optional queue name for ticket additions
253 my( $self, %options ) = @_;
255 local $SIG{HUP} = 'IGNORE';
256 local $SIG{INT} = 'IGNORE';
257 local $SIG{QUIT} = 'IGNORE';
258 local $SIG{TERM} = 'IGNORE';
259 local $SIG{TSTP} = 'IGNORE';
260 local $SIG{PIPE} = 'IGNORE';
262 my $oldAutoCommit = $FS::UID::AutoCommit;
263 local $FS::UID::AutoCommit = 0;
266 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
268 $dbh->rollback if $oldAutoCommit;
272 $self->refnum($self->cust_main->refnum) unless $self->refnum;
273 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
274 $self->process_m2m( 'link_table' => 'pkg_referral',
275 'target_table' => 'part_referral',
276 'params' => $self->refnum,
279 if ( $self->discountnum ) {
280 my $error = $self->insert_discount();
282 $dbh->rollback if $oldAutoCommit;
287 #if ( $self->reg_code ) {
288 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
289 # $error = $reg_code->delete;
291 # $dbh->rollback if $oldAutoCommit;
296 my $conf = new FS::Conf;
298 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
300 use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
307 my $q = new RT::Queue($RT::SystemUser);
308 $q->Load($options{ticket_queue}) if $options{ticket_queue};
309 my $t = new RT::Ticket($RT::SystemUser);
310 my $mime = new MIME::Entity;
311 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
312 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
313 Subject => $options{ticket_subject},
316 $t->AddLink( Type => 'MemberOf',
317 Target => 'freeside://freeside/cust_main/'. $self->custnum,
321 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
322 my $queue = new FS::queue {
323 'job' => 'FS::cust_main::queueable_print',
325 $error = $queue->insert(
326 'custnum' => $self->custnum,
327 'template' => 'welcome_letter',
331 warn "can't send welcome letter: $error";
336 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
343 This method now works but you probably shouldn't use it.
345 You don't want to delete billing items, because there would then be no record
346 the customer ever purchased the item. Instead, see the cancel method.
351 # return "Can't delete cust_pkg records!";
354 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
356 Replaces the OLD_RECORD with this one in the database. If there is an error,
357 returns the error, otherwise returns false.
359 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
361 Changing pkgpart may have disasterous effects. See the order subroutine.
363 setup and bill are normally updated by calling the bill method of a customer
364 object (see L<FS::cust_main>).
366 suspend is normally updated by the suspend and unsuspend methods.
368 cancel is normally updated by the cancel method (and also the order subroutine
371 Available options are:
377 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.
381 the access_user (see L<FS::access_user>) providing the reason
385 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
394 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
399 ( ref($_[0]) eq 'HASH' )
403 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
404 return "Can't change otaker!" if $old->otaker ne $new->otaker;
407 #return "Can't change setup once it exists!"
408 # if $old->getfield('setup') &&
409 # $old->getfield('setup') != $new->getfield('setup');
411 #some logic for bill, susp, cancel?
413 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
415 local $SIG{HUP} = 'IGNORE';
416 local $SIG{INT} = 'IGNORE';
417 local $SIG{QUIT} = 'IGNORE';
418 local $SIG{TERM} = 'IGNORE';
419 local $SIG{TSTP} = 'IGNORE';
420 local $SIG{PIPE} = 'IGNORE';
422 my $oldAutoCommit = $FS::UID::AutoCommit;
423 local $FS::UID::AutoCommit = 0;
426 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
427 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
428 my $error = $new->insert_reason(
429 'reason' => $options->{'reason'},
430 'date' => $new->$method,
432 'reason_otaker' => $options->{'reason_otaker'},
435 dbh->rollback if $oldAutoCommit;
436 return "Error inserting cust_pkg_reason: $error";
441 #save off and freeze RADIUS attributes for any associated svc_acct records
443 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
445 #also check for specific exports?
446 # to avoid spurious modify export events
447 @svc_acct = map { $_->svc_x }
448 grep { $_->part_svc->svcdb eq 'svc_acct' }
451 $_->snapshot foreach @svc_acct;
455 my $error = $new->SUPER::replace($old,
456 $options->{options} ? $options->{options} : ()
459 $dbh->rollback if $oldAutoCommit;
463 #for prepaid packages,
464 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
465 foreach my $old_svc_acct ( @svc_acct ) {
466 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
467 my $s_error = $new_svc_acct->replace($old_svc_acct);
469 $dbh->rollback if $oldAutoCommit;
474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
481 Checks all fields to make sure this is a valid billing item. If there is an
482 error, returns the error, otherwise returns false. Called by the insert and
490 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
493 $self->ut_numbern('pkgnum')
494 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
495 || $self->ut_numbern('pkgpart')
496 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
497 || $self->ut_numbern('start_date')
498 || $self->ut_numbern('setup')
499 || $self->ut_numbern('bill')
500 || $self->ut_numbern('susp')
501 || $self->ut_numbern('cancel')
502 || $self->ut_numbern('adjourn')
503 || $self->ut_numbern('expire')
505 return $error if $error;
507 if ( $self->reg_code ) {
509 unless ( grep { $self->pkgpart == $_->pkgpart }
510 map { $_->reg_code_pkg }
511 qsearchs( 'reg_code', { 'code' => $self->reg_code,
512 'agentnum' => $self->cust_main->agentnum })
514 return "Unknown registration code";
517 } elsif ( $self->promo_code ) {
520 qsearchs('part_pkg', {
521 'pkgpart' => $self->pkgpart,
522 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
524 return 'Unknown promotional code' unless $promo_part_pkg;
528 unless ( $disable_agentcheck ) {
530 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
531 return "agent ". $agent->agentnum. ':'. $agent->agent.
532 " can't purchase pkgpart ". $self->pkgpart
533 unless $agent->pkgpart_hashref->{ $self->pkgpart }
534 || $agent->agentnum == $self->part_pkg->agentnum;
537 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
538 return $error if $error;
542 $self->otaker(getotaker) unless $self->otaker;
543 $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
546 if ( $self->dbdef_table->column('manual_flag') ) {
547 $self->manual_flag('') if $self->manual_flag eq ' ';
548 $self->manual_flag =~ /^([01]?)$/
549 or return "Illegal manual_flag ". $self->manual_flag;
550 $self->manual_flag($1);
556 =item cancel [ OPTION => VALUE ... ]
558 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
559 in this package, then cancels the package itself (sets the cancel field to
562 Available options are:
566 =item quiet - can be set true to supress email cancellation notices.
568 =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.
570 =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.
572 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
574 =item nobill - can be set true to skip billing if it might otherwise be done.
578 If there is an error, returns the error, otherwise returns false.
583 my( $self, %options ) = @_;
586 my $conf = new FS::Conf;
588 warn "cust_pkg::cancel called with options".
589 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
592 local $SIG{HUP} = 'IGNORE';
593 local $SIG{INT} = 'IGNORE';
594 local $SIG{QUIT} = 'IGNORE';
595 local $SIG{TERM} = 'IGNORE';
596 local $SIG{TSTP} = 'IGNORE';
597 local $SIG{PIPE} = 'IGNORE';
599 my $oldAutoCommit = $FS::UID::AutoCommit;
600 local $FS::UID::AutoCommit = 0;
603 my $old = $self->select_for_update;
605 if ( $old->get('cancel') || $self->get('cancel') ) {
606 dbh->rollback if $oldAutoCommit;
607 return ""; # no error
610 my $date = $options{date} if $options{date}; # expire/cancel later
611 $date = '' if ($date && $date <= time); # complain instead?
613 #race condition: usage could be ongoing until unprovisioned
614 #resolved by performing a change package instead (which unprovisions) and
616 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
617 my $copy = $self->new({$self->hash});
619 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
620 warn "Error billing during cancel, custnum ".
621 #$self->cust_main->custnum. ": $error"
627 my $cancel_time = $options{'time'} || time;
629 if ( $options{'reason'} ) {
630 $error = $self->insert_reason( 'reason' => $options{'reason'},
631 'action' => $date ? 'expire' : 'cancel',
632 'date' => $date ? $date : $cancel_time,
633 'reason_otaker' => $options{'reason_otaker'},
636 dbh->rollback if $oldAutoCommit;
637 return "Error inserting cust_pkg_reason: $error";
643 foreach my $cust_svc (
646 sort { $a->[1] <=> $b->[1] }
647 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
648 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
651 my $error = $cust_svc->cancel;
654 $dbh->rollback if $oldAutoCommit;
655 return "Error cancelling cust_svc: $error";
659 # Add a credit for remaining service
660 my $remaining_value = $self->calc_remain(time=>$cancel_time);
661 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
662 my $error = $self->cust_main->credit(
664 'Credit for unused time on '. $self->part_pkg->pkg,
665 'reason_type' => $conf->config('cancel_credit_type'),
668 $dbh->rollback if $oldAutoCommit;
669 return "Error crediting customer \$$remaining_value for unused time on".
670 $self->part_pkg->pkg. ": $error";
675 my %hash = $self->hash;
676 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
677 my $new = new FS::cust_pkg ( \%hash );
678 $error = $new->replace( $self, options => { $self->options } );
680 $dbh->rollback if $oldAutoCommit;
684 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
685 return '' if $date; #no errors
687 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
688 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
689 my $error = send_email(
690 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
691 'to' => \@invoicing_list,
692 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
693 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
695 #should this do something on errors?
702 =item cancel_if_expired [ NOW_TIMESTAMP ]
704 Cancels this package if its expire date has been reached.
708 sub cancel_if_expired {
710 my $time = shift || time;
711 return '' unless $self->expire && $self->expire <= $time;
712 my $error = $self->cancel;
714 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
715 $self->custnum. ": $error";
722 Cancels any pending expiration (sets the expire field to null).
724 If there is an error, returns the error, otherwise returns false.
729 my( $self, %options ) = @_;
732 local $SIG{HUP} = 'IGNORE';
733 local $SIG{INT} = 'IGNORE';
734 local $SIG{QUIT} = 'IGNORE';
735 local $SIG{TERM} = 'IGNORE';
736 local $SIG{TSTP} = 'IGNORE';
737 local $SIG{PIPE} = 'IGNORE';
739 my $oldAutoCommit = $FS::UID::AutoCommit;
740 local $FS::UID::AutoCommit = 0;
743 my $old = $self->select_for_update;
745 my $pkgnum = $old->pkgnum;
746 if ( $old->get('cancel') || $self->get('cancel') ) {
747 dbh->rollback if $oldAutoCommit;
748 return "Can't unexpire cancelled package $pkgnum";
749 # or at least it's pointless
752 unless ( $old->get('expire') && $self->get('expire') ) {
753 dbh->rollback if $oldAutoCommit;
754 return ""; # no error
757 my %hash = $self->hash;
758 $hash{'expire'} = '';
759 my $new = new FS::cust_pkg ( \%hash );
760 $error = $new->replace( $self, options => { $self->options } );
762 $dbh->rollback if $oldAutoCommit;
766 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
772 =item suspend [ OPTION => VALUE ... ]
774 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
775 package, then suspends the package itself (sets the susp field to now).
777 Available options are:
781 =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.
783 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
787 If there is an error, returns the error, otherwise returns false.
792 my( $self, %options ) = @_;
795 local $SIG{HUP} = 'IGNORE';
796 local $SIG{INT} = 'IGNORE';
797 local $SIG{QUIT} = 'IGNORE';
798 local $SIG{TERM} = 'IGNORE';
799 local $SIG{TSTP} = 'IGNORE';
800 local $SIG{PIPE} = 'IGNORE';
802 my $oldAutoCommit = $FS::UID::AutoCommit;
803 local $FS::UID::AutoCommit = 0;
806 my $old = $self->select_for_update;
808 my $pkgnum = $old->pkgnum;
809 if ( $old->get('cancel') || $self->get('cancel') ) {
810 dbh->rollback if $oldAutoCommit;
811 return "Can't suspend cancelled package $pkgnum";
814 if ( $old->get('susp') || $self->get('susp') ) {
815 dbh->rollback if $oldAutoCommit;
816 return ""; # no error # complain on adjourn?
819 my $date = $options{date} if $options{date}; # adjourn/suspend later
820 $date = '' if ($date && $date <= time); # complain instead?
822 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
823 dbh->rollback if $oldAutoCommit;
824 return "Package $pkgnum expires before it would be suspended.";
827 my $suspend_time = $options{'time'} || time;
829 if ( $options{'reason'} ) {
830 $error = $self->insert_reason( 'reason' => $options{'reason'},
831 'action' => $date ? 'adjourn' : 'suspend',
832 'date' => $date ? $date : $suspend_time,
833 'reason_otaker' => $options{'reason_otaker'},
836 dbh->rollback if $oldAutoCommit;
837 return "Error inserting cust_pkg_reason: $error";
845 foreach my $cust_svc (
846 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
848 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
850 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
851 $dbh->rollback if $oldAutoCommit;
852 return "Illegal svcdb value in part_svc!";
855 require "FS/$svcdb.pm";
857 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
859 $error = $svc->suspend;
861 $dbh->rollback if $oldAutoCommit;
864 my( $label, $value ) = $cust_svc->label;
865 push @labels, "$label: $value";
869 my $conf = new FS::Conf;
870 if ( $conf->config('suspend_email_admin') ) {
872 my $error = send_email(
873 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
874 #invoice_from ??? well as good as any
875 'to' => $conf->config('suspend_email_admin'),
876 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
878 "This is an automatic message from your Freeside installation\n",
879 "informing you that the following customer package has been suspended:\n",
881 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
882 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
883 ( map { "Service : $_\n" } @labels ),
888 warn "WARNING: can't send suspension admin email (suspending anyway): ".
896 my %hash = $self->hash;
898 $hash{'adjourn'} = $date;
900 $hash{'susp'} = $suspend_time;
902 my $new = new FS::cust_pkg ( \%hash );
903 $error = $new->replace( $self, options => { $self->options } );
905 $dbh->rollback if $oldAutoCommit;
909 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
914 =item unsuspend [ OPTION => VALUE ... ]
916 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
917 package, then unsuspends the package itself (clears the susp field and the
918 adjourn field if it is in the past).
920 Available options are:
924 =item adjust_next_bill
926 Can be set true to adjust the next bill date forward by
927 the amount of time the account was inactive. This was set true by default
928 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
929 explicitly requested. Price plans for which this makes sense (anniversary-date
930 based than prorate or subscription) could have an option to enable this
935 If there is an error, returns the error, otherwise returns false.
940 my( $self, %opt ) = @_;
943 local $SIG{HUP} = 'IGNORE';
944 local $SIG{INT} = 'IGNORE';
945 local $SIG{QUIT} = 'IGNORE';
946 local $SIG{TERM} = 'IGNORE';
947 local $SIG{TSTP} = 'IGNORE';
948 local $SIG{PIPE} = 'IGNORE';
950 my $oldAutoCommit = $FS::UID::AutoCommit;
951 local $FS::UID::AutoCommit = 0;
954 my $old = $self->select_for_update;
956 my $pkgnum = $old->pkgnum;
957 if ( $old->get('cancel') || $self->get('cancel') ) {
958 dbh->rollback if $oldAutoCommit;
959 return "Can't unsuspend cancelled package $pkgnum";
962 unless ( $old->get('susp') && $self->get('susp') ) {
963 dbh->rollback if $oldAutoCommit;
964 return ""; # no error # complain instead?
967 foreach my $cust_svc (
968 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
970 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
972 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
973 $dbh->rollback if $oldAutoCommit;
974 return "Illegal svcdb value in part_svc!";
977 require "FS/$svcdb.pm";
979 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
981 $error = $svc->unsuspend;
983 $dbh->rollback if $oldAutoCommit;
990 my %hash = $self->hash;
991 my $inactive = time - $hash{'susp'};
993 my $conf = new FS::Conf;
995 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
996 if ( $opt{'adjust_next_bill'}
997 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
998 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
1001 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1002 my $new = new FS::cust_pkg ( \%hash );
1003 $error = $new->replace( $self, options => { $self->options } );
1005 $dbh->rollback if $oldAutoCommit;
1009 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1016 Cancels any pending suspension (sets the adjourn field to null).
1018 If there is an error, returns the error, otherwise returns false.
1023 my( $self, %options ) = @_;
1026 local $SIG{HUP} = 'IGNORE';
1027 local $SIG{INT} = 'IGNORE';
1028 local $SIG{QUIT} = 'IGNORE';
1029 local $SIG{TERM} = 'IGNORE';
1030 local $SIG{TSTP} = 'IGNORE';
1031 local $SIG{PIPE} = 'IGNORE';
1033 my $oldAutoCommit = $FS::UID::AutoCommit;
1034 local $FS::UID::AutoCommit = 0;
1037 my $old = $self->select_for_update;
1039 my $pkgnum = $old->pkgnum;
1040 if ( $old->get('cancel') || $self->get('cancel') ) {
1041 dbh->rollback if $oldAutoCommit;
1042 return "Can't unadjourn cancelled package $pkgnum";
1043 # or at least it's pointless
1046 if ( $old->get('susp') || $self->get('susp') ) {
1047 dbh->rollback if $oldAutoCommit;
1048 return "Can't unadjourn suspended package $pkgnum";
1049 # perhaps this is arbitrary
1052 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1053 dbh->rollback if $oldAutoCommit;
1054 return ""; # no error
1057 my %hash = $self->hash;
1058 $hash{'adjourn'} = '';
1059 my $new = new FS::cust_pkg ( \%hash );
1060 $error = $new->replace( $self, options => { $self->options } );
1062 $dbh->rollback if $oldAutoCommit;
1066 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1073 =item change HASHREF | OPTION => VALUE ...
1075 Changes this package: cancels it and creates a new one, with a different
1076 pkgpart or locationnum or both. All services are transferred to the new
1077 package (no change will be made if this is not possible).
1079 Options may be passed as a list of key/value pairs or as a hash reference.
1086 New locationnum, to change the location for this package.
1090 New FS::cust_location object, to create a new location and assign it
1095 New pkgpart (see L<FS::part_pkg>).
1099 New refnum (see L<FS::part_referral>).
1103 At least one option must be specified (otherwise, what's the point?)
1105 Returns either the new FS::cust_pkg object or a scalar error.
1109 my $err_or_new_cust_pkg = $old_cust_pkg->change
1113 #some false laziness w/order
1116 my $opt = ref($_[0]) ? shift : { @_ };
1118 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1121 my $conf = new FS::Conf;
1123 # Transactionize this whole mess
1124 local $SIG{HUP} = 'IGNORE';
1125 local $SIG{INT} = 'IGNORE';
1126 local $SIG{QUIT} = 'IGNORE';
1127 local $SIG{TERM} = 'IGNORE';
1128 local $SIG{TSTP} = 'IGNORE';
1129 local $SIG{PIPE} = 'IGNORE';
1131 my $oldAutoCommit = $FS::UID::AutoCommit;
1132 local $FS::UID::AutoCommit = 0;
1141 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1143 #$hash{$_} = $self->$_() foreach qw( setup );
1145 $hash{'setup'} = $time if $self->setup;
1147 $hash{'change_date'} = $time;
1148 $hash{"change_$_"} = $self->$_()
1149 foreach qw( pkgnum pkgpart locationnum );
1151 if ( $opt->{'cust_location'} &&
1152 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1153 $error = $opt->{'cust_location'}->insert;
1155 $dbh->rollback if $oldAutoCommit;
1156 return "inserting cust_location (transaction rolled back): $error";
1158 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1161 # Create the new package.
1162 my $cust_pkg = new FS::cust_pkg {
1163 custnum => $self->custnum,
1164 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1165 refnum => ( $opt->{'refnum'} || $self->refnum ),
1166 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1170 $error = $cust_pkg->insert( 'change' => 1 );
1172 $dbh->rollback if $oldAutoCommit;
1176 # Transfer services and cancel old package.
1178 $error = $self->transfer($cust_pkg);
1179 if ($error and $error == 0) {
1180 # $old_pkg->transfer failed.
1181 $dbh->rollback if $oldAutoCommit;
1185 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1186 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1187 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1188 if ($error and $error == 0) {
1189 # $old_pkg->transfer failed.
1190 $dbh->rollback if $oldAutoCommit;
1196 # Transfers were successful, but we still had services left on the old
1197 # package. We can't change the package under this circumstances, so abort.
1198 $dbh->rollback if $oldAutoCommit;
1199 return "Unable to transfer all services from package ". $self->pkgnum;
1202 #reset usage if changing pkgpart
1203 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1204 if ($self->pkgpart != $cust_pkg->pkgpart) {
1205 my $part_pkg = $cust_pkg->part_pkg;
1206 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1210 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1213 $dbh->rollback if $oldAutoCommit;
1214 return "Error setting usage values: $error";
1218 #Good to go, cancel old package.
1219 $error = $self->cancel( quiet=>1 );
1221 $dbh->rollback if $oldAutoCommit;
1225 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1227 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1229 $dbh->rollback if $oldAutoCommit;
1234 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1242 Returns the last bill date, or if there is no last bill date, the setup date.
1243 Useful for billing metered services.
1249 return $self->setfield('last_bill', $_[0]) if @_;
1250 return $self->getfield('last_bill') if $self->getfield('last_bill');
1251 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1252 'edate' => $self->bill, } );
1253 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1256 =item last_cust_pkg_reason ACTION
1258 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1259 Returns false if there is no reason or the package is not currenly ACTION'd
1260 ACTION is one of adjourn, susp, cancel, or expire.
1264 sub last_cust_pkg_reason {
1265 my ( $self, $action ) = ( shift, shift );
1266 my $date = $self->get($action);
1268 'table' => 'cust_pkg_reason',
1269 'hashref' => { 'pkgnum' => $self->pkgnum,
1270 'action' => substr(uc($action), 0, 1),
1273 'order_by' => 'ORDER BY num DESC LIMIT 1',
1277 =item last_reason ACTION
1279 Returns the most recent ACTION FS::reason associated with the package.
1280 Returns false if there is no reason or the package is not currenly ACTION'd
1281 ACTION is one of adjourn, susp, cancel, or expire.
1286 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1287 $cust_pkg_reason->reason
1288 if $cust_pkg_reason;
1293 Returns the definition for this billing item, as an FS::part_pkg object (see
1300 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1301 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1302 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1307 Returns the cancelled package this package was changed from, if any.
1313 return '' unless $self->change_pkgnum;
1314 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1319 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1326 $self->part_pkg->calc_setup($self, @_);
1331 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1338 $self->part_pkg->calc_recur($self, @_);
1343 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1350 $self->part_pkg->calc_remain($self, @_);
1355 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1362 $self->part_pkg->calc_cancel($self, @_);
1367 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1373 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1376 =item cust_pkg_detail [ DETAILTYPE ]
1378 Returns any customer package details for this package (see
1379 L<FS::cust_pkg_detail>).
1381 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1385 sub cust_pkg_detail {
1387 my %hash = ( 'pkgnum' => $self->pkgnum );
1388 $hash{detailtype} = shift if @_;
1390 'table' => 'cust_pkg_detail',
1391 'hashref' => \%hash,
1392 'order_by' => 'ORDER BY weight, pkgdetailnum',
1396 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1398 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1400 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1402 If there is an error, returns the error, otherwise returns false.
1406 sub set_cust_pkg_detail {
1407 my( $self, $detailtype, @details ) = @_;
1409 local $SIG{HUP} = 'IGNORE';
1410 local $SIG{INT} = 'IGNORE';
1411 local $SIG{QUIT} = 'IGNORE';
1412 local $SIG{TERM} = 'IGNORE';
1413 local $SIG{TSTP} = 'IGNORE';
1414 local $SIG{PIPE} = 'IGNORE';
1416 my $oldAutoCommit = $FS::UID::AutoCommit;
1417 local $FS::UID::AutoCommit = 0;
1420 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1421 my $error = $current->delete;
1423 $dbh->rollback if $oldAutoCommit;
1424 return "error removing old detail: $error";
1428 foreach my $detail ( @details ) {
1429 my $cust_pkg_detail = new FS::cust_pkg_detail {
1430 'pkgnum' => $self->pkgnum,
1431 'detailtype' => $detailtype,
1432 'detail' => $detail,
1434 my $error = $cust_pkg_detail->insert;
1436 $dbh->rollback if $oldAutoCommit;
1437 return "error adding new detail: $error";
1442 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1449 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1453 #false laziness w/cust_bill.pm
1457 'table' => 'cust_event',
1458 'addl_from' => 'JOIN part_event USING ( eventpart )',
1459 'hashref' => { 'tablenum' => $self->pkgnum },
1460 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1464 =item num_cust_event
1466 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1470 #false laziness w/cust_bill.pm
1471 sub num_cust_event {
1474 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1475 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1476 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1477 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1478 $sth->fetchrow_arrayref->[0];
1481 =item cust_svc [ SVCPART ]
1483 Returns the services for this package, as FS::cust_svc objects (see
1484 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1492 return () unless $self->num_cust_svc(@_);
1495 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1496 'svcpart' => shift, } );
1499 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1501 #if ( $self->{'_svcnum'} ) {
1502 # values %{ $self->{'_svcnum'}->cache };
1504 $self->_sort_cust_svc(
1505 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1511 =item overlimit [ SVCPART ]
1513 Returns the services for this package which have exceeded their
1514 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1515 is specified, return only the matching services.
1521 return () unless $self->num_cust_svc(@_);
1522 grep { $_->overlimit } $self->cust_svc(@_);
1525 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1527 Returns historical services for this package created before END TIMESTAMP and
1528 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1529 (see L<FS::h_cust_svc>).
1536 $self->_sort_cust_svc(
1537 [ qsearch( 'h_cust_svc',
1538 { 'pkgnum' => $self->pkgnum, },
1539 FS::h_cust_svc->sql_h_search(@_),
1545 sub _sort_cust_svc {
1546 my( $self, $arrayref ) = @_;
1549 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1554 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1555 'svcpart' => $_->svcpart } );
1557 $pkg_svc ? $pkg_svc->primary_svc : '',
1558 $pkg_svc ? $pkg_svc->quantity : 0,
1565 =item num_cust_svc [ SVCPART ]
1567 Returns the number of provisioned services for this package. If a svcpart is
1568 specified, counts only the matching services.
1575 return $self->{'_num_cust_svc'}
1577 && exists($self->{'_num_cust_svc'})
1578 && $self->{'_num_cust_svc'} =~ /\d/;
1580 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1583 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1584 $sql .= ' AND svcpart = ?' if @_;
1586 my $sth = dbh->prepare($sql) or die dbh->errstr;
1587 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1588 $sth->fetchrow_arrayref->[0];
1591 =item available_part_svc
1593 Returns a list of FS::part_svc objects representing services included in this
1594 package but not yet provisioned. Each FS::part_svc object also has an extra
1595 field, I<num_avail>, which specifies the number of available services.
1599 sub available_part_svc {
1601 grep { $_->num_avail > 0 }
1603 my $part_svc = $_->part_svc;
1604 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1605 $_->quantity - $self->num_cust_svc($_->svcpart);
1608 $self->part_pkg->pkg_svc;
1613 Returns a list of FS::part_svc objects representing provisioned and available
1614 services included in this package. Each FS::part_svc object also has the
1615 following extra fields:
1619 =item num_cust_svc (count)
1621 =item num_avail (quantity - count)
1623 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1626 label -> ($cust_svc->label)[1]
1635 #XXX some sort of sort order besides numeric by svcpart...
1636 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1638 my $part_svc = $pkg_svc->part_svc;
1639 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1640 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1641 $part_svc->{'Hash'}{'num_avail'} =
1642 max( 0, $pkg_svc->quantity - $num_cust_svc );
1643 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1644 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1646 } $self->part_pkg->pkg_svc;
1649 push @part_svc, map {
1651 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1652 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1653 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1654 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1655 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1657 } $self->extra_part_svc;
1663 =item extra_part_svc
1665 Returns a list of FS::part_svc objects corresponding to services in this
1666 package which are still provisioned but not (any longer) available in the
1671 sub extra_part_svc {
1674 my $pkgnum = $self->pkgnum;
1675 my $pkgpart = $self->pkgpart;
1678 # 'table' => 'part_svc',
1681 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1682 # WHERE pkg_svc.svcpart = part_svc.svcpart
1683 # AND pkg_svc.pkgpart = ?
1686 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1687 # LEFT JOIN cust_pkg USING ( pkgnum )
1688 # WHERE cust_svc.svcpart = part_svc.svcpart
1691 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1694 #seems to benchmark slightly faster...
1696 'select' => 'DISTINCT ON (svcpart) part_svc.*',
1697 'table' => 'part_svc',
1699 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1700 AND pkg_svc.pkgpart = ?
1703 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1704 LEFT JOIN cust_pkg USING ( pkgnum )
1707 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1708 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1714 Returns a short status string for this package, currently:
1718 =item not yet billed
1720 =item one-time charge
1735 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1737 return 'cancelled' if $self->get('cancel');
1738 return 'suspended' if $self->susp;
1739 return 'not yet billed' unless $self->setup;
1740 return 'one-time charge' if $freq =~ /^(0|$)/;
1746 Class method that returns the list of possible status strings for packages
1747 (see L<the status method|/status>). For example:
1749 @statuses = FS::cust_pkg->statuses();
1753 tie my %statuscolor, 'Tie::IxHash',
1754 'not yet billed' => '000000',
1755 'one-time charge' => '000000',
1756 'active' => '00CC00',
1757 'suspended' => 'FF9900',
1758 'cancelled' => 'FF0000',
1762 my $self = shift; #could be class...
1763 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1764 # # mayble split btw one-time vs. recur
1770 Returns a hex triplet color string for this package's status.
1776 $statuscolor{$self->status};
1781 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1782 "pkg-comment" depending on user preference).
1788 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1789 $label = $self->pkgnum. ": $label"
1790 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1794 =item pkg_label_long
1796 Returns a long label for this package, adding the primary service's label to
1801 sub pkg_label_long {
1803 my $label = $self->pkg_label;
1804 my $cust_svc = $self->primary_cust_svc;
1805 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1809 =item primary_cust_svc
1811 Returns a primary service (as FS::cust_svc object) if one can be identified.
1815 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1817 sub primary_cust_svc {
1820 my @cust_svc = $self->cust_svc;
1822 return '' unless @cust_svc; #no serivces - irrelevant then
1824 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1826 # primary service as specified in the package definition
1827 # or exactly one service definition with quantity one
1828 my $svcpart = $self->part_pkg->svcpart;
1829 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1830 return $cust_svc[0] if scalar(@cust_svc) == 1;
1832 #couldn't identify one thing..
1838 Returns a list of lists, calling the label method for all services
1839 (see L<FS::cust_svc>) of this billing item.
1845 map { [ $_->label ] } $self->cust_svc;
1848 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1850 Like the labels method, but returns historical information on services that
1851 were active as of END_TIMESTAMP and (optionally) not cancelled before
1854 Returns a list of lists, calling the label method for all (historical) services
1855 (see L<FS::h_cust_svc>) of this billing item.
1861 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1866 Like labels, except returns a simple flat list, and shortens long
1867 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1868 identical services to one line that lists the service label and the number of
1869 individual services rather than individual items.
1874 shift->_labels_short( 'labels', @_ );
1877 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1879 Like h_labels, except returns a simple flat list, and shortens long
1880 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1881 identical services to one line that lists the service label and the number of
1882 individual services rather than individual items.
1886 sub h_labels_short {
1887 shift->_labels_short( 'h_labels', @_ );
1891 my( $self, $method ) = ( shift, shift );
1893 my $conf = new FS::Conf;
1894 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1897 #tie %labels, 'Tie::IxHash';
1898 push @{ $labels{$_->[0]} }, $_->[1]
1899 foreach $self->h_labels(@_);
1901 foreach my $label ( keys %labels ) {
1903 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1904 my $num = scalar(@values);
1905 if ( $num > $max_same_services ) {
1906 push @labels, "$label ($num)";
1908 if ( $conf->exists('cust_bill-consolidate_services') ) {
1909 # push @labels, "$label: ". join(', ', @values);
1911 my $detail = "$label: ";
1912 $detail .= shift(@values). ', '
1913 while @values && length($detail.$values[0]) < 78;
1915 push @labels, $detail;
1918 push @labels, map { "$label: $_" } @values;
1929 Returns the parent customer object (see L<FS::cust_main>).
1935 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1940 Returns the location object, if any (see L<FS::cust_location>).
1946 return '' unless $self->locationnum;
1947 qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } );
1950 =item cust_location_or_main
1952 If this package is associated with a location, returns the locaiton (see
1953 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1957 sub cust_location_or_main {
1959 $self->cust_location || $self->cust_main;
1962 =item location_label [ OPTION => VALUE ... ]
1964 Returns the label of the location object (see L<FS::cust_location>).
1968 sub location_label {
1970 my $object = $self->cust_location_or_main;
1971 $object->location_label(@_);
1974 =item seconds_since TIMESTAMP
1976 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
1977 package have been online since TIMESTAMP, according to the session monitor.
1979 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
1980 L<Time::Local> and L<Date::Parse> for conversion functions.
1985 my($self, $since) = @_;
1988 foreach my $cust_svc (
1989 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
1991 $seconds += $cust_svc->seconds_since($since);
1998 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2000 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2001 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2004 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2005 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2011 sub seconds_since_sqlradacct {
2012 my($self, $start, $end) = @_;
2016 foreach my $cust_svc (
2018 my $part_svc = $_->part_svc;
2019 $part_svc->svcdb eq 'svc_acct'
2020 && scalar($part_svc->part_export('sqlradius'));
2023 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2030 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2032 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2033 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2037 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2038 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2043 sub attribute_since_sqlradacct {
2044 my($self, $start, $end, $attrib) = @_;
2048 foreach my $cust_svc (
2050 my $part_svc = $_->part_svc;
2051 $part_svc->svcdb eq 'svc_acct'
2052 && scalar($part_svc->part_export('sqlradius'));
2055 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2067 my( $self, $value ) = @_;
2068 if ( defined($value) ) {
2069 $self->setfield('quantity', $value);
2071 $self->getfield('quantity') || 1;
2074 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2076 Transfers as many services as possible from this package to another package.
2078 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2079 object. The destination package must already exist.
2081 Services are moved only if the destination allows services with the correct
2082 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2083 this option with caution! No provision is made for export differences
2084 between the old and new service definitions. Probably only should be used
2085 when your exports for all service definitions of a given svcdb are identical.
2086 (attempt a transfer without it first, to move all possible svcpart-matching
2089 Any services that can't be moved remain in the original package.
2091 Returns an error, if there is one; otherwise, returns the number of services
2092 that couldn't be moved.
2097 my ($self, $dest_pkgnum, %opt) = @_;
2103 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2104 $dest = $dest_pkgnum;
2105 $dest_pkgnum = $dest->pkgnum;
2107 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2110 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2112 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2113 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2116 foreach my $cust_svc ($dest->cust_svc) {
2117 $target{$cust_svc->svcpart}--;
2120 my %svcpart2svcparts = ();
2121 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2122 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2123 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2124 next if exists $svcpart2svcparts{$svcpart};
2125 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2126 $svcpart2svcparts{$svcpart} = [
2128 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2130 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2131 'svcpart' => $_ } );
2133 $pkg_svc ? $pkg_svc->primary_svc : '',
2134 $pkg_svc ? $pkg_svc->quantity : 0,
2138 grep { $_ != $svcpart }
2140 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2142 warn "alternates for svcpart $svcpart: ".
2143 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2148 foreach my $cust_svc ($self->cust_svc) {
2149 if($target{$cust_svc->svcpart} > 0) {
2150 $target{$cust_svc->svcpart}--;
2151 my $new = new FS::cust_svc { $cust_svc->hash };
2152 $new->pkgnum($dest_pkgnum);
2153 my $error = $new->replace($cust_svc);
2154 return $error if $error;
2155 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2157 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2158 warn "alternates to consider: ".
2159 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2161 my @alternate = grep {
2162 warn "considering alternate svcpart $_: ".
2163 "$target{$_} available in new package\n"
2166 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2168 warn "alternate(s) found\n" if $DEBUG;
2169 my $change_svcpart = $alternate[0];
2170 $target{$change_svcpart}--;
2171 my $new = new FS::cust_svc { $cust_svc->hash };
2172 $new->svcpart($change_svcpart);
2173 $new->pkgnum($dest_pkgnum);
2174 my $error = $new->replace($cust_svc);
2175 return $error if $error;
2188 This method is deprecated. See the I<depend_jobnum> option to the insert and
2189 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2196 local $SIG{HUP} = 'IGNORE';
2197 local $SIG{INT} = 'IGNORE';
2198 local $SIG{QUIT} = 'IGNORE';
2199 local $SIG{TERM} = 'IGNORE';
2200 local $SIG{TSTP} = 'IGNORE';
2201 local $SIG{PIPE} = 'IGNORE';
2203 my $oldAutoCommit = $FS::UID::AutoCommit;
2204 local $FS::UID::AutoCommit = 0;
2207 foreach my $cust_svc ( $self->cust_svc ) {
2208 #false laziness w/svc_Common::insert
2209 my $svc_x = $cust_svc->svc_x;
2210 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2211 my $error = $part_export->export_insert($svc_x);
2213 $dbh->rollback if $oldAutoCommit;
2219 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2226 Associates this package with a (suspension or cancellation) reason (see
2227 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2230 Available options are:
2236 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.
2240 the access_user (see L<FS::access_user>) providing the reason
2248 the action (cancel, susp, adjourn, expire) associated with the reason
2252 If there is an error, returns the error, otherwise returns false.
2257 my ($self, %options) = @_;
2259 my $otaker = $options{reason_otaker} ||
2260 $FS::CurrentUser::CurrentUser->username;
2263 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2267 } elsif ( ref($options{'reason'}) ) {
2269 return 'Enter a new reason (or select an existing one)'
2270 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2272 my $reason = new FS::reason({
2273 'reason_type' => $options{'reason'}->{'typenum'},
2274 'reason' => $options{'reason'}->{'reason'},
2276 my $error = $reason->insert;
2277 return $error if $error;
2279 $reasonnum = $reason->reasonnum;
2282 return "Unparsable reason: ". $options{'reason'};
2285 my $cust_pkg_reason =
2286 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2287 'reasonnum' => $reasonnum,
2288 'otaker' => $otaker,
2289 'action' => substr(uc($options{'action'}),0,1),
2290 'date' => $options{'date'}
2295 $cust_pkg_reason->insert;
2298 =item insert_discount
2300 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2301 inserting a new discount on the fly (see L<FS::discount>).
2303 Available options are:
2311 If there is an error, returns the error, otherwise returns false.
2315 sub insert_discount {
2316 #my ($self, %options) = @_;
2319 my $cust_pkg_discount = new FS::cust_pkg_discount {
2320 'pkgnum' => $self->pkgnum,
2321 'discountnum' => $self->discountnum,
2323 'end_date' => '', #XXX
2324 'otaker' => $self->otaker,
2325 #for the create a new discount case
2326 '_type' => $self->discountnum__type,
2327 'amount' => $self->discountnum_amount,
2328 'percent' => $self->discountnum_percent,
2329 'months' => $self->discountnum_months,
2330 #'disabled' => $self->discountnum_disabled,
2333 $cust_pkg_discount->insert;
2336 =item set_usage USAGE_VALUE_HASHREF
2338 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2339 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2340 upbytes, downbytes, and totalbytes are appropriate keys.
2342 All svc_accts which are part of this package have their values reset.
2347 my ($self, $valueref, %opt) = @_;
2349 foreach my $cust_svc ($self->cust_svc){
2350 my $svc_x = $cust_svc->svc_x;
2351 $svc_x->set_usage($valueref, %opt)
2352 if $svc_x->can("set_usage");
2356 =item recharge USAGE_VALUE_HASHREF
2358 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2359 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2360 upbytes, downbytes, and totalbytes are appropriate keys.
2362 All svc_accts which are part of this package have their values incremented.
2367 my ($self, $valueref) = @_;
2369 foreach my $cust_svc ($self->cust_svc){
2370 my $svc_x = $cust_svc->svc_x;
2371 $svc_x->recharge($valueref)
2372 if $svc_x->can("recharge");
2376 =item cust_pkg_discount
2380 sub cust_pkg_discount {
2382 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2385 =item cust_pkg_discount_active
2389 sub cust_pkg_discount_active {
2391 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2396 =head1 CLASS METHODS
2402 Returns an SQL expression identifying recurring packages.
2406 sub recurring_sql { "
2407 '0' != ( select freq from part_pkg
2408 where cust_pkg.pkgpart = part_pkg.pkgpart )
2413 Returns an SQL expression identifying one-time packages.
2418 '0' = ( select freq from part_pkg
2419 where cust_pkg.pkgpart = part_pkg.pkgpart )
2424 Returns an SQL expression identifying active packages.
2429 ". $_[0]->recurring_sql(). "
2430 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2431 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2432 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2435 =item not_yet_billed_sql
2437 Returns an SQL expression identifying packages which have not yet been billed.
2441 sub not_yet_billed_sql { "
2442 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2443 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2444 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2449 Returns an SQL expression identifying inactive packages (one-time packages
2450 that are otherwise unsuspended/uncancelled).
2454 sub inactive_sql { "
2455 ". $_[0]->onetime_sql(). "
2456 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2457 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2458 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2464 Returns an SQL expression identifying suspended packages.
2468 sub suspended_sql { susp_sql(@_); }
2470 #$_[0]->recurring_sql(). ' AND '.
2472 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2473 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2480 Returns an SQL exprression identifying cancelled packages.
2484 sub cancelled_sql { cancel_sql(@_); }
2486 #$_[0]->recurring_sql(). ' AND '.
2487 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2490 =item search HASHREF
2494 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2495 Valid parameters are
2503 active, inactive, suspended, cancel (or cancelled)
2507 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2511 boolean selects custom packages
2517 pkgpart or arrayref or hashref of pkgparts
2521 arrayref of beginning and ending epoch date
2525 arrayref of beginning and ending epoch date
2529 arrayref of beginning and ending epoch date
2533 arrayref of beginning and ending epoch date
2537 arrayref of beginning and ending epoch date
2541 arrayref of beginning and ending epoch date
2545 arrayref of beginning and ending epoch date
2549 pkgnum or APKG_pkgnum
2553 a value suited to passing to FS::UI::Web::cust_header
2557 specifies the user for agent virtualization
2564 my ($class, $params) = @_;
2571 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2573 "cust_main.agentnum = $1";
2580 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2582 "cust_pkg.custnum = $1";
2589 if ( $params->{'magic'} eq 'active'
2590 || $params->{'status'} eq 'active' ) {
2592 push @where, FS::cust_pkg->active_sql();
2594 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2595 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2597 push @where, FS::cust_pkg->not_yet_billed_sql();
2599 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2600 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2602 push @where, FS::cust_pkg->inactive_sql();
2604 } elsif ( $params->{'magic'} eq 'suspended'
2605 || $params->{'status'} eq 'suspended' ) {
2607 push @where, FS::cust_pkg->suspended_sql();
2609 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2610 || $params->{'status'} =~ /^cancell?ed$/ ) {
2612 push @where, FS::cust_pkg->cancelled_sql();
2617 # parse package class
2620 #false lazinessish w/graph/cust_bill_pkg.cgi
2623 if ( exists($params->{'classnum'})
2624 && $params->{'classnum'} =~ /^(\d*)$/
2628 if ( $classnum ) { #a specific class
2629 push @where, "part_pkg.classnum = $classnum";
2631 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2632 #die "classnum $classnum not found!" unless $pkg_class[0];
2633 #$title .= $pkg_class[0]->classname.' ';
2635 } elsif ( $classnum eq '' ) { #the empty class
2637 push @where, "part_pkg.classnum IS NULL";
2638 #$title .= 'Empty class ';
2639 #@pkg_class = ( '(empty class)' );
2640 } elsif ( $classnum eq '0' ) {
2641 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2642 #push @pkg_class, '(empty class)';
2644 die "illegal classnum";
2650 # parse package report options
2653 my @report_option = ();
2654 if ( exists($params->{'report_option'})
2655 && $params->{'report_option'} =~ /^([,\d]*)$/
2658 @report_option = split(',', $1);
2661 if (@report_option) {
2662 # this will result in the empty set for the dangling comma case as it should
2664 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2665 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2666 AND optionname = 'report_option_$_'
2667 AND optionvalue = '1' )"
2677 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2683 if ( exists($params->{'censustract'}) ) {
2684 $params->{'censustract'} =~ /^([.\d]*)$/;
2685 my $censustract = "cust_main.censustract = '$1'";
2686 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2687 push @where, "( $censustract )";
2694 if ( ref($params->{'pkgpart'}) ) {
2697 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2698 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2699 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2700 @pkgpart = @{ $params->{'pkgpart'} };
2702 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2705 @pkgpart = grep /^(\d+)$/, @pkgpart;
2707 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2709 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2710 push @where, "pkgpart = $1";
2719 #false laziness w/report_cust_pkg.html
2722 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2723 'active' => { 'susp'=>1, 'cancel'=>1 },
2724 'suspended' => { 'cancel' => 1 },
2729 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2731 next unless exists($params->{$field});
2733 my($beginning, $ending) = @{$params->{$field}};
2735 next if $beginning == 0 && $ending == 4294967295;
2738 "cust_pkg.$field IS NOT NULL",
2739 "cust_pkg.$field >= $beginning",
2740 "cust_pkg.$field <= $ending";
2742 $orderby ||= "ORDER BY cust_pkg.$field";
2746 $orderby ||= 'ORDER BY bill';
2749 # parse magic, legacy, etc.
2752 if ( $params->{'magic'} &&
2753 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2756 $orderby = 'ORDER BY pkgnum';
2758 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2759 push @where, "pkgpart = $1";
2762 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2764 $orderby = 'ORDER BY pkgnum';
2766 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2768 $orderby = 'ORDER BY pkgnum';
2771 SELECT count(*) FROM pkg_svc
2772 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2773 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2774 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2775 AND cust_svc.svcpart = pkg_svc.svcpart
2782 # setup queries, links, subs, etc. for the search
2785 # here is the agent virtualization
2786 if ($params->{CurrentUser}) {
2788 qsearchs('access_user', { username => $params->{CurrentUser} });
2791 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2796 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2799 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2801 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2802 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2803 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2805 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2808 'table' => 'cust_pkg',
2810 'select' => join(', ',
2812 ( map "part_pkg.$_", qw( pkg freq ) ),
2813 'pkg_class.classname',
2814 'cust_main.custnum AS cust_main_custnum',
2815 FS::UI::Web::cust_sql_fields(
2816 $params->{'cust_fields'}
2819 'extra_sql' => "$extra_sql $orderby",
2820 'addl_from' => $addl_from,
2821 'count_query' => $count_query,
2828 Returns a list: the first item is an SQL fragment identifying matching
2829 packages/customers via location (taking into account shipping and package
2830 address taxation, if enabled), and subsequent items are the parameters to
2831 substitute for the placeholders in that fragment.
2836 my($class, %opt) = @_;
2837 my $ornull = $opt{'ornull'};
2839 my $conf = new FS::Conf;
2841 # '?' placeholders in _location_sql_where
2842 my $x = $ornull ? 3 : 2;
2843 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
2847 if ( $conf->exists('tax-ship_address') ) {
2850 ( ( ship_last IS NULL OR ship_last = '' )
2851 AND ". _location_sql_where('cust_main', '', $ornull ). "
2853 OR ( ship_last IS NOT NULL AND ship_last != ''
2854 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2857 # AND payby != 'COMP'
2859 @main_param = ( @bill_param, @bill_param );
2863 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2864 @main_param = @bill_param;
2870 if ( $conf->exists('tax-pkg_address') ) {
2872 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2875 ( cust_pkg.locationnum IS NULL AND $main_where )
2876 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2879 @param = ( @main_param, @bill_param );
2883 $where = $main_where;
2884 @param = @main_param;
2892 #subroutine, helper for location_sql
2893 sub _location_sql_where {
2895 my $prefix = @_ ? shift : '';
2896 my $ornull = @_ ? shift : '';
2898 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2900 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2902 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
2903 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
2904 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
2906 # ( $table.${prefix}city = ? $or_empty_city $ornull )
2908 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
2909 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
2910 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
2911 AND $table.${prefix}country = ?
2919 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
2921 CUSTNUM is a customer (see L<FS::cust_main>)
2923 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
2924 L<FS::part_pkg>) to order for this customer. Duplicates are of course
2927 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
2928 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
2929 new billing items. An error is returned if this is not possible (see
2930 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
2933 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
2934 newly-created cust_pkg objects.
2936 REFNUM, if specified, will specify the FS::pkg_referral record to be created
2937 and inserted. Multiple FS::pkg_referral records can be created by
2938 setting I<refnum> to an array reference of refnums or a hash reference with
2939 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
2940 record will be created corresponding to cust_main.refnum.
2945 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
2947 my $conf = new FS::Conf;
2949 # Transactionize this whole mess
2950 local $SIG{HUP} = 'IGNORE';
2951 local $SIG{INT} = 'IGNORE';
2952 local $SIG{QUIT} = 'IGNORE';
2953 local $SIG{TERM} = 'IGNORE';
2954 local $SIG{TSTP} = 'IGNORE';
2955 local $SIG{PIPE} = 'IGNORE';
2957 my $oldAutoCommit = $FS::UID::AutoCommit;
2958 local $FS::UID::AutoCommit = 0;
2962 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
2963 # return "Customer not found: $custnum" unless $cust_main;
2965 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
2968 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
2971 my $change = scalar(@old_cust_pkg) != 0;
2974 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
2976 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
2977 " to pkgpart ". $pkgparts->[0]. "\n"
2980 my $err_or_cust_pkg =
2981 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
2982 'refnum' => $refnum,
2985 unless (ref($err_or_cust_pkg)) {
2986 $dbh->rollback if $oldAutoCommit;
2987 return $err_or_cust_pkg;
2990 push @$return_cust_pkg, $err_or_cust_pkg;
2991 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2996 # Create the new packages.
2997 foreach my $pkgpart (@$pkgparts) {
2999 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3001 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3002 pkgpart => $pkgpart,
3006 $error = $cust_pkg->insert( 'change' => $change );
3008 $dbh->rollback if $oldAutoCommit;
3011 push @$return_cust_pkg, $cust_pkg;
3013 # $return_cust_pkg now contains refs to all of the newly
3016 # Transfer services and cancel old packages.
3017 foreach my $old_pkg (@old_cust_pkg) {
3019 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3022 foreach my $new_pkg (@$return_cust_pkg) {
3023 $error = $old_pkg->transfer($new_pkg);
3024 if ($error and $error == 0) {
3025 # $old_pkg->transfer failed.
3026 $dbh->rollback if $oldAutoCommit;
3031 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3032 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3033 foreach my $new_pkg (@$return_cust_pkg) {
3034 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3035 if ($error and $error == 0) {
3036 # $old_pkg->transfer failed.
3037 $dbh->rollback if $oldAutoCommit;
3044 # Transfers were successful, but we went through all of the
3045 # new packages and still had services left on the old package.
3046 # We can't cancel the package under the circumstances, so abort.
3047 $dbh->rollback if $oldAutoCommit;
3048 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3050 $error = $old_pkg->cancel( quiet=>1 );
3056 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3060 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3062 A bulk change method to change packages for multiple customers.
3064 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3065 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3068 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3069 replace. The services (see L<FS::cust_svc>) are moved to the
3070 new billing items. An error is returned if this is not possible (see
3073 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3074 newly-created cust_pkg objects.
3079 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3081 # Transactionize this whole mess
3082 local $SIG{HUP} = 'IGNORE';
3083 local $SIG{INT} = 'IGNORE';
3084 local $SIG{QUIT} = 'IGNORE';
3085 local $SIG{TERM} = 'IGNORE';
3086 local $SIG{TSTP} = 'IGNORE';
3087 local $SIG{PIPE} = 'IGNORE';
3089 my $oldAutoCommit = $FS::UID::AutoCommit;
3090 local $FS::UID::AutoCommit = 0;
3094 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3097 while(scalar(@old_cust_pkg)) {
3099 my $custnum = $old_cust_pkg[0]->custnum;
3100 my (@remove) = map { $_->pkgnum }
3101 grep { $_->custnum == $custnum } @old_cust_pkg;
3102 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3104 my $error = order $custnum, $pkgparts, \@remove, \@return;
3106 push @errors, $error
3108 push @$return_cust_pkg, @return;
3111 if (scalar(@errors)) {
3112 $dbh->rollback if $oldAutoCommit;
3113 return join(' / ', @errors);
3116 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3124 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3126 In sub order, the @pkgparts array (passed by reference) is clobbered.
3128 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3129 method to pass dates to the recur_prog expression, it should do so.
3131 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3132 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3133 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3134 configuration values. Probably need a subroutine which decides what to do
3135 based on whether or not we've fetched the user yet, rather than a hash. See
3136 FS::UID and the TODO.
3138 Now that things are transactional should the check in the insert method be
3143 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3144 L<FS::pkg_svc>, schema.html from the base documentation