X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=f56402377d1820fb2f6511ff0655b42447e80fa9;hb=725f4954f7d4efaf7cd3fd5e402a5dacd5d185b9;hp=834d2efb8079c45925e8478915141ff8be94b157;hpb=9e4bc4c0c9c77d75618196f4f0eeeeeb35e2ee08;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 834d2efb8..f56402377 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,9 +2,11 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck $DEBUG); +use Carp qw(cluck); use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; +use MIME::Entity; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); @@ -13,9 +15,10 @@ use FS::cust_main_Mixin; 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; @@ -103,36 +106,88 @@ inherits from FS::Record. The following fields are currently supported: =over 4 -=item pkgnum - primary key (assigned automatically for new billing items) +=item pkgnum -=item custnum - Customer (see L) +Primary key (assigned automatically for new billing items) -=item pkgpart - Billing item definition (see L) +=item custnum -=item setup - date +Customer (see L) -=item bill - date (next bill date) +=item pkgpart -=item last_bill - last bill date +Billing item definition (see L) -=item adjourn - date +=item locationnum -=item susp - date +Optional link to package location (see L) -=item expire - date +=item start_date -=item cancel - date +date -=item otaker - order taker (assigned automatically if null, see L) +=item setup -=item manual_flag - If this field is set to 1, disables the automatic -unsuspension of this package when using the B config file. +date + +=item bill + +date (next bill date) + +=item last_bill + +last bill date + +=item adjourn + +date + +=item susp + +date + +=item expire + +date + +=item cancel + +date + +=item otaker + +order taker (assigned automatically if null, see L) + +=item manual_flag + +If this field is set to 1, disables the automatic +unsuspension of this package when using the B config option. + +=item quantity + +If not set, defaults to 1 + +=item change_date + +Date of change from previous package + +=item change_pkgnum + +Previous pkgnum + +=item change_pkgpart + +Previous pkgpart + +=item change_locationnum + +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 @@ -167,9 +222,27 @@ 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 -I, if set true, supresses any referral credit to a referring customer. +an optional queue name for ticket additions + +=back =cut @@ -210,41 +283,28 @@ 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(); + 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) { @@ -280,7 +340,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. @@ -297,7 +357,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 @@ -338,9 +414,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, - ); + 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"; @@ -397,10 +476,14 @@ 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') @@ -434,10 +517,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' ); @@ -475,6 +558,10 @@ Available options are: =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 - 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. + =back If there is an error, returns the error, otherwise returns false. @@ -483,6 +570,9 @@ If there is an error, returns the error, otherwise returns false. 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" @@ -499,12 +589,37 @@ sub cancel { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $cancel_time = $options{'time'} || time; + my $old = $self->select_for_update; + + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + 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 $error = + $self->cust_main->bill( pkg_list => [ $self ], cancel => 1 ); + warn "Error billing during cancel, custnum ". + #$self->cust_main->custnum. ": $error" + ": $error" + if $error; + } - my $error; + + my $cancel_time = $options{'time'} || time; if ( $options{'reason'} ) { - $error = $self->insert_reason( 'reason' => $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 ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; @@ -512,23 +627,23 @@ sub cancel { } my %svc; - 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 } ) - ) { + unless ( $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; + my $error = $cust_svc->cancel; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error cancelling cust_svc: $error"; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error cancelling cust_svc: $error"; + } } - } - unless ( $self->getfield('cancel') ) { # Add a credit for remaining service my $remaining_value = $self->calc_remain(time=>$cancel_time); if ( $remaining_value > 0 && !$options{'no_credit'} ) { @@ -541,27 +656,29 @@ sub cancel { if ($error) { $dbh->rollback if $oldAutoCommit; return "Error crediting customer \$$remaining_value for unused time on". - $self->part_pkg->pkg. ": $error"; - } - } - my %hash = $self->hash; - $hash{'cancel'} = $cancel_time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; + $self->part_pkg->pkg. ": $error"; + } } } + my %hash = $self->hash; + $date ? ($hash{'expire'} = $date) : ($hash{'cancel'} = $cancel_time); + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace( $self, options => { $self->options } ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $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'), + 'from' => $conf->config('invoice_from', $self->cust_main->agentnum), 'to' => \@invoicing_list, 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ), 'body' => [ map "$_\n", $conf->config('cancelmessage') ], @@ -591,7 +708,59 @@ sub cancel_if_expired { ''; } -=item suspend [ OPTION => VALUE ... ] +=item unexpire + +Cancels any pending expiration (sets the expire field to null). + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub unexpire { + my( $self, %options ) = @_; + my $error; + + 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 $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unexpire cancelled package $pkgnum"; + # or at least it's pointless + } + + unless ( $old->get('expire') && $self->get('expire') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + my %hash = $self->hash; + $hash{'expire'} = ''; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace( $self, options => { $self->options } ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; #no errors + +} + +=item suspend [ OPTION => VALUE ... ] Suspends all services (see L and L) in this package, then suspends the package itself (sets the susp field to now). @@ -602,6 +771,8 @@ Available options are: =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 - can be set to a unix style timestamp to specify when to suspend (adjourn) + =back If there is an error, returns the error, otherwise returns false. @@ -610,6 +781,7 @@ If there is an error, returns the error, otherwise returns false. sub suspend { my( $self, %options ) = @_; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -622,48 +794,107 @@ sub suspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $error; + my $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't suspend cancelled package $pkgnum"; + } + + if ( $old->get('susp') || $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error # complain on adjourn? + } + + my $date = $options{date} if $options{date}; # adjourn/suspend later + $date = '' if ($date && $date <= time); # complain instead? + + if ( $date && $old->get('expire') && $old->get('expire') < $date ) { + dbh->rollback if $oldAutoCommit; + 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'} ); + $error = $self->insert_reason( 'reason' => $options{'reason'}, + 'action' => $date ? 'adjourn' : 'suspend', + 'date' => $date ? $date : $suspend_time, + 'reason_otaker' => $options{'reason_otaker'}, + ); if ( $error ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; } } - foreach my $cust_svc ( - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) - ) { - my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + unless ( $date ) { - $part_svc->svcdb =~ /^([\w\-]+)$/ or do { - $dbh->rollback if $oldAutoCommit; - return "Illegal svcdb value in part_svc!"; - }; - my $svcdb = $1; - require "FS/$svcdb.pm"; + my @labels = (); - my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); - if ($svc) { - $error = $svc->suspend; - if ( $error ) { + foreach my $cust_svc ( + qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) + ) { + my $part_svc = qsearchs( 'part_svc', { 'svcpart' => $cust_svc->svcpart } ); + + $part_svc->svcdb =~ /^([\w\-]+)$/ or do { $dbh->rollback if $oldAutoCommit; - return $error; + return "Illegal svcdb value in part_svc!"; + }; + my $svcdb = $1; + require "FS/$svcdb.pm"; + + my $svc = qsearchs( $svcdb, { 'svcnum' => $cust_svc->svcnum } ); + if ($svc) { + $error = $svc->suspend; + if ( $error ) { + $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"; + } - unless ( $self->getfield('susp') ) { - my %hash = $self->hash; - $hash{'susp'} = time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; } + + } + + my %hash = $self->hash; + 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 ) { + $dbh->rollback if $oldAutoCommit; + return $error; } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -677,15 +908,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 -I can be set true to adjust the next bill date forward by +=item adjust_next_bill + +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 @@ -705,6 +942,19 @@ sub unsuspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + my $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unsuspend cancelled package $pkgnum"; + } + + unless ( $old->get('susp') && $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error # complain instead? + } + foreach my $cust_svc ( qsearch('cust_svc',{'pkgnum'=> $self->pkgnum } ) ) { @@ -725,33 +975,246 @@ sub unsuspend { return $error; } } - + + } + + my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; + + my $conf = new FS::Conf; + + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive + if ( $opt{'adjust_next_bill'} + || $conf->exists('unsuspend-always_adjust_next_bill_date') ) + && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + + $hash{'susp'} = ''; + $hash{'adjourn'} = '' if $hash{'adjourn'} < time; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace( $self, options => { $self->options } ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; #no errors +} + +=item unadjourn + +Cancels any pending suspension (sets the adjourn field to null). + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub unadjourn { + my( $self, %options ) = @_; + my $error; + + 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 $old = $self->select_for_update; + + my $pkgnum = $old->pkgnum; + if ( $old->get('cancel') || $self->get('cancel') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unadjourn cancelled package $pkgnum"; + # or at least it's pointless + } + + if ( $old->get('susp') || $self->get('susp') ) { + dbh->rollback if $oldAutoCommit; + return "Can't unadjourn suspended package $pkgnum"; + # perhaps this is arbitrary + } + + unless ( $old->get('adjourn') && $self->get('adjourn') ) { + dbh->rollback if $oldAutoCommit; + return ""; # no error + } + + my %hash = $self->hash; + $hash{'adjourn'} = ''; + my $new = new FS::cust_pkg ( \%hash ); + $error = $new->replace( $self, options => { $self->options } ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + ''; #no errors + +} + + +=item change HASHREF | OPTION => VALUE ... + +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). + +Options may be passed as a list of key/value pairs or as a hash reference. +Options are: + +=over 4 + +=item locaitonnum + +New locationnum, to change the location for this package. + +=item cust_location + +New FS::cust_location object, to create a new location and assign it +to this package. + +=item pkgpart + +New pkgpart (see L). + +=item refnum + +New refnum (see L). + +=back + +At least one option must be specified (otherwise, what's the point?) + +Returns either the new FS::cust_pkg object or a scalar error. + +For example: + + my $err_or_new_cust_pkg = $old_cust_pkg->change + +=cut + +#some false laziness w/order +sub change { + my $self = shift; + my $opt = ref($_[0]) ? shift : { @_ }; + +# my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_; +# + + my $conf = new FS::Conf; + + # 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'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $error; + + my %hash = (); + + my $time = time; + + #$hash{$_} = $self->$_() foreach qw( last_bill bill ); + + #$hash{$_} = $self->$_() foreach qw( setup ); + + $hash{'setup'} = $time if $self->setup; + + $hash{'change_date'} = $time; + $hash{"change_$_"} = $self->$_() + foreach qw( pkgnum pkgpart locationnum ); + + 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; } - unless ( ! $self->getfield('susp') ) { - my %hash = $self->hash; - my $inactive = time - $hash{'susp'}; + # 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, + }; - my $conf = new FS::Conf; + $error = $cust_pkg->insert( 'change' => 1 ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } - $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'} ); + # Transfer services and cancel old package. - $hash{'susp'} = ''; - $hash{'adjourn'} = '' if $hash{'adjourn'} < time; - my $new = new FS::cust_pkg ( \%hash ); - $error = $new->replace( $self, options => { $self->options } ); - if ( $error ) { + $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 + 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'); + + if ($error) { + $dbh->rollback if $oldAutoCommit; + return "Error setting usage values: $error"; + } + } + + #Good to go, cancel old package. + $error = $self->cancel( quiet=>1 ); + if ($error) { + $dbh->rollback; + return $error; + } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + $cust_pkg; - ''; #no errors } =item last_bill @@ -763,39 +1226,44 @@ Useful for billing metered services. sub last_bill { my $self = shift; - if ( $self->dbdef_table->column('last_bill') ) { - return $self->setfield('last_bill', $_[0]) if @_; - return $self->getfield('last_bill') if $self->getfield('last_bill'); - } + 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 +=item last_cust_pkg_reason ACTION -Returns the most recent FS::reason associated with the package. +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 = shift; + my ( $self, $action ) = ( shift, shift ); + my $date = $self->get($action); qsearchs( { 'table' => 'cust_pkg_reason', - 'hashref' => { 'pkgnum' => $self->pkgnum, }, - 'extra_sql'=> "AND date <= ". time, - 'order_by' => 'ORDER BY date DESC LIMIT 1', + 'hashref' => { 'pkgnum' => $self->pkgnum, + 'action' => substr(uc($action), 0, 1), + 'date' => $date, + }, + 'order_by' => 'ORDER BY num DESC LIMIT 1', } ); } -=item last_reason +=item last_reason ACTION -Returns the most recent FS::reason associated with the 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. =cut sub last_reason { - my $cust_pkg_reason = shift->last_cust_pkg_reason; + my $cust_pkg_reason = shift->last_cust_pkg_reason(@_); $cust_pkg_reason->reason if $cust_pkg_reason; } @@ -809,10 +1277,9 @@ L). sub part_pkg { my $self = shift; - #exists( $self->{'_pkgpart'} ) - $self->{'_pkgpart'} - ? $self->{'_pkgpart'} - : qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } ); + 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 @@ -886,6 +1353,77 @@ sub cust_bill_pkg { 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; + ''; + +} + =item cust_event Returns the new-style customer billing events (see L) for this invoice. @@ -931,11 +1469,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 { @@ -956,7 +1498,8 @@ 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 ] @@ -1005,9 +1548,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]; } @@ -1064,7 +1617,8 @@ 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; } $self->part_pkg->pkg_svc; @@ -1074,7 +1628,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; @@ -1096,20 +1651,38 @@ 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.*', + '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'] ], } ); } @@ -1164,8 +1737,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; } @@ -1210,24 +1783,29 @@ sub h_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; + 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(@_); 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; @@ -1249,6 +1827,30 @@ sub cust_main { qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } +=item cust_location + +Returns the location object, if any (see L). + +=cut + +sub cust_location { + my $self = shift; + return '' unless $self->locationnum; + qsearchs( 'cust_location', { 'locationnum' => $self->locationnum } ); +} + +=item cust_location_or_main + +If this package is associated with a location, returns the locaiton (see +L), otherwise returns the customer (see L). + +=cut + +sub cust_location_or_main { + my $self = shift; + $self->cust_location || $self->cust_main; +} + =item seconds_since TIMESTAMP Returns the number of seconds all accounts (see L) in this @@ -1337,6 +1939,18 @@ sub attribute_since_sqlradacct { } +=item quantity + +=cut + +sub quantity { + my( $self, $value ) = @_; + if ( defined($value) ) { + $self->setfield('quantity', $value); + } + $self->getfield('quantity') || 1; +} + =item transfer DEST_PKGNUM | DEST_CUST_PKG, [ OPTION => VALUE ... ] Transfers as many services as possible from this package to another package. @@ -1527,6 +2141,18 @@ sub active_sql { " 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 ) +"; } + =item inactive_sql Returns an SQL expression identifying inactive packages (one-time packages @@ -1536,6 +2162,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 ) "; } @@ -1569,27 +2196,75 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HREF +=item search_sql HASHREF -Returns a qsearch hash expression to search for parameters specified in HREF. +(Class method) + +Returns a qsearch hash expression to search for parameters specified in HASHREF. Valid parameters are =over 4 + =item agentnum -=item magic - /^(active|inactive|suspended|cancell?ed)$/ -=item status - /^(active|inactive|suspended|one-time charge|inactive|cancell?ed)$/ + +=item magic + +active, inactive, suspended, cancel (or cancelled) + +=item status + +active, inactive, suspended, one-time charge, inactive, cancel (or cancelled) + +=item custom + + boolean selects custom packages + =item classnum -=item pkgpart - list specified how? -=item setup - arrayref of beginning and ending epoch date -=item last_bill - arrayref of beginning and ending epoch date -=item bill - arrayref of beginning and ending epoch date -=item adjourn - arrayref of beginning and ending epoch date -=item susp - arrayref of beginning and ending epoch date -=item expire - arrayref of beginning and ending epoch date -=item cancel - arrayref of beginning and ending epoch date -=item query - /^(pkgnum/APKG_pkgnum)$/ -=item cust_fields - a value suited to passing to FS::UI::Web::cust_header -=item CurrentUser - specifies the user for agent virtualization + +=item pkgpart + +list specified how? + +=item setup + +arrayref of beginning and ending epoch date + +=item last_bill + +arrayref of beginning and ending epoch date + +=item bill + +arrayref of beginning and ending epoch date + +=item adjourn + +arrayref of beginning and ending epoch date + +=item susp + +arrayref of beginning and ending epoch date + +=item expire + +arrayref of beginning and ending epoch date + +=item cancel + +arrayref of beginning and ending epoch date + +=item query + +pkgnum or APKG_pkgnum + +=item cust_fields + +a value suited to passing to FS::UI::Web::cust_header + +=item CurrentUser + +specifies the user for agent virtualization + =back =cut @@ -1616,8 +2291,13 @@ sub search_sql { push @where, FS::cust_pkg->active_sql(); - } elsif ( $params->{'magic'} eq 'inactive' - || $params->{'status'} eq 'inactive' ) { + } elsif ( $params->{'magic'} eq 'not yet billed' + || $params->{'status'} eq '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(); @@ -1631,10 +2311,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(); - } ### @@ -1671,6 +2347,44 @@ 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 censustract + ### + + if ( $params->{'censustract'} =~ /^([.\d]+)$/ and $1 ) { + push @where, "cust_main.censustract = '". $params->{censustract}. "'"; + } + + ### # parse part_pkg ### @@ -1791,6 +2505,97 @@ sub search_sql { } +=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 @bill_param; + if ( $ornull ) { + @bill_param = qw( county county state state state country ); + } else { + @bill_param = qw( county state state country ); + } + unshift @bill_param, 'county'; # unless $nec; + + 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_county = " OR ( ? = '' AND $table.${prefix}county IS NULL ) "; + my $or_empty_state = " OR ( ? = '' AND $table.${prefix}state IS NULL ) "; + + " + ( $table.${prefix}county = ? $or_empty_county $ornull ) + AND ( $table.${prefix}state = ? $or_empty_state $ornull ) + AND $table.${prefix}country = ? + "; +} + =head1 SUBROUTINES =over 4 @@ -1838,8 +2643,8 @@ 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; my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } @$remove_pkgnum; @@ -1849,15 +2654,19 @@ sub order { my %hash = (); if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) { - my $time = time; + my $err_or_cust_pkg = + $old_cust_pkg[0]->change( 'pkgpart' => $pkgparts->[0], + 'refnum' => $refnum, + ); - #$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; + unless (ref($err_or_cust_pkg)) { + $dbh->rollback if $oldAutoCommit; + return $err_or_cust_pkg; + } + + push @$return_cust_pkg, $err_or_cust_pkg; + return ''; - $hash{'change_date'} = $time; - $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart ); } # Create the new packages. @@ -1918,30 +2727,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 @@ -1996,10 +2787,43 @@ sub bulk_change { ''; } +=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 = $FS::CurrentUser::CurrentUser->username; + my $otaker = $options{reason_otaker} || + $FS::CurrentUser::CurrentUser->username; my $reasonnum; if ( $options{'reason'} =~ /^(\d+)$/ ) { @@ -2028,6 +2852,7 @@ sub insert_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, @@ -2047,11 +2872,11 @@ All svc_accts which are part of this package have their values reset. =cut sub set_usage { - my ($self, $valueref) = @_; + my ($self, $valueref, %opt) = @_; foreach my $cust_svc ($self->cust_svc){ my $svc_x = $cust_svc->svc_x; - $svc_x->set_usage($valueref) + $svc_x->set_usage($valueref, %opt) if $svc_x->can("set_usage"); } }