);
use strict;
-use Carp qw(cluck);
+use Carp qw(cluck croak);
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);
our $cache_enabled = 0;
+our $disable_start_on_hold = 0;
+
sub _simplecache {
my( $self, $hashref ) = @_;
if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) {
=item locationnum
-Optional link to package location (see L<FS::location>)
+Optional link to package location (see L<FS::cust_location>)
=item order_date
$self->start_date( timelocal_nocheck(0,0,0,1,$mon,$year) );
}
- if ($self->susp eq 'now' or $part_pkg->start_on_hold) {
+ if ( $self->susp eq 'now'
+ or ( $part_pkg->start_on_hold && ! $disable_start_on_hold )
+ )
+ {
# if the package was ordered on hold:
# - suspend it
# - don't set the start date (it will be started manually)
my $conf = new FS::Conf;
+ if ($self->locationnum) {
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($self); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
if ( ! $import && $conf->config('ticket_system') && $options{ticket_subject} ) {
#this init stuff is still inefficient, but at least its limited to
# 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
=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.
+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.
=item reason_otaker
}
}
+ # also run exports if removing locationnum?
+ # doesn't seem to happen, and we don't export blank locationnum on insert...
+ if ($new->locationnum and ($new->locationnum != $old->locationnum)) {
+ my $conf = new FS::Conf;
+ my @part_export =
+ map qsearch( 'part_export', {exportnum=>$_} ),
+ $conf->config('cust_location-exports'); #, $agentnum
+
+ foreach my $part_export ( @part_export ) {
+ my $error = $part_export->export_pkg_location($new); #, @$export_args);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "exporting to ". $part_export->exporttype.
+ " (transaction rolled back): $error";
+ }
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
'';
the date. You are PROBABLY looking to expire the account instead of using
this.
-=item reason - can be set to a cancellation reason (see L<FS:reason>),
+=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.
$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 $error = '';
- if ( $msgnum ) {
- my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
- $error = $msg_template->send( 'cust_main' => $self->cust_main,
- 'object' => $self );
- }
+ my $cust_main = $self->cust_main;
+
+ my @invoicing_list = $cust_main->invoicing_list_emailonly;
+ my $msgnum = $conf->config('cancel_msgnum', $cust_main->agentnum);
+ if ( !$options{'quiet'}
+ && $conf->config_bool('emailcancel', $cust_main->agentnum)
+ && @invoicing_list
+ && $msgnum
+ )
+ {
+ my $msg_template = qsearchs('msg_template', { msgnum => $msgnum });
+ my $error = $msg_template->send(
+ 'cust_main' => $cust_main,
+ 'object' => $self,
+ );
+ #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?
}
'';
}
+=item uncancel_svc_x
+
+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 _h_svc_x, which contains the service history object.
+
+Set pkgnum before inserting.
+
+Accepts the following options:
+
+only_svcnum - arrayref of svcnum, only returns objects for these svcnum
+(and only if they would otherwise be returned by this)
+
+=cut
+
+sub uncancel_svc_x {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_x called on a non-cancelled cust_pkg' unless $self->get('cancel');
+
+ #find historical services within this timeframe before the package cancel
+ # (incompatible with "time" option to cust_pkg->cancel?)
+ my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
+ # too little? (unprovisioing export delay?)
+ my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
+ my @h_cust_svc = $self->h_cust_svc( $end, $start );
+
+ 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; # 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,
+ '_h_svc_x' => $h_svc_x,
+ map { $_ => $h_svc_x->get($_) } fields($table)
+ } );
+
+ # radius_usergroup
+ if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
+ $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
+ }
+
+ #these are pretty rare, but should handle them
+ # - dsl_device (mac addresses)
+ # - phone_device (mac addresses)
+ # - dsl_note (ikano notes)
+ # - domain_record (i.e. restore DNS information w/domains)
+ # - inventory_item(?) (inventory w/un-cancelling service?)
+ # - nas (svc_broaband nas stuff)
+ #this stuff is unused in the wild afaik
+ # - mailinglistmember
+ # - router.svcnum?
+ # - svc_domain.parent_svcnum?
+ # - acct_snarf (ancient mail fetching config)
+ # - cgp_rule (communigate)
+ # - cust_svc_option (used by our Tron stuff)
+ # - acct_rt_transaction (used by our time worked stuff)
+
+ push @svc_x, $svc_x;
+ }
+ return @svc_x;
+}
+
+=item uncancel_svc_summary
+
+Returns an array of hashrefs, one for each service that could
+potentially be reprovisioned by L</uncancel>, with the following keys:
+
+svcpart
+
+svc
+
+uncancel_svcnum
+
+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:
+
+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
+
+sub uncancel_svc_summary {
+ my ($self, %opt) = @_;
+
+ die 'uncancel_svc_summary called on a non-cancelled cust_pkg' unless $self->get('cancel');
+ die 'uncancel_svc_summary called from within a transaction' unless $FS::UID::AutoCommit;
+
+ 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 $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 {
+ 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;
+ }
+ }
+ }
+
+ dbh->rollback;
+ return @out;
+}
+
=item uncancel
"Un-cancels" this package: Orders a new package with the same custnum, pkgpart,
svc_errors: pass an array reference, will be filled in with any provisioning errors
+only_svcnum: arrayref, only attempt to re-provision these cancelled services
+
main_pkgnum: link the package as a supplemental package of this one. For
internal use only.
# insert services
##
- #find historical services within this timeframe before the package cancel
- # (incompatible with "time" option to cust_pkg->cancel?)
- my $fuzz = 2 * 60; #2 minutes? too much? (might catch separate unprovision)
- # too little? (unprovisioing export delay?)
- my($end, $start) = ( $self->get('cancel'), $self->get('cancel') - $fuzz );
- my @h_cust_svc = $self->h_cust_svc( $end, $start );
-
my @svc_errors;
- foreach my $h_cust_svc (@h_cust_svc) {
- my $h_svc_x = $h_cust_svc->h_svc_x( $end, $start );
- #next unless $h_svc_x; #should this happen?
- (my $table = $h_svc_x->table) =~ s/^h_//;
- require "FS/$table.pm";
- my $class = "FS::$table";
- my $svc_x = $class->new( {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'svcpart' => $h_cust_svc->svcpart,
- map { $_ => $h_svc_x->get($_) } fields($table)
- } );
-
- # radius_usergroup
- if ( $h_svc_x->isa('FS::h_svc_Radius_Mixin') ) {
- $svc_x->usergroup( [ $h_svc_x->h_usergroup($end, $start) ] );
- }
+ foreach my $svc_x ($self->uncancel_svc_x('only_svcnum' => $options{'only_svcnum'})) {
+ $svc_x->pkgnum($cust_pkg->pkgnum);
my $svc_error = $svc_x->insert;
+
if ( $svc_error ) {
if ( $options{svc_fatal} ) {
$dbh->rollback if $oldAutoCommit;
}
} # svc_fatal
} # svc_error
- } #foreach $h_cust_svc
-
- #these are pretty rare, but should handle them
- # - dsl_device (mac addresses)
- # - phone_device (mac addresses)
- # - dsl_note (ikano notes)
- # - domain_record (i.e. restore DNS information w/domains)
- # - inventory_item(?) (inventory w/un-cancelling service?)
- # - nas (svc_broaband nas stuff)
- #this stuff is unused in the wild afaik
- # - mailinglistmember
- # - router.svcnum?
- # - svc_domain.parent_svcnum?
- # - acct_snarf (ancient mail fetching config)
- # - cgp_rule (communigate)
- # - cust_svc_option (used by our Tron stuff)
- # - acct_rt_transaction (used by our time worked stuff)
+ } #foreach uncancel_svc_x
##
# also move over any services that didn't unprovision at cancellation
=item unexpire
-Cancels any pending expiration (sets the expire field to null).
+Cancels any pending expiration (sets the expire field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unexpire {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
my $oldAutoCommit = $FS::UID::AutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unexpire;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unexpiring supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
=over 4
-=item reason - can be set to a cancellation reason (see L<FS:reason>),
+=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>
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,
+ );
+
'';
}
=item unadjourn
-Cancels any pending suspension (sets the adjourn field to null).
+Cancels any pending suspension (sets the adjourn field to null)
+for this package and any supplemental packages.
If there is an error, returns the error, otherwise returns false.
=cut
sub unadjourn {
- my( $self, %options ) = @_;
+ my( $self ) = @_;
my $error;
my $oldAutoCommit = $FS::UID::AutoCommit;
return $error;
}
+ foreach my $supp_pkg ( $self->supplemental_pkgs ) {
+ $error = $supp_pkg->unadjourn;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "unadjourning supplemental pkg#".$supp_pkg->pkgnum.": $error";
+ }
+ }
+
$dbh->commit or die $dbh->errstr if $oldAutoCommit;
''; #no errors
$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;
+ }
+
+ # Discounts:
+ # When a new discount level is specified in $opt:
+ # If new discountnum matches old discountnum, months_used/end_date are
+ # carried over as the discount is applied to the new cust_pkg
+ #
+ # Legacy behavior:
+ # Unless discount-related fields have been set within $opt, change()
+ # sets no discounts on the changed packages unless the new pkgpart is the
+ # same as the old pkgpart. In that case, discounts from the old cust_pkg
+ # are copied onto the new cust_pkg
+
+ # Read discount fields from $opt
+ my %new_discount = $self->_parse_new_discounts($opt);
+ $self->set(waive_setup => $opt->{waive_setup} ? $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 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 ) ) {
+ foreach ( qw( locationnum pkgpart quantity refnum salesnum waive_setup ) ) {
if ( length($opt->{$_}) ) {
$self->set($_, $opt->{$_});
}
}
# 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
+
+ # Set waive_setup as directed
+ if ( !$error && exists $opt->{waive_setup} ) {
+ $self->set(waive_setup => $opt->{waive_setup});
+ $error = $self->replace;
+ }
+
+ # Set discounts if explicitly specified in $opt
+ if ( !$error && %new_discount ) {
+ $error = $self->change_discount(%new_discount);
+ }
+
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit if $oldAutoCommit;
+ return $self;
+
}
my %hash = ();
my $time = time;
- $hash{'setup'} = $time if $self->setup;
+ $hash{'setup'} = $time if $self->get('setup');
$hash{'change_date'} = $time;
$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'};
- # Special case. If the pkgpart is changing, and the customer is
- # going to be credited for remaining time, don't keep setup, bill,
- # or last_bill dates, and DO pass the flag to cancel() to credit
- # the customer.
+ # Special case. If the pkgpart is changing, and the customer is going to be
+ # credited for remaining time, don't keep setup, bill, or last_bill dates,
+ # and DO pass the flag to cancel() to credit the customer. If the old
+ # package had a setup date, set the new package's setup to the package
+ # change date so that it has the same status as before.
if ( $opt->{'pkgpart'}
and $opt->{'pkgpart'} != $self->pkgpart
and $self->part_pkg->option('unused_credit_change', 1) ) {
$unused_credit = 1;
$keep_dates = 0;
- $hash{$_} = '' foreach qw(setup bill last_bill);
+ $hash{'last_bill'} = '';
+ $hash{'bill'} = '';
}
if ( $keep_dates ) {
}
}
- # transfer discounts, if we're not changing pkgpart
- if ( $same_pkgpart ) {
+ if (%new_discount && !$error) {
+
+ # If discounts were explicitly specified in $opt
+ $error = $cust_pkg->change_discount(%new_discount);
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "applying discounts: $error";
+ }
+
+ } elsif ( $same_pkgpart ) {
+
+ # transfer discounts, if we're not changing pkgpart
foreach my $old_discount ($self->cust_pkg_discount_active) {
# don't remove the old discount, we may still need to bill that package.
my $new_discount = new FS::cust_pkg_discount {
- 'pkgnum' => $cust_pkg->pkgnum,
- 'discountnum' => $old_discount->discountnum,
- 'months_used' => $old_discount->months_used,
+ 'pkgnum' => $cust_pkg->pkgnum,
+ map { $_ => $old_discount->$_() }
+ qw( discountnum months_used end_date usernum setuprecur ),
};
$error = $new_discount->insert;
if ( $error ) {
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(
return "start_date $date is in the past";
}
+ # If the user entered a new location, set it up now.
+ if ( $opt->{'cust_location'} ) {
+ $error = $opt->{'cust_location'}->find_or_insert;
+ if ( $error ) {
+ $dbh->rollback if $oldAutoCommit;
+ return "creating location record: $error";
+ }
+ $opt->{'locationnum'} = $opt->{'cust_location'}->locationnum;
+ }
+
+ # Discounts:
+ # Applies discounts to the newly created future_change package
+ #
+ # If a new discount is the same as the old discount, carry over the
+ # old discount's months_used/end_date fields too
+ #
+ # Legacy behavior:
+ # Legacy behavior was to create the next package with no discount.
+ # This behavior is preserved. Without the discount fields in $opt,
+ # the new package will be created with no discounts.
+
+ # parse discount information from $opt
+ my %new_discount = $self->_parse_new_discounts($opt);
+
if ( $self->change_to_pkgnum ) {
my $change_to = FS::cust_pkg->by_key($self->change_to_pkgnum);
my $new_pkgpart = $opt->{'pkgpart'}
$change_to->set('start_date', $date);
$error = $self->replace || $change_to->replace;
}
+
+ if ( !$error && exists $opt->{waive_setup} ) {
+ $change_to->set(waive_setup => $opt->{waive_setup} );
+ $error = $change_to->insert();
+ }
+
+ if ( !$error && %new_discount ) {
+ $error = $change_to->change_discount(%new_discount);
+ }
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
return $error;
} );
$error = $new->insert('change' => 1,
'allow_pkgpart' => ($new_pkgpart ? 0 : 1));
+
+ if ( !$error && %new_discount ) {
+ $error = $new->change_discount(%new_discount);
+ }
+
if ( !$error ) {
$self->set('change_to_pkgnum', $new->pkgnum);
$self->set('expire', $date);
$error = $self->replace;
}
+
if ( $error ) {
$dbh->rollback if $oldAutoCommit;
} else {
$error;
}
+# Helper method reads $opt hashref from change() and change_later()
+# Returns a hash of %new_discount suitable for passing to change_discount()
+sub _parse_new_discounts {
+ my ($self, $opt) = @_;
+
+ croak "Bad parameter list" unless ref $opt;
+
+ my %old_discount =
+ map { $_->setuprecur => $_ }
+ qsearch('cust_pkg_discount', {
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ my %new_discount;
+ for my $type(qw|setup recur|) {
+
+ if (exists $opt->{"${type}_discountnum"}) {
+ $new_discount{$type} = {
+ discountnum => $opt->{"${type}_discountnum"},
+ amount => $opt->{"${type}_discountnum_amount"},
+ percent => $opt->{"${type}_discountnum_percent"},
+ months => $opt->{"${type}_discountnum_months"},
+ };
+ }
+
+ # Specified discountnum same as old discountnum, carry over addl fields
+ if (
+ exists $opt->{"${type}_discountnum"}
+ && exists $old_discount{$type}
+ && $opt->{"${type}_discountnum"} eq $old_discount{$type}->discountnum
+ ){
+ $new_discount{$type}->{months} = $old_discount{$type}->months;
+ $new_discount{$type}->{end_date} = $old_discount{$type}->end_date;
+ }
+
+ # No new discount specified, carryover old discount
+ # If we wanted to abandon legacy behavior, and always carry old discounts
+ # uncomment this:
+
+ # if (!exists $new_discount{$type} && $old_discount{$type}) {
+ # $new_discount{$type} = {
+ # discountnum => $old_discount{$type}->discountnum,
+ # amount => $old_discount{$type}->amount,
+ # percent => $old_discount{$type}->percent,
+ # months => $old_discount{$type}->months,
+ # end_date => $old_discount{$type}->end_date,
+ # };
+ # }
+ }
+
+ if ($DEBUG) {
+ warn "_parse_new_discounts(), pkgnum: ".$self->pkgnum." \n";
+ warn "Determine \%old_discount, \%new_discount: \n";
+ warn Dumper(\%old_discount);
+ warn Dumper(\%new_discount);
+ }
+
+ %new_discount;
+}
+
=item abort_change
Cancels a future package change scheduled by C<change_later>.
$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;
warn Dumper($param) if $DEBUG;
- my $old_part_pkg = qsearchs('part_pkg',
- { pkgpart => $param->{'old_pkgpart'} });
my $new_part_pkg = qsearchs('part_pkg',
{ pkgpart => $param->{'new_pkgpart'} });
- die "Must select a new package type\n" unless $new_part_pkg;
+ die "Must select a new package definition\n" unless $new_part_pkg;
+
#my $keep_dates = $param->{'keep_dates'} || 0;
my $keep_dates = 1; # there is no good reason to turn this off
local $FS::UID::AutoCommit = 0;
my $dbh = dbh;
- my @cust_pkgs = qsearch('cust_pkg', { 'pkgpart' => $param->{'old_pkgpart'} } );
+ my @old_pkgpart = ref($param->{'old_pkgpart'}) ? @{ $param->{'old_pkgpart'} }
+ : $param->{'old_pkgpart'};
+
+ my @cust_pkgs = qsearch({
+ 'table' => 'cust_pkg',
+ 'extra_sql' => ' WHERE pkgpart IN ('.
+ join(',', @old_pkgpart). ')',
+ });
my $i = 0;
foreach my $old_cust_pkg ( @cust_pkgs ) {
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<pkg_svc.hidden> flag will be omitted.
-Returns a list of lists, calling the label method for all (historical) services
-(see L<FS::h_cust_svc>) 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<FS::h_cust_svc>) 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
=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
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 );
$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;
}
=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.
+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.
=item reason_otaker
'';
}
+=item change_discount %opt
+
+Method checks if the given values represent a change in either setup or
+discount level. If so, the existing discounts are revoked, the new
+discounts are recorded.
+
+Usage:
+
+$error = change_discount(
+ setup => {
+
+ # -1: Indicates a "custom discount"
+ # 0: Indicates to remove any discount
+ # >0: discountnum to apply
+ discountnum => [-1, 0, discountnum],
+
+ # When discountnum is "-1" to indicate custom discount, include
+ # the additional fields:
+ amount => AMOUNT_DISCOUNT
+ percent => PERCENTAGE_DISCOUNT
+ months => -1,
+ },
+
+ recur => {...}
+);
+
+
+=cut
+
+sub change_discount {
+ my ($self, %opt) = @_;
+ return "change_discount() called with bad \%opt"
+ unless %opt;
+
+ for (keys %opt) {
+ return "change_discount() called with unknown bad key $_"
+ unless $_ eq 'setup' || $_ eq 'recur';
+ }
+
+ my @old_discount =
+ qsearch('cust_pkg_discount',{
+ pkgnum => $self->pkgnum,
+ disabled => '',
+ });
+
+ if ($DEBUG) {
+ warn "change_discount() pkgnum: ".$self->pkgnum." \n";
+ warn "change_discount() \%opt: \n";
+ warn Dumper(\%opt);
+ }
+
+ my @to_be_disabled;
+
+ for my $type (qw|setup recur|) {
+ next unless ref $opt{$type};
+ my %change = %{$opt{$type}};
+
+ return "change_discount() called with bad \$opt($type)"
+ unless $change{discountnum} =~ /^-?\d+$/;
+
+ if ($change{discountnum} eq 0) {
+ # Removing old discount
+
+ delete $opt{$type};
+ push @to_be_disabled, grep {$_->setuprecur eq $type} @old_discount;
+ } else {
+
+ if (
+ grep {
+ $_->discountnum eq $change{discountnum}
+ && $_->setuprecur eq $type
+ } @old_discount
+ ){
+ # Duplicate, disregard this entry
+ delete $opt{$type};
+ next;
+ } else {
+ # Mark any discounts we're replacing
+ push @to_be_disabled, grep{ $_->setuprecur eq $type} @old_discount;
+ }
+
+ }
+ }
+
+
+ # If we still have changes queued, pass them to insert_discount()
+ # by setting values into object fields
+ for my $type (keys %opt) {
+ $self->set("${type}_discountnum", $opt{$type}->{discountnum});
+
+ if ($opt{$type}->{discountnum} eq '-1') {
+ $self->set("${type}_discountnum_${_}", $opt{$type}->{$_})
+ for qw(amount percent months);
+ }
+
+ }
+
+ if ($DEBUG) {
+ warn "change_discount() \% opt before insert \n";
+ warn Dumper \%opt;
+ warn "\@to_be_disabled \n";
+ warn Dumper \@to_be_disabled;
+ }
+
+ # Roll these updates into a transaction
+ my $oldAutoCommit = $FS::UID::AutoCommit;
+ local $FS::UID::AutoCommit = 0;
+ my $dbh = dbh;
+
+ my $error;
+
+ # The "waive setup fee" flag has traditionally been handled by setting
+ # $cust_pkg->waive_setup_fee = Y. This has been appropriately, and separately
+ # handled, and it operates on a differetnt table than cust_pkg_discount,
+ # so the "-2 for waive setup fee" option is not being reimplemented
+ # here. Perhaps this may change later.
+ #
+ # When a setup discount is entered, we still need unset waive_setup
+ if ( $opt{setup} && $opt{setup} > -2 && $self->waive_setup ) {
+ $self->set(waive_setup => '');
+ $error = $self->replace();
+ }
+
+ # Create new discounts
+ $error ||= $self->insert_discount();
+
+ # Disabling old discounts
+ for my $tbd (@to_be_disabled) {
+ unless ($error) {
+ $tbd->set(disabled => 'Y');
+ $error = $tbd->replace();
+ }
+ }
+
+ if ($error) {
+ $dbh->rollback if $oldAutoCommit;
+ return $error;
+ }
+
+ $dbh->commit if $oldAutoCommit;
+ return undef;
+}
+
=item set_usage USAGE_VALUE_HASHREF
USAGE_VALUE_HASHREF is a hashref of svc_acct usage columns and the amounts
"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.
}
+=item fcc_477_record
+
+Returns a fcc_477 record based on option name.
+
+=cut
+
+sub fcc_477_record {
+ my ($self, $option_name) = @_;
+
+ my $fcc_record = qsearchs({
+ 'table' => 'part_pkg_fcc_option',
+ 'hashref' => { 'pkgpart' => $self->{Hash}->{pkgpart}, 'fccoptionname' => $option_name, },
+ });
+
+ return ( $fcc_record );
+
+}
+
=item tax_locationnum_sql
Returns an SQL expression for the tax location for a package, based
=item order CUSTNUM, PKGPARTS_ARYREF, [ REMOVE_PKGNUMS_ARYREF [ RETURN_CUST_PKG_ARRAYREF [ REFNUM ] ] ]
+=item order \%PARAMS
+
Bulk cancel + order subroutine. Perhaps slightly deprecated, only used by the
bulk cancel+order in the web UI and nowhere else (edit/process/cust_pkg.cgi)
refnums as keys. If no I<refnum> is defined, a default FS::pkg_referral
record will be created corresponding to cust_main.refnum.
+LOCATIONNUM, if specified, will be set on newly created cust_pkg records
+
=cut
sub order {
- my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+ my ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum,
+ $locationnum);
+
+ if ( ref $_[0] ) {
+ my $args = $_[0];
+ $custnum = $args->{custnum};
+ $pkgparts = $args->{pkgparts};
+ $remove_pkgnum = $args->{remove_pkgnum};
+ $return_cust_pkg = $args->{return_cust_pkg};
+ $refnum = $args->{refnum};
+ $locationnum = $args->{locationnum};
+ } else {
+ ($custnum, $pkgparts, $remove_pkgnum, $return_cust_pkg, $refnum) = @_;
+ }
my $conf = new FS::Conf;
}
+ $hash{locationnum} = $locationnum if $locationnum;
+
# Create the new packages.
foreach my $pkgpart (@$pkgparts) {
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
=cut
1;
-