X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=03cec75b84455e0489622b0df71aef0f90dcbde9;hp=9d4ca1c00bf06db472cd28ba5889d083cafc426d;hb=2b8ffc98529637ffddfe7cbf6b4f9b8deb90f0fa;hpb=d0aca10ecd6edb171555eb87b1570daa3d2820b1 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 9d4ca1c00..03cec75b8 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -2,6 +2,7 @@ package FS::cust_pkg; use strict; use vars qw(@ISA $disable_agentcheck $DEBUG); +use Scalar::Util qw( blessed ); use List::Util qw(max); use Tie::IxHash; use FS::UID qw( getotaker dbh ); @@ -12,15 +13,18 @@ use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; +use FS::cust_location; use FS::type_pkgs; 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::UI::Web; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -101,36 +105,80 @@ 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 setup -=item cancel - date +date -=item otaker - order taker (assigned automatically if null, see L) +=item bill -=item manual_flag - If this field is set to 1, disables the automatic -unsuspension of this package when using the B config file. +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 =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 @@ -165,9 +213,19 @@ 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: -I, if set true, supresses any referral credit to a referring customer. +=over 4 + +=item change + +If set true, supresses any referral credit to a referring customer. + +=item options + +cust_pkg_option records will be created + +=back =cut @@ -208,42 +266,6 @@ 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('welcome_letter') && $self->cust_main->num_pkgs == 1) { my $queue = new FS::queue { @@ -278,7 +300,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. @@ -295,17 +317,38 @@ 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 sub replace { - my( $new, $old, %options ) = @_; + my $new = shift; + + my $old = ( blessed($_[0]) && $_[0]->isa('FS::Record') ) + ? shift + : $new->replace_old; + + my $options = + ( ref($_[0]) eq 'HASH' ) + ? shift + : { @_ }; - # We absolutely have to have an old vs. new record to make this work. - if (!defined($old)) { - $old = qsearchs( 'cust_pkg', { 'pkgnum' => $new->pkgnum } ); - } #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change otaker!" if $old->otaker ne $new->otaker; @@ -330,10 +373,13 @@ sub replace { my $dbh = dbh; 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, - ); + 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'}, + ); if ( $error ) { dbh->rollback if $oldAutoCommit; return "Error inserting cust_pkg_reason: $error"; @@ -356,7 +402,7 @@ sub replace { } my $error = $new->SUPER::replace($old, - $options{options} ? ${options{options}} : () + $options->{options} ? $options->{options} : () ); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -394,6 +440,7 @@ sub check { $self->ut_numbern('pkgnum') || $self->ut_foreign_key('custnum', 'cust_main', 'custnum') || $self->ut_numbern('pkgpart') + || $self->ut_foreign_keyn('locationnum', 'location', 'locationnum') || $self->ut_numbern('setup') || $self->ut_numbern('bill') || $self->ut_numbern('susp') @@ -468,6 +515,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 cancel (expire) + =back If there is an error, returns the error, otherwise returns false. @@ -476,6 +525,7 @@ If there is an error, returns the error, otherwise returns false. sub cancel { my( $self, %options ) = @_; + my $error; warn "cust_pkg::cancel called with options". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" @@ -492,12 +542,24 @@ sub cancel { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $cancel_time = $options{'time'} || time; + my $old = $self->select_for_update; - my $error; + 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? + + 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"; @@ -505,23 +567,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'} ) { @@ -534,20 +596,22 @@ 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; @@ -584,7 +648,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). @@ -595,6 +711,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. @@ -603,6 +721,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'; @@ -615,48 +734,106 @@ 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'), #??? 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; @@ -670,15 +847,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 @@ -698,6 +881,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 } ) ) { @@ -721,30 +917,86 @@ sub unsuspend { } - unless ( ! $self->getfield('susp') ) { - my %hash = $self->hash; - my $inactive = time - $hash{'susp'}; + my %hash = $self->hash; + my $inactive = time - $hash{'susp'}; - my $conf = new FS::Conf; + 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'} ); + $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'} ); - $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; - } + $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 last_bill @@ -756,29 +1008,45 @@ 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_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, $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 $self = shift; - my $cust_pkg_reason = qsearchs( { - 'table' => 'cust_pkg_reason', - 'hashref' => { 'pkgnum' => $self->pkgnum, }, - 'extra_sql'=> 'ORDER BY date DESC LIMIT 1', - } ); - qsearchs ( 'reason', { 'reasonnum' => $cust_pkg_reason->reasonnum } ) + my $cust_pkg_reason = shift->last_cust_pkg_reason(@_); + $cust_pkg_reason->reason if $cust_pkg_reason; } @@ -868,6 +1136,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. @@ -1192,24 +1531,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; @@ -1231,6 +1575,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_main', { '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 @@ -1319,6 +1687,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. @@ -1551,27 +1931,71 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } -=item search_sql HREF +=item search_sql HASHREF + +(Class method) -Returns a qsearch hash expression to search for parameters specified in HREF. +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 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 @@ -1586,7 +2010,7 @@ sub search_sql { if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { push @where, - "agentnum = $1"; + "cust_main.agentnum = $1"; } ## @@ -1738,12 +2162,12 @@ sub search_sql { qsearchs('access_user', { username => $params->{CurrentUser} }); if ($access_user) { - push @where, $access_user->agentnums_sql; + push @where, $access_user->agentnums_sql('table'=>'cust_main'); }else{ push @where, "1=0"; } }else{ - push @where, $FS::CurrentUser::CurrentUser->agentnums_sql; + push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main'); } my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : ''; @@ -1900,26 +2324,6 @@ 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 ] PKGPARTS is a list of pkgparts specifying the the billing item definitions (see @@ -1978,10 +2382,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+)$/ ) { @@ -2010,6 +2447,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,