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 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;
35 # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
37 # because they load configuration by setting FS::UID::callback (see TODO)
43 # for sending cancel emails in sub cancel
47 $me = '[FS::cust_pkg]';
49 $disable_agentcheck = 0;
53 my ( $hashref, $cache ) = @_;
54 #if ( $hashref->{'pkgpart'} ) {
55 if ( $hashref->{'pkg'} ) {
56 # #@{ $self->{'_pkgnum'} } = ();
57 # my $subcache = $cache->subcache('pkgpart', 'part_pkg');
58 # $self->{'_pkgpart'} = $subcache;
59 # #push @{ $self->{'_pkgnum'} },
60 # FS::part_pkg->new_or_cached($hashref, $subcache);
61 $self->{'_pkgpart'} = FS::part_pkg->new($hashref);
63 if ( exists $hashref->{'svcnum'} ) {
64 #@{ $self->{'_pkgnum'} } = ();
65 my $subcache = $cache->subcache('svcnum', 'cust_svc', $hashref->{pkgnum});
66 $self->{'_svcnum'} = $subcache;
67 #push @{ $self->{'_pkgnum'} },
68 FS::cust_svc->new_or_cached($hashref, $subcache) if $hashref->{svcnum};
74 FS::cust_pkg - Object methods for cust_pkg objects
80 $record = new FS::cust_pkg \%hash;
81 $record = new FS::cust_pkg { 'column' => 'value' };
83 $error = $record->insert;
85 $error = $new_record->replace($old_record);
87 $error = $record->delete;
89 $error = $record->check;
91 $error = $record->cancel;
93 $error = $record->suspend;
95 $error = $record->unsuspend;
97 $part_pkg = $record->part_pkg;
99 @labels = $record->labels;
101 $seconds = $record->seconds_since($timestamp);
103 $error = FS::cust_pkg::order( $custnum, \@pkgparts );
104 $error = FS::cust_pkg::order( $custnum, \@pkgparts, \@remove_pkgnums ] );
108 An FS::cust_pkg object represents a customer billing item. FS::cust_pkg
109 inherits from FS::Record. The following fields are currently supported:
115 Primary key (assigned automatically for new billing items)
119 Customer (see L<FS::cust_main>)
123 Billing item definition (see L<FS::part_pkg>)
127 Optional link to package location (see L<FS::location>)
131 date package was ordered (also remains same on changes)
143 date (next bill date)
171 order taker (see L<FS::access_user>)
175 If this field is set to 1, disables the automatic
176 unsuspension of this package when using the B<unsuspendauto> config option.
180 If not set, defaults to 1
184 Date of change from previous package
194 =item change_locationnum
202 Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date
203 are specified as UNIX timestamps; see L<perlfunc/"time">. Also see
204 L<Time::Local> and L<Date::Parse> for conversion functions.
212 Create a new billing item. To add the item to the database, see L<"insert">.
216 sub table { 'cust_pkg'; }
217 sub cust_linked { $_[0]->cust_main_custnum; }
218 sub cust_unlinked_msg {
220 "WARNING: can't find cust_main.custnum ". $self->custnum.
221 ' (cust_pkg.pkgnum '. $self->pkgnum. ')';
224 =item insert [ OPTION => VALUE ... ]
226 Adds this billing item to the database ("Orders" the item). If there is an
227 error, returns the error, otherwise returns false.
229 If the additional field I<promo_code> is defined instead of I<pkgpart>, it
230 will be used to look up the package definition and agent restrictions will be
233 If the additional field I<refnum> is defined, an FS::pkg_referral record will
234 be created and inserted. Multiple FS::pkg_referral records can be created by
235 setting I<refnum> to an array reference of refnums or a hash reference with
236 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
237 record will be created corresponding to cust_main.refnum.
239 The following options are available:
245 If set true, supresses any referral credit to a referring customer.
249 cust_pkg_option records will be created
253 a ticket will be added to this customer with this subject
257 an optional queue name for ticket additions
264 my( $self, %options ) = @_;
266 my $error = $self->check_pkgpart;
267 return $error if $error;
269 my $part_pkg = $self->part_pkg;
271 if ( $part_pkg->option('start_1st', 1) && !$self->start_date ) {
272 my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5];
273 $mon += 1 unless $mday == 1;
274 until ( $mon < 12 ) { $mon -= 12; $year++; }
275 $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
278 foreach my $action ( qw(expire adjourn contract_end) ) {
279 my $months = $part_pkg->option("${action}_months",1);
280 if($months and !$self->$action) {
281 my $start = $self->start_date || $self->setup || time;
282 $self->$action( $part_pkg->add_freq($start, $months) );
286 my $free_days = $part_pkg->option('free_days',1);
287 if ( $free_days && $part_pkg->option('delay_setup',1) ) { #&& !$self->start_date
288 my ($mday,$mon,$year) = (localtime(time) )[3,4,5];
289 #my $start_date = ($self->start_date || timelocal(0,0,0,$mday,$mon,$year)) + 86400 * $free_days;
290 my $start_date = timelocal(0,0,0,$mday,$mon,$year) + 86400 * $free_days;
291 $self->start_date($start_date);
294 $self->order_date(time);
296 local $SIG{HUP} = 'IGNORE';
297 local $SIG{INT} = 'IGNORE';
298 local $SIG{QUIT} = 'IGNORE';
299 local $SIG{TERM} = 'IGNORE';
300 local $SIG{TSTP} = 'IGNORE';
301 local $SIG{PIPE} = 'IGNORE';
303 my $oldAutoCommit = $FS::UID::AutoCommit;
304 local $FS::UID::AutoCommit = 0;
307 $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
309 $dbh->rollback if $oldAutoCommit;
313 $self->refnum($self->cust_main->refnum) unless $self->refnum;
314 $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
315 $self->process_m2m( 'link_table' => 'pkg_referral',
316 'target_table' => 'part_referral',
317 'params' => $self->refnum,
320 if ( $self->discountnum ) {
321 my $error = $self->insert_discount();
323 $dbh->rollback if $oldAutoCommit;
328 #if ( $self->reg_code ) {
329 # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
330 # $error = $reg_code->delete;
332 # $dbh->rollback if $oldAutoCommit;
337 my $conf = new FS::Conf;
339 if ( $conf->config('ticket_system') && $options{ticket_subject} ) {
342 # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" );
349 use FS::TicketSystem;
350 FS::TicketSystem->init();
352 my $q = new RT::Queue($RT::SystemUser);
353 $q->Load($options{ticket_queue}) if $options{ticket_queue};
354 my $t = new RT::Ticket($RT::SystemUser);
355 my $mime = new MIME::Entity;
356 $mime->build( Type => 'text/plain', Data => $options{ticket_subject} );
357 $t->Create( $options{ticket_queue} ? (Queue => $q) : (),
358 Subject => $options{ticket_subject},
361 $t->AddLink( Type => 'MemberOf',
362 Target => 'freeside://freeside/cust_main/'. $self->custnum,
366 if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
367 my $queue = new FS::queue {
368 'job' => 'FS::cust_main::queueable_print',
370 $error = $queue->insert(
371 'custnum' => $self->custnum,
372 'template' => 'welcome_letter',
376 warn "can't send welcome letter: $error";
381 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
388 This method now works but you probably shouldn't use it.
390 You don't want to delete packages, because there would then be no record
391 the customer ever purchased the package. Instead, see the cancel method and
392 hide cancelled packages.
399 local $SIG{HUP} = 'IGNORE';
400 local $SIG{INT} = 'IGNORE';
401 local $SIG{QUIT} = 'IGNORE';
402 local $SIG{TERM} = 'IGNORE';
403 local $SIG{TSTP} = 'IGNORE';
404 local $SIG{PIPE} = 'IGNORE';
406 my $oldAutoCommit = $FS::UID::AutoCommit;
407 local $FS::UID::AutoCommit = 0;
410 foreach my $cust_pkg_discount ($self->cust_pkg_discount) {
411 my $error = $cust_pkg_discount->delete;
413 $dbh->rollback if $oldAutoCommit;
417 #cust_bill_pkg_discount?
419 foreach my $cust_pkg_detail ($self->cust_pkg_detail) {
420 my $error = $cust_pkg_detail->delete;
422 $dbh->rollback if $oldAutoCommit;
427 foreach my $cust_pkg_reason (
429 'table' => 'cust_pkg_reason',
430 'hashref' => { 'pkgnum' => $self->pkgnum },
434 my $error = $cust_pkg_reason->delete;
436 $dbh->rollback if $oldAutoCommit;
443 my $error = $self->SUPER::delete(@_);
445 $dbh->rollback if $oldAutoCommit;
449 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
455 =item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ]
457 Replaces the OLD_RECORD with this one in the database. If there is an error,
458 returns the error, otherwise returns false.
460 Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
462 Changing pkgpart may have disasterous effects. See the order subroutine.
464 setup and bill are normally updated by calling the bill method of a customer
465 object (see L<FS::cust_main>).
467 suspend is normally updated by the suspend and unsuspend methods.
469 cancel is normally updated by the cancel method (and also the order subroutine
472 Available options are:
478 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.
482 the access_user (see L<FS::access_user>) providing the reason
486 hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate
495 my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') )
500 ( ref($_[0]) eq 'HASH' )
504 #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart;
505 #return "Can't change otaker!" if $old->otaker ne $new->otaker;
508 #return "Can't change setup once it exists!"
509 # if $old->getfield('setup') &&
510 # $old->getfield('setup') != $new->getfield('setup');
512 #some logic for bill, susp, cancel?
514 local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart;
516 local $SIG{HUP} = 'IGNORE';
517 local $SIG{INT} = 'IGNORE';
518 local $SIG{QUIT} = 'IGNORE';
519 local $SIG{TERM} = 'IGNORE';
520 local $SIG{TSTP} = 'IGNORE';
521 local $SIG{PIPE} = 'IGNORE';
523 my $oldAutoCommit = $FS::UID::AutoCommit;
524 local $FS::UID::AutoCommit = 0;
527 foreach my $method ( qw(adjourn expire) ) { # How many reasons?
528 if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) {
529 my $error = $new->insert_reason(
530 'reason' => $options->{'reason'},
531 'date' => $new->$method,
533 'reason_otaker' => $options->{'reason_otaker'},
536 dbh->rollback if $oldAutoCommit;
537 return "Error inserting cust_pkg_reason: $error";
542 #save off and freeze RADIUS attributes for any associated svc_acct records
544 if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) {
546 #also check for specific exports?
547 # to avoid spurious modify export events
548 @svc_acct = map { $_->svc_x }
549 grep { $_->part_svc->svcdb eq 'svc_acct' }
552 $_->snapshot foreach @svc_acct;
556 my $error = $new->SUPER::replace($old,
557 $options->{options} ? $options->{options} : ()
560 $dbh->rollback if $oldAutoCommit;
564 #for prepaid packages,
565 #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes
566 foreach my $old_svc_acct ( @svc_acct ) {
567 my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash };
569 $new_svc_acct->replace( $old_svc_acct,
570 'depend_jobnum' => $options->{depend_jobnum},
573 $dbh->rollback if $oldAutoCommit;
578 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
585 Checks all fields to make sure this is a valid billing item. If there is an
586 error, returns the error, otherwise returns false. Called by the insert and
594 $self->locationnum('') if !$self->locationnum || $self->locationnum == -1;
597 $self->ut_numbern('pkgnum')
598 || $self->ut_foreign_key('custnum', 'cust_main', 'custnum')
599 || $self->ut_numbern('pkgpart')
600 || $self->check_pkgpart
601 || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum')
602 || $self->ut_numbern('start_date')
603 || $self->ut_numbern('setup')
604 || $self->ut_numbern('bill')
605 || $self->ut_numbern('susp')
606 || $self->ut_numbern('cancel')
607 || $self->ut_numbern('adjourn')
608 || $self->ut_numbern('expire')
609 || $self->ut_numbern('dundate')
610 || $self->ut_enum('no_auto', [ '', 'Y' ])
611 || $self->ut_enum('waive_setup', [ '', 'Y' ])
612 || $self->ut_numbern('agent_pkgid')
613 || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
614 || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
616 return $error if $error;
618 return "A package with both start date (future start) and setup date (already started) will never bill"
619 if $self->start_date && $self->setup;
621 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
623 if ( $self->dbdef_table->column('manual_flag') ) {
624 $self->manual_flag('') if $self->manual_flag eq ' ';
625 $self->manual_flag =~ /^([01]?)$/
626 or return "Illegal manual_flag ". $self->manual_flag;
627 $self->manual_flag($1);
640 my $error = $self->ut_numbern('pkgpart');
641 return $error if $error;
643 if ( $self->reg_code ) {
645 unless ( grep { $self->pkgpart == $_->pkgpart }
646 map { $_->reg_code_pkg }
647 qsearchs( 'reg_code', { 'code' => $self->reg_code,
648 'agentnum' => $self->cust_main->agentnum })
650 return "Unknown registration code";
653 } elsif ( $self->promo_code ) {
656 qsearchs('part_pkg', {
657 'pkgpart' => $self->pkgpart,
658 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
660 return 'Unknown promotional code' unless $promo_part_pkg;
664 unless ( $disable_agentcheck ) {
666 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
667 return "agent ". $agent->agentnum. ':'. $agent->agent.
668 " can't purchase pkgpart ". $self->pkgpart
669 unless $agent->pkgpart_hashref->{ $self->pkgpart }
670 || $agent->agentnum == $self->part_pkg->agentnum;
673 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
674 return $error if $error;
682 =item cancel [ OPTION => VALUE ... ]
684 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
685 in this package, then cancels the package itself (sets the cancel field to
688 Available options are:
692 =item quiet - can be set true to supress email cancellation notices.
694 =item time - can be set to cancel the package based on a specific future or
695 historical date. Using time ensures that the remaining amount is calculated
696 correctly. Note however that this is an immediate cancel and just changes
697 the date. You are PROBABLY looking to expire the account instead of using
700 =item reason - can be set to a cancellation reason (see L<FS:reason>),
701 either a reasonnum of an existing reason, or passing a hashref will create
702 a new reason. The hashref should have the following keys: typenum - Reason
703 type (see L<FS::reason_type>, reason - Text of the new reason.
705 =item date - can be set to a unix style timestamp to specify when to
708 =item nobill - can be set true to skip billing if it might otherwise be done.
710 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
711 not credit it. This must be set (by change()) when changing the package
712 to a different pkgpart or location, and probably shouldn't be in any other
713 case. If it's not set, the 'unused_credit_cancel' part_pkg option will
718 If there is an error, returns the error, otherwise returns false.
723 my( $self, %options ) = @_;
726 my $conf = new FS::Conf;
728 warn "cust_pkg::cancel called with options".
729 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
732 local $SIG{HUP} = 'IGNORE';
733 local $SIG{INT} = 'IGNORE';
734 local $SIG{QUIT} = 'IGNORE';
735 local $SIG{TERM} = 'IGNORE';
736 local $SIG{TSTP} = 'IGNORE';
737 local $SIG{PIPE} = 'IGNORE';
739 my $oldAutoCommit = $FS::UID::AutoCommit;
740 local $FS::UID::AutoCommit = 0;
743 my $old = $self->select_for_update;
745 if ( $old->get('cancel') || $self->get('cancel') ) {
746 dbh->rollback if $oldAutoCommit;
747 return ""; # no error
750 # XXX possibly set cancel_time to the expire date?
751 my $cancel_time = $options{'time'} || time;
752 my $date = $options{'date'} if $options{'date'}; # expire/cancel later
753 $date = '' if ($date && $date <= $cancel_time); # complain instead?
755 #race condition: usage could be ongoing until unprovisioned
756 #resolved by performing a change package instead (which unprovisions) and
758 if ( !$options{nobill} && !$date ) {
759 # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
760 my $copy = $self->new({$self->hash});
762 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
764 'time' => $cancel_time );
765 warn "Error billing during cancel, custnum ".
766 #$self->cust_main->custnum. ": $error"
771 if ( $options{'reason'} ) {
772 $error = $self->insert_reason( 'reason' => $options{'reason'},
773 'action' => $date ? 'expire' : 'cancel',
774 'date' => $date ? $date : $cancel_time,
775 'reason_otaker' => $options{'reason_otaker'},
778 dbh->rollback if $oldAutoCommit;
779 return "Error inserting cust_pkg_reason: $error";
783 my %svc_cancel_opt = ();
784 $svc_cancel_opt{'date'} = $date if $date;
785 foreach my $cust_svc (
788 sort { $a->[1] <=> $b->[1] }
789 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
790 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
792 my $part_svc = $cust_svc->part_svc;
793 next if ( defined($part_svc) and $part_svc->preserve );
794 my $error = $cust_svc->cancel( %svc_cancel_opt );
797 $dbh->rollback if $oldAutoCommit;
798 return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
804 # credit remaining time if appropriate
806 if ( exists($options{'unused_credit'}) ) {
807 $do_credit = $options{'unused_credit'};
810 $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
813 my $error = $self->credit_remaining($cancel_time);
815 $dbh->rollback if $oldAutoCommit;
822 my %hash = $self->hash;
823 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
824 my $new = new FS::cust_pkg ( \%hash );
825 $error = $new->replace( $self, options => { $self->options } );
827 $dbh->rollback if $oldAutoCommit;
831 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
832 return '' if $date; #no errors
834 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
835 if ( !$options{'quiet'} &&
836 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
838 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
841 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
842 $error = $msg_template->send( 'cust_main' => $self->cust_main,
847 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
848 'to' => \@invoicing_list,
849 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
850 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
853 #should this do something on errors?
860 =item cancel_if_expired [ NOW_TIMESTAMP ]
862 Cancels this package if its expire date has been reached.
866 sub cancel_if_expired {
868 my $time = shift || time;
869 return '' unless $self->expire && $self->expire <= $time;
870 my $error = $self->cancel;
872 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
873 $self->custnum. ": $error";
880 Cancels any pending expiration (sets the expire field to null).
882 If there is an error, returns the error, otherwise returns false.
887 my( $self, %options ) = @_;
890 local $SIG{HUP} = 'IGNORE';
891 local $SIG{INT} = 'IGNORE';
892 local $SIG{QUIT} = 'IGNORE';
893 local $SIG{TERM} = 'IGNORE';
894 local $SIG{TSTP} = 'IGNORE';
895 local $SIG{PIPE} = 'IGNORE';
897 my $oldAutoCommit = $FS::UID::AutoCommit;
898 local $FS::UID::AutoCommit = 0;
901 my $old = $self->select_for_update;
903 my $pkgnum = $old->pkgnum;
904 if ( $old->get('cancel') || $self->get('cancel') ) {
905 dbh->rollback if $oldAutoCommit;
906 return "Can't unexpire cancelled package $pkgnum";
907 # or at least it's pointless
910 unless ( $old->get('expire') && $self->get('expire') ) {
911 dbh->rollback if $oldAutoCommit;
912 return ""; # no error
915 my %hash = $self->hash;
916 $hash{'expire'} = '';
917 my $new = new FS::cust_pkg ( \%hash );
918 $error = $new->replace( $self, options => { $self->options } );
920 $dbh->rollback if $oldAutoCommit;
924 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
930 =item suspend [ OPTION => VALUE ... ]
932 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
933 package, then suspends the package itself (sets the susp field to now).
935 Available options are:
939 =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.
941 =item date - can be set to a unix style timestamp to specify when to suspend (adjourn)
945 If there is an error, returns the error, otherwise returns false.
950 my( $self, %options ) = @_;
953 local $SIG{HUP} = 'IGNORE';
954 local $SIG{INT} = 'IGNORE';
955 local $SIG{QUIT} = 'IGNORE';
956 local $SIG{TERM} = 'IGNORE';
957 local $SIG{TSTP} = 'IGNORE';
958 local $SIG{PIPE} = 'IGNORE';
960 my $oldAutoCommit = $FS::UID::AutoCommit;
961 local $FS::UID::AutoCommit = 0;
964 my $old = $self->select_for_update;
966 my $pkgnum = $old->pkgnum;
967 if ( $old->get('cancel') || $self->get('cancel') ) {
968 dbh->rollback if $oldAutoCommit;
969 return "Can't suspend cancelled package $pkgnum";
972 if ( $old->get('susp') || $self->get('susp') ) {
973 dbh->rollback if $oldAutoCommit;
974 return ""; # no error # complain on adjourn?
977 my $suspend_time = $options{'time'} || time;
978 my $date = $options{date} if $options{date}; # adjourn/suspend later
979 $date = '' if ($date && $date <= time); # complain instead?
981 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
982 dbh->rollback if $oldAutoCommit;
983 return "Package $pkgnum expires before it would be suspended.";
986 # some false laziness with sub cancel
987 if ( !$options{nobill} && !$date &&
988 $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
989 # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
990 # make the entire cust_main->bill path recognize 'suspend' and
991 # 'cancel' separately.
992 warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
993 my $copy = $self->new({$self->hash});
995 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
997 'time' => $suspend_time );
998 warn "Error billing during suspend, custnum ".
999 #$self->cust_main->custnum. ": $error"
1004 if ( $options{'reason'} ) {
1005 $error = $self->insert_reason( 'reason' => $options{'reason'},
1006 'action' => $date ? 'adjourn' : 'suspend',
1007 'date' => $date ? $date : $suspend_time,
1008 'reason_otaker' => $options{'reason_otaker'},
1011 dbh->rollback if $oldAutoCommit;
1012 return "Error inserting cust_pkg_reason: $error";
1016 my %hash = $self->hash;
1018 $hash{'adjourn'} = $date;
1020 $hash{'susp'} = $suspend_time;
1022 my $new = new FS::cust_pkg ( \%hash );
1023 $error = $new->replace( $self, options => { $self->options } );
1025 $dbh->rollback if $oldAutoCommit;
1030 # credit remaining time if appropriate
1031 if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
1032 my $error = $self->credit_remaining($suspend_time);
1034 $dbh->rollback if $oldAutoCommit;
1041 foreach my $cust_svc (
1042 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
1044 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1046 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1047 $dbh->rollback if $oldAutoCommit;
1048 return "Illegal svcdb value in part_svc!";
1051 require "FS/$svcdb.pm";
1053 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1055 $error = $svc->suspend;
1057 $dbh->rollback if $oldAutoCommit;
1060 my( $label, $value ) = $cust_svc->label;
1061 push @labels, "$label: $value";
1065 my $conf = new FS::Conf;
1066 if ( $conf->config('suspend_email_admin') ) {
1068 my $error = send_email(
1069 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1070 #invoice_from ??? well as good as any
1071 'to' => $conf->config('suspend_email_admin'),
1072 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1074 "This is an automatic message from your Freeside installation\n",
1075 "informing you that the following customer package has been suspended:\n",
1077 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1078 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1079 ( map { "Service : $_\n" } @labels ),
1084 warn "WARNING: can't send suspension admin email (suspending anyway): ".
1092 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1097 sub credit_remaining {
1098 # Add a credit for remaining service
1100 my $time = shift or die 'no suspend/cancel time';
1101 my $conf = FS::Conf->new;
1102 my $last_bill = $self->getfield('last_bill') || 0;
1103 my $next_bill = $self->getfield('bill') || 0;
1104 if ( $last_bill > 0 # the package has been billed
1105 and $next_bill > 0 # the package has a next bill date
1106 and $next_bill >= $time # which is in the future
1108 my $remaining_value = $self->calc_remain('time' => $time);
1109 if ( $remaining_value > 0 ) {
1110 warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1112 my $error = $self->cust_main->credit(
1114 'Credit for unused time on '. $self->part_pkg->pkg,
1115 'reason_type' => $conf->config('cancel_credit_type'),
1116 ); # need 'suspend_credit_type'?
1117 return "Error crediting customer \$$remaining_value for unused time".
1118 " on ". $self->part_pkg->pkg. ": $error"
1120 } #if $remaining_value
1121 } #if $last_bill, etc.
1125 =item unsuspend [ OPTION => VALUE ... ]
1127 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1128 package, then unsuspends the package itself (clears the susp field and the
1129 adjourn field if it is in the past).
1131 Available options are:
1135 =item adjust_next_bill
1137 Can be set true to adjust the next bill date forward by
1138 the amount of time the account was inactive. This was set true by default
1139 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
1140 explicitly requested. Price plans for which this makes sense (anniversary-date
1141 based than prorate or subscription) could have an option to enable this
1146 If there is an error, returns the error, otherwise returns false.
1151 my( $self, %opt ) = @_;
1154 local $SIG{HUP} = 'IGNORE';
1155 local $SIG{INT} = 'IGNORE';
1156 local $SIG{QUIT} = 'IGNORE';
1157 local $SIG{TERM} = 'IGNORE';
1158 local $SIG{TSTP} = 'IGNORE';
1159 local $SIG{PIPE} = 'IGNORE';
1161 my $oldAutoCommit = $FS::UID::AutoCommit;
1162 local $FS::UID::AutoCommit = 0;
1165 my $old = $self->select_for_update;
1167 my $pkgnum = $old->pkgnum;
1168 if ( $old->get('cancel') || $self->get('cancel') ) {
1169 dbh->rollback if $oldAutoCommit;
1170 return "Can't unsuspend cancelled package $pkgnum";
1173 unless ( $old->get('susp') && $self->get('susp') ) {
1174 dbh->rollback if $oldAutoCommit;
1175 return ""; # no error # complain instead?
1178 foreach my $cust_svc (
1179 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1181 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1183 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1184 $dbh->rollback if $oldAutoCommit;
1185 return "Illegal svcdb value in part_svc!";
1188 require "FS/$svcdb.pm";
1190 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1192 $error = $svc->unsuspend;
1194 $dbh->rollback if $oldAutoCommit;
1201 my %hash = $self->hash;
1202 my $inactive = time - $hash{'susp'};
1204 my $conf = new FS::Conf;
1206 if ( $inactive > 0 &&
1207 ( $hash{'bill'} || $hash{'setup'} ) &&
1208 ( $opt{'adjust_next_bill'} ||
1209 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1210 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1213 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1218 $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
1219 my $new = new FS::cust_pkg ( \%hash );
1220 $error = $new->replace( $self, options => { $self->options } );
1222 $dbh->rollback if $oldAutoCommit;
1226 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1233 Cancels any pending suspension (sets the adjourn field to null).
1235 If there is an error, returns the error, otherwise returns false.
1240 my( $self, %options ) = @_;
1243 local $SIG{HUP} = 'IGNORE';
1244 local $SIG{INT} = 'IGNORE';
1245 local $SIG{QUIT} = 'IGNORE';
1246 local $SIG{TERM} = 'IGNORE';
1247 local $SIG{TSTP} = 'IGNORE';
1248 local $SIG{PIPE} = 'IGNORE';
1250 my $oldAutoCommit = $FS::UID::AutoCommit;
1251 local $FS::UID::AutoCommit = 0;
1254 my $old = $self->select_for_update;
1256 my $pkgnum = $old->pkgnum;
1257 if ( $old->get('cancel') || $self->get('cancel') ) {
1258 dbh->rollback if $oldAutoCommit;
1259 return "Can't unadjourn cancelled package $pkgnum";
1260 # or at least it's pointless
1263 if ( $old->get('susp') || $self->get('susp') ) {
1264 dbh->rollback if $oldAutoCommit;
1265 return "Can't unadjourn suspended package $pkgnum";
1266 # perhaps this is arbitrary
1269 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1270 dbh->rollback if $oldAutoCommit;
1271 return ""; # no error
1274 my %hash = $self->hash;
1275 $hash{'adjourn'} = '';
1276 my $new = new FS::cust_pkg ( \%hash );
1277 $error = $new->replace( $self, options => { $self->options } );
1279 $dbh->rollback if $oldAutoCommit;
1283 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1290 =item change HASHREF | OPTION => VALUE ...
1292 Changes this package: cancels it and creates a new one, with a different
1293 pkgpart or locationnum or both. All services are transferred to the new
1294 package (no change will be made if this is not possible).
1296 Options may be passed as a list of key/value pairs or as a hash reference.
1303 New locationnum, to change the location for this package.
1307 New FS::cust_location object, to create a new location and assign it
1312 New pkgpart (see L<FS::part_pkg>).
1316 New refnum (see L<FS::part_referral>).
1320 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1321 susp, adjourn, cancel, expire, and contract_end) to the new package.
1325 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1326 (otherwise, what's the point?)
1328 Returns either the new FS::cust_pkg object or a scalar error.
1332 my $err_or_new_cust_pkg = $old_cust_pkg->change
1336 #some false laziness w/order
1339 my $opt = ref($_[0]) ? shift : { @_ };
1341 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1344 my $conf = new FS::Conf;
1346 # Transactionize this whole mess
1347 local $SIG{HUP} = 'IGNORE';
1348 local $SIG{INT} = 'IGNORE';
1349 local $SIG{QUIT} = 'IGNORE';
1350 local $SIG{TERM} = 'IGNORE';
1351 local $SIG{TSTP} = 'IGNORE';
1352 local $SIG{PIPE} = 'IGNORE';
1354 my $oldAutoCommit = $FS::UID::AutoCommit;
1355 local $FS::UID::AutoCommit = 0;
1364 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1366 #$hash{$_} = $self->$_() foreach qw( setup );
1368 $hash{'setup'} = $time if $self->setup;
1370 $hash{'change_date'} = $time;
1371 $hash{"change_$_"} = $self->$_()
1372 foreach qw( pkgnum pkgpart locationnum );
1374 if ( $opt->{'cust_location'} &&
1375 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1376 $error = $opt->{'cust_location'}->insert;
1378 $dbh->rollback if $oldAutoCommit;
1379 return "inserting cust_location (transaction rolled back): $error";
1381 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1384 my $unused_credit = 0;
1385 my $keep_dates = $opt->{'keep_dates'};
1386 # Special case. If the pkgpart is changing, and the customer is
1387 # going to be credited for remaining time, don't keep setup, bill,
1388 # or last_bill dates, and DO pass the flag to cancel() to credit
1390 if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
1392 $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
1393 $hash{$_} = '' foreach qw(setup bill last_bill);
1396 if ( $keep_dates ) {
1397 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1398 start_date contract_end ) ) {
1399 $hash{$date} = $self->getfield($date);
1402 # allow $opt->{'locationnum'} = '' to specifically set it to null
1403 # (i.e. customer default location)
1404 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
1406 # Create the new package.
1407 my $cust_pkg = new FS::cust_pkg {
1408 custnum => $self->custnum,
1409 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1410 refnum => ( $opt->{'refnum'} || $self->refnum ),
1411 locationnum => ( $opt->{'locationnum'} ),
1415 $error = $cust_pkg->insert( 'change' => 1 );
1417 $dbh->rollback if $oldAutoCommit;
1421 # Transfer services and cancel old package.
1423 $error = $self->transfer($cust_pkg);
1424 if ($error and $error == 0) {
1425 # $old_pkg->transfer failed.
1426 $dbh->rollback if $oldAutoCommit;
1430 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1431 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1432 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1433 if ($error and $error == 0) {
1434 # $old_pkg->transfer failed.
1435 $dbh->rollback if $oldAutoCommit;
1441 # Transfers were successful, but we still had services left on the old
1442 # package. We can't change the package under this circumstances, so abort.
1443 $dbh->rollback if $oldAutoCommit;
1444 return "Unable to transfer all services from package ". $self->pkgnum;
1447 #reset usage if changing pkgpart
1448 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1449 if ($self->pkgpart != $cust_pkg->pkgpart) {
1450 my $part_pkg = $cust_pkg->part_pkg;
1451 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1455 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1458 $dbh->rollback if $oldAutoCommit;
1459 return "Error setting usage values: $error";
1463 #Good to go, cancel old package. Notify 'cancel' of whether to credit
1465 #Don't allow billing the package (preceding period packages and/or
1466 #outstanding usage) if we are keeping dates (i.e. location changing),
1467 #because the new package will be billed for the same date range.
1468 $error = $self->cancel(
1470 unused_credit => $unused_credit,
1471 nobill => $keep_dates
1474 $dbh->rollback if $oldAutoCommit;
1478 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1480 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1482 $dbh->rollback if $oldAutoCommit;
1487 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1493 use Storable 'thaw';
1495 sub process_bulk_cust_pkg {
1497 my $param = thaw(decode_base64(shift));
1498 warn Dumper($param) if $DEBUG;
1500 my $old_part_pkg = qsearchs('part_pkg',
1501 { pkgpart => $param->{'old_pkgpart'} });
1502 my $new_part_pkg = qsearchs('part_pkg',
1503 { pkgpart => $param->{'new_pkgpart'} });
1504 die "Must select a new package type\n" unless $new_part_pkg;
1505 #my $keep_dates = $param->{'keep_dates'} || 0;
1506 my $keep_dates = 1; # there is no good reason to turn this off
1508 local $SIG{HUP} = 'IGNORE';
1509 local $SIG{INT} = 'IGNORE';
1510 local $SIG{QUIT} = 'IGNORE';
1511 local $SIG{TERM} = 'IGNORE';
1512 local $SIG{TSTP} = 'IGNORE';
1513 local $SIG{PIPE} = 'IGNORE';
1515 my $oldAutoCommit = $FS::UID::AutoCommit;
1516 local $FS::UID::AutoCommit = 0;
1519 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1522 foreach my $old_cust_pkg ( @cust_pkgs ) {
1524 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1525 if ( $old_cust_pkg->getfield('cancel') ) {
1526 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1527 $old_cust_pkg->pkgnum."\n"
1531 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1533 my $error = $old_cust_pkg->change(
1534 'pkgpart' => $param->{'new_pkgpart'},
1535 'keep_dates' => $keep_dates
1537 if ( !ref($error) ) { # change returns the cust_pkg on success
1539 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1542 $dbh->commit if $oldAutoCommit;
1548 Returns the last bill date, or if there is no last bill date, the setup date.
1549 Useful for billing metered services.
1555 return $self->setfield('last_bill', $_[0]) if @_;
1556 return $self->getfield('last_bill') if $self->getfield('last_bill');
1557 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1558 'edate' => $self->bill, } );
1559 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1562 =item last_cust_pkg_reason ACTION
1564 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1565 Returns false if there is no reason or the package is not currenly ACTION'd
1566 ACTION is one of adjourn, susp, cancel, or expire.
1570 sub last_cust_pkg_reason {
1571 my ( $self, $action ) = ( shift, shift );
1572 my $date = $self->get($action);
1574 'table' => 'cust_pkg_reason',
1575 'hashref' => { 'pkgnum' => $self->pkgnum,
1576 'action' => substr(uc($action), 0, 1),
1579 'order_by' => 'ORDER BY num DESC LIMIT 1',
1583 =item last_reason ACTION
1585 Returns the most recent ACTION FS::reason associated with the package.
1586 Returns false if there is no reason or the package is not currenly ACTION'd
1587 ACTION is one of adjourn, susp, cancel, or expire.
1592 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1593 $cust_pkg_reason->reason
1594 if $cust_pkg_reason;
1599 Returns the definition for this billing item, as an FS::part_pkg object (see
1606 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1607 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1608 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1613 Returns the cancelled package this package was changed from, if any.
1619 return '' unless $self->change_pkgnum;
1620 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1625 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1632 $self->part_pkg->calc_setup($self, @_);
1637 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1644 $self->part_pkg->calc_recur($self, @_);
1649 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1656 $self->part_pkg->base_recur($self, @_);
1661 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1668 $self->part_pkg->calc_remain($self, @_);
1673 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1680 $self->part_pkg->calc_cancel($self, @_);
1685 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1691 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1694 =item cust_pkg_detail [ DETAILTYPE ]
1696 Returns any customer package details for this package (see
1697 L<FS::cust_pkg_detail>).
1699 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1703 sub cust_pkg_detail {
1705 my %hash = ( 'pkgnum' => $self->pkgnum );
1706 $hash{detailtype} = shift if @_;
1708 'table' => 'cust_pkg_detail',
1709 'hashref' => \%hash,
1710 'order_by' => 'ORDER BY weight, pkgdetailnum',
1714 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1716 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1718 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1720 If there is an error, returns the error, otherwise returns false.
1724 sub set_cust_pkg_detail {
1725 my( $self, $detailtype, @details ) = @_;
1727 local $SIG{HUP} = 'IGNORE';
1728 local $SIG{INT} = 'IGNORE';
1729 local $SIG{QUIT} = 'IGNORE';
1730 local $SIG{TERM} = 'IGNORE';
1731 local $SIG{TSTP} = 'IGNORE';
1732 local $SIG{PIPE} = 'IGNORE';
1734 my $oldAutoCommit = $FS::UID::AutoCommit;
1735 local $FS::UID::AutoCommit = 0;
1738 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1739 my $error = $current->delete;
1741 $dbh->rollback if $oldAutoCommit;
1742 return "error removing old detail: $error";
1746 foreach my $detail ( @details ) {
1747 my $cust_pkg_detail = new FS::cust_pkg_detail {
1748 'pkgnum' => $self->pkgnum,
1749 'detailtype' => $detailtype,
1750 'detail' => $detail,
1752 my $error = $cust_pkg_detail->insert;
1754 $dbh->rollback if $oldAutoCommit;
1755 return "error adding new detail: $error";
1760 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1767 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1771 #false laziness w/cust_bill.pm
1775 'table' => 'cust_event',
1776 'addl_from' => 'JOIN part_event USING ( eventpart )',
1777 'hashref' => { 'tablenum' => $self->pkgnum },
1778 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1782 =item num_cust_event
1784 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1788 #false laziness w/cust_bill.pm
1789 sub num_cust_event {
1792 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1793 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1794 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1795 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1796 $sth->fetchrow_arrayref->[0];
1799 =item cust_svc [ SVCPART ] (old, deprecated usage)
1801 =item cust_svc [ OPTION => VALUE ... ] (current usage)
1803 Returns the services for this package, as FS::cust_svc objects (see
1804 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
1805 spcififed, returns only the matching services.
1812 return () unless $self->num_cust_svc(@_);
1815 if ( @_ && $_[0] =~ /^\d+/ ) {
1816 $opt{svcpart} = shift;
1817 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
1824 'table' => 'cust_svc',
1825 'hashref' => { 'pkgnum' => $self->pkgnum },
1827 if ( $opt{svcpart} ) {
1828 $search{hashref}->{svcpart} = $opt{'svcpart'};
1830 if ( $opt{'svcdb'} ) {
1831 $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
1832 $search{hashref}->{svcdb} = $opt{'svcdb'};
1835 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1837 #if ( $self->{'_svcnum'} ) {
1838 # values %{ $self->{'_svcnum'}->cache };
1840 $self->_sort_cust_svc( [ qsearch(\%search) ] );
1845 =item overlimit [ SVCPART ]
1847 Returns the services for this package which have exceeded their
1848 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1849 is specified, return only the matching services.
1855 return () unless $self->num_cust_svc(@_);
1856 grep { $_->overlimit } $self->cust_svc(@_);
1859 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1861 Returns historical services for this package created before END TIMESTAMP and
1862 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1863 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
1864 I<pkg_svc.hidden> flag will be omitted.
1870 warn "$me _h_cust_svc called on $self\n"
1873 my ($end, $start, $mode) = @_;
1874 my @cust_svc = $self->_sort_cust_svc(
1875 [ qsearch( 'h_cust_svc',
1876 { 'pkgnum' => $self->pkgnum, },
1877 FS::h_cust_svc->sql_h_search(@_),
1880 if ( defined($mode) && $mode eq 'I' ) {
1881 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1882 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1888 sub _sort_cust_svc {
1889 my( $self, $arrayref ) = @_;
1892 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1897 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1898 'svcpart' => $_->svcpart } );
1900 $pkg_svc ? $pkg_svc->primary_svc : '',
1901 $pkg_svc ? $pkg_svc->quantity : 0,
1908 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
1910 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
1912 Returns the number of services for this package. Available options are svcpart
1913 and svcdb. If either is spcififed, returns only the matching services.
1920 return $self->{'_num_cust_svc'}
1922 && exists($self->{'_num_cust_svc'})
1923 && $self->{'_num_cust_svc'} =~ /\d/;
1925 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
1929 if ( @_ && $_[0] =~ /^\d+/ ) {
1930 $opt{svcpart} = shift;
1931 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
1937 my $select = 'SELECT COUNT(*) FROM cust_svc ';
1938 my $where = ' WHERE pkgnum = ? ';
1939 my @param = ($self->pkgnum);
1941 if ( $opt{'svcpart'} ) {
1942 $where .= ' AND svcpart = ? ';
1943 push @param, $opt{'svcpart'};
1945 if ( $opt{'svcdb'} ) {
1946 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
1947 $where .= ' AND svcdb = ? ';
1948 push @param, $opt{'svcdb'};
1951 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
1952 $sth->execute(@param) or die $sth->errstr;
1953 $sth->fetchrow_arrayref->[0];
1956 =item available_part_svc
1958 Returns a list of FS::part_svc objects representing services included in this
1959 package but not yet provisioned. Each FS::part_svc object also has an extra
1960 field, I<num_avail>, which specifies the number of available services.
1964 sub available_part_svc {
1966 grep { $_->num_avail > 0 }
1968 my $part_svc = $_->part_svc;
1969 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
1970 $_->quantity - $self->num_cust_svc($_->svcpart);
1972 # more evil encapsulation breakage
1973 if($part_svc->{'Hash'}{'num_avail'} > 0) {
1974 my @exports = $part_svc->part_export_did;
1975 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
1980 $self->part_pkg->pkg_svc;
1983 =item part_svc [ OPTION => VALUE ... ]
1985 Returns a list of FS::part_svc objects representing provisioned and available
1986 services included in this package. Each FS::part_svc object also has the
1987 following extra fields:
1991 =item num_cust_svc (count)
1993 =item num_avail (quantity - count)
1995 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
1999 Accepts one option: summarize_size. If specified and non-zero, will omit the
2000 extra cust_pkg_svc option for objects where num_cust_svc is this size or
2006 #label -> ($cust_svc->label)[1]
2012 #XXX some sort of sort order besides numeric by svcpart...
2013 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
2015 my $part_svc = $pkg_svc->part_svc;
2016 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2017 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
2018 $part_svc->{'Hash'}{'num_avail'} =
2019 max( 0, $pkg_svc->quantity - $num_cust_svc );
2020 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2021 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
2022 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
2023 && $num_cust_svc >= $opt{summarize_size};
2024 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
2026 } $self->part_pkg->pkg_svc;
2029 push @part_svc, map {
2031 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2032 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
2033 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
2034 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2035 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
2037 } $self->extra_part_svc;
2043 =item extra_part_svc
2045 Returns a list of FS::part_svc objects corresponding to services in this
2046 package which are still provisioned but not (any longer) available in the
2051 sub extra_part_svc {
2054 my $pkgnum = $self->pkgnum;
2055 #my $pkgpart = $self->pkgpart;
2058 # 'table' => 'part_svc',
2061 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
2062 # WHERE pkg_svc.svcpart = part_svc.svcpart
2063 # AND pkg_svc.pkgpart = ?
2066 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
2067 # LEFT JOIN cust_pkg USING ( pkgnum )
2068 # WHERE cust_svc.svcpart = part_svc.svcpart
2071 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
2074 #seems to benchmark slightly faster... (or did?)
2076 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
2077 my $pkgparts = join(',', @pkgparts);
2080 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
2081 #MySQL doesn't grok DISINCT ON
2082 'select' => 'DISTINCT part_svc.*',
2083 'table' => 'part_svc',
2085 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
2086 AND pkg_svc.pkgpart IN ($pkgparts)
2089 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
2090 LEFT JOIN cust_pkg USING ( pkgnum )
2093 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
2094 'extra_param' => [ [$self->pkgnum=>'int'] ],
2100 Returns a short status string for this package, currently:
2104 =item not yet billed
2106 =item one-time charge
2121 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
2123 return 'cancelled' if $self->get('cancel');
2124 return 'suspended' if $self->susp;
2125 return 'not yet billed' unless $self->setup;
2126 return 'one-time charge' if $freq =~ /^(0|$)/;
2130 =item ucfirst_status
2132 Returns the status with the first character capitalized.
2136 sub ucfirst_status {
2137 ucfirst(shift->status);
2142 Class method that returns the list of possible status strings for packages
2143 (see L<the status method|/status>). For example:
2145 @statuses = FS::cust_pkg->statuses();
2149 tie my %statuscolor, 'Tie::IxHash',
2150 'not yet billed' => '009999', #teal? cyan?
2151 'one-time charge' => '000000',
2152 'active' => '00CC00',
2153 'suspended' => 'FF9900',
2154 'cancelled' => 'FF0000',
2158 my $self = shift; #could be class...
2159 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2160 # # mayble split btw one-time vs. recur
2166 Returns a hex triplet color string for this package's status.
2172 $statuscolor{$self->status};
2177 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
2178 "pkg-comment" depending on user preference).
2184 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2185 $label = $self->pkgnum. ": $label"
2186 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2190 =item pkg_label_long
2192 Returns a long label for this package, adding the primary service's label to
2197 sub pkg_label_long {
2199 my $label = $self->pkg_label;
2200 my $cust_svc = $self->primary_cust_svc;
2201 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2205 =item primary_cust_svc
2207 Returns a primary service (as FS::cust_svc object) if one can be identified.
2211 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2213 sub primary_cust_svc {
2216 my @cust_svc = $self->cust_svc;
2218 return '' unless @cust_svc; #no serivces - irrelevant then
2220 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2222 # primary service as specified in the package definition
2223 # or exactly one service definition with quantity one
2224 my $svcpart = $self->part_pkg->svcpart;
2225 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2226 return $cust_svc[0] if scalar(@cust_svc) == 1;
2228 #couldn't identify one thing..
2234 Returns a list of lists, calling the label method for all services
2235 (see L<FS::cust_svc>) of this billing item.
2241 map { [ $_->label ] } $self->cust_svc;
2244 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2246 Like the labels method, but returns historical information on services that
2247 were active as of END_TIMESTAMP and (optionally) not cancelled before
2248 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
2249 I<pkg_svc.hidden> flag will be omitted.
2251 Returns a list of lists, calling the label method for all (historical) services
2252 (see L<FS::h_cust_svc>) of this billing item.
2258 warn "$me _h_labels called on $self\n"
2260 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2265 Like labels, except returns a simple flat list, and shortens long
2266 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2267 identical services to one line that lists the service label and the number of
2268 individual services rather than individual items.
2273 shift->_labels_short( 'labels', @_ );
2276 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2278 Like h_labels, except returns a simple flat list, and shortens long
2279 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2280 identical services to one line that lists the service label and the number of
2281 individual services rather than individual items.
2285 sub h_labels_short {
2286 shift->_labels_short( 'h_labels', @_ );
2290 my( $self, $method ) = ( shift, shift );
2292 warn "$me _labels_short called on $self with $method method\n"
2295 my $conf = new FS::Conf;
2296 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2298 warn "$me _labels_short populating \%labels\n"
2302 #tie %labels, 'Tie::IxHash';
2303 push @{ $labels{$_->[0]} }, $_->[1]
2304 foreach $self->$method(@_);
2306 warn "$me _labels_short populating \@labels\n"
2310 foreach my $label ( keys %labels ) {
2312 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2313 my $num = scalar(@values);
2314 warn "$me _labels_short $num items for $label\n"
2317 if ( $num > $max_same_services ) {
2318 warn "$me _labels_short more than $max_same_services, so summarizing\n"
2320 push @labels, "$label ($num)";
2322 if ( $conf->exists('cust_bill-consolidate_services') ) {
2323 warn "$me _labels_short consolidating services\n"
2325 # push @labels, "$label: ". join(', ', @values);
2327 my $detail = "$label: ";
2328 $detail .= shift(@values). ', '
2330 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
2332 push @labels, $detail;
2334 warn "$me _labels_short done consolidating services\n"
2337 warn "$me _labels_short adding service data\n"
2339 push @labels, map { "$label: $_" } @values;
2350 Returns the parent customer object (see L<FS::cust_main>).
2356 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2359 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2363 Returns the location object, if any (see L<FS::cust_location>).
2365 =item cust_location_or_main
2367 If this package is associated with a location, returns the locaiton (see
2368 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2370 =item location_label [ OPTION => VALUE ... ]
2372 Returns the label of the location object (see L<FS::cust_location>).
2376 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2378 =item seconds_since TIMESTAMP
2380 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2381 package have been online since TIMESTAMP, according to the session monitor.
2383 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2384 L<Time::Local> and L<Date::Parse> for conversion functions.
2389 my($self, $since) = @_;
2392 foreach my $cust_svc (
2393 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2395 $seconds += $cust_svc->seconds_since($since);
2402 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2404 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2405 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2408 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2409 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2415 sub seconds_since_sqlradacct {
2416 my($self, $start, $end) = @_;
2420 foreach my $cust_svc (
2422 my $part_svc = $_->part_svc;
2423 $part_svc->svcdb eq 'svc_acct'
2424 && scalar($part_svc->part_export('sqlradius'));
2427 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2434 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2436 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2437 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2441 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2442 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2447 sub attribute_since_sqlradacct {
2448 my($self, $start, $end, $attrib) = @_;
2452 foreach my $cust_svc (
2454 my $part_svc = $_->part_svc;
2455 $part_svc->svcdb eq 'svc_acct'
2456 && scalar($part_svc->part_export('sqlradius'));
2459 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2471 my( $self, $value ) = @_;
2472 if ( defined($value) ) {
2473 $self->setfield('quantity', $value);
2475 $self->getfield('quantity') || 1;
2478 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2480 Transfers as many services as possible from this package to another package.
2482 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2483 object. The destination package must already exist.
2485 Services are moved only if the destination allows services with the correct
2486 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2487 this option with caution! No provision is made for export differences
2488 between the old and new service definitions. Probably only should be used
2489 when your exports for all service definitions of a given svcdb are identical.
2490 (attempt a transfer without it first, to move all possible svcpart-matching
2493 Any services that can't be moved remain in the original package.
2495 Returns an error, if there is one; otherwise, returns the number of services
2496 that couldn't be moved.
2501 my ($self, $dest_pkgnum, %opt) = @_;
2507 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2508 $dest = $dest_pkgnum;
2509 $dest_pkgnum = $dest->pkgnum;
2511 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2514 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2516 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2517 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2520 foreach my $cust_svc ($dest->cust_svc) {
2521 $target{$cust_svc->svcpart}--;
2524 my %svcpart2svcparts = ();
2525 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2526 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2527 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2528 next if exists $svcpart2svcparts{$svcpart};
2529 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2530 $svcpart2svcparts{$svcpart} = [
2532 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2534 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2535 'svcpart' => $_ } );
2537 $pkg_svc ? $pkg_svc->primary_svc : '',
2538 $pkg_svc ? $pkg_svc->quantity : 0,
2542 grep { $_ != $svcpart }
2544 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2546 warn "alternates for svcpart $svcpart: ".
2547 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2552 foreach my $cust_svc ($self->cust_svc) {
2553 if($target{$cust_svc->svcpart} > 0) {
2554 $target{$cust_svc->svcpart}--;
2555 my $new = new FS::cust_svc { $cust_svc->hash };
2556 $new->pkgnum($dest_pkgnum);
2557 my $error = $new->replace($cust_svc);
2558 return $error if $error;
2559 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2561 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2562 warn "alternates to consider: ".
2563 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2565 my @alternate = grep {
2566 warn "considering alternate svcpart $_: ".
2567 "$target{$_} available in new package\n"
2570 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2572 warn "alternate(s) found\n" if $DEBUG;
2573 my $change_svcpart = $alternate[0];
2574 $target{$change_svcpart}--;
2575 my $new = new FS::cust_svc { $cust_svc->hash };
2576 $new->svcpart($change_svcpart);
2577 $new->pkgnum($dest_pkgnum);
2578 my $error = $new->replace($cust_svc);
2579 return $error if $error;
2592 This method is deprecated. See the I<depend_jobnum> option to the insert and
2593 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2600 local $SIG{HUP} = 'IGNORE';
2601 local $SIG{INT} = 'IGNORE';
2602 local $SIG{QUIT} = 'IGNORE';
2603 local $SIG{TERM} = 'IGNORE';
2604 local $SIG{TSTP} = 'IGNORE';
2605 local $SIG{PIPE} = 'IGNORE';
2607 my $oldAutoCommit = $FS::UID::AutoCommit;
2608 local $FS::UID::AutoCommit = 0;
2611 foreach my $cust_svc ( $self->cust_svc ) {
2612 #false laziness w/svc_Common::insert
2613 my $svc_x = $cust_svc->svc_x;
2614 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2615 my $error = $part_export->export_insert($svc_x);
2617 $dbh->rollback if $oldAutoCommit;
2623 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2630 Associates this package with a (suspension or cancellation) reason (see
2631 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2634 Available options are:
2640 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.
2644 the access_user (see L<FS::access_user>) providing the reason
2652 the action (cancel, susp, adjourn, expire) associated with the reason
2656 If there is an error, returns the error, otherwise returns false.
2661 my ($self, %options) = @_;
2663 my $otaker = $options{reason_otaker} ||
2664 $FS::CurrentUser::CurrentUser->username;
2667 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2671 } elsif ( ref($options{'reason'}) ) {
2673 return 'Enter a new reason (or select an existing one)'
2674 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2676 my $reason = new FS::reason({
2677 'reason_type' => $options{'reason'}->{'typenum'},
2678 'reason' => $options{'reason'}->{'reason'},
2680 my $error = $reason->insert;
2681 return $error if $error;
2683 $reasonnum = $reason->reasonnum;
2686 return "Unparsable reason: ". $options{'reason'};
2689 my $cust_pkg_reason =
2690 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2691 'reasonnum' => $reasonnum,
2692 'otaker' => $otaker,
2693 'action' => substr(uc($options{'action'}),0,1),
2694 'date' => $options{'date'}
2699 $cust_pkg_reason->insert;
2702 =item insert_discount
2704 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2705 inserting a new discount on the fly (see L<FS::discount>).
2707 Available options are:
2715 If there is an error, returns the error, otherwise returns false.
2719 sub insert_discount {
2720 #my ($self, %options) = @_;
2723 my $cust_pkg_discount = new FS::cust_pkg_discount {
2724 'pkgnum' => $self->pkgnum,
2725 'discountnum' => $self->discountnum,
2727 'end_date' => '', #XXX
2728 #for the create a new discount case
2729 '_type' => $self->discountnum__type,
2730 'amount' => $self->discountnum_amount,
2731 'percent' => $self->discountnum_percent,
2732 'months' => $self->discountnum_months,
2733 'setup' => $self->discountnum_setup,
2734 #'disabled' => $self->discountnum_disabled,
2737 $cust_pkg_discount->insert;
2740 =item set_usage USAGE_VALUE_HASHREF
2742 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2743 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2744 upbytes, downbytes, and totalbytes are appropriate keys.
2746 All svc_accts which are part of this package have their values reset.
2751 my ($self, $valueref, %opt) = @_;
2753 #only svc_acct can set_usage for now
2754 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
2755 my $svc_x = $cust_svc->svc_x;
2756 $svc_x->set_usage($valueref, %opt)
2757 if $svc_x->can("set_usage");
2761 =item recharge USAGE_VALUE_HASHREF
2763 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2764 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2765 upbytes, downbytes, and totalbytes are appropriate keys.
2767 All svc_accts which are part of this package have their values incremented.
2772 my ($self, $valueref) = @_;
2774 #only svc_acct can set_usage for now
2775 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
2776 my $svc_x = $cust_svc->svc_x;
2777 $svc_x->recharge($valueref)
2778 if $svc_x->can("recharge");
2782 =item cust_pkg_discount
2786 sub cust_pkg_discount {
2788 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2791 =item cust_pkg_discount_active
2795 sub cust_pkg_discount_active {
2797 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2802 =head1 CLASS METHODS
2808 Returns an SQL expression identifying recurring packages.
2812 sub recurring_sql { "
2813 '0' != ( select freq from part_pkg
2814 where cust_pkg.pkgpart = part_pkg.pkgpart )
2819 Returns an SQL expression identifying one-time packages.
2824 '0' = ( select freq from part_pkg
2825 where cust_pkg.pkgpart = part_pkg.pkgpart )
2830 Returns an SQL expression identifying ordered packages (recurring packages not
2836 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2841 Returns an SQL expression identifying active packages.
2846 $_[0]->recurring_sql. "
2847 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2848 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2849 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2852 =item not_yet_billed_sql
2854 Returns an SQL expression identifying packages which have not yet been billed.
2858 sub not_yet_billed_sql { "
2859 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2860 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2861 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2866 Returns an SQL expression identifying inactive packages (one-time packages
2867 that are otherwise unsuspended/uncancelled).
2871 sub inactive_sql { "
2872 ". $_[0]->onetime_sql(). "
2873 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2874 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2875 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2881 Returns an SQL expression identifying suspended packages.
2885 sub suspended_sql { susp_sql(@_); }
2887 #$_[0]->recurring_sql(). ' AND '.
2889 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2890 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2897 Returns an SQL exprression identifying cancelled packages.
2901 sub cancelled_sql { cancel_sql(@_); }
2903 #$_[0]->recurring_sql(). ' AND '.
2904 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2909 Returns an SQL expression to give the package status as a string.
2915 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2916 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2917 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2918 WHEN ".onetime_sql()." THEN 'one-time charge'
2923 =item search HASHREF
2927 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2928 Valid parameters are
2936 active, inactive, suspended, cancel (or cancelled)
2940 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
2944 boolean selects custom packages
2950 pkgpart or arrayref or hashref of pkgparts
2954 arrayref of beginning and ending epoch date
2958 arrayref of beginning and ending epoch date
2962 arrayref of beginning and ending epoch date
2966 arrayref of beginning and ending epoch date
2970 arrayref of beginning and ending epoch date
2974 arrayref of beginning and ending epoch date
2978 arrayref of beginning and ending epoch date
2982 pkgnum or APKG_pkgnum
2986 a value suited to passing to FS::UI::Web::cust_header
2990 specifies the user for agent virtualization
2994 boolean selects packages containing fcc form 477 telco lines
3001 my ($class, $params) = @_;
3008 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
3010 "cust_main.agentnum = $1";
3017 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
3019 "cust_pkg.custnum = $1";
3026 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
3028 "cust_pkg.pkgbatch = '$1'";
3035 if ( $params->{'magic'} eq 'active'
3036 || $params->{'status'} eq 'active' ) {
3038 push @where, FS::cust_pkg->active_sql();
3040 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
3041 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
3043 push @where, FS::cust_pkg->not_yet_billed_sql();
3045 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
3046 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
3048 push @where, FS::cust_pkg->inactive_sql();
3050 } elsif ( $params->{'magic'} eq 'suspended'
3051 || $params->{'status'} eq 'suspended' ) {
3053 push @where, FS::cust_pkg->suspended_sql();
3055 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
3056 || $params->{'status'} =~ /^cancell?ed$/ ) {
3058 push @where, FS::cust_pkg->cancelled_sql();
3063 # parse package class
3066 if ( exists($params->{'classnum'}) ) {
3069 if ( ref($params->{'classnum'}) ) {
3071 if ( ref($params->{'classnum'}) eq 'HASH' ) {
3072 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
3073 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
3074 @classnum = @{ $params->{'classnum'} };
3076 die 'unhandled classnum ref '. $params->{'classnum'};
3080 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
3087 my @nums = grep $_, @classnum;
3088 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
3089 my $null = scalar( grep { $_ eq '' } @classnum );
3090 push @c_where, 'part_pkg.classnum IS NULL' if $null;
3092 if ( scalar(@c_where) == 1 ) {
3093 push @where, @c_where;
3094 } elsif ( @c_where ) {
3095 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
3105 # parse package report options
3108 my @report_option = ();
3109 if ( exists($params->{'report_option'}) ) {
3110 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
3111 @report_option = @{ $params->{'report_option'} };
3112 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
3113 @report_option = split(',', $1);
3118 if (@report_option) {
3119 # this will result in the empty set for the dangling comma case as it should
3121 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3122 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3123 AND optionname = 'report_option_$_'
3124 AND optionvalue = '1' )"
3128 foreach my $any ( grep /^report_option_any/, keys %$params ) {
3130 my @report_option_any = ();
3131 if ( ref($params->{$any}) eq 'ARRAY' ) {
3132 @report_option_any = @{ $params->{$any} };
3133 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
3134 @report_option_any = split(',', $1);
3137 if (@report_option_any) {
3138 # this will result in the empty set for the dangling comma case as it should
3139 push @where, ' ( '. join(' OR ',
3140 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3141 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3142 AND optionname = 'report_option_$_'
3143 AND optionvalue = '1' )"
3144 } @report_option_any
3154 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
3160 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
3161 if $params->{fcc_line};
3167 if ( exists($params->{'censustract'}) ) {
3168 $params->{'censustract'} =~ /^([.\d]*)$/;
3169 my $censustract = "cust_main.censustract = '$1'";
3170 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
3171 push @where, "( $censustract )";
3175 # parse censustract2
3177 if ( exists($params->{'censustract2'})
3178 && $params->{'censustract2'} =~ /^(\d*)$/
3182 push @where, "cust_main.censustract LIKE '$1%'";
3185 "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
3193 if ( ref($params->{'pkgpart'}) ) {
3196 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3197 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3198 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3199 @pkgpart = @{ $params->{'pkgpart'} };
3201 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3204 @pkgpart = grep /^(\d+)$/, @pkgpart;
3206 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3208 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3209 push @where, "pkgpart = $1";
3218 #false laziness w/report_cust_pkg.html
3221 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3222 'active' => { 'susp'=>1, 'cancel'=>1 },
3223 'suspended' => { 'cancel' => 1 },
3228 if( exists($params->{'active'} ) ) {
3229 # This overrides all the other date-related fields
3230 my($beginning, $ending) = @{$params->{'active'}};
3232 "cust_pkg.setup IS NOT NULL",
3233 "cust_pkg.setup <= $ending",
3234 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3235 "NOT (".FS::cust_pkg->onetime_sql . ")";
3238 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
3240 next unless exists($params->{$field});
3242 my($beginning, $ending) = @{$params->{$field}};
3244 next if $beginning == 0 && $ending == 4294967295;
3247 "cust_pkg.$field IS NOT NULL",
3248 "cust_pkg.$field >= $beginning",
3249 "cust_pkg.$field <= $ending";
3251 $orderby ||= "ORDER BY cust_pkg.$field";
3256 $orderby ||= 'ORDER BY bill';
3259 # parse magic, legacy, etc.
3262 if ( $params->{'magic'} &&
3263 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3266 $orderby = 'ORDER BY pkgnum';
3268 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3269 push @where, "pkgpart = $1";
3272 } elsif ( $params->{'query'} eq 'pkgnum' ) {
3274 $orderby = 'ORDER BY pkgnum';
3276 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3278 $orderby = 'ORDER BY pkgnum';
3281 SELECT count(*) FROM pkg_svc
3282 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
3283 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3284 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
3285 AND cust_svc.svcpart = pkg_svc.svcpart
3292 # setup queries, links, subs, etc. for the search
3295 # here is the agent virtualization
3296 if ($params->{CurrentUser}) {
3298 qsearchs('access_user', { username => $params->{CurrentUser} });
3301 push @where, $access_user->agentnums_sql('table'=>'cust_main');
3306 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3309 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3311 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
3312 'LEFT JOIN part_pkg USING ( pkgpart ) '.
3313 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3315 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3318 'table' => 'cust_pkg',
3320 'select' => join(', ',
3322 ( map "part_pkg.$_", qw( pkg freq ) ),
3323 'pkg_class.classname',
3324 'cust_main.custnum AS cust_main_custnum',
3325 FS::UI::Web::cust_sql_fields(
3326 $params->{'cust_fields'}
3329 'extra_sql' => "$extra_sql $orderby",
3330 'addl_from' => $addl_from,
3331 'count_query' => $count_query,
3338 Returns a list of two package counts. The first is a count of packages
3339 based on the supplied criteria and the second is the count of residential
3340 packages with those same criteria. Criteria are specified as in the search
3346 my ($class, $params) = @_;
3348 my $sql_query = $class->search( $params );
3350 my $count_sql = delete($sql_query->{'count_query'});
3351 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3352 or die "couldn't parse count_sql";
3354 my $count_sth = dbh->prepare($count_sql)
3355 or die "Error preparing $count_sql: ". dbh->errstr;
3357 or die "Error executing $count_sql: ". $count_sth->errstr;
3358 my $count_arrayref = $count_sth->fetchrow_arrayref;
3360 return ( @$count_arrayref );
3367 Returns a list: the first item is an SQL fragment identifying matching
3368 packages/customers via location (taking into account shipping and package
3369 address taxation, if enabled), and subsequent items are the parameters to
3370 substitute for the placeholders in that fragment.
3375 my($class, %opt) = @_;
3376 my $ornull = $opt{'ornull'};
3378 my $conf = new FS::Conf;
3380 # '?' placeholders in _location_sql_where
3381 my $x = $ornull ? 3 : 2;
3382 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3386 if ( $conf->exists('tax-ship_address') ) {
3389 ( ( ship_last IS NULL OR ship_last = '' )
3390 AND ". _location_sql_where('cust_main', '', $ornull ). "
3392 OR ( ship_last IS NOT NULL AND ship_last != ''
3393 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3396 # AND payby != 'COMP'
3398 @main_param = ( @bill_param, @bill_param );
3402 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3403 @main_param = @bill_param;
3409 if ( $conf->exists('tax-pkg_address') ) {
3411 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3414 ( cust_pkg.locationnum IS NULL AND $main_where )
3415 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3418 @param = ( @main_param, @bill_param );
3422 $where = $main_where;
3423 @param = @main_param;
3431 #subroutine, helper for location_sql
3432 sub _location_sql_where {
3434 my $prefix = @_ ? shift : '';
3435 my $ornull = @_ ? shift : '';
3437 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3439 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3441 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3442 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3443 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3445 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3447 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3448 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3449 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3450 AND $table.${prefix}country = ?
3455 my( $self, $what ) = @_;
3457 my $what_show_zero = $what. '_show_zero';
3458 length($self->$what_show_zero())
3459 ? ($self->$what_show_zero() eq 'Y')
3460 : $self->part_pkg->$what_show_zero();
3467 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3469 CUSTNUM is a customer (see L<FS::cust_main>)
3471 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3472 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3475 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3476 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3477 new billing items. An error is returned if this is not possible (see
3478 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3481 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3482 newly-created cust_pkg objects.
3484 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3485 and inserted. Multiple FS::pkg_referral records can be created by
3486 setting I<refnum> to an array reference of refnums or a hash reference with
3487 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3488 record will be created corresponding to cust_main.refnum.
3493 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3495 my $conf = new FS::Conf;
3497 # Transactionize this whole mess
3498 local $SIG{HUP} = 'IGNORE';
3499 local $SIG{INT} = 'IGNORE';
3500 local $SIG{QUIT} = 'IGNORE';
3501 local $SIG{TERM} = 'IGNORE';
3502 local $SIG{TSTP} = 'IGNORE';
3503 local $SIG{PIPE} = 'IGNORE';
3505 my $oldAutoCommit = $FS::UID::AutoCommit;
3506 local $FS::UID::AutoCommit = 0;
3510 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3511 # return "Customer not found: $custnum" unless $cust_main;
3513 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3516 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3519 my $change = scalar(@old_cust_pkg) != 0;
3522 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3524 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3525 " to pkgpart ". $pkgparts->[0]. "\n"
3528 my $err_or_cust_pkg =
3529 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3530 'refnum' => $refnum,
3533 unless (ref($err_or_cust_pkg)) {
3534 $dbh->rollback if $oldAutoCommit;
3535 return $err_or_cust_pkg;
3538 push @$return_cust_pkg, $err_or_cust_pkg;
3539 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3544 # Create the new packages.
3545 foreach my $pkgpart (@$pkgparts) {
3547 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3549 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3550 pkgpart => $pkgpart,
3554 $error = $cust_pkg->insert( 'change' => $change );
3556 $dbh->rollback if $oldAutoCommit;
3559 push @$return_cust_pkg, $cust_pkg;
3561 # $return_cust_pkg now contains refs to all of the newly
3564 # Transfer services and cancel old packages.
3565 foreach my $old_pkg (@old_cust_pkg) {
3567 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3570 foreach my $new_pkg (@$return_cust_pkg) {
3571 $error = $old_pkg->transfer($new_pkg);
3572 if ($error and $error == 0) {
3573 # $old_pkg->transfer failed.
3574 $dbh->rollback if $oldAutoCommit;
3579 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3580 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3581 foreach my $new_pkg (@$return_cust_pkg) {
3582 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3583 if ($error and $error == 0) {
3584 # $old_pkg->transfer failed.
3585 $dbh->rollback if $oldAutoCommit;
3592 # Transfers were successful, but we went through all of the
3593 # new packages and still had services left on the old package.
3594 # We can't cancel the package under the circumstances, so abort.
3595 $dbh->rollback if $oldAutoCommit;
3596 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3598 $error = $old_pkg->cancel( quiet=>1 );
3604 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3608 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3610 A bulk change method to change packages for multiple customers.
3612 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3613 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3616 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3617 replace. The services (see L<FS::cust_svc>) are moved to the
3618 new billing items. An error is returned if this is not possible (see
3621 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3622 newly-created cust_pkg objects.
3627 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3629 # Transactionize this whole mess
3630 local $SIG{HUP} = 'IGNORE';
3631 local $SIG{INT} = 'IGNORE';
3632 local $SIG{QUIT} = 'IGNORE';
3633 local $SIG{TERM} = 'IGNORE';
3634 local $SIG{TSTP} = 'IGNORE';
3635 local $SIG{PIPE} = 'IGNORE';
3637 my $oldAutoCommit = $FS::UID::AutoCommit;
3638 local $FS::UID::AutoCommit = 0;
3642 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3645 while(scalar(@old_cust_pkg)) {
3647 my $custnum = $old_cust_pkg[0]->custnum;
3648 my (@remove) = map { $_->pkgnum }
3649 grep { $_->custnum == $custnum } @old_cust_pkg;
3650 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3652 my $error = order $custnum, $pkgparts, \@remove, \@return;
3654 push @errors, $error
3656 push @$return_cust_pkg, @return;
3659 if (scalar(@errors)) {
3660 $dbh->rollback if $oldAutoCommit;
3661 return join(' / ', @errors);
3664 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3668 # Used by FS::Upgrade to migrate to a new database.
3669 sub _upgrade_data { # class method
3670 my ($class, %opts) = @_;
3671 $class->_upgrade_otaker(%opts);
3673 # RT#10139, bug resulting in contract_end being set when it shouldn't
3674 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3675 # RT#10830, bad calculation of prorate date near end of year
3676 # the date range for bill is December 2009, and we move it forward
3677 # one year if it's before the previous bill date (which it should
3679 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3680 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3681 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3682 # RT6628, add order_date to cust_pkg
3683 'update cust_pkg set order_date = (select history_date from h_cust_pkg
3684 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3685 history_action = \'insert\') where order_date is null',
3687 foreach my $sql (@statements) {
3688 my $sth = dbh->prepare($sql);
3689 $sth->execute or die $sth->errstr;
3697 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3699 In sub order, the @pkgparts array (passed by reference) is clobbered.
3701 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3702 method to pass dates to the recur_prog expression, it should do so.
3704 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3705 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3706 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3707 configuration values. Probably need a subroutine which decides what to do
3708 based on whether or not we've fetched the user yet, rather than a hash. See
3709 FS::UID and the TODO.
3711 Now that things are transactional should the check in the insert method be
3716 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3717 L<FS::pkg_svc>, schema.html from the base documentation