X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=2ed25a06c5341daf58c32b14efa98c5a8b1f0e07;hp=457d257863615a8d1ec0f2d30dc38233d760d18f;hb=74e058c8a010ef6feb539248a550d0bb169c1e94;hpb=7905f5dfd903529a6de89875e6fae74638a89aa3 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 457d25786..2ed25a06c 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,27 +1,34 @@ package FS::cust_pkg; use strict; -use vars qw(@ISA $disable_agentcheck $DEBUG); +use base qw( FS::otaker_Mixin FS::cust_main_Mixin FS::location_Mixin + FS::m2m_Common FS::option_Common ); +use vars qw($disable_agentcheck $DEBUG $me); +use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use Time::Local qw( timelocal_nocheck ); +use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); -use FS::m2m_Common; -use FS::cust_main_Mixin; +use FS::CurrentUser; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; -use FS::type_pkgs; +use FS::cust_location; use FS::pkg_svc; use FS::cust_bill_pkg; +use FS::cust_pkg_detail; use FS::cust_event; use FS::h_cust_svc; use FS::reg_code; use FS::part_svc; use FS::cust_pkg_reason; use FS::reason; +use FS::cust_pkg_discount; +use FS::discount; use FS::UI::Web; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, @@ -35,9 +42,8 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record ); - $DEBUG = 0; +$me = '[FS::cust_pkg]'; $disable_agentcheck = 0; @@ -103,38 +109,92 @@ inherits from FS::Record. The following fields are currently supported: =over 4 -=item pkgnum - primary key (assigned automatically for new billing items) +=item pkgnum + +Primary key (assigned automatically for new billing items) + +=item custnum + +Customer (see L) + +=item pkgpart + +Billing item definition (see L) + +=item locationnum + +Optional link to package location (see L) + +=item start_date + +date + +=item setup + +date + +=item bill + +date (next bill date) + +=item last_bill + +last bill date + +=item adjourn + +date + +=item susp + +date + +=item expire + +date + +=item contract_end + +date + +=item cancel + +date + +=item usernum + +order taker (see L) -=item custnum - Customer (see L) +=item manual_flag -=item pkgpart - Billing item definition (see L) +If this field is set to 1, disables the automatic +unsuspension of this package when using the B config option. -=item setup - date +=item quantity -=item bill - date (next bill date) +If not set, defaults to 1 -=item last_bill - last bill date +=item change_date -=item adjourn - date +Date of change from previous package -=item susp - date +=item change_pkgnum -=item expire - date +Previous pkgnum -=item cancel - date +=item change_pkgpart -=item otaker - order taker (assigned automatically if null, see L) +Previous pkgpart -=item manual_flag - If this field is set to 1, disables the automatic -unsuspension of this package when using the B config file. +=item change_locationnum -=item quantity - If not set, defaults to 1 +Previous locationnum =back -Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps; -see L. Also see L and L for -conversion functions. +Note: setup, last_bill, bill, adjourn, susp, expire, cancel and change_date +are specified as UNIX timestamps; see L. Also see +L and L for conversion functions. =head1 METHODS @@ -169,15 +229,48 @@ setting I to an array reference of refnums or a hash reference with refnums as keys. If no I is defined, a default FS::pkg_referral record will be created corresponding to cust_main.refnum. -The following options are available: I +The following options are available: + +=over 4 + +=item change + +If set true, supresses any referral credit to a referring customer. + +=item options + +cust_pkg_option records will be created + +=item ticket_subject + +a ticket will be added to this customer with this subject + +=item ticket_queue + +an optional queue name for ticket additions -I, if set true, supresses any referral credit to a referring customer. +=back =cut sub insert { my( $self, %options ) = @_; + if ( $self->part_pkg->option('start_1st', 1) && !$self->start_date ) { + my ($sec,$min,$hour,$mday,$mon,$year) = (localtime(time) )[0,1,2,3,4,5]; + $mon += 1 unless $mday == 1; + until ( $mon < 12 ) { $mon -= 12; $year++; } + $self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) ); + } + + foreach my $action ( qw(expire adjourn contract_end) ) { + my $months = $self->part_pkg->option("${action}_months",1); + if($months and !$self->$action) { + my $start = $self->start_date || $self->setup || time; + $self->$action( $self->part_pkg->add_freq($start, $months) ); + } + } + local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -202,6 +295,14 @@ sub insert { 'params' => $self->refnum, ); + if ( $self->discountnum ) { + my $error = $self->insert_discount(); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + #if ( $self->reg_code ) { # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); # $error = $reg_code->delete; @@ -212,41 +313,32 @@ sub insert { #} my $conf = new FS::Conf; - my $cust_main = $self->cust_main; - my $part_pkg = $self->part_pkg; - if ( $conf->exists('referral_credit') - && $cust_main->referral_custnum - && ! $options{'change'} - && $part_pkg->freq !~ /^0\D?$/ - ) - { - my $referring_cust_main = $cust_main->referring_cust_main; - if ( $referring_cust_main->status ne 'cancelled' ) { - my $error; - if ( $part_pkg->freq !~ /^\d+$/ ) { - warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. - ' for package '. $self->pkgnum. - ' ( customer '. $self->custnum. ')'. - ' - One-time referral credits not (yet) available for '. - ' packages with '. $part_pkg->freq_pretty. ' frequency'; - } else { - - my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); - my $error = - $referring_cust_main-> - credit( $amount, - 'Referral credit for '.$cust_main->name, - 'reason_type' => $conf->config('referral_credit_type') - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error crediting customer ". $cust_main->referral_custnum. - " for referral: $error"; - } - - } - } + if ( $conf->config('ticket_system') && $options{ticket_subject} ) { + + #eval ' + # use lib ( "/opt/rt3/local/lib", "/opt/rt3/lib" ); + # use RT; + #'; + #die $@ if $@; + # + #RT::LoadConfig(); + #RT::Init(); + use FS::TicketSystem; + FS::TicketSystem->init(); + + my $q = new RT::Queue($RT::SystemUser); + $q->Load($options{ticket_queue}) if $options{ticket_queue}; + my $t = new RT::Ticket($RT::SystemUser); + my $mime = new MIME::Entity; + $mime->build( Type => 'text/plain', Data => $options{ticket_subject} ); + $t->Create( $options{ticket_queue} ? (Queue => $q) : (), + Subject => $options{ticket_subject}, + MIMEObj => $mime, + ); + $t->AddLink( Type => 'MemberOf', + Target => 'freeside://freeside/cust_main/'. $self->custnum, + ); } if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) { @@ -282,7 +374,7 @@ the customer ever purchased the item. Instead, see the cancel method. # return "Can't delete cust_pkg records!"; #} -=item replace OLD_RECORD +=item replace [ OLD_RECORD ] [ HASHREF | OPTION => VALUE ... ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. @@ -299,7 +391,23 @@ suspend is normally updated by the suspend and unsuspend methods. cancel is normally updated by the cancel method (and also the order subroutine in some cases). -Calls +Available options are: + +=over 4 + +=item reason + +can be set to a cancellation reason (see L), 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, reason - Text of the new reason. + +=item reason_otaker + +the access_user (see L) providing the reason + +=item options + +hashref of keys and values - cust_pkg_option records will be created, updated or removed as appopriate + +=back =cut @@ -316,7 +424,7 @@ sub replace { : { @_ }; #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; - return "Can't change otaker!" if $old->otaker ne $new->otaker; + #return "Can't change otaker!" if $old->otaker ne $new->otaker; #allow this *sigh* #return "Can't change setup once it exists!" @@ -340,11 +448,12 @@ sub replace { foreach my $method ( qw(adjourn expire) ) { # How many reasons? if ($options->{'reason'} && $new->$method && $old->$method ne $new->$method) { - my $error = $new->insert_reason( 'reason' => $options->{'reason'}, - 'date' => $new->$method, - 'action' => $method, - 'reason_otaker' => $options{'reason_otaker'}, - ); + my $error = $new->insert_reason( + 'reason' => $options->{'reason'}, + 'date' => $new->$method, + 'action' => $method, + 'reason_otaker' => $options->{'reason_otaker'}, + ); if ( $error ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; @@ -401,16 +510,21 @@ replace methods. sub check { my $self = shift; + $self->locationnum('') if !$self->locationnum || $self->locationnum == -1; + my $error = $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') + || $self->ut_foreign_keyn('locationnum', 'cust_location', 'locationnum') + || $self->ut_numbern('start_date') || $self->ut_numbern('setup') || $self->ut_numbern('bill') || $self->ut_numbern('susp') || $self->ut_numbern('cancel') || $self->ut_numbern('adjourn') || $self->ut_numbern('expire') + || $self->ut_enum('no_auto', [ '', 'Y' ]) ; return $error if $error; @@ -438,10 +552,10 @@ sub check { unless ( $disable_agentcheck ) { my $agent = qsearchs( 'agent', { 'agentnum' => $self->cust_main->agentnum } ); - my $pkgpart_href = $agent->pkgpart_hashref; - return "agent ". $agent->agentnum. + return "agent ". $agent->agentnum. ':'. $agent->agent. " can't purchase pkgpart ". $self->pkgpart - unless $pkgpart_href->{ $self->pkgpart }; + unless $agent->pkgpart_hashref->{ $self->pkgpart } + || $agent->agentnum == $self->part_pkg->agentnum; } $error = $self->ut_foreign_key('pkgpart', 'part_pkg', 'pkgpart' ); @@ -449,9 +563,7 @@ sub check { } - $self->otaker(getotaker) unless $self->otaker; - $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker"; - $self->otaker($1); + $self->usernum($FS::CurrentUser::CurrentUser->usernum) unless $self->usernum; if ( $self->dbdef_table->column('manual_flag') ) { $self->manual_flag('') if $self->manual_flag eq ' '; @@ -481,6 +593,14 @@ Available options are: =item date - can be set to a unix style timestamp to specify when to cancel (expire) +=item nobill - can be set true to skip billing if it might otherwise be done. + +=item unused_credit - can be set to 1 to credit the remaining time, or 0 to +not credit it. This must be set (by change()) when changing the package +to a different pkgpart or location, and probably shouldn't be in any other +case. If it's not set, the 'unused_credit_cancel' part_pkg option will +be used. + =back If there is an error, returns the error, otherwise returns false. @@ -491,6 +611,8 @@ sub cancel { my( $self, %options ) = @_; my $error; + my $conf = new FS::Conf; + warn "cust_pkg::cancel called with options". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -516,11 +638,25 @@ sub cancel { my $date = $options{date} if $options{date}; # expire/cancel later $date = '' if ($date && $date <= time); # complain instead? + #race condition: usage could be ongoing until unprovisioned + #resolved by performing a change package instead (which unprovisions) and + #later cancelling + if ( !$options{nobill} && !$date && $conf->exists('bill_usage_on_cancel') ) { + my $copy = $self->new({$self->hash}); + my $error = + $copy->cust_main->bill( pkg_list => [ $copy ], cancel => 1 ); + warn "Error billing during cancel, custnum ". + #$self->cust_main->custnum. ": $error" + ": $error" + if $error; + } + my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { $error = $self->insert_reason( 'reason' => $options{'reason'}, 'action' => $date ? 'expire' : 'cancel', + 'date' => $date ? $date : $cancel_time, 'reason_otaker' => $options{'reason_otaker'}, ); if ( $error ) { @@ -530,7 +666,8 @@ sub cancel { } my %svc; - unless ( $date ) { + if ( $date ) { +# copied from below foreach my $cust_svc ( #schwartz map { $_->[0] } @@ -538,7 +675,21 @@ sub cancel { map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { + my $error = $cust_svc->cancel( ('date' => $date) ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error expiring cust_svc: $error"; + } + } + } else { #!date + foreach my $cust_svc ( + #schwartz + map { $_->[0] } + sort { $a->[1] <=> $b->[1] } + map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; } + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { my $error = $cust_svc->cancel; if ( $error ) { @@ -546,11 +697,28 @@ sub cancel { return "Error cancelling cust_svc: $error"; } } - - # Add a credit for remaining service - my $remaining_value = $self->calc_remain(time=>$cancel_time); - if ( $remaining_value > 0 && !$options{'no_credit'} ) { - my $conf = new FS::Conf; + } #if $date + + # Add a credit for remaining service + my $last_bill = $self->getfield('last_bill') || 0; + my $next_bill = $self->getfield('bill') || 0; + my $do_credit; + if ( exists($options{'unused_credit'}) ) { + $do_credit = $options{'unused_credit'}; + } + else { + $do_credit = $self->part_pkg->option('unused_credit_cancel', 1); + } + if ( $do_credit + and $last_bill > 0 # the package has been billed + and $next_bill > 0 # the package has a next bill date + and $next_bill >= $cancel_time # which is in the future + ) { + my $remaining_value = $self->calc_remain('time' => $cancel_time); + if ( $remaining_value > 0 ) { + # && !$options{'no_credit'} ) { + # Undocumented, unused option. + # part_pkg configuration should decide this anyway. my $error = $self->cust_main->credit( $remaining_value, 'Credit for unused time on '. $self->part_pkg->pkg, @@ -561,8 +729,8 @@ sub cancel { return "Error crediting customer \$$remaining_value for unused time on". $self->part_pkg->pkg. ": $error"; } - } - } + } #if $remaining_value + } #if $do_credit my %hash = $self->hash; $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); @@ -576,16 +744,25 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; return '' if $date; #no errors - my $conf = new FS::Conf; my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; - if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { - my $conf = new FS::Conf; - my $error = send_email( - 'from' => $conf->config('invoice_from'), - 'to' => \@invoicing_list, - 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), - 'body' => [ map "$_\n", $conf->config('cancelmessage') ], - ); + if ( !$options{'quiet'} && + $conf->exists('emailcancel', $self->cust_main->agentnum) && + @invoicing_list ) { + my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum); + my $error = ''; + if ( $msgnum ) { + my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); + $error = $msg_template->send( 'cust_main' => $self->cust_main, + 'object' => $self ); + } + else { + $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + 'to' => \@invoicing_list, + 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), + 'body' => [ map "$_\n", $conf->config('cancelmessage') ], + ); + } #should this do something on errors? } @@ -718,9 +895,12 @@ sub suspend { return "Package $pkgnum expires before it would be suspended."; } + my $suspend_time = $options{'time'} || time; + if ( $options{'reason'} ) { $error = $self->insert_reason( 'reason' => $options{'reason'}, 'action' => $date ? 'adjourn' : 'suspend', + 'date' => $date ? $date : $suspend_time, 'reason_otaker' => $options{'reason_otaker'}, ); if ( $error ) { @@ -730,6 +910,9 @@ sub suspend { } unless ( $date ) { + + my @labels = (); + foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { @@ -749,12 +932,44 @@ sub suspend { $dbh->rollback if $oldAutoCommit; return $error; } + my( $label, $value ) = $cust_svc->label; + push @labels, "$label: $value"; + } + } + + my $conf = new FS::Conf; + if ( $conf->config('suspend_email_admin') ) { + + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), + #invoice_from ??? well as good as any + 'to' => $conf->config('suspend_email_admin'), + 'subject' => 'FREESIDE NOTIFICATION: Customer package suspended', + 'body' => [ + "This is an automatic message from your Freeside installation\n", + "informing you that the following customer package has been suspended:\n", + "\n", + 'Customer: #'. $self->custnum. ' '. $self->cust_main->name. "\n", + 'Package : #'. $self->pkgnum. " (". $self->part_pkg->pkg_comment. ")\n", + ( map { "Service : $_\n" } @labels ), + ], + ); + + if ( $error ) { + warn "WARNING: can't send suspension admin email (suspending anyway): ". + "$error\n"; } + } + } my %hash = $self->hash; - $date ? ($hash{'adjourn'} = $date) : ($hash{'susp'} = time); + if ( $date ) { + $hash{'adjourn'} = $date; + } else { + $hash{'susp'} = $suspend_time; + } my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { @@ -773,15 +988,21 @@ Unsuspends all services (see L and L) in this package, then unsuspends the package itself (clears the susp field and the adjourn field if it is in the past). -Available options are: I. +Available options are: + +=over 4 + +=item adjust_next_bill -I can be set true to adjust the next bill date forward by +Can be set true to adjust the next bill date forward by the amount of time the account was inactive. This was set true by default since 1.4.2 and 1.5.0pre6; however, starting with 1.7.0 this needs to be explicitly requested. Price plans for which this makes sense (anniversary-date based than prorate or subscription) could have an option to enable this behaviour? +=back + If there is an error, returns the error, otherwise returns false. =cut @@ -842,10 +1063,16 @@ sub unsuspend { my $conf = new FS::Conf; - $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if ( $opt{'adjust_next_bill'} - || $conf->config('unsuspend-always_adjust_next_bill_date') ) - && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + if ( $inactive > 0 && + ( $hash{'bill'} || $hash{'setup'} ) && + ( $opt{'adjust_next_bill'} || + $conf->exists('unsuspend-always_adjust_next_bill_date') || + $self->part_pkg->option('unsuspend_adjust_bill', 1) ) + ) { + + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive; + + } $hash{'susp'} = ''; $hash{'adjourn'} = '' if $hash{'adjourn'} < time; @@ -919,141 +1146,470 @@ sub unadjourn { } -=item last_bill - -Returns the last bill date, or if there is no last bill date, the setup date. -Useful for billing metered services. -=cut - -sub last_bill { - my $self = shift; - return $self->setfield('last_bill', $_[0]) if @_; - return $self->getfield('last_bill') if $self->getfield('last_bill'); - my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, - 'edate' => $self->bill, } ); - $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; -} +=item change HASHREF | OPTION => VALUE ... -=item last_cust_pkg_reason ACTION +Changes this package: cancels it and creates a new one, with a different +pkgpart or locationnum or both. All services are transferred to the new +package (no change will be made if this is not possible). -Returns the most recent ACTION FS::cust_pkg_reason associated with the package. -Returns false if there is no reason or the package is not currenly ACTION'd -ACTION is one of adjourn, susp, cancel, or expire. +Options may be passed as a list of key/value pairs or as a hash reference. +Options are: -=cut +=over 4 -sub last_cust_pkg_reason { - my ( $self, $action ) = ( shift, shift ); - my $date = $self->get($action); - qsearchs( { - 'table' => 'cust_pkg_reason', - 'hashref' => { 'pkgnum' => $self->pkgnum, - 'action' => substr(uc($action), 0, 1), - 'date' => $date, - }, - 'order_by' => 'ORDER BY num DESC LIMIT 1', - } ); -} +=item locationnum -=item last_reason ACTION +New locationnum, to change the location for this package. -Returns the most recent ACTION FS::reason associated with the package. -Returns false if there is no reason or the package is not currenly ACTION'd -ACTION is one of adjourn, susp, cancel, or expire. +=item cust_location -=cut +New FS::cust_location object, to create a new location and assign it +to this package. -sub last_reason { - my $cust_pkg_reason = shift->last_cust_pkg_reason(@_); - $cust_pkg_reason->reason - if $cust_pkg_reason; -} +=item pkgpart -=item part_pkg +New pkgpart (see L). -Returns the definition for this billing item, as an FS::part_pkg object (see -L). +=item refnum -=cut +New refnum (see L). -sub part_pkg { - my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); -} +=item keep_dates -=item old_cust_pkg +Set to true to transfer billing dates (start_date, setup, last_bill, bill, +susp, adjourn, cancel, expire, and contract_end) to the new package. -Returns the cancelled package this package was changed from, if any. +=back -=cut +At least one of locationnum, cust_location, pkgpart, refnum must be specified +(otherwise, what's the point?) -sub old_cust_pkg { - my $self = shift; - return '' unless $self->change_pkgnum; - qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } ); -} +Returns either the new FS::cust_pkg object or a scalar error. -=item calc_setup +For example: -Calls the I of the FS::part_pkg object associated with this billing -item. + my $err_or_new_cust_pkg = $old_cust_pkg->change =cut -sub calc_setup { +#some false laziness w/order +sub change { my $self = shift; - $self->part_pkg->calc_setup($self, @_); -} + my $opt = ref($_[0]) ? shift : { @_ }; -=item calc_recur +# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_; +# -Calls the I of the FS::part_pkg object associated with this billing -item. + my $conf = new FS::Conf; -=cut + # Transactionize this whole mess + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; -sub calc_recur { - my $self = shift; - $self->part_pkg->calc_recur($self, @_); -} + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; -=item calc_remain + my $error; -Calls the I of the FS::part_pkg object associated with this -billing item. + my %hash = (); -=cut + my $time = time; -sub calc_remain { - my $self = shift; - $self->part_pkg->calc_remain($self, @_); -} + #$hash{$_} = $self->$_() foreach qw( last_bill bill ); + + #$hash{$_} = $self->$_() foreach qw( setup ); -=item calc_cancel + $hash{'setup'} = $time if $self->setup; -Calls the I of the FS::part_pkg object associated with this -billing item. + $hash{'change_date'} = $time; + $hash{"change_$_"} = $self->$_() + foreach qw( pkgnum pkgpart locationnum ); -=cut + if ( $opt->{'cust_location'} && + ( ! $opt->{'locationnum'} || $opt->{'locationnum'} == -1 ) ) { + $error = $opt->{'cust_location'}->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_location (transaction rolled back): $error"; + } + $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; + } -sub calc_cancel { - my $self = shift; - $self->part_pkg->calc_cancel($self, @_); -} + my $unused_credit = 0; + if ( $opt->{'keep_dates'} ) { + foreach my $date ( qw(setup bill last_bill susp adjourn cancel expire + start_date contract_end ) ) { + $hash{$date} = $self->getfield($date); + } + } + # Special case. If the pkgpart is changing, and the customer is + # going to be credited for remaining time, don't keep setup, bill, + # or last_bill dates, and DO pass the flag to cancel() to credit + # the customer. + if ( $opt->{'pkgpart'} + and $opt->{'pkgpart'} != $self->pkgpart + and $self->part_pkg->option('unused_credit_change', 1) ) { + $unused_credit = 1; + $hash{$_} = '' foreach qw(setup bill last_bill); + } -=item cust_bill_pkg + # Create the new package. + my $cust_pkg = new FS::cust_pkg { + custnum => $self->custnum, + pkgpart => ( $opt->{'pkgpart'} || $self->pkgpart ), + refnum => ( $opt->{'refnum'} || $self->refnum ), + locationnum => ( $opt->{'locationnum'} || $self->locationnum ), + %hash, + }; -Returns any invoice line items for this package (see L). + $error = $cust_pkg->insert( 'change' => 1 ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } -=cut + # Transfer services and cancel old package. + + $error = $self->transfer($cust_pkg); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) { + warn "trying transfer again with change_svcpart option\n" if $DEBUG; + $error = $self->transfer($cust_pkg, 'change_svcpart'=>1 ); + if ($error and $error == 0) { + # $old_pkg->transfer failed. + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + if ($error > 0) { + # Transfers were successful, but we still had services left on the old + # package. We can't change the package under this circumstances, so abort. + $dbh->rollback if $oldAutoCommit; + return "Unable to transfer all services from package ". $self->pkgnum; + } + + #reset usage if changing pkgpart + # AND usage rollover is off (otherwise adds twice, now and at package bill) + if ($self->pkgpart != $cust_pkg->pkgpart) { + my $part_pkg = $cust_pkg->part_pkg; + $error = $part_pkg->reset_usage($cust_pkg, $part_pkg->is_prepaid + ? () + : ( 'null' => 1 ) + ) + if $part_pkg->can('reset_usage') && ! $part_pkg->option('usage_rollover',1); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error setting usage values: $error"; + } + } + + #Good to go, cancel old package. Notify 'cancel' of whether to credit + #remaining time. + $error = $self->cancel( quiet=>1, unused_credit => $unused_credit ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { + #$self->cust_main + my $error = $cust_pkg->cust_main->bill( 'pkg_list' => [ $cust_pkg ] ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + $cust_pkg; + +} + +use Data::Dumper; +use Storable 'thaw'; +use MIME::Base64; +sub process_bulk_cust_pkg { + my $job = shift; + my $param = thaw(decode_base64(shift)); + warn Dumper($param) if $DEBUG; + + my $old_part_pkg = qsearchs('part_pkg', + { pkgpart => $param->{'old_pkgpart'} }); + my $new_part_pkg = qsearchs('part_pkg', + { pkgpart => $param->{'new_pkgpart'} }); + die "Must select a new package type\n" unless $new_part_pkg; + #my $keep_dates = $param->{'keep_dates'} || 0; + my $keep_dates = 1; # there is no good reason to turn this off + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } ); + + my $i = 0; + foreach my $old_cust_pkg ( @cust_pkgs ) { + $i++; + $job->update_statustext(int(100*$i/(scalar @cust_pkgs))); + if ( $old_cust_pkg->getfield('cancel') ) { + warn '[process_bulk_cust_pkg ] skipping canceled pkgnum '. + $old_cust_pkg->pkgnum."\n" + if $DEBUG; + next; + } + warn '[process_bulk_cust_pkg] changing pkgnum '.$old_cust_pkg->pkgnum."\n" + if $DEBUG; + my $error = $old_cust_pkg->change( + 'pkgpart' => $param->{'new_pkgpart'}, + 'keep_dates' => $keep_dates + ); + if ( !ref($error) ) { # change returns the cust_pkg on success + $dbh->rollback; + die "Error changing pkgnum ".$old_cust_pkg->pkgnum.": '$error'\n"; + } + } + $dbh->commit if $oldAutoCommit; + return; +} + +=item last_bill + +Returns the last bill date, or if there is no last bill date, the setup date. +Useful for billing metered services. + +=cut + +sub last_bill { + my $self = shift; + return $self->setfield('last_bill', $_[0]) if @_; + return $self->getfield('last_bill') if $self->getfield('last_bill'); + my $cust_bill_pkg = qsearchs('cust_bill_pkg', { 'pkgnum' => $self->pkgnum, + 'edate' => $self->bill, } ); + $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; +} + +=item last_cust_pkg_reason ACTION + +Returns the most recent ACTION FS::cust_pkg_reason associated with the package. +Returns false if there is no reason or the package is not currenly ACTION'd +ACTION is one of adjourn, susp, cancel, or expire. + +=cut + +sub last_cust_pkg_reason { + my ( $self, $action ) = ( shift, shift ); + my $date = $self->get($action); + qsearchs( { + 'table' => 'cust_pkg_reason', + 'hashref' => { 'pkgnum' => $self->pkgnum, + 'action' => substr(uc($action), 0, 1), + 'date' => $date, + }, + 'order_by' => 'ORDER BY num DESC LIMIT 1', + } ); +} + +=item last_reason ACTION + +Returns the most recent ACTION FS::reason associated with the package. +Returns false if there is no reason or the package is not currenly ACTION'd +ACTION is one of adjourn, susp, cancel, or expire. + +=cut + +sub last_reason { + my $cust_pkg_reason = shift->last_cust_pkg_reason(@_); + $cust_pkg_reason->reason + if $cust_pkg_reason; +} + +=item part_pkg + +Returns the definition for this billing item, as an FS::part_pkg object (see +L). + +=cut + +sub part_pkg { + my $self = shift; + return $self->{'_pkgpart'} if $self->{'_pkgpart'}; + cluck "cust_pkg->part_pkg called" if $DEBUG > 1; + qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); +} + +=item old_cust_pkg + +Returns the cancelled package this package was changed from, if any. + +=cut + +sub old_cust_pkg { + my $self = shift; + return '' unless $self->change_pkgnum; + qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } ); +} + +=item calc_setup + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_setup { + my $self = shift; + $self->part_pkg->calc_setup($self, @_); +} + +=item calc_recur + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub calc_recur { + my $self = shift; + $self->part_pkg->calc_recur($self, @_); +} + +=item base_recur + +Calls the I of the FS::part_pkg object associated with this billing +item. + +=cut + +sub base_recur { + my $self = shift; + $self->part_pkg->base_recur($self, @_); +} + +=item calc_remain + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_remain { + my $self = shift; + $self->part_pkg->calc_remain($self, @_); +} + +=item calc_cancel + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_cancel { + my $self = shift; + $self->part_pkg->calc_cancel($self, @_); +} + +=item cust_bill_pkg + +Returns any invoice line items for this package (see L). + +=cut + +sub cust_bill_pkg { + my $self = shift; + qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } ); +} + +=item cust_pkg_detail [ DETAILTYPE ] + +Returns any customer package details for this package (see +L). + +DETAILTYPE can be set to "I" for invoice details or "C" for comments. + +=cut + +sub cust_pkg_detail { + my $self = shift; + my %hash = ( 'pkgnum' => $self->pkgnum ); + $hash{detailtype} = shift if @_; + qsearch({ + 'table' => 'cust_pkg_detail', + 'hashref' => \%hash, + 'order_by' => 'ORDER BY weight, pkgdetailnum', + }); +} + +=item set_cust_pkg_detail DETAILTYPE [ DETAIL, DETAIL, ... ] + +Sets customer package details for this package (see L). + +DETAILTYPE can be set to "I" for invoice details or "C" for comments. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub set_cust_pkg_detail { + my( $self, $detailtype, @details ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $current ( $self->cust_pkg_detail($detailtype) ) { + my $error = $current->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error removing old detail: $error"; + } + } + + foreach my $detail ( @details ) { + my $cust_pkg_detail = new FS::cust_pkg_detail { + 'pkgnum' => $self->pkgnum, + 'detailtype' => $detailtype, + 'detail' => $detail, + }; + my $error = $cust_pkg_detail->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "error adding new detail: $error"; + } + + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; -sub cust_bill_pkg { - my $self = shift; - qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } ); } =item cust_event @@ -1101,11 +1657,15 @@ services. sub cust_svc { my $self = shift; + return () unless $self->num_cust_svc(@_); + if ( @_ ) { return qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum, 'svcpart' => shift, } ); } + cluck "cust_pkg->cust_svc called" if $DEBUG > 2; + #if ( $self->{'_svcnum'} ) { # values %{ $self->{'_svcnum'}->cache }; #} else { @@ -1126,34 +1686,45 @@ is specified, return only the matching services. sub overlimit { my $self = shift; - grep { $_->overlimit } $self->cust_svc; + return () unless $self->num_cust_svc(@_); + grep { $_->overlimit } $self->cust_svc(@_); } -=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] Returns historical services for this package created before END TIMESTAMP and (optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects -(see L). +(see L). If MODE is 'I' (for 'invoice'), services with the +I flag will be omitted. =cut sub h_cust_svc { my $self = shift; - - $self->_sort_cust_svc( + my ($end, $start, $mode) = @_; + my @cust_svc = $self->_sort_cust_svc( [ qsearch( 'h_cust_svc', - { 'pkgnum' => $self->pkgnum, }, - FS::h_cust_svc->sql_h_search(@_), - ) - ] + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) ] ); + if ( $mode eq 'I' ) { + my %hidden_svcpart = map { $_->svcpart => $_->hidden } $self->part_svc; + return grep { !$hidden_svcpart{$_->svcpart} } @cust_svc; + } + else { + return @cust_svc; + } } sub _sort_cust_svc { my( $self, $arrayref ) = @_; + my $sort = + sub ($$) { my ($a, $b) = @_; $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] }; + map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + sort $sort map { my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, 'svcpart' => $_->svcpart } ); @@ -1175,9 +1746,19 @@ specified, counts only the matching services. sub num_cust_svc { my $self = shift; + + return $self->{'_num_cust_svc'} + if !scalar(@_) + && exists($self->{'_num_cust_svc'}) + && $self->{'_num_cust_svc'} =~ /\d/; + + cluck "cust_pkg->num_cust_svc called, _num_cust_svc:".$self->{'_num_cust_svc'} + if $DEBUG > 2; + my $sql = 'SELECT COUNT(*) FROM cust_svc WHERE pkgnum = ?'; $sql .= ' AND svcpart = ?' if @_; - my $sth = dbh->prepare($sql) or die dbh->errstr; + + my $sth = dbh->prepare($sql) or die dbh->errstr; $sth->execute($self->pkgnum, @_) or die $sth->errstr; $sth->fetchrow_arrayref->[0]; } @@ -1197,6 +1778,13 @@ sub available_part_svc { my $part_svc = $_->part_svc; $part_svc->{'Hash'}{'num_avail'} = #evil encapsulation-breaking $_->quantity - $self->num_cust_svc($_->svcpart); + + # more evil encapsulation breakage + if($part_svc->{'Hash'}{'num_avail'} > 0) { + my @exports = $part_svc->part_export_did; + $part_svc->{'Hash'}{'can_get_dids'} = scalar(@exports); + } + $part_svc; } $self->part_pkg->pkg_svc; @@ -1234,7 +1822,9 @@ sub part_svc { $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #more evil $part_svc->{'Hash'}{'num_avail'} = max( 0, $pkg_svc->quantity - $num_cust_svc ); - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; + $part_svc->{'Hash'}{'hidden'} = $pkg_svc->hidden; $part_svc; } $self->part_pkg->pkg_svc; @@ -1244,7 +1834,8 @@ sub part_svc { my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart); $part_svc->{'Hash'}{'num_cust_svc'} = $num_cust_svc; #speak no evail $part_svc->{'Hash'}{'num_avail'} = 0; #0-$num_cust_svc ? - $part_svc->{'Hash'}{'cust_pkg_svc'} = [ $self->cust_svc($part_svc->svcpart) ]; + $part_svc->{'Hash'}{'cust_pkg_svc'} = + $num_cust_svc ? [ $self->cust_svc($part_svc->svcpart) ] : []; $part_svc; } $self->extra_part_svc; @@ -1266,20 +1857,40 @@ sub extra_part_svc { my $pkgnum = $self->pkgnum; my $pkgpart = $self->pkgpart; +# qsearch( { +# 'table' => 'part_svc', +# 'hashref' => {}, +# 'extra_sql' => +# "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc +# WHERE pkg_svc.svcpart = part_svc.svcpart +# AND pkg_svc.pkgpart = ? +# AND quantity > 0 +# ) +# AND 0 < ( SELECT COUNT(*) FROM cust_svc +# LEFT JOIN cust_pkg USING ( pkgnum ) +# WHERE cust_svc.svcpart = part_svc.svcpart +# AND pkgnum = ? +# )", +# 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], +# } ); + +#seems to benchmark slightly faster... qsearch( { - 'table' => 'part_svc', - 'hashref' => {}, - 'extra_sql' => "WHERE 0 = ( SELECT COUNT(*) FROM pkg_svc - WHERE pkg_svc.svcpart = part_svc.svcpart - AND pkg_svc.pkgpart = $pkgpart - AND quantity > 0 - ) - AND 0 < ( SELECT count(*) - FROM cust_svc - LEFT JOIN cust_pkg using ( pkgnum ) - WHERE cust_svc.svcpart = part_svc.svcpart - AND pkgnum = $pkgnum - )", + #'select' => 'DISTINCT ON (svcpart) part_svc.*', + #MySQL doesn't grok DISINCT ON + 'select' => 'DISTINCT part_svc.*', + 'table' => 'part_svc', + 'addl_from' => + 'LEFT JOIN pkg_svc ON ( pkg_svc.svcpart = part_svc.svcpart + AND pkg_svc.pkgpart = ? + AND quantity > 0 + ) + LEFT JOIN cust_svc ON ( cust_svc.svcpart = part_svc.svcpart ) + LEFT JOIN cust_pkg USING ( pkgnum ) + ', + 'hashref' => {}, + 'extra_sql' => "WHERE pkgsvcnum IS NULL AND cust_pkg.pkgnum = ? ", + 'extra_param' => [ [$self->pkgpart=>'int'], [$self->pkgnum=>'int'] ], } ); } @@ -1315,6 +1926,16 @@ sub status { return 'active'; } +=item ucfirst_status + +Returns the status with the first character capitalized. + +=cut + +sub ucfirst_status { + ucfirst(shift->status); +} + =item statuses Class method that returns the list of possible status strings for packages @@ -1325,7 +1946,7 @@ Class method that returns the list of possible status strings for packages =cut tie my %statuscolor, 'Tie::IxHash', - 'not yet billed' => '000000', + 'not yet billed' => '009999', #teal? cyan? 'one-time charge' => '000000', 'active' => '00CC00', 'suspended' => 'FF9900', @@ -1334,8 +1955,8 @@ tie my %statuscolor, 'Tie::IxHash', sub statuses { my $self = shift; #could be class... - grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway - # mayble split btw one-time vs. recur + #grep { $_ !~ /^(not yet billed)$/ } #this is a dumb status anyway + # # mayble split btw one-time vs. recur keys %statuscolor; } @@ -1350,6 +1971,63 @@ sub statuscolor { $statuscolor{$self->status}; } +=item pkg_label + +Returns a label for this package. (Currently "pkgnum: pkg - comment" or +"pkg-comment" depending on user preference). + +=cut + +sub pkg_label { + my $self = shift; + my $label = $self->part_pkg->pkg_comment( 'nopkgpart' => 1 ); + $label = $self->pkgnum. ": $label" + if $FS::CurrentUser::CurrentUser->option('show_pkgnum'); + $label; +} + +=item pkg_label_long + +Returns a long label for this package, adding the primary service's label to +pkg_label. + +=cut + +sub pkg_label_long { + my $self = shift; + my $label = $self->pkg_label; + my $cust_svc = $self->primary_cust_svc; + $label .= ' ('. ($cust_svc->label)[1]. ')' if $cust_svc; + $label; +} + +=item primary_cust_svc + +Returns a primary service (as FS::cust_svc object) if one can be identified. + +=cut + +#for labeling purposes - might not 100% match up with part_pkg->svcpart's idea + +sub primary_cust_svc { + my $self = shift; + + my @cust_svc = $self->cust_svc; + + return '' unless @cust_svc; #no serivces - irrelevant then + + return $cust_svc[0] if scalar(@cust_svc) == 1; #always return a single service + + # primary service as specified in the package definition + # or exactly one service definition with quantity one + my $svcpart = $self->part_pkg->svcpart; + @cust_svc = grep { $_->svcpart == $svcpart } @cust_svc; + return $cust_svc[0] if scalar(@cust_svc) == 1; + + #couldn't identify one thing.. + return ''; +} + =item labels Returns a list of lists, calling the label method for all services @@ -1362,11 +2040,12 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } -=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] Like the labels method, but returns historical information on services that were active as of END_TIMESTAMP and (optionally) not cancelled before -START_TIMESTAMP. +START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the +I flag will be omitted. Returns a list of lists, calling the label method for all (historical) services (see L) of this billing item. @@ -1378,29 +2057,62 @@ sub h_labels { map { [ $_->label(@_) ] } $self->h_cust_svc(@_); } +=item labels_short + +Like labels, except returns a simple flat list, and shortens long +(currently >5 or the cust_bill-max_same_services configuration value) lists of +identical services to one line that lists the service label and the number of +individual services rather than individual items. + +=cut + +sub labels_short { + shift->_labels_short( 'labels', @_ ); +} + =item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] -Like h_labels, except returns a simple flat list, and shortens long -(currently >5) lists of identical services to one line that lists the service -label and the number of individual services rather than individual items. +Like h_labels, except returns a simple flat list, and shortens long +(currently >5 or the cust_bill-max_same_services configuration value) lists of +identical services to one line that lists the service label and the number of +individual services rather than individual items. =cut sub h_labels_short { - my $self = shift; + shift->_labels_short( 'h_labels', @_ ); +} + +sub _labels_short { + my( $self, $method ) = ( shift, shift ); + + my $conf = new FS::Conf; + my $max_same_services = $conf->config('cust_bill-max_same_services') || 5; my %labels; #tie %labels, 'Tie::IxHash'; push @{ $labels{$_->[0]} }, $_->[1] - foreach $self->h_labels(@_); + foreach $self->$method(@_); my @labels; foreach my $label ( keys %labels ) { - my @values = @{ $labels{$label} }; + my %seen = (); + my @values = grep { ! $seen{$_}++ } @{ $labels{$label} }; my $num = scalar(@values); - if ( $num > 5 ) { + if ( $num > $max_same_services ) { push @labels, "$label ($num)"; } else { - push @labels, map { "$label: $_" } @values; + if ( $conf->exists('cust_bill-consolidate_services') ) { + # push @labels, "$label: ". join(', ', @values); + while ( @values ) { + my $detail = "$label: "; + $detail .= shift(@values). ', ' + while @values && length($detail.$values[0]) < 78; + $detail =~ s/, $//; + push @labels, $detail; + } + } else { + push @labels, map { "$label: $_" } @values; + } } } @@ -1419,6 +2131,25 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +#these subs are in location_Mixin.pm now... unfortunately the POD doesn't mixin + +=item cust_location + +Returns the location object, if any (see L). + +=item cust_location_or_main + +If this package is associated with a location, returns the locaiton (see +L), otherwise returns the customer (see L). + +=item location_label [ OPTION => VALUE ... ] + +Returns the label of the location object (see L). + +=cut + +#end of subs in location_Mixin.pm now... unfortunately the POD doesn't mixin + =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L) in this @@ -1648,25 +2379,195 @@ sub reexport { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + foreach my $cust_svc ( $self->cust_svc ) { + #false laziness w/svc_Common::insert + my $svc_x = $cust_svc->svc_x; + foreach my $part_export ( $cust_svc->part_svc->part_export ) { + my $error = $part_export->export_insert($svc_x); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item insert_reason + +Associates this package with a (suspension or cancellation) reason (see +L, possibly inserting a new reason on the fly (see +L). + +Available options are: + +=over 4 + +=item reason + +can be set to a cancellation reason (see L), 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, reason - Text of the new reason. + +=item reason_otaker + +the access_user (see L) providing the reason + +=item date + +a unix timestamp + +=item action + +the action (cancel, susp, adjourn, expire) associated with the reason + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_reason { + my ($self, %options) = @_; + + my $otaker = $options{reason_otaker} || + $FS::CurrentUser::CurrentUser->username; + + my $reasonnum; + if ( $options{'reason'} =~ /^(\d+)$/ ) { + + $reasonnum = $1; + + } elsif ( ref($options{'reason'}) ) { + + return 'Enter a new reason (or select an existing one)' + unless $options{'reason'}->{'reason'} !~ /^\s*$/; + + my $reason = new FS::reason({ + 'reason_type' => $options{'reason'}->{'typenum'}, + 'reason' => $options{'reason'}->{'reason'}, + }); + my $error = $reason->insert; + return $error if $error; + + $reasonnum = $reason->reasonnum; + + } else { + return "Unparsable reason: ". $options{'reason'}; + } + + my $cust_pkg_reason = + new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, + 'reasonnum' => $reasonnum, + 'otaker' => $otaker, + 'action' => substr(uc($options{'action'}),0,1), + 'date' => $options{'date'} + ? $options{'date'} + : time, + }); + + $cust_pkg_reason->insert; +} + +=item insert_discount + +Associates this package with a discount (see L, possibly +inserting a new discount on the fly (see L). + +Available options are: + +=over 4 + +=item discountnum + +=back + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_discount { + #my ($self, %options) = @_; + my $self = shift; + + my $cust_pkg_discount = new FS::cust_pkg_discount { + 'pkgnum' => $self->pkgnum, + 'discountnum' => $self->discountnum, + 'months_used' => 0, + 'end_date' => '', #XXX + 'otaker' => $self->otaker, + #for the create a new discount case + '_type' => $self->discountnum__type, + 'amount' => $self->discountnum_amount, + 'percent' => $self->discountnum_percent, + 'months' => $self->discountnum_months, + #'disabled' => $self->discountnum_disabled, + }; + + $cust_pkg_discount->insert; +} + +=item set_usage USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values reset. + +=cut + +sub set_usage { + my ($self, $valueref, %opt) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->set_usage($valueref, %opt) + if $svc_x->can("set_usage"); + } +} + +=item recharge USAGE_VALUE_HASHREF + +USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts +to which they should be set (see L). Currently seconds, +upbytes, downbytes, and totalbytes are appropriate keys. + +All svc_accts which are part of this package have their values incremented. + +=cut + +sub recharge { + my ($self, $valueref) = @_; + + foreach my $cust_svc ($self->cust_svc){ + my $svc_x = $cust_svc->svc_x; + $svc_x->recharge($valueref) + if $svc_x->can("recharge"); + } +} + +=item cust_pkg_discount + +=cut + +sub cust_pkg_discount { + my $self = shift; + qsearch('cust_pkg_discount', { 'pkgnum' => $self->pkgnum } ); +} - foreach my $cust_svc ( $self->cust_svc ) { - #false laziness w/svc_Common::insert - my $svc_x = $cust_svc->svc_x; - foreach my $part_export ( $cust_svc->part_svc->part_export ) { - my $error = $part_export->export_insert($svc_x); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - } +=item cust_pkg_discount_active - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; +=cut +sub cust_pkg_discount_active { + my $self = shift; + grep { $_->status eq 'active' } $self->cust_pkg_discount; } =back @@ -1697,14 +2598,38 @@ sub onetime_sql { " where cust_pkg.pkgpart = part_pkg.pkgpart ) "; } +=item ordered_sql + +Returns an SQL expression identifying ordered packages (recurring packages not +yet billed). + +=cut + +sub ordered_sql { + $_[0]->recurring_sql. " AND ". $_[0]->not_yet_billed_sql; +} + =item active_sql Returns an SQL expression identifying active packages. =cut -sub active_sql { " - ". $_[0]->recurring_sql(). " +sub active_sql { + $_[0]->recurring_sql. " + AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) +"; } + +=item not_yet_billed_sql + +Returns an SQL expression identifying packages which have not yet been billed. + +=cut + +sub not_yet_billed_sql { " + ( cust_pkg.setup IS NULL OR cust_pkg.setup = 0 ) AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } @@ -1718,6 +2643,7 @@ that are otherwise unsuspended/uncancelled). sub inactive_sql { " ". $_[0]->onetime_sql(). " + AND cust_pkg.setup IS NOT NULL AND cust_pkg.setup != 0 AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } @@ -1751,7 +2677,23 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HASHREF +=item status_sql + +Returns an SQL expression to give the package status as a string. + +=cut + +sub status_sql { +"CASE + WHEN cust_pkg.cancel IS NOT NULL THEN 'cancelled' + WHEN cust_pkg.susp IS NOT NULL THEN 'suspended' + WHEN cust_pkg.setup IS NULL THEN 'not yet billed' + WHEN ".onetime_sql()." THEN 'one-time charge' + ELSE 'active' +END" +} + +=item search HASHREF (Class method) @@ -1770,11 +2712,15 @@ active, inactive, suspended, cancel (or cancelled) active, inactive, suspended, one-time charge, inactive, cancel (or cancelled) +=item custom + + boolean selects custom packages + =item classnum =item pkgpart -list specified how? +pkgpart or arrayref or hashref of pkgparts =item setup @@ -1816,11 +2762,15 @@ a value suited to passing to FS::UI::Web::cust_header specifies the user for agent virtualization +=item fcc_line + + boolean selects packages containing fcc form 477 telco lines + =back =cut -sub search_sql { +sub search { my ($class, $params) = @_; my @where = (); @@ -1834,6 +2784,24 @@ sub search_sql { } ## + # parse custnum + ## + + if ( $params->{'custnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "cust_pkg.custnum = $1"; + } + + ## + # custbatch + ## + + if ( $params->{'pkgbatch'} =~ /^([\w\/\-\:\.]+)$/ and $1 ) { + push @where, + "cust_pkg.pkgbatch = '$1'"; + } + + ## # parse status ## @@ -1842,8 +2810,13 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'inactive' - || $params->{'status'} eq 'inactive' ) { + } elsif ( $params->{'magic'} =~ /^not[ _]yet[ _]billed$/ + || $params->{'status'} =~ /^not[ _]yet[ _]billed$/ ) { + + push @where, FS::cust_pkg->not_yet_billed_sql(); + + } elsif ( $params->{'magic'} =~ /^(one-time charge|inactive)/ + || $params->{'status'} =~ /^(one-time charge|inactive)/ ) { push @where, FS::cust_pkg->inactive_sql(); @@ -1857,10 +2830,6 @@ sub search_sql { push @where, FS::cust_pkg->cancelled_sql(); - } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) { - - push @where, FS::cust_pkg->inactive_sql(); - } ### @@ -1876,7 +2845,7 @@ sub search_sql { { $classnum = $1; if ( $classnum ) { #a specific class - push @where, "classnum = $classnum"; + push @where, "part_pkg.classnum = $classnum"; #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) ); #die "classnum $classnum not found!" unless $pkg_class[0]; @@ -1884,7 +2853,7 @@ sub search_sql { } elsif ( $classnum eq '' ) { #the empty class - push @where, "classnum IS NULL"; + push @where, "part_pkg.classnum IS NULL"; #$title .= 'Empty class '; #@pkg_class = ( '(empty class)' ); } elsif ( $classnum eq '0' ) { @@ -1897,12 +2866,74 @@ sub search_sql { #eslaf ### + # parse package report options + ### + + my @report_option = (); + if ( exists($params->{'report_option'}) + && $params->{'report_option'} =~ /^([,\d]*)$/ + ) + { + @report_option = split(',', $1); + } + + if (@report_option) { + # this will result in the empty set for the dangling comma case as it should + push @where, + map{ "0 < ( SELECT count(*) FROM part_pkg_option + WHERE part_pkg_option.pkgpart = part_pkg.pkgpart + AND optionname = 'report_option_$_' + AND optionvalue = '1' )" + } @report_option; + } + + #eslaf + + ### + # parse custom + ### + + push @where, "part_pkg.custom = 'Y'" if $params->{custom}; + + ### + # parse fcc_line + ### + + push @where, "part_pkg.fcc_ds0s > 0" if $params->{fcc_line}; + + ### + # parse censustract + ### + + if ( exists($params->{'censustract'}) ) { + $params->{'censustract'} =~ /^([.\d]*)$/; + my $censustract = "cust_main.censustract = '$1'"; + $censustract .= ' OR cust_main.censustract is NULL' unless $1; + push @where, "( $censustract )"; + } + + ### # parse part_pkg ### - my $pkgpart = join (' OR pkgpart=', - grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'})); - push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart; + if ( ref($params->{'pkgpart'}) ) { + + my @pkgpart = (); + if ( ref($params->{'pkgpart'}) eq 'HASH' ) { + @pkgpart = grep $params->{'pkgpart'}{$_}, keys %{ $params->{'pkgpart'} }; + } elsif ( ref($params->{'pkgpart'}) eq 'ARRAY' ) { + @pkgpart = @{ $params->{'pkgpart'} }; + } else { + die 'unhandled pkgpart ref '. $params->{'pkgpart'}; + } + + @pkgpart = grep /^(\d+)$/, @pkgpart; + + push @where, 'pkgpart IN ('. join(',', @pkgpart). ')' if scalar(@pkgpart); + + } elsif ( $params->{'pkgpart'} =~ /^(\d+)$/ ) { + push @where, "pkgpart = $1"; + } ### # parse dates @@ -1920,21 +2951,32 @@ sub search_sql { '' => {}, ); - foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) { + if( exists($params->{'active'} ) ) { + # This overrides all the other date-related fields + my($beginning, $ending) = @{$params->{'active'}}; + push @where, + "cust_pkg.setup IS NOT NULL", + "cust_pkg.setup <= $ending", + "(cust_pkg.cancel IS NULL OR cust_pkg.cancel >= $beginning )", + "NOT (".FS::cust_pkg->onetime_sql . ")"; + } + else { + foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end cancel )) { - next unless exists($params->{$field}); + next unless exists($params->{$field}); - my($beginning, $ending) = @{$params->{$field}}; + my($beginning, $ending) = @{$params->{$field}}; - next if $beginning == 0 && $ending == 4294967295; + next if $beginning == 0 && $ending == 4294967295; - push @where, - "cust_pkg.$field IS NOT NULL", - "cust_pkg.$field >= $beginning", - "cust_pkg.$field <= $ending"; + push @where, + "cust_pkg.$field IS NOT NULL", + "cust_pkg.$field >= $beginning", + "cust_pkg.$field <= $ending"; - $orderby ||= "ORDER BY cust_pkg.$field"; + $orderby ||= "ORDER BY cust_pkg.$field"; + } } $orderby ||= 'ORDER BY bill'; @@ -1983,10 +3025,10 @@ sub search_sql { if ($access_user) { push @where, $access_user->agentnums_sql('table'=>'cust_main'); - }else{ + } else { push @where, "1=0"; } - }else{ + } else { push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main'); } @@ -1994,7 +3036,7 @@ sub search_sql { my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '. 'LEFT JOIN part_pkg USING ( pkgpart ) '. - 'LEFT JOIN pkg_class USING ( classnum ) '; + 'LEFT JOIN pkg_class ON ( part_pkg.classnum = pkg_class.classnum ) '; my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql"; @@ -2005,7 +3047,7 @@ sub search_sql { 'cust_pkg.*', ( map "part_pkg.$_", qw( pkg freq ) ), 'pkg_class.classname', - 'cust_main.custnum as cust_main_custnum', + 'cust_main.custnum AS cust_main_custnum', FS::UI::Web::cust_sql_fields( $params->{'cust_fields'} ), @@ -2017,6 +3059,124 @@ sub search_sql { } +=item fcc_477_count + +Returns a list of two package counts. The first is a count of packages +based on the supplied criteria and the second is the count of residential +packages with those same criteria. Criteria are specified as in the search +method. + +=cut + +sub fcc_477_count { + my ($class, $params) = @_; + + my $sql_query = $class->search( $params ); + + my $count_sql = delete($sql_query->{'count_query'}); + $count_sql =~ s/ FROM/,count(CASE WHEN cust_main.company IS NULL OR cust_main.company = '' THEN 1 END) FROM/ + or die "couldn't parse count_sql"; + + my $count_sth = dbh->prepare($count_sql) + or die "Error preparing $count_sql: ". dbh->errstr; + $count_sth->execute + or die "Error executing $count_sql: ". $count_sth->errstr; + my $count_arrayref = $count_sth->fetchrow_arrayref; + + return ( @$count_arrayref ); + +} + + +=item location_sql + +Returns a list: the first item is an SQL fragment identifying matching +packages/customers via location (taking into account shipping and package +address taxation, if enabled), and subsequent items are the parameters to +substitute for the placeholders in that fragment. + +=cut + +sub location_sql { + my($class, %opt) = @_; + my $ornull = $opt{'ornull'}; + + my $conf = new FS::Conf; + + # '?' placeholders in _location_sql_where + my $x = $ornull ? 3 : 2; + my @bill_param = ( ('city')x3, ('county')x$x, ('state')x$x, 'country' ); + + my $main_where; + my @main_param; + if ( $conf->exists('tax-ship_address') ) { + + $main_where = "( + ( ( ship_last IS NULL OR ship_last = '' ) + AND ". _location_sql_where('cust_main', '', $ornull ). " + ) + OR ( ship_last IS NOT NULL AND ship_last != '' + AND ". _location_sql_where('cust_main', 'ship_', $ornull ). " + ) + )"; + # AND payby != 'COMP' + + @main_param = ( @bill_param, @bill_param ); + + } else { + + $main_where = _location_sql_where('cust_main'); # AND payby != 'COMP' + @main_param = @bill_param; + + } + + my $where; + my @param; + if ( $conf->exists('tax-pkg_address') ) { + + my $loc_where = _location_sql_where( 'cust_location', '', $ornull ); + + $where = " ( + ( cust_pkg.locationnum IS NULL AND $main_where ) + OR ( cust_pkg.locationnum IS NOT NULL AND $loc_where ) + ) + "; + @param = ( @main_param, @bill_param ); + + } else { + + $where = $main_where; + @param = @main_param; + + } + + ( $where, @param ); + +} + +#subroutine, helper for location_sql +sub _location_sql_where { + my $table = shift; + my $prefix = @_ ? shift : ''; + my $ornull = @_ ? shift : ''; + +# $ornull = $ornull ? " OR ( ? IS NULL AND $table.${prefix}county IS NULL ) " : ''; + + $ornull = $ornull ? ' OR ? IS NULL ' : ''; + + my $or_empty_city = " OR ( ? = '' AND $table.${prefix}city IS NULL ) "; + my $or_empty_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; + my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; + +# ( $table.${prefix}city = ? $or_empty_city $ornull ) + " + ( $table.${prefix}city = ? OR ? = '' OR CAST(? AS text) IS NULL ) + AND ( $table.${prefix}county = ? $or_empty_county $ornull ) + AND ( $table.${prefix}state = ? $or_empty_state $ornull ) + AND $table.${prefix}country = ? + "; +} + =head1 SUBROUTINES =over 4 @@ -2064,8 +3224,11 @@ sub order { my $dbh = dbh; my $error; - my $cust_main = qsearchs('cust_main', { custnum => $custnum }); - return "Customer not found: $custnum" unless $cust_main; +# my $cust_main = qsearchs('cust_main', { custnum => $custnum }); +# return "Customer not found: $custnum" unless $cust_main; + + warn "$me order: pkgnums to remove: ". join(',', @$remove_pkgnum). "\n" + if $DEBUG; my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } @$remove_pkgnum; @@ -2075,19 +3238,31 @@ sub order { my %hash = (); if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) { - my $time = time; + warn "$me order: changing pkgnum ". $old_cust_pkg[0]->pkgnum. + " to pkgpart ". $pkgparts->[0]. "\n" + if $DEBUG; - #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); - - #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup ); - $hash{'setup'} = $time if $old_cust_pkg[0]->setup; + my $err_or_cust_pkg = + $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0], + 'refnum' => $refnum, + ); + + unless (ref($err_or_cust_pkg)) { + $dbh->rollback if $oldAutoCommit; + return $err_or_cust_pkg; + } + + push @$return_cust_pkg, $err_or_cust_pkg; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; - $hash{'change_date'} = $time; - $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart ); } # Create the new packages. foreach my $pkgpart (@$pkgparts) { + + warn "$me order: inserting pkgpart $pkgpart\n" if $DEBUG; + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, pkgpart => $pkgpart, refnum => $refnum, @@ -2106,6 +3281,9 @@ sub order { # Transfer services and cancel old packages. foreach my $old_pkg (@old_cust_pkg) { + warn "$me order: transferring services from pkgnum ". $old_pkg->pkgnum. "\n" + if $DEBUG; + foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg); if ($error and $error == 0) { @@ -2144,30 +3322,12 @@ sub order { ''; } -=item insert_reason - -Associates this package with a (suspension or cancellation) reason (see -L, possibly inserting a new reason on the fly (see -L). - -Available options are: - -=over 4 - -=item reason - can be set to a cancellation reason (see L), 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, reason - Text of the new reason. - -=item date - -=back - -If there is an error, returns the error, otherwise returns false. - -=cut - =item bulk_change PKGPARTS_ARYREF, REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] +A bulk change method to change packages for multiple customers. + PKGPARTS is a list of pkgparts specifying the the billing item definitions (see -L) to order for this customer. Duplicates are of course +L) to order for each customer. Duplicates are of course permitted. REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to @@ -2222,85 +3382,24 @@ sub bulk_change { ''; } -sub insert_reason { - my ($self, %options) = @_; - - my $otaker = $options{reason_otaker} || - $FS::CurrentUser::CurrentUser->username; - - my $reasonnum; - if ( $options{'reason'} =~ /^(\d+)$/ ) { - - $reasonnum = $1; - - } elsif ( ref($options{'reason'}) ) { - - return 'Enter a new reason (or select an existing one)' - unless $options{'reason'}->{'reason'} !~ /^\s*$/; - - my $reason = new FS::reason({ - 'reason_type' => $options{'reason'}->{'typenum'}, - 'reason' => $options{'reason'}->{'reason'}, - }); - my $error = $reason->insert; - return $error if $error; - - $reasonnum = $reason->reasonnum; - - } else { - return "Unparsable reason: ". $options{'reason'}; - } - - my $cust_pkg_reason = - new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, - 'reasonnum' => $reasonnum, - 'otaker' => $otaker, - 'action' => substr(uc($options{'action'}),0,1), - 'date' => $options{'date'} - ? $options{'date'} - : time, - }); - - $cust_pkg_reason->insert; -} - -=item set_usage USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values reset. - -=cut - -sub set_usage { - my ($self, $valueref) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref) - if $svc_x->can("set_usage"); - } -} - -=item recharge USAGE_VALUE_HASHREF - -USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts -to which they should be set (see L). Currently seconds, -upbytes, downbytes, and totalbytes are appropriate keys. - -All svc_accts which are part of this package have their values incremented. - -=cut - -sub recharge { - my ($self, $valueref) = @_; - - foreach my $cust_svc ($self->cust_svc){ - my $svc_x = $cust_svc->svc_x; - $svc_x->recharge($valueref) - if $svc_x->can("recharge"); +# Used by FS::Upgrade to migrate to a new database. +sub _upgrade_data { # class method + my ($class, %opts) = @_; + $class->_upgrade_otaker(%opts); + my @statements = ( + # RT#10139, bug resulting in contract_end being set when it shouldn't + 'UPDATE cust_pkg SET contract_end = NULL WHERE contract_end = -1', + # RT#10830, bad calculation of prorate date near end of year + # the date range for bill is December 2009, and we move it forward + # one year if it's before the previous bill date (which it should + # never be) + 'UPDATE cust_pkg SET bill = bill + (365*24*60*60) WHERE bill < last_bill + AND bill > 1259654400 AND bill < 1262332800 AND (SELECT plan FROM part_pkg + WHERE part_pkg.pkgpart = cust_pkg.pkgpart) = \'prorate\'', + ); + foreach my $sql (@statements) { + my $sth = dbh->prepare($sql); + $sth->execute or die $sth->errstr; } }