package FS::cust_pkg;
use strict;
-use vars qw(@ISA $disable_agentcheck @SVCDB_CANCEL_SEQ $DEBUG);
+use vars qw(@ISA $disable_agentcheck $DEBUG);
+use List::Util qw(max);
use Tie::IxHash;
use FS::UID qw( getotaker dbh );
use FS::Misc qw( send_email );
use FS::cust_bill_pkg;
use FS::h_cust_svc;
use FS::reg_code;
+use FS::part_svc;
+use FS::cust_pkg_reason;
+use FS::reason;
# need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend,
# setup }
# for sending cancel emails in sub cancel
use FS::Conf;
-@ISA = qw( FS::cust_main_Mixin FS::Record );
+@ISA = qw( FS::cust_main_Mixin FS::option_Common FS::Record );
$DEBUG = 0;
$disable_agentcheck = 0;
-# The order in which to unprovision services.
-@SVCDB_CANCEL_SEQ = qw( svc_external
- svc_www
- svc_forward
- svc_acct
- svc_domain
- svc_broadband );
-
sub _cache {
my $self = shift;
my ( $hashref, $cache ) = @_;
=item last_bill - last bill date
+=item adjourn - date
+
=item susp - date
=item expire - date
=back
-Note: setup, bill, susp, expire and cancel are specified as UNIX timestamps;
+Note: setup, bill, adjourn, susp, expire and cancel are specified as UNIX timestamps;
see L<perlfunc/"time">. Also see L<Time::Local> and L<Date::Parse> for
conversion functions.
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my $error = $self->SUPER::insert;
+ my $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ());
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
}
}
+ if ($conf->config('welcome_letter') && $self->cust_main->num_pkgs == 1) {
+ my $queue = new FS::queue {
+ 'job' => 'FS::cust_main::queueable_print',
+ };
+ $error = $queue->insert(
+ 'custnum' => $self->custnum,
+ 'template' => 'welcome_letter',
+ );
+
+ if ($error) {
+ warn "can't send welcome letter: $error";
+ }
+
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
Replaces the OLD_RECORD with this one in the database. If there is an error,
returns the error, otherwise returns false.
-Currently, custnum, setup, bill, susp, expire, and cancel may be changed.
+Currently, custnum, setup, bill, adjourn, susp, expire, and cancel may be changed.
Changing pkgpart may have disasterous effects. See the order subroutine.
=cut
sub replace {
- my( $new, $old ) = ( shift, shift );
+ my( $new, $old, %options ) = @_;
+ # 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;
local $FS::UID::AutoCommit = 0;
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 ( $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 ) {
}
- my $error = $new->SUPER::replace($old);
+ my $error = $new->SUPER::replace($old,
+ $options{options} ? ${options{options}} : ()
+ );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
|| $self->ut_numbern('bill')
|| $self->ut_numbern('susp')
|| $self->ut_numbern('cancel')
+ || $self->ut_numbern('adjourn')
+ || $self->ut_numbern('expire')
;
return $error if $error;
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 } )
+ #schwartz
+ map { $_->[0] }
+ sort { $a->[1] <=> $b->[1] }
+ map { [ $_, $_->svc_x->table_info->{'cancel_weight'} ]; }
+ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } )
) {
- push @{ $svc{$cust_svc->part_svc->svcdb} }, $cust_svc;
- }
- foreach my $svcdb (@SVCDB_CANCEL_SEQ) {
- foreach my $cust_svc (@{ $svc{$svcdb} }) {
- 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";
}
}
my %hash = $self->hash;
$hash{'cancel'} = time;
my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace($self);
+ $error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
=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 } )
) {
my %hash = $self->hash;
$hash{'susp'} = time;
my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace($self);
+ $error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
''; #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).
+package, then unsuspends the package itself (clears the susp field and the
+adjourn field if it is in the past).
+
+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'} = '';
+ $hash{'adjourn'} = '' if $hash{'adjourn'} < time;
my $new = new FS::cust_pkg ( \%hash );
- $error = $new->replace($self);
+ $error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $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 LIMIT 1',
+ } );
+ 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
$self->part_pkg->calc_cancel($self, @_);
}
+=item cust_bill_pkg
+
+Returns any invoice line items for this package (see L<FS::cust_bill_pkg>).
+
+=cut
+
+sub cust_bill_pkg {
+ my $self = shift;
+ qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
+}
+
=item cust_svc [ SVCPART ]
Returns the services for this package, as FS::cust_svc objects (see
}
+=item overlimit [ SVCPART ]
+
+Returns the services for this package which have exceeded their
+usage limit as FS::cust_svc objects (see L<FS::cust_svc>). If a svcpart
+is specified, return only the matching services.
+
+=cut
+
+sub overlimit {
+ my $self = shift;
+ grep { $_->overlimit } $self->cust_svc;
+}
+
=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ]
Returns historical services for this package created before END TIMESTAMP and
=item available_part_svc
-Returns a list FS::part_svc objects representing services included in this
+Returns a list of FS::part_svc objects representing services included in this
package but not yet provisioned. Each FS::part_svc object also has an extra
field, I<num_avail>, which specifies the number of available services.
$self->part_pkg->pkg_svc;
}
+=item
+
+Returns a list of FS::part_svc objects representing provisioned and available
+services included in this package. Each FS::part_svc object also has the
+following extra fields:
+
+=over 4
+
+=item num_cust_svc (count)
+
+=item num_avail (quantity - count)
+
+=item cust_pkg_svc (services) - array reference containing the provisioned services, as cust_svc objects
+
+svcnum
+label -> ($cust_svc->label)[1]
+
+=back
+
+=cut
+
+sub part_svc {
+ my $self = shift;
+
+ #XXX some sort of sort order besides numeric by svcpart...
+ my @part_svc = sort { $a->svcpart <=> $b->svcpart } map {
+ my $pkg_svc = $_;
+ my $part_svc = $pkg_svc->part_svc;
+ my $num_cust_svc = $self->num_cust_svc($part_svc->svcpart);
+ $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;
+ } $self->part_pkg->pkg_svc;
+
+ #extras
+ push @part_svc, map {
+ my $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;
+ } $self->extra_part_svc;
+
+ @part_svc;
+
+}
+
+=item extra_part_svc
+
+Returns a list of FS::part_svc objects corresponding to services in this
+package which are still provisioned but not (any longer) available in the
+package definition.
+
+=cut
+
+sub extra_part_svc {
+ my $self = shift;
+
+ 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 = $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
+ )",
+ } );
+}
+
=item status
Returns a short status string for this package, currently:
foreach my $cust_svc ($self->cust_svc) {
if($target{$cust_svc->svcpart} > 0) {
$target{$cust_svc->svcpart}--;
- my $new = new FS::cust_svc {
- svcnum => $cust_svc->svcnum,
- svcpart => $cust_svc->svcpart,
- pkgnum => $dest_pkgnum,
- };
+ my $new = new FS::cust_svc { $cust_svc->hash };
+ $new->pkgnum($dest_pkgnum);
my $error = $new->replace($cust_svc);
return $error if $error;
} elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
warn "alternate(s) found\n" if $DEBUG;
my $change_svcpart = $alternate[0];
$target{$change_svcpart}--;
- my $new = new FS::cust_svc {
- svcnum => $cust_svc->svcnum,
- svcpart => $change_svcpart,
- pkgnum => $dest_pkgnum,
- };
+ my $new = new FS::cust_svc { $cust_svc->hash };
+ $new->svcpart($change_svcpart);
+ $new->pkgnum($dest_pkgnum);
my $error = $new->replace($cust_svc);
return $error if $error;
} else {
$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->username;
+
+ 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