use strict;
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::Record qw( qsearch qsearchs );
+use FS::m2m_Common;
use FS::cust_main_Mixin;
use FS::cust_svc;
use FS::part_pkg;
use FS::type_pkgs;
use FS::pkg_svc;
use FS::cust_bill_pkg;
+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 }
# for sending cancel emails in sub cancel
use FS::Conf;
-@ISA = qw( FS::cust_main_Mixin FS::option_Common FS::Record );
+@ISA = qw( FS::m2m_Common FS::cust_main_Mixin FS::option_Common FS::Record );
$DEBUG = 0;
=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.
will be used to look up the package definition and agent restrictions will be
ignored.
+If the additional field I<refnum> is defined, an FS::pkg_referral record will
+be created and inserted. Multiple FS::pkg_referral records can be created by
+setting I<refnum> to an array reference of refnums or a hash reference with
+refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
+record will be created corresponding to cust_main.refnum.
+
The following options are available: I<change>
I<change>, if set true, supresses any referral credit to a referring customer.
return $error;
}
+ $self->refnum($self->cust_main->refnum) unless $self->refnum;
+ $self->refnum( [ $self->refnum ] ) unless ref($self->refnum);
+ $self->process_m2m( 'link_table' => 'pkg_referral',
+ 'target_table' => 'part_referral',
+ 'params' => $self->refnum,
+ );
+
#if ( $self->reg_code ) {
# my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } );
# $error = $reg_code->delete;
my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq );
my $error =
- $referring_cust_main->credit( $amount,
- 'Referral credit for '. $cust_main->name
- );
+ $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.
}
}
+ 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.
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";
+ 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";
+ }
}
}
|| $self->ut_numbern('bill')
|| $self->ut_numbern('susp')
|| $self->ut_numbern('cancel')
+ || $self->ut_numbern('adjourn')
+ || $self->ut_numbern('expire')
;
return $error if $error;
}
$self->otaker(getotaker) unless $self->otaker;
- $self->otaker =~ /^([\w\.\-]{0,16})$/ or return "Illegal otaker";
+ $self->otaker =~ /^(\w{1,32})$/ or return "Illegal otaker";
$self->otaker($1);
if ( $self->dbdef_table->column('manual_flag') ) {
in this package, then cancels the package itself (sets the cancel field to
now).
-Available options are: I<quiet>
+Available options are:
+
+=over 4
+
+=item quiet - can be set true to supress email cancellation notices.
+
+=item time - can be set to cancel the package based on a specific future or historical date. Using time ensures that the remaining amount is calculated correctly. Note however that this is an immediate cancel and just changes the date. You are PROBABLY looking to expire the account instead of using this.
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), 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<FS::reason_type>, reason - Text of the new reason.
-I<quiet> can be set true to supress email cancellation notices.
+=back
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"
+ if $DEBUG;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
my $oldAutoCommit = $FS::UID::AutoCommit;
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
+
+ my $cancel_time = $options{'time'} || time;
- if ($options{'reason'}) {
+ my $error;
+
+ if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'} );
if ( $error ) {
dbh->rollback if $oldAutoCommit;
}
}
- # Add a credit for remaining service
- my $remaining_value = $self->calc_remain();
- if ( $remaining_value > 0 ) {
- my $error = $self->cust_main->credit(
- $remaining_value,
- 'Credit for unused time on '. $self->part_pkg->pkg,
- );
- if ($error) {
- $dbh->rollback if $oldAutoCommit;
- return "Error crediting customer \$$remaining_value for unused time on".
- $self->part_pkg->pkg. ": $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'} ) {
+ my $conf = new FS::Conf;
+ my $error = $self->cust_main->credit(
+ $remaining_value,
+ 'Credit for unused time on '. $self->part_pkg->pkg,
+ 'reason_type' => $conf->config('cancel_credit_type'),
+ );
+ 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'} = time;
+ $hash{'cancel'} = $cancel_time;
my $new = new FS::cust_pkg ( \%hash );
$error = $new->replace( $self, options => { $self->options } );
if ( $error ) {
my $error = send_email(
'from' => $conf->config('invoice_from'),
'to' => \@invoicing_list,
- 'subject' => $conf->config('cancelsubject'),
+ 'subject' => ( $conf->config('cancelsubject') || 'Cancellation Notice' ),
'body' => [ map "$_\n", $conf->config('cancelmessage') ],
);
#should this do something on errors?
}
-=item suspend
+=item cancel_if_expired [ NOW_TIMESTAMP ]
+
+Cancels this package if its expire date has been reached.
+
+=cut
+
+sub cancel_if_expired {
+ my $self = shift;
+ my $time = shift || time;
+ return '' unless $self->expire && $self->expire <= $time;
+ my $error = $self->cancel;
+ if ( $error ) {
+ return "Error cancelling expired pkg ". $self->pkgnum. " for custnum ".
+ $self->custnum. ": $error";
+ }
+ '';
+}
+
+=item suspend [ OPTION => VALUE ... ]
Suspends all services (see L<FS::cust_svc> and L<FS::part_svc>) in this
package, then suspends the package itself (sets the susp field to now).
+Available options are:
+
+=over 4
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), 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<FS::reason_type>, reason - Text of the new reason.
+
+=back
+
If there is an error, returns the error, otherwise returns false.
=cut
sub suspend {
my( $self, %options ) = @_;
- my $error ;
local $SIG{HUP} = 'IGNORE';
local $SIG{INT} = 'IGNORE';
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- if ($options{'reason'}) {
+ my $error;
+
+ if ( $options{'reason'} ) {
$error = $self->insert_reason( 'reason' => $options{'reason'} );
if ( $error ) {
dbh->rollback if $oldAutoCommit;
=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>.
&& $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 ) {
my $cust_pkg_reason = qsearchs( {
'table' => 'cust_pkg_reason',
'hashref' => { 'pkgnum' => $self->pkgnum, },
- 'extra_sql'=> 'ORDER BY date DESC',
+ 'extra_sql'=> 'ORDER BY date DESC LIMIT 1',
} );
qsearchs ( 'reason', { 'reasonnum' => $cust_pkg_reason->reasonnum } )
if $cust_pkg_reason;
: qsearchs( 'part_pkg', { 'pkgpart' => $self->pkgpart } );
}
+=item old_cust_pkg
+
+Returns the cancelled package this package was changed from, if any.
+
+=cut
+
+sub old_cust_pkg {
+ my $self = shift;
+ return '' unless $self->change_pkgnum;
+ qsearchs('cust_pkg', { 'pkgnum' => $self->change_pkgnum } );
+}
+
=item calc_setup
Calls the I<calc_setup> of the FS::part_pkg object associated with this billing
qsearch( 'cust_bill_pkg', { 'pkgnum' => $self->pkgnum } );
}
+=item cust_event
+
+Returns the new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub cust_event {
+ my $self = shift;
+ qsearch({
+ 'table' => 'cust_event',
+ 'addl_from' => 'JOIN part_event USING ( eventpart )',
+ 'hashref' => { 'tablenum' => $self->pkgnum },
+ 'extra_sql' => " AND eventtable = 'cust_pkg' ",
+ });
+}
+
+=item num_cust_event
+
+Returns the number of new-style customer billing events (see L<FS::cust_event>) for this invoice.
+
+=cut
+
+#false laziness w/cust_bill.pm
+sub num_cust_event {
+ my $self = shift;
+ my $sql =
+ "SELECT COUNT(*) FROM cust_event JOIN part_event USING ( eventpart ) ".
+ " WHERE tablenum = ? AND eventtable = 'cust_pkg'";
+ my $sth = dbh->prepare($sql) or die dbh->errstr. " preparing $sql";
+ $sth->execute($self->pkgnum) or die $sth->errstr. " executing $sql";
+ $sth->fetchrow_arrayref->[0];
+}
+
=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
$self->part_pkg->pkg_svc;
}
-=item
+=item part_svc
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
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'} = $pkg_svc->quantity - $num_cust_svc;
+ $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;
=item statuses
-Class method that returns the list of possible status strings for pacakges
+Class method that returns the list of possible status strings for packages
(see L<the status method|/status>). For example:
@statuses = FS::cust_pkg->statuses();
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 {
"cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
}
+=item search_sql HREF
+
+Returns a qsearch hash expression to search for parameters specified in HREF.
+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 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
+=back
+
+=cut
+
+sub search_sql {
+ my ($class, $params) = @_;
+ my @where = ();
+
+ ##
+ # parse agent
+ ##
+
+ if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) {
+ push @where,
+ "cust_main.agentnum = $1";
+ }
+
+ ##
+ # parse status
+ ##
+
+ if ( $params->{'magic'} eq 'active'
+ || $params->{'status'} eq 'active' ) {
+
+ push @where, FS::cust_pkg->active_sql();
+
+ } elsif ( $params->{'magic'} eq 'inactive'
+ || $params->{'status'} eq 'inactive' ) {
+
+ push @where, FS::cust_pkg->inactive_sql();
+
+ } elsif ( $params->{'magic'} eq 'suspended'
+ || $params->{'status'} eq 'suspended' ) {
+
+ push @where, FS::cust_pkg->suspended_sql();
+
+ } elsif ( $params->{'magic'} =~ /^cancell?ed$/
+ || $params->{'status'} =~ /^cancell?ed$/ ) {
+
+ push @where, FS::cust_pkg->cancelled_sql();
+
+ } elsif ( $params->{'status'} =~ /^(one-time charge|inactive)$/ ) {
+
+ push @where, FS::cust_pkg->inactive_sql();
+
+ }
+
+ ###
+ # parse package class
+ ###
+
+ #false lazinessish w/graph/cust_bill_pkg.cgi
+ my $classnum = 0;
+ my @pkg_class = ();
+ if ( exists($params->{'classnum'})
+ && $params->{'classnum'} =~ /^(\d*)$/
+ )
+ {
+ $classnum = $1;
+ if ( $classnum ) { #a specific class
+ push @where, "classnum = $classnum";
+
+ #@pkg_class = ( qsearchs('pkg_class', { 'classnum' => $classnum } ) );
+ #die "classnum $classnum not found!" unless $pkg_class[0];
+ #$title .= $pkg_class[0]->classname.' ';
+
+ } elsif ( $classnum eq '' ) { #the empty class
+
+ push @where, "classnum IS NULL";
+ #$title .= 'Empty class ';
+ #@pkg_class = ( '(empty class)' );
+ } elsif ( $classnum eq '0' ) {
+ #@pkg_class = qsearch('pkg_class', {} ); # { 'disabled' => '' } );
+ #push @pkg_class, '(empty class)';
+ } else {
+ die "illegal classnum";
+ }
+ }
+ #eslaf
+
+ ###
+ # parse part_pkg
+ ###
+
+ my $pkgpart = join (' OR pkgpart=',
+ grep {$_} map { /^(\d+)$/; } ($params->{'pkgpart'}));
+ push @where, '(pkgpart=' . $pkgpart . ')' if $pkgpart;
+
+ ###
+ # parse dates
+ ###
+
+ my $orderby = '';
+
+ #false laziness w/report_cust_pkg.html
+ my %disable = (
+ 'all' => {},
+ 'one-time charge' => { 'last_bill'=>1, 'bill'=>1, 'adjourn'=>1, 'susp'=>1, 'expire'=>1, 'cancel'=>1, },
+ 'active' => { 'susp'=>1, 'cancel'=>1 },
+ 'suspended' => { 'cancel' => 1 },
+ 'cancelled' => {},
+ '' => {},
+ );
+
+ foreach my $field (qw( setup last_bill bill adjourn susp expire cancel )) {
+
+ next unless exists($params->{$field});
+
+ my($beginning, $ending) = @{$params->{$field}};
+
+ next if $beginning == 0 && $ending == 4294967295;
+
+ push @where,
+ "cust_pkg.$field IS NOT NULL",
+ "cust_pkg.$field >= $beginning",
+ "cust_pkg.$field <= $ending";
+
+ $orderby ||= "ORDER BY cust_pkg.$field";
+
+ }
+
+ $orderby ||= 'ORDER BY bill';
+
+ ###
+ # parse magic, legacy, etc.
+ ###
+
+ if ( $params->{'magic'} &&
+ $params->{'magic'} =~ /^(active|inactive|suspended|cancell?ed)$/
+ ) {
+
+ $orderby = 'ORDER BY pkgnum';
+
+ if ( $params->{'pkgpart'} =~ /^(\d+)$/ ) {
+ push @where, "pkgpart = $1";
+ }
+
+ } elsif ( $params->{'query'} eq 'pkgnum' ) {
+
+ $orderby = 'ORDER BY pkgnum';
+
+ } elsif ( $params->{'query'} eq 'APKG_pkgnum' ) {
+
+ $orderby = 'ORDER BY pkgnum';
+
+ push @where, '0 < (
+ SELECT count(*) FROM pkg_svc
+ WHERE pkg_svc.pkgpart = cust_pkg.pkgpart
+ AND pkg_svc.quantity > ( SELECT count(*) FROM cust_svc
+ WHERE cust_svc.pkgnum = cust_pkg.pkgnum
+ AND cust_svc.svcpart = pkg_svc.svcpart
+ )
+ )';
+
+ }
+
+ ##
+ # setup queries, links, subs, etc. for the search
+ ##
+
+ # here is the agent virtualization
+ if ($params->{CurrentUser}) {
+ my $access_user =
+ qsearchs('access_user', { username => $params->{CurrentUser} });
+
+ if ($access_user) {
+ push @where, $access_user->agentnums_sql('table'=>'cust_main');
+ }else{
+ push @where, "1=0";
+ }
+ }else{
+ push @where, $FS::CurrentUser::CurrentUser->agentnums_sql('table'=>'cust_main');
+ }
+
+ my $extra_sql = scalar(@where) ? ' WHERE '. join(' AND ', @where) : '';
+
+ my $addl_from = 'LEFT JOIN cust_main USING ( custnum ) '.
+ 'LEFT JOIN part_pkg USING ( pkgpart ) '.
+ 'LEFT JOIN pkg_class USING ( classnum ) ';
+
+ my $count_query = "SELECT COUNT(*) FROM cust_pkg $addl_from $extra_sql";
+
+ my $sql_query = {
+ 'table' => 'cust_pkg',
+ 'hashref' => {},
+ 'select' => join(', ',
+ 'cust_pkg.*',
+ ( map "part_pkg.$_", qw( pkg freq ) ),
+ 'pkg_class.classname',
+ 'cust_main.custnum as cust_main_custnum',
+ FS::UI::Web::cust_sql_fields(
+ $params->{'cust_fields'}
+ ),
+ ),
+ 'extra_sql' => "$extra_sql $orderby",
+ 'addl_from' => $addl_from,
+ 'count_query' => $count_query,
+ };
+
+}
+
=head1 SUBROUTINES
=over 4
-=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF ] ]
+=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
CUSTNUM is a customer (see L<FS::cust_main>)
RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
newly-created cust_pkg objects.
+REFNUM, if specified, will specify the FS::pkg_referral record to be created
+and inserted. Multiple FS::pkg_referral records can be created by
+setting I<refnum> to an array reference of refnums or a hash reference with
+refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
+record will be created corresponding to cust_main.refnum.
+
=cut
sub order {
- my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+ my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
my $conf = new FS::Conf;
my $change = scalar(@old_cust_pkg) != 0;
my %hash = ();
- if ( scalar(@old_cust_pkg) == 1 ) {
+ if ( scalar(@old_cust_pkg) == 1 && scalar(@$pkgparts) == 1 ) {
+
+ my $time = time;
+
#$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill );
- $hash{'setup'} = time;
+
+ #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( setup );
+ $hash{'setup'} = $time if $old_cust_pkg[0]->setup;
+
+ $hash{'change_date'} = $time;
+ $hash{"change_$_"} = $old_cust_pkg[0]->$_() foreach qw( pkgnum pkgpart );
}
# Create the new packages.
foreach my $pkgpart (@$pkgparts) {
my $cust_pkg = new FS::cust_pkg { custnum => $custnum,
pkgpart => $pkgpart,
+ refnum => $refnum,
%hash,
};
$error = $cust_pkg->insert( 'change' => $change );
'';
}
+=item insert_reason
+
+Associates this package with a (suspension or cancellation) reason (see
+L<FS::cust_pkg_reason>, possibly inserting a new reason on the fly (see
+L<FS::reason>).
+
+Available options are:
+
+=over 4
+
+=item reason - can be set to a cancellation reason (see L<FS:reason>), 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<FS::reason_type>, 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
+L<FS::part_pkg>) to order for this customer. Duplicates are of course
+permitted.
+
+REMOVE_PKGNUMS is an list of pkgnums specifying the billing items to
+replace. The services (see L<FS::cust_svc>) are moved to the
+new billing items. An error is returned if this is not possible (see
+L<FS::pkg_svc>).
+
+RETURN_CUST_PKG_ARRAYREF, if specified, will be filled in with the
+newly-created cust_pkg objects.
+
+=cut
+
+sub bulk_change {
+ my ($pkgparts, $remove_pkgnum, $return_cust_pkg) = @_;
+
+ # 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 @errors;
+ my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) }
+ @$remove_pkgnum;
+
+ while(scalar(@old_cust_pkg)) {
+ my @return = ();
+ my $custnum = $old_cust_pkg[0]->custnum;
+ my (@remove) = map { $_->pkgnum }
+ grep { $_->custnum == $custnum } @old_cust_pkg;
+ @old_cust_pkg = grep { $_->custnum != $custnum } @old_cust_pkg;
+
+ my $error = order $custnum, $pkgparts, \@remove, \@return;
+
+ push @errors, $error
+ if $error;
+ push @$return_cust_pkg, @return;
+ }
+
+ if (scalar(@errors)) {
+ $dbh->rollback if $oldAutoCommit;
+ return join(' / ', @errors);
+ }
+
+ $dbh->commit or die $dbh->errstr if $oldAutoCommit;
+ '';
+}
+
sub insert_reason {
my ($self, %options) = @_;
- my $otaker = $FS::CurrentUser::CurrentUser->name;
- $otaker = $FS::CurrentUser::CurrentUser->username
- if (($otaker) eq "User, Legacy");
+ my $otaker = $FS::CurrentUser::CurrentUser->username;
+
+ my $reasonnum;
+ if ( $options{'reason'} =~ /^(\d+)$/ ) {
+
+ $reasonnum = $1;
+
+ } elsif ( ref($options{'reason'}) ) {
+
+ return 'Enter a new reason (or select an existing one)'
+ unless $options{'reason'}->{'reason'} !~ /^\s*$/;
+
+ my $reason = new FS::reason({
+ 'reason_type' => $options{'reason'}->{'typenum'},
+ 'reason' => $options{'reason'}->{'reason'},
+ });
+ my $error = $reason->insert;
+ return $error if $error;
+
+ $reasonnum = $reason->reasonnum;
+
+ } else {
+ return "Unparsable reason: ". $options{'reason'};
+ }
my $cust_pkg_reason =
new FS::cust_pkg_reason({ 'pkgnum' => $self->pkgnum,
- 'reasonnum' => $options{'reason'},
+ 'reasonnum' => $reasonnum,
'otaker' => $otaker,
'date' => $options{'date'}
? $options{'date'}
: time,
});
- return $cust_pkg_reason->insert;
+
+ $cust_pkg_reason->insert;
}
=item set_usage USAGE_VALUE_HASHREF
}
}
+=item recharge 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 incremented.
+
+=cut
+
+sub recharge {
+ my ($self, $valueref) = @_;
+
+ foreach my $cust_svc ($self->cust_svc){
+ my $svc_x = $cust_svc->svc_x;
+ $svc_x->recharge($valueref)
+ if $svc_x->can("recharge");
+ }
+}
+
=back
=head1 BUGS
projects / freeside.git / blobdiff