X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=ea959ab1164a3a98bb950d2a1a149b80622e43e4;hb=260c76262745d1a96e7533e1a8498e6a582b2c3d;hp=630e88ea7929ee26e564061eceb98a5741ed7ad6;hpb=b81d94452ba28c79036ab417bd32df54a583f324;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 630e88ea7..ea959ab11 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1,20 +1,28 @@ 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::Record qw( qsearch qsearchs ); use FS::Misc qw( send_email ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_main_Mixin; use FS::cust_svc; use FS::part_pkg; use FS::cust_main; use FS::type_pkgs; 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; # 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; @@ -23,20 +31,12 @@ use FS::svc_forward; # for sending cancel emails in sub cancel use FS::Conf; -@ISA = qw( 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 ) = @_; @@ -139,8 +139,14 @@ Create a new billing item. To add the item to the database, see L<"insert">. =cut sub table { 'cust_pkg'; } +sub cust_linked { $_[0]->cust_main_custnum; } +sub cust_unlinked_msg { + my $self = shift; + "WARNING: can't find cust_main.custnum ". $self->custnum. + ' (cust_pkg.pkgnum '. $self->pkgnum. ')'; +} -=item insert +=item insert [ OPTION => VALUE ... ] Adds this billing item to the database ("Orders" the item). If there is an error, returns the error, otherwise returns false. @@ -149,6 +155,82 @@ If the additional field I is defined instead of I, it will be used to look up the package definition and agent restrictions will be ignored. +The following options are available: I + +I, if set true, supresses any referral credit to a referring customer. + +=cut + +sub insert { + my( $self, %options ) = @_; + + 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 $error = $self->SUPER::insert($options{options} ? %{$options{options}} : ()); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #if ( $self->reg_code ) { + # my $reg_code = qsearchs('reg_code', { 'code' => $self->reg_code } ); + # $error = $reg_code->delete; + # if ( $error ) { + # $dbh->rollback if $oldAutoCommit; + # return $error; + # } + #} + + my $conf = new FS::Conf; + my $cust_main = $self->cust_main; + my $part_pkg = $self->part_pkg; + if ( $conf->exists('referral_credit') + && $cust_main->referral_custnum + && ! $options{'change'} + && $part_pkg->freq !~ /^0\D?$/ + ) + { + my $referring_cust_main = $cust_main->referring_cust_main; + if ( $referring_cust_main->status ne 'cancelled' ) { + my $error; + if ( $part_pkg->freq !~ /^\d+$/ ) { + warn 'WARNING: Not crediting customer '. $cust_main->referral_custnum. + ' for package '. $self->pkgnum. + ' ( customer '. $self->custnum. ')'. + ' - One-time referral credits not (yet) available for '. + ' packages with '. $part_pkg->freq_pretty. ' frequency'; + } else { + + my $amount = sprintf( "%.2f", $part_pkg->base_recur / $part_pkg->freq ); + my $error = + $referring_cust_main->credit( $amount, + 'Referral credit for '. $cust_main->name + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error crediting customer ". $cust_main->referral_custnum. + " for referral: $error"; + } + + } + + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item delete This method now works but you probably shouldn't use it. @@ -179,11 +261,17 @@ suspend is normally updated by the suspend and unsuspend methods. cancel is normally updated by the cancel method (and also the order subroutine in some cases). +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; @@ -196,7 +284,63 @@ sub replace { local($disable_agentcheck) = 1 if $old->pkgpart == $new->pkgpart; - $new->SUPER::replace($old); + 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; + + 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 ) { + + #also check for specific exports? + # to avoid spurious modify export events + @svc_acct = map { $_->svc_x } + grep { $_->part_svc->svcdb eq 'svc_acct' } + $old->cust_svc; + + $_->snapshot foreach @svc_acct; + + } + + my $error = $new->SUPER::replace($old, + $options{options} ? ${options{options}} : () + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + #for prepaid packages, + #trigger export of new RADIUS Expiration attribute when cust_pkg.bill changes + foreach my $old_svc_acct ( @svc_acct ) { + my $new_svc_acct = new FS::svc_acct { $old_svc_acct->hash }; + my $s_error = $new_svc_acct->replace($old_svc_acct); + if ( $s_error ) { + $dbh->rollback if $oldAutoCommit; + return $s_error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + } =item check @@ -221,7 +365,17 @@ sub check { ; return $error if $error; - if ( $self->promo_code ) { + if ( $self->reg_code ) { + + unless ( grep { $self->pkgpart == $_->pkgpart } + map { $_->reg_code_pkg } + qsearchs( 'reg_code', { 'code' => $self->reg_code, + 'agentnum' => $self->cust_main->agentnum }) + ) { + return "Unknown registration code"; + } + + } elsif ( $self->promo_code ) { my $promo_part_pkg = qsearchs('part_pkg', { @@ -229,7 +383,6 @@ sub check { 'promo_code' => { op=>'ILIKE', value=>$self->promo_code }, } ); return 'Unknown promotional code' unless $promo_part_pkg; - $self->pkgpart($promo_part_pkg->pkgpart); } else { @@ -290,29 +443,50 @@ 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 $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') ) { 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; @@ -322,7 +496,7 @@ sub cancel { $dbh->commit or die $dbh->errstr if $oldAutoCommit; my $conf = new FS::Conf; - my @invoicing_list = grep { $_ ne 'POST' } $self->cust_main->invoicing_list; + my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list; if ( !$options{'quiet'} && $conf->exists('emailcancel') && @invoicing_list ) { my $conf = new FS::Conf; my $error = send_email( @@ -348,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'; @@ -362,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 } ) ) { @@ -389,7 +571,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; @@ -401,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'; @@ -451,11 +642,17 @@ 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); + $error = $new->replace( $self, options => { $self->options } ); if ( $error ) { $dbh->rollback if $oldAutoCommit; return $error; @@ -485,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 @@ -524,6 +738,41 @@ sub calc_recur { $self->part_pkg->calc_recur($self, @_); } +=item calc_remain + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_remain { + my $self = shift; + $self->part_pkg->calc_remain($self, @_); +} + +=item calc_cancel + +Calls the I of the FS::part_pkg object associated with this +billing item. + +=cut + +sub calc_cancel { + my $self = shift; + $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 @@ -543,21 +792,50 @@ sub cust_svc { #if ( $self->{'_svcnum'} ) { # values %{ $self->{'_svcnum'}->cache }; #} else { - map { $_->[0] } - sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } - map { - my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, - 'svcpart' => $_->svcpart } ); - [ $_, - $pkg_svc ? $pkg_svc->primary_svc : '', - $pkg_svc ? $pkg_svc->quantity : 0, - ]; - } - qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ); + $self->_sort_cust_svc( + [ qsearch( 'cust_svc', { 'pkgnum' => $self->pkgnum } ) ] + ); #} } +=item h_cust_svc END_TIMESTAMP [ START_TIMESTAMP ] + +Returns historical services for this package created before END TIMESTAMP and +(optionally) not cancelled before START_TIMESTAMP, as FS::h_cust_svc objects +(see L). + +=cut + +sub h_cust_svc { + my $self = shift; + + $self->_sort_cust_svc( + [ qsearch( 'h_cust_svc', + { 'pkgnum' => $self->pkgnum, }, + FS::h_cust_svc->sql_h_search(@_), + ) + ] + ); +} + +sub _sort_cust_svc { + my( $self, $arrayref ) = @_; + + map { $_->[0] } + sort { $b->[1] cmp $a->[1] or $a->[2] <=> $b->[2] } + map { + my $pkg_svc = qsearchs( 'pkg_svc', { 'pkgpart' => $self->pkgpart, + 'svcpart' => $_->svcpart } ); + [ $_, + $pkg_svc ? $pkg_svc->primary_svc : '', + $pkg_svc ? $pkg_svc->quantity : 0, + ]; + } + @$arrayref; + +} + =item num_cust_svc [ SVCPART ] Returns the number of provisioned services for this package. If a svcpart is @@ -576,7 +854,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. @@ -594,6 +872,154 @@ sub available_part_svc { $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: + +=over 4 + +=item not yet billed + +=item one-time charge + +=item active + +=item suspended + +=item cancelled + +=back + +=cut + +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 $freq =~ /^(0|$)/; + return 'active'; +} + +=item statuses + +Class method that returns the list of possible status strings for pacakges +(see L). For example: + + @statuses = FS::cust_pkg->statuses(); + +=cut + +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}; +} + =item labels Returns a list of lists, calling the label method for all services @@ -606,6 +1032,52 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } +=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] + +Like the labels method, but returns historical information on services that +were active as of END_TIMESTAMP and (optionally) not cancelled before +START_TIMESTAMP. + +Returns a list of lists, calling the label method for all (historical) services +(see L) of this billing item. + +=cut + +sub h_labels { + my $self = shift; + map { [ $_->label(@_) ] } $self->h_cust_svc(@_); +} + +=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] + +Like h_labels, except returns a simple flat list, and shortens long +(currently >5) lists of identical services to one line that lists the service +label and the number of individual services rather than individual items. + +=cut + +sub h_labels_short { + my $self = shift; + + my %labels; + #tie %labels, 'Tie::IxHash'; + push @{ $labels{$_->[0]} }, $_->[1] + foreach $self->h_labels(@_); + my @labels; + foreach my $label ( keys %labels ) { + my @values = @{ $labels{$label} }; + my $num = scalar(@values); + if ( $num > 5 ) { + push @labels, "$label ($num)"; + } else { + push @labels, map { "$label: $_" } @values; + } + } + + @labels; + +} + =item cust_main Returns the parent customer object (see L). @@ -862,6 +1334,86 @@ sub reexport { =back +=head1 CLASS METHODS + +=over 4 + +=item recurring_sql + +Returns an SQL expression identifying recurring packages. + +=cut + +sub recurring_sql { " + '0' != ( select freq from part_pkg + 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. + +=cut + +sub active_sql { " + ". $_[0]->recurring_sql(). " + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + 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 + +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 + "; +} + +=item cancel_sql +=item cancelled_sql + +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"; +} + =head1 SUBROUTINES =over 4 @@ -906,12 +1458,24 @@ sub order { my $cust_main = qsearchs('cust_main', { custnum => $custnum }); return "Customer not found: $custnum" unless $cust_main; + my @old_cust_pkg = map { qsearchs('cust_pkg', { pkgnum => $_ }) } + @$remove_pkgnum; + + my $change = scalar(@old_cust_pkg) != 0; + + my %hash = (); + if ( scalar(@old_cust_pkg) == 1 ) { + #$hash{$_} = $old_cust_pkg[0]->$_() foreach qw( last_bill bill ); + $hash{'setup'} = time; + } + # Create the new packages. - my $cust_pkg; - foreach (@$pkgparts) { - $cust_pkg = new FS::cust_pkg { custnum => $custnum, - pkgpart => $_ }; - $error = $cust_pkg->insert; + foreach my $pkgpart (@$pkgparts) { + my $cust_pkg = new FS::cust_pkg { custnum => $custnum, + pkgpart => $pkgpart, + %hash, + }; + $error = $cust_pkg->insert( 'change' => $change ); if ($error) { $dbh->rollback if $oldAutoCommit; return $error; @@ -922,8 +1486,7 @@ sub order { # created packages. # Transfer services and cancel old packages. - foreach my $old_pkgnum (@$remove_pkgnum) { - my $old_pkg = qsearchs ('cust_pkg', { pkgnum => $old_pkgnum }); + foreach my $old_pkg (@old_cust_pkg) { foreach my $new_pkg (@$return_cust_pkg) { $error = $old_pkg->transfer($new_pkg); @@ -953,7 +1516,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; @@ -963,6 +1526,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