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)
162 order taker (see L<FS::access_user>)
166 If this field is set to 1, disables the automatic
167 unsuspension of this package when using the B<unsuspendauto> config option.
171 If not set, defaults to 1
175 Date of change from previous package
185 =item change_locationnum
191 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
192 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
193 L<Time::Local> and L<Date::Parse> for conversion functions.
201 Create a new billing item. To add the item to the database, see L<"insert">.
205 sub table { 'cust_pkg'; }
206 sub cust_linked { $_[0]->cust_main_custnum; }
207 sub cust_unlinked_msg {
209 "WARNING: can't find cust_main.custnum ". $self->custnum.
210 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
213 =item insert [ OPTION => VALUE ... ]
215 Adds this billing item to the database ("Orders" the item). If there is an
216 error, returns the error, otherwise returns false.
218 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
219 will be used to look up the package definition and agent restrictions will be
222 If the additional field I<refnum> is defined, an FS::pkg_referral record will
223 be created and inserted. Multiple FS::pkg_referral records can be created by
224 setting I<refnum> to an array reference of refnums or a hash reference with
225 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
226 record will be created corresponding to cust_main.refnum.
228 The following options are available:
234 If set true, supresses any referral credit to a referring customer.
238 cust_pkg_option records will be created
242 a ticket will be added to this customer with this subject
246 an optional queue name for ticket additions
253 my( $self, %options ) = @_;
255 if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
256 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
257 $mon += 1 unless $mday == 1;
258 until ( $mon < 12 ) { $mon -= 12; $year++; }
259 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
262 foreach my $action ( qw(expire adjourn) ) {
263 my $months = $self->part_pkg->option("${action}_months",1);
264 if($months and !$self->$action) {
265 my $start = $self->start_date || $self->setup || time;
266 $self->$action( $self->part_pkg->add_freq($start, $months) );
270 local $SIG{HUP} = 'IGNORE';
271 local $SIG{INT} = 'IGNORE';
272 local $SIG{QUIT} = 'IGNORE';
273 local $SIG{TERM} = 'IGNORE';
274 local $SIG{TSTP} = 'IGNORE';
275 local $SIG{PIPE} = 'IGNORE';
277 my $oldAutoCommit = $FS::UID::AutoCommit;
278 local $FS::UID::AutoCommit = 0;
281 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
283 $dbh->rollback if $oldAutoCommit;
287 $self->refnum($self->cust_main->refnum) unless $self->refnum;
288 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
289 $self->process_m2m( 'link_table' => 'pkg_referral',
290 'target_table' => 'part_referral',
291 'params' => $self->refnum,
294 if ( $self->discountnum ) {
295 my $error = $self->insert_discount();
297 $dbh->rollback if $oldAutoCommit;
302 #if ( $self->reg_code ) {
303 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
304 # $error = $reg_code->delete;
306 # $dbh->rollback if $oldAutoCommit;
311 my $conf = new FS::Conf;
313 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
316 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
323 use FS::TicketSystem;
324 FS::TicketSystem->init();
326 my $q = new RT::Queue($RT::SystemUser);
327 $q->Load($options{ticket_queue}) if $options{ticket_queue};
328 my $t = new RT::Ticket($RT::SystemUser);
329 my $mime = new MIME::Entity;
330 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
331 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
332 Subject => $options{ticket_subject},
335 $t->AddLink( Type => 'MemberOf',
336 Target => 'freeside://freeside/cust_main/'. $self->custnum,
340 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
341 my $queue = new FS::queue {
342 'job' => 'FS::cust_main::queueable_print',
344 $error = $queue->insert(
345 'custnum' => $self->custnum,
346 'template' => 'welcome_letter',
350 warn "can't send welcome letter: $error";
355 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
362 This method now works but you probably shouldn't use it.
364 You don't want to delete billing items, because there would then be no record
365 the customer ever purchased the item. Instead, see the cancel method.
370 # return "Can't delete cust_pkg records!";
373 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
375 Replaces the OLD_RECORD with this one in the database. If there is an error,
376 returns the error, otherwise returns false.
378 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
380 Changing pkgpart may have disasterous effects. See the order subroutine.
382 setup and bill are normally updated by calling the bill method of a customer
383 object (see L<FS::cust_main>).
385 suspend is normally updated by the suspend and unsuspend methods.
387 cancel is normally updated by the cancel method (and also the order subroutine
390 Available options are:
396 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.
400 the access_user (see L<FS::access_user>) providing the reason
404 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
413 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
418 ( ref($_[0]) eq 'HASH' )
422 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
423 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
426 #return "Can't change setup once it exists!"
427 # if $old->getfield('setup') &&
428 # $old->getfield('setup') != $new->getfield('setup');
430 #some logic for bill, susp, cancel?
432 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
434 local $SIG{HUP} = 'IGNORE';
435 local $SIG{INT} = 'IGNORE';
436 local $SIG{QUIT} = 'IGNORE';
437 local $SIG{TERM} = 'IGNORE';
438 local $SIG{TSTP} = 'IGNORE';
439 local $SIG{PIPE} = 'IGNORE';
441 my $oldAutoCommit = $FS::UID::AutoCommit;
442 local $FS::UID::AutoCommit = 0;
445 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
446 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
447 my $error = $new->insert_reason(
448 'reason' => $options->{'reason'},
449 'date' => $new->$method,
451 'reason_otaker' => $options->{'reason_otaker'},
454 dbh->rollback if $oldAutoCommit;
455 return "Error inserting cust_pkg_reason: $error";
460 #save off and freeze RADIUS attributes for any associated svc_acct records
462 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
464 #also check for specific exports?
465 # to avoid spurious modify export events
466 @svc_acct = map { $_->svc_x }
467 grep { $_->part_svc->svcdb eq 'svc_acct' }
470 $_->snapshot foreach @svc_acct;
474 my $error = $new->SUPER::replace($old,
475 $options->{options} ? $options->{options} : ()
478 $dbh->rollback if $oldAutoCommit;
482 #for prepaid packages,
483 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
484 foreach my $old_svc_acct ( @svc_acct ) {
485 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
486 my $s_error = $new_svc_acct->replace($old_svc_acct);
488 $dbh->rollback if $oldAutoCommit;
493 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
500 Checks all fields to make sure this is a valid billing item. If there is an
501 error, returns the error, otherwise returns false. Called by the insert and
509 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
512 $self->ut_numbern('pkgnum')
513 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
514 || $self->ut_numbern('pkgpart')
515 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
516 || $self->ut_numbern('start_date')
517 || $self->ut_numbern('setup')
518 || $self->ut_numbern('bill')
519 || $self->ut_numbern('susp')
520 || $self->ut_numbern('cancel')
521 || $self->ut_numbern('adjourn')
522 || $self->ut_numbern('expire')
523 || $self->ut_enum('no_auto', [ '', 'Y' ])
525 return $error if $error;
527 if ( $self->reg_code ) {
529 unless ( grep { $self->pkgpart == $_->pkgpart }
530 map { $_->reg_code_pkg }
531 qsearchs( 'reg_code', { 'code' => $self->reg_code,
532 'agentnum' => $self->cust_main->agentnum })
534 return "Unknown registration code";
537 } elsif ( $self->promo_code ) {
540 qsearchs('part_pkg', {
541 'pkgpart' => $self->pkgpart,
542 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
544 return 'Unknown promotional code' unless $promo_part_pkg;
548 unless ( $disable_agentcheck ) {
550 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
551 return "agent ". $agent->agentnum. ':'. $agent->agent.
552 " can't purchase pkgpart ". $self->pkgpart
553 unless $agent->pkgpart_hashref->{ $self->pkgpart }
554 || $agent->agentnum == $self->part_pkg->agentnum;
557 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
558 return $error if $error;
562 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
564 if ( $self->dbdef_table->column('manual_flag') ) {
565 $self->manual_flag('') if $self->manual_flag eq ' ';
566 $self->manual_flag =~ /^([01]?)$/
567 or return "Illegal manual_flag ". $self->manual_flag;
568 $self->manual_flag($1);
574 =item cancel [ OPTION => VALUE ... ]
576 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
577 in this package, then cancels the package itself (sets the cancel field to
580 Available options are:
584 =item quiet - can be set true to supress email cancellation notices.
586 =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.
588 =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.
590 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
592 =item nobill - can be set true to skip billing if it might otherwise be done.
596 If there is an error, returns the error, otherwise returns false.
601 my( $self, %options ) = @_;
604 my $conf = new FS::Conf;
606 warn "cust_pkg::cancel called with options".
607 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
610 local $SIG{HUP} = 'IGNORE';
611 local $SIG{INT} = 'IGNORE';
612 local $SIG{QUIT} = 'IGNORE';
613 local $SIG{TERM} = 'IGNORE';
614 local $SIG{TSTP} = 'IGNORE';
615 local $SIG{PIPE} = 'IGNORE';
617 my $oldAutoCommit = $FS::UID::AutoCommit;
618 local $FS::UID::AutoCommit = 0;
621 my $old = $self->select_for_update;
623 if ( $old->get('cancel') || $self->get('cancel') ) {
624 dbh->rollback if $oldAutoCommit;
625 return ""; # no error
628 my $date = $options{date} if $options{date}; # expire/cancel later
629 $date = '' if ($date && $date <= time); # complain instead?
631 #race condition: usage could be ongoing until unprovisioned
632 #resolved by performing a change package instead (which unprovisions) and
634 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
635 my $copy = $self->new({$self->hash});
637 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
638 warn "Error billing during cancel, custnum ".
639 #$self->cust_main->custnum. ": $error"
645 my $cancel_time = $options{'time'} || time;
647 if ( $options{'reason'} ) {
648 $error = $self->insert_reason( 'reason' => $options{'reason'},
649 'action' => $date ? 'expire' : 'cancel',
650 'date' => $date ? $date : $cancel_time,
651 'reason_otaker' => $options{'reason_otaker'},
654 dbh->rollback if $oldAutoCommit;
655 return "Error inserting cust_pkg_reason: $error";
661 foreach my $cust_svc (
664 sort { $a->[1] <=> $b->[1] }
665 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
666 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
669 my $error = $cust_svc->cancel;
672 $dbh->rollback if $oldAutoCommit;
673 return "Error cancelling cust_svc: $error";
677 # Add a credit for remaining service
678 my $remaining_value = $self->calc_remain(time=>$cancel_time);
679 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
680 my $error = $self->cust_main->credit(
682 'Credit for unused time on '. $self->part_pkg->pkg,
683 'reason_type' => $conf->config('cancel_credit_type'),
686 $dbh->rollback if $oldAutoCommit;
687 return "Error crediting customer \$$remaining_value for unused time on".
688 $self->part_pkg->pkg. ": $error";
693 my %hash = $self->hash;
694 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
695 my $new = new FS::cust_pkg ( \%hash );
696 $error = $new->replace( $self, options => { $self->options } );
698 $dbh->rollback if $oldAutoCommit;
702 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
703 return '' if $date; #no errors
705 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
706 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
707 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
710 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
711 $error = $msg_template->send( 'cust_main' => $self->cust_main,
716 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
717 'to' => \@invoicing_list,
718 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
719 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
722 #should this do something on errors?
729 =item cancel_if_expired [ NOW_TIMESTAMP ]
731 Cancels this package if its expire date has been reached.
735 sub cancel_if_expired {
737 my $time = shift || time;
738 return '' unless $self->expire && $self->expire <= $time;
739 my $error = $self->cancel;
741 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
742 $self->custnum. ": $error";
749 Cancels any pending expiration (sets the expire field to null).
751 If there is an error, returns the error, otherwise returns false.
756 my( $self, %options ) = @_;
759 local $SIG{HUP} = 'IGNORE';
760 local $SIG{INT} = 'IGNORE';
761 local $SIG{QUIT} = 'IGNORE';
762 local $SIG{TERM} = 'IGNORE';
763 local $SIG{TSTP} = 'IGNORE';
764 local $SIG{PIPE} = 'IGNORE';
766 my $oldAutoCommit = $FS::UID::AutoCommit;
767 local $FS::UID::AutoCommit = 0;
770 my $old = $self->select_for_update;
772 my $pkgnum = $old->pkgnum;
773 if ( $old->get('cancel') || $self->get('cancel') ) {
774 dbh->rollback if $oldAutoCommit;
775 return "Can't unexpire cancelled package $pkgnum";
776 # or at least it's pointless
779 unless ( $old->get('expire') && $self->get('expire') ) {
780 dbh->rollback if $oldAutoCommit;
781 return ""; # no error
784 my %hash = $self->hash;
785 $hash{'expire'} = '';
786 my $new = new FS::cust_pkg ( \%hash );
787 $error = $new->replace( $self, options => { $self->options } );
789 $dbh->rollback if $oldAutoCommit;
793 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
799 =item suspend [ OPTION => VALUE ... ]
801 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
802 package, then suspends the package itself (sets the susp field to now).
804 Available options are:
808 =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.
810 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
814 If there is an error, returns the error, otherwise returns false.
819 my( $self, %options ) = @_;
822 local $SIG{HUP} = 'IGNORE';
823 local $SIG{INT} = 'IGNORE';
824 local $SIG{QUIT} = 'IGNORE';
825 local $SIG{TERM} = 'IGNORE';
826 local $SIG{TSTP} = 'IGNORE';
827 local $SIG{PIPE} = 'IGNORE';
829 my $oldAutoCommit = $FS::UID::AutoCommit;
830 local $FS::UID::AutoCommit = 0;
833 my $old = $self->select_for_update;
835 my $pkgnum = $old->pkgnum;
836 if ( $old->get('cancel') || $self->get('cancel') ) {
837 dbh->rollback if $oldAutoCommit;
838 return "Can't suspend cancelled package $pkgnum";
841 if ( $old->get('susp') || $self->get('susp') ) {
842 dbh->rollback if $oldAutoCommit;
843 return ""; # no error # complain on adjourn?
846 my $date = $options{date} if $options{date}; # adjourn/suspend later
847 $date = '' if ($date && $date <= time); # complain instead?
849 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
850 dbh->rollback if $oldAutoCommit;
851 return "Package $pkgnum expires before it would be suspended.";
854 my $suspend_time = $options{'time'} || time;
856 if ( $options{'reason'} ) {
857 $error = $self->insert_reason( 'reason' => $options{'reason'},
858 'action' => $date ? 'adjourn' : 'suspend',
859 'date' => $date ? $date : $suspend_time,
860 'reason_otaker' => $options{'reason_otaker'},
863 dbh->rollback if $oldAutoCommit;
864 return "Error inserting cust_pkg_reason: $error";
872 foreach my $cust_svc (
873 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
875 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
877 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
878 $dbh->rollback if $oldAutoCommit;
879 return "Illegal svcdb value in part_svc!";
882 require "FS/$svcdb.pm";
884 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
886 $error = $svc->suspend;
888 $dbh->rollback if $oldAutoCommit;
891 my( $label, $value ) = $cust_svc->label;
892 push @labels, "$label: $value";
896 my $conf = new FS::Conf;
897 if ( $conf->config('suspend_email_admin') ) {
899 my $error = send_email(
900 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
901 #invoice_from ??? well as good as any
902 'to' => $conf->config('suspend_email_admin'),
903 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
905 "This is an automatic message from your Freeside installation\n",
906 "informing you that the following customer package has been suspended:\n",
908 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
909 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
910 ( map { "Service : $_\n" } @labels ),
915 warn "WARNING: can't send suspension admin email (suspending anyway): ".
923 my %hash = $self->hash;
925 $hash{'adjourn'} = $date;
927 $hash{'susp'} = $suspend_time;
929 my $new = new FS::cust_pkg ( \%hash );
930 $error = $new->replace( $self, options => { $self->options } );
932 $dbh->rollback if $oldAutoCommit;
936 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
941 =item unsuspend [ OPTION => VALUE ... ]
943 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
944 package, then unsuspends the package itself (clears the susp field and the
945 adjourn field if it is in the past).
947 Available options are:
951 =item adjust_next_bill
953 Can be set true to adjust the next bill date forward by
954 the amount of time the account was inactive. This was set true by default
955 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
956 explicitly requested. Price plans for which this makes sense (anniversary-date
957 based than prorate or subscription) could have an option to enable this
962 If there is an error, returns the error, otherwise returns false.
967 my( $self, %opt ) = @_;
970 local $SIG{HUP} = 'IGNORE';
971 local $SIG{INT} = 'IGNORE';
972 local $SIG{QUIT} = 'IGNORE';
973 local $SIG{TERM} = 'IGNORE';
974 local $SIG{TSTP} = 'IGNORE';
975 local $SIG{PIPE} = 'IGNORE';
977 my $oldAutoCommit = $FS::UID::AutoCommit;
978 local $FS::UID::AutoCommit = 0;
981 my $old = $self->select_for_update;
983 my $pkgnum = $old->pkgnum;
984 if ( $old->get('cancel') || $self->get('cancel') ) {
985 dbh->rollback if $oldAutoCommit;
986 return "Can't unsuspend cancelled package $pkgnum";
989 unless ( $old->get('susp') && $self->get('susp') ) {
990 dbh->rollback if $oldAutoCommit;
991 return ""; # no error # complain instead?
994 foreach my $cust_svc (
995 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
997 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
999 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1000 $dbh->rollback if $oldAutoCommit;
1001 return "Illegal svcdb value in part_svc!";
1004 require "FS/$svcdb.pm";
1006 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1008 $error = $svc->unsuspend;
1010 $dbh->rollback if $oldAutoCommit;
1017 my %hash = $self->hash;
1018 my $inactive = time - $hash{'susp'};
1020 my $conf = new FS::Conf;
1022 if ( $inactive > 0 &&
1023 ( $hash{'bill'} || $hash{'setup'} ) &&
1024 ( $opt{'adjust_next_bill'} ||
1025 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1026 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1029 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1034 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1035 my $new = new FS::cust_pkg ( \%hash );
1036 $error = $new->replace( $self, options => { $self->options } );
1038 $dbh->rollback if $oldAutoCommit;
1042 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1049 Cancels any pending suspension (sets the adjourn field to null).
1051 If there is an error, returns the error, otherwise returns false.
1056 my( $self, %options ) = @_;
1059 local $SIG{HUP} = 'IGNORE';
1060 local $SIG{INT} = 'IGNORE';
1061 local $SIG{QUIT} = 'IGNORE';
1062 local $SIG{TERM} = 'IGNORE';
1063 local $SIG{TSTP} = 'IGNORE';
1064 local $SIG{PIPE} = 'IGNORE';
1066 my $oldAutoCommit = $FS::UID::AutoCommit;
1067 local $FS::UID::AutoCommit = 0;
1070 my $old = $self->select_for_update;
1072 my $pkgnum = $old->pkgnum;
1073 if ( $old->get('cancel') || $self->get('cancel') ) {
1074 dbh->rollback if $oldAutoCommit;
1075 return "Can't unadjourn cancelled package $pkgnum";
1076 # or at least it's pointless
1079 if ( $old->get('susp') || $self->get('susp') ) {
1080 dbh->rollback if $oldAutoCommit;
1081 return "Can't unadjourn suspended package $pkgnum";
1082 # perhaps this is arbitrary
1085 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1086 dbh->rollback if $oldAutoCommit;
1087 return ""; # no error
1090 my %hash = $self->hash;
1091 $hash{'adjourn'} = '';
1092 my $new = new FS::cust_pkg ( \%hash );
1093 $error = $new->replace( $self, options => { $self->options } );
1095 $dbh->rollback if $oldAutoCommit;
1099 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1106 =item change HASHREF | OPTION => VALUE ...
1108 Changes this package: cancels it and creates a new one, with a different
1109 pkgpart or locationnum or both. All services are transferred to the new
1110 package (no change will be made if this is not possible).
1112 Options may be passed as a list of key/value pairs or as a hash reference.
1119 New locationnum, to change the location for this package.
1123 New FS::cust_location object, to create a new location and assign it
1128 New pkgpart (see L<FS::part_pkg>).
1132 New refnum (see L<FS::part_referral>).
1136 At least one option must be specified (otherwise, what's the point?)
1138 Returns either the new FS::cust_pkg object or a scalar error.
1142 my $err_or_new_cust_pkg = $old_cust_pkg->change
1146 #some false laziness w/order
1149 my $opt = ref($_[0]) ? shift : { @_ };
1151 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1154 my $conf = new FS::Conf;
1156 # Transactionize this whole mess
1157 local $SIG{HUP} = 'IGNORE';
1158 local $SIG{INT} = 'IGNORE';
1159 local $SIG{QUIT} = 'IGNORE';
1160 local $SIG{TERM} = 'IGNORE';
1161 local $SIG{TSTP} = 'IGNORE';
1162 local $SIG{PIPE} = 'IGNORE';
1164 my $oldAutoCommit = $FS::UID::AutoCommit;
1165 local $FS::UID::AutoCommit = 0;
1174 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1176 #$hash{$_} = $self->$_() foreach qw( setup );
1178 $hash{'setup'} = $time if $self->setup;
1180 $hash{'change_date'} = $time;
1181 $hash{"change_$_"} = $self->$_()
1182 foreach qw( pkgnum pkgpart locationnum );
1184 if ( $opt->{'cust_location'} &&
1185 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1186 $error = $opt->{'cust_location'}->insert;
1188 $dbh->rollback if $oldAutoCommit;
1189 return "inserting cust_location (transaction rolled back): $error";
1191 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1194 # Create the new package.
1195 my $cust_pkg = new FS::cust_pkg {
1196 custnum => $self->custnum,
1197 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1198 refnum => ( $opt->{'refnum'} || $self->refnum ),
1199 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1203 $error = $cust_pkg->insert( 'change' => 1 );
1205 $dbh->rollback if $oldAutoCommit;
1209 # Transfer services and cancel old package.
1211 $error = $self->transfer($cust_pkg);
1212 if ($error and $error == 0) {
1213 # $old_pkg->transfer failed.
1214 $dbh->rollback if $oldAutoCommit;
1218 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1219 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1220 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1221 if ($error and $error == 0) {
1222 # $old_pkg->transfer failed.
1223 $dbh->rollback if $oldAutoCommit;
1229 # Transfers were successful, but we still had services left on the old
1230 # package. We can't change the package under this circumstances, so abort.
1231 $dbh->rollback if $oldAutoCommit;
1232 return "Unable to transfer all services from package ". $self->pkgnum;
1235 #reset usage if changing pkgpart
1236 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1237 if ($self->pkgpart != $cust_pkg->pkgpart) {
1238 my $part_pkg = $cust_pkg->part_pkg;
1239 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1243 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1246 $dbh->rollback if $oldAutoCommit;
1247 return "Error setting usage values: $error";
1251 #Good to go, cancel old package.
1252 $error = $self->cancel( quiet=>1 );
1254 $dbh->rollback if $oldAutoCommit;
1258 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1260 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1262 $dbh->rollback if $oldAutoCommit;
1267 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1275 Returns the last bill date, or if there is no last bill date, the setup date.
1276 Useful for billing metered services.
1282 return $self->setfield('last_bill', $_[0]) if @_;
1283 return $self->getfield('last_bill') if $self->getfield('last_bill');
1284 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1285 'edate' => $self->bill, } );
1286 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1289 =item last_cust_pkg_reason ACTION
1291 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1292 Returns false if there is no reason or the package is not currenly ACTION'd
1293 ACTION is one of adjourn, susp, cancel, or expire.
1297 sub last_cust_pkg_reason {
1298 my ( $self, $action ) = ( shift, shift );
1299 my $date = $self->get($action);
1301 'table' => 'cust_pkg_reason',
1302 'hashref' => { 'pkgnum' => $self->pkgnum,
1303 'action' => substr(uc($action), 0, 1),
1306 'order_by' => 'ORDER BY num DESC LIMIT 1',
1310 =item last_reason ACTION
1312 Returns the most recent ACTION FS::reason associated with the package.
1313 Returns false if there is no reason or the package is not currenly ACTION'd
1314 ACTION is one of adjourn, susp, cancel, or expire.
1319 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1320 $cust_pkg_reason->reason
1321 if $cust_pkg_reason;
1326 Returns the definition for this billing item, as an FS::part_pkg object (see
1333 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1334 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1335 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1340 Returns the cancelled package this package was changed from, if any.
1346 return '' unless $self->change_pkgnum;
1347 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1352 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1359 $self->part_pkg->calc_setup($self, @_);
1364 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1371 $self->part_pkg->calc_recur($self, @_);
1376 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1383 $self->part_pkg->base_recur($self, @_);
1388 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1395 $self->part_pkg->calc_remain($self, @_);
1400 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1407 $self->part_pkg->calc_cancel($self, @_);
1412 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1418 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1421 =item cust_pkg_detail [ DETAILTYPE ]
1423 Returns any customer package details for this package (see
1424 L<FS::cust_pkg_detail>).
1426 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1430 sub cust_pkg_detail {
1432 my %hash = ( 'pkgnum' => $self->pkgnum );
1433 $hash{detailtype} = shift if @_;
1435 'table' => 'cust_pkg_detail',
1436 'hashref' => \%hash,
1437 'order_by' => 'ORDER BY weight, pkgdetailnum',
1441 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1443 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1445 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1447 If there is an error, returns the error, otherwise returns false.
1451 sub set_cust_pkg_detail {
1452 my( $self, $detailtype, @details ) = @_;
1454 local $SIG{HUP} = 'IGNORE';
1455 local $SIG{INT} = 'IGNORE';
1456 local $SIG{QUIT} = 'IGNORE';
1457 local $SIG{TERM} = 'IGNORE';
1458 local $SIG{TSTP} = 'IGNORE';
1459 local $SIG{PIPE} = 'IGNORE';
1461 my $oldAutoCommit = $FS::UID::AutoCommit;
1462 local $FS::UID::AutoCommit = 0;
1465 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1466 my $error = $current->delete;
1468 $dbh->rollback if $oldAutoCommit;
1469 return "error removing old detail: $error";
1473 foreach my $detail ( @details ) {
1474 my $cust_pkg_detail = new FS::cust_pkg_detail {
1475 'pkgnum' => $self->pkgnum,
1476 'detailtype' => $detailtype,
1477 'detail' => $detail,
1479 my $error = $cust_pkg_detail->insert;
1481 $dbh->rollback if $oldAutoCommit;
1482 return "error adding new detail: $error";
1487 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1494 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1498 #false laziness w/cust_bill.pm
1502 'table' => 'cust_event',
1503 'addl_from' => 'JOIN part_event USING ( eventpart )',
1504 'hashref' => { 'tablenum' => $self->pkgnum },
1505 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1509 =item num_cust_event
1511 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1515 #false laziness w/cust_bill.pm
1516 sub num_cust_event {
1519 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1520 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1521 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1522 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1523 $sth->fetchrow_arrayref->[0];
1526 =item cust_svc [ SVCPART ]
1528 Returns the services for this package, as FS::cust_svc objects (see
1529 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1537 return () unless $self->num_cust_svc(@_);
1540 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1541 'svcpart' => shift, } );
1544 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1546 #if ( $self->{'_svcnum'} ) {
1547 # values %{ $self->{'_svcnum'}->cache };
1549 $self->_sort_cust_svc(
1550 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1556 =item overlimit [ SVCPART ]
1558 Returns the services for this package which have exceeded their
1559 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1560 is specified, return only the matching services.
1566 return () unless $self->num_cust_svc(@_);
1567 grep { $_->overlimit } $self->cust_svc(@_);
1570 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1572 Returns historical services for this package created before END TIMESTAMP and
1573 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1574 (see L<FS::h_cust_svc>).
1581 $self->_sort_cust_svc(
1582 [ qsearch( 'h_cust_svc',
1583 { 'pkgnum' => $self->pkgnum, },
1584 FS::h_cust_svc->sql_h_search(@_),
1590 sub _sort_cust_svc {
1591 my( $self, $arrayref ) = @_;
1594 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1599 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1600 'svcpart' => $_->svcpart } );
1602 $pkg_svc ? $pkg_svc->primary_svc : '',
1603 $pkg_svc ? $pkg_svc->quantity : 0,
1610 =item num_cust_svc [ SVCPART ]
1612 Returns the number of provisioned services for this package. If a svcpart is
1613 specified, counts only the matching services.
1620 return $self->{'_num_cust_svc'}
1622 && exists($self->{'_num_cust_svc'})
1623 && $self->{'_num_cust_svc'} =~ /\d/;
1625 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1628 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1629 $sql .= ' AND svcpart = ?' if @_;
1631 my $sth = dbh->prepare($sql) or die dbh->errstr;
1632 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1633 $sth->fetchrow_arrayref->[0];
1636 =item available_part_svc
1638 Returns a list of FS::part_svc objects representing services included in this
1639 package but not yet provisioned. Each FS::part_svc object also has an extra
1640 field, I<num_avail>, which specifies the number of available services.
1644 sub available_part_svc {
1646 grep { $_->num_avail > 0 }
1648 my $part_svc = $_->part_svc;
1649 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1650 $_->quantity - $self->num_cust_svc($_->svcpart);
1653 $self->part_pkg->pkg_svc;
1658 Returns a list of FS::part_svc objects representing provisioned and available
1659 services included in this package. Each FS::part_svc object also has the
1660 following extra fields:
1664 =item num_cust_svc (count)
1666 =item num_avail (quantity - count)
1668 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1671 label -> ($cust_svc->label)[1]
1680 #XXX some sort of sort order besides numeric by svcpart...
1681 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1683 my $part_svc = $pkg_svc->part_svc;
1684 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1685 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1686 $part_svc->{'Hash'}{'num_avail'} =
1687 max( 0, $pkg_svc->quantity - $num_cust_svc );
1688 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1689 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1691 } $self->part_pkg->pkg_svc;
1694 push @part_svc, map {
1696 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1697 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1698 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1699 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1700 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1702 } $self->extra_part_svc;
1708 =item extra_part_svc
1710 Returns a list of FS::part_svc objects corresponding to services in this
1711 package which are still provisioned but not (any longer) available in the
1716 sub extra_part_svc {
1719 my $pkgnum = $self->pkgnum;
1720 my $pkgpart = $self->pkgpart;
1723 # 'table' => 'part_svc',
1726 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1727 # WHERE pkg_svc.svcpart = part_svc.svcpart
1728 # AND pkg_svc.pkgpart = ?
1731 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1732 # LEFT JOIN cust_pkg USING ( pkgnum )
1733 # WHERE cust_svc.svcpart = part_svc.svcpart
1736 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1739 #seems to benchmark slightly faster...
1741 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1742 #MySQL doesn't grok DISINCT ON
1743 'select' => 'DISTINCT part_svc.*',
1744 'table' => 'part_svc',
1746 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1747 AND pkg_svc.pkgpart = ?
1750 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1751 LEFT JOIN cust_pkg USING ( pkgnum )
1754 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1755 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1761 Returns a short status string for this package, currently:
1765 =item not yet billed
1767 =item one-time charge
1782 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1784 return 'cancelled' if $self->get('cancel');
1785 return 'suspended' if $self->susp;
1786 return 'not yet billed' unless $self->setup;
1787 return 'one-time charge' if $freq =~ /^(0|$)/;
1791 =item ucfirst_status
1793 Returns the status with the first character capitalized.
1797 sub ucfirst_status {
1798 ucfirst(shift->status);
1803 Class method that returns the list of possible status strings for packages
1804 (see L<the status method|/status>). For example:
1806 @statuses = FS::cust_pkg->statuses();
1810 tie my %statuscolor, 'Tie::IxHash',
1811 'not yet billed' => '000000',
1812 'one-time charge' => '000000',
1813 'active' => '00CC00',
1814 'suspended' => 'FF9900',
1815 'cancelled' => 'FF0000',
1819 my $self = shift; #could be class...
1820 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1821 # # mayble split btw one-time vs. recur
1827 Returns a hex triplet color string for this package's status.
1833 $statuscolor{$self->status};
1838 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1839 "pkg-comment" depending on user preference).
1845 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1846 $label = $self->pkgnum. ": $label"
1847 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1851 =item pkg_label_long
1853 Returns a long label for this package, adding the primary service's label to
1858 sub pkg_label_long {
1860 my $label = $self->pkg_label;
1861 my $cust_svc = $self->primary_cust_svc;
1862 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1866 =item primary_cust_svc
1868 Returns a primary service (as FS::cust_svc object) if one can be identified.
1872 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1874 sub primary_cust_svc {
1877 my @cust_svc = $self->cust_svc;
1879 return '' unless @cust_svc; #no serivces - irrelevant then
1881 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1883 # primary service as specified in the package definition
1884 # or exactly one service definition with quantity one
1885 my $svcpart = $self->part_pkg->svcpart;
1886 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1887 return $cust_svc[0] if scalar(@cust_svc) == 1;
1889 #couldn't identify one thing..
1895 Returns a list of lists, calling the label method for all services
1896 (see L<FS::cust_svc>) of this billing item.
1902 map { [ $_->label ] } $self->cust_svc;
1905 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1907 Like the labels method, but returns historical information on services that
1908 were active as of END_TIMESTAMP and (optionally) not cancelled before
1911 Returns a list of lists, calling the label method for all (historical) services
1912 (see L<FS::h_cust_svc>) of this billing item.
1918 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1923 Like labels, except returns a simple flat list, and shortens long
1924 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1925 identical services to one line that lists the service label and the number of
1926 individual services rather than individual items.
1931 shift->_labels_short( 'labels', @_ );
1934 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1936 Like h_labels, except returns a simple flat list, and shortens long
1937 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1938 identical services to one line that lists the service label and the number of
1939 individual services rather than individual items.
1943 sub h_labels_short {
1944 shift->_labels_short( 'h_labels', @_ );
1948 my( $self, $method ) = ( shift, shift );
1950 my $conf = new FS::Conf;
1951 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1954 #tie %labels, 'Tie::IxHash';
1955 push @{ $labels{$_->[0]} }, $_->[1]
1956 foreach $self->$method(@_);
1958 foreach my $label ( keys %labels ) {
1960 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1961 my $num = scalar(@values);
1962 if ( $num > $max_same_services ) {
1963 push @labels, "$label ($num)";
1965 if ( $conf->exists('cust_bill-consolidate_services') ) {
1966 # push @labels, "$label: ". join(', ', @values);
1968 my $detail = "$label: ";
1969 $detail .= shift(@values). ', '
1970 while @values && length($detail.$values[0]) < 78;
1972 push @labels, $detail;
1975 push @labels, map { "$label: $_" } @values;
1986 Returns the parent customer object (see L<FS::cust_main>).
1992 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1995 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
1999 Returns the location object, if any (see L<FS::cust_location>).
2001 =item cust_location_or_main
2003 If this package is associated with a location, returns the locaiton (see
2004 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2006 =item location_label [ OPTION => VALUE ... ]
2008 Returns the label of the location object (see L<FS::cust_location>).
2012 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2014 =item seconds_since TIMESTAMP
2016 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2017 package have been online since TIMESTAMP, according to the session monitor.
2019 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2020 L<Time::Local> and L<Date::Parse> for conversion functions.
2025 my($self, $since) = @_;
2028 foreach my $cust_svc (
2029 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2031 $seconds += $cust_svc->seconds_since($since);
2038 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2040 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2041 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2044 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2045 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2051 sub seconds_since_sqlradacct {
2052 my($self, $start, $end) = @_;
2056 foreach my $cust_svc (
2058 my $part_svc = $_->part_svc;
2059 $part_svc->svcdb eq 'svc_acct'
2060 && scalar($part_svc->part_export('sqlradius'));
2063 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2070 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2072 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2073 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2077 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2078 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2083 sub attribute_since_sqlradacct {
2084 my($self, $start, $end, $attrib) = @_;
2088 foreach my $cust_svc (
2090 my $part_svc = $_->part_svc;
2091 $part_svc->svcdb eq 'svc_acct'
2092 && scalar($part_svc->part_export('sqlradius'));
2095 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2107 my( $self, $value ) = @_;
2108 if ( defined($value) ) {
2109 $self->setfield('quantity', $value);
2111 $self->getfield('quantity') || 1;
2114 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2116 Transfers as many services as possible from this package to another package.
2118 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2119 object. The destination package must already exist.
2121 Services are moved only if the destination allows services with the correct
2122 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2123 this option with caution! No provision is made for export differences
2124 between the old and new service definitions. Probably only should be used
2125 when your exports for all service definitions of a given svcdb are identical.
2126 (attempt a transfer without it first, to move all possible svcpart-matching
2129 Any services that can't be moved remain in the original package.
2131 Returns an error, if there is one; otherwise, returns the number of services
2132 that couldn't be moved.
2137 my ($self, $dest_pkgnum, %opt) = @_;
2143 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2144 $dest = $dest_pkgnum;
2145 $dest_pkgnum = $dest->pkgnum;
2147 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2150 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2152 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2153 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2156 foreach my $cust_svc ($dest->cust_svc) {
2157 $target{$cust_svc->svcpart}--;
2160 my %svcpart2svcparts = ();
2161 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2162 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2163 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2164 next if exists $svcpart2svcparts{$svcpart};
2165 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2166 $svcpart2svcparts{$svcpart} = [
2168 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2170 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2171 'svcpart' => $_ } );
2173 $pkg_svc ? $pkg_svc->primary_svc : '',
2174 $pkg_svc ? $pkg_svc->quantity : 0,
2178 grep { $_ != $svcpart }
2180 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2182 warn "alternates for svcpart $svcpart: ".
2183 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2188 foreach my $cust_svc ($self->cust_svc) {
2189 if($target{$cust_svc->svcpart} > 0) {
2190 $target{$cust_svc->svcpart}--;
2191 my $new = new FS::cust_svc { $cust_svc->hash };
2192 $new->pkgnum($dest_pkgnum);
2193 my $error = $new->replace($cust_svc);
2194 return $error if $error;
2195 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2197 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2198 warn "alternates to consider: ".
2199 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2201 my @alternate = grep {
2202 warn "considering alternate svcpart $_: ".
2203 "$target{$_} available in new package\n"
2206 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2208 warn "alternate(s) found\n" if $DEBUG;
2209 my $change_svcpart = $alternate[0];
2210 $target{$change_svcpart}--;
2211 my $new = new FS::cust_svc { $cust_svc->hash };
2212 $new->svcpart($change_svcpart);
2213 $new->pkgnum($dest_pkgnum);
2214 my $error = $new->replace($cust_svc);
2215 return $error if $error;
2228 This method is deprecated. See the I<depend_jobnum> option to the insert and
2229 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2236 local $SIG{HUP} = 'IGNORE';
2237 local $SIG{INT} = 'IGNORE';
2238 local $SIG{QUIT} = 'IGNORE';
2239 local $SIG{TERM} = 'IGNORE';
2240 local $SIG{TSTP} = 'IGNORE';
2241 local $SIG{PIPE} = 'IGNORE';
2243 my $oldAutoCommit = $FS::UID::AutoCommit;
2244 local $FS::UID::AutoCommit = 0;
2247 foreach my $cust_svc ( $self->cust_svc ) {
2248 #false laziness w/svc_Common::insert
2249 my $svc_x = $cust_svc->svc_x;
2250 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2251 my $error = $part_export->export_insert($svc_x);
2253 $dbh->rollback if $oldAutoCommit;
2259 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2266 Associates this package with a (suspension or cancellation) reason (see
2267 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2270 Available options are:
2276 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.
2280 the access_user (see L<FS::access_user>) providing the reason
2288 the action (cancel, susp, adjourn, expire) associated with the reason
2292 If there is an error, returns the error, otherwise returns false.
2297 my ($self, %options) = @_;
2299 my $otaker = $options{reason_otaker} ||
2300 $FS::CurrentUser::CurrentUser->username;
2303 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2307 } elsif ( ref($options{'reason'}) ) {
2309 return 'Enter a new reason (or select an existing one)'
2310 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2312 my $reason = new FS::reason({
2313 'reason_type' => $options{'reason'}->{'typenum'},
2314 'reason' => $options{'reason'}->{'reason'},
2316 my $error = $reason->insert;
2317 return $error if $error;
2319 $reasonnum = $reason->reasonnum;
2322 return "Unparsable reason: ". $options{'reason'};
2325 my $cust_pkg_reason =
2326 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2327 'reasonnum' => $reasonnum,
2328 'otaker' => $otaker,
2329 'action' => substr(uc($options{'action'}),0,1),
2330 'date' => $options{'date'}
2335 $cust_pkg_reason->insert;
2338 =item insert_discount
2340 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2341 inserting a new discount on the fly (see L<FS::discount>).
2343 Available options are:
2351 If there is an error, returns the error, otherwise returns false.
2355 sub insert_discount {
2356 #my ($self, %options) = @_;
2359 my $cust_pkg_discount = new FS::cust_pkg_discount {
2360 'pkgnum' => $self->pkgnum,
2361 'discountnum' => $self->discountnum,
2363 'end_date' => '', #XXX
2364 'otaker' => $self->otaker,
2365 #for the create a new discount case
2366 '_type' => $self->discountnum__type,
2367 'amount' => $self->discountnum_amount,
2368 'percent' => $self->discountnum_percent,
2369 'months' => $self->discountnum_months,
2370 #'disabled' => $self->discountnum_disabled,
2373 $cust_pkg_discount->insert;
2376 =item set_usage USAGE_VALUE_HASHREF
2378 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2379 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2380 upbytes, downbytes, and totalbytes are appropriate keys.
2382 All svc_accts which are part of this package have their values reset.
2387 my ($self, $valueref, %opt) = @_;
2389 foreach my $cust_svc ($self->cust_svc){
2390 my $svc_x = $cust_svc->svc_x;
2391 $svc_x->set_usage($valueref, %opt)
2392 if $svc_x->can("set_usage");
2396 =item recharge USAGE_VALUE_HASHREF
2398 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2399 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2400 upbytes, downbytes, and totalbytes are appropriate keys.
2402 All svc_accts which are part of this package have their values incremented.
2407 my ($self, $valueref) = @_;
2409 foreach my $cust_svc ($self->cust_svc){
2410 my $svc_x = $cust_svc->svc_x;
2411 $svc_x->recharge($valueref)
2412 if $svc_x->can("recharge");
2416 =item cust_pkg_discount
2420 sub cust_pkg_discount {
2422 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2425 =item cust_pkg_discount_active
2429 sub cust_pkg_discount_active {
2431 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2436 =head1 CLASS METHODS
2442 Returns an SQL expression identifying recurring packages.
2446 sub recurring_sql { "
2447 '0' != ( select freq from part_pkg
2448 where cust_pkg.pkgpart = part_pkg.pkgpart )
2453 Returns an SQL expression identifying one-time packages.
2458 '0' = ( select freq from part_pkg
2459 where cust_pkg.pkgpart = part_pkg.pkgpart )
2464 Returns an SQL expression identifying ordered packages (recurring packages not
2470 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2475 Returns an SQL expression identifying active packages.
2480 $_[0]->recurring_sql. "
2481 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2482 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2483 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2486 =item not_yet_billed_sql
2488 Returns an SQL expression identifying packages which have not yet been billed.
2492 sub not_yet_billed_sql { "
2493 ( cust_pkg.setup IS NULL OR 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 )
2500 Returns an SQL expression identifying inactive packages (one-time packages
2501 that are otherwise unsuspended/uncancelled).
2505 sub inactive_sql { "
2506 ". $_[0]->onetime_sql(). "
2507 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2508 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2509 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2515 Returns an SQL expression identifying suspended packages.
2519 sub suspended_sql { susp_sql(@_); }
2521 #$_[0]->recurring_sql(). ' AND '.
2523 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2524 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2531 Returns an SQL exprression identifying cancelled packages.
2535 sub cancelled_sql { cancel_sql(@_); }
2537 #$_[0]->recurring_sql(). ' AND '.
2538 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2541 =item search HASHREF
2545 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2546 Valid parameters are
2554 active, inactive, suspended, cancel (or cancelled)
2558 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2562 boolean selects custom packages
2568 pkgpart or arrayref or hashref of pkgparts
2572 arrayref of beginning and ending epoch date
2576 arrayref of beginning and ending epoch date
2580 arrayref of beginning and ending epoch date
2584 arrayref of beginning and ending epoch date
2588 arrayref of beginning and ending epoch date
2592 arrayref of beginning and ending epoch date
2596 arrayref of beginning and ending epoch date
2600 pkgnum or APKG_pkgnum
2604 a value suited to passing to FS::UI::Web::cust_header
2608 specifies the user for agent virtualization
2612 boolean selects packages containing fcc form 477 telco lines
2619 my ($class, $params) = @_;
2626 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2628 "cust_main.agentnum = $1";
2635 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2637 "cust_pkg.custnum = $1";
2644 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2646 "cust_pkg.pkgbatch = '$1'";
2653 if ( $params->{'magic'} eq 'active'
2654 || $params->{'status'} eq 'active' ) {
2656 push @where, FS::cust_pkg->active_sql();
2658 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2659 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2661 push @where, FS::cust_pkg->not_yet_billed_sql();
2663 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2664 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2666 push @where, FS::cust_pkg->inactive_sql();
2668 } elsif ( $params->{'magic'} eq 'suspended'
2669 || $params->{'status'} eq 'suspended' ) {
2671 push @where, FS::cust_pkg->suspended_sql();
2673 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2674 || $params->{'status'} =~ /^cancell?ed$/ ) {
2676 push @where, FS::cust_pkg->cancelled_sql();
2681 # parse package class
2684 #false lazinessish w/graph/cust_bill_pkg.cgi
2687 if ( exists($params->{'classnum'})
2688 && $params->{'classnum'} =~ /^(\d*)$/
2692 if ( $classnum ) { #a specific class
2693 push @where, "part_pkg.classnum = $classnum";
2695 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2696 #die "classnum $classnum not found!" unless $pkg_class[0];
2697 #$title .= $pkg_class[0]->classname.' ';
2699 } elsif ( $classnum eq '' ) { #the empty class
2701 push @where, "part_pkg.classnum IS NULL";
2702 #$title .= 'Empty class ';
2703 #@pkg_class = ( '(empty class)' );
2704 } elsif ( $classnum eq '0' ) {
2705 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2706 #push @pkg_class, '(empty class)';
2708 die "illegal classnum";
2714 # parse package report options
2717 my @report_option = ();
2718 if ( exists($params->{'report_option'})
2719 && $params->{'report_option'} =~ /^([,\d]*)$/
2722 @report_option = split(',', $1);
2725 if (@report_option) {
2726 # this will result in the empty set for the dangling comma case as it should
2728 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2729 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2730 AND optionname = 'report_option_$_'
2731 AND optionvalue = '1' )"
2741 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2747 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2753 if ( exists($params->{'censustract'}) ) {
2754 $params->{'censustract'} =~ /^([.\d]*)$/;
2755 my $censustract = "cust_main.censustract = '$1'";
2756 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2757 push @where, "( $censustract )";
2764 if ( ref($params->{'pkgpart'}) ) {
2767 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2768 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2769 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2770 @pkgpart = @{ $params->{'pkgpart'} };
2772 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2775 @pkgpart = grep /^(\d+)$/, @pkgpart;
2777 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2779 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2780 push @where, "pkgpart = $1";
2789 #false laziness w/report_cust_pkg.html
2792 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2793 'active' => { 'susp'=>1, 'cancel'=>1 },
2794 'suspended' => { 'cancel' => 1 },
2799 if( exists($params->{'active'} ) ) {
2800 # This overrides all the other date-related fields
2801 my($beginning, $ending) = @{$params->{'active'}};
2803 "cust_pkg.setup IS NOT NULL",
2804 "cust_pkg.setup <= $ending",
2805 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2806 "NOT (".FS::cust_pkg->onetime_sql . ")";
2809 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2811 next unless exists($params->{$field});
2813 my($beginning, $ending) = @{$params->{$field}};
2815 next if $beginning == 0 && $ending == 4294967295;
2818 "cust_pkg.$field IS NOT NULL",
2819 "cust_pkg.$field >= $beginning",
2820 "cust_pkg.$field <= $ending";
2822 $orderby ||= "ORDER BY cust_pkg.$field";
2827 $orderby ||= 'ORDER BY bill';
2830 # parse magic, legacy, etc.
2833 if ( $params->{'magic'} &&
2834 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2837 $orderby = 'ORDER BY pkgnum';
2839 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2840 push @where, "pkgpart = $1";
2843 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2845 $orderby = 'ORDER BY pkgnum';
2847 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2849 $orderby = 'ORDER BY pkgnum';
2852 SELECT count(*) FROM pkg_svc
2853 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2854 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2855 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2856 AND cust_svc.svcpart = pkg_svc.svcpart
2863 # setup queries, links, subs, etc. for the search
2866 # here is the agent virtualization
2867 if ($params->{CurrentUser}) {
2869 qsearchs('access_user', { username => $params->{CurrentUser} });
2872 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2877 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2880 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2882 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2883 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2884 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2886 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2889 'table' => 'cust_pkg',
2891 'select' => join(', ',
2893 ( map "part_pkg.$_", qw( pkg freq ) ),
2894 'pkg_class.classname',
2895 'cust_main.custnum AS cust_main_custnum',
2896 FS::UI::Web::cust_sql_fields(
2897 $params->{'cust_fields'}
2900 'extra_sql' => "$extra_sql $orderby",
2901 'addl_from' => $addl_from,
2902 'count_query' => $count_query,
2909 Returns a list of two package counts. The first is a count of packages
2910 based on the supplied criteria and the second is the count of residential
2911 packages with those same criteria. Criteria are specified as in the search
2917 my ($class, $params) = @_;
2919 my $sql_query = $class->search( $params );
2921 my $count_sql = delete($sql_query->{'count_query'});
2922 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
2923 or die "couldn't parse count_sql";
2925 my $count_sth = dbh->prepare($count_sql)
2926 or die "Error preparing $count_sql: ". dbh->errstr;
2928 or die "Error executing $count_sql: ". $count_sth->errstr;
2929 my $count_arrayref = $count_sth->fetchrow_arrayref;
2931 return ( @$count_arrayref );
2938 Returns a list: the first item is an SQL fragment identifying matching
2939 packages/customers via location (taking into account shipping and package
2940 address taxation, if enabled), and subsequent items are the parameters to
2941 substitute for the placeholders in that fragment.
2946 my($class, %opt) = @_;
2947 my $ornull = $opt{'ornull'};
2949 my $conf = new FS::Conf;
2951 # '?' placeholders in _location_sql_where
2952 my $x = $ornull ? 3 : 2;
2953 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
2957 if ( $conf->exists('tax-ship_address') ) {
2960 ( ( ship_last IS NULL OR ship_last = '' )
2961 AND ". _location_sql_where('cust_main', '', $ornull ). "
2963 OR ( ship_last IS NOT NULL AND ship_last != ''
2964 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2967 # AND payby != 'COMP'
2969 @main_param = ( @bill_param, @bill_param );
2973 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2974 @main_param = @bill_param;
2980 if ( $conf->exists('tax-pkg_address') ) {
2982 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2985 ( cust_pkg.locationnum IS NULL AND $main_where )
2986 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2989 @param = ( @main_param, @bill_param );
2993 $where = $main_where;
2994 @param = @main_param;
3002 #subroutine, helper for location_sql
3003 sub _location_sql_where {
3005 my $prefix = @_ ? shift : '';
3006 my $ornull = @_ ? shift : '';
3008 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3010 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3012 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3013 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3014 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3016 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3018 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3019 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3020 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3021 AND $table.${prefix}country = ?
3029 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3031 CUSTNUM is a customer (see L<FS::cust_main>)
3033 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3034 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3037 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3038 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3039 new billing items. An error is returned if this is not possible (see
3040 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3043 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3044 newly-created cust_pkg objects.
3046 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3047 and inserted. Multiple FS::pkg_referral records can be created by
3048 setting I<refnum> to an array reference of refnums or a hash reference with
3049 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3050 record will be created corresponding to cust_main.refnum.
3055 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3057 my $conf = new FS::Conf;
3059 # Transactionize this whole mess
3060 local $SIG{HUP} = 'IGNORE';
3061 local $SIG{INT} = 'IGNORE';
3062 local $SIG{QUIT} = 'IGNORE';
3063 local $SIG{TERM} = 'IGNORE';
3064 local $SIG{TSTP} = 'IGNORE';
3065 local $SIG{PIPE} = 'IGNORE';
3067 my $oldAutoCommit = $FS::UID::AutoCommit;
3068 local $FS::UID::AutoCommit = 0;
3072 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3073 # return "Customer not found: $custnum" unless $cust_main;
3075 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3078 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3081 my $change = scalar(@old_cust_pkg) != 0;
3084 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3086 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3087 " to pkgpart ". $pkgparts->[0]. "\n"
3090 my $err_or_cust_pkg =
3091 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3092 'refnum' => $refnum,
3095 unless (ref($err_or_cust_pkg)) {
3096 $dbh->rollback if $oldAutoCommit;
3097 return $err_or_cust_pkg;
3100 push @$return_cust_pkg, $err_or_cust_pkg;
3101 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3106 # Create the new packages.
3107 foreach my $pkgpart (@$pkgparts) {
3109 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3111 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3112 pkgpart => $pkgpart,
3116 $error = $cust_pkg->insert( 'change' => $change );
3118 $dbh->rollback if $oldAutoCommit;
3121 push @$return_cust_pkg, $cust_pkg;
3123 # $return_cust_pkg now contains refs to all of the newly
3126 # Transfer services and cancel old packages.
3127 foreach my $old_pkg (@old_cust_pkg) {
3129 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3132 foreach my $new_pkg (@$return_cust_pkg) {
3133 $error = $old_pkg->transfer($new_pkg);
3134 if ($error and $error == 0) {
3135 # $old_pkg->transfer failed.
3136 $dbh->rollback if $oldAutoCommit;
3141 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3142 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3143 foreach my $new_pkg (@$return_cust_pkg) {
3144 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3145 if ($error and $error == 0) {
3146 # $old_pkg->transfer failed.
3147 $dbh->rollback if $oldAutoCommit;
3154 # Transfers were successful, but we went through all of the
3155 # new packages and still had services left on the old package.
3156 # We can't cancel the package under the circumstances, so abort.
3157 $dbh->rollback if $oldAutoCommit;
3158 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3160 $error = $old_pkg->cancel( quiet=>1 );
3166 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3170 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3172 A bulk change method to change packages for multiple customers.
3174 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3175 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3178 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3179 replace. The services (see L<FS::cust_svc>) are moved to the
3180 new billing items. An error is returned if this is not possible (see
3183 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3184 newly-created cust_pkg objects.
3189 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3191 # Transactionize this whole mess
3192 local $SIG{HUP} = 'IGNORE';
3193 local $SIG{INT} = 'IGNORE';
3194 local $SIG{QUIT} = 'IGNORE';
3195 local $SIG{TERM} = 'IGNORE';
3196 local $SIG{TSTP} = 'IGNORE';
3197 local $SIG{PIPE} = 'IGNORE';
3199 my $oldAutoCommit = $FS::UID::AutoCommit;
3200 local $FS::UID::AutoCommit = 0;
3204 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3207 while(scalar(@old_cust_pkg)) {
3209 my $custnum = $old_cust_pkg[0]->custnum;
3210 my (@remove) = map { $_->pkgnum }
3211 grep { $_->custnum == $custnum } @old_cust_pkg;
3212 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3214 my $error = order $custnum, $pkgparts, \@remove, \@return;
3216 push @errors, $error
3218 push @$return_cust_pkg, @return;
3221 if (scalar(@errors)) {
3222 $dbh->rollback if $oldAutoCommit;
3223 return join(' / ', @errors);
3226 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3230 # Used by FS::Upgrade to migrate to a new database.
3231 sub _upgrade_data { # class method
3232 my ($class, %opts) = @_;
3233 $class->_upgrade_otaker(%opts);
3240 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3242 In sub order, the @pkgparts array (passed by reference) is clobbered.
3244 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3245 method to pass dates to the recur_prog expression, it should do so.
3247 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3248 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3249 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3250 configuration values. Probably need a subroutine which decides what to do
3251 based on whether or not we've fetched the user yet, rather than a hash. See
3252 FS::UID and the TODO.
3254 Now that things are transactional should the check in the insert method be
3259 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3260 L<FS::pkg_svc>, schema.html from the base documentation