use vars qw( $disable_agentcheck $DEBUG $me $upgrade );
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;
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.
+either a reasonnum of an existing reason, or a hashref to 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.
+
+If this argument isn't given or is a false value, then the package will be
+canceled with no reason.
=item date - can be set to a unix style timestamp to specify when to
cancel (expire)
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
return '' if $date; #no errors
- my @invoicing_list = grep { $_ !~ /^(POST|FAX)$/ } $self->cust_main->invoicing_list;
- if ( !$options{'quiet'} &&
- $conf->exists('emailcancel', $self->cust_main->agentnum) &&
- @invoicing_list ) {
- my $msgnum = $conf->config('cancel_msgnum', $self->cust_main->agentnum);
+ my $cust_main = $self->cust_main;
+
+ my @invoicing_list = $cust_main->invoicing_list_emailonly;
+ if ( !$options{'quiet'}
+ && $conf->config_bool('emailcancel', $cust_main->agentnum)
+ && @invoicing_list
+ )
+ {
+ my $msgnum = $conf->config('cancel_msgnum', $cust_main->agentnum);
my $error = '';
if ( $msgnum ) {
my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send( 'cust_main' => $self->cust_main,
- 'object' => $self );
- }
- else {
+ $error = $msg_template->send(
+ 'cust_main' => $cust_main,
+ 'object' => $self,
+ );
+ } else {
$error = send_email(
'from' => $conf->invoice_from_full( $self->cust_main->agentnum ),
'to' => \@invoicing_list,
#should this do something on errors?
}
+ my %pkg_class = map { $_=>1 }
+ $conf->config('cancel_msgnum-referring_cust-pkg_class');
+ my $ref_msgnum = $conf->config('cancel_msgnum-referring_cust');
+ if ( !$options{'quiet'}
+ && $cust_main->referral_custnum
+ && $pkg_class{ $self->classnum }
+ && $ref_msgnum
+ )
+ {
+ my $msg_template = qsearchs('msg_template', { msgnum => $ref_msgnum });
+ my $error = $msg_template->send(
+ 'cust_main' => $cust_main->referring_cust_main,
+ 'object' => $self,
+ );
+ #should this do something on errors?
+ }
+
''; #no errors
}
=cut
+# XXX should look for an expire reason
+# but seems to be unused; this is now handled more holistically in
+# cust_main::Billing
+
sub cancel_if_expired {
my $self = shift;
my $time = shift || time;
For cancelled cust_pkg, returns a list of new, uninserted FS::svc_X records
for services that would be inserted by L</uncancel>. Returned objects also
-include the field '_uncancel_svcnum' that contains the original svcnum.
+include the field _h_svc_x, which contains the service history object.
+
Set pkgnum before inserting.
Accepts the following options:
-summarize_size - if true, returns empty list if number of potential services is
-equal to or greater than this
-
only_svcnum - arrayref of svcnum, only returns objects for these svcnum
(and only if they would otherwise be returned by this)
my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
my @h_cust_svc = $self->h_cust_svc( $end, $start );
- return () if $opt{'summarize_size'} and @h_cust_svc >= $opt{'summarize_size'};
-
my @svc_x;
foreach my $h_cust_svc (@h_cust_svc) {
next if $opt{'only_svcnum'} && !(grep { $_ == $h_cust_svc->svcnum } @{$opt{'only_svcnum'}});
+ # filter out services that still exist on this package (ie preserved svcs)
+ # but keep services that have since been provisioned on another package (for informational purposes)
+ next if qsearchs('cust_svc',{ 'svcnum' => $h_cust_svc->svcnum, 'pkgnum' => $self->pkgnum });
my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
- #next unless $h_svc_x; #should this happen?
+ next unless $h_svc_x; # this probably doesn't happen, but just in case
(my $table = $h_svc_x->table) =~ s/^h_//;
require "FS/$table.pm";
my $class = "FS::$table";
my $svc_x = $class->new( {
'svcpart' => $h_cust_svc->svcpart,
- '_uncancel_svcnum' => $h_cust_svc->svcnum,
+ '_h_svc_x' => $h_svc_x,
map { $_ => $h_svc_x->get($_) } fields($table)
} );
=item uncancel_svc_summary
-Returns an array of hashrefs, one for each service that could be
-successfully reprovisioned by L</uncancel>, with the following keys:
+Returns an array of hashrefs, one for each service that could
+potentially be reprovisioned by L</uncancel>, with the following keys:
svcpart
uncancel_svcnum
-label
+label - from history table if not currently calculable, undefined if it can't be loaded
reprovisionable - 1 if test reprovision succeeded, otherwise 0
+num_cust_svc - number of svcs for this svcpart, only if summarizing (see below)
+
Cannot be run from within a transaction. Performs inserts
to test the results, and then rolls back the transaction.
Does not perform exports, so does not catch if export would fail.
Also accepts the following options:
-summarize_size - if true, returns empty list if number of potential services is
-equal to or greater than this
+no_test_reprovision - skip the test inserts (reprovisionable field will not exist)
+
+summarize_size - if true, returns a single summary record for svcparts with at
+least this many svcs, will have key num_cust_svc but not uncancel_svcnum, label or reprovisionable
=cut
local $FS::svc_Common::noexport_hack = 1; # very important not to run exports!!!
local $FS::UID::AutoCommit = 0;
+ # sort by svcpart, to check summarize_size
+ my $uncancel_svc_x = {};
+ foreach my $svc_x (sort { $a->{'svcpart'} <=> $b->{'svcpart'} } $self->uncancel_svc_x) {
+ $uncancel_svc_x->{$svc_x->svcpart} = [] unless $uncancel_svc_x->{$svc_x->svcpart};
+ push @{$uncancel_svc_x->{$svc_x->svcpart}}, $svc_x;
+ }
+
my @out;
- foreach my $svc_x ($self->uncancel_svc_x(%opt)) {
- $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
- my $part_svc = $svc_x->part_svc;
- my $out = {
- 'svcpart' => $part_svc->svcpart,
- 'svc' => $part_svc->svc,
- 'uncancel_svcnum' => $svc_x->get('_uncancel_svcnum'),
- };
- if ($svc_x->insert) { # if error inserting
- $out->{'label'} = "(cannot re-provision)";
- $out->{'reprovisionable'} = 0;
+ foreach my $svcpart (keys %$uncancel_svc_x) {
+ my @svcpart_svc_x = @{$uncancel_svc_x->{$svcpart}};
+ if ($opt{'summarize_size'} && (@svcpart_svc_x >= $opt{'summarize_size'})) {
+ my $svc_x = $svcpart_svc_x[0]; #grab first one for access to $part_svc
+ my $part_svc = $svc_x->part_svc;
+ push @out, {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'num_cust_svc' => scalar(@svcpart_svc_x),
+ };
} else {
- $out->{'label'} = $svc_x->label;
- $out->{'reprovisionable'} = 1;
+ foreach my $svc_x (@svcpart_svc_x) {
+ my $part_svc = $svc_x->part_svc;
+ my $out = {
+ 'svcpart' => $part_svc->svcpart,
+ 'svc' => $part_svc->svc,
+ 'uncancel_svcnum' => $svc_x->get('_h_svc_x')->svcnum,
+ };
+ $svc_x->pkgnum($self->pkgnum); # provisioning services on a canceled package, will be rolled back
+ my $insert_error;
+ unless ($opt{'no_test_reprovision'}) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $insert_error = $svc_x->insert };
+ $insert_error ||= $@;
+ }
+ if ($opt{'no_test_reprovision'} or $insert_error) {
+ # avoid possibly fatal errors from missing linked records
+ eval { $out->{'label'} = $svc_x->label };
+ eval { $out->{'label'} = $svc_x->get('_h_svc_x')->label } unless defined($out->{'label'});
+ $out->{'reprovisionable'} = 0 unless $opt{'no_test_reprovision'};
+ } else {
+ $out->{'label'} = $svc_x->label;
+ $out->{'reprovisionable'} = 1;
+ }
+ push @out, $out;
+ }
}
- push @out, $out;
}
dbh->rollback;
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 $remaining_value = 0;
+ $time ||= time;
- my $remain_pkg = $self;
- $remaining_value = $remain_pkg->calc_remain('time' => $time);
+ 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);
+
+ 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,
- );
- 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,
+ );
+
'';
}
$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->{$_}) ) {
}
# almost. if the new pkgpart specifies start/adjourn/expire timers,
# apply those.
- if ( $opt->{'pkgpart'} and $opt->{'pkgpart'} != $self->pkgpart ) {
+ if ( !$same_pkgpart ) {
$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 = ();
$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'};
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;
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(
$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 Storable 'thaw';
use MIME::Base64;
use Data::Dumper;
$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 "service $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.
}
###
- # parse refnum (advertising source)
+ # parse (customer) refnum (advertising source)
###
if ( exists($params->{'refnum'}) ) {
@refnum = ( $params->{'refnum'} );
}
my $in = join(',', grep /^\d+$/, @refnum);
- push @where, "refnum IN($in)" if length $in;
+ push @where, "cust_main.refnum IN($in)" if length $in;
}
###
foreach my $field (qw( setup last_bill bill adjourn susp expire contract_end change_date cancel )) {
- next unless exists($params->{$field});
+ if ( $params->{$field.'_null'} ) {
- my($beginning, $ending) = @{$params->{$field}};
+ push @where, "cust_pkg.$field IS NULL";
+ # this should surely be obsoleted by now: OR cust_pkg.$field == 0
- next if $beginning == 0 && $ending == 4294967295;
+ } else {
- push @where,
- "cust_pkg.$field IS NOT NULL",
- "cust_pkg.$field >= $beginning",
- "cust_pkg.$field <= $ending";
-
- $orderby ||= "ORDER BY cust_pkg.$field";
-
- if ( $field eq 'setup' ) {
- $exclude_change_from = 1;
- } elsif ( $field eq 'cancel' ) {
- $exclude_change_to = 1;
- } elsif ( $field eq 'change_date' ) {
- # if we are given setup and change_date ranges, and the setup date
- # falls in _both_ ranges, then include the package whether it was
- # a change or not
- $exclude_change_from = 0;
+ 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";
+
+ if ( $field eq 'setup' ) {
+ $exclude_change_from = 1;
+ } elsif ( $field eq 'cancel' ) {
+ $exclude_change_to = 1;
+ } elsif ( $field eq 'change_date' ) {
+ # if we are given setup and change_date ranges, and the setup date
+ # falls in _both_ ranges, then include the package whether it was
+ # a change or not
+ $exclude_change_from = 0;
+ }
}
+
}
if ($exclude_change_from) {
WHERE cust_pkg.pkgnum = changed_to_pkg.change_pkgnum
)";
}
+
}
$orderby ||= 'ORDER BY bill';
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;
+ }
+
+}
+
+# will autoload in v4+
+sub rt_field_charge {
+ my $self = shift;
+ qsearch('rt_field_charge',{ 'pkgnum' => $self->pkgnum });
}
=back