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('resume')
609 || $self->ut_numbern('expire')
610 || $self->ut_numbern('dundate')
611 || $self->ut_enum('no_auto', [ '', 'Y' ])
612 || $self->ut_enum('waive_setup', [ '', 'Y' ])
613 || $self->ut_numbern('agent_pkgid')
614 || $self->ut_enum('recur_show_zero', [ '', 'Y', 'N', ])
615 || $self->ut_enum('setup_show_zero', [ '', 'Y', 'N', ])
617 return $error if $error;
619 return "A package with both start date (future start) and setup date (already started) will never bill"
620 if $self->start_date && $self->setup;
622 return "A future unsuspend date can only be set for a package with a suspend date"
623 if $self->resume and !$self->susp and !$self->adjourn;
625 $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum;
627 if ( $self->dbdef_table->column('manual_flag') ) {
628 $self->manual_flag('') if $self->manual_flag eq ' ';
629 $self->manual_flag =~ /^([01]?)$/
630 or return "Illegal manual_flag ". $self->manual_flag;
631 $self->manual_flag($1);
644 my $error = $self->ut_numbern('pkgpart');
645 return $error if $error;
647 if ( $self->reg_code ) {
649 unless ( grep { $self->pkgpart == $_->pkgpart }
650 map { $_->reg_code_pkg }
651 qsearchs( 'reg_code', { 'code' => $self->reg_code,
652 'agentnum' => $self->cust_main->agentnum })
654 return "Unknown registration code";
657 } elsif ( $self->promo_code ) {
660 qsearchs('part_pkg', {
661 'pkgpart' => $self->pkgpart,
662 'promo_code' => { op=>'ILIKE', value=>$self->promo_code },
664 return 'Unknown promotional code' unless $promo_part_pkg;
668 unless ( $disable_agentcheck ) {
670 qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } );
671 return "agent ". $agent->agentnum. ':'. $agent->agent.
672 " can't purchase pkgpart ". $self->pkgpart
673 unless $agent->pkgpart_hashref->{ $self->pkgpart }
674 || $agent->agentnum == $self->part_pkg->agentnum;
677 $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' );
678 return $error if $error;
686 =item cancel [ OPTION => VALUE ... ]
688 Cancels and removes all services (see L<FS::cust_svc> and L<FS::part_svc>)
689 in this package, then cancels the package itself (sets the cancel field to
692 Available options are:
696 =item quiet - can be set true to supress email cancellation notices.
698 =item time - can be set to cancel the package based on a specific future or
699 historical date. Using time ensures that the remaining amount is calculated
700 correctly. Note however that this is an immediate cancel and just changes
701 the date. You are PROBABLY looking to expire the account instead of using
704 =item reason - can be set to a cancellation reason (see L<FS:reason>),
705 either a reasonnum of an existing reason, or passing a hashref will create
706 a new reason. The hashref should have the following keys: typenum - Reason
707 type (see L<FS::reason_type>, reason - Text of the new reason.
709 =item date - can be set to a unix style timestamp to specify when to
712 =item nobill - can be set true to skip billing if it might otherwise be done.
714 =item unused_credit - can be set to 1 to credit the remaining time, or 0 to
715 not credit it. This must be set (by change()) when changing the package
716 to a different pkgpart or location, and probably shouldn't be in any other
717 case. If it's not set, the 'unused_credit_cancel' part_pkg option will
722 If there is an error, returns the error, otherwise returns false.
727 my( $self, %options ) = @_;
730 my $conf = new FS::Conf;
732 warn "cust_pkg::cancel called with options".
733 join(', ', map { "$_: $options{$_}" } keys %options ). "\n"
736 local $SIG{HUP} = 'IGNORE';
737 local $SIG{INT} = 'IGNORE';
738 local $SIG{QUIT} = 'IGNORE';
739 local $SIG{TERM} = 'IGNORE';
740 local $SIG{TSTP} = 'IGNORE';
741 local $SIG{PIPE} = 'IGNORE';
743 my $oldAutoCommit = $FS::UID::AutoCommit;
744 local $FS::UID::AutoCommit = 0;
747 my $old = $self->select_for_update;
749 if ( $old->get('cancel') || $self->get('cancel') ) {
750 dbh->rollback if $oldAutoCommit;
751 return ""; # no error
754 # XXX possibly set cancel_time to the expire date?
755 my $cancel_time = $options{'time'} || time;
756 my $date = $options{'date'} if $options{'date'}; # expire/cancel later
757 $date = '' if ($date && $date <= $cancel_time); # complain instead?
759 #race condition: usage could be ongoing until unprovisioned
760 #resolved by performing a change package instead (which unprovisions) and
762 if ( !$options{nobill} && !$date ) {
763 # && $conf->exists('bill_usage_on_cancel') ) { #calc_cancel checks this
764 my $copy = $self->new({$self->hash});
766 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
768 'time' => $cancel_time );
769 warn "Error billing during cancel, custnum ".
770 #$self->cust_main->custnum. ": $error"
775 if ( $options{'reason'} ) {
776 $error = $self->insert_reason( 'reason' => $options{'reason'},
777 'action' => $date ? 'expire' : 'cancel',
778 'date' => $date ? $date : $cancel_time,
779 'reason_otaker' => $options{'reason_otaker'},
782 dbh->rollback if $oldAutoCommit;
783 return "Error inserting cust_pkg_reason: $error";
787 my %svc_cancel_opt = ();
788 $svc_cancel_opt{'date'} = $date if $date;
789 foreach my $cust_svc (
792 sort { $a->[1] <=> $b->[1] }
793 map { [ $_, $_->svc_x ? $_->svc_x->table_info->{'cancel_weight'} : -1 ]; }
794 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
796 my $part_svc = $cust_svc->part_svc;
797 next if ( defined($part_svc) and $part_svc->preserve );
798 my $error = $cust_svc->cancel( %svc_cancel_opt );
801 $dbh->rollback if $oldAutoCommit;
802 return 'Error '. ($svc_cancel_opt{'date'} ? 'expiring' : 'canceling' ).
808 # credit remaining time if appropriate
810 if ( exists($options{'unused_credit'}) ) {
811 $do_credit = $options{'unused_credit'};
814 $do_credit = $self->part_pkg->option('unused_credit_cancel', 1);
817 my $error = $self->credit_remaining('cancel', $cancel_time);
819 $dbh->rollback if $oldAutoCommit;
826 my %hash = $self->hash;
827 $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time);
828 my $new = new FS::cust_pkg ( \%hash );
829 $error = $new->replace( $self, options => { $self->options } );
831 $dbh->rollback if $oldAutoCommit;
835 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
836 return '' if $date; #no errors
838 my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
839 if ( !$options{'quiet'} &&
840 $conf->exists('emailcancel', $self->cust_main->agentnum) &&
842 my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
845 my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
846 $error = $msg_template->send( 'cust_main' => $self->cust_main,
851 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
852 'to' => \@invoicing_list,
853 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
854 'body' => [ map "$_\n", $conf->config('cancelmessage') ],
857 #should this do something on errors?
864 =item cancel_if_expired [ NOW_TIMESTAMP ]
866 Cancels this package if its expire date has been reached.
870 sub cancel_if_expired {
872 my $time = shift || time;
873 return '' unless $self->expire && $self->expire <= $time;
874 my $error = $self->cancel;
876 return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
877 $self->custnum. ": $error";
884 Cancels any pending expiration (sets the expire field to null).
886 If there is an error, returns the error, otherwise returns false.
891 my( $self, %options ) = @_;
894 local $SIG{HUP} = 'IGNORE';
895 local $SIG{INT} = 'IGNORE';
896 local $SIG{QUIT} = 'IGNORE';
897 local $SIG{TERM} = 'IGNORE';
898 local $SIG{TSTP} = 'IGNORE';
899 local $SIG{PIPE} = 'IGNORE';
901 my $oldAutoCommit = $FS::UID::AutoCommit;
902 local $FS::UID::AutoCommit = 0;
905 my $old = $self->select_for_update;
907 my $pkgnum = $old->pkgnum;
908 if ( $old->get('cancel') || $self->get('cancel') ) {
909 dbh->rollback if $oldAutoCommit;
910 return "Can't unexpire cancelled package $pkgnum";
911 # or at least it's pointless
914 unless ( $old->get('expire') && $self->get('expire') ) {
915 dbh->rollback if $oldAutoCommit;
916 return ""; # no error
919 my %hash = $self->hash;
920 $hash{'expire'} = '';
921 my $new = new FS::cust_pkg ( \%hash );
922 $error = $new->replace( $self, options => { $self->options } );
924 $dbh->rollback if $oldAutoCommit;
928 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
934 =item suspend [ OPTION => VALUE ... ]
936 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
937 package, then suspends the package itself (sets the susp field to now).
939 Available options are:
943 =item reason - can be set to a cancellation reason (see L<FS:reason>),
944 either a reasonnum of an existing reason, or passing a hashref will create
945 a new reason. The hashref should have the following keys:
946 - typenum - Reason type (see L<FS::reason_type>
947 - reason - Text of the new reason.
949 =item date - can be set to a unix style timestamp to specify when to
952 =item time - can be set to override the current time, for calculation
953 of final invoices or unused-time credits
955 =item resume_date - can be set to a time when the package should be
956 unsuspended. This may be more convenient than calling C<unsuspend()>
961 If there is an error, returns the error, otherwise returns false.
966 my( $self, %options ) = @_;
969 local $SIG{HUP} = 'IGNORE';
970 local $SIG{INT} = 'IGNORE';
971 local $SIG{QUIT} = 'IGNORE';
972 local $SIG{TERM} = 'IGNORE';
973 local $SIG{TSTP} = 'IGNORE';
974 local $SIG{PIPE} = 'IGNORE';
976 my $oldAutoCommit = $FS::UID::AutoCommit;
977 local $FS::UID::AutoCommit = 0;
980 my $old = $self->select_for_update;
982 my $pkgnum = $old->pkgnum;
983 if ( $old->get('cancel') || $self->get('cancel') ) {
984 dbh->rollback if $oldAutoCommit;
985 return "Can't suspend cancelled package $pkgnum";
988 if ( $old->get('susp') || $self->get('susp') ) {
989 dbh->rollback if $oldAutoCommit;
990 return ""; # no error # complain on adjourn?
993 my $suspend_time = $options{'time'} || time;
994 my $date = $options{date} if $options{date}; # adjourn/suspend later
995 $date = '' if ($date && $date <= $suspend_time); # complain instead?
997 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
998 dbh->rollback if $oldAutoCommit;
999 return "Package $pkgnum expires before it would be suspended.";
1002 # some false laziness with sub cancel
1003 if ( !$options{nobill} && !$date &&
1004 $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1005 # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
1006 # make the entire cust_main->bill path recognize 'suspend' and
1007 # 'cancel' separately.
1008 warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1009 my $copy = $self->new({$self->hash});
1011 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
1013 'time' => $suspend_time );
1014 warn "Error billing during suspend, custnum ".
1015 #$self->cust_main->custnum. ": $error"
1020 if ( $options{'reason'} ) {
1021 $error = $self->insert_reason( 'reason' => $options{'reason'},
1022 'action' => $date ? 'adjourn' : 'suspend',
1023 'date' => $date ? $date : $suspend_time,
1024 'reason_otaker' => $options{'reason_otaker'},
1027 dbh->rollback if $oldAutoCommit;
1028 return "Error inserting cust_pkg_reason: $error";
1032 my %hash = $self->hash;
1034 $hash{'adjourn'} = $date;
1036 $hash{'susp'} = $suspend_time;
1039 my $resume_date = $options{'resume_date'} || 0;
1040 if ( $resume_date > ($date || $suspend_time) ) {
1041 $hash{'resume'} = $resume_date;
1044 $options{options} ||= {};
1046 my $new = new FS::cust_pkg ( \%hash );
1047 $error = $new->replace( $self, options => { $self->options,
1048 %{ $options{options} },
1052 $dbh->rollback if $oldAutoCommit;
1057 # credit remaining time if appropriate
1058 if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
1059 my $error = $self->credit_remaining('suspend', $suspend_time);
1061 $dbh->rollback if $oldAutoCommit;
1068 foreach my $cust_svc (
1069 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
1071 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1073 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1074 $dbh->rollback if $oldAutoCommit;
1075 return "Illegal svcdb value in part_svc!";
1078 require "FS/$svcdb.pm";
1080 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1082 $error = $svc->suspend;
1084 $dbh->rollback if $oldAutoCommit;
1087 my( $label, $value ) = $cust_svc->label;
1088 push @labels, "$label: $value";
1092 my $conf = new FS::Conf;
1093 if ( $conf->config('suspend_email_admin') ) {
1095 my $error = send_email(
1096 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1097 #invoice_from ??? well as good as any
1098 'to' => $conf->config('suspend_email_admin'),
1099 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1101 "This is an automatic message from your Freeside installation\n",
1102 "informing you that the following customer package has been suspended:\n",
1104 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1105 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1106 ( map { "Service : $_\n" } @labels ),
1111 warn "WARNING: can't send suspension admin email (suspending anyway): ".
1119 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1124 =item credit_remaining MODE TIME
1126 Generate a credit for this package for the time remaining in the current
1127 billing period. MODE is either "suspend" or "cancel" (determines the
1128 credit type). TIME is the time of suspension/cancellation. Both arguments
1133 sub credit_remaining {
1134 # Add a credit for remaining service
1135 my ($self, $mode, $time) = @_;
1136 die 'credit_remaining requires suspend or cancel'
1137 unless $mode eq 'suspend' or $mode eq 'cancel';
1138 die 'no suspend/cancel time' unless $time > 0;
1140 my $conf = FS::Conf->new;
1141 my $reason_type = $conf->config($mode.'_credit_type');
1143 my $last_bill = $self->getfield('last_bill') || 0;
1144 my $next_bill = $self->getfield('bill') || 0;
1145 if ( $last_bill > 0 # the package has been billed
1146 and $next_bill > 0 # the package has a next bill date
1147 and $next_bill >= $time # which is in the future
1149 my $remaining_value = $self->calc_remain('time' => $time);
1150 if ( $remaining_value > 0 ) {
1151 warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1153 my $error = $self->cust_main->credit(
1155 'Credit for unused time on '. $self->part_pkg->pkg,
1156 'reason_type' => $reason_type,
1158 return "Error crediting customer \$$remaining_value for unused time".
1159 " on ". $self->part_pkg->pkg. ": $error"
1161 } #if $remaining_value
1162 } #if $last_bill, etc.
1166 =item unsuspend [ OPTION => VALUE ... ]
1168 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1169 package, then unsuspends the package itself (clears the susp field and the
1170 adjourn field if it is in the past).
1172 Available options are:
1178 Can be set to a date to unsuspend the package in the future (the 'resume'
1181 =item adjust_next_bill
1183 Can be set true to adjust the next bill date forward by
1184 the amount of time the account was inactive. This was set true by default
1185 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
1186 explicitly requested. Price plans for which this makes sense (anniversary-date
1187 based than prorate or subscription) could have an option to enable this
1192 If there is an error, returns the error, otherwise returns false.
1197 my( $self, %opt ) = @_;
1200 local $SIG{HUP} = 'IGNORE';
1201 local $SIG{INT} = 'IGNORE';
1202 local $SIG{QUIT} = 'IGNORE';
1203 local $SIG{TERM} = 'IGNORE';
1204 local $SIG{TSTP} = 'IGNORE';
1205 local $SIG{PIPE} = 'IGNORE';
1207 my $oldAutoCommit = $FS::UID::AutoCommit;
1208 local $FS::UID::AutoCommit = 0;
1211 my $old = $self->select_for_update;
1213 my $pkgnum = $old->pkgnum;
1214 if ( $old->get('cancel') || $self->get('cancel') ) {
1215 $dbh->rollback if $oldAutoCommit;
1216 return "Can't unsuspend cancelled package $pkgnum";
1219 unless ( $old->get('susp') && $self->get('susp') ) {
1220 $dbh->rollback if $oldAutoCommit;
1221 return ""; # no error # complain instead?
1224 my $date = $opt{'date'};
1225 if ( $date and $date > time ) { # return an error if $date <= time?
1227 if ( $old->get('expire') && $old->get('expire') < $date ) {
1228 $dbh->rollback if $oldAutoCommit;
1229 return "Package $pkgnum expires before it would be unsuspended.";
1232 my $new = new FS::cust_pkg { $self->hash };
1233 $new->set('resume', $date);
1234 $error = $new->replace($self, options => $self->options);
1237 $dbh->rollback if $oldAutoCommit;
1241 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1247 foreach my $cust_svc (
1248 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1250 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1252 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1253 $dbh->rollback if $oldAutoCommit;
1254 return "Illegal svcdb value in part_svc!";
1257 require "FS/$svcdb.pm";
1259 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1261 $error = $svc->unsuspend;
1263 $dbh->rollback if $oldAutoCommit;
1270 my %hash = $self->hash;
1271 my $inactive = time - $hash{'susp'};
1273 my $conf = new FS::Conf;
1275 if ( $inactive > 0 &&
1276 ( $hash{'bill'} || $hash{'setup'} ) &&
1277 ( $opt{'adjust_next_bill'} ||
1278 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1279 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1282 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1287 $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
1288 $hash{'resume'} = '' if !$hash{'adjourn'};
1289 my $new = new FS::cust_pkg ( \%hash );
1290 $error = $new->replace( $self, options => { $self->options } );
1292 $dbh->rollback if $oldAutoCommit;
1296 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1303 Cancels any pending suspension (sets the adjourn field to null).
1305 If there is an error, returns the error, otherwise returns false.
1310 my( $self, %options ) = @_;
1313 local $SIG{HUP} = 'IGNORE';
1314 local $SIG{INT} = 'IGNORE';
1315 local $SIG{QUIT} = 'IGNORE';
1316 local $SIG{TERM} = 'IGNORE';
1317 local $SIG{TSTP} = 'IGNORE';
1318 local $SIG{PIPE} = 'IGNORE';
1320 my $oldAutoCommit = $FS::UID::AutoCommit;
1321 local $FS::UID::AutoCommit = 0;
1324 my $old = $self->select_for_update;
1326 my $pkgnum = $old->pkgnum;
1327 if ( $old->get('cancel') || $self->get('cancel') ) {
1328 dbh->rollback if $oldAutoCommit;
1329 return "Can't unadjourn cancelled package $pkgnum";
1330 # or at least it's pointless
1333 if ( $old->get('susp') || $self->get('susp') ) {
1334 dbh->rollback if $oldAutoCommit;
1335 return "Can't unadjourn suspended package $pkgnum";
1336 # perhaps this is arbitrary
1339 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1340 dbh->rollback if $oldAutoCommit;
1341 return ""; # no error
1344 my %hash = $self->hash;
1345 $hash{'adjourn'} = '';
1346 $hash{'resume'} = '';
1347 my $new = new FS::cust_pkg ( \%hash );
1348 $error = $new->replace( $self, options => { $self->options } );
1350 $dbh->rollback if $oldAutoCommit;
1354 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1361 =item change HASHREF | OPTION => VALUE ...
1363 Changes this package: cancels it and creates a new one, with a different
1364 pkgpart or locationnum or both. All services are transferred to the new
1365 package (no change will be made if this is not possible).
1367 Options may be passed as a list of key/value pairs or as a hash reference.
1374 New locationnum, to change the location for this package.
1378 New FS::cust_location object, to create a new location and assign it
1383 New pkgpart (see L<FS::part_pkg>).
1387 New refnum (see L<FS::part_referral>).
1391 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1392 susp, adjourn, cancel, expire, and contract_end) to the new package.
1396 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1397 (otherwise, what's the point?)
1399 Returns either the new FS::cust_pkg object or a scalar error.
1403 my $err_or_new_cust_pkg = $old_cust_pkg->change
1407 #some false laziness w/order
1410 my $opt = ref($_[0]) ? shift : { @_ };
1412 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1415 my $conf = new FS::Conf;
1417 # Transactionize this whole mess
1418 local $SIG{HUP} = 'IGNORE';
1419 local $SIG{INT} = 'IGNORE';
1420 local $SIG{QUIT} = 'IGNORE';
1421 local $SIG{TERM} = 'IGNORE';
1422 local $SIG{TSTP} = 'IGNORE';
1423 local $SIG{PIPE} = 'IGNORE';
1425 my $oldAutoCommit = $FS::UID::AutoCommit;
1426 local $FS::UID::AutoCommit = 0;
1435 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1437 #$hash{$_} = $self->$_() foreach qw( setup );
1439 $hash{'setup'} = $time if $self->setup;
1441 $hash{'change_date'} = $time;
1442 $hash{"change_$_"} = $self->$_()
1443 foreach qw( pkgnum pkgpart locationnum );
1445 if ( $opt->{'cust_location'} &&
1446 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1447 $error = $opt->{'cust_location'}->insert;
1449 $dbh->rollback if $oldAutoCommit;
1450 return "inserting cust_location (transaction rolled back): $error";
1452 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1455 my $unused_credit = 0;
1456 my $keep_dates = $opt->{'keep_dates'};
1457 # Special case. If the pkgpart is changing, and the customer is
1458 # going to be credited for remaining time, don't keep setup, bill,
1459 # or last_bill dates, and DO pass the flag to cancel() to credit
1461 if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
1463 $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
1464 $hash{$_} = '' foreach qw(setup bill last_bill);
1467 if ( $keep_dates ) {
1468 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1469 resume start_date contract_end ) ) {
1470 $hash{$date} = $self->getfield($date);
1473 # allow $opt->{'locationnum'} = '' to specifically set it to null
1474 # (i.e. customer default location)
1475 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
1477 # Create the new package.
1478 my $cust_pkg = new FS::cust_pkg {
1479 custnum => $self->custnum,
1480 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1481 refnum => ( $opt->{'refnum'} || $self->refnum ),
1482 locationnum => ( $opt->{'locationnum'} ),
1486 $error = $cust_pkg->insert( 'change' => 1 );
1488 $dbh->rollback if $oldAutoCommit;
1492 # Transfer services and cancel old package.
1494 $error = $self->transfer($cust_pkg);
1495 if ($error and $error == 0) {
1496 # $old_pkg->transfer failed.
1497 $dbh->rollback if $oldAutoCommit;
1501 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1502 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1503 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1504 if ($error and $error == 0) {
1505 # $old_pkg->transfer failed.
1506 $dbh->rollback if $oldAutoCommit;
1512 # Transfers were successful, but we still had services left on the old
1513 # package. We can't change the package under this circumstances, so abort.
1514 $dbh->rollback if $oldAutoCommit;
1515 return "Unable to transfer all services from package ". $self->pkgnum;
1518 #reset usage if changing pkgpart
1519 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1520 if ($self->pkgpart != $cust_pkg->pkgpart) {
1521 my $part_pkg = $cust_pkg->part_pkg;
1522 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1526 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1529 $dbh->rollback if $oldAutoCommit;
1530 return "Error setting usage values: $error";
1534 #Good to go, cancel old package. Notify 'cancel' of whether to credit
1536 #Don't allow billing the package (preceding period packages and/or
1537 #outstanding usage) if we are keeping dates (i.e. location changing),
1538 #because the new package will be billed for the same date range.
1539 $error = $self->cancel(
1541 unused_credit => $unused_credit,
1542 nobill => $keep_dates
1545 $dbh->rollback if $oldAutoCommit;
1549 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1551 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1553 $dbh->rollback if $oldAutoCommit;
1558 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1564 use Storable 'thaw';
1566 sub process_bulk_cust_pkg {
1568 my $param = thaw(decode_base64(shift));
1569 warn Dumper($param) if $DEBUG;
1571 my $old_part_pkg = qsearchs('part_pkg',
1572 { pkgpart => $param->{'old_pkgpart'} });
1573 my $new_part_pkg = qsearchs('part_pkg',
1574 { pkgpart => $param->{'new_pkgpart'} });
1575 die "Must select a new package type\n" unless $new_part_pkg;
1576 #my $keep_dates = $param->{'keep_dates'} || 0;
1577 my $keep_dates = 1; # there is no good reason to turn this off
1579 local $SIG{HUP} = 'IGNORE';
1580 local $SIG{INT} = 'IGNORE';
1581 local $SIG{QUIT} = 'IGNORE';
1582 local $SIG{TERM} = 'IGNORE';
1583 local $SIG{TSTP} = 'IGNORE';
1584 local $SIG{PIPE} = 'IGNORE';
1586 my $oldAutoCommit = $FS::UID::AutoCommit;
1587 local $FS::UID::AutoCommit = 0;
1590 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1593 foreach my $old_cust_pkg ( @cust_pkgs ) {
1595 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1596 if ( $old_cust_pkg->getfield('cancel') ) {
1597 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1598 $old_cust_pkg->pkgnum."\n"
1602 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1604 my $error = $old_cust_pkg->change(
1605 'pkgpart' => $param->{'new_pkgpart'},
1606 'keep_dates' => $keep_dates
1608 if ( !ref($error) ) { # change returns the cust_pkg on success
1610 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1613 $dbh->commit if $oldAutoCommit;
1619 Returns the last bill date, or if there is no last bill date, the setup date.
1620 Useful for billing metered services.
1626 return $self->setfield('last_bill', $_[0]) if @_;
1627 return $self->getfield('last_bill') if $self->getfield('last_bill');
1628 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1629 'edate' => $self->bill, } );
1630 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1633 =item last_cust_pkg_reason ACTION
1635 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1636 Returns false if there is no reason or the package is not currenly ACTION'd
1637 ACTION is one of adjourn, susp, cancel, or expire.
1641 sub last_cust_pkg_reason {
1642 my ( $self, $action ) = ( shift, shift );
1643 my $date = $self->get($action);
1645 'table' => 'cust_pkg_reason',
1646 'hashref' => { 'pkgnum' => $self->pkgnum,
1647 'action' => substr(uc($action), 0, 1),
1650 'order_by' => 'ORDER BY num DESC LIMIT 1',
1654 =item last_reason ACTION
1656 Returns the most recent ACTION FS::reason associated with the package.
1657 Returns false if there is no reason or the package is not currenly ACTION'd
1658 ACTION is one of adjourn, susp, cancel, or expire.
1663 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1664 $cust_pkg_reason->reason
1665 if $cust_pkg_reason;
1670 Returns the definition for this billing item, as an FS::part_pkg object (see
1677 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1678 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1679 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1684 Returns the cancelled package this package was changed from, if any.
1690 return '' unless $self->change_pkgnum;
1691 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1696 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1703 $self->part_pkg->calc_setup($self, @_);
1708 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1715 $self->part_pkg->calc_recur($self, @_);
1720 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1727 $self->part_pkg->base_recur($self, @_);
1732 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1739 $self->part_pkg->calc_remain($self, @_);
1744 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1751 $self->part_pkg->calc_cancel($self, @_);
1756 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1762 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1765 =item cust_pkg_detail [ DETAILTYPE ]
1767 Returns any customer package details for this package (see
1768 L<FS::cust_pkg_detail>).
1770 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1774 sub cust_pkg_detail {
1776 my %hash = ( 'pkgnum' => $self->pkgnum );
1777 $hash{detailtype} = shift if @_;
1779 'table' => 'cust_pkg_detail',
1780 'hashref' => \%hash,
1781 'order_by' => 'ORDER BY weight, pkgdetailnum',
1785 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1787 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1789 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1791 If there is an error, returns the error, otherwise returns false.
1795 sub set_cust_pkg_detail {
1796 my( $self, $detailtype, @details ) = @_;
1798 local $SIG{HUP} = 'IGNORE';
1799 local $SIG{INT} = 'IGNORE';
1800 local $SIG{QUIT} = 'IGNORE';
1801 local $SIG{TERM} = 'IGNORE';
1802 local $SIG{TSTP} = 'IGNORE';
1803 local $SIG{PIPE} = 'IGNORE';
1805 my $oldAutoCommit = $FS::UID::AutoCommit;
1806 local $FS::UID::AutoCommit = 0;
1809 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1810 my $error = $current->delete;
1812 $dbh->rollback if $oldAutoCommit;
1813 return "error removing old detail: $error";
1817 foreach my $detail ( @details ) {
1818 my $cust_pkg_detail = new FS::cust_pkg_detail {
1819 'pkgnum' => $self->pkgnum,
1820 'detailtype' => $detailtype,
1821 'detail' => $detail,
1823 my $error = $cust_pkg_detail->insert;
1825 $dbh->rollback if $oldAutoCommit;
1826 return "error adding new detail: $error";
1831 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1838 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
1842 #false laziness w/cust_bill.pm
1846 'table' => 'cust_event',
1847 'addl_from' => 'JOIN part_event USING ( eventpart )',
1848 'hashref' => { 'tablenum' => $self->pkgnum },
1849 'extra_sql' => " AND eventtable = 'cust_pkg' ",
1853 =item num_cust_event
1855 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
1859 #false laziness w/cust_bill.pm
1860 sub num_cust_event {
1863 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
1864 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
1865 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
1866 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
1867 $sth->fetchrow_arrayref->[0];
1870 =item cust_svc [ SVCPART ] (old, deprecated usage)
1872 =item cust_svc [ OPTION => VALUE ... ] (current usage)
1874 Returns the services for this package, as FS::cust_svc objects (see
1875 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
1876 spcififed, returns only the matching services.
1883 return () unless $self->num_cust_svc(@_);
1886 if ( @_ && $_[0] =~ /^\d+/ ) {
1887 $opt{svcpart} = shift;
1888 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
1895 'table' => 'cust_svc',
1896 'hashref' => { 'pkgnum' => $self->pkgnum },
1898 if ( $opt{svcpart} ) {
1899 $search{hashref}->{svcpart} = $opt{'svcpart'};
1901 if ( $opt{'svcdb'} ) {
1902 $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
1903 $search{hashref}->{svcdb} = $opt{'svcdb'};
1906 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
1908 #if ( $self->{'_svcnum'} ) {
1909 # values %{ $self->{'_svcnum'}->cache };
1911 $self->_sort_cust_svc( [ qsearch(\%search) ] );
1916 =item overlimit [ SVCPART ]
1918 Returns the services for this package which have exceeded their
1919 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
1920 is specified, return only the matching services.
1926 return () unless $self->num_cust_svc(@_);
1927 grep { $_->overlimit } $self->cust_svc(@_);
1930 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
1932 Returns historical services for this package created before END TIMESTAMP and
1933 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
1934 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
1935 I<pkg_svc.hidden> flag will be omitted.
1941 warn "$me _h_cust_svc called on $self\n"
1944 my ($end, $start, $mode) = @_;
1945 my @cust_svc = $self->_sort_cust_svc(
1946 [ qsearch( 'h_cust_svc',
1947 { 'pkgnum' => $self->pkgnum, },
1948 FS::h_cust_svc->sql_h_search(@_),
1951 if ( defined($mode) && $mode eq 'I' ) {
1952 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
1953 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
1959 sub _sort_cust_svc {
1960 my( $self, $arrayref ) = @_;
1963 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
1968 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
1969 'svcpart' => $_->svcpart } );
1971 $pkg_svc ? $pkg_svc->primary_svc : '',
1972 $pkg_svc ? $pkg_svc->quantity : 0,
1979 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
1981 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
1983 Returns the number of services for this package. Available options are svcpart
1984 and svcdb. If either is spcififed, returns only the matching services.
1991 return $self->{'_num_cust_svc'}
1993 && exists($self->{'_num_cust_svc'})
1994 && $self->{'_num_cust_svc'} =~ /\d/;
1996 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
2000 if ( @_ && $_[0] =~ /^\d+/ ) {
2001 $opt{svcpart} = shift;
2002 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2008 my $select = 'SELECT COUNT(*) FROM cust_svc ';
2009 my $where = ' WHERE pkgnum = ? ';
2010 my @param = ($self->pkgnum);
2012 if ( $opt{'svcpart'} ) {
2013 $where .= ' AND svcpart = ? ';
2014 push @param, $opt{'svcpart'};
2016 if ( $opt{'svcdb'} ) {
2017 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
2018 $where .= ' AND svcdb = ? ';
2019 push @param, $opt{'svcdb'};
2022 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
2023 $sth->execute(@param) or die $sth->errstr;
2024 $sth->fetchrow_arrayref->[0];
2027 =item available_part_svc
2029 Returns a list of FS::part_svc objects representing services included in this
2030 package but not yet provisioned. Each FS::part_svc object also has an extra
2031 field, I<num_avail>, which specifies the number of available services.
2035 sub available_part_svc {
2037 grep { $_->num_avail > 0 }
2039 my $part_svc = $_->part_svc;
2040 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
2041 $_->quantity - $self->num_cust_svc($_->svcpart);
2043 # more evil encapsulation breakage
2044 if($part_svc->{'Hash'}{'num_avail'} > 0) {
2045 my @exports = $part_svc->part_export_did;
2046 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
2051 $self->part_pkg->pkg_svc;
2054 =item part_svc [ OPTION => VALUE ... ]
2056 Returns a list of FS::part_svc objects representing provisioned and available
2057 services included in this package. Each FS::part_svc object also has the
2058 following extra fields:
2062 =item num_cust_svc (count)
2064 =item num_avail (quantity - count)
2066 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
2070 Accepts one option: summarize_size. If specified and non-zero, will omit the
2071 extra cust_pkg_svc option for objects where num_cust_svc is this size or
2077 #label -> ($cust_svc->label)[1]
2083 #XXX some sort of sort order besides numeric by svcpart...
2084 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
2086 my $part_svc = $pkg_svc->part_svc;
2087 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2088 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
2089 $part_svc->{'Hash'}{'num_avail'} =
2090 max( 0, $pkg_svc->quantity - $num_cust_svc );
2091 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2092 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
2093 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
2094 && $num_cust_svc >= $opt{summarize_size};
2095 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
2097 } $self->part_pkg->pkg_svc;
2100 push @part_svc, map {
2102 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2103 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
2104 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
2105 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2106 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
2108 } $self->extra_part_svc;
2114 =item extra_part_svc
2116 Returns a list of FS::part_svc objects corresponding to services in this
2117 package which are still provisioned but not (any longer) available in the
2122 sub extra_part_svc {
2125 my $pkgnum = $self->pkgnum;
2126 #my $pkgpart = $self->pkgpart;
2129 # 'table' => 'part_svc',
2132 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
2133 # WHERE pkg_svc.svcpart = part_svc.svcpart
2134 # AND pkg_svc.pkgpart = ?
2137 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
2138 # LEFT JOIN cust_pkg USING ( pkgnum )
2139 # WHERE cust_svc.svcpart = part_svc.svcpart
2142 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
2145 #seems to benchmark slightly faster... (or did?)
2147 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
2148 my $pkgparts = join(',', @pkgparts);
2151 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
2152 #MySQL doesn't grok DISINCT ON
2153 'select' => 'DISTINCT part_svc.*',
2154 'table' => 'part_svc',
2156 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
2157 AND pkg_svc.pkgpart IN ($pkgparts)
2160 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
2161 LEFT JOIN cust_pkg USING ( pkgnum )
2164 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
2165 'extra_param' => [ [$self->pkgnum=>'int'] ],
2171 Returns a short status string for this package, currently:
2175 =item not yet billed
2177 =item one-time charge
2192 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
2194 return 'cancelled' if $self->get('cancel');
2195 return 'suspended' if $self->susp;
2196 return 'not yet billed' unless $self->setup;
2197 return 'one-time charge' if $freq =~ /^(0|$)/;
2201 =item ucfirst_status
2203 Returns the status with the first character capitalized.
2207 sub ucfirst_status {
2208 ucfirst(shift->status);
2213 Class method that returns the list of possible status strings for packages
2214 (see L<the status method|/status>). For example:
2216 @statuses = FS::cust_pkg->statuses();
2220 tie my %statuscolor, 'Tie::IxHash',
2221 'not yet billed' => '009999', #teal? cyan?
2222 'one-time charge' => '000000',
2223 'active' => '00CC00',
2224 'suspended' => 'FF9900',
2225 'cancelled' => 'FF0000',
2229 my $self = shift; #could be class...
2230 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2231 # # mayble split btw one-time vs. recur
2237 Returns a hex triplet color string for this package's status.
2243 $statuscolor{$self->status};
2248 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
2249 "pkg-comment" depending on user preference).
2255 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2256 $label = $self->pkgnum. ": $label"
2257 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2261 =item pkg_label_long
2263 Returns a long label for this package, adding the primary service's label to
2268 sub pkg_label_long {
2270 my $label = $self->pkg_label;
2271 my $cust_svc = $self->primary_cust_svc;
2272 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2276 =item primary_cust_svc
2278 Returns a primary service (as FS::cust_svc object) if one can be identified.
2282 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2284 sub primary_cust_svc {
2287 my @cust_svc = $self->cust_svc;
2289 return '' unless @cust_svc; #no serivces - irrelevant then
2291 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2293 # primary service as specified in the package definition
2294 # or exactly one service definition with quantity one
2295 my $svcpart = $self->part_pkg->svcpart;
2296 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2297 return $cust_svc[0] if scalar(@cust_svc) == 1;
2299 #couldn't identify one thing..
2305 Returns a list of lists, calling the label method for all services
2306 (see L<FS::cust_svc>) of this billing item.
2312 map { [ $_->label ] } $self->cust_svc;
2315 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2317 Like the labels method, but returns historical information on services that
2318 were active as of END_TIMESTAMP and (optionally) not cancelled before
2319 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
2320 I<pkg_svc.hidden> flag will be omitted.
2322 Returns a list of lists, calling the label method for all (historical) services
2323 (see L<FS::h_cust_svc>) of this billing item.
2329 warn "$me _h_labels called on $self\n"
2331 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2336 Like labels, except returns a simple flat list, and shortens long
2337 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2338 identical services to one line that lists the service label and the number of
2339 individual services rather than individual items.
2344 shift->_labels_short( 'labels', @_ );
2347 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2349 Like h_labels, except returns a simple flat list, and shortens long
2350 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2351 identical services to one line that lists the service label and the number of
2352 individual services rather than individual items.
2356 sub h_labels_short {
2357 shift->_labels_short( 'h_labels', @_ );
2361 my( $self, $method ) = ( shift, shift );
2363 warn "$me _labels_short called on $self with $method method\n"
2366 my $conf = new FS::Conf;
2367 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2369 warn "$me _labels_short populating \%labels\n"
2373 #tie %labels, 'Tie::IxHash';
2374 push @{ $labels{$_->[0]} }, $_->[1]
2375 foreach $self->$method(@_);
2377 warn "$me _labels_short populating \@labels\n"
2381 foreach my $label ( keys %labels ) {
2383 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2384 my $num = scalar(@values);
2385 warn "$me _labels_short $num items for $label\n"
2388 if ( $num > $max_same_services ) {
2389 warn "$me _labels_short more than $max_same_services, so summarizing\n"
2391 push @labels, "$label ($num)";
2393 if ( $conf->exists('cust_bill-consolidate_services') ) {
2394 warn "$me _labels_short consolidating services\n"
2396 # push @labels, "$label: ". join(', ', @values);
2398 my $detail = "$label: ";
2399 $detail .= shift(@values). ', '
2401 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
2403 push @labels, $detail;
2405 warn "$me _labels_short done consolidating services\n"
2408 warn "$me _labels_short adding service data\n"
2410 push @labels, map { "$label: $_" } @values;
2421 Returns the parent customer object (see L<FS::cust_main>).
2427 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2430 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2434 Returns the location object, if any (see L<FS::cust_location>).
2436 =item cust_location_or_main
2438 If this package is associated with a location, returns the locaiton (see
2439 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2441 =item location_label [ OPTION => VALUE ... ]
2443 Returns the label of the location object (see L<FS::cust_location>).
2447 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2449 =item seconds_since TIMESTAMP
2451 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2452 package have been online since TIMESTAMP, according to the session monitor.
2454 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2455 L<Time::Local> and L<Date::Parse> for conversion functions.
2460 my($self, $since) = @_;
2463 foreach my $cust_svc (
2464 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2466 $seconds += $cust_svc->seconds_since($since);
2473 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2475 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2476 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2479 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2480 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2486 sub seconds_since_sqlradacct {
2487 my($self, $start, $end) = @_;
2491 foreach my $cust_svc (
2493 my $part_svc = $_->part_svc;
2494 $part_svc->svcdb eq 'svc_acct'
2495 && scalar($part_svc->part_export('sqlradius'));
2498 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2505 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2507 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2508 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2512 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2513 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2518 sub attribute_since_sqlradacct {
2519 my($self, $start, $end, $attrib) = @_;
2523 foreach my $cust_svc (
2525 my $part_svc = $_->part_svc;
2526 $part_svc->svcdb eq 'svc_acct'
2527 && scalar($part_svc->part_export('sqlradius'));
2530 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2542 my( $self, $value ) = @_;
2543 if ( defined($value) ) {
2544 $self->setfield('quantity', $value);
2546 $self->getfield('quantity') || 1;
2549 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2551 Transfers as many services as possible from this package to another package.
2553 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2554 object. The destination package must already exist.
2556 Services are moved only if the destination allows services with the correct
2557 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2558 this option with caution! No provision is made for export differences
2559 between the old and new service definitions. Probably only should be used
2560 when your exports for all service definitions of a given svcdb are identical.
2561 (attempt a transfer without it first, to move all possible svcpart-matching
2564 Any services that can't be moved remain in the original package.
2566 Returns an error, if there is one; otherwise, returns the number of services
2567 that couldn't be moved.
2572 my ($self, $dest_pkgnum, %opt) = @_;
2578 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2579 $dest = $dest_pkgnum;
2580 $dest_pkgnum = $dest->pkgnum;
2582 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2585 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2587 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2588 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2591 foreach my $cust_svc ($dest->cust_svc) {
2592 $target{$cust_svc->svcpart}--;
2595 my %svcpart2svcparts = ();
2596 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2597 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2598 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2599 next if exists $svcpart2svcparts{$svcpart};
2600 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2601 $svcpart2svcparts{$svcpart} = [
2603 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2605 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2606 'svcpart' => $_ } );
2608 $pkg_svc ? $pkg_svc->primary_svc : '',
2609 $pkg_svc ? $pkg_svc->quantity : 0,
2613 grep { $_ != $svcpart }
2615 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2617 warn "alternates for svcpart $svcpart: ".
2618 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2623 foreach my $cust_svc ($self->cust_svc) {
2624 if($target{$cust_svc->svcpart} > 0) {
2625 $target{$cust_svc->svcpart}--;
2626 my $new = new FS::cust_svc { $cust_svc->hash };
2627 $new->pkgnum($dest_pkgnum);
2628 my $error = $new->replace($cust_svc);
2629 return $error if $error;
2630 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2632 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2633 warn "alternates to consider: ".
2634 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2636 my @alternate = grep {
2637 warn "considering alternate svcpart $_: ".
2638 "$target{$_} available in new package\n"
2641 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2643 warn "alternate(s) found\n" if $DEBUG;
2644 my $change_svcpart = $alternate[0];
2645 $target{$change_svcpart}--;
2646 my $new = new FS::cust_svc { $cust_svc->hash };
2647 $new->svcpart($change_svcpart);
2648 $new->pkgnum($dest_pkgnum);
2649 my $error = $new->replace($cust_svc);
2650 return $error if $error;
2663 This method is deprecated. See the I<depend_jobnum> option to the insert and
2664 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2671 local $SIG{HUP} = 'IGNORE';
2672 local $SIG{INT} = 'IGNORE';
2673 local $SIG{QUIT} = 'IGNORE';
2674 local $SIG{TERM} = 'IGNORE';
2675 local $SIG{TSTP} = 'IGNORE';
2676 local $SIG{PIPE} = 'IGNORE';
2678 my $oldAutoCommit = $FS::UID::AutoCommit;
2679 local $FS::UID::AutoCommit = 0;
2682 foreach my $cust_svc ( $self->cust_svc ) {
2683 #false laziness w/svc_Common::insert
2684 my $svc_x = $cust_svc->svc_x;
2685 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2686 my $error = $part_export->export_insert($svc_x);
2688 $dbh->rollback if $oldAutoCommit;
2694 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2701 Associates this package with a (suspension or cancellation) reason (see
2702 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2705 Available options are:
2711 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.
2715 the access_user (see L<FS::access_user>) providing the reason
2723 the action (cancel, susp, adjourn, expire) associated with the reason
2727 If there is an error, returns the error, otherwise returns false.
2732 my ($self, %options) = @_;
2734 my $otaker = $options{reason_otaker} ||
2735 $FS::CurrentUser::CurrentUser->username;
2738 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2742 } elsif ( ref($options{'reason'}) ) {
2744 return 'Enter a new reason (or select an existing one)'
2745 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2747 my $reason = new FS::reason({
2748 'reason_type' => $options{'reason'}->{'typenum'},
2749 'reason' => $options{'reason'}->{'reason'},
2751 my $error = $reason->insert;
2752 return $error if $error;
2754 $reasonnum = $reason->reasonnum;
2757 return "Unparsable reason: ". $options{'reason'};
2760 my $cust_pkg_reason =
2761 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2762 'reasonnum' => $reasonnum,
2763 'otaker' => $otaker,
2764 'action' => substr(uc($options{'action'}),0,1),
2765 'date' => $options{'date'}
2770 $cust_pkg_reason->insert;
2773 =item insert_discount
2775 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2776 inserting a new discount on the fly (see L<FS::discount>).
2778 Available options are:
2786 If there is an error, returns the error, otherwise returns false.
2790 sub insert_discount {
2791 #my ($self, %options) = @_;
2794 my $cust_pkg_discount = new FS::cust_pkg_discount {
2795 'pkgnum' => $self->pkgnum,
2796 'discountnum' => $self->discountnum,
2798 'end_date' => '', #XXX
2799 #for the create a new discount case
2800 '_type' => $self->discountnum__type,
2801 'amount' => $self->discountnum_amount,
2802 'percent' => $self->discountnum_percent,
2803 'months' => $self->discountnum_months,
2804 'setup' => $self->discountnum_setup,
2805 #'disabled' => $self->discountnum_disabled,
2808 $cust_pkg_discount->insert;
2811 =item set_usage USAGE_VALUE_HASHREF
2813 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2814 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2815 upbytes, downbytes, and totalbytes are appropriate keys.
2817 All svc_accts which are part of this package have their values reset.
2822 my ($self, $valueref, %opt) = @_;
2824 #only svc_acct can set_usage for now
2825 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
2826 my $svc_x = $cust_svc->svc_x;
2827 $svc_x->set_usage($valueref, %opt)
2828 if $svc_x->can("set_usage");
2832 =item recharge USAGE_VALUE_HASHREF
2834 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2835 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2836 upbytes, downbytes, and totalbytes are appropriate keys.
2838 All svc_accts which are part of this package have their values incremented.
2843 my ($self, $valueref) = @_;
2845 #only svc_acct can set_usage for now
2846 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
2847 my $svc_x = $cust_svc->svc_x;
2848 $svc_x->recharge($valueref)
2849 if $svc_x->can("recharge");
2853 =item cust_pkg_discount
2857 sub cust_pkg_discount {
2859 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
2862 =item cust_pkg_discount_active
2866 sub cust_pkg_discount_active {
2868 grep { $_->status eq 'active' } $self->cust_pkg_discount;
2873 =head1 CLASS METHODS
2879 Returns an SQL expression identifying recurring packages.
2883 sub recurring_sql { "
2884 '0' != ( select freq from part_pkg
2885 where cust_pkg.pkgpart = part_pkg.pkgpart )
2890 Returns an SQL expression identifying one-time packages.
2895 '0' = ( select freq from part_pkg
2896 where cust_pkg.pkgpart = part_pkg.pkgpart )
2901 Returns an SQL expression identifying ordered packages (recurring packages not
2907 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
2912 Returns an SQL expression identifying active packages.
2917 $_[0]->recurring_sql. "
2918 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2919 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2920 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2923 =item not_yet_billed_sql
2925 Returns an SQL expression identifying packages which have not yet been billed.
2929 sub not_yet_billed_sql { "
2930 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
2931 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2932 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2937 Returns an SQL expression identifying inactive packages (one-time packages
2938 that are otherwise unsuspended/uncancelled).
2942 sub inactive_sql { "
2943 ". $_[0]->onetime_sql(). "
2944 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
2945 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2946 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
2952 Returns an SQL expression identifying suspended packages.
2956 sub suspended_sql { susp_sql(@_); }
2958 #$_[0]->recurring_sql(). ' AND '.
2960 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
2961 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
2968 Returns an SQL exprression identifying cancelled packages.
2972 sub cancelled_sql { cancel_sql(@_); }
2974 #$_[0]->recurring_sql(). ' AND '.
2975 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
2980 Returns an SQL expression to give the package status as a string.
2986 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
2987 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
2988 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
2989 WHEN ".onetime_sql()." THEN 'one-time charge'
2994 =item search HASHREF
2998 Returns a qsearch hash expression to search for parameters specified in HASHREF.
2999 Valid parameters are
3007 active, inactive, suspended, cancel (or cancelled)
3011 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
3015 boolean selects custom packages
3021 pkgpart or arrayref or hashref of pkgparts
3025 arrayref of beginning and ending epoch date
3029 arrayref of beginning and ending epoch date
3033 arrayref of beginning and ending epoch date
3037 arrayref of beginning and ending epoch date
3041 arrayref of beginning and ending epoch date
3045 arrayref of beginning and ending epoch date
3049 arrayref of beginning and ending epoch date
3053 pkgnum or APKG_pkgnum
3057 a value suited to passing to FS::UI::Web::cust_header
3061 specifies the user for agent virtualization
3065 boolean selects packages containing fcc form 477 telco lines
3072 my ($class, $params) = @_;
3079 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
3081 "cust_main.agentnum = $1";
3088 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
3090 "cust_pkg.custnum = $1";
3097 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
3099 "cust_pkg.pkgbatch = '$1'";
3106 if ( $params->{'magic'} eq 'active'
3107 || $params->{'status'} eq 'active' ) {
3109 push @where, FS::cust_pkg->active_sql();
3111 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
3112 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
3114 push @where, FS::cust_pkg->not_yet_billed_sql();
3116 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
3117 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
3119 push @where, FS::cust_pkg->inactive_sql();
3121 } elsif ( $params->{'magic'} eq 'suspended'
3122 || $params->{'status'} eq 'suspended' ) {
3124 push @where, FS::cust_pkg->suspended_sql();
3126 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
3127 || $params->{'status'} =~ /^cancell?ed$/ ) {
3129 push @where, FS::cust_pkg->cancelled_sql();
3134 # parse package class
3137 if ( exists($params->{'classnum'}) ) {
3140 if ( ref($params->{'classnum'}) ) {
3142 if ( ref($params->{'classnum'}) eq 'HASH' ) {
3143 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
3144 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
3145 @classnum = @{ $params->{'classnum'} };
3147 die 'unhandled classnum ref '. $params->{'classnum'};
3151 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
3158 my @nums = grep $_, @classnum;
3159 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
3160 my $null = scalar( grep { $_ eq '' } @classnum );
3161 push @c_where, 'part_pkg.classnum IS NULL' if $null;
3163 if ( scalar(@c_where) == 1 ) {
3164 push @where, @c_where;
3165 } elsif ( @c_where ) {
3166 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
3175 # parse package report options
3178 my @report_option = ();
3179 if ( exists($params->{'report_option'}) ) {
3180 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
3181 @report_option = @{ $params->{'report_option'} };
3182 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
3183 @report_option = split(',', $1);
3188 if (@report_option) {
3189 # this will result in the empty set for the dangling comma case as it should
3191 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3192 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3193 AND optionname = 'report_option_$_'
3194 AND optionvalue = '1' )"
3198 foreach my $any ( grep /^report_option_any/, keys %$params ) {
3200 my @report_option_any = ();
3201 if ( ref($params->{$any}) eq 'ARRAY' ) {
3202 @report_option_any = @{ $params->{$any} };
3203 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
3204 @report_option_any = split(',', $1);
3207 if (@report_option_any) {
3208 # this will result in the empty set for the dangling comma case as it should
3209 push @where, ' ( '. join(' OR ',
3210 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3211 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3212 AND optionname = 'report_option_$_'
3213 AND optionvalue = '1' )"
3214 } @report_option_any
3224 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
3230 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
3231 if $params->{fcc_line};
3237 if ( exists($params->{'censustract'}) ) {
3238 $params->{'censustract'} =~ /^([.\d]*)$/;
3239 my $censustract = "cust_main.censustract = '$1'";
3240 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
3241 push @where, "( $censustract )";
3245 # parse censustract2
3247 if ( exists($params->{'censustract2'})
3248 && $params->{'censustract2'} =~ /^(\d*)$/
3252 push @where, "cust_main.censustract LIKE '$1%'";
3255 "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
3263 if ( ref($params->{'pkgpart'}) ) {
3266 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3267 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3268 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3269 @pkgpart = @{ $params->{'pkgpart'} };
3271 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3274 @pkgpart = grep /^(\d+)$/, @pkgpart;
3276 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3278 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3279 push @where, "pkgpart = $1";
3288 #false laziness w/report_cust_pkg.html
3291 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3292 'active' => { 'susp'=>1, 'cancel'=>1 },
3293 'suspended' => { 'cancel' => 1 },
3298 if( exists($params->{'active'} ) ) {
3299 # This overrides all the other date-related fields
3300 my($beginning, $ending) = @{$params->{'active'}};
3302 "cust_pkg.setup IS NOT NULL",
3303 "cust_pkg.setup <= $ending",
3304 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3305 "NOT (".FS::cust_pkg->onetime_sql . ")";
3308 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) {
3310 next unless exists($params->{$field});
3312 my($beginning, $ending) = @{$params->{$field}};
3314 next if $beginning == 0 && $ending == 4294967295;
3317 "cust_pkg.$field IS NOT NULL",
3318 "cust_pkg.$field >= $beginning",
3319 "cust_pkg.$field <= $ending";
3321 $orderby ||= "ORDER BY cust_pkg.$field";
3326 $orderby ||= 'ORDER BY bill';
3329 # parse magic, legacy, etc.
3332 if ( $params->{'magic'} &&
3333 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3336 $orderby = 'ORDER BY pkgnum';
3338 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3339 push @where, "pkgpart = $1";
3342 } elsif ( $params->{'query'} eq 'pkgnum' ) {
3344 $orderby = 'ORDER BY pkgnum';
3346 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3348 $orderby = 'ORDER BY pkgnum';
3351 SELECT count(*) FROM pkg_svc
3352 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
3353 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3354 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
3355 AND cust_svc.svcpart = pkg_svc.svcpart
3362 # setup queries, links, subs, etc. for the search
3365 # here is the agent virtualization
3366 if ($params->{CurrentUser}) {
3368 qsearchs('access_user', { username => $params->{CurrentUser} });
3371 push @where, $access_user->agentnums_sql('table'=>'cust_main');
3376 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3379 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3381 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
3382 'LEFT JOIN part_pkg USING ( pkgpart ) '.
3383 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3385 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3388 'table' => 'cust_pkg',
3390 'select' => join(', ',
3392 ( map "part_pkg.$_", qw( pkg freq ) ),
3393 'pkg_class.classname',
3394 'cust_main.custnum AS cust_main_custnum',
3395 FS::UI::Web::cust_sql_fields(
3396 $params->{'cust_fields'}
3399 'extra_sql' => $extra_sql,
3400 'order_by' => $orderby,
3401 'addl_from' => $addl_from,
3402 'count_query' => $count_query,
3409 Returns a list of two package counts. The first is a count of packages
3410 based on the supplied criteria and the second is the count of residential
3411 packages with those same criteria. Criteria are specified as in the search
3417 my ($class, $params) = @_;
3419 my $sql_query = $class->search( $params );
3421 my $count_sql = delete($sql_query->{'count_query'});
3422 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3423 or die "couldn't parse count_sql";
3425 my $count_sth = dbh->prepare($count_sql)
3426 or die "Error preparing $count_sql: ". dbh->errstr;
3428 or die "Error executing $count_sql: ". $count_sth->errstr;
3429 my $count_arrayref = $count_sth->fetchrow_arrayref;
3431 return ( @$count_arrayref );
3438 Returns a list: the first item is an SQL fragment identifying matching
3439 packages/customers via location (taking into account shipping and package
3440 address taxation, if enabled), and subsequent items are the parameters to
3441 substitute for the placeholders in that fragment.
3446 my($class, %opt) = @_;
3447 my $ornull = $opt{'ornull'};
3449 my $conf = new FS::Conf;
3451 # '?' placeholders in _location_sql_where
3452 my $x = $ornull ? 3 : 2;
3453 my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' );
3457 if ( $conf->exists('tax-ship_address') ) {
3460 ( ( ship_last IS NULL OR ship_last = '' )
3461 AND ". _location_sql_where('cust_main', '', $ornull ). "
3463 OR ( ship_last IS NOT NULL AND ship_last != ''
3464 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3467 # AND payby != 'COMP'
3469 @main_param = ( @bill_param, @bill_param );
3473 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3474 @main_param = @bill_param;
3480 if ( $conf->exists('tax-pkg_address') ) {
3482 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3485 ( cust_pkg.locationnum IS NULL AND $main_where )
3486 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3489 @param = ( @main_param, @bill_param );
3493 $where = $main_where;
3494 @param = @main_param;
3502 #subroutine, helper for location_sql
3503 sub _location_sql_where {
3505 my $prefix = @_ ? shift : '';
3506 my $ornull = @_ ? shift : '';
3508 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3510 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3512 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) ";
3513 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) ";
3514 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) ";
3516 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3518 ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3519 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3520 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3521 AND $table.${prefix}country = ?
3526 my( $self, $what ) = @_;
3528 my $what_show_zero = $what. '_show_zero';
3529 length($self->$what_show_zero())
3530 ? ($self->$what_show_zero() eq 'Y')
3531 : $self->part_pkg->$what_show_zero();
3538 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3540 CUSTNUM is a customer (see L<FS::cust_main>)
3542 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3543 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3546 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3547 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3548 new billing items. An error is returned if this is not possible (see
3549 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3552 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3553 newly-created cust_pkg objects.
3555 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3556 and inserted. Multiple FS::pkg_referral records can be created by
3557 setting I<refnum> to an array reference of refnums or a hash reference with
3558 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3559 record will be created corresponding to cust_main.refnum.
3564 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3566 my $conf = new FS::Conf;
3568 # Transactionize this whole mess
3569 local $SIG{HUP} = 'IGNORE';
3570 local $SIG{INT} = 'IGNORE';
3571 local $SIG{QUIT} = 'IGNORE';
3572 local $SIG{TERM} = 'IGNORE';
3573 local $SIG{TSTP} = 'IGNORE';
3574 local $SIG{PIPE} = 'IGNORE';
3576 my $oldAutoCommit = $FS::UID::AutoCommit;
3577 local $FS::UID::AutoCommit = 0;
3581 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3582 # return "Customer not found: $custnum" unless $cust_main;
3584 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3587 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3590 my $change = scalar(@old_cust_pkg) != 0;
3593 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3595 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3596 " to pkgpart ". $pkgparts->[0]. "\n"
3599 my $err_or_cust_pkg =
3600 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3601 'refnum' => $refnum,
3604 unless (ref($err_or_cust_pkg)) {
3605 $dbh->rollback if $oldAutoCommit;
3606 return $err_or_cust_pkg;
3609 push @$return_cust_pkg, $err_or_cust_pkg;
3610 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3615 # Create the new packages.
3616 foreach my $pkgpart (@$pkgparts) {
3618 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3620 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3621 pkgpart => $pkgpart,
3625 $error = $cust_pkg->insert( 'change' => $change );
3627 $dbh->rollback if $oldAutoCommit;
3630 push @$return_cust_pkg, $cust_pkg;
3632 # $return_cust_pkg now contains refs to all of the newly
3635 # Transfer services and cancel old packages.
3636 foreach my $old_pkg (@old_cust_pkg) {
3638 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3641 foreach my $new_pkg (@$return_cust_pkg) {
3642 $error = $old_pkg->transfer($new_pkg);
3643 if ($error and $error == 0) {
3644 # $old_pkg->transfer failed.
3645 $dbh->rollback if $oldAutoCommit;
3650 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3651 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3652 foreach my $new_pkg (@$return_cust_pkg) {
3653 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3654 if ($error and $error == 0) {
3655 # $old_pkg->transfer failed.
3656 $dbh->rollback if $oldAutoCommit;
3663 # Transfers were successful, but we went through all of the
3664 # new packages and still had services left on the old package.
3665 # We can't cancel the package under the circumstances, so abort.
3666 $dbh->rollback if $oldAutoCommit;
3667 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3669 $error = $old_pkg->cancel( quiet=>1 );
3675 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3679 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3681 A bulk change method to change packages for multiple customers.
3683 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3684 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3687 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3688 replace. The services (see L<FS::cust_svc>) are moved to the
3689 new billing items. An error is returned if this is not possible (see
3692 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3693 newly-created cust_pkg objects.
3698 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3700 # Transactionize this whole mess
3701 local $SIG{HUP} = 'IGNORE';
3702 local $SIG{INT} = 'IGNORE';
3703 local $SIG{QUIT} = 'IGNORE';
3704 local $SIG{TERM} = 'IGNORE';
3705 local $SIG{TSTP} = 'IGNORE';
3706 local $SIG{PIPE} = 'IGNORE';
3708 my $oldAutoCommit = $FS::UID::AutoCommit;
3709 local $FS::UID::AutoCommit = 0;
3713 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3716 while(scalar(@old_cust_pkg)) {
3718 my $custnum = $old_cust_pkg[0]->custnum;
3719 my (@remove) = map { $_->pkgnum }
3720 grep { $_->custnum == $custnum } @old_cust_pkg;
3721 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3723 my $error = order $custnum, $pkgparts, \@remove, \@return;
3725 push @errors, $error
3727 push @$return_cust_pkg, @return;
3730 if (scalar(@errors)) {
3731 $dbh->rollback if $oldAutoCommit;
3732 return join(' / ', @errors);
3735 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3739 # Used by FS::Upgrade to migrate to a new database.
3740 sub _upgrade_data { # class method
3741 my ($class, %opts) = @_;
3742 $class->_upgrade_otaker(%opts);
3744 # RT#10139, bug resulting in contract_end being set when it shouldn't
3745 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3746 # RT#10830, bad calculation of prorate date near end of year
3747 # the date range for bill is December 2009, and we move it forward
3748 # one year if it's before the previous bill date (which it should
3750 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3751 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3752 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3753 # RT6628, add order_date to cust_pkg
3754 'update cust_pkg set order_date = (select history_date from h_cust_pkg
3755 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3756 history_action = \'insert\') where order_date is null',
3758 foreach my $sql (@statements) {
3759 my $sth = dbh->prepare($sql);
3760 $sth->execute or die $sth->errstr;
3768 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3770 In sub order, the @pkgparts array (passed by reference) is clobbered.
3772 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3773 method to pass dates to the recur_prog expression, it should do so.
3775 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3776 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3777 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3778 configuration values. Probably need a subroutine which decides what to do
3779 based on whether or not we've fetched the user yet, rather than a hash. See
3780 FS::UID and the TODO.
3782 Now that things are transactional should the check in the insert method be
3787 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3788 L<FS::pkg_svc>, schema.html from the base documentation