X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=c70a6795f3e2144f81bd374278d2917f82f787dd;hp=2c7550633a98726dc2e467e34455431e3bf293a9;hb=dba5666db2791c7c9694969470b452633b74d573;hpb=44dcd4a1ff335a85a6babf0e007be57e6ec4f525 diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index 2c7550633..c70a6795f 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -38,6 +38,8 @@ use FS::sales; # 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); @@ -58,6 +60,8 @@ our $upgrade = 0; #go away after setup+start dates cleaned up for old customers our $cache_enabled = 0; +our $disable_start_on_hold = 0; + sub _simplecache { my( $self, $hashref ) = @_; if ( $cache_enabled && $hashref->{'pkg'} && $hashref->{'plan'} ) { @@ -395,7 +399,10 @@ sub insert { $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) @@ -1094,17 +1101,38 @@ sub cancel { $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? } @@ -1810,6 +1838,8 @@ sub credit_remaining { # 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?) @@ -1818,14 +1848,23 @@ sub credit_remaining { ($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); - push @billpkgnums, $cust_bill_pkg->billpkgnum; - push @amounts, $amount; - push @setuprecurs, 'recur'; + # 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 ) { - warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n" - if $DEBUG; + push @billpkgnums, $cust_bill_pkg->billpkgnum; + push @amounts, $amount; + push @setuprecurs, 'recur'; + + warn "Crediting for $amount on package ".$remain_pkg->pkgnum."\n" + if $DEBUG; + } } @@ -2333,13 +2372,15 @@ sub change { $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->{$_}); } @@ -2581,9 +2622,9 @@ sub change { 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 ) { @@ -2999,7 +3040,7 @@ sub modify_charge { $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; @@ -3153,9 +3194,6 @@ sub modify_charge { ''; } - - -use Data::Dumper; sub process_bulk_cust_pkg { my $job = shift; my $param = shift; @@ -4385,8 +4423,10 @@ sub transfer { $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 = (); @@ -4420,24 +4460,42 @@ sub transfer { 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]; @@ -4449,13 +4507,16 @@ sub transfer { } else { $remaining++; } + } else { $remaining++ } + if ( $error ) { my @label = $cust_svc->label; return "$label[0] $label[1]: $error"; } + } return $remaining; } @@ -5061,6 +5122,17 @@ sub cancel_sql { "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. @@ -5514,6 +5586,23 @@ sub forward_emails { } # 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) = @_; $class->_upgrade_otaker(%opts); @@ -5553,6 +5642,32 @@ sub _upgrade_data { # class method 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