X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=6807baf4967a73ef6923984b54e9a3098796c86e;hb=7b586e45d966b42a1a7bed8e953980d9d082a9cd;hp=cb4f94418c74a49378758e032aeea6960900b3b9;hpb=be9a87ae0cc60259ca8d62047af6d2529b57a373;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index cb4f94418..6807baf49 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 @SVCDB_CANCEL_SEQ $DEBUG); +use Tie::IxHash; use FS::UID qw( getotaker dbh ); use FS::Misc qw( send_email ); use FS::Record qw( qsearch qsearchs ); @@ -14,10 +15,11 @@ use FS::pkg_svc; use FS::cust_bill_pkg; use FS::h_cust_svc; use FS::reg_code; +use FS::cust_pkg_reason; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } -# because they load configuraion by setting FS::UID::callback (see TODO) +# because they load configuration by setting FS::UID::callback (see TODO) use FS::svc_acct; use FS::svc_domain; use FS::svc_www; @@ -269,7 +271,7 @@ Calls =cut sub replace { - my( $new, $old ) = ( shift, shift ); + my( $new, $old, %options ) = @_; #return "Can't (yet?) change pkgpart!" if $old->pkgpart != $new->pkgpart; return "Can't change otaker!" if $old->otaker ne $new->otaker; @@ -294,6 +296,16 @@ sub replace { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + if ($options{'reason'} && $new->expire && $old->expire ne $new->expire) { + my $error = $new->insert_reason( 'reason' => $options{'reason'}, + 'date' => $new->expire, + ); + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return "Error inserting cust_pkg_reason: $error"; + } + } + #save off and freeze RADIUS attributes for any associated svc_acct records my @svc_acct = (); if ( $old->part_pkg->is_prepaid || $new->part_pkg->is_prepaid ) { @@ -359,7 +371,7 @@ sub check { qsearchs( 'reg_code', { 'code' => $self->reg_code, 'agentnum' => $self->cust_main->agentnum }) ) { - return "Unknown registraiton code"; + return "Unknown registration code"; } } elsif ( $self->promo_code ) { @@ -430,6 +442,14 @@ sub cancel { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + if ($options{'reason'}) { + $error = $self->insert_reason( 'reason' => $options{'reason'} ); + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return "Error inserting cust_pkg_reason: $error"; + } + } + my %svc; foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) @@ -502,7 +522,7 @@ If there is an error, returns the error, otherwise returns false. =cut sub suspend { - my $self = shift; + my( $self, %options ) = @_; my $error ; local $SIG{HUP} = 'IGNORE'; @@ -516,6 +536,14 @@ sub suspend { local $FS::UID::AutoCommit = 0; my $dbh = dbh; + if ($options{'reason'}) { + $error = $self->insert_reason( 'reason' => $options{'reason'} ); + if ( $error ) { + dbh->rollback if $oldAutoCommit; + return "Error inserting cust_pkg_reason: $error"; + } + } + foreach my $cust_svc ( qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ) { @@ -555,18 +583,27 @@ sub suspend { ''; #no errors } -=item unsuspend +=item unsuspend [ OPTION => VALUE ... ] Unsuspends all services (see L and L) in this package, then unsuspends the package itself (clears the susp field). +Available options are: I. + +I 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? + If there is an error, returns the error, otherwise returns false. =cut sub unsuspend { - my $self = shift; - my($error); + my( $self, %opt ) = @_; + my $error; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -605,9 +642,15 @@ sub unsuspend { unless ( ! $self->getfield('susp') ) { my %hash = $self->hash; my $inactive = time - $hash{'susp'}; - $hash{'susp'} = ''; + + my $conf = new FS::Conf; + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + if ( $opt{'adjust_next_bill'} + || $conf->config('unsuspend-always_adjust_next_bill_date') ) + && $inactive > 0 && ( $hash{'bill'} || $hash{'setup'} ); + + $hash{'susp'} = ''; my $new = new FS::cust_pkg ( \%hash ); $error = $new->replace($self); if ( $error ) { @@ -639,6 +682,23 @@ sub last_bill { $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; } +=item last_reason + +Returns the most recent FS::reason associated with the package. + +=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', + } ); + qsearchs ( 'reason', { 'reasonnum' => $cust_pkg_reason->reasonnum } ) + if $cust_pkg_reason; +} + =item part_pkg Returns the definition for this billing item, as an FS::part_pkg object (see @@ -824,26 +884,45 @@ Returns a short status string for this package, currently: sub status { my $self = shift; + my $freq = length($self->freq) ? $self->freq : $self->part_pkg->freq; + return 'cancelled' if $self->get('cancel'); return 'suspended' if $self->susp; return 'not yet billed' unless $self->setup; - return 'one-time charge' if $self->part_pkg->freq =~ /^(0|$)/; + return 'one-time charge' if $freq =~ /^(0|$)/; return 'active'; } -=item statuscolor +=item statuses -Returns a hex triplet color string for this package's status. +Class method that returns the list of possible status strings for pacakges +(see L). For example: + + @statuses = FS::cust_pkg->statuses(); =cut -my %statuscolor = ( +tie my %statuscolor, 'Tie::IxHash', 'not yet billed' => '000000', 'one-time charge' => '000000', 'active' => '00CC00', 'suspended' => 'FF9900', 'cancelled' => 'FF0000', -); +; + +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 + keys %statuscolor; +} + +=item statuscolor + +Returns a hex triplet color string for this package's status. + +=cut + sub statuscolor { my $self = shift; $statuscolor{$self->status}; @@ -1163,7 +1242,7 @@ sub reexport { =back -=head1 CLASS METHOD +=head1 CLASS METHODS =over 4 @@ -1178,6 +1257,17 @@ sub recurring_sql { " where cust_pkg.pkgpart = part_pkg.pkgpart ) "; } +=item onetime_sql + +Returns an SQL expression identifying one-time packages. + +=cut + +sub onetime_sql { " + '0' = ( select freq from part_pkg + where cust_pkg.pkgpart = part_pkg.pkgpart ) +"; } + =item active_sql Returns an SQL expression identifying active packages. @@ -1190,6 +1280,19 @@ sub active_sql { " AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) "; } +=item inactive_sql + +Returns an SQL expression identifying inactive packages (one-time packages +that are otherwise unsuspended/uncancelled). + +=cut + +sub inactive_sql { " + ". $_[0]->onetime_sql(). " + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) +"; } + =item susp_sql =item suspended_sql @@ -1198,11 +1301,13 @@ Returns an SQL expression identifying suspended packages. =cut sub suspended_sql { susp_sql(@_); } -sub susp_sql { " - ". $_[0]->recurring_sql(). " - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 -"; } +sub susp_sql { + #$_[0]->recurring_sql(). ' AND '. + " + ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND cust_pkg.susp IS NOT NULL AND cust_pkg.susp != 0 + "; +} =item cancel_sql =item cancelled_sql @@ -1212,10 +1317,10 @@ Returns an SQL exprression identifying cancelled packages. =cut sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { " - ". $_[0]->recurring_sql(). " - AND cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0 -"; } +sub cancel_sql { + #$_[0]->recurring_sql(). ' AND '. + "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; +} =head1 SUBROUTINES @@ -1319,7 +1424,7 @@ sub order { $dbh->rollback if $oldAutoCommit; return "Unable to transfer all services from package ".$old_pkg->pkgnum; } - $error = $old_pkg->cancel; + $error = $old_pkg->cancel( quiet=>1 ); if ($error) { $dbh->rollback; return $error; @@ -1329,6 +1434,44 @@ sub order { ''; } +sub insert_reason { + my ($self, %options) = @_; + + my $otaker = $FS::CurrentUser::CurrentUser->name; + $otaker = $FS::CurrentUser::CurrentUser->username + if (($otaker) eq "User, Legacy"); + + my $cust_pkg_reason = + new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum, + 'reasonnum' => $options{'reason'}, + 'otaker' => $otaker, + 'date' => $options{'date'} + ? $options{'date'} + : time, + }); + return $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"); + } +} + =back =head1 BUGS