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 my $expire_months = $self->part_pkg->option('expire_months', 1);
263 if ( $expire_months && !$self->expire ) {
264 my $start = $self->start_date || $self->setup || time;
266 #false laziness w/part_pkg::add_freq
267 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime($start) )[0,1,2,3,4,5];
268 $mon += $expire_months;
269 until ( $mon < 12 ) { $mon -= 12; $year++; }
271 #$self->expire( timelocal_nocheck($sec,$min,$hour,$mday,$mon,$year) );
272 $self->expire( timelocal_nocheck(0,0,0,$mday,$mon,$year) );
275 local $SIG{HUP} = 'IGNORE';
276 local $SIG{INT} = 'IGNORE';
277 local $SIG{QUIT} = 'IGNORE';
278 local $SIG{TERM} = 'IGNORE';
279 local $SIG{TSTP} = 'IGNORE';
280 local $SIG{PIPE} = 'IGNORE';
282 my $oldAutoCommit = $FS::UID::AutoCommit;
283 local $FS::UID::AutoCommit = 0;
286 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
288 $dbh->rollback if $oldAutoCommit;
292 $self->refnum($self->cust_main->refnum) unless $self->refnum;
293 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
294 $self->process_m2m( 'link_table' => 'pkg_referral',
295 'target_table' => 'part_referral',
296 'params' => $self->refnum,
299 if ( $self->discountnum ) {
300 my $error = $self->insert_discount();
302 $dbh->rollback if $oldAutoCommit;
307 #if ( $self->reg_code ) {
308 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
309 # $error = $reg_code->delete;
311 # $dbh->rollback if $oldAutoCommit;
316 my $conf = new FS::Conf;
318 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
321 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
328 use FS::TicketSystem;
329 FS::TicketSystem->init();
331 my $q = new RT::Queue($RT::SystemUser);
332 $q->Load($options{ticket_queue}) if $options{ticket_queue};
333 my $t = new RT::Ticket($RT::SystemUser);
334 my $mime = new MIME::Entity;
335 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
336 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
337 Subject => $options{ticket_subject},
340 $t->AddLink( Type => 'MemberOf',
341 Target => 'freeside://freeside/cust_main/'. $self->custnum,
345 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
346 my $queue = new FS::queue {
347 'job' => 'FS::cust_main::queueable_print',
349 $error = $queue->insert(
350 'custnum' => $self->custnum,
351 'template' => 'welcome_letter',
355 warn "can't send welcome letter: $error";
360 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
367 This method now works but you probably shouldn't use it.
369 You don't want to delete billing items, because there would then be no record
370 the customer ever purchased the item. Instead, see the cancel method.
375 # return "Can't delete cust_pkg records!";
378 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
380 Replaces the OLD_RECORD with this one in the database. If there is an error,
381 returns the error, otherwise returns false.
383 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
385 Changing pkgpart may have disasterous effects. See the order subroutine.
387 setup and bill are normally updated by calling the bill method of a customer
388 object (see L<FS::cust_main>).
390 suspend is normally updated by the suspend and unsuspend methods.
392 cancel is normally updated by the cancel method (and also the order subroutine
395 Available options are:
401 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.
405 the access_user (see L<FS::access_user>) providing the reason
409 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
418 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
423 ( ref($_[0]) eq 'HASH' )
427 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
428 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
431 #return "Can't change setup once it exists!"
432 # if $old->getfield('setup') &&
433 # $old->getfield('setup') != $new->getfield('setup');
435 #some logic for bill, susp, cancel?
437 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
439 local $SIG{HUP} = 'IGNORE';
440 local $SIG{INT} = 'IGNORE';
441 local $SIG{QUIT} = 'IGNORE';
442 local $SIG{TERM} = 'IGNORE';
443 local $SIG{TSTP} = 'IGNORE';
444 local $SIG{PIPE} = 'IGNORE';
446 my $oldAutoCommit = $FS::UID::AutoCommit;
447 local $FS::UID::AutoCommit = 0;
450 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
451 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
452 my $error = $new->insert_reason(
453 'reason' => $options->{'reason'},
454 'date' => $new->$method,
456 'reason_otaker' => $options->{'reason_otaker'},
459 dbh->rollback if $oldAutoCommit;
460 return "Error inserting cust_pkg_reason: $error";
465 #save off and freeze RADIUS attributes for any associated svc_acct records
467 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
469 #also check for specific exports?
470 # to avoid spurious modify export events
471 @svc_acct = map { $_->svc_x }
472 grep { $_->part_svc->svcdb eq 'svc_acct' }
475 $_->snapshot foreach @svc_acct;
479 my $error = $new->SUPER::replace($old,
480 $options->{options} ? $options->{options} : ()
483 $dbh->rollback if $oldAutoCommit;
487 #for prepaid packages,
488 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
489 foreach my $old_svc_acct ( @svc_acct ) {
490 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
491 my $s_error = $new_svc_acct->replace($old_svc_acct);
493 $dbh->rollback if $oldAutoCommit;
498 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
505 Checks all fields to make sure this is a valid billing item. If there is an
506 error, returns the error, otherwise returns false. Called by the insert and
514 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
517 $self->ut_numbern('pkgnum')
518 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
519 || $self->ut_numbern('pkgpart')
520 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
521 || $self->ut_numbern('start_date')
522 || $self->ut_numbern('setup')
523 || $self->ut_numbern('bill')
524 || $self->ut_numbern('susp')
525 || $self->ut_numbern('cancel')
526 || $self->ut_numbern('adjourn')
527 || $self->ut_numbern('expire')
528 || $self->ut_enum('no_auto', [ '', 'Y' ])
530 return $error if $error;
532 if ( $self->reg_code ) {
534 unless ( grep { $self->pkgpart == $_->pkgpart }
535 map { $_->reg_code_pkg }
536 qsearchs( 'reg_code', { 'code' => $self->reg_code,
537 'agentnum' => $self->cust_main->agentnum })
539 return "Unknown registration code";
542 } elsif ( $self->promo_code ) {
545 qsearchs('part_pkg', {
546 'pkgpart' => $self->pkgpart,
547 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
549 return 'Unknown promotional code' unless $promo_part_pkg;
553 unless ( $disable_agentcheck ) {
555 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
556 return "agent ". $agent->agentnum. ':'. $agent->agent.
557 " can't purchase pkgpart ". $self->pkgpart
558 unless $agent->pkgpart_hashref->{ $self->pkgpart }
559 || $agent->agentnum == $self->part_pkg->agentnum;
562 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
563 return $error if $error;
567 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
569 if ( $self->dbdef_table->column('manual_flag') ) {
570 $self->manual_flag('') if $self->manual_flag eq ' ';
571 $self->manual_flag =~ /^([01]?)$/
572 or return "Illegal manual_flag ". $self->manual_flag;
573 $self->manual_flag($1);
579 =item cancel [ OPTION => VALUE ... ]
581 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
582 in this package, then cancels the package itself (sets the cancel field to
585 Available options are:
589 =item quiet - can be set true to supress email cancellation notices.
591 =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.
593 =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.
595 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
597 =item nobill - can be set true to skip billing if it might otherwise be done.
601 If there is an error, returns the error, otherwise returns false.
606 my( $self, %options ) = @_;
609 my $conf = new FS::Conf;
611 warn "cust_pkg::cancel called with options".
612 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
615 local $SIG{HUP} = 'IGNORE';
616 local $SIG{INT} = 'IGNORE';
617 local $SIG{QUIT} = 'IGNORE';
618 local $SIG{TERM} = 'IGNORE';
619 local $SIG{TSTP} = 'IGNORE';
620 local $SIG{PIPE} = 'IGNORE';
622 my $oldAutoCommit = $FS::UID::AutoCommit;
623 local $FS::UID::AutoCommit = 0;
626 my $old = $self->select_for_update;
628 if ( $old->get('cancel') || $self->get('cancel') ) {
629 dbh->rollback if $oldAutoCommit;
630 return ""; # no error
633 my $date = $options{date} if $options{date}; # expire/cancel later
634 $date = '' if ($date && $date <= time); # complain instead?
636 #race condition: usage could be ongoing until unprovisioned
637 #resolved by performing a change package instead (which unprovisions) and
639 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
640 my $copy = $self->new({$self->hash});
642 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
643 warn "Error billing during cancel, custnum ".
644 #$self->cust_main->custnum. ": $error"
650 my $cancel_time = $options{'time'} || time;
652 if ( $options{'reason'} ) {
653 $error = $self->insert_reason( 'reason' => $options{'reason'},
654 'action' => $date ? 'expire' : 'cancel',
655 'date' => $date ? $date : $cancel_time,
656 'reason_otaker' => $options{'reason_otaker'},
659 dbh->rollback if $oldAutoCommit;
660 return "Error inserting cust_pkg_reason: $error";
666 foreach my $cust_svc (
669 sort { $a->[1] <=> $b->[1] }
670 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
671 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
674 my $error = $cust_svc->cancel;
677 $dbh->rollback if $oldAutoCommit;
678 return "Error cancelling cust_svc: $error";
682 # Add a credit for remaining service
683 my $remaining_value = $self->calc_remain(time=>$cancel_time);
684 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
685 my $error = $self->cust_main->credit(
687 'Credit for unused time on '. $self->part_pkg->pkg,
688 'reason_type' => $conf->config('cancel_credit_type'),
691 $dbh->rollback if $oldAutoCommit;
692 return "Error crediting customer \$$remaining_value for unused time on".
693 $self->part_pkg->pkg. ": $error";
698 my %hash = $self->hash;
699 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
700 my $new = new FS::cust_pkg ( \%hash );
701 $error = $new->replace( $self, options => { $self->options } );
703 $dbh->rollback if $oldAutoCommit;
707 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
708 return '' if $date; #no errors
710 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
711 if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) {
712 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
715 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
716 $error = $msg_template->send( 'cust_main' => $self->cust_main,
721 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
722 'to' => \@invoicing_list,
723 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
724 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
727 #should this do something on errors?
734 =item cancel_if_expired [ NOW_TIMESTAMP ]
736 Cancels this package if its expire date has been reached.
740 sub cancel_if_expired {
742 my $time = shift || time;
743 return '' unless $self->expire && $self->expire <= $time;
744 my $error = $self->cancel;
746 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
747 $self->custnum. ": $error";
754 Cancels any pending expiration (sets the expire field to null).
756 If there is an error, returns the error, otherwise returns false.
761 my( $self, %options ) = @_;
764 local $SIG{HUP} = 'IGNORE';
765 local $SIG{INT} = 'IGNORE';
766 local $SIG{QUIT} = 'IGNORE';
767 local $SIG{TERM} = 'IGNORE';
768 local $SIG{TSTP} = 'IGNORE';
769 local $SIG{PIPE} = 'IGNORE';
771 my $oldAutoCommit = $FS::UID::AutoCommit;
772 local $FS::UID::AutoCommit = 0;
775 my $old = $self->select_for_update;
777 my $pkgnum = $old->pkgnum;
778 if ( $old->get('cancel') || $self->get('cancel') ) {
779 dbh->rollback if $oldAutoCommit;
780 return "Can't unexpire cancelled package $pkgnum";
781 # or at least it's pointless
784 unless ( $old->get('expire') && $self->get('expire') ) {
785 dbh->rollback if $oldAutoCommit;
786 return ""; # no error
789 my %hash = $self->hash;
790 $hash{'expire'} = '';
791 my $new = new FS::cust_pkg ( \%hash );
792 $error = $new->replace( $self, options => { $self->options } );
794 $dbh->rollback if $oldAutoCommit;
798 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
804 =item suspend [ OPTION => VALUE ... ]
806 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
807 package, then suspends the package itself (sets the susp field to now).
809 Available options are:
813 =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.
815 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
819 If there is an error, returns the error, otherwise returns false.
824 my( $self, %options ) = @_;
827 local $SIG{HUP} = 'IGNORE';
828 local $SIG{INT} = 'IGNORE';
829 local $SIG{QUIT} = 'IGNORE';
830 local $SIG{TERM} = 'IGNORE';
831 local $SIG{TSTP} = 'IGNORE';
832 local $SIG{PIPE} = 'IGNORE';
834 my $oldAutoCommit = $FS::UID::AutoCommit;
835 local $FS::UID::AutoCommit = 0;
838 my $old = $self->select_for_update;
840 my $pkgnum = $old->pkgnum;
841 if ( $old->get('cancel') || $self->get('cancel') ) {
842 dbh->rollback if $oldAutoCommit;
843 return "Can't suspend cancelled package $pkgnum";
846 if ( $old->get('susp') || $self->get('susp') ) {
847 dbh->rollback if $oldAutoCommit;
848 return ""; # no error # complain on adjourn?
851 my $date = $options{date} if $options{date}; # adjourn/suspend later
852 $date = '' if ($date && $date <= time); # complain instead?
854 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
855 dbh->rollback if $oldAutoCommit;
856 return "Package $pkgnum expires before it would be suspended.";
859 my $suspend_time = $options{'time'} || time;
861 if ( $options{'reason'} ) {
862 $error = $self->insert_reason( 'reason' => $options{'reason'},
863 'action' => $date ? 'adjourn' : 'suspend',
864 'date' => $date ? $date : $suspend_time,
865 'reason_otaker' => $options{'reason_otaker'},
868 dbh->rollback if $oldAutoCommit;
869 return "Error inserting cust_pkg_reason: $error";
877 foreach my $cust_svc (
878 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
880 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
882 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
883 $dbh->rollback if $oldAutoCommit;
884 return "Illegal svcdb value in part_svc!";
887 require "FS/$svcdb.pm";
889 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
891 $error = $svc->suspend;
893 $dbh->rollback if $oldAutoCommit;
896 my( $label, $value ) = $cust_svc->label;
897 push @labels, "$label: $value";
901 my $conf = new FS::Conf;
902 if ( $conf->config('suspend_email_admin') ) {
904 my $error = send_email(
905 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
906 #invoice_from ??? well as good as any
907 'to' => $conf->config('suspend_email_admin'),
908 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
910 "This is an automatic message from your Freeside installation\n",
911 "informing you that the following customer package has been suspended:\n",
913 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
914 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
915 ( map { "Service : $_\n" } @labels ),
920 warn "WARNING: can't send suspension admin email (suspending anyway): ".
928 my %hash = $self->hash;
930 $hash{'adjourn'} = $date;
932 $hash{'susp'} = $suspend_time;
934 my $new = new FS::cust_pkg ( \%hash );
935 $error = $new->replace( $self, options => { $self->options } );
937 $dbh->rollback if $oldAutoCommit;
941 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
946 =item unsuspend [ OPTION => VALUE ... ]
948 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
949 package, then unsuspends the package itself (clears the susp field and the
950 adjourn field if it is in the past).
952 Available options are:
956 =item adjust_next_bill
958 Can be set true to adjust the next bill date forward by
959 the amount of time the account was inactive. This was set true by default
960 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
961 explicitly requested. Price plans for which this makes sense (anniversary-date
962 based than prorate or subscription) could have an option to enable this
967 If there is an error, returns the error, otherwise returns false.
972 my( $self, %opt ) = @_;
975 local $SIG{HUP} = 'IGNORE';
976 local $SIG{INT} = 'IGNORE';
977 local $SIG{QUIT} = 'IGNORE';
978 local $SIG{TERM} = 'IGNORE';
979 local $SIG{TSTP} = 'IGNORE';
980 local $SIG{PIPE} = 'IGNORE';
982 my $oldAutoCommit = $FS::UID::AutoCommit;
983 local $FS::UID::AutoCommit = 0;
986 my $old = $self->select_for_update;
988 my $pkgnum = $old->pkgnum;
989 if ( $old->get('cancel') || $self->get('cancel') ) {
990 dbh->rollback if $oldAutoCommit;
991 return "Can't unsuspend cancelled package $pkgnum";
994 unless ( $old->get('susp') && $self->get('susp') ) {
995 dbh->rollback if $oldAutoCommit;
996 return ""; # no error # complain instead?
999 foreach my $cust_svc (
1000 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1002 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1004 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1005 $dbh->rollback if $oldAutoCommit;
1006 return "Illegal svcdb value in part_svc!";
1009 require "FS/$svcdb.pm";
1011 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1013 $error = $svc->unsuspend;
1015 $dbh->rollback if $oldAutoCommit;
1022 my %hash = $self->hash;
1023 my $inactive = time - $hash{'susp'};
1025 my $conf = new FS::Conf;
1027 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive
1028 if ( $opt{'adjust_next_bill'}
1029 || $conf->exists('unsuspend-always_adjust_next_bill_date') )
1030 && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} );
1033 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1034 my $new = new FS::cust_pkg ( \%hash );
1035 $error = $new->replace( $self, options => { $self->options } );
1037 $dbh->rollback if $oldAutoCommit;
1041 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1048 Cancels any pending suspension (sets the adjourn field to null).
1050 If there is an error, returns the error, otherwise returns false.
1055 my( $self, %options ) = @_;
1058 local $SIG{HUP} = 'IGNORE';
1059 local $SIG{INT} = 'IGNORE';
1060 local $SIG{QUIT} = 'IGNORE';
1061 local $SIG{TERM} = 'IGNORE';
1062 local $SIG{TSTP} = 'IGNORE';
1063 local $SIG{PIPE} = 'IGNORE';
1065 my $oldAutoCommit = $FS::UID::AutoCommit;
1066 local $FS::UID::AutoCommit = 0;
1069 my $old = $self->select_for_update;
1071 my $pkgnum = $old->pkgnum;
1072 if ( $old->get('cancel') || $self->get('cancel') ) {
1073 dbh->rollback if $oldAutoCommit;
1074 return "Can't unadjourn cancelled package $pkgnum";
1075 # or at least it's pointless
1078 if ( $old->get('susp') || $self->get('susp') ) {
1079 dbh->rollback if $oldAutoCommit;
1080 return "Can't unadjourn suspended package $pkgnum";
1081 # perhaps this is arbitrary
1084 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1085 dbh->rollback if $oldAutoCommit;
1086 return ""; # no error
1089 my %hash = $self->hash;
1090 $hash{'adjourn'} = '';
1091 my $new = new FS::cust_pkg ( \%hash );
1092 $error = $new->replace( $self, options => { $self->options } );
1094 $dbh->rollback if $oldAutoCommit;
1098 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1105 =item change HASHREF | OPTION => VALUE ...
1107 Changes this package: cancels it and creates a new one, with a different
1108 pkgpart or locationnum or both. All services are transferred to the new
1109 package (no change will be made if this is not possible).
1111 Options may be passed as a list of key/value pairs or as a hash reference.
1118 New locationnum, to change the location for this package.
1122 New FS::cust_location object, to create a new location and assign it
1127 New pkgpart (see L<FS::part_pkg>).
1131 New refnum (see L<FS::part_referral>).
1135 At least one option must be specified (otherwise, what's the point?)
1137 Returns either the new FS::cust_pkg object or a scalar error.
1141 my $err_or_new_cust_pkg = $old_cust_pkg->change
1145 #some false laziness w/order
1148 my $opt = ref($_[0]) ? shift : { @_ };
1150 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1153 my $conf = new FS::Conf;
1155 # Transactionize this whole mess
1156 local $SIG{HUP} = 'IGNORE';
1157 local $SIG{INT} = 'IGNORE';
1158 local $SIG{QUIT} = 'IGNORE';
1159 local $SIG{TERM} = 'IGNORE';
1160 local $SIG{TSTP} = 'IGNORE';
1161 local $SIG{PIPE} = 'IGNORE';
1163 my $oldAutoCommit = $FS::UID::AutoCommit;
1164 local $FS::UID::AutoCommit = 0;
1173 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1175 #$hash{$_} = $self->$_() foreach qw( setup );
1177 $hash{'setup'} = $time if $self->setup;
1179 $hash{'change_date'} = $time;
1180 $hash{"change_$_"} = $self->$_()
1181 foreach qw( pkgnum pkgpart locationnum );
1183 if ( $opt->{'cust_location'} &&
1184 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1185 $error = $opt->{'cust_location'}->insert;
1187 $dbh->rollback if $oldAutoCommit;
1188 return "inserting cust_location (transaction rolled back): $error";
1190 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1193 # Create the new package.
1194 my $cust_pkg = new FS::cust_pkg {
1195 custnum => $self->custnum,
1196 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1197 refnum => ( $opt->{'refnum'} || $self->refnum ),
1198 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1202 $error = $cust_pkg->insert( 'change' => 1 );
1204 $dbh->rollback if $oldAutoCommit;
1208 # Transfer services and cancel old package.
1210 $error = $self->transfer($cust_pkg);
1211 if ($error and $error == 0) {
1212 # $old_pkg->transfer failed.
1213 $dbh->rollback if $oldAutoCommit;
1217 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1218 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1219 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1220 if ($error and $error == 0) {
1221 # $old_pkg->transfer failed.
1222 $dbh->rollback if $oldAutoCommit;
1228 # Transfers were successful, but we still had services left on the old
1229 # package. We can't change the package under this circumstances, so abort.
1230 $dbh->rollback if $oldAutoCommit;
1231 return "Unable to transfer all services from package ". $self->pkgnum;
1234 #reset usage if changing pkgpart
1235 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1236 if ($self->pkgpart != $cust_pkg->pkgpart) {
1237 my $part_pkg = $cust_pkg->part_pkg;
1238 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1242 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover');
1245 $dbh->rollback if $oldAutoCommit;
1246 return "Error setting usage values: $error";
1250 #Good to go, cancel old package.
1251 $error = $self->cancel( quiet=>1 );
1253 $dbh->rollback if $oldAutoCommit;
1257 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1259 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1261 $dbh->rollback if $oldAutoCommit;
1266 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1274 Returns the last bill date, or if there is no last bill date, the setup date.
1275 Useful for billing metered services.
1281 return $self->setfield('last_bill', $_[0]) if @_;
1282 return $self->getfield('last_bill') if $self->getfield('last_bill');
1283 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1284 'edate' => $self->bill, } );
1285 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1288 =item last_cust_pkg_reason ACTION
1290 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1291 Returns false if there is no reason or the package is not currenly ACTION'd
1292 ACTION is one of adjourn, susp, cancel, or expire.
1296 sub last_cust_pkg_reason {
1297 my ( $self, $action ) = ( shift, shift );
1298 my $date = $self->get($action);
1300 'table' => 'cust_pkg_reason',
1301 'hashref' => { 'pkgnum' => $self->pkgnum,
1302 'action' => substr(uc($action), 0, 1),
1305 'order_by' => 'ORDER BY num DESC LIMIT 1',
1309 =item last_reason ACTION
1311 Returns the most recent ACTION FS::reason associated with the package.
1312 Returns false if there is no reason or the package is not currenly ACTION'd
1313 ACTION is one of adjourn, susp, cancel, or expire.
1318 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1319 $cust_pkg_reason->reason
1320 if $cust_pkg_reason;
1325 Returns the definition for this billing item, as an FS::part_pkg object (see
1332 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1333 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1334 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1339 Returns the cancelled package this package was changed from, if any.
1345 return '' unless $self->change_pkgnum;
1346 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1351 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1358 $self->part_pkg->calc_setup($self, @_);
1363 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1370 $self->part_pkg->calc_recur($self, @_);
1375 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1382 $self->part_pkg->calc_remain($self, @_);
1387 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1394 $self->part_pkg->calc_cancel($self, @_);
1399 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1405 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1408 =item cust_pkg_detail [ DETAILTYPE ]
1410 Returns any customer package details for this package (see
1411 L<FS::cust_pkg_detail>).
1413 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1417 sub cust_pkg_detail {
1419 my %hash = ( 'pkgnum' => $self->pkgnum );
1420 $hash{detailtype} = shift if @_;
1422 'table' => 'cust_pkg_detail',
1423 'hashref' => \%hash,
1424 'order_by' => 'ORDER BY weight, pkgdetailnum',
1428 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1430 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1432 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1434 If there is an error, returns the error, otherwise returns false.
1438 sub set_cust_pkg_detail {
1439 my( $self, $detailtype, @details ) = @_;
1441 local $SIG{HUP} = 'IGNORE';
1442 local $SIG{INT} = 'IGNORE';
1443 local $SIG{QUIT} = 'IGNORE';
1444 local $SIG{TERM} = 'IGNORE';
1445 local $SIG{TSTP} = 'IGNORE';
1446 local $SIG{PIPE} = 'IGNORE';
1448 my $oldAutoCommit = $FS::UID::AutoCommit;
1449 local $FS::UID::AutoCommit = 0;
1452 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1453 my $error = $current->delete;
1455 $dbh->rollback if $oldAutoCommit;
1456 return "error removing old detail: $error";
1460 foreach my $detail ( @details ) {
1461 my $cust_pkg_detail = new FS::cust_pkg_detail {
1462 'pkgnum' => $self->pkgnum,
1463 'detailtype' => $detailtype,
1464 'detail' => $detail,
1466 my $error = $cust_pkg_detail->insert;
1468 $dbh->rollback if $oldAutoCommit;
1469 return "error adding new detail: $error";
1474 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1481 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1485 #false laziness w/cust_bill.pm
1489 'table' => 'cust_event',
1490 'addl_from' => 'JOIN part_event USING ( eventpart )',
1491 'hashref' => { 'tablenum' => $self->pkgnum },
1492 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1496 =item num_cust_event
1498 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1502 #false laziness w/cust_bill.pm
1503 sub num_cust_event {
1506 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1507 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1508 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1509 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1510 $sth->fetchrow_arrayref->[0];
1513 =item cust_svc [ SVCPART ]
1515 Returns the services for this package, as FS::cust_svc objects (see
1516 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1524 return () unless $self->num_cust_svc(@_);
1527 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1528 'svcpart' => shift, } );
1531 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1533 #if ( $self->{'_svcnum'} ) {
1534 # values %{ $self->{'_svcnum'}->cache };
1536 $self->_sort_cust_svc(
1537 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1543 =item overlimit [ SVCPART ]
1545 Returns the services for this package which have exceeded their
1546 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1547 is specified, return only the matching services.
1553 return () unless $self->num_cust_svc(@_);
1554 grep { $_->overlimit } $self->cust_svc(@_);
1557 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
1559 Returns historical services for this package created before END TIMESTAMP and
1560 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1561 (see L<FS::h_cust_svc>).
1568 $self->_sort_cust_svc(
1569 [ qsearch( 'h_cust_svc',
1570 { 'pkgnum' => $self->pkgnum, },
1571 FS::h_cust_svc->sql_h_search(@_),
1577 sub _sort_cust_svc {
1578 my( $self, $arrayref ) = @_;
1581 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1586 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1587 'svcpart' => $_->svcpart } );
1589 $pkg_svc ? $pkg_svc->primary_svc : '',
1590 $pkg_svc ? $pkg_svc->quantity : 0,
1597 =item num_cust_svc [ SVCPART ]
1599 Returns the number of provisioned services for this package. If a svcpart is
1600 specified, counts only the matching services.
1607 return $self->{'_num_cust_svc'}
1609 && exists($self->{'_num_cust_svc'})
1610 && $self->{'_num_cust_svc'} =~ /\d/;
1612 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1615 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1616 $sql .= ' AND svcpart = ?' if @_;
1618 my $sth = dbh->prepare($sql) or die dbh->errstr;
1619 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1620 $sth->fetchrow_arrayref->[0];
1623 =item available_part_svc
1625 Returns a list of FS::part_svc objects representing services included in this
1626 package but not yet provisioned. Each FS::part_svc object also has an extra
1627 field, I<num_avail>, which specifies the number of available services.
1631 sub available_part_svc {
1633 grep { $_->num_avail > 0 }
1635 my $part_svc = $_->part_svc;
1636 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1637 $_->quantity - $self->num_cust_svc($_->svcpart);
1640 $self->part_pkg->pkg_svc;
1645 Returns a list of FS::part_svc objects representing provisioned and available
1646 services included in this package. Each FS::part_svc object also has the
1647 following extra fields:
1651 =item num_cust_svc (count)
1653 =item num_avail (quantity - count)
1655 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1658 label -> ($cust_svc->label)[1]
1667 #XXX some sort of sort order besides numeric by svcpart...
1668 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1670 my $part_svc = $pkg_svc->part_svc;
1671 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1672 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1673 $part_svc->{'Hash'}{'num_avail'} =
1674 max( 0, $pkg_svc->quantity - $num_cust_svc );
1675 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1676 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1678 } $self->part_pkg->pkg_svc;
1681 push @part_svc, map {
1683 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1684 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1685 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1686 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1687 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1689 } $self->extra_part_svc;
1695 =item extra_part_svc
1697 Returns a list of FS::part_svc objects corresponding to services in this
1698 package which are still provisioned but not (any longer) available in the
1703 sub extra_part_svc {
1706 my $pkgnum = $self->pkgnum;
1707 my $pkgpart = $self->pkgpart;
1710 # 'table' => 'part_svc',
1713 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1714 # WHERE pkg_svc.svcpart = part_svc.svcpart
1715 # AND pkg_svc.pkgpart = ?
1718 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1719 # LEFT JOIN cust_pkg USING ( pkgnum )
1720 # WHERE cust_svc.svcpart = part_svc.svcpart
1723 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1726 #seems to benchmark slightly faster...
1728 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1729 #MySQL doesn't grok DISINCT ON
1730 'select' => 'DISTINCT part_svc.*',
1731 'table' => 'part_svc',
1733 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1734 AND pkg_svc.pkgpart = ?
1737 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1738 LEFT JOIN cust_pkg USING ( pkgnum )
1741 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1742 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1748 Returns a short status string for this package, currently:
1752 =item not yet billed
1754 =item one-time charge
1769 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1771 return 'cancelled' if $self->get('cancel');
1772 return 'suspended' if $self->susp;
1773 return 'not yet billed' unless $self->setup;
1774 return 'one-time charge' if $freq =~ /^(0|$)/;
1778 =item ucfirst_status
1780 Returns the status with the first character capitalized.
1784 sub ucfirst_status {
1785 ucfirst(shift->status);
1790 Class method that returns the list of possible status strings for packages
1791 (see L<the status method|/status>). For example:
1793 @statuses = FS::cust_pkg->statuses();
1797 tie my %statuscolor, 'Tie::IxHash',
1798 'not yet billed' => '000000',
1799 'one-time charge' => '000000',
1800 'active' => '00CC00',
1801 'suspended' => 'FF9900',
1802 'cancelled' => 'FF0000',
1806 my $self = shift; #could be class...
1807 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1808 # # mayble split btw one-time vs. recur
1814 Returns a hex triplet color string for this package's status.
1820 $statuscolor{$self->status};
1825 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1826 "pkg-comment" depending on user preference).
1832 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1833 $label = $self->pkgnum. ": $label"
1834 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1838 =item pkg_label_long
1840 Returns a long label for this package, adding the primary service's label to
1845 sub pkg_label_long {
1847 my $label = $self->pkg_label;
1848 my $cust_svc = $self->primary_cust_svc;
1849 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1853 =item primary_cust_svc
1855 Returns a primary service (as FS::cust_svc object) if one can be identified.
1859 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1861 sub primary_cust_svc {
1864 my @cust_svc = $self->cust_svc;
1866 return '' unless @cust_svc; #no serivces - irrelevant then
1868 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1870 # primary service as specified in the package definition
1871 # or exactly one service definition with quantity one
1872 my $svcpart = $self->part_pkg->svcpart;
1873 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1874 return $cust_svc[0] if scalar(@cust_svc) == 1;
1876 #couldn't identify one thing..
1882 Returns a list of lists, calling the label method for all services
1883 (see L<FS::cust_svc>) of this billing item.
1889 map { [ $_->label ] } $self->cust_svc;
1892 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ]
1894 Like the labels method, but returns historical information on services that
1895 were active as of END_TIMESTAMP and (optionally) not cancelled before
1898 Returns a list of lists, calling the label method for all (historical) services
1899 (see L<FS::h_cust_svc>) of this billing item.
1905 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
1910 Like labels, except returns a simple flat list, and shortens long
1911 (currently >5 or the cust_bill-max_same_services configuration value) lists of
1912 identical services to one line that lists the service label and the number of
1913 individual services rather than individual items.
1918 shift->_labels_short( 'labels', @_ );
1921 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
1923 Like h_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.
1930 sub h_labels_short {
1931 shift->_labels_short( 'h_labels', @_ );
1935 my( $self, $method ) = ( shift, shift );
1937 my $conf = new FS::Conf;
1938 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
1941 #tie %labels, 'Tie::IxHash';
1942 push @{ $labels{$_->[0]} }, $_->[1]
1943 foreach $self->$method(@_);
1945 foreach my $label ( keys %labels ) {
1947 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
1948 my $num = scalar(@values);
1949 if ( $num > $max_same_services ) {
1950 push @labels, "$label ($num)";
1952 if ( $conf->exists('cust_bill-consolidate_services') ) {
1953 # push @labels, "$label: ". join(', ', @values);
1955 my $detail = "$label: ";
1956 $detail .= shift(@values). ', '
1957 while @values && length($detail.$values[0]) < 78;
1959 push @labels, $detail;
1962 push @labels, map { "$label: $_" } @values;
1973 Returns the parent customer object (see L<FS::cust_main>).
1979 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
1982 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
1986 Returns the location object, if any (see L<FS::cust_location>).
1988 =item cust_location_or_main
1990 If this package is associated with a location, returns the locaiton (see
1991 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
1993 =item location_label [ OPTION => VALUE ... ]
1995 Returns the label of the location object (see L<FS::cust_location>).
1999 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2001 =item seconds_since TIMESTAMP
2003 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2004 package have been online since TIMESTAMP, according to the session monitor.
2006 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2007 L<Time::Local> and L<Date::Parse> for conversion functions.
2012 my($self, $since) = @_;
2015 foreach my $cust_svc (
2016 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2018 $seconds += $cust_svc->seconds_since($since);
2025 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2027 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2028 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2031 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2032 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2038 sub seconds_since_sqlradacct {
2039 my($self, $start, $end) = @_;
2043 foreach my $cust_svc (
2045 my $part_svc = $_->part_svc;
2046 $part_svc->svcdb eq 'svc_acct'
2047 && scalar($part_svc->part_export('sqlradius'));
2050 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2057 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2059 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2060 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2064 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2065 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2070 sub attribute_since_sqlradacct {
2071 my($self, $start, $end, $attrib) = @_;
2075 foreach my $cust_svc (
2077 my $part_svc = $_->part_svc;
2078 $part_svc->svcdb eq 'svc_acct'
2079 && scalar($part_svc->part_export('sqlradius'));
2082 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2094 my( $self, $value ) = @_;
2095 if ( defined($value) ) {
2096 $self->setfield('quantity', $value);
2098 $self->getfield('quantity') || 1;
2101 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2103 Transfers as many services as possible from this package to another package.
2105 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2106 object. The destination package must already exist.
2108 Services are moved only if the destination allows services with the correct
2109 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2110 this option with caution! No provision is made for export differences
2111 between the old and new service definitions. Probably only should be used
2112 when your exports for all service definitions of a given svcdb are identical.
2113 (attempt a transfer without it first, to move all possible svcpart-matching
2116 Any services that can't be moved remain in the original package.
2118 Returns an error, if there is one; otherwise, returns the number of services
2119 that couldn't be moved.
2124 my ($self, $dest_pkgnum, %opt) = @_;
2130 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2131 $dest = $dest_pkgnum;
2132 $dest_pkgnum = $dest->pkgnum;
2134 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2137 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2139 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2140 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2143 foreach my $cust_svc ($dest->cust_svc) {
2144 $target{$cust_svc->svcpart}--;
2147 my %svcpart2svcparts = ();
2148 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2149 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2150 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2151 next if exists $svcpart2svcparts{$svcpart};
2152 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2153 $svcpart2svcparts{$svcpart} = [
2155 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2157 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2158 'svcpart' => $_ } );
2160 $pkg_svc ? $pkg_svc->primary_svc : '',
2161 $pkg_svc ? $pkg_svc->quantity : 0,
2165 grep { $_ != $svcpart }
2167 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2169 warn "alternates for svcpart $svcpart: ".
2170 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2175 foreach my $cust_svc ($self->cust_svc) {
2176 if($target{$cust_svc->svcpart} > 0) {
2177 $target{$cust_svc->svcpart}--;
2178 my $new = new FS::cust_svc { $cust_svc->hash };
2179 $new->pkgnum($dest_pkgnum);
2180 my $error = $new->replace($cust_svc);
2181 return $error if $error;
2182 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2184 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2185 warn "alternates to consider: ".
2186 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2188 my @alternate = grep {
2189 warn "considering alternate svcpart $_: ".
2190 "$target{$_} available in new package\n"
2193 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2195 warn "alternate(s) found\n" if $DEBUG;
2196 my $change_svcpart = $alternate[0];
2197 $target{$change_svcpart}--;
2198 my $new = new FS::cust_svc { $cust_svc->hash };
2199 $new->svcpart($change_svcpart);
2200 $new->pkgnum($dest_pkgnum);
2201 my $error = $new->replace($cust_svc);
2202 return $error if $error;
2215 This method is deprecated. See the I<depend_jobnum> option to the insert and
2216 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2223 local $SIG{HUP} = 'IGNORE';
2224 local $SIG{INT} = 'IGNORE';
2225 local $SIG{QUIT} = 'IGNORE';
2226 local $SIG{TERM} = 'IGNORE';
2227 local $SIG{TSTP} = 'IGNORE';
2228 local $SIG{PIPE} = 'IGNORE';
2230 my $oldAutoCommit = $FS::UID::AutoCommit;
2231 local $FS::UID::AutoCommit = 0;
2234 foreach my $cust_svc ( $self->cust_svc ) {
2235 #false laziness w/svc_Common::insert
2236 my $svc_x = $cust_svc->svc_x;
2237 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2238 my $error = $part_export->export_insert($svc_x);
2240 $dbh->rollback if $oldAutoCommit;
2246 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2253 Associates this package with a (suspension or cancellation) reason (see
2254 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2257 Available options are:
2263 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.
2267 the access_user (see L<FS::access_user>) providing the reason
2275 the action (cancel, susp, adjourn, expire) associated with the reason
2279 If there is an error, returns the error, otherwise returns false.
2284 my ($self, %options) = @_;
2286 my $otaker = $options{reason_otaker} ||
2287 $FS::CurrentUser::CurrentUser->username;
2290 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2294 } elsif ( ref($options{'reason'}) ) {
2296 return 'Enter a new reason (or select an existing one)'
2297 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2299 my $reason = new FS::reason({
2300 'reason_type' => $options{'reason'}->{'typenum'},
2301 'reason' => $options{'reason'}->{'reason'},
2303 my $error = $reason->insert;
2304 return $error if $error;
2306 $reasonnum = $reason->reasonnum;
2309 return "Unparsable reason: ". $options{'reason'};
2312 my $cust_pkg_reason =
2313 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2314 'reasonnum' => $reasonnum,
2315 'otaker' => $otaker,
2316 'action' => substr(uc($options{'action'}),0,1),
2317 'date' => $options{'date'}
2322 $cust_pkg_reason->insert;
2325 =item insert_discount
2327 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2328 inserting a new discount on the fly (see L<FS::discount>).
2330 Available options are:
2338 If there is an error, returns the error, otherwise returns false.
2342 sub insert_discount {
2343 #my ($self, %options) = @_;
2346 my $cust_pkg_discount = new FS::cust_pkg_discount {
2347 'pkgnum' => $self->pkgnum,
2348 'discountnum' => $self->discountnum,
2350 'end_date' => '', #XXX
2351 'otaker' => $self->otaker,
2352 #for the create a new discount case
2353 '_type' => $self->discountnum__type,
2354 'amount' => $self->discountnum_amount,
2355 'percent' => $self->discountnum_percent,
2356 'months' => $self->discountnum_months,
2357 #'disabled' => $self->discountnum_disabled,
2360 $cust_pkg_discount->insert;
2363 =item set_usage USAGE_VALUE_HASHREF
2365 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2366 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2367 upbytes, downbytes, and totalbytes are appropriate keys.
2369 All svc_accts which are part of this package have their values reset.
2374 my ($self, $valueref, %opt) = @_;
2376 foreach my $cust_svc ($self->cust_svc){
2377 my $svc_x = $cust_svc->svc_x;
2378 $svc_x->set_usage($valueref, %opt)
2379 if $svc_x->can("set_usage");
2383 =item recharge USAGE_VALUE_HASHREF
2385 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2386 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2387 upbytes, downbytes, and totalbytes are appropriate keys.
2389 All svc_accts which are part of this package have their values incremented.
2394 my ($self, $valueref) = @_;
2396 foreach my $cust_svc ($self->cust_svc){
2397 my $svc_x = $cust_svc->svc_x;
2398 $svc_x->recharge($valueref)
2399 if $svc_x->can("recharge");
2403 =item cust_pkg_discount
2407 sub cust_pkg_discount {
2409 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2412 =item cust_pkg_discount_active
2416 sub cust_pkg_discount_active {
2418 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2423 =head1 CLASS METHODS
2429 Returns an SQL expression identifying recurring packages.
2433 sub recurring_sql { "
2434 '0' != ( select freq from part_pkg
2435 where cust_pkg.pkgpart = part_pkg.pkgpart )
2440 Returns an SQL expression identifying one-time packages.
2445 '0' = ( select freq from part_pkg
2446 where cust_pkg.pkgpart = part_pkg.pkgpart )
2451 Returns an SQL expression identifying ordered packages (recurring packages not
2457 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2462 Returns an SQL expression identifying active packages.
2467 $_[0]->recurring_sql. "
2468 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2469 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2470 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2473 =item not_yet_billed_sql
2475 Returns an SQL expression identifying packages which have not yet been billed.
2479 sub not_yet_billed_sql { "
2480 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2481 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2482 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2487 Returns an SQL expression identifying inactive packages (one-time packages
2488 that are otherwise unsuspended/uncancelled).
2492 sub inactive_sql { "
2493 ". $_[0]->onetime_sql(). "
2494 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2495 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2496 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2502 Returns an SQL expression identifying suspended packages.
2506 sub suspended_sql { susp_sql(@_); }
2508 #$_[0]->recurring_sql(). ' AND '.
2510 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2511 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2518 Returns an SQL exprression identifying cancelled packages.
2522 sub cancelled_sql { cancel_sql(@_); }
2524 #$_[0]->recurring_sql(). ' AND '.
2525 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2528 =item search HASHREF
2532 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2533 Valid parameters are
2541 active, inactive, suspended, cancel (or cancelled)
2545 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2549 boolean selects custom packages
2555 pkgpart or arrayref or hashref of pkgparts
2559 arrayref of beginning and ending epoch date
2563 arrayref of beginning and ending epoch date
2567 arrayref of beginning and ending epoch date
2571 arrayref of beginning and ending epoch date
2575 arrayref of beginning and ending epoch date
2579 arrayref of beginning and ending epoch date
2583 arrayref of beginning and ending epoch date
2587 pkgnum or APKG_pkgnum
2591 a value suited to passing to FS::UI::Web::cust_header
2595 specifies the user for agent virtualization
2599 boolean selects packages containing fcc form 477 telco lines
2606 my ($class, $params) = @_;
2613 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2615 "cust_main.agentnum = $1";
2622 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2624 "cust_pkg.custnum = $1";
2631 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2633 "cust_pkg.pkgbatch = '$1'";
2640 if ( $params->{'magic'} eq 'active'
2641 || $params->{'status'} eq 'active' ) {
2643 push @where, FS::cust_pkg->active_sql();
2645 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2646 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2648 push @where, FS::cust_pkg->not_yet_billed_sql();
2650 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2651 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2653 push @where, FS::cust_pkg->inactive_sql();
2655 } elsif ( $params->{'magic'} eq 'suspended'
2656 || $params->{'status'} eq 'suspended' ) {
2658 push @where, FS::cust_pkg->suspended_sql();
2660 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2661 || $params->{'status'} =~ /^cancell?ed$/ ) {
2663 push @where, FS::cust_pkg->cancelled_sql();
2668 # parse package class
2671 #false lazinessish w/graph/cust_bill_pkg.cgi
2674 if ( exists($params->{'classnum'})
2675 && $params->{'classnum'} =~ /^(\d*)$/
2679 if ( $classnum ) { #a specific class
2680 push @where, "part_pkg.classnum = $classnum";
2682 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2683 #die "classnum $classnum not found!" unless $pkg_class[0];
2684 #$title .= $pkg_class[0]->classname.' ';
2686 } elsif ( $classnum eq '' ) { #the empty class
2688 push @where, "part_pkg.classnum IS NULL";
2689 #$title .= 'Empty class ';
2690 #@pkg_class = ( '(empty class)' );
2691 } elsif ( $classnum eq '0' ) {
2692 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2693 #push @pkg_class, '(empty class)';
2695 die "illegal classnum";
2701 # parse package report options
2704 my @report_option = ();
2705 if ( exists($params->{'report_option'})
2706 && $params->{'report_option'} =~ /^([,\d]*)$/
2709 @report_option = split(',', $1);
2712 if (@report_option) {
2713 # this will result in the empty set for the dangling comma case as it should
2715 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2716 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2717 AND optionname = 'report_option_$_'
2718 AND optionvalue = '1' )"
2728 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2734 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2740 if ( exists($params->{'censustract'}) ) {
2741 $params->{'censustract'} =~ /^([.\d]*)$/;
2742 my $censustract = "cust_main.censustract = '$1'";
2743 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2744 push @where, "( $censustract )";
2751 if ( ref($params->{'pkgpart'}) ) {
2754 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2755 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2756 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2757 @pkgpart = @{ $params->{'pkgpart'} };
2759 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2762 @pkgpart = grep /^(\d+)$/, @pkgpart;
2764 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2766 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2767 push @where, "pkgpart = $1";
2776 #false laziness w/report_cust_pkg.html
2779 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2780 'active' => { 'susp'=>1, 'cancel'=>1 },
2781 'suspended' => { 'cancel' => 1 },
2786 if( exists($params->{'active'} ) ) {
2787 # This overrides all the other date-related fields
2788 my($beginning, $ending) = @{$params->{'active'}};
2790 "cust_pkg.setup IS NOT NULL",
2791 "cust_pkg.setup <= $ending",
2792 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2793 "NOT (".FS::cust_pkg->onetime_sql . ")";
2796 foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
2798 next unless exists($params->{$field});
2800 my($beginning, $ending) = @{$params->{$field}};
2802 next if $beginning == 0 && $ending == 4294967295;
2805 "cust_pkg.$field IS NOT NULL",
2806 "cust_pkg.$field >= $beginning",
2807 "cust_pkg.$field <= $ending";
2809 $orderby ||= "ORDER BY cust_pkg.$field";
2814 $orderby ||= 'ORDER BY bill';
2817 # parse magic, legacy, etc.
2820 if ( $params->{'magic'} &&
2821 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2824 $orderby = 'ORDER BY pkgnum';
2826 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2827 push @where, "pkgpart = $1";
2830 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2832 $orderby = 'ORDER BY pkgnum';
2834 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2836 $orderby = 'ORDER BY pkgnum';
2839 SELECT count(*) FROM pkg_svc
2840 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2841 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2842 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2843 AND cust_svc.svcpart = pkg_svc.svcpart
2850 # setup queries, links, subs, etc. for the search
2853 # here is the agent virtualization
2854 if ($params->{CurrentUser}) {
2856 qsearchs('access_user', { username => $params->{CurrentUser} });
2859 push @where, $access_user->agentnums_sql('table'=>'cust_main');
2864 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
2867 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
2869 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
2870 'LEFT JOIN part_pkg USING ( pkgpart ) '.
2871 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
2873 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
2876 'table' => 'cust_pkg',
2878 'select' => join(', ',
2880 ( map "part_pkg.$_", qw( pkg freq ) ),
2881 'pkg_class.classname',
2882 'cust_main.custnum AS cust_main_custnum',
2883 FS::UI::Web::cust_sql_fields(
2884 $params->{'cust_fields'}
2887 'extra_sql' => "$extra_sql $orderby",
2888 'addl_from' => $addl_from,
2889 'count_query' => $count_query,
2896 Returns a list of two package counts. The first is a count of packages
2897 based on the supplied criteria and the second is the count of residential
2898 packages with those same criteria. Criteria are specified as in the search
2904 my ($class, $params) = @_;
2906 my $sql_query = $class->search( $params );
2908 my $count_sql = delete($sql_query->{'count_query'});
2909 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
2910 or die "couldn't parse count_sql";
2912 my $count_sth = dbh->prepare($count_sql)
2913 or die "Error preparing $count_sql: ". dbh->errstr;
2915 or die "Error executing $count_sql: ". $count_sth->errstr;
2916 my $count_arrayref = $count_sth->fetchrow_arrayref;
2918 return ( @$count_arrayref );
2925 Returns a list: the first item is an SQL fragment identifying matching
2926 packages/customers via location (taking into account shipping and package
2927 address taxation, if enabled), and subsequent items are the parameters to
2928 substitute for the placeholders in that fragment.
2933 my($class, %opt) = @_;
2934 my $ornull = $opt{'ornull'};
2936 my $conf = new FS::Conf;
2938 # '?' placeholders in _location_sql_where
2939 my $x = $ornull ? 3 : 2;
2940 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
2944 if ( $conf->exists('tax-ship_address') ) {
2947 ( ( ship_last IS NULL OR ship_last = '' )
2948 AND ". _location_sql_where('cust_main', '', $ornull ). "
2950 OR ( ship_last IS NOT NULL AND ship_last != ''
2951 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
2954 # AND payby != 'COMP'
2956 @main_param = ( @bill_param, @bill_param );
2960 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
2961 @main_param = @bill_param;
2967 if ( $conf->exists('tax-pkg_address') ) {
2969 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
2972 ( cust_pkg.locationnum IS NULL AND $main_where )
2973 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
2976 @param = ( @main_param, @bill_param );
2980 $where = $main_where;
2981 @param = @main_param;
2989 #subroutine, helper for location_sql
2990 sub _location_sql_where {
2992 my $prefix = @_ ? shift : '';
2993 my $ornull = @_ ? shift : '';
2995 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
2997 $ornull = $ornull ? ' OR ? IS NULL ' : '';
2999 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3000 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3001 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3003 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3005 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3006 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3007 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3008 AND $table.${prefix}country = ?
3016 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3018 CUSTNUM is a customer (see L<FS::cust_main>)
3020 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3021 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3024 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3025 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3026 new billing items. An error is returned if this is not possible (see
3027 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3030 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3031 newly-created cust_pkg objects.
3033 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3034 and inserted. Multiple FS::pkg_referral records can be created by
3035 setting I<refnum> to an array reference of refnums or a hash reference with
3036 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3037 record will be created corresponding to cust_main.refnum.
3042 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3044 my $conf = new FS::Conf;
3046 # Transactionize this whole mess
3047 local $SIG{HUP} = 'IGNORE';
3048 local $SIG{INT} = 'IGNORE';
3049 local $SIG{QUIT} = 'IGNORE';
3050 local $SIG{TERM} = 'IGNORE';
3051 local $SIG{TSTP} = 'IGNORE';
3052 local $SIG{PIPE} = 'IGNORE';
3054 my $oldAutoCommit = $FS::UID::AutoCommit;
3055 local $FS::UID::AutoCommit = 0;
3059 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3060 # return "Customer not found: $custnum" unless $cust_main;
3062 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3065 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3068 my $change = scalar(@old_cust_pkg) != 0;
3071 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3073 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3074 " to pkgpart ". $pkgparts->[0]. "\n"
3077 my $err_or_cust_pkg =
3078 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3079 'refnum' => $refnum,
3082 unless (ref($err_or_cust_pkg)) {
3083 $dbh->rollback if $oldAutoCommit;
3084 return $err_or_cust_pkg;
3087 push @$return_cust_pkg, $err_or_cust_pkg;
3088 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3093 # Create the new packages.
3094 foreach my $pkgpart (@$pkgparts) {
3096 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3098 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3099 pkgpart => $pkgpart,
3103 $error = $cust_pkg->insert( 'change' => $change );
3105 $dbh->rollback if $oldAutoCommit;
3108 push @$return_cust_pkg, $cust_pkg;
3110 # $return_cust_pkg now contains refs to all of the newly
3113 # Transfer services and cancel old packages.
3114 foreach my $old_pkg (@old_cust_pkg) {
3116 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3119 foreach my $new_pkg (@$return_cust_pkg) {
3120 $error = $old_pkg->transfer($new_pkg);
3121 if ($error and $error == 0) {
3122 # $old_pkg->transfer failed.
3123 $dbh->rollback if $oldAutoCommit;
3128 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3129 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3130 foreach my $new_pkg (@$return_cust_pkg) {
3131 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3132 if ($error and $error == 0) {
3133 # $old_pkg->transfer failed.
3134 $dbh->rollback if $oldAutoCommit;
3141 # Transfers were successful, but we went through all of the
3142 # new packages and still had services left on the old package.
3143 # We can't cancel the package under the circumstances, so abort.
3144 $dbh->rollback if $oldAutoCommit;
3145 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3147 $error = $old_pkg->cancel( quiet=>1 );
3153 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3157 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3159 A bulk change method to change packages for multiple customers.
3161 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3162 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3165 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3166 replace. The services (see L<FS::cust_svc>) are moved to the
3167 new billing items. An error is returned if this is not possible (see
3170 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3171 newly-created cust_pkg objects.
3176 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3178 # Transactionize this whole mess
3179 local $SIG{HUP} = 'IGNORE';
3180 local $SIG{INT} = 'IGNORE';
3181 local $SIG{QUIT} = 'IGNORE';
3182 local $SIG{TERM} = 'IGNORE';
3183 local $SIG{TSTP} = 'IGNORE';
3184 local $SIG{PIPE} = 'IGNORE';
3186 my $oldAutoCommit = $FS::UID::AutoCommit;
3187 local $FS::UID::AutoCommit = 0;
3191 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3194 while(scalar(@old_cust_pkg)) {
3196 my $custnum = $old_cust_pkg[0]->custnum;
3197 my (@remove) = map { $_->pkgnum }
3198 grep { $_->custnum == $custnum } @old_cust_pkg;
3199 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3201 my $error = order $custnum, $pkgparts, \@remove, \@return;
3203 push @errors, $error
3205 push @$return_cust_pkg, @return;
3208 if (scalar(@errors)) {
3209 $dbh->rollback if $oldAutoCommit;
3210 return join(' / ', @errors);
3213 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3217 # Used by FS::Upgrade to migrate to a new database.
3218 sub _upgrade_data { # class method
3219 my ($class, %opts) = @_;
3220 $class->_upgrade_otaker(%opts);
3227 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3229 In sub order, the @pkgparts array (passed by reference) is clobbered.
3231 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3232 method to pass dates to the recur_prog expression, it should do so.
3234 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3235 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3236 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3237 configuration values. Probably need a subroutine which decides what to do
3238 based on whether or not we've fetched the user yet, rather than a hash. See
3239 FS::UID and the TODO.
3241 Now that things are transactional should the check in the insert method be
3246 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3247 L<FS::pkg_svc>, schema.html from the base documentation