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 );
20 use FS::cust_location;
22 use FS::cust_bill_pkg;
23 use FS::cust_pkg_detail;
28 use FS::cust_pkg_reason;
30 use FS::cust_pkg_discount;
34 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
36 # because they load configuration by setting FS::UID::callback (see TODO)
42 # for sending cancel emails in sub cancel
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)
166 order taker (see L<FS::access_user>)
170 If this field is set to 1, disables the automatic
171 unsuspension of this package when using the B<unsuspendauto> config option.
175 If not set, defaults to 1
179 Date of change from previous package
189 =item change_locationnum
195 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
196 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
197 L<Time::Local> and L<Date::Parse> for conversion functions.
205 Create a new billing item. To add the item to the database, see L<"insert">.
209 sub table { 'cust_pkg'; }
210 sub cust_linked { $_[0]->cust_main_custnum; }
211 sub cust_unlinked_msg {
213 "WARNING: can't find cust_main.custnum ". $self->custnum.
214 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
217 =item insert [ OPTION => VALUE ... ]
219 Adds this billing item to the database ("Orders" the item). If there is an
220 error, returns the error, otherwise returns false.
222 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
223 will be used to look up the package definition and agent restrictions will be
226 If the additional field I<refnum> is defined, an FS::pkg_referral record will
227 be created and inserted. Multiple FS::pkg_referral records can be created by
228 setting I<refnum> to an array reference of refnums or a hash reference with
229 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
230 record will be created corresponding to cust_main.refnum.
232 The following options are available:
238 If set true, supresses any referral credit to a referring customer.
242 cust_pkg_option records will be created
246 a ticket will be added to this customer with this subject
250 an optional queue name for ticket additions
257 my( $self, %options ) = @_;
259 if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
260 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
261 $mon += 1 unless $mday == 1;
262 until ( $mon < 12 ) { $mon -= 12; $year++; }
263 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
266 foreach my $action ( qw(expire adjourn contract_end) ) {
267 my $months = $self->part_pkg->option("${action}_months",1);
268 if($months and !$self->$action) {
269 my $start = $self->start_date || $self->setup || time;
270 $self->$action( $self->part_pkg->add_freq($start, $months) );
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->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
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'} &&
711 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
713 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
716 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
717 $error = $msg_template->send( 'cust_main' => $self->cust_main,
722 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
723 'to' => \@invoicing_list,
724 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
725 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
728 #should this do something on errors?
735 =item cancel_if_expired [ NOW_TIMESTAMP ]
737 Cancels this package if its expire date has been reached.
741 sub cancel_if_expired {
743 my $time = shift || time;
744 return '' unless $self->expire && $self->expire <= $time;
745 my $error = $self->cancel;
747 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
748 $self->custnum. ": $error";
755 Cancels any pending expiration (sets the expire field to null).
757 If there is an error, returns the error, otherwise returns false.
762 my( $self, %options ) = @_;
765 local $SIG{HUP} = 'IGNORE';
766 local $SIG{INT} = 'IGNORE';
767 local $SIG{QUIT} = 'IGNORE';
768 local $SIG{TERM} = 'IGNORE';
769 local $SIG{TSTP} = 'IGNORE';
770 local $SIG{PIPE} = 'IGNORE';
772 my $oldAutoCommit = $FS::UID::AutoCommit;
773 local $FS::UID::AutoCommit = 0;
776 my $old = $self->select_for_update;
778 my $pkgnum = $old->pkgnum;
779 if ( $old->get('cancel') || $self->get('cancel') ) {
780 dbh->rollback if $oldAutoCommit;
781 return "Can't unexpire cancelled package $pkgnum";
782 # or at least it's pointless
785 unless ( $old->get('expire') && $self->get('expire') ) {
786 dbh->rollback if $oldAutoCommit;
787 return ""; # no error
790 my %hash = $self->hash;
791 $hash{'expire'} = '';
792 my $new = new FS::cust_pkg ( \%hash );
793 $error = $new->replace( $self, options => { $self->options } );
795 $dbh->rollback if $oldAutoCommit;
799 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
805 =item suspend [ OPTION => VALUE ... ]
807 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
808 package, then suspends the package itself (sets the susp field to now).
810 Available options are:
814 =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.
816 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
820 If there is an error, returns the error, otherwise returns false.
825 my( $self, %options ) = @_;
828 local $SIG{HUP} = 'IGNORE';
829 local $SIG{INT} = 'IGNORE';
830 local $SIG{QUIT} = 'IGNORE';
831 local $SIG{TERM} = 'IGNORE';
832 local $SIG{TSTP} = 'IGNORE';
833 local $SIG{PIPE} = 'IGNORE';
835 my $oldAutoCommit = $FS::UID::AutoCommit;
836 local $FS::UID::AutoCommit = 0;
839 my $old = $self->select_for_update;
841 my $pkgnum = $old->pkgnum;
842 if ( $old->get('cancel') || $self->get('cancel') ) {
843 dbh->rollback if $oldAutoCommit;
844 return "Can't suspend cancelled package $pkgnum";
847 if ( $old->get('susp') || $self->get('susp') ) {
848 dbh->rollback if $oldAutoCommit;
849 return ""; # no error # complain on adjourn?
852 my $date = $options{date} if $options{date}; # adjourn/suspend later
853 $date = '' if ($date && $date <= time); # complain instead?
855 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
856 dbh->rollback if $oldAutoCommit;
857 return "Package $pkgnum expires before it would be suspended.";
860 my $suspend_time = $options{'time'} || time;
862 if ( $options{'reason'} ) {
863 $error = $self->insert_reason( 'reason' => $options{'reason'},
864 'action' => $date ? 'adjourn' : 'suspend',
865 'date' => $date ? $date : $suspend_time,
866 'reason_otaker' => $options{'reason_otaker'},
869 dbh->rollback if $oldAutoCommit;
870 return "Error inserting cust_pkg_reason: $error";
878 foreach my $cust_svc (
879 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
881 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
883 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
884 $dbh->rollback if $oldAutoCommit;
885 return "Illegal svcdb value in part_svc!";
888 require "FS/$svcdb.pm";
890 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
892 $error = $svc->suspend;
894 $dbh->rollback if $oldAutoCommit;
897 my( $label, $value ) = $cust_svc->label;
898 push @labels, "$label: $value";
902 my $conf = new FS::Conf;
903 if ( $conf->config('suspend_email_admin') ) {
905 my $error = send_email(
906 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
907 #invoice_from ??? well as good as any
908 'to' => $conf->config('suspend_email_admin'),
909 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
911 "This is an automatic message from your Freeside installation\n",
912 "informing you that the following customer package has been suspended:\n",
914 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
915 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
916 ( map { "Service : $_\n" } @labels ),
921 warn "WARNING: can't send suspension admin email (suspending anyway): ".
929 my %hash = $self->hash;
931 $hash{'adjourn'} = $date;
933 $hash{'susp'} = $suspend_time;
935 my $new = new FS::cust_pkg ( \%hash );
936 $error = $new->replace( $self, options => { $self->options } );
938 $dbh->rollback if $oldAutoCommit;
942 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
947 =item unsuspend [ OPTION => VALUE ... ]
949 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
950 package, then unsuspends the package itself (clears the susp field and the
951 adjourn field if it is in the past).
953 Available options are:
957 =item adjust_next_bill
959 Can be set true to adjust the next bill date forward by
960 the amount of time the account was inactive. This was set true by default
961 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
962 explicitly requested. Price plans for which this makes sense (anniversary-date
963 based than prorate or subscription) could have an option to enable this
968 If there is an error, returns the error, otherwise returns false.
973 my( $self, %opt ) = @_;
976 local $SIG{HUP} = 'IGNORE';
977 local $SIG{INT} = 'IGNORE';
978 local $SIG{QUIT} = 'IGNORE';
979 local $SIG{TERM} = 'IGNORE';
980 local $SIG{TSTP} = 'IGNORE';
981 local $SIG{PIPE} = 'IGNORE';
983 my $oldAutoCommit = $FS::UID::AutoCommit;
984 local $FS::UID::AutoCommit = 0;
987 my $old = $self->select_for_update;
989 my $pkgnum = $old->pkgnum;
990 if ( $old->get('cancel') || $self->get('cancel') ) {
991 dbh->rollback if $oldAutoCommit;
992 return "Can't unsuspend cancelled package $pkgnum";
995 unless ( $old->get('susp') && $self->get('susp') ) {
996 dbh->rollback if $oldAutoCommit;
997 return ""; # no error # complain instead?
1000 foreach my $cust_svc (
1001 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1003 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1005 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1006 $dbh->rollback if $oldAutoCommit;
1007 return "Illegal svcdb value in part_svc!";
1010 require "FS/$svcdb.pm";
1012 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1014 $error = $svc->unsuspend;
1016 $dbh->rollback if $oldAutoCommit;
1023 my %hash = $self->hash;
1024 my $inactive = time - $hash{'susp'};
1026 my $conf = new FS::Conf;
1028 if ( $inactive > 0 &&
1029 ( $hash{'bill'} || $hash{'setup'} ) &&
1030 ( $opt{'adjust_next_bill'} ||
1031 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1032 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1035 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1040 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1041 my $new = new FS::cust_pkg ( \%hash );
1042 $error = $new->replace( $self, options => { $self->options } );
1044 $dbh->rollback if $oldAutoCommit;
1048 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1055 Cancels any pending suspension (sets the adjourn field to null).
1057 If there is an error, returns the error, otherwise returns false.
1062 my( $self, %options ) = @_;
1065 local $SIG{HUP} = 'IGNORE';
1066 local $SIG{INT} = 'IGNORE';
1067 local $SIG{QUIT} = 'IGNORE';
1068 local $SIG{TERM} = 'IGNORE';
1069 local $SIG{TSTP} = 'IGNORE';
1070 local $SIG{PIPE} = 'IGNORE';
1072 my $oldAutoCommit = $FS::UID::AutoCommit;
1073 local $FS::UID::AutoCommit = 0;
1076 my $old = $self->select_for_update;
1078 my $pkgnum = $old->pkgnum;
1079 if ( $old->get('cancel') || $self->get('cancel') ) {
1080 dbh->rollback if $oldAutoCommit;
1081 return "Can't unadjourn cancelled package $pkgnum";
1082 # or at least it's pointless
1085 if ( $old->get('susp') || $self->get('susp') ) {
1086 dbh->rollback if $oldAutoCommit;
1087 return "Can't unadjourn suspended package $pkgnum";
1088 # perhaps this is arbitrary
1091 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1092 dbh->rollback if $oldAutoCommit;
1093 return ""; # no error
1096 my %hash = $self->hash;
1097 $hash{'adjourn'} = '';
1098 my $new = new FS::cust_pkg ( \%hash );
1099 $error = $new->replace( $self, options => { $self->options } );
1101 $dbh->rollback if $oldAutoCommit;
1105 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1112 =item change HASHREF | OPTION => VALUE ...
1114 Changes this package: cancels it and creates a new one, with a different
1115 pkgpart or locationnum or both. All services are transferred to the new
1116 package (no change will be made if this is not possible).
1118 Options may be passed as a list of key/value pairs or as a hash reference.
1125 New locationnum, to change the location for this package.
1129 New FS::cust_location object, to create a new location and assign it
1134 New pkgpart (see L<FS::part_pkg>).
1138 New refnum (see L<FS::part_referral>).
1142 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1143 susp, adjourn, cancel, expire, and contract_end) to the new package.
1147 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1148 (otherwise, what's the point?)
1150 Returns either the new FS::cust_pkg object or a scalar error.
1154 my $err_or_new_cust_pkg = $old_cust_pkg->change
1158 #some false laziness w/order
1161 my $opt = ref($_[0]) ? shift : { @_ };
1163 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1166 my $conf = new FS::Conf;
1168 # Transactionize this whole mess
1169 local $SIG{HUP} = 'IGNORE';
1170 local $SIG{INT} = 'IGNORE';
1171 local $SIG{QUIT} = 'IGNORE';
1172 local $SIG{TERM} = 'IGNORE';
1173 local $SIG{TSTP} = 'IGNORE';
1174 local $SIG{PIPE} = 'IGNORE';
1176 my $oldAutoCommit = $FS::UID::AutoCommit;
1177 local $FS::UID::AutoCommit = 0;
1186 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1188 #$hash{$_} = $self->$_() foreach qw( setup );
1190 $hash{'setup'} = $time if $self->setup;
1192 $hash{'change_date'} = $time;
1193 $hash{"change_$_"} = $self->$_()
1194 foreach qw( pkgnum pkgpart locationnum );
1196 if ( $opt->{'cust_location'} &&
1197 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1198 $error = $opt->{'cust_location'}->insert;
1200 $dbh->rollback if $oldAutoCommit;
1201 return "inserting cust_location (transaction rolled back): $error";
1203 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1206 if ( $opt->{'keep_dates'} ) {
1207 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1208 start_date contract_end ) ) {
1209 $hash{$date} = $self->getfield($date);
1213 # Create the new package.
1214 my $cust_pkg = new FS::cust_pkg {
1215 custnum => $self->custnum,
1216 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1217 refnum => ( $opt->{'refnum'} || $self->refnum ),
1218 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1222 $error = $cust_pkg->insert( 'change' => 1 );
1224 $dbh->rollback if $oldAutoCommit;
1228 # Transfer services and cancel old package.
1230 $error = $self->transfer($cust_pkg);
1231 if ($error and $error == 0) {
1232 # $old_pkg->transfer failed.
1233 $dbh->rollback if $oldAutoCommit;
1237 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1238 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1239 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1240 if ($error and $error == 0) {
1241 # $old_pkg->transfer failed.
1242 $dbh->rollback if $oldAutoCommit;
1248 # Transfers were successful, but we still had services left on the old
1249 # package. We can't change the package under this circumstances, so abort.
1250 $dbh->rollback if $oldAutoCommit;
1251 return "Unable to transfer all services from package ". $self->pkgnum;
1254 #reset usage if changing pkgpart
1255 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1256 if ($self->pkgpart != $cust_pkg->pkgpart) {
1257 my $part_pkg = $cust_pkg->part_pkg;
1258 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1262 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1265 $dbh->rollback if $oldAutoCommit;
1266 return "Error setting usage values: $error";
1270 #Good to go, cancel old package.
1271 $error = $self->cancel( quiet=>1 );
1273 $dbh->rollback if $oldAutoCommit;
1277 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1279 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1281 $dbh->rollback if $oldAutoCommit;
1286 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1293 use Storable 'thaw';
1295 sub process_bulk_cust_pkg {
1297 my $param = thaw(decode_base64(shift));
1298 warn Dumper($param) if $DEBUG;
1300 my $old_part_pkg = qsearchs('part_pkg',
1301 { pkgpart => $param->{'old_pkgpart'} });
1302 my $new_part_pkg = qsearchs('part_pkg',
1303 { pkgpart => $param->{'new_pkgpart'} });
1304 die "Must select a new package type\n" unless $new_part_pkg;
1305 #my $keep_dates = $param->{'keep_dates'} || 0;
1306 my $keep_dates = 1; # there is no good reason to turn this off
1308 local $SIG{HUP} = 'IGNORE';
1309 local $SIG{INT} = 'IGNORE';
1310 local $SIG{QUIT} = 'IGNORE';
1311 local $SIG{TERM} = 'IGNORE';
1312 local $SIG{TSTP} = 'IGNORE';
1313 local $SIG{PIPE} = 'IGNORE';
1315 my $oldAutoCommit = $FS::UID::AutoCommit;
1316 local $FS::UID::AutoCommit = 0;
1319 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1322 foreach my $old_cust_pkg ( @cust_pkgs ) {
1324 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1325 if ( $old_cust_pkg->getfield('cancel') ) {
1326 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1327 $old_cust_pkg->pkgnum."\n"
1331 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1333 my $error = $old_cust_pkg->change(
1334 'pkgpart' => $param->{'new_pkgpart'},
1335 'keep_dates' => $keep_dates
1337 if ( !ref($error) ) { # change returns the cust_pkg on success
1339 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1342 $dbh->commit if $oldAutoCommit;
1348 Returns the last bill date, or if there is no last bill date, the setup date.
1349 Useful for billing metered services.
1355 return $self->setfield('last_bill', $_[0]) if @_;
1356 return $self->getfield('last_bill') if $self->getfield('last_bill');
1357 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1358 'edate' => $self->bill, } );
1359 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1362 =item last_cust_pkg_reason ACTION
1364 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1365 Returns false if there is no reason or the package is not currenly ACTION'd
1366 ACTION is one of adjourn, susp, cancel, or expire.
1370 sub last_cust_pkg_reason {
1371 my ( $self, $action ) = ( shift, shift );
1372 my $date = $self->get($action);
1374 'table' => 'cust_pkg_reason',
1375 'hashref' => { 'pkgnum' => $self->pkgnum,
1376 'action' => substr(uc($action), 0, 1),
1379 'order_by' => 'ORDER BY num DESC LIMIT 1',
1383 =item last_reason ACTION
1385 Returns the most recent ACTION FS::reason associated with the package.
1386 Returns false if there is no reason or the package is not currenly ACTION'd
1387 ACTION is one of adjourn, susp, cancel, or expire.
1392 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1393 $cust_pkg_reason->reason
1394 if $cust_pkg_reason;
1399 Returns the definition for this billing item, as an FS::part_pkg object (see
1406 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1407 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1408 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1413 Returns the cancelled package this package was changed from, if any.
1419 return '' unless $self->change_pkgnum;
1420 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1425 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1432 $self->part_pkg->calc_setup($self, @_);
1437 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1444 $self->part_pkg->calc_recur($self, @_);
1449 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1456 $self->part_pkg->base_recur($self, @_);
1461 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1468 $self->part_pkg->calc_remain($self, @_);
1473 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1480 $self->part_pkg->calc_cancel($self, @_);
1485 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1491 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1494 =item cust_pkg_detail [ DETAILTYPE ]
1496 Returns any customer package details for this package (see
1497 L<FS::cust_pkg_detail>).
1499 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1503 sub cust_pkg_detail {
1505 my %hash = ( 'pkgnum' => $self->pkgnum );
1506 $hash{detailtype} = shift if @_;
1508 'table' => 'cust_pkg_detail',
1509 'hashref' => \%hash,
1510 'order_by' => 'ORDER BY weight, pkgdetailnum',
1514 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1516 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1518 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1520 If there is an error, returns the error, otherwise returns false.
1524 sub set_cust_pkg_detail {
1525 my( $self, $detailtype, @details ) = @_;
1527 local $SIG{HUP} = 'IGNORE';
1528 local $SIG{INT} = 'IGNORE';
1529 local $SIG{QUIT} = 'IGNORE';
1530 local $SIG{TERM} = 'IGNORE';
1531 local $SIG{TSTP} = 'IGNORE';
1532 local $SIG{PIPE} = 'IGNORE';
1534 my $oldAutoCommit = $FS::UID::AutoCommit;
1535 local $FS::UID::AutoCommit = 0;
1538 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1539 my $error = $current->delete;
1541 $dbh->rollback if $oldAutoCommit;
1542 return "error removing old detail: $error";
1546 foreach my $detail ( @details ) {
1547 my $cust_pkg_detail = new FS::cust_pkg_detail {
1548 'pkgnum' => $self->pkgnum,
1549 'detailtype' => $detailtype,
1550 'detail' => $detail,
1552 my $error = $cust_pkg_detail->insert;
1554 $dbh->rollback if $oldAutoCommit;
1555 return "error adding new detail: $error";
1560 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1567 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1571 #false laziness w/cust_bill.pm
1575 'table' => 'cust_event',
1576 'addl_from' => 'JOIN part_event USING ( eventpart )',
1577 'hashref' => { 'tablenum' => $self->pkgnum },
1578 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1582 =item num_cust_event
1584 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1588 #false laziness w/cust_bill.pm
1589 sub num_cust_event {
1592 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1593 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1594 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1595 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1596 $sth->fetchrow_arrayref->[0];
1599 =item cust_svc [ SVCPART ]
1601 Returns the services for this package, as FS::cust_svc objects (see
1602 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1610 return () unless $self->num_cust_svc(@_);
1613 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1614 'svcpart' => shift, } );
1617 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1619 #if ( $self->{'_svcnum'} ) {
1620 # values %{ $self->{'_svcnum'}->cache };
1622 $self->_sort_cust_svc(
1623 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1629 =item overlimit [ SVCPART ]
1631 Returns the services for this package which have exceeded their
1632 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1633 is specified, return only the matching services.
1639 return () unless $self->num_cust_svc(@_);
1640 grep { $_->overlimit } $self->cust_svc(@_);
1643 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1645 Returns historical services for this package created before END TIMESTAMP and
1646 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1647 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
1648 I<pkg_svc.hidden> flag will be omitted.
1654 my ($end, $start, $mode) = @_;
1655 my @cust_svc = $self->_sort_cust_svc(
1656 [ qsearch( 'h_cust_svc',
1657 { 'pkgnum' => $self->pkgnum, },
1658 FS::h_cust_svc->sql_h_search(@_),
1661 if ( $mode eq 'I' ) {
1662 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1663 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1670 sub _sort_cust_svc {
1671 my( $self, $arrayref ) = @_;
1674 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1679 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1680 'svcpart' => $_->svcpart } );
1682 $pkg_svc ? $pkg_svc->primary_svc : '',
1683 $pkg_svc ? $pkg_svc->quantity : 0,
1690 =item num_cust_svc [ SVCPART ]
1692 Returns the number of provisioned services for this package. If a svcpart is
1693 specified, counts only the matching services.
1700 return $self->{'_num_cust_svc'}
1702 && exists($self->{'_num_cust_svc'})
1703 && $self->{'_num_cust_svc'} =~ /\d/;
1705 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1708 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1709 $sql .= ' AND svcpart = ?' if @_;
1711 my $sth = dbh->prepare($sql) or die dbh->errstr;
1712 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1713 $sth->fetchrow_arrayref->[0];
1716 =item available_part_svc
1718 Returns a list of FS::part_svc objects representing services included in this
1719 package but not yet provisioned. Each FS::part_svc object also has an extra
1720 field, I<num_avail>, which specifies the number of available services.
1724 sub available_part_svc {
1726 grep { $_->num_avail > 0 }
1728 my $part_svc = $_->part_svc;
1729 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1730 $_->quantity - $self->num_cust_svc($_->svcpart);
1732 # more evil encapsulation breakage
1733 if($part_svc->{'Hash'}{'num_avail'} > 0) {
1734 my @exports = $part_svc->part_export_did;
1735 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
1740 $self->part_pkg->pkg_svc;
1745 Returns a list of FS::part_svc objects representing provisioned and available
1746 services included in this package. Each FS::part_svc object also has the
1747 following extra fields:
1751 =item num_cust_svc (count)
1753 =item num_avail (quantity - count)
1755 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1758 label -> ($cust_svc->label)[1]
1767 #XXX some sort of sort order besides numeric by svcpart...
1768 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1770 my $part_svc = $pkg_svc->part_svc;
1771 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1772 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1773 $part_svc->{'Hash'}{'num_avail'} =
1774 max( 0, $pkg_svc->quantity - $num_cust_svc );
1775 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1776 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1777 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
1779 } $self->part_pkg->pkg_svc;
1782 push @part_svc, map {
1784 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1785 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1786 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1787 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1788 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1790 } $self->extra_part_svc;
1796 =item extra_part_svc
1798 Returns a list of FS::part_svc objects corresponding to services in this
1799 package which are still provisioned but not (any longer) available in the
1804 sub extra_part_svc {
1807 my $pkgnum = $self->pkgnum;
1808 my $pkgpart = $self->pkgpart;
1811 # 'table' => 'part_svc',
1814 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1815 # WHERE pkg_svc.svcpart = part_svc.svcpart
1816 # AND pkg_svc.pkgpart = ?
1819 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1820 # LEFT JOIN cust_pkg USING ( pkgnum )
1821 # WHERE cust_svc.svcpart = part_svc.svcpart
1824 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1827 #seems to benchmark slightly faster...
1829 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1830 #MySQL doesn't grok DISINCT ON
1831 'select' => 'DISTINCT part_svc.*',
1832 'table' => 'part_svc',
1834 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1835 AND pkg_svc.pkgpart = ?
1838 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1839 LEFT JOIN cust_pkg USING ( pkgnum )
1842 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1843 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1849 Returns a short status string for this package, currently:
1853 =item not yet billed
1855 =item one-time charge
1870 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1872 return 'cancelled' if $self->get('cancel');
1873 return 'suspended' if $self->susp;
1874 return 'not yet billed' unless $self->setup;
1875 return 'one-time charge' if $freq =~ /^(0|$)/;
1879 =item ucfirst_status
1881 Returns the status with the first character capitalized.
1885 sub ucfirst_status {
1886 ucfirst(shift->status);
1891 Class method that returns the list of possible status strings for packages
1892 (see L<the status method|/status>). For example:
1894 @statuses = FS::cust_pkg->statuses();
1898 tie my %statuscolor, 'Tie::IxHash',
1899 'not yet billed' => '009999', #teal? cyan?
1900 'one-time charge' => '000000',
1901 'active' => '00CC00',
1902 'suspended' => 'FF9900',
1903 'cancelled' => 'FF0000',
1907 my $self = shift; #could be class...
1908 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1909 # # mayble split btw one-time vs. recur
1915 Returns a hex triplet color string for this package's status.
1921 $statuscolor{$self->status};
1926 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1927 "pkg-comment" depending on user preference).
1933 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1934 $label = $self->pkgnum. ": $label"
1935 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1939 =item pkg_label_long
1941 Returns a long label for this package, adding the primary service's label to
1946 sub pkg_label_long {
1948 my $label = $self->pkg_label;
1949 my $cust_svc = $self->primary_cust_svc;
1950 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1954 =item primary_cust_svc
1956 Returns a primary service (as FS::cust_svc object) if one can be identified.
1960 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1962 sub primary_cust_svc {
1965 my @cust_svc = $self->cust_svc;
1967 return '' unless @cust_svc; #no serivces - irrelevant then
1969 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1971 # primary service as specified in the package definition
1972 # or exactly one service definition with quantity one
1973 my $svcpart = $self->part_pkg->svcpart;
1974 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1975 return $cust_svc[0] if scalar(@cust_svc) == 1;
1977 #couldn't identify one thing..
1983 Returns a list of lists, calling the label method for all services
1984 (see L<FS::cust_svc>) of this billing item.
1990 map { [ $_->label ] } $self->cust_svc;
1993 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1995 Like the labels method, but returns historical information on services that
1996 were active as of END_TIMESTAMP and (optionally) not cancelled before
1997 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
1998 I<pkg_svc.hidden> flag will be omitted.
2000 Returns a list of lists, calling the label method for all (historical) services
2001 (see L<FS::h_cust_svc>) of this billing item.
2007 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2012 Like labels, except returns a simple flat list, and shortens long
2013 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2014 identical services to one line that lists the service label and the number of
2015 individual services rather than individual items.
2020 shift->_labels_short( 'labels', @_ );
2023 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2025 Like h_labels, except returns a simple flat list, and shortens long
2026 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2027 identical services to one line that lists the service label and the number of
2028 individual services rather than individual items.
2032 sub h_labels_short {
2033 shift->_labels_short( 'h_labels', @_ );
2037 my( $self, $method ) = ( shift, shift );
2039 my $conf = new FS::Conf;
2040 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2043 #tie %labels, 'Tie::IxHash';
2044 push @{ $labels{$_->[0]} }, $_->[1]
2045 foreach $self->$method(@_);
2047 foreach my $label ( keys %labels ) {
2049 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2050 my $num = scalar(@values);
2051 if ( $num > $max_same_services ) {
2052 push @labels, "$label ($num)";
2054 if ( $conf->exists('cust_bill-consolidate_services') ) {
2055 # push @labels, "$label: ". join(', ', @values);
2057 my $detail = "$label: ";
2058 $detail .= shift(@values). ', '
2059 while @values && length($detail.$values[0]) < 78;
2061 push @labels, $detail;
2064 push @labels, map { "$label: $_" } @values;
2075 Returns the parent customer object (see L<FS::cust_main>).
2081 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2084 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2088 Returns the location object, if any (see L<FS::cust_location>).
2090 =item cust_location_or_main
2092 If this package is associated with a location, returns the locaiton (see
2093 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2095 =item location_label [ OPTION => VALUE ... ]
2097 Returns the label of the location object (see L<FS::cust_location>).
2101 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2103 =item seconds_since TIMESTAMP
2105 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2106 package have been online since TIMESTAMP, according to the session monitor.
2108 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2109 L<Time::Local> and L<Date::Parse> for conversion functions.
2114 my($self, $since) = @_;
2117 foreach my $cust_svc (
2118 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2120 $seconds += $cust_svc->seconds_since($since);
2127 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2129 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2130 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2133 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2134 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2140 sub seconds_since_sqlradacct {
2141 my($self, $start, $end) = @_;
2145 foreach my $cust_svc (
2147 my $part_svc = $_->part_svc;
2148 $part_svc->svcdb eq 'svc_acct'
2149 && scalar($part_svc->part_export('sqlradius'));
2152 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2159 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2161 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2162 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2166 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2167 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2172 sub attribute_since_sqlradacct {
2173 my($self, $start, $end, $attrib) = @_;
2177 foreach my $cust_svc (
2179 my $part_svc = $_->part_svc;
2180 $part_svc->svcdb eq 'svc_acct'
2181 && scalar($part_svc->part_export('sqlradius'));
2184 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2196 my( $self, $value ) = @_;
2197 if ( defined($value) ) {
2198 $self->setfield('quantity', $value);
2200 $self->getfield('quantity') || 1;
2203 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2205 Transfers as many services as possible from this package to another package.
2207 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2208 object. The destination package must already exist.
2210 Services are moved only if the destination allows services with the correct
2211 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2212 this option with caution! No provision is made for export differences
2213 between the old and new service definitions. Probably only should be used
2214 when your exports for all service definitions of a given svcdb are identical.
2215 (attempt a transfer without it first, to move all possible svcpart-matching
2218 Any services that can't be moved remain in the original package.
2220 Returns an error, if there is one; otherwise, returns the number of services
2221 that couldn't be moved.
2226 my ($self, $dest_pkgnum, %opt) = @_;
2232 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2233 $dest = $dest_pkgnum;
2234 $dest_pkgnum = $dest->pkgnum;
2236 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2239 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2241 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2242 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2245 foreach my $cust_svc ($dest->cust_svc) {
2246 $target{$cust_svc->svcpart}--;
2249 my %svcpart2svcparts = ();
2250 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2251 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2252 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2253 next if exists $svcpart2svcparts{$svcpart};
2254 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2255 $svcpart2svcparts{$svcpart} = [
2257 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2259 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2260 'svcpart' => $_ } );
2262 $pkg_svc ? $pkg_svc->primary_svc : '',
2263 $pkg_svc ? $pkg_svc->quantity : 0,
2267 grep { $_ != $svcpart }
2269 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2271 warn "alternates for svcpart $svcpart: ".
2272 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2277 foreach my $cust_svc ($self->cust_svc) {
2278 if($target{$cust_svc->svcpart} > 0) {
2279 $target{$cust_svc->svcpart}--;
2280 my $new = new FS::cust_svc { $cust_svc->hash };
2281 $new->pkgnum($dest_pkgnum);
2282 my $error = $new->replace($cust_svc);
2283 return $error if $error;
2284 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2286 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2287 warn "alternates to consider: ".
2288 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2290 my @alternate = grep {
2291 warn "considering alternate svcpart $_: ".
2292 "$target{$_} available in new package\n"
2295 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2297 warn "alternate(s) found\n" if $DEBUG;
2298 my $change_svcpart = $alternate[0];
2299 $target{$change_svcpart}--;
2300 my $new = new FS::cust_svc { $cust_svc->hash };
2301 $new->svcpart($change_svcpart);
2302 $new->pkgnum($dest_pkgnum);
2303 my $error = $new->replace($cust_svc);
2304 return $error if $error;
2317 This method is deprecated. See the I<depend_jobnum> option to the insert and
2318 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2325 local $SIG{HUP} = 'IGNORE';
2326 local $SIG{INT} = 'IGNORE';
2327 local $SIG{QUIT} = 'IGNORE';
2328 local $SIG{TERM} = 'IGNORE';
2329 local $SIG{TSTP} = 'IGNORE';
2330 local $SIG{PIPE} = 'IGNORE';
2332 my $oldAutoCommit = $FS::UID::AutoCommit;
2333 local $FS::UID::AutoCommit = 0;
2336 foreach my $cust_svc ( $self->cust_svc ) {
2337 #false laziness w/svc_Common::insert
2338 my $svc_x = $cust_svc->svc_x;
2339 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2340 my $error = $part_export->export_insert($svc_x);
2342 $dbh->rollback if $oldAutoCommit;
2348 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2355 Associates this package with a (suspension or cancellation) reason (see
2356 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2359 Available options are:
2365 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.
2369 the access_user (see L<FS::access_user>) providing the reason
2377 the action (cancel, susp, adjourn, expire) associated with the reason
2381 If there is an error, returns the error, otherwise returns false.
2386 my ($self, %options) = @_;
2388 my $otaker = $options{reason_otaker} ||
2389 $FS::CurrentUser::CurrentUser->username;
2392 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2396 } elsif ( ref($options{'reason'}) ) {
2398 return 'Enter a new reason (or select an existing one)'
2399 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2401 my $reason = new FS::reason({
2402 'reason_type' => $options{'reason'}->{'typenum'},
2403 'reason' => $options{'reason'}->{'reason'},
2405 my $error = $reason->insert;
2406 return $error if $error;
2408 $reasonnum = $reason->reasonnum;
2411 return "Unparsable reason: ". $options{'reason'};
2414 my $cust_pkg_reason =
2415 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2416 'reasonnum' => $reasonnum,
2417 'otaker' => $otaker,
2418 'action' => substr(uc($options{'action'}),0,1),
2419 'date' => $options{'date'}
2424 $cust_pkg_reason->insert;
2427 =item insert_discount
2429 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2430 inserting a new discount on the fly (see L<FS::discount>).
2432 Available options are:
2440 If there is an error, returns the error, otherwise returns false.
2444 sub insert_discount {
2445 #my ($self, %options) = @_;
2448 my $cust_pkg_discount = new FS::cust_pkg_discount {
2449 'pkgnum' => $self->pkgnum,
2450 'discountnum' => $self->discountnum,
2452 'end_date' => '', #XXX
2453 'otaker' => $self->otaker,
2454 #for the create a new discount case
2455 '_type' => $self->discountnum__type,
2456 'amount' => $self->discountnum_amount,
2457 'percent' => $self->discountnum_percent,
2458 'months' => $self->discountnum_months,
2459 #'disabled' => $self->discountnum_disabled,
2462 $cust_pkg_discount->insert;
2465 =item set_usage USAGE_VALUE_HASHREF
2467 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2468 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2469 upbytes, downbytes, and totalbytes are appropriate keys.
2471 All svc_accts which are part of this package have their values reset.
2476 my ($self, $valueref, %opt) = @_;
2478 foreach my $cust_svc ($self->cust_svc){
2479 my $svc_x = $cust_svc->svc_x;
2480 $svc_x->set_usage($valueref, %opt)
2481 if $svc_x->can("set_usage");
2485 =item recharge USAGE_VALUE_HASHREF
2487 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2488 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2489 upbytes, downbytes, and totalbytes are appropriate keys.
2491 All svc_accts which are part of this package have their values incremented.
2496 my ($self, $valueref) = @_;
2498 foreach my $cust_svc ($self->cust_svc){
2499 my $svc_x = $cust_svc->svc_x;
2500 $svc_x->recharge($valueref)
2501 if $svc_x->can("recharge");
2505 =item cust_pkg_discount
2509 sub cust_pkg_discount {
2511 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2514 =item cust_pkg_discount_active
2518 sub cust_pkg_discount_active {
2520 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2525 =head1 CLASS METHODS
2531 Returns an SQL expression identifying recurring packages.
2535 sub recurring_sql { "
2536 '0' != ( select freq from part_pkg
2537 where cust_pkg.pkgpart = part_pkg.pkgpart )
2542 Returns an SQL expression identifying one-time packages.
2547 '0' = ( select freq from part_pkg
2548 where cust_pkg.pkgpart = part_pkg.pkgpart )
2553 Returns an SQL expression identifying ordered packages (recurring packages not
2559 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2564 Returns an SQL expression identifying active packages.
2569 $_[0]->recurring_sql. "
2570 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2571 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2572 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2575 =item not_yet_billed_sql
2577 Returns an SQL expression identifying packages which have not yet been billed.
2581 sub not_yet_billed_sql { "
2582 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2583 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2584 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2589 Returns an SQL expression identifying inactive packages (one-time packages
2590 that are otherwise unsuspended/uncancelled).
2594 sub inactive_sql { "
2595 ". $_[0]->onetime_sql(). "
2596 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2597 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2598 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2604 Returns an SQL expression identifying suspended packages.
2608 sub suspended_sql { susp_sql(@_); }
2610 #$_[0]->recurring_sql(). ' AND '.
2612 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2613 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2620 Returns an SQL exprression identifying cancelled packages.
2624 sub cancelled_sql { cancel_sql(@_); }
2626 #$_[0]->recurring_sql(). ' AND '.
2627 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2632 Returns an SQL expression to give the package status as a string.
2638 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2639 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2640 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2641 WHEN ".onetime_sql()." THEN 'one-time charge'
2646 =item search HASHREF
2650 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2651 Valid parameters are
2659 active, inactive, suspended, cancel (or cancelled)
2663 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2667 boolean selects custom packages
2673 pkgpart or arrayref or hashref of pkgparts
2677 arrayref of beginning and ending epoch date
2681 arrayref of beginning and ending epoch date
2685 arrayref of beginning and ending epoch date
2689 arrayref of beginning and ending epoch date
2693 arrayref of beginning and ending epoch date
2697 arrayref of beginning and ending epoch date
2701 arrayref of beginning and ending epoch date
2705 pkgnum or APKG_pkgnum
2709 a value suited to passing to FS::UI::Web::cust_header
2713 specifies the user for agent virtualization
2717 boolean selects packages containing fcc form 477 telco lines
2724 my ($class, $params) = @_;
2731 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2733 "cust_main.agentnum = $1";
2740 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2742 "cust_pkg.custnum = $1";
2749 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2751 "cust_pkg.pkgbatch = '$1'";
2758 if ( $params->{'magic'} eq 'active'
2759 || $params->{'status'} eq 'active' ) {
2761 push @where, FS::cust_pkg->active_sql();
2763 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2764 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2766 push @where, FS::cust_pkg->not_yet_billed_sql();
2768 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2769 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2771 push @where, FS::cust_pkg->inactive_sql();
2773 } elsif ( $params->{'magic'} eq 'suspended'
2774 || $params->{'status'} eq 'suspended' ) {
2776 push @where, FS::cust_pkg->suspended_sql();
2778 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2779 || $params->{'status'} =~ /^cancell?ed$/ ) {
2781 push @where, FS::cust_pkg->cancelled_sql();
2786 # parse package class
2789 #false lazinessish w/graph/cust_bill_pkg.cgi
2792 if ( exists($params->{'classnum'})
2793 && $params->{'classnum'} =~ /^(\d*)$/
2797 if ( $classnum ) { #a specific class
2798 push @where, "part_pkg.classnum = $classnum";
2800 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2801 #die "classnum $classnum not found!" unless $pkg_class[0];
2802 #$title .= $pkg_class[0]->classname.' ';
2804 } elsif ( $classnum eq '' ) { #the empty class
2806 push @where, "part_pkg.classnum IS NULL";
2807 #$title .= 'Empty class ';
2808 #@pkg_class = ( '(empty class)' );
2809 } elsif ( $classnum eq '0' ) {
2810 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2811 #push @pkg_class, '(empty class)';
2813 die "illegal classnum";
2819 # parse package report options
2822 my @report_option = ();
2823 if ( exists($params->{'report_option'})
2824 && $params->{'report_option'} =~ /^([,\d]*)$/
2827 @report_option = split(',', $1);
2830 if (@report_option) {
2831 # this will result in the empty set for the dangling comma case as it should
2833 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2834 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2835 AND optionname = 'report_option_$_'
2836 AND optionvalue = '1' )"
2846 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2852 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2858 if ( exists($params->{'censustract'}) ) {
2859 $params->{'censustract'} =~ /^([.\d]*)$/;
2860 my $censustract = "cust_main.censustract = '$1'";
2861 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2862 push @where, "( $censustract )";
2869 if ( ref($params->{'pkgpart'}) ) {
2872 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2873 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2874 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2875 @pkgpart = @{ $params->{'pkgpart'} };
2877 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2880 @pkgpart = grep /^(\d+)$/, @pkgpart;
2882 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2884 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2885 push @where, "pkgpart = $1";
2894 #false laziness w/report_cust_pkg.html
2897 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2898 'active' => { 'susp'=>1, 'cancel'=>1 },
2899 'suspended' => { 'cancel' => 1 },
2904 if( exists($params->{'active'} ) ) {
2905 # This overrides all the other date-related fields
2906 my($beginning, $ending) = @{$params->{'active'}};
2908 "cust_pkg.setup IS NOT NULL",
2909 "cust_pkg.setup <= $ending",
2910 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2911 "NOT (".FS::cust_pkg->onetime_sql . ")";
2914 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
2916 next unless exists($params->{$field});
2918 my($beginning, $ending) = @{$params->{$field}};
2920 next if $beginning == 0 && $ending == 4294967295;
2923 "cust_pkg.$field IS NOT NULL",
2924 "cust_pkg.$field >= $beginning",
2925 "cust_pkg.$field <= $ending";
2927 $orderby ||= "ORDER BY cust_pkg.$field";
2932 $orderby ||= 'ORDER BY bill';
2935 # parse magic, legacy, etc.
2938 if ( $params->{'magic'} &&
2939 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2942 $orderby = 'ORDER BY pkgnum';
2944 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2945 push @where, "pkgpart = $1";
2948 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2950 $orderby = 'ORDER BY pkgnum';
2952 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2954 $orderby = 'ORDER BY pkgnum';
2957 SELECT count(*) FROM pkg_svc
2958 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2959 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2960 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2961 AND cust_svc.svcpart = pkg_svc.svcpart
2968 # setup queries, links, subs, etc. for the search
2971 # here is the agent virtualization
2972 if ($params->{CurrentUser}) {
2974 qsearchs('access_user', { username => $params->{CurrentUser} });
2977 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2982 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2985 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2987 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2988 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2989 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2991 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2994 'table' => 'cust_pkg',
2996 'select' => join(', ',
2998 ( map "part_pkg.$_", qw( pkg freq ) ),
2999 'pkg_class.classname',
3000 'cust_main.custnum AS cust_main_custnum',
3001 FS::UI::Web::cust_sql_fields(
3002 $params->{'cust_fields'}
3005 'extra_sql' => "$extra_sql $orderby",
3006 'addl_from' => $addl_from,
3007 'count_query' => $count_query,
3014 Returns a list of two package counts. The first is a count of packages
3015 based on the supplied criteria and the second is the count of residential
3016 packages with those same criteria. Criteria are specified as in the search
3022 my ($class, $params) = @_;
3024 my $sql_query = $class->search( $params );
3026 my $count_sql = delete($sql_query->{'count_query'});
3027 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3028 or die "couldn't parse count_sql";
3030 my $count_sth = dbh->prepare($count_sql)
3031 or die "Error preparing $count_sql: ". dbh->errstr;
3033 or die "Error executing $count_sql: ". $count_sth->errstr;
3034 my $count_arrayref = $count_sth->fetchrow_arrayref;
3036 return ( @$count_arrayref );
3043 Returns a list: the first item is an SQL fragment identifying matching
3044 packages/customers via location (taking into account shipping and package
3045 address taxation, if enabled), and subsequent items are the parameters to
3046 substitute for the placeholders in that fragment.
3051 my($class, %opt) = @_;
3052 my $ornull = $opt{'ornull'};
3054 my $conf = new FS::Conf;
3056 # '?' placeholders in _location_sql_where
3057 my $x = $ornull ? 3 : 2;
3058 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3062 if ( $conf->exists('tax-ship_address') ) {
3065 ( ( ship_last IS NULL OR ship_last = '' )
3066 AND ". _location_sql_where('cust_main', '', $ornull ). "
3068 OR ( ship_last IS NOT NULL AND ship_last != ''
3069 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3072 # AND payby != 'COMP'
3074 @main_param = ( @bill_param, @bill_param );
3078 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3079 @main_param = @bill_param;
3085 if ( $conf->exists('tax-pkg_address') ) {
3087 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3090 ( cust_pkg.locationnum IS NULL AND $main_where )
3091 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3094 @param = ( @main_param, @bill_param );
3098 $where = $main_where;
3099 @param = @main_param;
3107 #subroutine, helper for location_sql
3108 sub _location_sql_where {
3110 my $prefix = @_ ? shift : '';
3111 my $ornull = @_ ? shift : '';
3113 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3115 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3117 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3118 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3119 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3121 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3123 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3124 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3125 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3126 AND $table.${prefix}country = ?
3134 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3136 CUSTNUM is a customer (see L<FS::cust_main>)
3138 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3139 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3142 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3143 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3144 new billing items. An error is returned if this is not possible (see
3145 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3148 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3149 newly-created cust_pkg objects.
3151 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3152 and inserted. Multiple FS::pkg_referral records can be created by
3153 setting I<refnum> to an array reference of refnums or a hash reference with
3154 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3155 record will be created corresponding to cust_main.refnum.
3160 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3162 my $conf = new FS::Conf;
3164 # Transactionize this whole mess
3165 local $SIG{HUP} = 'IGNORE';
3166 local $SIG{INT} = 'IGNORE';
3167 local $SIG{QUIT} = 'IGNORE';
3168 local $SIG{TERM} = 'IGNORE';
3169 local $SIG{TSTP} = 'IGNORE';
3170 local $SIG{PIPE} = 'IGNORE';
3172 my $oldAutoCommit = $FS::UID::AutoCommit;
3173 local $FS::UID::AutoCommit = 0;
3177 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3178 # return "Customer not found: $custnum" unless $cust_main;
3180 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3183 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3186 my $change = scalar(@old_cust_pkg) != 0;
3189 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3191 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3192 " to pkgpart ". $pkgparts->[0]. "\n"
3195 my $err_or_cust_pkg =
3196 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3197 'refnum' => $refnum,
3200 unless (ref($err_or_cust_pkg)) {
3201 $dbh->rollback if $oldAutoCommit;
3202 return $err_or_cust_pkg;
3205 push @$return_cust_pkg, $err_or_cust_pkg;
3206 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3211 # Create the new packages.
3212 foreach my $pkgpart (@$pkgparts) {
3214 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3216 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3217 pkgpart => $pkgpart,
3221 $error = $cust_pkg->insert( 'change' => $change );
3223 $dbh->rollback if $oldAutoCommit;
3226 push @$return_cust_pkg, $cust_pkg;
3228 # $return_cust_pkg now contains refs to all of the newly
3231 # Transfer services and cancel old packages.
3232 foreach my $old_pkg (@old_cust_pkg) {
3234 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3237 foreach my $new_pkg (@$return_cust_pkg) {
3238 $error = $old_pkg->transfer($new_pkg);
3239 if ($error and $error == 0) {
3240 # $old_pkg->transfer failed.
3241 $dbh->rollback if $oldAutoCommit;
3246 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3247 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3248 foreach my $new_pkg (@$return_cust_pkg) {
3249 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3250 if ($error and $error == 0) {
3251 # $old_pkg->transfer failed.
3252 $dbh->rollback if $oldAutoCommit;
3259 # Transfers were successful, but we went through all of the
3260 # new packages and still had services left on the old package.
3261 # We can't cancel the package under the circumstances, so abort.
3262 $dbh->rollback if $oldAutoCommit;
3263 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3265 $error = $old_pkg->cancel( quiet=>1 );
3271 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3275 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3277 A bulk change method to change packages for multiple customers.
3279 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3280 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3283 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3284 replace. The services (see L<FS::cust_svc>) are moved to the
3285 new billing items. An error is returned if this is not possible (see
3288 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3289 newly-created cust_pkg objects.
3294 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3296 # Transactionize this whole mess
3297 local $SIG{HUP} = 'IGNORE';
3298 local $SIG{INT} = 'IGNORE';
3299 local $SIG{QUIT} = 'IGNORE';
3300 local $SIG{TERM} = 'IGNORE';
3301 local $SIG{TSTP} = 'IGNORE';
3302 local $SIG{PIPE} = 'IGNORE';
3304 my $oldAutoCommit = $FS::UID::AutoCommit;
3305 local $FS::UID::AutoCommit = 0;
3309 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3312 while(scalar(@old_cust_pkg)) {
3314 my $custnum = $old_cust_pkg[0]->custnum;
3315 my (@remove) = map { $_->pkgnum }
3316 grep { $_->custnum == $custnum } @old_cust_pkg;
3317 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3319 my $error = order $custnum, $pkgparts, \@remove, \@return;
3321 push @errors, $error
3323 push @$return_cust_pkg, @return;
3326 if (scalar(@errors)) {
3327 $dbh->rollback if $oldAutoCommit;
3328 return join(' / ', @errors);
3331 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3335 # Used by FS::Upgrade to migrate to a new database.
3336 sub _upgrade_data { # class method
3337 my ($class, %opts) = @_;
3338 $class->_upgrade_otaker(%opts);
3340 # RT#10139, bug resulting in contract_end being set when it shouldn't
3341 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3342 # RT#10830, bad calculation of prorate date near end of year
3343 # the date range for bill is December 2009, and we move it forward
3344 # one year if it's before the previous bill date (which it should
3346 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3347 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3348 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3350 foreach my $sql (@statements) {
3351 my $sth = dbh->prepare($sql);
3352 $sth->execute or die $sth->errstr;
3360 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3362 In sub order, the @pkgparts array (passed by reference) is clobbered.
3364 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3365 method to pass dates to the recur_prog expression, it should do so.
3367 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3368 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3369 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3370 configuration values. Probably need a subroutine which decides what to do
3371 based on whether or not we've fetched the user yet, rather than a hash. See
3372 FS::UID and the TODO.
3374 Now that things are transactional should the check in the insert method be
3379 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3380 L<FS::pkg_svc>, schema.html from the base documentation