4 use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin
5 FS::m2m_Common FS::option_Common );
6 use vars qw($disable_agentcheck $DEBUG $me);
8 use Scalar::Util qw( blessed );
9 use List::Util qw(max);
11 use Time::Local qw( timelocal_nocheck );
13 use FS::UID qw( getotaker dbh );
14 use FS::Misc qw( send_email );
15 use FS::Record qw( qsearch qsearchs );
20 use FS::cust_location;
22 use FS::cust_bill_pkg;
23 use FS::cust_pkg_detail;
28 use FS::cust_pkg_reason;
30 use FS::cust_pkg_discount;
34 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
36 # because they load configuration by setting FS::UID::callback (see TODO)
42 # for sending cancel emails in sub cancel
46 $me = '[FS::cust_pkg]';
48 $disable_agentcheck = 0;
52 my ( $hashref, $cache ) = @_;
53 #if ( $hashref->{'pkgpart'} ) {
54 if ( $hashref->{'pkg'} ) {
55 # #@{ $self->{'_pkgnum'} } = ();
56 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
57 # $self->{'_pkgpart'} = $subcache;
58 # #push @{ $self->{'_pkgnum'} },
59 # FS::part_pkg->new_or_cached($hashref, $subcache);
60 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
62 if ( exists $hashref->{'svcnum'} ) {
63 #@{ $self->{'_pkgnum'} } = ();
64 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
65 $self->{'_svcnum'} = $subcache;
66 #push @{ $self->{'_pkgnum'} },
67 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
73 FS::cust_pkg - Object methods for cust_pkg objects
79 $record = new FS::cust_pkg \%hash;
80 $record = new FS::cust_pkg { 'column' => 'value' };
82 $error = $record->insert;
84 $error = $new_record->replace($old_record);
86 $error = $record->delete;
88 $error = $record->check;
90 $error = $record->cancel;
92 $error = $record->suspend;
94 $error = $record->unsuspend;
96 $part_pkg = $record->part_pkg;
98 @labels = $record->labels;
100 $seconds = $record->seconds_since($timestamp);
102 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
103 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
107 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
108 inherits from FS::Record. The following fields are currently supported:
114 Primary key (assigned automatically for new billing items)
118 Customer (see L<FS::cust_main>)
122 Billing item definition (see L<FS::part_pkg>)
126 Optional link to package location (see L<FS::location>)
138 date (next bill date)
166 order taker (see L<FS::access_user>)
170 If this field is set to 1, disables the automatic
171 unsuspension of this package when using the B<unsuspendauto> config option.
175 If not set, defaults to 1
179 Date of change from previous package
189 =item change_locationnum
195 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
196 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
197 L<Time::Local> and L<Date::Parse> for conversion functions.
205 Create a new billing item. To add the item to the database, see L<"insert">.
209 sub table { 'cust_pkg'; }
210 sub cust_linked { $_[0]->cust_main_custnum; }
211 sub cust_unlinked_msg {
213 "WARNING: can't find cust_main.custnum ". $self->custnum.
214 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
217 =item insert [ OPTION => VALUE ... ]
219 Adds this billing item to the database ("Orders" the item). If there is an
220 error, returns the error, otherwise returns false.
222 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
223 will be used to look up the package definition and agent restrictions will be
226 If the additional field I<refnum> is defined, an FS::pkg_referral record will
227 be created and inserted. Multiple FS::pkg_referral records can be created by
228 setting I<refnum> to an array reference of refnums or a hash reference with
229 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
230 record will be created corresponding to cust_main.refnum.
232 The following options are available:
238 If set true, supresses any referral credit to a referring customer.
242 cust_pkg_option records will be created
246 a ticket will be added to this customer with this subject
250 an optional queue name for ticket additions
257 my( $self, %options ) = @_;
259 if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) {
260 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
261 $mon += 1 unless $mday == 1;
262 until ( $mon < 12 ) { $mon -= 12; $year++; }
263 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
266 foreach my $action ( qw(expire adjourn contract_end) ) {
267 my $months = $self->part_pkg->option("${action}_months",1);
268 if($months and !$self->$action) {
269 my $start = $self->start_date || $self->setup || time;
270 $self->$action( $self->part_pkg->add_freq($start, $months) );
274 local $SIG{HUP} = 'IGNORE';
275 local $SIG{INT} = 'IGNORE';
276 local $SIG{QUIT} = 'IGNORE';
277 local $SIG{TERM} = 'IGNORE';
278 local $SIG{TSTP} = 'IGNORE';
279 local $SIG{PIPE} = 'IGNORE';
281 my $oldAutoCommit = $FS::UID::AutoCommit;
282 local $FS::UID::AutoCommit = 0;
285 my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
287 $dbh->rollback if $oldAutoCommit;
291 $self->refnum($self->cust_main->refnum) unless $self->refnum;
292 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
293 $self->process_m2m( 'link_table' => 'pkg_referral',
294 'target_table' => 'part_referral',
295 'params' => $self->refnum,
298 if ( $self->discountnum ) {
299 my $error = $self->insert_discount();
301 $dbh->rollback if $oldAutoCommit;
306 #if ( $self->reg_code ) {
307 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
308 # $error = $reg_code->delete;
310 # $dbh->rollback if $oldAutoCommit;
315 my $conf = new FS::Conf;
317 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
320 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
327 use FS::TicketSystem;
328 FS::TicketSystem->init();
330 my $q = new RT::Queue($RT::SystemUser);
331 $q->Load($options{ticket_queue}) if $options{ticket_queue};
332 my $t = new RT::Ticket($RT::SystemUser);
333 my $mime = new MIME::Entity;
334 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
335 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
336 Subject => $options{ticket_subject},
339 $t->AddLink( Type => 'MemberOf',
340 Target => 'freeside://freeside/cust_main/'. $self->custnum,
344 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
345 my $queue = new FS::queue {
346 'job' => 'FS::cust_main::queueable_print',
348 $error = $queue->insert(
349 'custnum' => $self->custnum,
350 'template' => 'welcome_letter',
354 warn "can't send welcome letter: $error";
359 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
366 This method now works but you probably shouldn't use it.
368 You don't want to delete billing items, because there would then be no record
369 the customer ever purchased the item. Instead, see the cancel method.
374 # return "Can't delete cust_pkg records!";
377 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
379 Replaces the OLD_RECORD with this one in the database. If there is an error,
380 returns the error, otherwise returns false.
382 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
384 Changing pkgpart may have disasterous effects. See the order subroutine.
386 setup and bill are normally updated by calling the bill method of a customer
387 object (see L<FS::cust_main>).
389 suspend is normally updated by the suspend and unsuspend methods.
391 cancel is normally updated by the cancel method (and also the order subroutine
394 Available options are:
400 can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
404 the access_user (see L<FS::access_user>) providing the reason
408 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
417 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
422 ( ref($_[0]) eq 'HASH' )
426 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
427 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
430 #return "Can't change setup once it exists!"
431 # if $old->getfield('setup') &&
432 # $old->getfield('setup') != $new->getfield('setup');
434 #some logic for bill, susp, cancel?
436 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
438 local $SIG{HUP} = 'IGNORE';
439 local $SIG{INT} = 'IGNORE';
440 local $SIG{QUIT} = 'IGNORE';
441 local $SIG{TERM} = 'IGNORE';
442 local $SIG{TSTP} = 'IGNORE';
443 local $SIG{PIPE} = 'IGNORE';
445 my $oldAutoCommit = $FS::UID::AutoCommit;
446 local $FS::UID::AutoCommit = 0;
449 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
450 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
451 my $error = $new->insert_reason(
452 'reason' => $options->{'reason'},
453 'date' => $new->$method,
455 'reason_otaker' => $options->{'reason_otaker'},
458 dbh->rollback if $oldAutoCommit;
459 return "Error inserting cust_pkg_reason: $error";
464 #save off and freeze RADIUS attributes for any associated svc_acct records
466 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
468 #also check for specific exports?
469 # to avoid spurious modify export events
470 @svc_acct = map { $_->svc_x }
471 grep { $_->part_svc->svcdb eq 'svc_acct' }
474 $_->snapshot foreach @svc_acct;
478 my $error = $new->SUPER::replace($old,
479 $options->{options} ? $options->{options} : ()
482 $dbh->rollback if $oldAutoCommit;
486 #for prepaid packages,
487 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
488 foreach my $old_svc_acct ( @svc_acct ) {
489 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
490 my $s_error = $new_svc_acct->replace($old_svc_acct);
492 $dbh->rollback if $oldAutoCommit;
497 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
504 Checks all fields to make sure this is a valid billing item. If there is an
505 error, returns the error, otherwise returns false. Called by the insert and
513 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
516 $self->ut_numbern('pkgnum')
517 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
518 || $self->ut_numbern('pkgpart')
519 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
520 || $self->ut_numbern('start_date')
521 || $self->ut_numbern('setup')
522 || $self->ut_numbern('bill')
523 || $self->ut_numbern('susp')
524 || $self->ut_numbern('cancel')
525 || $self->ut_numbern('adjourn')
526 || $self->ut_numbern('expire')
527 || $self->ut_enum('no_auto', [ '', 'Y' ])
529 return $error if $error;
531 if ( $self->reg_code ) {
533 unless ( grep { $self->pkgpart == $_->pkgpart }
534 map { $_->reg_code_pkg }
535 qsearchs( 'reg_code', { 'code' => $self->reg_code,
536 'agentnum' => $self->cust_main->agentnum })
538 return "Unknown registration code";
541 } elsif ( $self->promo_code ) {
544 qsearchs('part_pkg', {
545 'pkgpart' => $self->pkgpart,
546 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
548 return 'Unknown promotional code' unless $promo_part_pkg;
552 unless ( $disable_agentcheck ) {
554 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
555 return "agent ". $agent->agentnum. ':'. $agent->agent.
556 " can't purchase pkgpart ". $self->pkgpart
557 unless $agent->pkgpart_hashref->{ $self->pkgpart }
558 || $agent->agentnum == $self->part_pkg->agentnum;
561 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
562 return $error if $error;
566 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
568 if ( $self->dbdef_table->column('manual_flag') ) {
569 $self->manual_flag('') if $self->manual_flag eq ' ';
570 $self->manual_flag =~ /^([01]?)$/
571 or return "Illegal manual_flag ". $self->manual_flag;
572 $self->manual_flag($1);
578 =item cancel [ OPTION => VALUE ... ]
580 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
581 in this package, then cancels the package itself (sets the cancel field to
584 Available options are:
588 =item quiet - can be set true to supress email cancellation notices.
590 =item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
592 =item reason - can be set to a cancellation reason (see L<FS:reason>), either a reasonnum of an existing reason, or passing a hashref will create a new reason. The hashref should have the following keys: typenum - Reason type (see L<FS::reason_type>, reason - Text of the new reason.
594 =item date - can be set to a unix style timestamp to specify when to cancel (expire)
596 =item nobill - can be set true to skip billing if it might otherwise be done.
600 If there is an error, returns the error, otherwise returns false.
605 my( $self, %options ) = @_;
608 my $conf = new FS::Conf;
610 warn "cust_pkg::cancel called with options".
611 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
614 local $SIG{HUP} = 'IGNORE';
615 local $SIG{INT} = 'IGNORE';
616 local $SIG{QUIT} = 'IGNORE';
617 local $SIG{TERM} = 'IGNORE';
618 local $SIG{TSTP} = 'IGNORE';
619 local $SIG{PIPE} = 'IGNORE';
621 my $oldAutoCommit = $FS::UID::AutoCommit;
622 local $FS::UID::AutoCommit = 0;
625 my $old = $self->select_for_update;
627 if ( $old->get('cancel') || $self->get('cancel') ) {
628 dbh->rollback if $oldAutoCommit;
629 return ""; # no error
632 my $date = $options{date} if $options{date}; # expire/cancel later
633 $date = '' if ($date && $date <= time); # complain instead?
635 #race condition: usage could be ongoing until unprovisioned
636 #resolved by performing a change package instead (which unprovisions) and
638 if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) {
639 my $copy = $self->new({$self->hash});
641 $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 );
642 warn "Error billing during cancel, custnum ".
643 #$self->cust_main->custnum. ": $error"
649 my $cancel_time = $options{'time'} || time;
651 if ( $options{'reason'} ) {
652 $error = $self->insert_reason( 'reason' => $options{'reason'},
653 'action' => $date ? 'expire' : 'cancel',
654 'date' => $date ? $date : $cancel_time,
655 'reason_otaker' => $options{'reason_otaker'},
658 dbh->rollback if $oldAutoCommit;
659 return "Error inserting cust_pkg_reason: $error";
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( ('date' => $date) );
677 $dbh->rollback if $oldAutoCommit;
678 return "Error expiring cust_svc: $error";
683 foreach my $cust_svc (
686 sort { $a->[1] <=> $b->[1] }
687 map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
688 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
691 my $error = $cust_svc->cancel;
694 $dbh->rollback if $oldAutoCommit;
695 return "Error cancelling cust_svc: $error";
699 # Add a credit for remaining service
700 my $remaining_value = $self->calc_remain(time=>$cancel_time);
701 if ( $remaining_value > 0 && !$options{'no_credit'} ) {
702 my $error = $self->cust_main->credit(
704 'Credit for unused time on '. $self->part_pkg->pkg,
705 'reason_type' => $conf->config('cancel_credit_type'),
708 $dbh->rollback if $oldAutoCommit;
709 return "Error crediting customer \$$remaining_value for unused time on".
710 $self->part_pkg->pkg. ": $error";
715 my %hash = $self->hash;
716 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
717 my $new = new FS::cust_pkg ( \%hash );
718 $error = $new->replace( $self, options => { $self->options } );
720 $dbh->rollback if $oldAutoCommit;
724 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
725 return '' if $date; #no errors
727 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
728 if ( !$options{'quiet'} &&
729 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
731 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
734 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
735 $error = $msg_template->send( 'cust_main' => $self->cust_main,
740 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
741 'to' => \@invoicing_list,
742 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
743 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
746 #should this do something on errors?
753 =item cancel_if_expired [ NOW_TIMESTAMP ]
755 Cancels this package if its expire date has been reached.
759 sub cancel_if_expired {
761 my $time = shift || time;
762 return '' unless $self->expire && $self->expire <= $time;
763 my $error = $self->cancel;
765 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
766 $self->custnum. ": $error";
773 Cancels any pending expiration (sets the expire field to null).
775 If there is an error, returns the error, otherwise returns false.
780 my( $self, %options ) = @_;
783 local $SIG{HUP} = 'IGNORE';
784 local $SIG{INT} = 'IGNORE';
785 local $SIG{QUIT} = 'IGNORE';
786 local $SIG{TERM} = 'IGNORE';
787 local $SIG{TSTP} = 'IGNORE';
788 local $SIG{PIPE} = 'IGNORE';
790 my $oldAutoCommit = $FS::UID::AutoCommit;
791 local $FS::UID::AutoCommit = 0;
794 my $old = $self->select_for_update;
796 my $pkgnum = $old->pkgnum;
797 if ( $old->get('cancel') || $self->get('cancel') ) {
798 dbh->rollback if $oldAutoCommit;
799 return "Can't unexpire cancelled package $pkgnum";
800 # or at least it's pointless
803 unless ( $old->get('expire') && $self->get('expire') ) {
804 dbh->rollback if $oldAutoCommit;
805 return ""; # no error
808 my %hash = $self->hash;
809 $hash{'expire'} = '';
810 my $new = new FS::cust_pkg ( \%hash );
811 $error = $new->replace( $self, options => { $self->options } );
813 $dbh->rollback if $oldAutoCommit;
817 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
823 =item suspend [ OPTION => VALUE ... ]
825 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
826 package, then suspends the package itself (sets the susp field to now).
828 Available options are:
832 =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.
834 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
838 If there is an error, returns the error, otherwise returns false.
843 my( $self, %options ) = @_;
846 local $SIG{HUP} = 'IGNORE';
847 local $SIG{INT} = 'IGNORE';
848 local $SIG{QUIT} = 'IGNORE';
849 local $SIG{TERM} = 'IGNORE';
850 local $SIG{TSTP} = 'IGNORE';
851 local $SIG{PIPE} = 'IGNORE';
853 my $oldAutoCommit = $FS::UID::AutoCommit;
854 local $FS::UID::AutoCommit = 0;
857 my $old = $self->select_for_update;
859 my $pkgnum = $old->pkgnum;
860 if ( $old->get('cancel') || $self->get('cancel') ) {
861 dbh->rollback if $oldAutoCommit;
862 return "Can't suspend cancelled package $pkgnum";
865 if ( $old->get('susp') || $self->get('susp') ) {
866 dbh->rollback if $oldAutoCommit;
867 return ""; # no error # complain on adjourn?
870 my $date = $options{date} if $options{date}; # adjourn/suspend later
871 $date = '' if ($date && $date <= time); # complain instead?
873 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
874 dbh->rollback if $oldAutoCommit;
875 return "Package $pkgnum expires before it would be suspended.";
878 my $suspend_time = $options{'time'} || time;
880 if ( $options{'reason'} ) {
881 $error = $self->insert_reason( 'reason' => $options{'reason'},
882 'action' => $date ? 'adjourn' : 'suspend',
883 'date' => $date ? $date : $suspend_time,
884 'reason_otaker' => $options{'reason_otaker'},
887 dbh->rollback if $oldAutoCommit;
888 return "Error inserting cust_pkg_reason: $error";
896 foreach my $cust_svc (
897 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
899 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
901 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
902 $dbh->rollback if $oldAutoCommit;
903 return "Illegal svcdb value in part_svc!";
906 require "FS/$svcdb.pm";
908 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
910 $error = $svc->suspend;
912 $dbh->rollback if $oldAutoCommit;
915 my( $label, $value ) = $cust_svc->label;
916 push @labels, "$label: $value";
920 my $conf = new FS::Conf;
921 if ( $conf->config('suspend_email_admin') ) {
923 my $error = send_email(
924 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
925 #invoice_from ??? well as good as any
926 'to' => $conf->config('suspend_email_admin'),
927 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
929 "This is an automatic message from your Freeside installation\n",
930 "informing you that the following customer package has been suspended:\n",
932 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
933 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
934 ( map { "Service : $_\n" } @labels ),
939 warn "WARNING: can't send suspension admin email (suspending anyway): ".
947 my %hash = $self->hash;
949 $hash{'adjourn'} = $date;
951 $hash{'susp'} = $suspend_time;
953 my $new = new FS::cust_pkg ( \%hash );
954 $error = $new->replace( $self, options => { $self->options } );
956 $dbh->rollback if $oldAutoCommit;
960 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
965 =item unsuspend [ OPTION => VALUE ... ]
967 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
968 package, then unsuspends the package itself (clears the susp field and the
969 adjourn field if it is in the past).
971 Available options are:
975 =item adjust_next_bill
977 Can be set true to adjust the next bill date forward by
978 the amount of time the account was inactive. This was set true by default
979 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
980 explicitly requested. Price plans for which this makes sense (anniversary-date
981 based than prorate or subscription) could have an option to enable this
986 If there is an error, returns the error, otherwise returns false.
991 my( $self, %opt ) = @_;
994 local $SIG{HUP} = 'IGNORE';
995 local $SIG{INT} = 'IGNORE';
996 local $SIG{QUIT} = 'IGNORE';
997 local $SIG{TERM} = 'IGNORE';
998 local $SIG{TSTP} = 'IGNORE';
999 local $SIG{PIPE} = 'IGNORE';
1001 my $oldAutoCommit = $FS::UID::AutoCommit;
1002 local $FS::UID::AutoCommit = 0;
1005 my $old = $self->select_for_update;
1007 my $pkgnum = $old->pkgnum;
1008 if ( $old->get('cancel') || $self->get('cancel') ) {
1009 dbh->rollback if $oldAutoCommit;
1010 return "Can't unsuspend cancelled package $pkgnum";
1013 unless ( $old->get('susp') && $self->get('susp') ) {
1014 dbh->rollback if $oldAutoCommit;
1015 return ""; # no error # complain instead?
1018 foreach my $cust_svc (
1019 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1021 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1023 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1024 $dbh->rollback if $oldAutoCommit;
1025 return "Illegal svcdb value in part_svc!";
1028 require "FS/$svcdb.pm";
1030 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1032 $error = $svc->unsuspend;
1034 $dbh->rollback if $oldAutoCommit;
1041 my %hash = $self->hash;
1042 my $inactive = time - $hash{'susp'};
1044 my $conf = new FS::Conf;
1046 if ( $inactive > 0 &&
1047 ( $hash{'bill'} || $hash{'setup'} ) &&
1048 ( $opt{'adjust_next_bill'} ||
1049 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1050 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1053 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1058 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1059 my $new = new FS::cust_pkg ( \%hash );
1060 $error = $new->replace( $self, options => { $self->options } );
1062 $dbh->rollback if $oldAutoCommit;
1066 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1073 Cancels any pending suspension (sets the adjourn field to null).
1075 If there is an error, returns the error, otherwise returns false.
1080 my( $self, %options ) = @_;
1083 local $SIG{HUP} = 'IGNORE';
1084 local $SIG{INT} = 'IGNORE';
1085 local $SIG{QUIT} = 'IGNORE';
1086 local $SIG{TERM} = 'IGNORE';
1087 local $SIG{TSTP} = 'IGNORE';
1088 local $SIG{PIPE} = 'IGNORE';
1090 my $oldAutoCommit = $FS::UID::AutoCommit;
1091 local $FS::UID::AutoCommit = 0;
1094 my $old = $self->select_for_update;
1096 my $pkgnum = $old->pkgnum;
1097 if ( $old->get('cancel') || $self->get('cancel') ) {
1098 dbh->rollback if $oldAutoCommit;
1099 return "Can't unadjourn cancelled package $pkgnum";
1100 # or at least it's pointless
1103 if ( $old->get('susp') || $self->get('susp') ) {
1104 dbh->rollback if $oldAutoCommit;
1105 return "Can't unadjourn suspended package $pkgnum";
1106 # perhaps this is arbitrary
1109 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1110 dbh->rollback if $oldAutoCommit;
1111 return ""; # no error
1114 my %hash = $self->hash;
1115 $hash{'adjourn'} = '';
1116 my $new = new FS::cust_pkg ( \%hash );
1117 $error = $new->replace( $self, options => { $self->options } );
1119 $dbh->rollback if $oldAutoCommit;
1123 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1130 =item change HASHREF | OPTION => VALUE ...
1132 Changes this package: cancels it and creates a new one, with a different
1133 pkgpart or locationnum or both. All services are transferred to the new
1134 package (no change will be made if this is not possible).
1136 Options may be passed as a list of key/value pairs or as a hash reference.
1143 New locationnum, to change the location for this package.
1147 New FS::cust_location object, to create a new location and assign it
1152 New pkgpart (see L<FS::part_pkg>).
1156 New refnum (see L<FS::part_referral>).
1160 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1161 susp, adjourn, cancel, expire, and contract_end) to the new package.
1165 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1166 (otherwise, what's the point?)
1168 Returns either the new FS::cust_pkg object or a scalar error.
1172 my $err_or_new_cust_pkg = $old_cust_pkg->change
1176 #some false laziness w/order
1179 my $opt = ref($_[0]) ? shift : { @_ };
1181 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1184 my $conf = new FS::Conf;
1186 # Transactionize this whole mess
1187 local $SIG{HUP} = 'IGNORE';
1188 local $SIG{INT} = 'IGNORE';
1189 local $SIG{QUIT} = 'IGNORE';
1190 local $SIG{TERM} = 'IGNORE';
1191 local $SIG{TSTP} = 'IGNORE';
1192 local $SIG{PIPE} = 'IGNORE';
1194 my $oldAutoCommit = $FS::UID::AutoCommit;
1195 local $FS::UID::AutoCommit = 0;
1204 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1206 #$hash{$_} = $self->$_() foreach qw( setup );
1208 $hash{'setup'} = $time if $self->setup;
1210 $hash{'change_date'} = $time;
1211 $hash{"change_$_"} = $self->$_()
1212 foreach qw( pkgnum pkgpart locationnum );
1214 if ( $opt->{'cust_location'} &&
1215 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1216 $error = $opt->{'cust_location'}->insert;
1218 $dbh->rollback if $oldAutoCommit;
1219 return "inserting cust_location (transaction rolled back): $error";
1221 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1224 if ( $opt->{'keep_dates'} ) {
1225 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1226 start_date contract_end ) ) {
1227 $hash{$date} = $self->getfield($date);
1231 # Create the new package.
1232 my $cust_pkg = new FS::cust_pkg {
1233 custnum => $self->custnum,
1234 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1235 refnum => ( $opt->{'refnum'} || $self->refnum ),
1236 locationnum => ( $opt->{'locationnum'} || $self->locationnum ),
1240 $error = $cust_pkg->insert( 'change' => 1 );
1242 $dbh->rollback if $oldAutoCommit;
1246 # Transfer services and cancel old package.
1248 $error = $self->transfer($cust_pkg);
1249 if ($error and $error == 0) {
1250 # $old_pkg->transfer failed.
1251 $dbh->rollback if $oldAutoCommit;
1255 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1256 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1257 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1258 if ($error and $error == 0) {
1259 # $old_pkg->transfer failed.
1260 $dbh->rollback if $oldAutoCommit;
1266 # Transfers were successful, but we still had services left on the old
1267 # package. We can't change the package under this circumstances, so abort.
1268 $dbh->rollback if $oldAutoCommit;
1269 return "Unable to transfer all services from package ". $self->pkgnum;
1272 #reset usage if changing pkgpart
1273 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1274 if ($self->pkgpart != $cust_pkg->pkgpart) {
1275 my $part_pkg = $cust_pkg->part_pkg;
1276 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1280 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1283 $dbh->rollback if $oldAutoCommit;
1284 return "Error setting usage values: $error";
1288 #Good to go, cancel old package.
1289 $error = $self->cancel( quiet=>1 );
1291 $dbh->rollback if $oldAutoCommit;
1295 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1297 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1299 $dbh->rollback if $oldAutoCommit;
1304 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1311 use Storable 'thaw';
1313 sub process_bulk_cust_pkg {
1315 my $param = thaw(decode_base64(shift));
1316 warn Dumper($param) if $DEBUG;
1318 my $old_part_pkg = qsearchs('part_pkg',
1319 { pkgpart => $param->{'old_pkgpart'} });
1320 my $new_part_pkg = qsearchs('part_pkg',
1321 { pkgpart => $param->{'new_pkgpart'} });
1322 die "Must select a new package type\n" unless $new_part_pkg;
1323 #my $keep_dates = $param->{'keep_dates'} || 0;
1324 my $keep_dates = 1; # there is no good reason to turn this off
1326 local $SIG{HUP} = 'IGNORE';
1327 local $SIG{INT} = 'IGNORE';
1328 local $SIG{QUIT} = 'IGNORE';
1329 local $SIG{TERM} = 'IGNORE';
1330 local $SIG{TSTP} = 'IGNORE';
1331 local $SIG{PIPE} = 'IGNORE';
1333 my $oldAutoCommit = $FS::UID::AutoCommit;
1334 local $FS::UID::AutoCommit = 0;
1337 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1340 foreach my $old_cust_pkg ( @cust_pkgs ) {
1342 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1343 if ( $old_cust_pkg->getfield('cancel') ) {
1344 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1345 $old_cust_pkg->pkgnum."\n"
1349 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1351 my $error = $old_cust_pkg->change(
1352 'pkgpart' => $param->{'new_pkgpart'},
1353 'keep_dates' => $keep_dates
1355 if ( !ref($error) ) { # change returns the cust_pkg on success
1357 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1360 $dbh->commit if $oldAutoCommit;
1366 Returns the last bill date, or if there is no last bill date, the setup date.
1367 Useful for billing metered services.
1373 return $self->setfield('last_bill', $_[0]) if @_;
1374 return $self->getfield('last_bill') if $self->getfield('last_bill');
1375 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1376 'edate' => $self->bill, } );
1377 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1380 =item last_cust_pkg_reason ACTION
1382 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1383 Returns false if there is no reason or the package is not currenly ACTION'd
1384 ACTION is one of adjourn, susp, cancel, or expire.
1388 sub last_cust_pkg_reason {
1389 my ( $self, $action ) = ( shift, shift );
1390 my $date = $self->get($action);
1392 'table' => 'cust_pkg_reason',
1393 'hashref' => { 'pkgnum' => $self->pkgnum,
1394 'action' => substr(uc($action), 0, 1),
1397 'order_by' => 'ORDER BY num DESC LIMIT 1',
1401 =item last_reason ACTION
1403 Returns the most recent ACTION FS::reason associated with the package.
1404 Returns false if there is no reason or the package is not currenly ACTION'd
1405 ACTION is one of adjourn, susp, cancel, or expire.
1410 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1411 $cust_pkg_reason->reason
1412 if $cust_pkg_reason;
1417 Returns the definition for this billing item, as an FS::part_pkg object (see
1424 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1425 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1426 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1431 Returns the cancelled package this package was changed from, if any.
1437 return '' unless $self->change_pkgnum;
1438 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1443 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1450 $self->part_pkg->calc_setup($self, @_);
1455 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1462 $self->part_pkg->calc_recur($self, @_);
1467 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1474 $self->part_pkg->base_recur($self, @_);
1479 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1486 $self->part_pkg->calc_remain($self, @_);
1491 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1498 $self->part_pkg->calc_cancel($self, @_);
1503 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1509 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1512 =item cust_pkg_detail [ DETAILTYPE ]
1514 Returns any customer package details for this package (see
1515 L<FS::cust_pkg_detail>).
1517 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1521 sub cust_pkg_detail {
1523 my %hash = ( 'pkgnum' => $self->pkgnum );
1524 $hash{detailtype} = shift if @_;
1526 'table' => 'cust_pkg_detail',
1527 'hashref' => \%hash,
1528 'order_by' => 'ORDER BY weight, pkgdetailnum',
1532 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1534 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1536 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1538 If there is an error, returns the error, otherwise returns false.
1542 sub set_cust_pkg_detail {
1543 my( $self, $detailtype, @details ) = @_;
1545 local $SIG{HUP} = 'IGNORE';
1546 local $SIG{INT} = 'IGNORE';
1547 local $SIG{QUIT} = 'IGNORE';
1548 local $SIG{TERM} = 'IGNORE';
1549 local $SIG{TSTP} = 'IGNORE';
1550 local $SIG{PIPE} = 'IGNORE';
1552 my $oldAutoCommit = $FS::UID::AutoCommit;
1553 local $FS::UID::AutoCommit = 0;
1556 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1557 my $error = $current->delete;
1559 $dbh->rollback if $oldAutoCommit;
1560 return "error removing old detail: $error";
1564 foreach my $detail ( @details ) {
1565 my $cust_pkg_detail = new FS::cust_pkg_detail {
1566 'pkgnum' => $self->pkgnum,
1567 'detailtype' => $detailtype,
1568 'detail' => $detail,
1570 my $error = $cust_pkg_detail->insert;
1572 $dbh->rollback if $oldAutoCommit;
1573 return "error adding new detail: $error";
1578 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1585 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1589 #false laziness w/cust_bill.pm
1593 'table' => 'cust_event',
1594 'addl_from' => 'JOIN part_event USING ( eventpart )',
1595 'hashref' => { 'tablenum' => $self->pkgnum },
1596 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1600 =item num_cust_event
1602 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1606 #false laziness w/cust_bill.pm
1607 sub num_cust_event {
1610 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1611 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1612 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1613 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1614 $sth->fetchrow_arrayref->[0];
1617 =item cust_svc [ SVCPART ]
1619 Returns the services for this package, as FS::cust_svc objects (see
1620 L<FS::cust_svc>). If a svcpart is specified, return only the matching
1628 return () unless $self->num_cust_svc(@_);
1631 return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum,
1632 'svcpart' => shift, } );
1635 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1637 #if ( $self->{'_svcnum'} ) {
1638 # values %{ $self->{'_svcnum'}->cache };
1640 $self->_sort_cust_svc(
1641 [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ]
1647 =item overlimit [ SVCPART ]
1649 Returns the services for this package which have exceeded their
1650 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1651 is specified, return only the matching services.
1657 return () unless $self->num_cust_svc(@_);
1658 grep { $_->overlimit } $self->cust_svc(@_);
1661 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1663 Returns historical services for this package created before END TIMESTAMP and
1664 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1665 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
1666 I<pkg_svc.hidden> flag will be omitted.
1672 my ($end, $start, $mode) = @_;
1673 my @cust_svc = $self->_sort_cust_svc(
1674 [ qsearch( 'h_cust_svc',
1675 { 'pkgnum' => $self->pkgnum, },
1676 FS::h_cust_svc->sql_h_search(@_),
1679 if ( $mode eq 'I' ) {
1680 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1681 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1688 sub _sort_cust_svc {
1689 my( $self, $arrayref ) = @_;
1692 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1697 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1698 'svcpart' => $_->svcpart } );
1700 $pkg_svc ? $pkg_svc->primary_svc : '',
1701 $pkg_svc ? $pkg_svc->quantity : 0,
1708 =item num_cust_svc [ SVCPART ]
1710 Returns the number of provisioned services for this package. If a svcpart is
1711 specified, counts only the matching services.
1718 return $self->{'_num_cust_svc'}
1720 && exists($self->{'_num_cust_svc'})
1721 && $self->{'_num_cust_svc'} =~ /\d/;
1723 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1726 my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?';
1727 $sql .= ' AND svcpart = ?' if @_;
1729 my $sth = dbh->prepare($sql) or die dbh->errstr;
1730 $sth->execute($self->pkgnum, @_) or die $sth->errstr;
1731 $sth->fetchrow_arrayref->[0];
1734 =item available_part_svc
1736 Returns a list of FS::part_svc objects representing services included in this
1737 package but not yet provisioned. Each FS::part_svc object also has an extra
1738 field, I<num_avail>, which specifies the number of available services.
1742 sub available_part_svc {
1744 grep { $_->num_avail > 0 }
1746 my $part_svc = $_->part_svc;
1747 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1748 $_->quantity - $self->num_cust_svc($_->svcpart);
1750 # more evil encapsulation breakage
1751 if($part_svc->{'Hash'}{'num_avail'} > 0) {
1752 my @exports = $part_svc->part_export_did;
1753 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
1758 $self->part_pkg->pkg_svc;
1763 Returns a list of FS::part_svc objects representing provisioned and available
1764 services included in this package. Each FS::part_svc object also has the
1765 following extra fields:
1769 =item num_cust_svc (count)
1771 =item num_avail (quantity - count)
1773 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1776 label -> ($cust_svc->label)[1]
1785 #XXX some sort of sort order besides numeric by svcpart...
1786 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
1788 my $part_svc = $pkg_svc->part_svc;
1789 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1790 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
1791 $part_svc->{'Hash'}{'num_avail'} =
1792 max( 0, $pkg_svc->quantity - $num_cust_svc );
1793 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1794 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1795 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
1797 } $self->part_pkg->pkg_svc;
1800 push @part_svc, map {
1802 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
1803 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
1804 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
1805 $part_svc->{'Hash'}{'cust_pkg_svc'} =
1806 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
1808 } $self->extra_part_svc;
1814 =item extra_part_svc
1816 Returns a list of FS::part_svc objects corresponding to services in this
1817 package which are still provisioned but not (any longer) available in the
1822 sub extra_part_svc {
1825 my $pkgnum = $self->pkgnum;
1826 my $pkgpart = $self->pkgpart;
1829 # 'table' => 'part_svc',
1832 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
1833 # WHERE pkg_svc.svcpart = part_svc.svcpart
1834 # AND pkg_svc.pkgpart = ?
1837 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
1838 # LEFT JOIN cust_pkg USING ( pkgnum )
1839 # WHERE cust_svc.svcpart = part_svc.svcpart
1842 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1845 #seems to benchmark slightly faster...
1847 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
1848 #MySQL doesn't grok DISINCT ON
1849 'select' => 'DISTINCT part_svc.*',
1850 'table' => 'part_svc',
1852 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
1853 AND pkg_svc.pkgpart = ?
1856 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
1857 LEFT JOIN cust_pkg USING ( pkgnum )
1860 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
1861 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
1867 Returns a short status string for this package, currently:
1871 =item not yet billed
1873 =item one-time charge
1888 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
1890 return 'cancelled' if $self->get('cancel');
1891 return 'suspended' if $self->susp;
1892 return 'not yet billed' unless $self->setup;
1893 return 'one-time charge' if $freq =~ /^(0|$)/;
1897 =item ucfirst_status
1899 Returns the status with the first character capitalized.
1903 sub ucfirst_status {
1904 ucfirst(shift->status);
1909 Class method that returns the list of possible status strings for packages
1910 (see L<the status method|/status>). For example:
1912 @statuses = FS::cust_pkg->statuses();
1916 tie my %statuscolor, 'Tie::IxHash',
1917 'not yet billed' => '009999', #teal? cyan?
1918 'one-time charge' => '000000',
1919 'active' => '00CC00',
1920 'suspended' => 'FF9900',
1921 'cancelled' => 'FF0000',
1925 my $self = shift; #could be class...
1926 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
1927 # # mayble split btw one-time vs. recur
1933 Returns a hex triplet color string for this package's status.
1939 $statuscolor{$self->status};
1944 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
1945 "pkg-comment" depending on user preference).
1951 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
1952 $label = $self->pkgnum. ": $label"
1953 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
1957 =item pkg_label_long
1959 Returns a long label for this package, adding the primary service's label to
1964 sub pkg_label_long {
1966 my $label = $self->pkg_label;
1967 my $cust_svc = $self->primary_cust_svc;
1968 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
1972 =item primary_cust_svc
1974 Returns a primary service (as FS::cust_svc object) if one can be identified.
1978 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
1980 sub primary_cust_svc {
1983 my @cust_svc = $self->cust_svc;
1985 return '' unless @cust_svc; #no serivces - irrelevant then
1987 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
1989 # primary service as specified in the package definition
1990 # or exactly one service definition with quantity one
1991 my $svcpart = $self->part_pkg->svcpart;
1992 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
1993 return $cust_svc[0] if scalar(@cust_svc) == 1;
1995 #couldn't identify one thing..
2001 Returns a list of lists, calling the label method for all services
2002 (see L<FS::cust_svc>) of this billing item.
2008 map { [ $_->label ] } $self->cust_svc;
2011 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2013 Like the labels method, but returns historical information on services that
2014 were active as of END_TIMESTAMP and (optionally) not cancelled before
2015 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
2016 I<pkg_svc.hidden> flag will be omitted.
2018 Returns a list of lists, calling the label method for all (historical) services
2019 (see L<FS::h_cust_svc>) of this billing item.
2025 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2030 Like labels, except returns a simple flat list, and shortens long
2031 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2032 identical services to one line that lists the service label and the number of
2033 individual services rather than individual items.
2038 shift->_labels_short( 'labels', @_ );
2041 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2043 Like h_labels, except returns a simple flat list, and shortens long
2044 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2045 identical services to one line that lists the service label and the number of
2046 individual services rather than individual items.
2050 sub h_labels_short {
2051 shift->_labels_short( 'h_labels', @_ );
2055 my( $self, $method ) = ( shift, shift );
2057 my $conf = new FS::Conf;
2058 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2061 #tie %labels, 'Tie::IxHash';
2062 push @{ $labels{$_->[0]} }, $_->[1]
2063 foreach $self->$method(@_);
2065 foreach my $label ( keys %labels ) {
2067 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2068 my $num = scalar(@values);
2069 if ( $num > $max_same_services ) {
2070 push @labels, "$label ($num)";
2072 if ( $conf->exists('cust_bill-consolidate_services') ) {
2073 # push @labels, "$label: ". join(', ', @values);
2075 my $detail = "$label: ";
2076 $detail .= shift(@values). ', '
2077 while @values && length($detail.$values[0]) < 78;
2079 push @labels, $detail;
2082 push @labels, map { "$label: $_" } @values;
2093 Returns the parent customer object (see L<FS::cust_main>).
2099 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2102 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2106 Returns the location object, if any (see L<FS::cust_location>).
2108 =item cust_location_or_main
2110 If this package is associated with a location, returns the locaiton (see
2111 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2113 =item location_label [ OPTION => VALUE ... ]
2115 Returns the label of the location object (see L<FS::cust_location>).
2119 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2121 =item seconds_since TIMESTAMP
2123 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2124 package have been online since TIMESTAMP, according to the session monitor.
2126 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2127 L<Time::Local> and L<Date::Parse> for conversion functions.
2132 my($self, $since) = @_;
2135 foreach my $cust_svc (
2136 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2138 $seconds += $cust_svc->seconds_since($since);
2145 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2147 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2148 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2151 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2152 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2158 sub seconds_since_sqlradacct {
2159 my($self, $start, $end) = @_;
2163 foreach my $cust_svc (
2165 my $part_svc = $_->part_svc;
2166 $part_svc->svcdb eq 'svc_acct'
2167 && scalar($part_svc->part_export('sqlradius'));
2170 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2177 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2179 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2180 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2184 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2185 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2190 sub attribute_since_sqlradacct {
2191 my($self, $start, $end, $attrib) = @_;
2195 foreach my $cust_svc (
2197 my $part_svc = $_->part_svc;
2198 $part_svc->svcdb eq 'svc_acct'
2199 && scalar($part_svc->part_export('sqlradius'));
2202 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2214 my( $self, $value ) = @_;
2215 if ( defined($value) ) {
2216 $self->setfield('quantity', $value);
2218 $self->getfield('quantity') || 1;
2221 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2223 Transfers as many services as possible from this package to another package.
2225 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2226 object. The destination package must already exist.
2228 Services are moved only if the destination allows services with the correct
2229 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2230 this option with caution! No provision is made for export differences
2231 between the old and new service definitions. Probably only should be used
2232 when your exports for all service definitions of a given svcdb are identical.
2233 (attempt a transfer without it first, to move all possible svcpart-matching
2236 Any services that can't be moved remain in the original package.
2238 Returns an error, if there is one; otherwise, returns the number of services
2239 that couldn't be moved.
2244 my ($self, $dest_pkgnum, %opt) = @_;
2250 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2251 $dest = $dest_pkgnum;
2252 $dest_pkgnum = $dest->pkgnum;
2254 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2257 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2259 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2260 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2263 foreach my $cust_svc ($dest->cust_svc) {
2264 $target{$cust_svc->svcpart}--;
2267 my %svcpart2svcparts = ();
2268 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2269 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2270 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2271 next if exists $svcpart2svcparts{$svcpart};
2272 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2273 $svcpart2svcparts{$svcpart} = [
2275 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2277 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2278 'svcpart' => $_ } );
2280 $pkg_svc ? $pkg_svc->primary_svc : '',
2281 $pkg_svc ? $pkg_svc->quantity : 0,
2285 grep { $_ != $svcpart }
2287 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2289 warn "alternates for svcpart $svcpart: ".
2290 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2295 foreach my $cust_svc ($self->cust_svc) {
2296 if($target{$cust_svc->svcpart} > 0) {
2297 $target{$cust_svc->svcpart}--;
2298 my $new = new FS::cust_svc { $cust_svc->hash };
2299 $new->pkgnum($dest_pkgnum);
2300 my $error = $new->replace($cust_svc);
2301 return $error if $error;
2302 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2304 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2305 warn "alternates to consider: ".
2306 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2308 my @alternate = grep {
2309 warn "considering alternate svcpart $_: ".
2310 "$target{$_} available in new package\n"
2313 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2315 warn "alternate(s) found\n" if $DEBUG;
2316 my $change_svcpart = $alternate[0];
2317 $target{$change_svcpart}--;
2318 my $new = new FS::cust_svc { $cust_svc->hash };
2319 $new->svcpart($change_svcpart);
2320 $new->pkgnum($dest_pkgnum);
2321 my $error = $new->replace($cust_svc);
2322 return $error if $error;
2335 This method is deprecated. See the I<depend_jobnum> option to the insert and
2336 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2343 local $SIG{HUP} = 'IGNORE';
2344 local $SIG{INT} = 'IGNORE';
2345 local $SIG{QUIT} = 'IGNORE';
2346 local $SIG{TERM} = 'IGNORE';
2347 local $SIG{TSTP} = 'IGNORE';
2348 local $SIG{PIPE} = 'IGNORE';
2350 my $oldAutoCommit = $FS::UID::AutoCommit;
2351 local $FS::UID::AutoCommit = 0;
2354 foreach my $cust_svc ( $self->cust_svc ) {
2355 #false laziness w/svc_Common::insert
2356 my $svc_x = $cust_svc->svc_x;
2357 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2358 my $error = $part_export->export_insert($svc_x);
2360 $dbh->rollback if $oldAutoCommit;
2366 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2373 Associates this package with a (suspension or cancellation) reason (see
2374 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2377 Available options are:
2383 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.
2387 the access_user (see L<FS::access_user>) providing the reason
2395 the action (cancel, susp, adjourn, expire) associated with the reason
2399 If there is an error, returns the error, otherwise returns false.
2404 my ($self, %options) = @_;
2406 my $otaker = $options{reason_otaker} ||
2407 $FS::CurrentUser::CurrentUser->username;
2410 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2414 } elsif ( ref($options{'reason'}) ) {
2416 return 'Enter a new reason (or select an existing one)'
2417 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2419 my $reason = new FS::reason({
2420 'reason_type' => $options{'reason'}->{'typenum'},
2421 'reason' => $options{'reason'}->{'reason'},
2423 my $error = $reason->insert;
2424 return $error if $error;
2426 $reasonnum = $reason->reasonnum;
2429 return "Unparsable reason: ". $options{'reason'};
2432 my $cust_pkg_reason =
2433 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2434 'reasonnum' => $reasonnum,
2435 'otaker' => $otaker,
2436 'action' => substr(uc($options{'action'}),0,1),
2437 'date' => $options{'date'}
2442 $cust_pkg_reason->insert;
2445 =item insert_discount
2447 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2448 inserting a new discount on the fly (see L<FS::discount>).
2450 Available options are:
2458 If there is an error, returns the error, otherwise returns false.
2462 sub insert_discount {
2463 #my ($self, %options) = @_;
2466 my $cust_pkg_discount = new FS::cust_pkg_discount {
2467 'pkgnum' => $self->pkgnum,
2468 'discountnum' => $self->discountnum,
2470 'end_date' => '', #XXX
2471 'otaker' => $self->otaker,
2472 #for the create a new discount case
2473 '_type' => $self->discountnum__type,
2474 'amount' => $self->discountnum_amount,
2475 'percent' => $self->discountnum_percent,
2476 'months' => $self->discountnum_months,
2477 #'disabled' => $self->discountnum_disabled,
2480 $cust_pkg_discount->insert;
2483 =item set_usage USAGE_VALUE_HASHREF
2485 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2486 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2487 upbytes, downbytes, and totalbytes are appropriate keys.
2489 All svc_accts which are part of this package have their values reset.
2494 my ($self, $valueref, %opt) = @_;
2496 foreach my $cust_svc ($self->cust_svc){
2497 my $svc_x = $cust_svc->svc_x;
2498 $svc_x->set_usage($valueref, %opt)
2499 if $svc_x->can("set_usage");
2503 =item recharge USAGE_VALUE_HASHREF
2505 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2506 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2507 upbytes, downbytes, and totalbytes are appropriate keys.
2509 All svc_accts which are part of this package have their values incremented.
2514 my ($self, $valueref) = @_;
2516 foreach my $cust_svc ($self->cust_svc){
2517 my $svc_x = $cust_svc->svc_x;
2518 $svc_x->recharge($valueref)
2519 if $svc_x->can("recharge");
2523 =item cust_pkg_discount
2527 sub cust_pkg_discount {
2529 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2532 =item cust_pkg_discount_active
2536 sub cust_pkg_discount_active {
2538 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2543 =head1 CLASS METHODS
2549 Returns an SQL expression identifying recurring packages.
2553 sub recurring_sql { "
2554 '0' != ( select freq from part_pkg
2555 where cust_pkg.pkgpart = part_pkg.pkgpart )
2560 Returns an SQL expression identifying one-time packages.
2565 '0' = ( select freq from part_pkg
2566 where cust_pkg.pkgpart = part_pkg.pkgpart )
2571 Returns an SQL expression identifying ordered packages (recurring packages not
2577 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2582 Returns an SQL expression identifying active packages.
2587 $_[0]->recurring_sql. "
2588 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2589 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2590 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2593 =item not_yet_billed_sql
2595 Returns an SQL expression identifying packages which have not yet been billed.
2599 sub not_yet_billed_sql { "
2600 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2601 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2602 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2607 Returns an SQL expression identifying inactive packages (one-time packages
2608 that are otherwise unsuspended/uncancelled).
2612 sub inactive_sql { "
2613 ". $_[0]->onetime_sql(). "
2614 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2615 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2616 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2622 Returns an SQL expression identifying suspended packages.
2626 sub suspended_sql { susp_sql(@_); }
2628 #$_[0]->recurring_sql(). ' AND '.
2630 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2631 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2638 Returns an SQL exprression identifying cancelled packages.
2642 sub cancelled_sql { cancel_sql(@_); }
2644 #$_[0]->recurring_sql(). ' AND '.
2645 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2650 Returns an SQL expression to give the package status as a string.
2656 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2657 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2658 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2659 WHEN ".onetime_sql()." THEN 'one-time charge'
2664 =item search HASHREF
2668 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2669 Valid parameters are
2677 active, inactive, suspended, cancel (or cancelled)
2681 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2685 boolean selects custom packages
2691 pkgpart or arrayref or hashref of pkgparts
2695 arrayref of beginning and ending epoch date
2699 arrayref of beginning and ending epoch date
2703 arrayref of beginning and ending epoch date
2707 arrayref of beginning and ending epoch date
2711 arrayref of beginning and ending epoch date
2715 arrayref of beginning and ending epoch date
2719 arrayref of beginning and ending epoch date
2723 pkgnum or APKG_pkgnum
2727 a value suited to passing to FS::UI::Web::cust_header
2731 specifies the user for agent virtualization
2735 boolean selects packages containing fcc form 477 telco lines
2742 my ($class, $params) = @_;
2749 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
2751 "cust_main.agentnum = $1";
2758 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
2760 "cust_pkg.custnum = $1";
2767 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
2769 "cust_pkg.pkgbatch = '$1'";
2776 if ( $params->{'magic'} eq 'active'
2777 || $params->{'status'} eq 'active' ) {
2779 push @where, FS::cust_pkg->active_sql();
2781 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
2782 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
2784 push @where, FS::cust_pkg->not_yet_billed_sql();
2786 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
2787 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
2789 push @where, FS::cust_pkg->inactive_sql();
2791 } elsif ( $params->{'magic'} eq 'suspended'
2792 || $params->{'status'} eq 'suspended' ) {
2794 push @where, FS::cust_pkg->suspended_sql();
2796 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
2797 || $params->{'status'} =~ /^cancell?ed$/ ) {
2799 push @where, FS::cust_pkg->cancelled_sql();
2804 # parse package class
2807 #false lazinessish w/graph/cust_bill_pkg.cgi
2810 if ( exists($params->{'classnum'})
2811 && $params->{'classnum'} =~ /^(\d*)$/
2815 if ( $classnum ) { #a specific class
2816 push @where, "part_pkg.classnum = $classnum";
2818 #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
2819 #die "classnum $classnum not found!" unless $pkg_class[0];
2820 #$title .= $pkg_class[0]->classname.' ';
2822 } elsif ( $classnum eq '' ) { #the empty class
2824 push @where, "part_pkg.classnum IS NULL";
2825 #$title .= 'Empty class ';
2826 #@pkg_class = ( '(empty class)' );
2827 } elsif ( $classnum eq '0' ) {
2828 #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
2829 #push @pkg_class, '(empty class)';
2831 die "illegal classnum";
2837 # parse package report options
2840 my @report_option = ();
2841 if ( exists($params->{'report_option'})
2842 && $params->{'report_option'} =~ /^([,\d]*)$/
2845 @report_option = split(',', $1);
2848 if (@report_option) {
2849 # this will result in the empty set for the dangling comma case as it should
2851 map{ "0 < ( SELECT count(*) FROM part_pkg_option
2852 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
2853 AND optionname = 'report_option_$_'
2854 AND optionvalue = '1' )"
2864 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
2870 push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line};
2876 if ( exists($params->{'censustract'}) ) {
2877 $params->{'censustract'} =~ /^([.\d]*)$/;
2878 my $censustract = "cust_main.censustract = '$1'";
2879 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
2880 push @where, "( $censustract )";
2887 if ( ref($params->{'pkgpart'}) ) {
2890 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
2891 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
2892 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
2893 @pkgpart = @{ $params->{'pkgpart'} };
2895 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
2898 @pkgpart = grep /^(\d+)$/, @pkgpart;
2900 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
2902 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2903 push @where, "pkgpart = $1";
2912 #false laziness w/report_cust_pkg.html
2915 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
2916 'active' => { 'susp'=>1, 'cancel'=>1 },
2917 'suspended' => { 'cancel' => 1 },
2922 if( exists($params->{'active'} ) ) {
2923 # This overrides all the other date-related fields
2924 my($beginning, $ending) = @{$params->{'active'}};
2926 "cust_pkg.setup IS NOT NULL",
2927 "cust_pkg.setup <= $ending",
2928 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
2929 "NOT (".FS::cust_pkg->onetime_sql . ")";
2932 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
2934 next unless exists($params->{$field});
2936 my($beginning, $ending) = @{$params->{$field}};
2938 next if $beginning == 0 && $ending == 4294967295;
2941 "cust_pkg.$field IS NOT NULL",
2942 "cust_pkg.$field >= $beginning",
2943 "cust_pkg.$field <= $ending";
2945 $orderby ||= "ORDER BY cust_pkg.$field";
2950 $orderby ||= 'ORDER BY bill';
2953 # parse magic, legacy, etc.
2956 if ( $params->{'magic'} &&
2957 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
2960 $orderby = 'ORDER BY pkgnum';
2962 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
2963 push @where, "pkgpart = $1";
2966 } elsif ( $params->{'query'} eq 'pkgnum' ) {
2968 $orderby = 'ORDER BY pkgnum';
2970 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
2972 $orderby = 'ORDER BY pkgnum';
2975 SELECT count(*) FROM pkg_svc
2976 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
2977 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
2978 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
2979 AND cust_svc.svcpart = pkg_svc.svcpart
2986 # setup queries, links, subs, etc. for the search
2989 # here is the agent virtualization
2990 if ($params->{CurrentUser}) {
2992 qsearchs('access_user', { username => $params->{CurrentUser} });
2995 push @where, $access_user->agentnums_sql('table'=>'cust_main');
3000 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3003 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3005 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
3006 'LEFT JOIN part_pkg USING ( pkgpart ) '.
3007 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3009 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3012 'table' => 'cust_pkg',
3014 'select' => join(', ',
3016 ( map "part_pkg.$_", qw( pkg freq ) ),
3017 'pkg_class.classname',
3018 'cust_main.custnum AS cust_main_custnum',
3019 FS::UI::Web::cust_sql_fields(
3020 $params->{'cust_fields'}
3023 'extra_sql' => "$extra_sql $orderby",
3024 'addl_from' => $addl_from,
3025 'count_query' => $count_query,
3032 Returns a list of two package counts. The first is a count of packages
3033 based on the supplied criteria and the second is the count of residential
3034 packages with those same criteria. Criteria are specified as in the search
3040 my ($class, $params) = @_;
3042 my $sql_query = $class->search( $params );
3044 my $count_sql = delete($sql_query->{'count_query'});
3045 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3046 or die "couldn't parse count_sql";
3048 my $count_sth = dbh->prepare($count_sql)
3049 or die "Error preparing $count_sql: ". dbh->errstr;
3051 or die "Error executing $count_sql: ". $count_sth->errstr;
3052 my $count_arrayref = $count_sth->fetchrow_arrayref;
3054 return ( @$count_arrayref );
3061 Returns a list: the first item is an SQL fragment identifying matching
3062 packages/customers via location (taking into account shipping and package
3063 address taxation, if enabled), and subsequent items are the parameters to
3064 substitute for the placeholders in that fragment.
3069 my($class, %opt) = @_;
3070 my $ornull = $opt{'ornull'};
3072 my $conf = new FS::Conf;
3074 # '?' placeholders in _location_sql_where
3075 my $x = $ornull ? 3 : 2;
3076 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3080 if ( $conf->exists('tax-ship_address') ) {
3083 ( ( ship_last IS NULL OR ship_last = '' )
3084 AND ". _location_sql_where('cust_main', '', $ornull ). "
3086 OR ( ship_last IS NOT NULL AND ship_last != ''
3087 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3090 # AND payby != 'COMP'
3092 @main_param = ( @bill_param, @bill_param );
3096 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3097 @main_param = @bill_param;
3103 if ( $conf->exists('tax-pkg_address') ) {
3105 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3108 ( cust_pkg.locationnum IS NULL AND $main_where )
3109 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3112 @param = ( @main_param, @bill_param );
3116 $where = $main_where;
3117 @param = @main_param;
3125 #subroutine, helper for location_sql
3126 sub _location_sql_where {
3128 my $prefix = @_ ? shift : '';
3129 my $ornull = @_ ? shift : '';
3131 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3133 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3135 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3136 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3137 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3139 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3141 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3142 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3143 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3144 AND $table.${prefix}country = ?
3152 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3154 CUSTNUM is a customer (see L<FS::cust_main>)
3156 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3157 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3160 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3161 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3162 new billing items. An error is returned if this is not possible (see
3163 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3166 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3167 newly-created cust_pkg objects.
3169 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3170 and inserted. Multiple FS::pkg_referral records can be created by
3171 setting I<refnum> to an array reference of refnums or a hash reference with
3172 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3173 record will be created corresponding to cust_main.refnum.
3178 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3180 my $conf = new FS::Conf;
3182 # Transactionize this whole mess
3183 local $SIG{HUP} = 'IGNORE';
3184 local $SIG{INT} = 'IGNORE';
3185 local $SIG{QUIT} = 'IGNORE';
3186 local $SIG{TERM} = 'IGNORE';
3187 local $SIG{TSTP} = 'IGNORE';
3188 local $SIG{PIPE} = 'IGNORE';
3190 my $oldAutoCommit = $FS::UID::AutoCommit;
3191 local $FS::UID::AutoCommit = 0;
3195 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3196 # return "Customer not found: $custnum" unless $cust_main;
3198 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3201 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3204 my $change = scalar(@old_cust_pkg) != 0;
3207 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3209 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3210 " to pkgpart ". $pkgparts->[0]. "\n"
3213 my $err_or_cust_pkg =
3214 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3215 'refnum' => $refnum,
3218 unless (ref($err_or_cust_pkg)) {
3219 $dbh->rollback if $oldAutoCommit;
3220 return $err_or_cust_pkg;
3223 push @$return_cust_pkg, $err_or_cust_pkg;
3224 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3229 # Create the new packages.
3230 foreach my $pkgpart (@$pkgparts) {
3232 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3234 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3235 pkgpart => $pkgpart,
3239 $error = $cust_pkg->insert( 'change' => $change );
3241 $dbh->rollback if $oldAutoCommit;
3244 push @$return_cust_pkg, $cust_pkg;
3246 # $return_cust_pkg now contains refs to all of the newly
3249 # Transfer services and cancel old packages.
3250 foreach my $old_pkg (@old_cust_pkg) {
3252 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3255 foreach my $new_pkg (@$return_cust_pkg) {
3256 $error = $old_pkg->transfer($new_pkg);
3257 if ($error and $error == 0) {
3258 # $old_pkg->transfer failed.
3259 $dbh->rollback if $oldAutoCommit;
3264 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3265 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3266 foreach my $new_pkg (@$return_cust_pkg) {
3267 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3268 if ($error and $error == 0) {
3269 # $old_pkg->transfer failed.
3270 $dbh->rollback if $oldAutoCommit;
3277 # Transfers were successful, but we went through all of the
3278 # new packages and still had services left on the old package.
3279 # We can't cancel the package under the circumstances, so abort.
3280 $dbh->rollback if $oldAutoCommit;
3281 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3283 $error = $old_pkg->cancel( quiet=>1 );
3289 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3293 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3295 A bulk change method to change packages for multiple customers.
3297 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3298 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3301 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3302 replace. The services (see L<FS::cust_svc>) are moved to the
3303 new billing items. An error is returned if this is not possible (see
3306 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3307 newly-created cust_pkg objects.
3312 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3314 # Transactionize this whole mess
3315 local $SIG{HUP} = 'IGNORE';
3316 local $SIG{INT} = 'IGNORE';
3317 local $SIG{QUIT} = 'IGNORE';
3318 local $SIG{TERM} = 'IGNORE';
3319 local $SIG{TSTP} = 'IGNORE';
3320 local $SIG{PIPE} = 'IGNORE';
3322 my $oldAutoCommit = $FS::UID::AutoCommit;
3323 local $FS::UID::AutoCommit = 0;
3327 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3330 while(scalar(@old_cust_pkg)) {
3332 my $custnum = $old_cust_pkg[0]->custnum;
3333 my (@remove) = map { $_->pkgnum }
3334 grep { $_->custnum == $custnum } @old_cust_pkg;
3335 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3337 my $error = order $custnum, $pkgparts, \@remove, \@return;
3339 push @errors, $error
3341 push @$return_cust_pkg, @return;
3344 if (scalar(@errors)) {
3345 $dbh->rollback if $oldAutoCommit;
3346 return join(' / ', @errors);
3349 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3353 # Used by FS::Upgrade to migrate to a new database.
3354 sub _upgrade_data { # class method
3355 my ($class, %opts) = @_;
3356 $class->_upgrade_otaker(%opts);
3358 # RT#10139, bug resulting in contract_end being set when it shouldn't
3359 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3360 # RT#10830, bad calculation of prorate date near end of year
3361 # the date range for bill is December 2009, and we move it forward
3362 # one year if it's before the previous bill date (which it should
3364 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3365 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3366 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3368 foreach my $sql (@statements) {
3369 my $sth = dbh->prepare($sql);
3370 $sth->execute or die $sth->errstr;
3378 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3380 In sub order, the @pkgparts array (passed by reference) is clobbered.
3382 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3383 method to pass dates to the recur_prog expression, it should do so.
3385 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3386 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3387 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3388 configuration values. Probably need a subroutine which decides what to do
3389 based on whether or not we've fetched the user yet, rather than a hash. See
3390 FS::UID and the TODO.
3392 Now that things are transactional should the check in the insert method be
3397 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3398 L<FS::pkg_svc>, schema.html from the base documentation