X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_pkg.pm;h=fea05683d1eaee7e92a56a71d9c0f82f8577ed34;hb=71231d6bd803d2a3977c3ce2fa1f3c0ed4746b2d;hp=aedfe9c75153d9d5042190853d1c608a92d18546;hpb=133546cdadf999b58a43e8e1b8ceb5f493e187d6;p=freeside.git diff --git a/FS/FS/cust_pkg.pm b/FS/FS/cust_pkg.pm index aedfe9c75..fea05683d 100644 --- a/FS/FS/cust_pkg.pm +++ b/FS/FS/cust_pkg.pm @@ -1048,18 +1048,23 @@ 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 $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, @@ -1072,6 +1077,23 @@ sub cancel { #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 } @@ -2341,13 +2363,16 @@ sub change { $same_pkgpart = 0; } + if ($opt->{'waive_setup'}) { $self->set('waive_setup', $opt->{'waive_setup'}) } + else { $self->set('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->{$_}); } @@ -2740,6 +2765,10 @@ The date for the package change. Required, and must be in the future. =item quantity +=item discount + +Optional hashref that will be passed to $new_pkg->change_discount() + =item contract_end The pkgpart, locationnum, quantity and optional contract_end of the new @@ -2757,6 +2786,9 @@ sub change_later { my $error = $self->_check_change($opt); return $error if $error; + my %discount; + %discount = %{$opt->{discount}} if ref $opt->{discount}; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -2809,6 +2841,10 @@ sub change_later { (($err_or_pkg->pkgnum == $change_to->pkgnum) ? '' : $change_to->cancel('no_delay_cancel' => 1) || $change_to->delete); + + # Apply user-specified discount to new cust_pkg + $error = $err_or_pkg->change_discount(\%discount) + if !$error && %discount && %discount{discountnum} =~ /^-?\d+$/; } else { $error = $err_or_pkg; } @@ -2816,6 +2852,10 @@ sub change_later { $self->set('expire', $date); $change_to->set('start_date', $date); $error = $self->replace || $change_to->replace; + + # Apply user-specified discount to new cust_pkg + $error = $change_to->change_discount(\%discount) + if !$error && %discount && %discount{discountnum} =~ /^-?\d+$/; } if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -2855,6 +2895,11 @@ sub change_later { $self->set('expire', $date); $error = $self->replace; } + + # Apply user-specified discount to new cust_pkg + $new->change_discount(\%discount) + if !$error && %discount && %discount{discountnum} =~ /^-?\d+$/; + if ( $error ) { $dbh->rollback if $oldAutoCommit; } else { @@ -4395,24 +4440,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]; @@ -4424,13 +4487,16 @@ sub transfer { } else { $remaining++; } + } else { $remaining++ } + if ( $error ) { my @label = $cust_svc->label; return "service $label[1]: $error"; } + } return $remaining; } @@ -4658,6 +4724,139 @@ sub insert_discount { $cust_pkg_discount->insert; } + +=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( + { + # -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 => 12, + setup => 1, # APPLY TO SETUP + _type => amount/percentage + }, +); + + +=cut + +sub change_discount { + my ($self, $opt) = @_; + return "change_discount() called with bad \%opt hashref" + unless ref $opt; + + my %opt = %{$opt}; + + 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; + my %change = %opt; + + return "change_discount() called with bad discountnum" + unless $change{discountnum} =~ /^-?\d+$/; + + if ($change{discountnum} eq 0) { + # Removing old discount + + %change = (); + + push @to_be_disabled, @old_discount; + + } else { + + if ( grep { $_->discountnum eq $change{discountnum} } @old_discount ){ + # Duplicate, disregard this entry + %change = (); + } else { + # Mark any discounts we're replacing + push @to_be_disabled, @old_discount; + } + } + + # If we still have changes queued, create data structures for + # insert_discount(). + my @discount_insert; + if (%change) { + push @discount_insert, { + discountnum => $change{discountnum}, + discountnum__type => $change{_type}, + discountnum_amount => $change{amount}, + discountnum_percent => $change{percent} ? $change{percent} : '0', + discountnum_months => $change{months}, + discountnum_setup => $change{setup} ? 'Y' : '', + } + } + + 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 = Y. This has been appropriately, and separately + # handled, and it operates on a different table than cust_pkg_discount, + # so the "-2 for waive setup fee" option is not being reimplemented + # here. Perhaps this may change later. + + # Create new discounts + for my $insert_discount (@discount_insert) { + + # Set parameters for insert_discount into object, and insert + for my $k (keys %{$insert_discount}) { + $self->set($k, $insert_discount->{$k}); + } + $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 @@ -6282,4 +6481,3 @@ L, schema.html from the base documentation =cut 1; -