4 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
5 FS::m2m_Common FS::option_Common );
6 use vars qw($disable_agentcheck $DEBUG $me);
8 use Scalar::Util qw( blessed );
9 use List::Util qw(max);
11 use Time::Local qw( timelocal_nocheck );
13 use FS::UID qw( getotaker dbh );
14 use FS::Misc qw( send_email );
15 use FS::Record qw( qsearch qsearchs );
19 use FS::cust_location;
21 use FS::cust_bill_pkg;
22 use FS::cust_pkg_detail;
27 use FS::cust_pkg_reason;
29 use FS::cust_pkg_discount;
33 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
35 # because they load configuration by setting FS::UID::callback (see TODO)
41 # for sending cancel emails in sub cancel
45 $me = '[FS::cust_pkg]';
47 $disable_agentcheck = 0;
51 my ( $hashref, $cache ) = @_;
52 #if ( $hashref->{'pkgpart'} ) {
53 if ( $hashref->{'pkg'} ) {
54 # #@{ $self->{'_pkgnum'} } = ();
55 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
56 # $self->{'_pkgpart'} = $subcache;
57 # #push @{ $self->{'_pkgnum'} },
58 # FS::part_pkg->new_or_cached($hashref, $subcache);
59 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
61 if ( exists $hashref->{'svcnum'} ) {
62 #@{ $self->{'_pkgnum'} } = ();
63 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
64 $self->{'_svcnum'} = $subcache;
65 #push @{ $self->{'_pkgnum'} },
66 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
72 FS::cust_pkg - Object methods for cust_pkg objects
78 $record = new FS::cust_pkg \%hash;
79 $record = new FS::cust_pkg { 'column' => 'value' };
81 $error = $record->insert;
83 $error = $new_record->replace($old_record);
85 $error = $record->delete;
87 $error = $record->check;
89 $error = $record->cancel;
91 $error = $record->suspend;
93 $error = $record->unsuspend;
95 $part_pkg = $record->part_pkg;
97 @labels = $record->labels;
99 $seconds = $record->seconds_since($timestamp);
101 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
102 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
106 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
107 inherits from FS::Record. The following fields are currently supported:
113 Primary key (assigned automatically for new billing items)
117 Customer (see L<FS::cust_main>)
121 Billing item definition (see L<FS::part_pkg>)
125 Optional link to package location (see L<FS::location>)
137 date (next bill date)
161 order taker (see L<FS::access_user>)
165 If this field is set to 1, disables the automatic
166 unsuspension of this package when using the B<unsuspendauto> config option.
170 If not set, defaults to 1
174 Date of change from previous package
184 =item change_locationnum
190 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
191 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
192 L<Time::Local> and L<Date::Parse> for conversion functions.
200 Create a new billing item. To add the item to the database, see L<"insert">.
204 sub table { 'cust_pkg'; }
205 sub cust_linked { $_[0]->cust_main_custnum; }
206 sub cust_unlinked_msg {
208 "WARNING: can't find cust_main.custnum ". $self->custnum.
209 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
212 =item insert [ OPTION => VALUE ... ]
214 Adds this billing item to the database ("Orders" the item). If there is an
215 error, returns the error, otherwise returns false.
217 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
218 will be used to look up the package definition and agent restrictions will be
221 If the additional field I<refnum> is defined, an FS::pkg_referral record will
222 be created and inserted. Multiple FS::pkg_referral records can be created by
223 setting I<refnum> to an array reference of refnums or a hash reference with
224 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
225 record will be created corresponding to cust_main.refnum.
227 The following options are available:
233 If set true, supresses any referral credit to a referring customer.
237 cust_pkg_option records will be created
241 a ticket will be added to this customer with this subject
245 an optional queue name for ticket additions
252 my( $self, %options ) = @_;
254 if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
255 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
256 $mon += 1 unless $mday == 1;
257 until ( $mon < 12 ) { $mon -= 12; $year++; }
258 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
261 my $expire_months = $self->part_pkg->option('expire_months', 1);
262 if ( $expire_months && !$self->expire ) {
263 my $start = $self->start_date || $self->setup || time;
265 #false laziness w/part_pkg::add_freq
266 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5];
267 $mon += $expire_months;
268 until ( $mon < 12 ) { $mon -= 12; $year++; }
270 #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) );
271 $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) );
274 local $SIG{HUP} = 'IGNORE';
275 local $SIG{INT} = 'IGNORE';
276 local $SIG{QUIT} = 'IGNORE';
277 local $SIG{TERM} = 'IGNORE';
278 local $SIG{TSTP} = 'IGNORE';
279 local $SIG{PIPE} = 'IGNORE';
281 my $oldAutoCommit = $FS::UID::AutoCommit;
282 local $FS::UID::AutoCommit = 0;
285 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
287 $dbh->rollback if $oldAutoCommit;
291 $self->refnum($self->cust_main->refnum) unless $self->refnum;
292 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
293 $self->process_m2m( 'link_table' => 'pkg_referral',
294 'target_table' => 'part_referral',
295 'params' => $self->refnum,
298 if ( $self->discountnum ) {
299 my $error = $self->insert_discount();
301 $dbh->rollback if $oldAutoCommit;
306 #if ( $self->reg_code ) {
307 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
308 # $error = $reg_code->delete;
310 # $dbh->rollback if $oldAutoCommit;
315 my $conf = new FS::Conf;
317 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
320 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
327 use FS::TicketSystem;
328 FS::TicketSystem->init();
330 my $q = new RT::Queue($RT::SystemUser);
331 $q->Load($options{ticket_queue}) if $options{ticket_queue};
332 my $t = new RT::Ticket($RT::SystemUser);
333 my $mime = new MIME::Entity;
334 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
335 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
336 Subject => $options{ticket_subject},
339 $t->AddLink( Type => 'MemberOf',
340 Target => 'freeside://freeside/cust_main/'. $self->custnum,
344 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
345 my $queue = new FS::queue {
346 'job' => 'FS::cust_main::queueable_print',
348 $error = $queue->insert(
349 'custnum' => $self->custnum,
350 'template' => 'welcome_letter',
354 warn "can't send welcome letter: $error";
359 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
366 This method now works but you probably shouldn't use it.
368 You don't want to delete billing items, because there would then be no record
369 the customer ever purchased the item. Instead, see the cancel method.
374 # return "Can't delete cust_pkg records!";
377 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
379 Replaces the OLD_RECORD with this one in the database. If there is an error,
380 returns the error, otherwise returns false.
382 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
384 Changing pkgpart may have disasterous effects. See the order subroutine.
386 setup and bill are normally updated by calling the bill method of a customer
387 object (see L<FS::cust_main>).
389 suspend is normally updated by the suspend and unsuspend methods.
391 cancel is normally updated by the cancel method (and also the order subroutine
394 Available options are:
400 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.
404 the access_user (see L<FS::access_user>) providing the reason
408 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
417 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
422 ( ref($_[0]) eq 'HASH' )
426 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
427 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
430 #return "Can't change setup once it exists!"
431 # if $old->getfield('setup') &&
432 # $old->getfield('setup') != $new->getfield('setup');
434 #some logic for bill, susp, cancel?
436 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
438 local $SIG{HUP} = 'IGNORE';
439 local $SIG{INT} = 'IGNORE';
440 local $SIG{QUIT} = 'IGNORE';
441 local $SIG{TERM} = 'IGNORE';
442 local $SIG{TSTP} = 'IGNORE';
443 local $SIG{PIPE} = 'IGNORE';
445 my $oldAutoCommit = $FS::UID::AutoCommit;
446 local $FS::UID::AutoCommit = 0;
449 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
450 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
451 my $error = $new->insert_reason(
452 'reason' => $options->{'reason'},
453 'date' => $new->$method,
455 'reason_otaker' => $options->{'reason_otaker'},
458 dbh->rollback if $oldAutoCommit;
459 return "Error inserting cust_pkg_reason: $error";
464 #save off and freeze RADIUS attributes for any associated svc_acct records
466 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
468 #also check for specific exports?
469 # to avoid spurious modify export events
470 @svc_acct = map { $_->svc_x }
471 grep { $_->part_svc->svcdb eq 'svc_acct' }
474 $_->snapshot foreach @svc_acct;
478 my $error = $new->SUPER::replace($old,
479 $options->{options} ? $options->{options} : ()
482 $dbh->rollback if $oldAutoCommit;
486 #for prepaid packages,
487 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
488 foreach my $old_svc_acct ( @svc_acct ) {
489 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
490 my $s_error = $new_svc_acct->replace($old_svc_acct);
492 $dbh->rollback if $oldAutoCommit;
497 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
504 Checks all fields to make sure this is a valid billing item. If there is an
505 error, returns the error, otherwise returns false. Called by the insert and
513 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
516 $self->ut_numbern('pkgnum')
517 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
518 || $self->ut_numbern('pkgpart')
519 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
520 || $self->ut_numbern('start_date')
521 || $self->ut_numbern('setup')
522 || $self->ut_numbern('bill')
523 || $self->ut_numbern('susp')
524 || $self->ut_numbern('cancel')
525 || $self->ut_numbern('adjourn')
526 || $self->ut_numbern('expire')
527 || $self->ut_enum('no_auto', [ '', 'Y' ])
529 return $error if $error;
531 if ( $self->reg_code ) {
533 unless ( grep { $self->pkgpart == $_->pkgpart }
534 map { $_->reg_code_pkg }
535 qsearchs( 'reg_code', { 'code' => $self->reg_code,
536 'agentnum' => $self->cust_main->agentnum })
538 return "Unknown registration code";
541 } elsif ( $self->promo_code ) {
544 qsearchs('part_pkg', {
545 'pkgpart' => $self->pkgpart,
546 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
548 return 'Unknown promotional code' unless $promo_part_pkg;
552 unless ( $disable_agentcheck ) {
554 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
555 return "agent ". $agent->agentnum. ':'. $agent->agent.
556 " can't purchase pkgpart ". $self->pkgpart
557 unless $agent->pkgpart_hashref->{ $self->pkgpart }
558 || $agent->agentnum == $self->part_pkg->agentnum;
561 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
562 return $error if $error;
566 $self->otaker(getotaker) unless $self->otaker;
568 if ( $self->dbdef_table->column('manual_flag') ) {
569 $self->manual_flag('') if $self->manual_flag eq ' ';
570 $self->manual_flag =~ /^([01]?)$/
571 or return "Illegal manual_flag ". $self->manual_flag;
572 $self->manual_flag($1);
578 =item cancel [ OPTION => VALUE ... ]
580 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
581 in this package, then cancels the package itself (sets the cancel field to
584 Available options are:
588 =item quiet - can be set true to supress email cancellation notices.
590 =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.
592 =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.
594 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
596 =item nobill - can be set true to skip billing if it might otherwise be done.
600 If there is an error, returns the error, otherwise returns false.
605 my( $self, %options ) = @_;
608 my $conf = new FS::Conf;
610 warn "cust_pkg::cancel called with options".
611 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
614 local $SIG{HUP} = 'IGNORE';
615 local $SIG{INT} = 'IGNORE';
616 local $SIG{QUIT} = 'IGNORE';
617 local $SIG{TERM} = 'IGNORE';
618 local $SIG{TSTP} = 'IGNORE';
619 local $SIG{PIPE} = 'IGNORE';
621 my $oldAutoCommit = $FS::UID::AutoCommit;
622 local $FS::UID::AutoCommit = 0;
625 my $old = $self->select_for_update;
627 if ( $old->get('cancel') || $self->get('cancel') ) {
628 dbh->rollback if $oldAutoCommit;
629 return ""; # no error
632 my $date = $options{date} if $options{date}; # expire/cancel later
633 $date = '' if ($date && $date <= time); # complain instead?
635 #race condition: usage could be ongoing until unprovisioned
636 #resolved by performing a change package instead (which unprovisions) and
638 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
639 my $copy = $self->new({$self->hash});
641 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
642 warn "Error billing during cancel, custnum ".
643 #$self->cust_main->custnum. ": $error"
649 my $cancel_time = $options{'time'} || time;
651 if ( $options{'reason'} ) {
652 $error = $self->insert_reason( 'reason' => $options{'reason'},
653 'action' => $date ? 'expire' : 'cancel',
654 'date' => $date ? $date : $cancel_time,
655 'reason_otaker' => $options{'reason_otaker'},
658 dbh->rollback if $oldAutoCommit;
659 return "Error inserting cust_pkg_reason: $error";
665 foreach my $cust_svc (
668 sort { $a->[1] <=> $b->[1] }
669 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
670 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
673 my $error = $cust_svc->cancel;
676 $dbh->rollback if $oldAutoCommit;
677 return "Error cancelling cust_svc: $error";
681 # Add a credit for remaining service
682 my $remaining_value = $self->calc_remain(time=>$cancel_time);
683 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
684 my $error = $self->cust_main->credit(
686 'Credit for unused time on '. $self->part_pkg->pkg,
687 'reason_type' => $conf->config('cancel_credit_type'),
690 $dbh->rollback if $oldAutoCommit;
691 return "Error crediting customer \$$remaining_value for unused time on".
692 $self->part_pkg->pkg. ": $error";
697 my %hash = $self->hash;
698 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
699 my $new = new FS::cust_pkg ( \%hash );
700 $error = $new->replace( $self, options => { $self->options } );
702 $dbh->rollback if $oldAutoCommit;
706 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
707 return '' if $date; #no errors
709 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
710 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
711 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
714 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
715 $error = $msg_template->send( 'cust_main' => $self->cust_main,
720 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
721 'to' => \@invoicing_list,
722 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
723 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
726 #should this do something on errors?
733 =item cancel_if_expired [ NOW_TIMESTAMP ]
735 Cancels this package if its expire date has been reached.
739 sub cancel_if_expired {
741 my $time = shift || time;
742 return '' unless $self->expire && $self->expire <= $time;
743 my $error = $self->cancel;
745 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
746 $self->custnum. ": $error";
753 Cancels any pending expiration (sets the expire field to null).
755 If there is an error, returns the error, otherwise returns false.
760 my( $self, %options ) = @_;
763 local $SIG{HUP} = 'IGNORE';
764 local $SIG{INT} = 'IGNORE';
765 local $SIG{QUIT} = 'IGNORE';
766 local $SIG{TERM} = 'IGNORE';
767 local $SIG{TSTP} = 'IGNORE';
768 local $SIG{PIPE} = 'IGNORE';
770 my $oldAutoCommit = $FS::UID::AutoCommit;
771 local $FS::UID::AutoCommit = 0;
774 my $old = $self->select_for_update;
776 my $pkgnum = $old->pkgnum;
777 if ( $old->get('cancel') || $self->get('cancel') ) {
778 dbh->rollback if $oldAutoCommit;
779 return "Can't unexpire cancelled package $pkgnum";
780 # or at least it's pointless
783 unless ( $old->get('expire') && $self->get('expire') ) {
784 dbh->rollback if $oldAutoCommit;
785 return ""; # no error
788 my %hash = $self->hash;
789 $hash{'expire'} = '';
790 my $new = new FS::cust_pkg ( \%hash );
791 $error = $new->replace( $self, options => { $self->options } );
793 $dbh->rollback if $oldAutoCommit;
797 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
803 =item suspend [ OPTION => VALUE ... ]
805 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
806 package, then suspends the package itself (sets the susp field to now).
808 Available options are:
812 =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.
814 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
818 If there is an error, returns the error, otherwise returns false.
823 my( $self, %options ) = @_;
826 local $SIG{HUP} = 'IGNORE';
827 local $SIG{INT} = 'IGNORE';
828 local $SIG{QUIT} = 'IGNORE';
829 local $SIG{TERM} = 'IGNORE';
830 local $SIG{TSTP} = 'IGNORE';
831 local $SIG{PIPE} = 'IGNORE';
833 my $oldAutoCommit = $FS::UID::AutoCommit;
834 local $FS::UID::AutoCommit = 0;
837 my $old = $self->select_for_update;
839 my $pkgnum = $old->pkgnum;
840 if ( $old->get('cancel') || $self->get('cancel') ) {
841 dbh->rollback if $oldAutoCommit;
842 return "Can't suspend cancelled package $pkgnum";
845 if ( $old->get('susp') || $self->get('susp') ) {
846 dbh->rollback if $oldAutoCommit;
847 return ""; # no error # complain on adjourn?
850 my $date = $options{date} if $options{date}; # adjourn/suspend later
851 $date = '' if ($date && $date <= time); # complain instead?
853 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
854 dbh->rollback if $oldAutoCommit;
855 return "Package $pkgnum expires before it would be suspended.";
858 my $suspend_time = $options{'time'} || time;
860 if ( $options{'reason'} ) {
861 $error = $self->insert_reason( 'reason' => $options{'reason'},
862 'action' => $date ? 'adjourn' : 'suspend',
863 'date' => $date ? $date : $suspend_time,
864 'reason_otaker' => $options{'reason_otaker'},
867 dbh->rollback if $oldAutoCommit;
868 return "Error inserting cust_pkg_reason: $error";
876 foreach my $cust_svc (
877 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
879 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
881 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
882 $dbh->rollback if $oldAutoCommit;
883 return "Illegal svcdb value in part_svc!";
886 require "FS/$svcdb.pm";
888 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
890 $error = $svc->suspend;
892 $dbh->rollback if $oldAutoCommit;
895 my( $label, $value ) = $cust_svc->label;
896 push @labels, "$label: $value";
900 my $conf = new FS::Conf;
901 if ( $conf->config('suspend_email_admin') ) {
903 my $error = send_email(
904 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
905 #invoice_from ??? well as good as any
906 'to' => $conf->config('suspend_email_admin'),
907 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
909 "This is an automatic message from your Freeside installation\n",
910 "informing you that the following customer package has been suspended:\n",
912 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
913 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
914 ( map { "Service : $_\n" } @labels ),
919 warn "WARNING: can't send suspension admin email (suspending anyway): ".
927 my %hash = $self->hash;
929 $hash{'adjourn'} = $date;
931 $hash{'susp'} = $suspend_time;
933 my $new = new FS::cust_pkg ( \%hash );
934 $error = $new->replace( $self, options => { $self->options } );
936 $dbh->rollback if $oldAutoCommit;
940 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
945 =item unsuspend [ OPTION => VALUE ... ]
947 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
948 package, then unsuspends the package itself (clears the susp field and the
949 adjourn field if it is in the past).
951 Available options are:
955 =item adjust_next_bill
957 Can be set true to adjust the next bill date forward by
958 the amount of time the account was inactive. This was set true by default
959 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
960 explicitly requested. Price plans for which this makes sense (anniversary-date
961 based than prorate or subscription) could have an option to enable this
966 If there is an error, returns the error, otherwise returns false.
971 my( $self, %opt ) = @_;
974 local $SIG{HUP} = 'IGNORE';
975 local $SIG{INT} = 'IGNORE';
976 local $SIG{QUIT} = 'IGNORE';
977 local $SIG{TERM} = 'IGNORE';
978 local $SIG{TSTP} = 'IGNORE';
979 local $SIG{PIPE} = 'IGNORE';
981 my $oldAutoCommit = $FS::UID::AutoCommit;
982 local $FS::UID::AutoCommit = 0;
985 my $old = $self->select_for_update;
987 my $pkgnum = $old->pkgnum;
988 if ( $old->get('cancel') || $self->get('cancel') ) {
989 dbh->rollback if $oldAutoCommit;
990 return "Can't unsuspend cancelled package $pkgnum";
993 unless ( $old->get('susp') && $self->get('susp') ) {
994 dbh->rollback if $oldAutoCommit;
995 return ""; # no error # complain instead?
998 foreach my $cust_svc (
999 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1001 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1003 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1004 $dbh->rollback if $oldAutoCommit;
1005 return "Illegal svcdb value in part_svc!";
1008 require "FS/$svcdb.pm";
1010 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1012 $error = $svc->unsuspend;
1014 $dbh->rollback if $oldAutoCommit;
1021 my %hash = $self->hash;
1022 my $inactive = time - $hash{'susp'};
1024 my $conf = new FS::Conf;
1026 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
1027 if ( $opt{'adjust_next_bill'}
1028 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
1029 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
1032 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1033 my $new = new FS::cust_pkg ( \%hash );
1034 $error = $new->replace( $self, options => { $self->options } );
1036 $dbh->rollback if $oldAutoCommit;
1040 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1047 Cancels any pending suspension (sets the adjourn field to null).
1049 If there is an error, returns the error, otherwise returns false.
1054 my( $self, %options ) = @_;
1057 local $SIG{HUP} = 'IGNORE';
1058 local $SIG{INT} = 'IGNORE';
1059 local $SIG{QUIT} = 'IGNORE';
1060 local $SIG{TERM} = 'IGNORE';
1061 local $SIG{TSTP} = 'IGNORE';
1062 local $SIG{PIPE} = 'IGNORE';
1064 my $oldAutoCommit = $FS::UID::AutoCommit;
1065 local $FS::UID::AutoCommit = 0;
1068 my $old = $self->select_for_update;
1070 my $pkgnum = $old->pkgnum;
1071 if ( $old->get('cancel') || $self->get('cancel') ) {
1072 dbh->rollback if $oldAutoCommit;
1073 return "Can't unadjourn cancelled package $pkgnum";
1074 # or at least it's pointless
1077 if ( $old->get('susp') || $self->get('susp') ) {
1078 dbh->rollback if $oldAutoCommit;
1079 return "Can't unadjourn suspended package $pkgnum";
1080 # perhaps this is arbitrary
1083 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1084 dbh->rollback if $oldAutoCommit;
1085 return ""; # no error
1088 my %hash = $self->hash;
1089 $hash{'adjourn'} = '';
1090 my $new = new FS::cust_pkg ( \%hash );
1091 $error = $new->replace( $self, options => { $self->options } );
1093 $dbh->rollback if $oldAutoCommit;
1097 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1104 =item change HASHREF | OPTION => VALUE ...
1106 Changes this package: cancels it and creates a new one, with a different
1107 pkgpart or locationnum or both. All services are transferred to the new
1108 package (no change will be made if this is not possible).
1110 Options may be passed as a list of key/value pairs or as a hash reference.
1117 New locationnum, to change the location for this package.
1121 New FS::cust_location object, to create a new location and assign it
1126 New pkgpart (see L<FS::part_pkg>).
1130 New refnum (see L<FS::part_referral>).
1134 At least one option must be specified (otherwise, what's the point?)
1136 Returns either the new FS::cust_pkg object or a scalar error.
1140 my $err_or_new_cust_pkg = $old_cust_pkg->change
1144 #some false laziness w/order
1147 my $opt = ref($_[0]) ? shift : { @_ };
1149 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1152 my $conf = new FS::Conf;
1154 # Transactionize this whole mess
1155 local $SIG{HUP} = 'IGNORE';
1156 local $SIG{INT} = 'IGNORE';
1157 local $SIG{QUIT} = 'IGNORE';
1158 local $SIG{TERM} = 'IGNORE';
1159 local $SIG{TSTP} = 'IGNORE';
1160 local $SIG{PIPE} = 'IGNORE';
1162 my $oldAutoCommit = $FS::UID::AutoCommit;
1163 local $FS::UID::AutoCommit = 0;
1172 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1174 #$hash{$_} = $self->$_() foreach qw( setup );
1176 $hash{'setup'} = $time if $self->setup;
1178 $hash{'change_date'} = $time;
1179 $hash{"change_$_"} = $self->$_()
1180 foreach qw( pkgnum pkgpart locationnum );
1182 if ( $opt->{'cust_location'} &&
1183 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1184 $error = $opt->{'cust_location'}->insert;
1186 $dbh->rollback if $oldAutoCommit;
1187 return "inserting cust_location (transaction rolled back): $error";
1189 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1192 # Create the new package.
1193 my $cust_pkg = new FS::cust_pkg {
1194 custnum => $self->custnum,
1195 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1196 refnum => ( $opt->{'refnum'} || $self->refnum ),
1197 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1201 $error = $cust_pkg->insert( 'change' => 1 );
1203 $dbh->rollback if $oldAutoCommit;
1207 # Transfer services and cancel old package.
1209 $error = $self->transfer($cust_pkg);
1210 if ($error and $error == 0) {
1211 # $old_pkg->transfer failed.
1212 $dbh->rollback if $oldAutoCommit;
1216 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1217 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1218 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1219 if ($error and $error == 0) {
1220 # $old_pkg->transfer failed.
1221 $dbh->rollback if $oldAutoCommit;
1227 # Transfers were successful, but we still had services left on the old
1228 # package. We can't change the package under this circumstances, so abort.
1229 $dbh->rollback if $oldAutoCommit;
1230 return "Unable to transfer all services from package ". $self->pkgnum;
1233 #reset usage if changing pkgpart
1234 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1235 if ($self->pkgpart != $cust_pkg->pkgpart) {
1236 my $part_pkg = $cust_pkg->part_pkg;
1237 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1241 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1244 $dbh->rollback if $oldAutoCommit;
1245 return "Error setting usage values: $error";
1249 #Good to go, cancel old package.
1250 $error = $self->cancel( quiet=>1 );
1252 $dbh->rollback if $oldAutoCommit;
1256 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1258 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1260 $dbh->rollback if $oldAutoCommit;
1265 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1273 Returns the last bill date, or if there is no last bill date, the setup date.
1274 Useful for billing metered services.
1280 return $self->setfield('last_bill', $_[0]) if @_;
1281 return $self->getfield('last_bill') if $self->getfield('last_bill');
1282 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1283 'edate' => $self->bill, } );
1284 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1287 =item last_cust_pkg_reason ACTION
1289 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1290 Returns false if there is no reason or the package is not currenly ACTION'd
1291 ACTION is one of adjourn, susp, cancel, or expire.
1295 sub last_cust_pkg_reason {
1296 my ( $self, $action ) = ( shift, shift );
1297 my $date = $self->get($action);
1299 'table' => 'cust_pkg_reason',
1300 'hashref' => { 'pkgnum' => $self->pkgnum,
1301 'action' => substr(uc($action), 0, 1),
1304 'order_by' => 'ORDER BY num DESC LIMIT 1',
1308 =item last_reason ACTION
1310 Returns the most recent ACTION FS::reason associated with the package.
1311 Returns false if there is no reason or the package is not currenly ACTION'd
1312 ACTION is one of adjourn, susp, cancel, or expire.
1317 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1318 $cust_pkg_reason->reason
1319 if $cust_pkg_reason;
1324 Returns the definition for this billing item, as an FS::part_pkg object (see
1331 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1332 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1333 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1338 Returns the cancelled package this package was changed from, if any.
1344 return '' unless $self->change_pkgnum;
1345 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1350 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1357 $self->part_pkg->calc_setup($self, @_);
1362 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1369 $self->part_pkg->calc_recur($self, @_);
1374 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1381 $self->part_pkg->calc_remain($self, @_);
1386 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1393 $self->part_pkg->calc_cancel($self, @_);
1398 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1404 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1407 =item cust_pkg_detail [ DETAILTYPE ]
1409 Returns any customer package details for this package (see
1410 L<FS::cust_pkg_detail>).
1412 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1416 sub cust_pkg_detail {
1418 my %hash = ( 'pkgnum' => $self->pkgnum );
1419 $hash{detailtype} = shift if @_;
1421 'table' => 'cust_pkg_detail',
1422 'hashref' => \%hash,
1423 'order_by' => 'ORDER BY weight, pkgdetailnum',
1427 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1429 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1431 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1433 If there is an error, returns the error, otherwise returns false.
1437 sub set_cust_pkg_detail {
1438 my( $self, $detailtype, @details ) = @_;
1440 local $SIG{HUP} = 'IGNORE';
1441 local $SIG{INT} = 'IGNORE';
1442 local $SIG{QUIT} = 'IGNORE';
1443 local $SIG{TERM} = 'IGNORE';
1444 local $SIG{TSTP} = 'IGNORE';
1445 local $SIG{PIPE} = 'IGNORE';
1447 my $oldAutoCommit = $FS::UID::AutoCommit;
1448 local $FS::UID::AutoCommit = 0;
1451 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1452 my $error = $current->delete;
1454 $dbh->rollback if $oldAutoCommit;
1455 return "error removing old detail: $error";
1459 foreach my $detail ( @details ) {
1460 my $cust_pkg_detail = new FS::cust_pkg_detail {
1461 'pkgnum' => $self->pkgnum,
1462 'detailtype' => $detailtype,
1463 'detail' => $detail,
1465 my $error = $cust_pkg_detail->insert;
1467 $dbh->rollback if $oldAutoCommit;
1468 return "error adding new detail: $error";
1473 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1480 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1484 #false laziness w/cust_bill.pm
1488 'table' => 'cust_event',
1489 'addl_from' => 'JOIN part_event USING ( eventpart )',
1490 'hashref' => { 'tablenum' => $self->pkgnum },
1491 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1495 =item num_cust_event
1497 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1501 #false laziness w/cust_bill.pm
1502 sub num_cust_event {
1505 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1506 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1507 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1508 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1509 $sth->fetchrow_arrayref->[0];
1512 =item cust_svc [ SVCPART ]
1514 Returns the services for this package, as FS::cust_svc objects (see
1515 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1523 return () unless $self->num_cust_svc(@_);
1526 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1527 'svcpart' => shift, } );
1530 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1532 #if ( $self->{'_svcnum'} ) {
1533 # values %{ $self->{'_svcnum'}->cache };
1535 $self->_sort_cust_svc(
1536 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1542 =item overlimit [ SVCPART ]
1544 Returns the services for this package which have exceeded their
1545 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1546 is specified, return only the matching services.
1552 return () unless $self->num_cust_svc(@_);
1553 grep { $_->overlimit } $self->cust_svc(@_);
1556 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1558 Returns historical services for this package created before END TIMESTAMP and
1559 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1560 (see L<FS::h_cust_svc>).
1567 $self->_sort_cust_svc(
1568 [ qsearch( 'h_cust_svc',
1569 { 'pkgnum' => $self->pkgnum, },
1570 FS::h_cust_svc->sql_h_search(@_),
1576 sub _sort_cust_svc {
1577 my( $self, $arrayref ) = @_;
1580 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1585 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1586 'svcpart' => $_->svcpart } );
1588 $pkg_svc ? $pkg_svc->primary_svc : '',
1589 $pkg_svc ? $pkg_svc->quantity : 0,
1596 =item num_cust_svc [ SVCPART ]
1598 Returns the number of provisioned services for this package. If a svcpart is
1599 specified, counts only the matching services.
1606 return $self->{'_num_cust_svc'}
1608 && exists($self->{'_num_cust_svc'})
1609 && $self->{'_num_cust_svc'} =~ /\d/;
1611 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1614 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1615 $sql .= ' AND svcpart = ?' if @_;
1617 my $sth = dbh->prepare($sql) or die dbh->errstr;
1618 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1619 $sth->fetchrow_arrayref->[0];
1622 =item available_part_svc
1624 Returns a list of FS::part_svc objects representing services included in this
1625 package but not yet provisioned. Each FS::part_svc object also has an extra
1626 field, I<num_avail>, which specifies the number of available services.
1630 sub available_part_svc {
1632 grep { $_->num_avail > 0 }
1634 my $part_svc = $_->part_svc;
1635 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1636 $_->quantity - $self->num_cust_svc($_->svcpart);
1639 $self->part_pkg->pkg_svc;
1644 Returns a list of FS::part_svc objects representing provisioned and available
1645 services included in this package. Each FS::part_svc object also has the
1646 following extra fields:
1650 =item num_cust_svc (count)
1652 =item num_avail (quantity - count)
1654 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1657 label -> ($cust_svc->label)[1]
1666 #XXX some sort of sort order besides numeric by svcpart...
1667 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1669 my $part_svc = $pkg_svc->part_svc;
1670 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1671 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1672 $part_svc->{'Hash'}{'num_avail'} =
1673 max( 0, $pkg_svc->quantity - $num_cust_svc );
1674 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1675 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1677 } $self->part_pkg->pkg_svc;
1680 push @part_svc, map {
1682 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1683 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1684 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1685 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1686 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1688 } $self->extra_part_svc;
1694 =item extra_part_svc
1696 Returns a list of FS::part_svc objects corresponding to services in this
1697 package which are still provisioned but not (any longer) available in the
1702 sub extra_part_svc {
1705 my $pkgnum = $self->pkgnum;
1706 my $pkgpart = $self->pkgpart;
1709 # 'table' => 'part_svc',
1712 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1713 # WHERE pkg_svc.svcpart = part_svc.svcpart
1714 # AND pkg_svc.pkgpart = ?
1717 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1718 # LEFT JOIN cust_pkg USING ( pkgnum )
1719 # WHERE cust_svc.svcpart = part_svc.svcpart
1722 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1725 #seems to benchmark slightly faster...
1727 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1728 #MySQL doesn't grok DISINCT ON
1729 'select' => 'DISTINCT part_svc.*',
1730 'table' => 'part_svc',
1732 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1733 AND pkg_svc.pkgpart = ?
1736 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1737 LEFT JOIN cust_pkg USING ( pkgnum )
1740 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1741 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1747 Returns a short status string for this package, currently:
1751 =item not yet billed
1753 =item one-time charge
1768 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1770 return 'cancelled' if $self->get('cancel');
1771 return 'suspended' if $self->susp;
1772 return 'not yet billed' unless $self->setup;
1773 return 'one-time charge' if $freq =~ /^(0|$)/;
1777 =item ucfirst_status
1779 Returns the status with the first character capitalized.
1783 sub ucfirst_status {
1784 ucfirst(shift->status);
1789 Class method that returns the list of possible status strings for packages
1790 (see L<the status method|/status>). For example:
1792 @statuses = FS::cust_pkg->statuses();
1796 tie my %statuscolor, 'Tie::IxHash',
1797 'not yet billed' => '000000',
1798 'one-time charge' => '000000',
1799 'active' => '00CC00',
1800 'suspended' => 'FF9900',
1801 'cancelled' => 'FF0000',
1805 my $self = shift; #could be class...
1806 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1807 # # mayble split btw one-time vs. recur
1813 Returns a hex triplet color string for this package's status.
1819 $statuscolor{$self->status};
1824 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1825 "pkg-comment" depending on user preference).
1831 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1832 $label = $self->pkgnum. ": $label"
1833 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1837 =item pkg_label_long
1839 Returns a long label for this package, adding the primary service's label to
1844 sub pkg_label_long {
1846 my $label = $self->pkg_label;
1847 my $cust_svc = $self->primary_cust_svc;
1848 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1852 =item primary_cust_svc
1854 Returns a primary service (as FS::cust_svc object) if one can be identified.
1858 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1860 sub primary_cust_svc {
1863 my @cust_svc = $self->cust_svc;
1865 return '' unless @cust_svc; #no serivces - irrelevant then
1867 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1869 # primary service as specified in the package definition
1870 # or exactly one service definition with quantity one
1871 my $svcpart = $self->part_pkg->svcpart;
1872 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1873 return $cust_svc[0] if scalar(@cust_svc) == 1;
1875 #couldn't identify one thing..
1881 Returns a list of lists, calling the label method for all services
1882 (see L<FS::cust_svc>) of this billing item.
1888 map { [ $_->label ] } $self->cust_svc;
1891 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1893 Like the labels method, but returns historical information on services that
1894 were active as of END_TIMESTAMP and (optionally) not cancelled before
1897 Returns a list of lists, calling the label method for all (historical) services
1898 (see L<FS::h_cust_svc>) of this billing item.
1904 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1909 Like labels, except returns a simple flat list, and shortens long
1910 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1911 identical services to one line that lists the service label and the number of
1912 individual services rather than individual items.
1917 shift->_labels_short( 'labels', @_ );
1920 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1922 Like h_labels, except returns a simple flat list, and shortens long
1923 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1924 identical services to one line that lists the service label and the number of
1925 individual services rather than individual items.
1929 sub h_labels_short {
1930 shift->_labels_short( 'h_labels', @_ );
1934 my( $self, $method ) = ( shift, shift );
1936 my $conf = new FS::Conf;
1937 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1940 #tie %labels, 'Tie::IxHash';
1941 push @{ $labels{$_->[0]} }, $_->[1]
1942 foreach $self->$method(@_);
1944 foreach my $label ( keys %labels ) {
1946 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1947 my $num = scalar(@values);
1948 if ( $num > $max_same_services ) {
1949 push @labels, "$label ($num)";
1951 if ( $conf->exists('cust_bill-consolidate_services') ) {
1952 # push @labels, "$label: ". join(', ', @values);
1954 my $detail = "$label: ";
1955 $detail .= shift(@values). ', '
1956 while @values && length($detail.$values[0]) < 78;
1958 push @labels, $detail;
1961 push @labels, map { "$label: $_" } @values;
1972 Returns the parent customer object (see L<FS::cust_main>).
1978 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1981 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
1985 Returns the location object, if any (see L<FS::cust_location>).
1987 =item cust_location_or_main
1989 If this package is associated with a location, returns the locaiton (see
1990 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1992 =item location_label [ OPTION => VALUE ... ]
1994 Returns the label of the location object (see L<FS::cust_location>).
1998 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2000 =item seconds_since TIMESTAMP
2002 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2003 package have been online since TIMESTAMP, according to the session monitor.
2005 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2006 L<Time::Local> and L<Date::Parse> for conversion functions.
2011 my($self, $since) = @_;
2014 foreach my $cust_svc (
2015 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2017 $seconds += $cust_svc->seconds_since($since);
2024 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2026 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2027 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2030 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2031 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2037 sub seconds_since_sqlradacct {
2038 my($self, $start, $end) = @_;
2042 foreach my $cust_svc (
2044 my $part_svc = $_->part_svc;
2045 $part_svc->svcdb eq 'svc_acct'
2046 && scalar($part_svc->part_export('sqlradius'));
2049 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2056 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2058 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2059 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2063 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2064 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2069 sub attribute_since_sqlradacct {
2070 my($self, $start, $end, $attrib) = @_;
2074 foreach my $cust_svc (
2076 my $part_svc = $_->part_svc;
2077 $part_svc->svcdb eq 'svc_acct'
2078 && scalar($part_svc->part_export('sqlradius'));
2081 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2093 my( $self, $value ) = @_;
2094 if ( defined($value) ) {
2095 $self->setfield('quantity', $value);
2097 $self->getfield('quantity') || 1;
2100 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2102 Transfers as many services as possible from this package to another package.
2104 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2105 object. The destination package must already exist.
2107 Services are moved only if the destination allows services with the correct
2108 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2109 this option with caution! No provision is made for export differences
2110 between the old and new service definitions. Probably only should be used
2111 when your exports for all service definitions of a given svcdb are identical.
2112 (attempt a transfer without it first, to move all possible svcpart-matching
2115 Any services that can't be moved remain in the original package.
2117 Returns an error, if there is one; otherwise, returns the number of services
2118 that couldn't be moved.
2123 my ($self, $dest_pkgnum, %opt) = @_;
2129 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2130 $dest = $dest_pkgnum;
2131 $dest_pkgnum = $dest->pkgnum;
2133 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2136 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2138 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2139 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2142 foreach my $cust_svc ($dest->cust_svc) {
2143 $target{$cust_svc->svcpart}--;
2146 my %svcpart2svcparts = ();
2147 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2148 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2149 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2150 next if exists $svcpart2svcparts{$svcpart};
2151 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2152 $svcpart2svcparts{$svcpart} = [
2154 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2156 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2157 'svcpart' => $_ } );
2159 $pkg_svc ? $pkg_svc->primary_svc : '',
2160 $pkg_svc ? $pkg_svc->quantity : 0,
2164 grep { $_ != $svcpart }
2166 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2168 warn "alternates for svcpart $svcpart: ".
2169 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2174 foreach my $cust_svc ($self->cust_svc) {
2175 if($target{$cust_svc->svcpart} > 0) {
2176 $target{$cust_svc->svcpart}--;
2177 my $new = new FS::cust_svc { $cust_svc->hash };
2178 $new->pkgnum($dest_pkgnum);
2179 my $error = $new->replace($cust_svc);
2180 return $error if $error;
2181 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2183 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2184 warn "alternates to consider: ".
2185 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2187 my @alternate = grep {
2188 warn "considering alternate svcpart $_: ".
2189 "$target{$_} available in new package\n"
2192 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2194 warn "alternate(s) found\n" if $DEBUG;
2195 my $change_svcpart = $alternate[0];
2196 $target{$change_svcpart}--;
2197 my $new = new FS::cust_svc { $cust_svc->hash };
2198 $new->svcpart($change_svcpart);
2199 $new->pkgnum($dest_pkgnum);
2200 my $error = $new->replace($cust_svc);
2201 return $error if $error;
2214 This method is deprecated. See the I<depend_jobnum> option to the insert and
2215 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2222 local $SIG{HUP} = 'IGNORE';
2223 local $SIG{INT} = 'IGNORE';
2224 local $SIG{QUIT} = 'IGNORE';
2225 local $SIG{TERM} = 'IGNORE';
2226 local $SIG{TSTP} = 'IGNORE';
2227 local $SIG{PIPE} = 'IGNORE';
2229 my $oldAutoCommit = $FS::UID::AutoCommit;
2230 local $FS::UID::AutoCommit = 0;
2233 foreach my $cust_svc ( $self->cust_svc ) {
2234 #false laziness w/svc_Common::insert
2235 my $svc_x = $cust_svc->svc_x;
2236 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2237 my $error = $part_export->export_insert($svc_x);
2239 $dbh->rollback if $oldAutoCommit;
2245 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2252 Associates this package with a (suspension or cancellation) reason (see
2253 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2256 Available options are:
2262 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.
2266 the access_user (see L<FS::access_user>) providing the reason
2274 the action (cancel, susp, adjourn, expire) associated with the reason
2278 If there is an error, returns the error, otherwise returns false.
2283 my ($self, %options) = @_;
2285 my $otaker = $options{reason_otaker} ||
2286 $FS::CurrentUser::CurrentUser->username;
2289 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2293 } elsif ( ref($options{'reason'}) ) {
2295 return 'Enter a new reason (or select an existing one)'
2296 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2298 my $reason = new FS::reason({
2299 'reason_type' => $options{'reason'}->{'typenum'},
2300 'reason' => $options{'reason'}->{'reason'},
2302 my $error = $reason->insert;
2303 return $error if $error;
2305 $reasonnum = $reason->reasonnum;
2308 return "Unparsable reason: ". $options{'reason'};
2311 my $cust_pkg_reason =
2312 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2313 'reasonnum' => $reasonnum,
2314 'otaker' => $otaker,
2315 'action' => substr(uc($options{'action'}),0,1),
2316 'date' => $options{'date'}
2321 $cust_pkg_reason->insert;
2324 =item insert_discount
2326 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2327 inserting a new discount on the fly (see L<FS::discount>).
2329 Available options are:
2337 If there is an error, returns the error, otherwise returns false.
2341 sub insert_discount {
2342 #my ($self, %options) = @_;
2345 my $cust_pkg_discount = new FS::cust_pkg_discount {
2346 'pkgnum' => $self->pkgnum,
2347 'discountnum' => $self->discountnum,
2349 'end_date' => '', #XXX
2350 'otaker' => $self->otaker,
2351 #for the create a new discount case
2352 '_type' => $self->discountnum__type,
2353 'amount' => $self->discountnum_amount,
2354 'percent' => $self->discountnum_percent,
2355 'months' => $self->discountnum_months,
2356 #'disabled' => $self->discountnum_disabled,
2359 $cust_pkg_discount->insert;
2362 =item set_usage USAGE_VALUE_HASHREF
2364 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2365 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2366 upbytes, downbytes, and totalbytes are appropriate keys.
2368 All svc_accts which are part of this package have their values reset.
2373 my ($self, $valueref, %opt) = @_;
2375 foreach my $cust_svc ($self->cust_svc){
2376 my $svc_x = $cust_svc->svc_x;
2377 $svc_x->set_usage($valueref, %opt)
2378 if $svc_x->can("set_usage");
2382 =item recharge USAGE_VALUE_HASHREF
2384 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2385 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2386 upbytes, downbytes, and totalbytes are appropriate keys.
2388 All svc_accts which are part of this package have their values incremented.
2393 my ($self, $valueref) = @_;
2395 foreach my $cust_svc ($self->cust_svc){
2396 my $svc_x = $cust_svc->svc_x;
2397 $svc_x->recharge($valueref)
2398 if $svc_x->can("recharge");
2402 =item cust_pkg_discount
2406 sub cust_pkg_discount {
2408 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2411 =item cust_pkg_discount_active
2415 sub cust_pkg_discount_active {
2417 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2422 =head1 CLASS METHODS
2428 Returns an SQL expression identifying recurring packages.
2432 sub recurring_sql { "
2433 '0' != ( select freq from part_pkg
2434 where cust_pkg.pkgpart = part_pkg.pkgpart )
2439 Returns an SQL expression identifying one-time packages.
2444 '0' = ( select freq from part_pkg
2445 where cust_pkg.pkgpart = part_pkg.pkgpart )
2450 Returns an SQL expression identifying ordered packages (recurring packages not
2456 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2461 Returns an SQL expression identifying active packages.
2466 $_[0]->recurring_sql. "
2467 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2468 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2469 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2472 =item not_yet_billed_sql
2474 Returns an SQL expression identifying packages which have not yet been billed.
2478 sub not_yet_billed_sql { "
2479 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2480 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2481 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2486 Returns an SQL expression identifying inactive packages (one-time packages
2487 that are otherwise unsuspended/uncancelled).
2491 sub inactive_sql { "
2492 ". $_[0]->onetime_sql(). "
2493 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2494 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2495 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2501 Returns an SQL expression identifying suspended packages.
2505 sub suspended_sql { susp_sql(@_); }
2507 #$_[0]->recurring_sql(). ' AND '.
2509 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2510 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2517 Returns an SQL exprression identifying cancelled packages.
2521 sub cancelled_sql { cancel_sql(@_); }
2523 #$_[0]->recurring_sql(). ' AND '.
2524 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2527 =item search HASHREF
2531 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2532 Valid parameters are
2540 active, inactive, suspended, cancel (or cancelled)
2544 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2548 boolean selects custom packages
2554 pkgpart or arrayref or hashref of pkgparts
2558 arrayref of beginning and ending epoch date
2562 arrayref of beginning and ending epoch date
2566 arrayref of beginning and ending epoch date
2570 arrayref of beginning and ending epoch date
2574 arrayref of beginning and ending epoch date
2578 arrayref of beginning and ending epoch date
2582 arrayref of beginning and ending epoch date
2586 pkgnum or APKG_pkgnum
2590 a value suited to passing to FS::UI::Web::cust_header
2594 specifies the user for agent virtualization
2598 boolean selects packages containing fcc form 477 telco lines
2605 my ($class, $params) = @_;
2612 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2614 "cust_main.agentnum = $1";
2621 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2623 "cust_pkg.custnum = $1";
2630 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2632 "cust_pkg.pkgbatch = '$1'";
2639 if ( $params->{'magic'} eq 'active'
2640 || $params->{'status'} eq 'active' ) {
2642 push @where, FS::cust_pkg->active_sql();
2644 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2645 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2647 push @where, FS::cust_pkg->not_yet_billed_sql();
2649 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2650 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2652 push @where, FS::cust_pkg->inactive_sql();
2654 } elsif ( $params->{'magic'} eq 'suspended'
2655 || $params->{'status'} eq 'suspended' ) {
2657 push @where, FS::cust_pkg->suspended_sql();
2659 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2660 || $params->{'status'} =~ /^cancell?ed$/ ) {
2662 push @where, FS::cust_pkg->cancelled_sql();
2667 # parse package class
2670 #false lazinessish w/graph/cust_bill_pkg.cgi
2673 if ( exists($params->{'classnum'})
2674 && $params->{'classnum'} =~ /^(\d*)$/
2678 if ( $classnum ) { #a specific class
2679 push @where, "part_pkg.classnum = $classnum";
2681 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2682 #die "classnum $classnum not found!" unless $pkg_class[0];
2683 #$title .= $pkg_class[0]->classname.' ';
2685 } elsif ( $classnum eq '' ) { #the empty class
2687 push @where, "part_pkg.classnum IS NULL";
2688 #$title .= 'Empty class ';
2689 #@pkg_class = ( '(empty class)' );
2690 } elsif ( $classnum eq '0' ) {
2691 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2692 #push @pkg_class, '(empty class)';
2694 die "illegal classnum";
2700 # parse package report options
2703 my @report_option = ();
2704 if ( exists($params->{'report_option'})
2705 && $params->{'report_option'} =~ /^([,\d]*)$/
2708 @report_option = split(',', $1);
2711 if (@report_option) {
2712 # this will result in the empty set for the dangling comma case as it should
2714 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2715 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2716 AND optionname = 'report_option_$_'
2717 AND optionvalue = '1' )"
2727 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2733 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2739 if ( exists($params->{'censustract'}) ) {
2740 $params->{'censustract'} =~ /^([.\d]*)$/;
2741 my $censustract = "cust_main.censustract = '$1'";
2742 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2743 push @where, "( $censustract )";
2750 if ( ref($params->{'pkgpart'}) ) {
2753 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2754 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2755 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2756 @pkgpart = @{ $params->{'pkgpart'} };
2758 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2761 @pkgpart = grep /^(\d+)$/, @pkgpart;
2763 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2765 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2766 push @where, "pkgpart = $1";
2775 #false laziness w/report_cust_pkg.html
2778 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2779 'active' => { 'susp'=>1, 'cancel'=>1 },
2780 'suspended' => { 'cancel' => 1 },
2785 if( exists($params->{'active'} ) ) {
2786 # This overrides all the other date-related fields
2787 my($beginning, $ending) = @{$params->{'active'}};
2789 "cust_pkg.setup IS NOT NULL",
2790 "cust_pkg.setup <= $ending",
2791 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2792 "NOT (".FS::cust_pkg->onetime_sql . ")";
2795 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2797 next unless exists($params->{$field});
2799 my($beginning, $ending) = @{$params->{$field}};
2801 next if $beginning == 0 && $ending == 4294967295;
2804 "cust_pkg.$field IS NOT NULL",
2805 "cust_pkg.$field >= $beginning",
2806 "cust_pkg.$field <= $ending";
2808 $orderby ||= "ORDER BY cust_pkg.$field";
2813 $orderby ||= 'ORDER BY bill';
2816 # parse magic, legacy, etc.
2819 if ( $params->{'magic'} &&
2820 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2823 $orderby = 'ORDER BY pkgnum';
2825 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2826 push @where, "pkgpart = $1";
2829 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2831 $orderby = 'ORDER BY pkgnum';
2833 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2835 $orderby = 'ORDER BY pkgnum';
2838 SELECT count(*) FROM pkg_svc
2839 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2840 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2841 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2842 AND cust_svc.svcpart = pkg_svc.svcpart
2849 # setup queries, links, subs, etc. for the search
2852 # here is the agent virtualization
2853 if ($params->{CurrentUser}) {
2855 qsearchs('access_user', { username => $params->{CurrentUser} });
2858 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2863 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2866 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2868 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2869 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2870 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2872 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2875 'table' => 'cust_pkg',
2877 'select' => join(', ',
2879 ( map "part_pkg.$_", qw( pkg freq ) ),
2880 'pkg_class.classname',
2881 'cust_main.custnum AS cust_main_custnum',
2882 FS::UI::Web::cust_sql_fields(
2883 $params->{'cust_fields'}
2886 'extra_sql' => "$extra_sql $orderby",
2887 'addl_from' => $addl_from,
2888 'count_query' => $count_query,
2895 Returns a list of two package counts. The first is a count of packages
2896 based on the supplied criteria and the second is the count of residential
2897 packages with those same criteria. Criteria are specified as in the search
2903 my ($class, $params) = @_;
2905 my $sql_query = $class->search( $params );
2907 my $count_sql = delete($sql_query->{'count_query'});
2908 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
2909 or die "couldn't parse count_sql";
2911 my $count_sth = dbh->prepare($count_sql)
2912 or die "Error preparing $count_sql: ". dbh->errstr;
2914 or die "Error executing $count_sql: ". $count_sth->errstr;
2915 my $count_arrayref = $count_sth->fetchrow_arrayref;
2917 return ( @$count_arrayref );
2924 Returns a list: the first item is an SQL fragment identifying matching
2925 packages/customers via location (taking into account shipping and package
2926 address taxation, if enabled), and subsequent items are the parameters to
2927 substitute for the placeholders in that fragment.
2932 my($class, %opt) = @_;
2933 my $ornull = $opt{'ornull'};
2935 my $conf = new FS::Conf;
2937 # '?' placeholders in _location_sql_where
2938 my $x = $ornull ? 3 : 2;
2939 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
2943 if ( $conf->exists('tax-ship_address') ) {
2946 ( ( ship_last IS NULL OR ship_last = '' )
2947 AND ". _location_sql_where('cust_main', '', $ornull ). "
2949 OR ( ship_last IS NOT NULL AND ship_last != ''
2950 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2953 # AND payby != 'COMP'
2955 @main_param = ( @bill_param, @bill_param );
2959 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2960 @main_param = @bill_param;
2966 if ( $conf->exists('tax-pkg_address') ) {
2968 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2971 ( cust_pkg.locationnum IS NULL AND $main_where )
2972 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2975 @param = ( @main_param, @bill_param );
2979 $where = $main_where;
2980 @param = @main_param;
2988 #subroutine, helper for location_sql
2989 sub _location_sql_where {
2991 my $prefix = @_ ? shift : '';
2992 my $ornull = @_ ? shift : '';
2994 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2996 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2998 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
2999 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3000 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3002 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3004 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3005 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3006 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3007 AND $table.${prefix}country = ?
3015 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3017 CUSTNUM is a customer (see L<FS::cust_main>)
3019 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3020 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3023 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3024 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3025 new billing items. An error is returned if this is not possible (see
3026 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3029 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3030 newly-created cust_pkg objects.
3032 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3033 and inserted. Multiple FS::pkg_referral records can be created by
3034 setting I<refnum> to an array reference of refnums or a hash reference with
3035 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3036 record will be created corresponding to cust_main.refnum.
3041 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3043 my $conf = new FS::Conf;
3045 # Transactionize this whole mess
3046 local $SIG{HUP} = 'IGNORE';
3047 local $SIG{INT} = 'IGNORE';
3048 local $SIG{QUIT} = 'IGNORE';
3049 local $SIG{TERM} = 'IGNORE';
3050 local $SIG{TSTP} = 'IGNORE';
3051 local $SIG{PIPE} = 'IGNORE';
3053 my $oldAutoCommit = $FS::UID::AutoCommit;
3054 local $FS::UID::AutoCommit = 0;
3058 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3059 # return "Customer not found: $custnum" unless $cust_main;
3061 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3064 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3067 my $change = scalar(@old_cust_pkg) != 0;
3070 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3072 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3073 " to pkgpart ". $pkgparts->[0]. "\n"
3076 my $err_or_cust_pkg =
3077 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3078 'refnum' => $refnum,
3081 unless (ref($err_or_cust_pkg)) {
3082 $dbh->rollback if $oldAutoCommit;
3083 return $err_or_cust_pkg;
3086 push @$return_cust_pkg, $err_or_cust_pkg;
3087 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3092 # Create the new packages.
3093 foreach my $pkgpart (@$pkgparts) {
3095 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3097 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3098 pkgpart => $pkgpart,
3102 $error = $cust_pkg->insert( 'change' => $change );
3104 $dbh->rollback if $oldAutoCommit;
3107 push @$return_cust_pkg, $cust_pkg;
3109 # $return_cust_pkg now contains refs to all of the newly
3112 # Transfer services and cancel old packages.
3113 foreach my $old_pkg (@old_cust_pkg) {
3115 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3118 foreach my $new_pkg (@$return_cust_pkg) {
3119 $error = $old_pkg->transfer($new_pkg);
3120 if ($error and $error == 0) {
3121 # $old_pkg->transfer failed.
3122 $dbh->rollback if $oldAutoCommit;
3127 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3128 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3129 foreach my $new_pkg (@$return_cust_pkg) {
3130 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3131 if ($error and $error == 0) {
3132 # $old_pkg->transfer failed.
3133 $dbh->rollback if $oldAutoCommit;
3140 # Transfers were successful, but we went through all of the
3141 # new packages and still had services left on the old package.
3142 # We can't cancel the package under the circumstances, so abort.
3143 $dbh->rollback if $oldAutoCommit;
3144 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3146 $error = $old_pkg->cancel( quiet=>1 );
3152 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3156 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3158 A bulk change method to change packages for multiple customers.
3160 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3161 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3164 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3165 replace. The services (see L<FS::cust_svc>) are moved to the
3166 new billing items. An error is returned if this is not possible (see
3169 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3170 newly-created cust_pkg objects.
3175 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3177 # Transactionize this whole mess
3178 local $SIG{HUP} = 'IGNORE';
3179 local $SIG{INT} = 'IGNORE';
3180 local $SIG{QUIT} = 'IGNORE';
3181 local $SIG{TERM} = 'IGNORE';
3182 local $SIG{TSTP} = 'IGNORE';
3183 local $SIG{PIPE} = 'IGNORE';
3185 my $oldAutoCommit = $FS::UID::AutoCommit;
3186 local $FS::UID::AutoCommit = 0;
3190 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3193 while(scalar(@old_cust_pkg)) {
3195 my $custnum = $old_cust_pkg[0]->custnum;
3196 my (@remove) = map { $_->pkgnum }
3197 grep { $_->custnum == $custnum } @old_cust_pkg;
3198 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3200 my $error = order $custnum, $pkgparts, \@remove, \@return;
3202 push @errors, $error
3204 push @$return_cust_pkg, @return;
3207 if (scalar(@errors)) {
3208 $dbh->rollback if $oldAutoCommit;
3209 return join(' / ', @errors);
3212 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3216 # Used by FS::Upgrade to migrate to a new database.
3217 sub _upgrade_data { # class method
3218 my ($class, %opts) = @_;
3219 $class->_upgrade_otaker(%opts);
3226 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3228 In sub order, the @pkgparts array (passed by reference) is clobbered.
3230 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3231 method to pass dates to the recur_prog expression, it should do so.
3233 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3234 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3235 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3236 configuration values. Probably need a subroutine which decides what to do
3237 based on whether or not we've fetched the user yet, rather than a hash. See
3238 FS::UID and the TODO.
3240 Now that things are transactional should the check in the insert method be
3245 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3246 L<FS::pkg_svc>, schema.html from the base documentation