X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=2c7550633a98726dc2e467e34455431e3bf293a9;hp=661625725850d58c810ef5cc1ecf8eae1923556a;hb=44dcd4a1ff335a85a6babf0e007be57e6ec4f525;hpb=7d38afc8a7175c836721400f3b08f84f1c20ea4f diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 661625725..2c7550633 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -8,7 +8,7 @@ use base qw( FS::cust_pkg::Search FS::cust_pkg::API use strict; use Carp qw(cluck); use Scalar::Util qw( blessed ); -use List::Util qw(min max); +use List::Util qw(min max sum); use Tie::IxHash; use Time::Local qw( timelocal timelocal_nocheck ); use MIME::Entity; @@ -533,6 +533,7 @@ sub delete { # cust_bill_pay.pkgnum (wtf, shouldn't reference pkgnum) # cust_pkg_usage.pkgnum # cust_pkg.uncancel_pkgnum, change_pkgnum, main_pkgnum, and change_to_pkgnum + # rt_field_charge.pkgnum # cust_svc is handled by canceling the package before deleting it # cust_pkg_option is handled via option_Common @@ -1773,50 +1774,94 @@ sub credit_remaining { my $conf = FS::Conf->new; my $reason_type = $conf->config($mode.'_credit_type'); - my $last_bill = $self->getfield('last_bill') || 0; - my $next_bill = $self->getfield('bill') || 0; - if ( $last_bill > 0 # the package has been billed - and $next_bill > 0 # the package has a next bill date - and $next_bill >= $time # which is in the future - ) { - my @cust_credit_source_bill_pkg = (); - my $remaining_value = 0; + $time ||= time; - my $remain_pkg = $self; - $remaining_value = $remain_pkg->calc_remain( - 'time' => $time, - 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, - ); + my $remain_pkg = $self; + my (@billpkgnums, @amounts, @setuprecurs); + + # we may have to walk back past some package changes to get to the + # one that actually has unused time. loop until that happens, or we + # reach the first package in the chain. + while (1) { + my $last_bill = $remain_pkg->get('last_bill') || 0; + my $next_bill = $remain_pkg->get('bill') || 0; + if ( $last_bill > 0 # the package has been billed + and $next_bill > 0 # the package has a next bill date + and $next_bill >= $time # which is in the future + ) { + + # Find actual charges for the period ending on or after the cancel + # date. + my @charges = qsearch('cust_bill_pkg', { + pkgnum => $remain_pkg->pkgnum, + edate => {op => '>=', value => $time}, + recur => {op => '>' , value => 0}, + }); + + foreach my $cust_bill_pkg (@charges) { + # hack to deal with the weird behavior of edate on package + # cancellation + my $edate = $cust_bill_pkg->edate; + if ( $self->recur_temporality eq 'preceding' ) { + $edate = $self->add_freq($cust_bill_pkg->sdate); + } + + # this will also get any package charges that are _entirely_ after + # the cancellation date (can happen with advance billing). in that + # case, use the entire recurring charge: + my $amount = $cust_bill_pkg->recur - $cust_bill_pkg->usage; + + # but if the cancellation happens during the interval, prorate it: + # (XXX obey prorate_round_day here?) + if ( $cust_bill_pkg->sdate < $time ) { + $amount = $amount * + ($edate - $time) / ($edate - $cust_bill_pkg->sdate); + } + + $amount = sprintf('%.2f', $amount); + + push @billpkgnums, $cust_bill_pkg->billpkgnum; + push @amounts, $amount; + push @setuprecurs, 'recur'; + + warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n" + if $DEBUG; - # we may have to walk back past some package changes to get to the - # one that actually has unused time - while ( $remaining_value == 0 ) { - if ( $remain_pkg->change_pkgnum ) { - $remain_pkg = FS::cust_pkg->by_key($remain_pkg->change_pkgnum); - } else { - # the package has really never been billed - return; } - $remaining_value = $remain_pkg->calc_remain( - 'time' => $time, - 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, - ); + + last if @charges; } - if ( $remaining_value > 0 ) { - warn "Crediting for $remaining_value on package ".$self->pkgnum."\n" - if $DEBUG; - my $error = $self->cust_main->credit( - $remaining_value, - 'Credit for unused time on '. $self->part_pkg->pkg, - 'reason_type' => $reason_type, - 'cust_credit_source_bill_pkg' => \@cust_credit_source_bill_pkg, - ); - return "Error crediting customer \$$remaining_value for unused time". - " on ". $self->part_pkg->pkg. ": $error" - if $error; - } #if $remaining_value - } #if $last_bill, etc. + if ( my $changed_from_pkgnum = $remain_pkg->change_pkgnum ) { + $remain_pkg = FS::cust_pkg->by_key($changed_from_pkgnum); + } else { + # the package has really never been billed + return; + } + } + + # keep traditional behavior here. + local $@; + my $reason = FS::reason->new_or_existing( + reason => 'Credit for unused time on '. $self->part_pkg->pkg, + type => $reason_type, + class => 'R', + ); + if ( $@ ) { + return "failed to set credit reason: $@"; + } + + my $error = FS::cust_credit->credit_lineitems( + 'billpkgnums' => \@billpkgnums, + 'setuprecurs' => \@setuprecurs, + 'amounts' => \@amounts, + 'custnum' => $self->custnum, + 'date' => time, + 'reasonnum' => $reason->reasonnum, + 'apply' => 1, + 'set_source' => 1, + ); + ''; } @@ -2277,10 +2322,22 @@ sub change { $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum; } + # figure out if we're changing pkgpart + if ( $opt->{'cust_pkg'} ) { + $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart; + } + + # whether to override pkgpart checking on the new package + my $same_pkgpart = 1; + if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) { + $same_pkgpart = 0; + } + # Before going any further here: if the package is still in the pre-setup # state, it's safe to modify it in place. No need to charge/credit for - # partial period, transfer services, transfer usage pools, copy invoice - # details, or change any dates. + # partial period, transfer usage pools, copy invoice details, or change any + # dates. We DO need to "transfer" services (from the package to itself) to + # check their validity on the new pkgpart. if ( ! $self->setup and ! $opt->{cust_pkg} and ! $opt->{cust_main} ) { foreach ( qw( locationnum pkgpart quantity refnum salesnum ) ) { if ( length($opt->{$_}) ) { @@ -2289,20 +2346,50 @@ sub change { } # almost. if the new pkgpart specifies start/adjourn/expire timers, # apply those. - if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) { + if ( !$same_pkgpart ) { $error ||= $self->set_initial_timers; } # but if contract_end was explicitly specified, that overrides all else $self->set('contract_end', $opt->{'contract_end'}) if $opt->{'contract_end'}; + $error ||= $self->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; return "modifying package: $error"; - } else { - $dbh->commit if $oldAutoCommit; - return $self; } + + # check/convert services (only on pkgpart change, to avoid surprises + # when editing locations) + # (maybe do this if changing quantity?) + if ( !$same_pkgpart ) { + + $error = $self->transfer($self); + + if ( $error and $error == 0 ) { + $error = "transferring $error"; + } elsif ( $error > 0 && $conf->exists('cust_pkg-change_svcpart') ) { + warn "trying transfer again with change_svcpart option\n" if $DEBUG; + $error = $self->transfer($self, 'change_svcpart'=>1 ); + if ($error and $error == 0) { + $error = "converting $error"; + } + } + + if ($error > 0) { + $error = "unable to transfer all services"; + } + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } # done transferring services + + $dbh->commit if $oldAutoCommit; + return $self; + } my %hash = (); @@ -2315,18 +2402,6 @@ sub change { $hash{"change_$_"} = $self->$_() foreach qw( pkgnum pkgpart locationnum ); - if ( $opt->{'cust_pkg'} ) { - # treat changing to a package with a different pkgpart as a - # pkgpart change (because it is) - $opt->{'pkgpart'} = $opt->{'cust_pkg'}->pkgpart; - } - - # whether to override pkgpart checking on the new package - my $same_pkgpart = 1; - if ( $opt->{'pkgpart'} and ( $opt->{'pkgpart'} != $self->pkgpart ) ) { - $same_pkgpart = 0; - } - my $unused_credit = 0; my $keep_dates = $opt->{'keep_dates'}; @@ -2529,6 +2604,21 @@ sub change { return "transferring package notes: $error"; } } + + # transfer scheduled expire/adjourn reasons + foreach my $action ('expire', 'adjourn') { + if ( $cust_pkg->get($action) ) { + my $reason = $self->last_cust_pkg_reason($action); + if ( $reason ) { + $reason->set('pkgnum', $cust_pkg->pkgnum); + $error = $reason->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "transferring $action reason: $error"; + } + } + } + } my @new_supp_pkgs; @@ -2609,6 +2699,19 @@ sub change { return "canceling old package: $error"; } + # transfer rt_field_charge, if we're not changing pkgpart + # after billing of old package, before billing of new package + if ( $same_pkgpart ) { + foreach my $rt_field_charge ($self->rt_field_charge) { + $rt_field_charge->set('pkgnum', $cust_pkg->pkgnum); + $error = $rt_field_charge->replace; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "transferring rt_field_charge: $error"; + } + } + } + if ( $conf->exists('cust_pkg-change_pkgpart-bill_now') ) { #$self->cust_main my $error = $cust_pkg->cust_main->bill( @@ -3953,23 +4056,27 @@ sub labels { map { [ $_->label ] } $self->cust_svc; } -=item h_labels END_TIMESTAMP [ START_TIMESTAMP ] [ MODE ] +=item h_labels END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ] Like the labels method, but returns historical information on services that were active as of END_TIMESTAMP and (optionally) not cancelled before START_TIMESTAMP. If MODE is 'I' (for 'invoice'), services with the I flag will be omitted. -Returns a list of lists, calling the label method for all (historical) services -(see L) of this billing item. +If LOCALE is passed, service definition names will be localized. + +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; - warn "$me _h_labels called on $self\n" + my ($end, $start, $mode, $locale) = @_; + warn "$me h_labels\n" if $DEBUG; - map { [ $_->label(@_) ] } $self->h_cust_svc(@_); + map { [ $_->label($end, $start, $locale) ] } + $self->h_cust_svc($end, $start, $mode); } =item labels_short @@ -3982,15 +4089,15 @@ individual services rather than individual items. =cut sub labels_short { - shift->_labels_short( 'labels', @_ ); + shift->_labels_short( 'labels' ); # 'labels' takes no further arguments } -=item h_labels_short END_TIMESTAMP [ START_TIMESTAMP ] +=item h_labels_short END_TIMESTAMP [, START_TIMESTAMP [, MODE [, LOCALE ] ] ] Like h_labels, except returns a simple flat list, and shortens long -(currently >5 or the cust_bill-max_same_services configuration value) lists of -identical services to one line that lists the service label and the number of -individual services rather than individual items. +(currently >5 or the cust_bill-max_same_services configuration value) lists +of identical services to one line that lists the service label and the +number of individual services rather than individual items. =cut @@ -3998,6 +4105,9 @@ sub h_labels_short { shift->_labels_short( 'h_labels', @_ ); } +# takes a method name ('labels' or 'h_labels') and all its arguments; +# maybe should be "shorten($self->h_labels( ... ) )" + sub _labels_short { my( $self, $method ) = ( shift, shift );