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 );
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 }
=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;
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 ) {
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 } )
=cut
sub suspend {
- my $self = shift;
+ my( $self, %options ) = @_;
my $error ;
local $SIG{HUP} = 'IGNORE';
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 } )
) {
''; #no errors
}
-=item unsuspend
+=item unsuspend [ OPTION => VALUE ... ]
Unsuspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
package, then unsuspends the package itself (clears the susp field).
+Available options are: I<adjust_next_bill>.
+
+I<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?
+
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';
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 ) {
$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
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<the status method|/status>). 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};
=back
-=head1 CLASS METHOD
+=head1 CLASS METHODS
=over 4
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.
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
=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
=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
$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;
'';
}
+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<FS::svc_acct>). 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