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 fields );
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 "Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
885 locationnum, (other fields?). Attempts to re-provision cancelled services
886 using history information (errors at this stage are not fatal).
888 cust_pkg: pass a scalar reference, will be filled in with the new cust_pkg object
890 svc_fatal: service provisioning errors are fatal
892 svc_errors: pass an array reference, will be filled in with any provisioning errors
897 my( $self, %options ) = @_;
899 #in case you try do do $uncancel-date = $cust_pkg->uncacel
900 return '' unless $self->get('cancel');
906 local $SIG{HUP} = 'IGNORE';
907 local $SIG{INT} = 'IGNORE';
908 local $SIG{QUIT} = 'IGNORE';
909 local $SIG{TERM} = 'IGNORE';
910 local $SIG{TSTP} = 'IGNORE';
911 local $SIG{PIPE} = 'IGNORE';
913 my $oldAutoCommit = $FS::UID::AutoCommit;
914 local $FS::UID::AutoCommit = 0;
918 # insert the new package
921 my $cust_pkg = new FS::cust_pkg {
922 last_bill => ( $options{'last_bill'} || $self->get('last_bill') ),
923 bill => ( $options{'bill'} || $self->get('bill') ),
925 uncancel_pkgnum => $self->pkgnum,
926 map { $_ => $self->get($_) } qw(
927 custnum pkgpart locationnum
929 susp adjourn resume expire start_date contract_end dundate
930 change_date change_pkgpart change_locationnum
931 manual_flag no_auto quantity agent_pkgid recur_show_zero setup_show_zero
935 my $error = $cust_pkg->insert(
936 'change' => 1, #supresses any referral credit to a referring customer
939 $dbh->rollback if $oldAutoCommit;
947 #find historical services within this timeframe before the package cancel
948 # (incompatible with "time" option to cust_pkg->cancel?)
949 my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
950 # too little? (unprovisioing export delay?)
951 my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
952 my @h_cust_svc = $self->h_cust_svc( $end, $start );
955 foreach my $h_cust_svc (@h_cust_svc) {
956 my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
957 #next unless $h_svc_x; #should this happen?
958 (my $table = $h_svc_x->table) =~ s/^h_//;
959 require "FS/$table.pm";
960 my $class = "FS::$table";
961 my $svc_x = $class->new( {
962 'pkgnum' => $cust_pkg->pkgnum,
963 'svcpart' => $h_cust_svc->svcpart,
964 map { $_ => $h_svc_x->get($_) } fields($table)
968 if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
969 $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
972 my $svc_error = $svc_x->insert;
973 if ( $svc_error && $options{svc_fatal} ) {
974 $dbh->rollback if $oldAutoCommit;
977 push @svc_errors, $svc_error if $svc_error;
980 #these are pretty rare, but should handle them
981 # - dsl_device (mac addresses)
982 # - phone_device (mac addresses)
983 # - dsl_note (ikano notes)
984 # - domain_record (i.e. restore DNS information w/domains)
985 # - inventory_item(?) (inventory w/un-cancelling service?)
986 # - nas (svc_broaband nas stuff)
987 #this stuff is unused in the wild afaik
988 # - mailinglistmember
990 # - svc_domain.parent_svcnum?
991 # - acct_snarf (ancient mail fetching config)
992 # - cgp_rule (communigate)
993 # - cust_svc_option (used by our Tron stuff)
994 # - acct_rt_transaction (used by our time worked stuff)
997 # also move over any services that didn't unprovision at cancellation
1000 foreach my $cust_svc ( qsearch('cust_svc', { pkgnum => $self->pkgnum } ) ) {
1001 $cust_svc->pkgnum( $cust_pkg->pkgnum );
1002 my $error = $cust_svc->replace;
1004 $dbh->rollback if $oldAutoCommit;
1013 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1015 ${ $options{cust_pkg} } = $cust_pkg if ref($options{cust_pkg});
1016 @{ $options{svc_errors} } = @svc_errors if ref($options{svc_errors});
1023 Cancels any pending expiration (sets the expire field to null).
1025 If there is an error, returns the error, otherwise returns false.
1030 my( $self, %options ) = @_;
1033 local $SIG{HUP} = 'IGNORE';
1034 local $SIG{INT} = 'IGNORE';
1035 local $SIG{QUIT} = 'IGNORE';
1036 local $SIG{TERM} = 'IGNORE';
1037 local $SIG{TSTP} = 'IGNORE';
1038 local $SIG{PIPE} = 'IGNORE';
1040 my $oldAutoCommit = $FS::UID::AutoCommit;
1041 local $FS::UID::AutoCommit = 0;
1044 my $old = $self->select_for_update;
1046 my $pkgnum = $old->pkgnum;
1047 if ( $old->get('cancel') || $self->get('cancel') ) {
1048 dbh->rollback if $oldAutoCommit;
1049 return "Can't unexpire cancelled package $pkgnum";
1050 # or at least it's pointless
1053 unless ( $old->get('expire') && $self->get('expire') ) {
1054 dbh->rollback if $oldAutoCommit;
1055 return ""; # no error
1058 my %hash = $self->hash;
1059 $hash{'expire'} = '';
1060 my $new = new FS::cust_pkg ( \%hash );
1061 $error = $new->replace( $self, options => { $self->options } );
1063 $dbh->rollback if $oldAutoCommit;
1067 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1073 =item suspend [ OPTION => VALUE ... ]
1075 Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1076 package, then suspends the package itself (sets the susp field to now).
1078 Available options are:
1082 =item reason - can be set to a cancellation reason (see L<FS:reason>),
1083 either a reasonnum of an existing reason, or passing a hashref will create
1084 a new reason. The hashref should have the following keys:
1085 - typenum - Reason type (see L<FS::reason_type>
1086 - reason - Text of the new reason.
1088 =item date - can be set to a unix style timestamp to specify when to
1091 =item time - can be set to override the current time, for calculation
1092 of final invoices or unused-time credits
1094 =item resume_date - can be set to a time when the package should be
1095 unsuspended. This may be more convenient than calling C<unsuspend()>
1100 If there is an error, returns the error, otherwise returns false.
1105 my( $self, %options ) = @_;
1108 local $SIG{HUP} = 'IGNORE';
1109 local $SIG{INT} = 'IGNORE';
1110 local $SIG{QUIT} = 'IGNORE';
1111 local $SIG{TERM} = 'IGNORE';
1112 local $SIG{TSTP} = 'IGNORE';
1113 local $SIG{PIPE} = 'IGNORE';
1115 my $oldAutoCommit = $FS::UID::AutoCommit;
1116 local $FS::UID::AutoCommit = 0;
1119 my $old = $self->select_for_update;
1121 my $pkgnum = $old->pkgnum;
1122 if ( $old->get('cancel') || $self->get('cancel') ) {
1123 dbh->rollback if $oldAutoCommit;
1124 return "Can't suspend cancelled package $pkgnum";
1127 if ( $old->get('susp') || $self->get('susp') ) {
1128 dbh->rollback if $oldAutoCommit;
1129 return ""; # no error # complain on adjourn?
1132 my $suspend_time = $options{'time'} || time;
1133 my $date = $options{date} if $options{date}; # adjourn/suspend later
1134 $date = '' if ($date && $date <= $suspend_time); # complain instead?
1136 if ( $date && $old->get('expire') && $old->get('expire') < $date ) {
1137 dbh->rollback if $oldAutoCommit;
1138 return "Package $pkgnum expires before it would be suspended.";
1141 # some false laziness with sub cancel
1142 if ( !$options{nobill} && !$date &&
1143 $self->part_pkg->option('bill_suspend_as_cancel',1) ) {
1144 # kind of a kludge--'bill_suspend_as_cancel' to avoid having to
1145 # make the entire cust_main->bill path recognize 'suspend' and
1146 # 'cancel' separately.
1147 warn "Billing $pkgnum on suspension (at $suspend_time)\n" if $DEBUG;
1148 my $copy = $self->new({$self->hash});
1150 $copy->cust_main->bill( 'pkg_list' => [ $copy ],
1152 'time' => $suspend_time );
1153 warn "Error billing during suspend, custnum ".
1154 #$self->cust_main->custnum. ": $error"
1159 if ( $options{'reason'} ) {
1160 $error = $self->insert_reason( 'reason' => $options{'reason'},
1161 'action' => $date ? 'adjourn' : 'suspend',
1162 'date' => $date ? $date : $suspend_time,
1163 'reason_otaker' => $options{'reason_otaker'},
1166 dbh->rollback if $oldAutoCommit;
1167 return "Error inserting cust_pkg_reason: $error";
1171 my %hash = $self->hash;
1173 $hash{'adjourn'} = $date;
1175 $hash{'susp'} = $suspend_time;
1178 my $resume_date = $options{'resume_date'} || 0;
1179 if ( $resume_date > ($date || $suspend_time) ) {
1180 $hash{'resume'} = $resume_date;
1183 my $new = new FS::cust_pkg ( \%hash );
1184 $error = $new->replace( $self, options => { $self->options } );
1186 $dbh->rollback if $oldAutoCommit;
1191 # credit remaining time if appropriate
1192 if ( $self->part_pkg->option('unused_credit_suspend', 1) ) {
1193 my $error = $self->credit_remaining('suspend', $suspend_time);
1195 $dbh->rollback if $oldAutoCommit;
1202 foreach my $cust_svc (
1203 qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
1205 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1207 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1208 $dbh->rollback if $oldAutoCommit;
1209 return "Illegal svcdb value in part_svc!";
1212 require "FS/$svcdb.pm";
1214 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1216 $error = $svc->suspend;
1218 $dbh->rollback if $oldAutoCommit;
1221 my( $label, $value ) = $cust_svc->label;
1222 push @labels, "$label: $value";
1226 my $conf = new FS::Conf;
1227 if ( $conf->config('suspend_email_admin') ) {
1229 my $error = send_email(
1230 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1231 #invoice_from ??? well as good as any
1232 'to' => $conf->config('suspend_email_admin'),
1233 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended',
1235 "This is an automatic message from your Freeside installation\n",
1236 "informing you that the following customer package has been suspended:\n",
1238 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1239 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1240 ( map { "Service : $_\n" } @labels ),
1245 warn "WARNING: can't send suspension admin email (suspending anyway): ".
1253 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1258 =item credit_remaining MODE TIME
1260 Generate a credit for this package for the time remaining in the current
1261 billing period. MODE is either "suspend" or "cancel" (determines the
1262 credit type). TIME is the time of suspension/cancellation. Both arguments
1267 sub credit_remaining {
1268 # Add a credit for remaining service
1269 my ($self, $mode, $time) = @_;
1270 die 'credit_remaining requires suspend or cancel'
1271 unless $mode eq 'suspend' or $mode eq 'cancel';
1272 die 'no suspend/cancel time' unless $time > 0;
1274 my $conf = FS::Conf->new;
1275 my $reason_type = $conf->config($mode.'_credit_type');
1277 my $last_bill = $self->getfield('last_bill') || 0;
1278 my $next_bill = $self->getfield('bill') || 0;
1279 if ( $last_bill > 0 # the package has been billed
1280 and $next_bill > 0 # the package has a next bill date
1281 and $next_bill >= $time # which is in the future
1283 my $remaining_value = $self->calc_remain('time' => $time);
1284 if ( $remaining_value > 0 ) {
1285 warn "Crediting for $remaining_value on package ".$self->pkgnum."\n"
1287 my $error = $self->cust_main->credit(
1289 'Credit for unused time on '. $self->part_pkg->pkg,
1290 'reason_type' => $reason_type,
1292 return "Error crediting customer \$$remaining_value for unused time".
1293 " on ". $self->part_pkg->pkg. ": $error"
1295 } #if $remaining_value
1296 } #if $last_bill, etc.
1300 =item unsuspend [ OPTION => VALUE ... ]
1302 Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
1303 package, then unsuspends the package itself (clears the susp field and the
1304 adjourn field if it is in the past).
1306 Available options are:
1312 Can be set to a date to unsuspend the package in the future (the 'resume'
1315 =item adjust_next_bill
1317 Can be set true to adjust the next bill date forward by
1318 the amount of time the account was inactive. This was set true by default
1319 since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be
1320 explicitly requested. Price plans for which this makes sense (anniversary-date
1321 based than prorate or subscription) could have an option to enable this
1326 If there is an error, returns the error, otherwise returns false.
1331 my( $self, %opt ) = @_;
1334 local $SIG{HUP} = 'IGNORE';
1335 local $SIG{INT} = 'IGNORE';
1336 local $SIG{QUIT} = 'IGNORE';
1337 local $SIG{TERM} = 'IGNORE';
1338 local $SIG{TSTP} = 'IGNORE';
1339 local $SIG{PIPE} = 'IGNORE';
1341 my $oldAutoCommit = $FS::UID::AutoCommit;
1342 local $FS::UID::AutoCommit = 0;
1345 my $old = $self->select_for_update;
1347 my $pkgnum = $old->pkgnum;
1348 if ( $old->get('cancel') || $self->get('cancel') ) {
1349 $dbh->rollback if $oldAutoCommit;
1350 return "Can't unsuspend cancelled package $pkgnum";
1353 unless ( $old->get('susp') && $self->get('susp') ) {
1354 $dbh->rollback if $oldAutoCommit;
1355 return ""; # no error # complain instead?
1358 my $date = $opt{'date'};
1359 if ( $date and $date > time ) { # return an error if $date <= time?
1361 if ( $old->get('expire') && $old->get('expire') < $date ) {
1362 $dbh->rollback if $oldAutoCommit;
1363 return "Package $pkgnum expires before it would be unsuspended.";
1366 my $new = new FS::cust_pkg { $self->hash };
1367 $new->set('resume', $date);
1368 $error = $new->replace($self, options => $self->options);
1371 $dbh->rollback if $oldAutoCommit;
1375 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1383 foreach my $cust_svc (
1384 qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } )
1386 my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } );
1388 $part_svc->svcdb =~ /^([\w\-]+)$/ or do {
1389 $dbh->rollback if $oldAutoCommit;
1390 return "Illegal svcdb value in part_svc!";
1393 require "FS/$svcdb.pm";
1395 my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } );
1397 $error = $svc->unsuspend;
1399 $dbh->rollback if $oldAutoCommit;
1402 my( $label, $value ) = $cust_svc->label;
1403 push @labels, "$label: $value";
1408 my %hash = $self->hash;
1409 my $inactive = time - $hash{'susp'};
1411 my $conf = new FS::Conf;
1413 if ( $inactive > 0 &&
1414 ( $hash{'bill'} || $hash{'setup'} ) &&
1415 ( $opt{'adjust_next_bill'} ||
1416 $conf->exists('unsuspend-always_adjust_next_bill_date') ||
1417 $self->part_pkg->option('unsuspend_adjust_bill', 1) )
1420 $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive;
1425 $hash{'adjourn'} = '' if $hash{'adjourn'} and $hash{'adjourn'} < time;
1426 $hash{'resume'} = '' if !$hash{'adjourn'};
1427 my $new = new FS::cust_pkg ( \%hash );
1428 $error = $new->replace( $self, options => { $self->options } );
1430 $dbh->rollback if $oldAutoCommit;
1434 if ( $conf->config('unsuspend_email_admin') ) {
1436 my $error = send_email(
1437 'from' => $conf->config('invoice_from', $self->cust_main->agentnum),
1438 #invoice_from ??? well as good as any
1439 'to' => $conf->config('unsuspend_email_admin'),
1440 'subject' => 'FREESIDE NOTIFICATION: Customer package unsuspended', 'body' => [
1441 "This is an automatic message from your Freeside installation\n",
1442 "informing you that the following customer package has been unsuspended:\n",
1444 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n",
1445 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n",
1446 ( map { "Service : $_\n" } @labels ),
1451 warn "WARNING: can't send unsuspension admin email (unsuspending anyway): ".
1457 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1464 Cancels any pending suspension (sets the adjourn field to null).
1466 If there is an error, returns the error, otherwise returns false.
1471 my( $self, %options ) = @_;
1474 local $SIG{HUP} = 'IGNORE';
1475 local $SIG{INT} = 'IGNORE';
1476 local $SIG{QUIT} = 'IGNORE';
1477 local $SIG{TERM} = 'IGNORE';
1478 local $SIG{TSTP} = 'IGNORE';
1479 local $SIG{PIPE} = 'IGNORE';
1481 my $oldAutoCommit = $FS::UID::AutoCommit;
1482 local $FS::UID::AutoCommit = 0;
1485 my $old = $self->select_for_update;
1487 my $pkgnum = $old->pkgnum;
1488 if ( $old->get('cancel') || $self->get('cancel') ) {
1489 dbh->rollback if $oldAutoCommit;
1490 return "Can't unadjourn cancelled package $pkgnum";
1491 # or at least it's pointless
1494 if ( $old->get('susp') || $self->get('susp') ) {
1495 dbh->rollback if $oldAutoCommit;
1496 return "Can't unadjourn suspended package $pkgnum";
1497 # perhaps this is arbitrary
1500 unless ( $old->get('adjourn') && $self->get('adjourn') ) {
1501 dbh->rollback if $oldAutoCommit;
1502 return ""; # no error
1505 my %hash = $self->hash;
1506 $hash{'adjourn'} = '';
1507 $hash{'resume'} = '';
1508 my $new = new FS::cust_pkg ( \%hash );
1509 $error = $new->replace( $self, options => { $self->options } );
1511 $dbh->rollback if $oldAutoCommit;
1515 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1522 =item change HASHREF | OPTION => VALUE ...
1524 Changes this package: cancels it and creates a new one, with a different
1525 pkgpart or locationnum or both. All services are transferred to the new
1526 package (no change will be made if this is not possible).
1528 Options may be passed as a list of key/value pairs or as a hash reference.
1535 New locationnum, to change the location for this package.
1539 New FS::cust_location object, to create a new location and assign it
1544 New pkgpart (see L<FS::part_pkg>).
1548 New refnum (see L<FS::part_referral>).
1552 Set to true to transfer billing dates (start_date, setup, last_bill, bill,
1553 susp, adjourn, cancel, expire, and contract_end) to the new package.
1557 At least one of locationnum, cust_location, pkgpart, refnum must be specified
1558 (otherwise, what's the point?)
1560 Returns either the new FS::cust_pkg object or a scalar error.
1564 my $err_or_new_cust_pkg = $old_cust_pkg->change
1568 #some false laziness w/order
1571 my $opt = ref($_[0]) ? shift : { @_ };
1573 # my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
1576 my $conf = new FS::Conf;
1578 # Transactionize this whole mess
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;
1596 #$hash{$_} = $self->$_() foreach qw( last_bill bill );
1598 #$hash{$_} = $self->$_() foreach qw( setup );
1600 $hash{'setup'} = $time if $self->setup;
1602 $hash{'change_date'} = $time;
1603 $hash{"change_$_"} = $self->$_()
1604 foreach qw( pkgnum pkgpart locationnum );
1606 if ( $opt->{'cust_location'} &&
1607 ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) {
1608 $error = $opt->{'cust_location'}->insert;
1610 $dbh->rollback if $oldAutoCommit;
1611 return "inserting cust_location (transaction rolled back): $error";
1613 $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
1616 my $unused_credit = 0;
1617 my $keep_dates = $opt->{'keep_dates'};
1618 # Special case. If the pkgpart is changing, and the customer is
1619 # going to be credited for remaining time, don't keep setup, bill,
1620 # or last_bill dates, and DO pass the flag to cancel() to credit
1622 if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
1624 $unused_credit = 1 if $self->part_pkg->option('unused_credit_change', 1);
1625 $hash{$_} = '' foreach qw(setup bill last_bill);
1628 if ( $keep_dates ) {
1629 foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire
1630 resume start_date contract_end ) ) {
1631 $hash{$date} = $self->getfield($date);
1634 # allow $opt->{'locationnum'} = '' to specifically set it to null
1635 # (i.e. customer default location)
1636 $opt->{'locationnum'} = $self->locationnum if !exists($opt->{'locationnum'});
1638 # Create the new package.
1639 my $cust_pkg = new FS::cust_pkg {
1640 custnum => $self->custnum,
1641 pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ),
1642 refnum => ( $opt->{'refnum'} || $self->refnum ),
1643 locationnum => ( $opt->{'locationnum'} ),
1647 $error = $cust_pkg->insert( 'change' => 1 );
1649 $dbh->rollback if $oldAutoCommit;
1653 # Transfer services and cancel old package.
1655 $error = $self->transfer($cust_pkg);
1656 if ($error and $error == 0) {
1657 # $old_pkg->transfer failed.
1658 $dbh->rollback if $oldAutoCommit;
1662 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
1663 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
1664 $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 );
1665 if ($error and $error == 0) {
1666 # $old_pkg->transfer failed.
1667 $dbh->rollback if $oldAutoCommit;
1673 # Transfers were successful, but we still had services left on the old
1674 # package. We can't change the package under this circumstances, so abort.
1675 $dbh->rollback if $oldAutoCommit;
1676 return "Unable to transfer all services from package ". $self->pkgnum;
1679 #reset usage if changing pkgpart
1680 # AND usage rollover is off (otherwise adds twice, now and at package bill)
1681 if ($self->pkgpart != $cust_pkg->pkgpart) {
1682 my $part_pkg = $cust_pkg->part_pkg;
1683 $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid
1687 if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1);
1690 $dbh->rollback if $oldAutoCommit;
1691 return "Error setting usage values: $error";
1695 #Good to go, cancel old package. Notify 'cancel' of whether to credit
1697 #Don't allow billing the package (preceding period packages and/or
1698 #outstanding usage) if we are keeping dates (i.e. location changing),
1699 #because the new package will be billed for the same date range.
1700 $error = $self->cancel(
1702 unused_credit => $unused_credit,
1703 nobill => $keep_dates
1706 $dbh->rollback if $oldAutoCommit;
1710 if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) {
1712 my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] );
1714 $dbh->rollback if $oldAutoCommit;
1719 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1725 use Storable 'thaw';
1727 sub process_bulk_cust_pkg {
1729 my $param = thaw(decode_base64(shift));
1730 warn Dumper($param) if $DEBUG;
1732 my $old_part_pkg = qsearchs('part_pkg',
1733 { pkgpart => $param->{'old_pkgpart'} });
1734 my $new_part_pkg = qsearchs('part_pkg',
1735 { pkgpart => $param->{'new_pkgpart'} });
1736 die "Must select a new package type\n" unless $new_part_pkg;
1737 #my $keep_dates = $param->{'keep_dates'} || 0;
1738 my $keep_dates = 1; # there is no good reason to turn this off
1740 local $SIG{HUP} = 'IGNORE';
1741 local $SIG{INT} = 'IGNORE';
1742 local $SIG{QUIT} = 'IGNORE';
1743 local $SIG{TERM} = 'IGNORE';
1744 local $SIG{TSTP} = 'IGNORE';
1745 local $SIG{PIPE} = 'IGNORE';
1747 my $oldAutoCommit = $FS::UID::AutoCommit;
1748 local $FS::UID::AutoCommit = 0;
1751 my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
1754 foreach my $old_cust_pkg ( @cust_pkgs ) {
1756 $job->update_statustext(int(100*$i/(scalar @cust_pkgs)));
1757 if ( $old_cust_pkg->getfield('cancel') ) {
1758 warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '.
1759 $old_cust_pkg->pkgnum."\n"
1763 warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n"
1765 my $error = $old_cust_pkg->change(
1766 'pkgpart' => $param->{'new_pkgpart'},
1767 'keep_dates' => $keep_dates
1769 if ( !ref($error) ) { # change returns the cust_pkg on success
1771 die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n";
1774 $dbh->commit if $oldAutoCommit;
1780 Returns the last bill date, or if there is no last bill date, the setup date.
1781 Useful for billing metered services.
1787 return $self->setfield('last_bill', $_[0]) if @_;
1788 return $self->getfield('last_bill') if $self->getfield('last_bill');
1789 my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum,
1790 'edate' => $self->bill, } );
1791 $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0;
1794 =item last_cust_pkg_reason ACTION
1796 Returns the most recent ACTION FS::cust_pkg_reason associated with the package.
1797 Returns false if there is no reason or the package is not currenly ACTION'd
1798 ACTION is one of adjourn, susp, cancel, or expire.
1802 sub last_cust_pkg_reason {
1803 my ( $self, $action ) = ( shift, shift );
1804 my $date = $self->get($action);
1806 'table' => 'cust_pkg_reason',
1807 'hashref' => { 'pkgnum' => $self->pkgnum,
1808 'action' => substr(uc($action), 0, 1),
1811 'order_by' => 'ORDER BY num DESC LIMIT 1',
1815 =item last_reason ACTION
1817 Returns the most recent ACTION FS::reason associated with the package.
1818 Returns false if there is no reason or the package is not currenly ACTION'd
1819 ACTION is one of adjourn, susp, cancel, or expire.
1824 my $cust_pkg_reason = shift->last_cust_pkg_reason(@_);
1825 $cust_pkg_reason->reason
1826 if $cust_pkg_reason;
1831 Returns the definition for this billing item, as an FS::part_pkg object (see
1838 return $self->{'_pkgpart'} if $self->{'_pkgpart'};
1839 cluck "cust_pkg->part_pkg called" if $DEBUG > 1;
1840 qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
1845 Returns the cancelled package this package was changed from, if any.
1851 return '' unless $self->change_pkgnum;
1852 qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
1857 Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
1864 $self->part_pkg->calc_setup($self, @_);
1869 Calls the I<calc_recur> of the FS::part_pkg object associated with this billing
1876 $self->part_pkg->calc_recur($self, @_);
1881 Calls the I<base_recur> of the FS::part_pkg object associated with this billing
1888 $self->part_pkg->base_recur($self, @_);
1893 Calls the I<calc_remain> of the FS::part_pkg object associated with this
1900 $self->part_pkg->calc_remain($self, @_);
1905 Calls the I<calc_cancel> of the FS::part_pkg object associated with this
1912 $self->part_pkg->calc_cancel($self, @_);
1917 Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
1923 qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
1926 =item cust_pkg_detail [ DETAILTYPE ]
1928 Returns any customer package details for this package (see
1929 L<FS::cust_pkg_detail>).
1931 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1935 sub cust_pkg_detail {
1937 my %hash = ( 'pkgnum' => $self->pkgnum );
1938 $hash{detailtype} = shift if @_;
1940 'table' => 'cust_pkg_detail',
1941 'hashref' => \%hash,
1942 'order_by' => 'ORDER BY weight, pkgdetailnum',
1946 =item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ]
1948 Sets customer package details for this package (see L<FS::cust_pkg_detail>).
1950 DETAILTYPE can be set to "I" for invoice details or "C" for comments.
1952 If there is an error, returns the error, otherwise returns false.
1956 sub set_cust_pkg_detail {
1957 my( $self, $detailtype, @details ) = @_;
1959 local $SIG{HUP} = 'IGNORE';
1960 local $SIG{INT} = 'IGNORE';
1961 local $SIG{QUIT} = 'IGNORE';
1962 local $SIG{TERM} = 'IGNORE';
1963 local $SIG{TSTP} = 'IGNORE';
1964 local $SIG{PIPE} = 'IGNORE';
1966 my $oldAutoCommit = $FS::UID::AutoCommit;
1967 local $FS::UID::AutoCommit = 0;
1970 foreach my $current ( $self->cust_pkg_detail($detailtype) ) {
1971 my $error = $current->delete;
1973 $dbh->rollback if $oldAutoCommit;
1974 return "error removing old detail: $error";
1978 foreach my $detail ( @details ) {
1979 my $cust_pkg_detail = new FS::cust_pkg_detail {
1980 'pkgnum' => $self->pkgnum,
1981 'detailtype' => $detailtype,
1982 'detail' => $detail,
1984 my $error = $cust_pkg_detail->insert;
1986 $dbh->rollback if $oldAutoCommit;
1987 return "error adding new detail: $error";
1992 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
1999 Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
2003 #false laziness w/cust_bill.pm
2007 'table' => 'cust_event',
2008 'addl_from' => 'JOIN part_event USING ( eventpart )',
2009 'hashref' => { 'tablenum' => $self->pkgnum },
2010 'extra_sql' => " AND eventtable = 'cust_pkg' ",
2014 =item num_cust_event
2016 Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
2020 #false laziness w/cust_bill.pm
2021 sub num_cust_event {
2024 "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
2025 " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
2026 my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
2027 $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
2028 $sth->fetchrow_arrayref->[0];
2031 =item cust_svc [ SVCPART ] (old, deprecated usage)
2033 =item cust_svc [ OPTION => VALUE ... ] (current usage)
2035 Returns the services for this package, as FS::cust_svc objects (see
2036 L<FS::cust_svc>). Available options are svcpart and svcdb. If either is
2037 spcififed, returns only the matching services.
2044 return () unless $self->num_cust_svc(@_);
2047 if ( @_ && $_[0] =~ /^\d+/ ) {
2048 $opt{svcpart} = shift;
2049 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2056 'table' => 'cust_svc',
2057 'hashref' => { 'pkgnum' => $self->pkgnum },
2059 if ( $opt{svcpart} ) {
2060 $search{hashref}->{svcpart} = $opt{'svcpart'};
2062 if ( $opt{'svcdb'} ) {
2063 $search{addl_from} = ' LEFT JOIN part_svc USING ( svcpart ) ';
2064 $search{hashref}->{svcdb} = $opt{'svcdb'};
2067 cluck "cust_pkg->cust_svc called" if $DEBUG > 2;
2069 #if ( $self->{'_svcnum'} ) {
2070 # values %{ $self->{'_svcnum'}->cache };
2072 $self->_sort_cust_svc( [ qsearch(\%search) ] );
2077 =item overlimit [ SVCPART ]
2079 Returns the services for this package which have exceeded their
2080 usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
2081 is specified, return only the matching services.
2087 return () unless $self->num_cust_svc(@_);
2088 grep { $_->overlimit } $self->cust_svc(@_);
2091 =item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2093 Returns historical services for this package created before END TIMESTAMP and
2094 (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects
2095 (see L<FS::h_cust_svc>). If MODE is 'I' (for 'invoice'), services with the
2096 I<pkg_svc.hidden> flag will be omitted.
2102 warn "$me _h_cust_svc called on $self\n"
2105 my ($end, $start, $mode) = @_;
2106 my @cust_svc = $self->_sort_cust_svc(
2107 [ qsearch( 'h_cust_svc',
2108 { 'pkgnum' => $self->pkgnum, },
2109 FS::h_cust_svc->sql_h_search(@_),
2112 if ( defined($mode) && $mode eq 'I' ) {
2113 my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc;
2114 return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc;
2120 sub _sort_cust_svc {
2121 my( $self, $arrayref ) = @_;
2124 sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] };
2129 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart,
2130 'svcpart' => $_->svcpart } );
2132 $pkg_svc ? $pkg_svc->primary_svc : '',
2133 $pkg_svc ? $pkg_svc->quantity : 0,
2140 =item num_cust_svc [ SVCPART ] (old, deprecated usage)
2142 =item num_cust_svc [ OPTION => VALUE ... ] (current usage)
2144 Returns the number of services for this package. Available options are svcpart
2145 and svcdb. If either is spcififed, returns only the matching services.
2152 return $self->{'_num_cust_svc'}
2154 && exists($self->{'_num_cust_svc'})
2155 && $self->{'_num_cust_svc'} =~ /\d/;
2157 cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'}
2161 if ( @_ && $_[0] =~ /^\d+/ ) {
2162 $opt{svcpart} = shift;
2163 } elsif ( @_ && ref($_[0]) eq 'HASH' ) {
2169 my $select = 'SELECT COUNT(*) FROM cust_svc ';
2170 my $where = ' WHERE pkgnum = ? ';
2171 my @param = ($self->pkgnum);
2173 if ( $opt{'svcpart'} ) {
2174 $where .= ' AND svcpart = ? ';
2175 push @param, $opt{'svcpart'};
2177 if ( $opt{'svcdb'} ) {
2178 $select .= ' LEFT JOIN part_svc USING ( svcpart ) ';
2179 $where .= ' AND svcdb = ? ';
2180 push @param, $opt{'svcdb'};
2183 my $sth = dbh->prepare("$select $where") or die dbh->errstr;
2184 $sth->execute(@param) or die $sth->errstr;
2185 $sth->fetchrow_arrayref->[0];
2188 =item available_part_svc
2190 Returns a list of FS::part_svc objects representing services included in this
2191 package but not yet provisioned. Each FS::part_svc object also has an extra
2192 field, I<num_avail>, which specifies the number of available services.
2196 sub available_part_svc {
2198 grep { $_->num_avail > 0 }
2200 my $part_svc = $_->part_svc;
2201 $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking
2202 $_->quantity - $self->num_cust_svc($_->svcpart);
2204 # more evil encapsulation breakage
2205 if($part_svc->{'Hash'}{'num_avail'} > 0) {
2206 my @exports = $part_svc->part_export_did;
2207 $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports);
2212 $self->part_pkg->pkg_svc;
2215 =item part_svc [ OPTION => VALUE ... ]
2217 Returns a list of FS::part_svc objects representing provisioned and available
2218 services included in this package. Each FS::part_svc object also has the
2219 following extra fields:
2223 =item num_cust_svc (count)
2225 =item num_avail (quantity - count)
2227 =item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
2231 Accepts one option: summarize_size. If specified and non-zero, will omit the
2232 extra cust_pkg_svc option for objects where num_cust_svc is this size or
2238 #label -> ($cust_svc->label)[1]
2244 #XXX some sort of sort order besides numeric by svcpart...
2245 my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
2247 my $part_svc = $pkg_svc->part_svc;
2248 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2249 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil
2250 $part_svc->{'Hash'}{'num_avail'} =
2251 max( 0, $pkg_svc->quantity - $num_cust_svc );
2252 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2253 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []
2254 unless exists($opt{summarize_size}) && $opt{summarize_size} > 0
2255 && $num_cust_svc >= $opt{summarize_size};
2256 $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden;
2258 } $self->part_pkg->pkg_svc;
2261 push @part_svc, map {
2263 my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
2264 $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail
2265 $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ?
2266 $part_svc->{'Hash'}{'cust_pkg_svc'} =
2267 $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : [];
2269 } $self->extra_part_svc;
2275 =item extra_part_svc
2277 Returns a list of FS::part_svc objects corresponding to services in this
2278 package which are still provisioned but not (any longer) available in the
2283 sub extra_part_svc {
2286 my $pkgnum = $self->pkgnum;
2287 #my $pkgpart = $self->pkgpart;
2290 # 'table' => 'part_svc',
2293 # "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc
2294 # WHERE pkg_svc.svcpart = part_svc.svcpart
2295 # AND pkg_svc.pkgpart = ?
2298 # AND 0 < ( SELECT COUNT(*) FROM cust_svc
2299 # LEFT JOIN cust_pkg USING ( pkgnum )
2300 # WHERE cust_svc.svcpart = part_svc.svcpart
2303 # 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ],
2306 #seems to benchmark slightly faster... (or did?)
2308 my @pkgparts = map $_->pkgpart, $self->part_pkg->self_and_svc_linked;
2309 my $pkgparts = join(',', @pkgparts);
2312 #'select' => 'DISTINCT ON (svcpart) part_svc.*',
2313 #MySQL doesn't grok DISINCT ON
2314 'select' => 'DISTINCT part_svc.*',
2315 'table' => 'part_svc',
2317 "LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart
2318 AND pkg_svc.pkgpart IN ($pkgparts)
2321 LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart )
2322 LEFT JOIN cust_pkg USING ( pkgnum )
2325 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ",
2326 'extra_param' => [ [$self->pkgnum=>'int'] ],
2332 Returns a short status string for this package, currently:
2336 =item not yet billed
2338 =item one-time charge
2353 my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq;
2355 return 'cancelled' if $self->get('cancel');
2356 return 'suspended' if $self->susp;
2357 return 'not yet billed' unless $self->setup;
2358 return 'one-time charge' if $freq =~ /^(0|$)/;
2362 =item ucfirst_status
2364 Returns the status with the first character capitalized.
2368 sub ucfirst_status {
2369 ucfirst(shift->status);
2374 Class method that returns the list of possible status strings for packages
2375 (see L<the status method|/status>). For example:
2377 @statuses = FS::cust_pkg->statuses();
2381 tie my %statuscolor, 'Tie::IxHash',
2382 'not yet billed' => '009999', #teal? cyan?
2383 'one-time charge' => '000000',
2384 'active' => '00CC00',
2385 'suspended' => 'FF9900',
2386 'cancelled' => 'FF0000',
2390 my $self = shift; #could be class...
2391 #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway
2392 # # mayble split btw one-time vs. recur
2398 Returns a hex triplet color string for this package's status.
2404 $statuscolor{$self->status};
2409 Returns a label for this package. (Currently "pkgnum: pkg - comment" or
2410 "pkg-comment" depending on user preference).
2416 my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 );
2417 $label = $self->pkgnum. ": $label"
2418 if $FS::CurrentUser::CurrentUser->option('show_pkgnum');
2422 =item pkg_label_long
2424 Returns a long label for this package, adding the primary service's label to
2429 sub pkg_label_long {
2431 my $label = $self->pkg_label;
2432 my $cust_svc = $self->primary_cust_svc;
2433 $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc;
2437 =item primary_cust_svc
2439 Returns a primary service (as FS::cust_svc object) if one can be identified.
2443 #for labeling purposes - might not 100% match up with part_pkg->svcpart's idea
2445 sub primary_cust_svc {
2448 my @cust_svc = $self->cust_svc;
2450 return '' unless @cust_svc; #no serivces - irrelevant then
2452 return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service
2454 # primary service as specified in the package definition
2455 # or exactly one service definition with quantity one
2456 my $svcpart = $self->part_pkg->svcpart;
2457 @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc;
2458 return $cust_svc[0] if scalar(@cust_svc) == 1;
2460 #couldn't identify one thing..
2466 Returns a list of lists, calling the label method for all services
2467 (see L<FS::cust_svc>) of this billing item.
2473 map { [ $_->label ] } $self->cust_svc;
2476 =item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ]
2478 Like the labels method, but returns historical information on services that
2479 were active as of END_TIMESTAMP and (optionally) not cancelled before
2480 START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the
2481 I<pkg_svc.hidden> flag will be omitted.
2483 Returns a list of lists, calling the label method for all (historical) services
2484 (see L<FS::h_cust_svc>) of this billing item.
2490 warn "$me _h_labels called on $self\n"
2492 map { [ $_->label(@_) ] } $self->h_cust_svc(@_);
2497 Like labels, except returns a simple flat list, and shortens long
2498 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2499 identical services to one line that lists the service label and the number of
2500 individual services rather than individual items.
2505 shift->_labels_short( 'labels', @_ );
2508 =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ]
2510 Like h_labels, except returns a simple flat list, and shortens long
2511 (currently >5 or the cust_bill-max_same_services configuration value) lists of
2512 identical services to one line that lists the service label and the number of
2513 individual services rather than individual items.
2517 sub h_labels_short {
2518 shift->_labels_short( 'h_labels', @_ );
2522 my( $self, $method ) = ( shift, shift );
2524 warn "$me _labels_short called on $self with $method method\n"
2527 my $conf = new FS::Conf;
2528 my $max_same_services = $conf->config('cust_bill-max_same_services') || 5;
2530 warn "$me _labels_short populating \%labels\n"
2534 #tie %labels, 'Tie::IxHash';
2535 push @{ $labels{$_->[0]} }, $_->[1]
2536 foreach $self->$method(@_);
2538 warn "$me _labels_short populating \@labels\n"
2542 foreach my $label ( keys %labels ) {
2544 my @values = grep { ! $seen{$_}++ } @{ $labels{$label} };
2545 my $num = scalar(@values);
2546 warn "$me _labels_short $num items for $label\n"
2549 if ( $num > $max_same_services ) {
2550 warn "$me _labels_short more than $max_same_services, so summarizing\n"
2552 push @labels, "$label ($num)";
2554 if ( $conf->exists('cust_bill-consolidate_services') ) {
2555 warn "$me _labels_short consolidating services\n"
2557 # push @labels, "$label: ". join(', ', @values);
2559 my $detail = "$label: ";
2560 $detail .= shift(@values). ', '
2562 && ( length($detail.$values[0]) < 78 || $detail eq "$label: " );
2564 push @labels, $detail;
2566 warn "$me _labels_short done consolidating services\n"
2569 warn "$me _labels_short adding service data\n"
2571 push @labels, map { "$label: $_" } @values;
2582 Returns the parent customer object (see L<FS::cust_main>).
2588 qsearchs( 'cust_main', { 'custnum' => $self->custnum } );
2591 #these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin
2595 Returns the location object, if any (see L<FS::cust_location>).
2597 =item cust_location_or_main
2599 If this package is associated with a location, returns the locaiton (see
2600 L<FS::cust_location>), otherwise returns the customer (see L<FS::cust_main>).
2602 =item location_label [ OPTION => VALUE ... ]
2604 Returns the label of the location object (see L<FS::cust_location>).
2608 #end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin
2610 =item seconds_since TIMESTAMP
2612 Returns the number of seconds all accounts (see L<FS::svc_acct>) in this
2613 package have been online since TIMESTAMP, according to the session monitor.
2615 TIMESTAMP is specified as a UNIX timestamp; see L<perlfunc/"time">. Also see
2616 L<Time::Local> and L<Date::Parse> for conversion functions.
2621 my($self, $since) = @_;
2624 foreach my $cust_svc (
2625 grep { $_->part_svc->svcdb eq 'svc_acct' } $self->cust_svc
2627 $seconds += $cust_svc->seconds_since($since);
2634 =item seconds_since_sqlradacct TIMESTAMP_START TIMESTAMP_END
2636 Returns the numbers of seconds all accounts (see L<FS::svc_acct>) in this
2637 package have been online between TIMESTAMP_START (inclusive) and TIMESTAMP_END
2640 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2641 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2647 sub seconds_since_sqlradacct {
2648 my($self, $start, $end) = @_;
2652 foreach my $cust_svc (
2654 my $part_svc = $_->part_svc;
2655 $part_svc->svcdb eq 'svc_acct'
2656 && scalar($part_svc->part_export('sqlradius'));
2659 $seconds += $cust_svc->seconds_since_sqlradacct($start, $end);
2666 =item attribute_since_sqlradacct TIMESTAMP_START TIMESTAMP_END ATTRIBUTE
2668 Returns the sum of the given attribute for all accounts (see L<FS::svc_acct>)
2669 in this package for sessions ending between TIMESTAMP_START (inclusive) and
2673 TIMESTAMP_START and TIMESTAMP_END are specified as UNIX timestamps; see
2674 L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for conversion
2679 sub attribute_since_sqlradacct {
2680 my($self, $start, $end, $attrib) = @_;
2684 foreach my $cust_svc (
2686 my $part_svc = $_->part_svc;
2687 $part_svc->svcdb eq 'svc_acct'
2688 && scalar($part_svc->part_export('sqlradius'));
2691 $sum += $cust_svc->attribute_since_sqlradacct($start, $end, $attrib);
2703 my( $self, $value ) = @_;
2704 if ( defined($value) ) {
2705 $self->setfield('quantity', $value);
2707 $self->getfield('quantity') || 1;
2710 =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ]
2712 Transfers as many services as possible from this package to another package.
2714 The destination package can be specified by pkgnum by passing an FS::cust_pkg
2715 object. The destination package must already exist.
2717 Services are moved only if the destination allows services with the correct
2718 I<svcpart> (not svcdb), unless the B<change_svcpart> option is set true. Use
2719 this option with caution! No provision is made for export differences
2720 between the old and new service definitions. Probably only should be used
2721 when your exports for all service definitions of a given svcdb are identical.
2722 (attempt a transfer without it first, to move all possible svcpart-matching
2725 Any services that can't be moved remain in the original package.
2727 Returns an error, if there is one; otherwise, returns the number of services
2728 that couldn't be moved.
2733 my ($self, $dest_pkgnum, %opt) = @_;
2739 if (ref ($dest_pkgnum) eq 'FS::cust_pkg') {
2740 $dest = $dest_pkgnum;
2741 $dest_pkgnum = $dest->pkgnum;
2743 $dest = qsearchs('cust_pkg', { pkgnum => $dest_pkgnum });
2746 return ('Package does not exist: '.$dest_pkgnum) unless $dest;
2748 foreach my $pkg_svc ( $dest->part_pkg->pkg_svc ) {
2749 $target{$pkg_svc->svcpart} = $pkg_svc->quantity;
2752 foreach my $cust_svc ($dest->cust_svc) {
2753 $target{$cust_svc->svcpart}--;
2756 my %svcpart2svcparts = ();
2757 if ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2758 warn "change_svcpart option received, creating alternates list\n" if $DEBUG;
2759 foreach my $svcpart ( map { $_->svcpart } $self->cust_svc ) {
2760 next if exists $svcpart2svcparts{$svcpart};
2761 my $part_svc = qsearchs('part_svc', { 'svcpart' => $svcpart } );
2762 $svcpart2svcparts{$svcpart} = [
2764 sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }
2766 my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $dest->pkgpart,
2767 'svcpart' => $_ } );
2769 $pkg_svc ? $pkg_svc->primary_svc : '',
2770 $pkg_svc ? $pkg_svc->quantity : 0,
2774 grep { $_ != $svcpart }
2776 qsearch('part_svc', { 'svcdb' => $part_svc->svcdb } )
2778 warn "alternates for svcpart $svcpart: ".
2779 join(', ', @{$svcpart2svcparts{$svcpart}}). "\n"
2784 foreach my $cust_svc ($self->cust_svc) {
2785 if($target{$cust_svc->svcpart} > 0) {
2786 $target{$cust_svc->svcpart}--;
2787 my $new = new FS::cust_svc { $cust_svc->hash };
2788 $new->pkgnum($dest_pkgnum);
2789 my $error = $new->replace($cust_svc);
2790 return $error if $error;
2791 } elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
2793 warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
2794 warn "alternates to consider: ".
2795 join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
2797 my @alternate = grep {
2798 warn "considering alternate svcpart $_: ".
2799 "$target{$_} available in new package\n"
2802 } @{$svcpart2svcparts{$cust_svc->svcpart}};
2804 warn "alternate(s) found\n" if $DEBUG;
2805 my $change_svcpart = $alternate[0];
2806 $target{$change_svcpart}--;
2807 my $new = new FS::cust_svc { $cust_svc->hash };
2808 $new->svcpart($change_svcpart);
2809 $new->pkgnum($dest_pkgnum);
2810 my $error = $new->replace($cust_svc);
2811 return $error if $error;
2824 This method is deprecated. See the I<depend_jobnum> option to the insert and
2825 order_pkgs methods in FS::cust_main for a better way to defer provisioning.
2832 local $SIG{HUP} = 'IGNORE';
2833 local $SIG{INT} = 'IGNORE';
2834 local $SIG{QUIT} = 'IGNORE';
2835 local $SIG{TERM} = 'IGNORE';
2836 local $SIG{TSTP} = 'IGNORE';
2837 local $SIG{PIPE} = 'IGNORE';
2839 my $oldAutoCommit = $FS::UID::AutoCommit;
2840 local $FS::UID::AutoCommit = 0;
2843 foreach my $cust_svc ( $self->cust_svc ) {
2844 #false laziness w/svc_Common::insert
2845 my $svc_x = $cust_svc->svc_x;
2846 foreach my $part_export ( $cust_svc->part_svc->part_export ) {
2847 my $error = $part_export->export_insert($svc_x);
2849 $dbh->rollback if $oldAutoCommit;
2855 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
2862 Associates this package with a (suspension or cancellation) reason (see
2863 L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
2866 Available options are:
2872 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.
2876 the access_user (see L<FS::access_user>) providing the reason
2884 the action (cancel, susp, adjourn, expire) associated with the reason
2888 If there is an error, returns the error, otherwise returns false.
2893 my ($self, %options) = @_;
2895 my $otaker = $options{reason_otaker} ||
2896 $FS::CurrentUser::CurrentUser->username;
2899 if ( $options{'reason'} =~ /^(\d+)$/ ) {
2903 } elsif ( ref($options{'reason'}) ) {
2905 return 'Enter a new reason (or select an existing one)'
2906 unless $options{'reason'}->{'reason'} !~ /^\s*$/;
2908 my $reason = new FS::reason({
2909 'reason_type' => $options{'reason'}->{'typenum'},
2910 'reason' => $options{'reason'}->{'reason'},
2912 my $error = $reason->insert;
2913 return $error if $error;
2915 $reasonnum = $reason->reasonnum;
2918 return "Unparsable reason: ". $options{'reason'};
2921 my $cust_pkg_reason =
2922 new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
2923 'reasonnum' => $reasonnum,
2924 'otaker' => $otaker,
2925 'action' => substr(uc($options{'action'}),0,1),
2926 'date' => $options{'date'}
2931 $cust_pkg_reason->insert;
2934 =item insert_discount
2936 Associates this package with a discount (see L<FS::cust_pkg_discount>, possibly
2937 inserting a new discount on the fly (see L<FS::discount>).
2939 Available options are:
2947 If there is an error, returns the error, otherwise returns false.
2951 sub insert_discount {
2952 #my ($self, %options) = @_;
2955 my $cust_pkg_discount = new FS::cust_pkg_discount {
2956 'pkgnum' => $self->pkgnum,
2957 'discountnum' => $self->discountnum,
2959 'end_date' => '', #XXX
2960 #for the create a new discount case
2961 '_type' => $self->discountnum__type,
2962 'amount' => $self->discountnum_amount,
2963 'percent' => $self->discountnum_percent,
2964 'months' => $self->discountnum_months,
2965 'setup' => $self->discountnum_setup,
2966 #'disabled' => $self->discountnum_disabled,
2969 $cust_pkg_discount->insert;
2972 =item set_usage USAGE_VALUE_HASHREF
2974 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2975 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2976 upbytes, downbytes, and totalbytes are appropriate keys.
2978 All svc_accts which are part of this package have their values reset.
2983 my ($self, $valueref, %opt) = @_;
2985 #only svc_acct can set_usage for now
2986 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
2987 my $svc_x = $cust_svc->svc_x;
2988 $svc_x->set_usage($valueref, %opt)
2989 if $svc_x->can("set_usage");
2993 =item recharge USAGE_VALUE_HASHREF
2995 USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
2996 to which they should be set (see L<FS::svc_acct>). Currently seconds,
2997 upbytes, downbytes, and totalbytes are appropriate keys.
2999 All svc_accts which are part of this package have their values incremented.
3004 my ($self, $valueref) = @_;
3006 #only svc_acct can set_usage for now
3007 foreach my $cust_svc ( $self->cust_svc( 'svcdb'=>'svc_acct' ) ) {
3008 my $svc_x = $cust_svc->svc_x;
3009 $svc_x->recharge($valueref)
3010 if $svc_x->can("recharge");
3014 =item cust_pkg_discount
3018 sub cust_pkg_discount {
3020 qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } );
3023 =item cust_pkg_discount_active
3027 sub cust_pkg_discount_active {
3029 grep { $_->status eq 'active' } $self->cust_pkg_discount;
3034 =head1 CLASS METHODS
3040 Returns an SQL expression identifying recurring packages.
3044 sub recurring_sql { "
3045 '0' != ( select freq from part_pkg
3046 where cust_pkg.pkgpart = part_pkg.pkgpart )
3051 Returns an SQL expression identifying one-time packages.
3056 '0' = ( select freq from part_pkg
3057 where cust_pkg.pkgpart = part_pkg.pkgpart )
3062 Returns an SQL expression identifying ordered packages (recurring packages not
3068 $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql;
3073 Returns an SQL expression identifying active packages.
3078 $_[0]->recurring_sql. "
3079 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
3080 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3081 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3084 =item not_yet_billed_sql
3086 Returns an SQL expression identifying packages which have not yet been billed.
3090 sub not_yet_billed_sql { "
3091 ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 )
3092 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3093 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3098 Returns an SQL expression identifying inactive packages (one-time packages
3099 that are otherwise unsuspended/uncancelled).
3103 sub inactive_sql { "
3104 ". $_[0]->onetime_sql(). "
3105 AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0
3106 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3107 AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 )
3113 Returns an SQL expression identifying suspended packages.
3117 sub suspended_sql { susp_sql(@_); }
3119 #$_[0]->recurring_sql(). ' AND '.
3121 ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
3122 AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0
3129 Returns an SQL exprression identifying cancelled packages.
3133 sub cancelled_sql { cancel_sql(@_); }
3135 #$_[0]->recurring_sql(). ' AND '.
3136 "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
3141 Returns an SQL expression to give the package status as a string.
3147 WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled'
3148 WHEN cust_pkg.susp IS NOT NULL THEN 'suspended'
3149 WHEN cust_pkg.setup IS NULL THEN 'not yet billed'
3150 WHEN ".onetime_sql()." THEN 'one-time charge'
3155 =item search HASHREF
3159 Returns a qsearch hash expression to search for parameters specified in HASHREF.
3160 Valid parameters are
3168 active, inactive, suspended, cancel (or cancelled)
3172 active, inactive, suspended, one-time charge, inactive, cancel (or cancelled)
3176 boolean selects custom packages
3182 pkgpart or arrayref or hashref of pkgparts
3186 arrayref of beginning and ending epoch date
3190 arrayref of beginning and ending epoch date
3194 arrayref of beginning and ending epoch date
3198 arrayref of beginning and ending epoch date
3202 arrayref of beginning and ending epoch date
3206 arrayref of beginning and ending epoch date
3210 arrayref of beginning and ending epoch date
3214 pkgnum or APKG_pkgnum
3218 a value suited to passing to FS::UI::Web::cust_header
3222 specifies the user for agent virtualization
3226 boolean selects packages containing fcc form 477 telco lines
3233 my ($class, $params) = @_;
3240 if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
3242 "cust_main.agentnum = $1";
3249 if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) {
3251 "cust_pkg.custnum = $1";
3258 if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) {
3260 "cust_pkg.pkgbatch = '$1'";
3267 if ( $params->{'magic'} eq 'active'
3268 || $params->{'status'} eq 'active' ) {
3270 push @where, FS::cust_pkg->active_sql();
3272 } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/
3273 || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) {
3275 push @where, FS::cust_pkg->not_yet_billed_sql();
3277 } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/
3278 || $params->{'status'} =~ /^(one-time charge|inactive)/ ) {
3280 push @where, FS::cust_pkg->inactive_sql();
3282 } elsif ( $params->{'magic'} eq 'suspended'
3283 || $params->{'status'} eq 'suspended' ) {
3285 push @where, FS::cust_pkg->suspended_sql();
3287 } elsif ( $params->{'magic'} =~ /^cancell?ed$/
3288 || $params->{'status'} =~ /^cancell?ed$/ ) {
3290 push @where, FS::cust_pkg->cancelled_sql();
3295 # parse package class
3298 if ( exists($params->{'classnum'}) ) {
3301 if ( ref($params->{'classnum'}) ) {
3303 if ( ref($params->{'classnum'}) eq 'HASH' ) {
3304 @classnum = grep $params->{'classnum'}{$_}, keys %{ $params->{'classnum'} };
3305 } elsif ( ref($params->{'classnum'}) eq 'ARRAY' ) {
3306 @classnum = @{ $params->{'classnum'} };
3308 die 'unhandled classnum ref '. $params->{'classnum'};
3312 } elsif ( $params->{'classnum'} =~ /^(\d*)$/ && $1 ne '0' ) {
3319 my @nums = grep $_, @classnum;
3320 push @c_where, 'part_pkg.classnum IN ('. join(',',@nums). ')' if @nums;
3321 my $null = scalar( grep { $_ eq '' } @classnum );
3322 push @c_where, 'part_pkg.classnum IS NULL' if $null;
3324 if ( scalar(@c_where) == 1 ) {
3325 push @where, @c_where;
3326 } elsif ( @c_where ) {
3327 push @where, ' ( '. join(' OR ', @c_where). ' ) ';
3336 # parse package report options
3339 my @report_option = ();
3340 if ( exists($params->{'report_option'}) ) {
3341 if ( ref($params->{'report_option'}) eq 'ARRAY' ) {
3342 @report_option = @{ $params->{'report_option'} };
3343 } elsif ( $params->{'report_option'} =~ /^([,\d]*)$/ ) {
3344 @report_option = split(',', $1);
3349 if (@report_option) {
3350 # this will result in the empty set for the dangling comma case as it should
3352 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3353 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3354 AND optionname = 'report_option_$_'
3355 AND optionvalue = '1' )"
3359 foreach my $any ( grep /^report_option_any/, keys %$params ) {
3361 my @report_option_any = ();
3362 if ( ref($params->{$any}) eq 'ARRAY' ) {
3363 @report_option_any = @{ $params->{$any} };
3364 } elsif ( $params->{$any} =~ /^([,\d]*)$/ ) {
3365 @report_option_any = split(',', $1);
3368 if (@report_option_any) {
3369 # this will result in the empty set for the dangling comma case as it should
3370 push @where, ' ( '. join(' OR ',
3371 map{ "0 < ( SELECT count(*) FROM part_pkg_option
3372 WHERE part_pkg_option.pkgpart = part_pkg.pkgpart
3373 AND optionname = 'report_option_$_'
3374 AND optionvalue = '1' )"
3375 } @report_option_any
3385 push @where, "part_pkg.custom = 'Y'" if $params->{custom};
3391 push @where, "(part_pkg.fcc_ds0s > 0 OR pkg_class.fcc_ds0s > 0)"
3392 if $params->{fcc_line};
3398 if ( exists($params->{'censustract'}) ) {
3399 $params->{'censustract'} =~ /^([.\d]*)$/;
3400 my $censustract = "cust_main.censustract = '$1'";
3401 $censustract .= ' OR cust_main.censustract is NULL' unless $1;
3402 push @where, "( $censustract )";
3406 # parse censustract2
3408 if ( exists($params->{'censustract2'})
3409 && $params->{'censustract2'} =~ /^(\d*)$/
3413 push @where, "cust_main.censustract LIKE '$1%'";
3416 "( cust_main.censustract = '' OR cust_main.censustract IS NULL )";
3424 if ( ref($params->{'pkgpart'}) ) {
3427 if ( ref($params->{'pkgpart'}) eq 'HASH' ) {
3428 @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} };
3429 } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) {
3430 @pkgpart = @{ $params->{'pkgpart'} };
3432 die 'unhandled pkgpart ref '. $params->{'pkgpart'};
3435 @pkgpart = grep /^(\d+)$/, @pkgpart;
3437 push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart);
3439 } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3440 push @where, "pkgpart = $1";
3449 #false laziness w/report_cust_pkg.html
3452 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
3453 'active' => { 'susp'=>1, 'cancel'=>1 },
3454 'suspended' => { 'cancel' => 1 },
3459 if( exists($params->{'active'} ) ) {
3460 # This overrides all the other date-related fields
3461 my($beginning, $ending) = @{$params->{'active'}};
3463 "cust_pkg.setup IS NOT NULL",
3464 "cust_pkg.setup <= $ending",
3465 "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )",
3466 "NOT (".FS::cust_pkg->onetime_sql . ")";
3469 foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
3471 next unless exists($params->{$field});
3473 my($beginning, $ending) = @{$params->{$field}};
3475 next if $beginning == 0 && $ending == 4294967295;
3478 "cust_pkg.$field IS NOT NULL",
3479 "cust_pkg.$field >= $beginning",
3480 "cust_pkg.$field <= $ending";
3482 $orderby ||= "ORDER BY cust_pkg.$field";
3487 $orderby ||= 'ORDER BY bill';
3490 # parse magic, legacy, etc.
3493 if ( $params->{'magic'} &&
3494 $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
3497 $orderby = 'ORDER BY pkgnum';
3499 if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
3500 push @where, "pkgpart = $1";
3503 } elsif ( $params->{'query'} eq 'pkgnum' ) {
3505 $orderby = 'ORDER BY pkgnum';
3507 } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
3509 $orderby = 'ORDER BY pkgnum';
3512 SELECT count(*) FROM pkg_svc
3513 WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
3514 AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
3515 WHERE cust_svc.pkgnum = cust_pkg.pkgnum
3516 AND cust_svc.svcpart = pkg_svc.svcpart
3523 # setup queries, links, subs, etc. for the search
3526 # here is the agent virtualization
3527 if ($params->{CurrentUser}) {
3529 qsearchs('access_user', { username => $params->{CurrentUser} });
3532 push @where, $access_user->agentnums_sql('table'=>'cust_main');
3537 push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
3540 my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
3542 my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
3543 'LEFT JOIN part_pkg USING ( pkgpart ) '.
3544 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) ';
3546 my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
3549 'table' => 'cust_pkg',
3551 'select' => join(', ',
3553 ( map "part_pkg.$_", qw( pkg freq ) ),
3554 'pkg_class.classname',
3555 'cust_main.custnum AS cust_main_custnum',
3556 FS::UI::Web::cust_sql_fields(
3557 $params->{'cust_fields'}
3560 'extra_sql' => $extra_sql,
3561 'order_by' => $orderby,
3562 'addl_from' => $addl_from,
3563 'count_query' => $count_query,
3570 Returns a list of two package counts. The first is a count of packages
3571 based on the supplied criteria and the second is the count of residential
3572 packages with those same criteria. Criteria are specified as in the search
3578 my ($class, $params) = @_;
3580 my $sql_query = $class->search( $params );
3582 my $count_sql = delete($sql_query->{'count_query'});
3583 $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/
3584 or die "couldn't parse count_sql";
3586 my $count_sth = dbh->prepare($count_sql)
3587 or die "Error preparing $count_sql: ". dbh->errstr;
3589 or die "Error executing $count_sql: ". $count_sth->errstr;
3590 my $count_arrayref = $count_sth->fetchrow_arrayref;
3592 return ( @$count_arrayref );
3599 Returns a list: the first item is an SQL fragment identifying matching
3600 packages/customers via location (taking into account shipping and package
3601 address taxation, if enabled), and subsequent items are the parameters to
3602 substitute for the placeholders in that fragment.
3607 my($class, %opt) = @_;
3608 my $ornull = $opt{'ornull'};
3610 my $conf = new FS::Conf;
3612 # '?' placeholders in _location_sql_where
3613 my $x = $ornull ? 3 : 2;
3624 if ( $conf->exists('tax-ship_address') ) {
3627 ( ( ship_last IS NULL OR ship_last = '' )
3628 AND ". _location_sql_where('cust_main', '', $ornull ). "
3630 OR ( ship_last IS NOT NULL AND ship_last != ''
3631 AND ". _location_sql_where('cust_main', 'ship_', $ornull ). "
3634 # AND payby != 'COMP'
3636 @main_param = ( @bill_param, @bill_param );
3640 $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP'
3641 @main_param = @bill_param;
3647 if ( $conf->exists('tax-pkg_address') ) {
3649 my $loc_where = _location_sql_where( 'cust_location', '', $ornull );
3652 ( cust_pkg.locationnum IS NULL AND $main_where )
3653 OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where )
3656 @param = ( @main_param, @bill_param );
3660 $where = $main_where;
3661 @param = @main_param;
3669 #subroutine, helper for location_sql
3670 sub _location_sql_where {
3672 my $prefix = @_ ? shift : '';
3673 my $ornull = @_ ? shift : '';
3675 # $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : '';
3677 $ornull = $ornull ? ' OR ? IS NULL ' : '';
3679 my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL )";
3680 my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL )";
3681 my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL )";
3683 # ( $table.${prefix}city = ? $or_empty_city $ornull )
3685 ( $table.district = ? OR ? = '' OR CAST(? AS text) IS NULL )
3686 AND ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL )
3687 AND ( $table.${prefix}county = ? $or_empty_county $ornull )
3688 AND ( $table.${prefix}state = ? $or_empty_state $ornull )
3689 AND $table.${prefix}country = ?
3694 my( $self, $what ) = @_;
3696 my $what_show_zero = $what. '_show_zero';
3697 length($self->$what_show_zero())
3698 ? ($self->$what_show_zero() eq 'Y')
3699 : $self->part_pkg->$what_show_zero();
3706 =item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
3708 CUSTNUM is a customer (see L<FS::cust_main>)
3710 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3711 L<FS::part_pkg>) to order for this customer. Duplicates are of course
3714 REMOVE_PKGNUMS is an optional list of pkgnums specifying the billing items to
3715 remove for this customer. The services (see L<FS::cust_svc>) are moved to the
3716 new billing items. An error is returned if this is not possible (see
3717 L<FS::pkg_svc>). An empty arrayref is equivalent to not specifying this
3720 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3721 newly-created cust_pkg objects.
3723 REFNUM, if specified, will specify the FS::pkg_referral record to be created
3724 and inserted. Multiple FS::pkg_referral records can be created by
3725 setting I<refnum> to an array reference of refnums or a hash reference with
3726 refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
3727 record will be created corresponding to cust_main.refnum.
3732 my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
3734 my $conf = new FS::Conf;
3736 # Transactionize this whole mess
3737 local $SIG{HUP} = 'IGNORE';
3738 local $SIG{INT} = 'IGNORE';
3739 local $SIG{QUIT} = 'IGNORE';
3740 local $SIG{TERM} = 'IGNORE';
3741 local $SIG{TSTP} = 'IGNORE';
3742 local $SIG{PIPE} = 'IGNORE';
3744 my $oldAutoCommit = $FS::UID::AutoCommit;
3745 local $FS::UID::AutoCommit = 0;
3749 # my $cust_main = qsearchs('cust_main', { custnum => $custnum });
3750 # return "Customer not found: $custnum" unless $cust_main;
3752 warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n"
3755 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3758 my $change = scalar(@old_cust_pkg) != 0;
3761 if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
3763 warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum.
3764 " to pkgpart ". $pkgparts->[0]. "\n"
3767 my $err_or_cust_pkg =
3768 $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0],
3769 'refnum' => $refnum,
3772 unless (ref($err_or_cust_pkg)) {
3773 $dbh->rollback if $oldAutoCommit;
3774 return $err_or_cust_pkg;
3777 push @$return_cust_pkg, $err_or_cust_pkg;
3778 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3783 # Create the new packages.
3784 foreach my $pkgpart (@$pkgparts) {
3786 warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG;
3788 my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
3789 pkgpart => $pkgpart,
3793 $error = $cust_pkg->insert( 'change' => $change );
3795 $dbh->rollback if $oldAutoCommit;
3798 push @$return_cust_pkg, $cust_pkg;
3800 # $return_cust_pkg now contains refs to all of the newly
3803 # Transfer services and cancel old packages.
3804 foreach my $old_pkg (@old_cust_pkg) {
3806 warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n"
3809 foreach my $new_pkg (@$return_cust_pkg) {
3810 $error = $old_pkg->transfer($new_pkg);
3811 if ($error and $error == 0) {
3812 # $old_pkg->transfer failed.
3813 $dbh->rollback if $oldAutoCommit;
3818 if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) {
3819 warn "trying transfer again with change_svcpart option\n" if $DEBUG;
3820 foreach my $new_pkg (@$return_cust_pkg) {
3821 $error = $old_pkg->transfer($new_pkg, 'change_svcpart'=>1 );
3822 if ($error and $error == 0) {
3823 # $old_pkg->transfer failed.
3824 $dbh->rollback if $oldAutoCommit;
3831 # Transfers were successful, but we went through all of the
3832 # new packages and still had services left on the old package.
3833 # We can't cancel the package under the circumstances, so abort.
3834 $dbh->rollback if $oldAutoCommit;
3835 return "Unable to transfer all services from package ".$old_pkg->pkgnum;
3837 $error = $old_pkg->cancel( quiet=>1 );
3843 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3847 =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ]
3849 A bulk change method to change packages for multiple customers.
3851 PKGPARTS is a list of pkgparts specifying the the billing item definitions (see
3852 L<FS::part_pkg>) to order for each customer. Duplicates are of course
3855 REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
3856 replace. The services (see L<FS::cust_svc>) are moved to the
3857 new billing items. An error is returned if this is not possible (see
3860 RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
3861 newly-created cust_pkg objects.
3866 my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
3868 # Transactionize this whole mess
3869 local $SIG{HUP} = 'IGNORE';
3870 local $SIG{INT} = 'IGNORE';
3871 local $SIG{QUIT} = 'IGNORE';
3872 local $SIG{TERM} = 'IGNORE';
3873 local $SIG{TSTP} = 'IGNORE';
3874 local $SIG{PIPE} = 'IGNORE';
3876 my $oldAutoCommit = $FS::UID::AutoCommit;
3877 local $FS::UID::AutoCommit = 0;
3881 my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
3884 while(scalar(@old_cust_pkg)) {
3886 my $custnum = $old_cust_pkg[0]->custnum;
3887 my (@remove) = map { $_->pkgnum }
3888 grep { $_->custnum == $custnum } @old_cust_pkg;
3889 @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
3891 my $error = order $custnum, $pkgparts, \@remove, \@return;
3893 push @errors, $error
3895 push @$return_cust_pkg, @return;
3898 if (scalar(@errors)) {
3899 $dbh->rollback if $oldAutoCommit;
3900 return join(' / ', @errors);
3903 $dbh->commit or die $dbh->errstr if $oldAutoCommit;
3907 # Used by FS::Upgrade to migrate to a new database.
3908 sub _upgrade_data { # class method
3909 my ($class, %opts) = @_;
3910 $class->_upgrade_otaker(%opts);
3912 # RT#10139, bug resulting in contract_end being set when it shouldn't
3913 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1',
3914 # RT#10830, bad calculation of prorate date near end of year
3915 # the date range for bill is December 2009, and we move it forward
3916 # one year if it's before the previous bill date (which it should
3918 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill
3919 AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg
3920 WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'',
3921 # RT6628, add order_date to cust_pkg
3922 'update cust_pkg set order_date = (select history_date from h_cust_pkg
3923 where h_cust_pkg.pkgnum = cust_pkg.pkgnum and
3924 history_action = \'insert\') where order_date is null',
3926 foreach my $sql (@statements) {
3927 my $sth = dbh->prepare($sql);
3928 $sth->execute or die $sth->errstr;
3936 sub order is not OO. Perhaps it should be moved to FS::cust_main and made so?
3938 In sub order, the @pkgparts array (passed by reference) is clobbered.
3940 Also in sub order, no money is adjusted. Once FS::part_pkg defines a standard
3941 method to pass dates to the recur_prog expression, it should do so.
3943 FS::svc_acct, FS::svc_domain, FS::svc_www, FS::svc_ip and FS::svc_forward are
3944 loaded via 'use' at compile time, rather than via 'require' in sub { setup,
3945 suspend, unsuspend, cancel } because they use %FS::UID::callback to load
3946 configuration values. Probably need a subroutine which decides what to do
3947 based on whether or not we've fetched the user yet, rather than a hash. See
3948 FS::UID and the TODO.
3950 Now that things are transactional should the check in the insert method be
3955 L<FS::Record>, L<FS::cust_main>, L<FS::part_pkg>, L<FS::cust_svc>,
3956 L<FS::pkg_svc>, schema.html from the base documentation