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;
# for modify_charge
use FS::cust_credit;
+use Data::Dumper;
+
# temporary fix; remove this once (un)suspend admin notices are cleaned up
use FS::Misc qw(send_email);
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;
+ my $max_credit = $amount
+ - $cust_bill_pkg->credited('', '', setuprecur => 'recur') || 0;
+
+ # 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);
+ }
+
+ # if there are existing credits, don't let the sum of credits exceed
+ # the recurring charge
+ $amount = $max_credit if $amount > $max_credit;
+
+ $amount = sprintf('%.2f', $amount);
+
+ # if no time has been used and/or there are existing line item
+ # credits, we may end up not needing to credit anything.
+ if ( $amount > 0 ) {
+
+ 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,
+ );
+
'';
}
$same_pkgpart = 0;
}
+ $self->set('waive_setup', $opt->{'waive_setup'}) if $opt->{'waive_setup'};
+
# 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 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 ) ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum waive_setup ) ) {
if ( length($opt->{$_}) ) {
$self->set($_, $opt->{$_});
}
$pkg_opt_modified = 1;
}
}
- $pkg_opt_modified = 1 if (scalar(@old_additional) - 1) != $i;
+ $pkg_opt_modified = 1 if scalar(@old_additional) != $i;
$pkg_opt{'additional_count'} = $i if $i > 0;
my $old_classnum;
'';
}
-
-
-use Data::Dumper;
sub process_bulk_cust_pkg {
my $job = shift;
my $param = shift;
$target{$pkg_svc->svcpart} = $pkg_svc->quantity * ( $dest->quantity || 1 );
}
- foreach my $cust_svc ($dest->cust_svc) {
- $target{$cust_svc->svcpart}--;
+ unless ( $self->pkgnum == $dest->pkgnum ) {
+ foreach my $cust_svc ($dest->cust_svc) {
+ $target{$cust_svc->svcpart}--;
+ }
}
my %svcpart2svcparts = ();
my $error;
foreach my $cust_svc ($self->cust_svc) {
my $svcnum = $cust_svc->svcnum;
- if($target{$cust_svc->svcpart} > 0
- or $FS::cust_svc::ignore_quantity) { # maybe should be a 'force' option
+
+ if ( $target{$cust_svc->svcpart} > 0
+ or $FS::cust_svc::ignore_quantity # maybe should be a 'force' option
+ )
+ {
$target{$cust_svc->svcpart}--;
+
+ local $FS::cust_svc::ignore_quantity = 1
+ if $self->pkgnum == $dest->pkgnum;
+
+ #why run replace at all in the $self->pkgnum == $dest->pkgnum case?
+ # we do want to trigger location and pkg_change exports, but
+ # without pkgnum changing from an old to new package, cust_svc->replace
+ # doesn't know how to trigger those. :/
+ # does this mean we scrap the whole idea of "safe to modify it in place",
+ # or do we special-case and pass the info needed to cust_svc->replace? :/
+
my $new = new FS::cust_svc { $cust_svc->hash };
$new->pkgnum($dest_pkgnum);
$error = $new->replace($cust_svc);
+
} elsif ( exists $opt{'change_svcpart'} && $opt{'change_svcpart'} ) {
+
if ( $DEBUG ) {
warn "looking for alternates for svcpart ". $cust_svc->svcpart. "\n";
warn "alternates to consider: ".
join(', ', @{$svcpart2svcparts{$cust_svc->svcpart}}). "\n";
}
+
my @alternate = grep {
warn "considering alternate svcpart $_: ".
"$target{$_} available in new package\n"
if $DEBUG;
$target{$_} > 0;
} @{$svcpart2svcparts{$cust_svc->svcpart}};
+
if ( @alternate ) {
warn "alternate(s) found\n" if $DEBUG;
my $change_svcpart = $alternate[0];
} else {
$remaining++;
}
+
} else {
$remaining++
}
+
if ( $error ) {
my @label = $cust_svc->label;
return "$label[0] $label[1]: $error";
}
+
}
return $remaining;
}
"cust_pkg.cancel IS NOT NULL AND cust_pkg.cancel != 0";
}
+=item ncancelled_recurring_sql
+
+Returns an SQL expression identifying un-cancelled, recurring packages.
+
+=cut
+
+sub ncancelled_recurring_sql {
+ $_[0]->recurring_sql().
+ " AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) ";
+}
+
=item status_sql
Returns an SQL expression to give the package status as a string.
return %email;
}
+# Used by FS::Upgrade to migrate to a new database.
+sub _upgrade_schema { # class method
+ my ($class, %opts) = @_;
+
+ my $sql = '
+ UPDATE cust_pkg SET change_to_pkgnum = NULL
+ WHERE change_to_pkgnum IS NOT NULL
+ AND NOT EXISTS ( SELECT 1 FROM cust_pkg AS ctcp
+ WHERE ctcp.pkgnum = cust_pkg.change_to_pkgnum
+ )
+ ';
+
+ my $sth = dbh->prepare($sql) or die dbh->errstr;
+ $sth->execute or die $sth->errstr;
+ '';
+}
+
# Used by FS::Upgrade to migrate to a new database.
sub _upgrade_data { # class method
my ($class, %opts) = @_;
my $error = $part_pkg_link->remove_linked;
die $error if $error;
}
+
+ # RT#73607: canceling a package with billing addons sometimes changes its
+ # pkgpart.
+ # Find records where the last replace_new record for the package before it
+ # was canceled has a different pkgpart from the package itself.
+ my @cust_pkg = qsearch({
+ 'table' => 'cust_pkg',
+ 'select' => 'cust_pkg.*, h_cust_pkg.pkgpart AS h_pkgpart',
+ 'addl_from' => ' JOIN (
+ SELECT pkgnum, MAX(historynum) AS historynum FROM h_cust_pkg
+ WHERE cancel IS NULL
+ AND history_action = \'replace_new\'
+ GROUP BY pkgnum
+ ) AS last_history USING (pkgnum)
+ JOIN h_cust_pkg USING (historynum)',
+ 'extra_sql' => ' WHERE cust_pkg.cancel is not null
+ AND cust_pkg.pkgpart != h_cust_pkg.pkgpart'
+ });
+ foreach my $cust_pkg ( @cust_pkg ) {
+ my $pkgnum = $cust_pkg->pkgnum;
+ warn "fixing pkgpart on canceled pkg#$pkgnum\n";
+ $cust_pkg->set('pkgpart', $cust_pkg->h_pkgpart);
+ my $error = $cust_pkg->replace;
+ die $error if $error;
+ }
+
}
=back