X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=074746579d4d371365e488a06a22e9c75d5e0fdc;hb=a54f127b4decc976d91a3ce7fbb66edbef9bdc87;hp=4976a2d50dc2a32ebb4a236103f4bb6a830a657b;hpb=eddbfe83c7b701ef02ce346b169fc44eae4f6e97;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 4976a2d50..074746579 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,7 +1,8 @@ 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 ); @@ -15,6 +16,10 @@ use FS::pkg_svc; 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; +use FS::UI::Web; # need to 'use' these instead of 'require' in sub { cancel, suspend, unsuspend, # setup } @@ -27,20 +32,12 @@ use FS::svc_forward; # 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 ) = @_; @@ -115,6 +112,8 @@ inherits from FS::Record. The following fields are currently supported: =item last_bill - last bill date +=item adjourn - date + =item susp - date =item expire - date @@ -126,9 +125,11 @@ inherits from FS::Record. The following fields are currently supported: =item manual_flag - If this field is set to 1, disables the automatic unsuspension of this package when using the B config file. +=item quantity - If not set, defaults to 1 + =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. Also see L and L for conversion functions. @@ -179,7 +180,7 @@ sub insert { 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; @@ -216,9 +217,11 @@ sub insert { 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. @@ -230,6 +233,21 @@ sub insert { } } + 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; ''; @@ -253,7 +271,7 @@ the customer ever purchased the item. Instead, see the cancel method. 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. @@ -270,8 +288,12 @@ Calls =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; @@ -295,6 +317,18 @@ sub replace { 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 ) { @@ -309,7 +343,9 @@ sub replace { } - my $error = $new->SUPER::replace($old); + my $error = $new->SUPER::replace($old, + $options{options} ? ${options{options}} : () + ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -350,6 +386,8 @@ sub check { || $self->ut_numbern('bill') || $self->ut_numbern('susp') || $self->ut_numbern('cancel') + || $self->ut_numbern('adjourn') + || $self->ut_numbern('expire') ; return $error if $error; @@ -389,7 +427,7 @@ sub check { } $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') ) { @@ -431,30 +469,39 @@ 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 } ) + #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"; } } # Add a credit for remaining service my $remaining_value = $self->calc_remain(); if ( $remaining_value > 0 ) { + 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; @@ -467,7 +514,7 @@ sub cancel { 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; @@ -483,7 +530,7 @@ sub cancel { 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? @@ -503,7 +550,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'; @@ -517,6 +564,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 } ) ) { @@ -544,7 +599,7 @@ sub suspend { 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; @@ -559,7 +614,8 @@ sub suspend { =item unsuspend [ OPTION => VALUE ... ] Unsuspends all services (see L and L) 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. @@ -616,13 +672,17 @@ sub unsuspend { my %hash = $self->hash; my $inactive = time - $hash{'susp'}; + my $conf = new FS::Conf; + $hash{'bill'} = ( $hash{'bill'} || $hash{'setup'} ) + $inactive - if $opt{'adjust_next_bill'} + 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; @@ -652,6 +712,34 @@ sub last_bill { $cust_bill_pkg ? $cust_bill_pkg->sdate : $self->setup || 0; } +=item last_cust_pkg_reason + +Returns the most recent FS::reason associated with the package. + +=cut + +sub last_cust_pkg_reason { + my $self = shift; + qsearchs( { + 'table' => 'cust_pkg_reason', + 'hashref' => { 'pkgnum' => $self->pkgnum, }, + 'extra_sql'=> "AND date <= ". time, + 'order_by' => 'ORDER BY date DESC LIMIT 1', + } ); +} + +=item last_reason + +Returns the most recent FS::reason associated with the package. + +=cut + +sub last_reason { + my $cust_pkg_reason = shift->last_cust_pkg_reason; + $cust_pkg_reason->reason + if $cust_pkg_reason; +} + =item part_pkg Returns the definition for this billing item, as an FS::part_pkg object (see @@ -667,6 +755,18 @@ sub part_pkg { : 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 of the FS::part_pkg object associated with this billing @@ -715,6 +815,17 @@ sub calc_cancel { $self->part_pkg->calc_cancel($self, @_); } +=item cust_bill_pkg + +Returns any invoice line items for this package (see L). + +=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 @@ -741,6 +852,19 @@ sub cust_svc { } +=item overlimit [ SVCPART ] + +Returns the services for this package which have exceeded their +usage limit as FS::cust_svc objects (see L). 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 @@ -796,7 +920,7 @@ sub num_cust_svc { =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, which specifies the number of available services. @@ -814,6 +938,87 @@ sub available_part_svc { $self->part_pkg->pkg_svc; } +=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 +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: @@ -1038,6 +1243,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. @@ -1115,11 +1332,8 @@ sub transfer { 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'} ) { @@ -1138,11 +1352,9 @@ sub transfer { 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 { @@ -1275,6 +1487,272 @@ sub cancel_sql { "cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0"; } +=item search_sql HASHREF + +(Class method) + +Returns a qsearch hash expression to search for parameters specified in HASHREF. +Valid parameters are + +=over 4 + +=item agentnum + +=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 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 + +sub search_sql { + my ($class, $params) = @_; + my @where = (); + + ## + # parse agent + ## + + if ( $params->{'agentnum'} =~ /^(\d+)$/ and $1 ) { + push @where, + "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; + }else{ + push @where, "1=0"; + } + }else{ + push @where, $FS::CurrentUser::CurrentUser->agentnums_sql; + } + + 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 @@ -1325,9 +1803,17 @@ sub order { 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. @@ -1387,6 +1873,100 @@ sub order { ''; } +=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) 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) are moved to the +new billing items. An error is returned if this is not possible (see +L). + +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->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). 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