diff options
author | ivan <ivan> | 2010-09-17 20:19:41 +0000 |
---|---|---|
committer | ivan <ivan> | 2010-09-17 20:19:41 +0000 |
commit | 5a52da30588e8811338845ce2edaf0631acad479 (patch) | |
tree | 2192181b4ededbce5ee58479e0846d55537b4aa9 | |
parent | 0fb7ffd120c41dabfc34b6c06443a7604d879f8a (diff) |
refactor giant cust_main.pm a little in preparation of adding API methods for maestro, RT#9967
-rw-r--r-- | FS/FS.pm | 4 | ||||
-rw-r--r-- | FS/FS/cust_main.pm | 2911 | ||||
-rw-r--r-- | FS/FS/cust_main/Billing.pm | 1549 | ||||
-rw-r--r-- | FS/FS/cust_main/Billing_Realtime.pm | 1439 | ||||
-rw-r--r-- | FS/FS/part_pkg.pm | 1 | ||||
-rw-r--r-- | FS/MANIFEST | 2 |
6 files changed, 3005 insertions, 2901 deletions
@@ -262,6 +262,10 @@ L<FS::prospect_main> - Prospect class L<FS::cust_main> - Customer class +L<FS::cust_main::Billing> - Customer billing class + +L<FS::cust_main::Billing_Realtime> - Customer real-time billing class + L<FS::cust_location> - Customer location class L<FS::cust_main_Mixin> - Mixin class for records that contain fields from cust_main diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 007beec92..21f66b92e 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,11 +2,10 @@ package FS::cust_main; require 5.006; use strict; -use base qw( FS::otaker_Mixin - FS::payinfo_Mixin - FS::cust_main_Mixin +use base qw( FS::cust_main::Billing FS::cust_main::Billing_Realtime + FS::otaker_Mixin FS::payinfo_Mixin FS::cust_main_Mixin FS::Record - ); + ); use vars qw( @EXPORT_OK $DEBUG $me $conf @encrypted_fields $import $ignore_expired_card @@ -14,7 +13,6 @@ use vars qw( @EXPORT_OK $DEBUG $me $conf @paytypes ); use vars qw( $realtime_bop_decline_quiet ); #ugh -use Safe; use Carp; use Exporter; use Scalar::Util qw( blessed ); @@ -40,10 +38,6 @@ use FS::payby; use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; -use FS::cust_bill_pkg; -use FS::cust_bill_pkg_display; -use FS::cust_bill_pkg_tax_location; -use FS::cust_bill_pkg_tax_rate_location; use FS::cust_pay; use FS::cust_pay_pending; use FS::cust_pay_void; @@ -56,15 +50,10 @@ use FS::cust_location; use FS::cust_class; use FS::cust_main_exemption; use FS::cust_tax_adjustment; -use FS::tax_rate; -use FS::tax_rate_location; use FS::cust_tax_location; -use FS::part_pkg_taxrate; use FS::agent; use FS::cust_main_invoice; use FS::cust_tag; -use FS::cust_credit_bill; -use FS::cust_bill_pay; use FS::prepay_credit; use FS::queue; use FS::part_pkg; @@ -80,7 +69,7 @@ use FS::TicketSystem; @EXPORT_OK = qw( smart_search ); -$realtime_bop_decline_quiet = 0; +$realtime_bop_decline_quiet = 0; #move to Billing_Realtime # 1 is mostly method/subroutine entry and options # 2 traces progress of some operations @@ -2667,1271 +2656,10 @@ sub classname { : ''; } +=item BILLING METHODS -=item bill_and_collect - -Cancels and suspends any packages due, generates bills, applies payments and -credits, and applies collection events to run cards, send bills and notices, -etc. - -By default, warns on errors and continues with the next operation (but see the -"fatal" flag below). - -Options are passed as name-value pairs. Currently available options are: - -=over 4 - -=item time - -Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: - - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - -=item invoice_time - -Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. - -=item check_freq - -"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) - -=item resetup - -If set true, re-charges setup fees. - -=item fatal - -If set any errors prevent subsequent operations from continusing. If set -specifically to "return", returns the error (or false, if there is no error). -Any other true value causes errors to die. - -=item debug - -Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) - -=item job - -Optional FS::queue entry to receive status updates. - -=back - -Options are passed to the B<bill> and B<collect> methods verbatim, so all -options of those methods are also available. - -=cut - -sub bill_and_collect { - my( $self, %options ) = @_; - - my $error; - - #$options{actual_time} not $options{time} because freeside-daily -d is for - #pre-printing invoices - - $options{'actual_time'} ||= time; - my $job = $options{'job'}; - - $job->update_statustext('0,cleaning expired packages') if $job; - $error = $self->cancel_expired_pkgs( $options{actual_time} ); - if ( $error ) { - $error = "Error expiring custnum ". $self->custnum. ": $error"; - if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } - elsif ( $options{fatal} ) { die $error; } - else { warn $error; } - } - - $error = $self->suspend_adjourned_pkgs( $options{actual_time} ); - if ( $error ) { - $error = "Error adjourning custnum ". $self->custnum. ": $error"; - if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } - elsif ( $options{fatal} ) { die $error; } - else { warn $error; } - } - - $job->update_statustext('20,billing packages') if $job; - $error = $self->bill( %options ); - if ( $error ) { - $error = "Error billing custnum ". $self->custnum. ": $error"; - if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } - elsif ( $options{fatal} ) { die $error; } - else { warn $error; } - } - - $job->update_statustext('50,applying payments and credits') if $job; - $error = $self->apply_payments_and_credits; - if ( $error ) { - $error = "Error applying custnum ". $self->custnum. ": $error"; - if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } - elsif ( $options{fatal} ) { die $error; } - else { warn $error; } - } - - $job->update_statustext('70,running collection events') if $job; - unless ( $conf->exists('cancelled_cust-noevents') - && ! $self->num_ncancelled_pkgs - ) { - $error = $self->collect( %options ); - if ( $error ) { - $error = "Error collecting custnum ". $self->custnum. ": $error"; - if ($options{fatal} && $options{fatal} eq 'return') { return $error; } - elsif ($options{fatal} ) { die $error; } - else { warn $error; } - } - } - $job->update_statustext('100,finished') if $job; - - ''; - -} - -sub cancel_expired_pkgs { - my ( $self, $time, %options ) = @_; - - my @cancel_pkgs = $self->ncancelled_pkgs( { - 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time " - } ); - - my @errors = (); - - foreach my $cust_pkg ( @cancel_pkgs ) { - my $cpr = $cust_pkg->last_cust_pkg_reason('expire'); - my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, - 'reason_otaker' => $cpr->otaker - ) - : () - ); - push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error; - } - - scalar(@errors) ? join(' / ', @errors) : ''; - -} - -sub suspend_adjourned_pkgs { - my ( $self, $time, %options ) = @_; - - my @susp_pkgs = $self->ncancelled_pkgs( { - 'extra_sql' => - " AND ( susp IS NULL OR susp = 0 ) - AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time ) - OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time ) - ) - ", - } ); - - #only because there's no SQL test for is_prepaid :/ - @susp_pkgs = - grep { ( $_->part_pkg->is_prepaid - && $_->bill - && $_->bill < $time - ) - || ( $_->adjourn - && $_->adjourn <= $time - ) - - } - @susp_pkgs; - - my @errors = (); - - foreach my $cust_pkg ( @susp_pkgs ) { - my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn') - if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T); - my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum, - 'reason_otaker' => $cpr->otaker - ) - : () - ); - push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error; - } - - scalar(@errors) ? join(' / ', @errors) : ''; - -} - -=item bill OPTIONS - -Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in -conjunction with the collect method by calling B<bill_and_collect>. - -If there is an error, returns the error, otherwise returns false. - -Options are passed as name-value pairs. Currently available options are: - -=over 4 - -=item resetup - -If set true, re-charges setup fees. - -=item time - -Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: - - use Date::Parse; - ... - $cust_main->bill( 'time' => str2time('April 20th, 2001') ); - -=item pkg_list - -An array ref of specific packages (objects) to attempt billing, instead trying all of them. - - $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); - -=item not_pkgpart - -A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar). - -=item invoice_time - -Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. - -=item cancel - -This boolean value informs the us that the package is being cancelled. This -typically might mean not charging the normal recurring fee but only usage -fees since the last billing. Setup charges may be charged. Not all package -plans support this feature (they tend to charge 0). - -=item invoice_terms - -Optional terms to be printed on this invoice. Otherwise, customer-specific -terms or the default terms are used. - -=back - -=cut - -sub bill { - my( $self, %options ) = @_; - return '' if $self->payby eq 'COMP'; - warn "$me bill customer ". $self->custnum. "\n" - if $DEBUG; - - my $time = $options{'time'} || time; - my $invoice_time = $options{'invoice_time'} || $time; - - $options{'not_pkgpart'} ||= {}; - $options{'not_pkgpart'} = { map { $_ => 1 } - split(/\s*,\s*/, $options{'not_pkgpart'}) - } - unless ref($options{'not_pkgpart'}); - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - warn "$me acquiring lock on customer ". $self->custnum. "\n" - if $DEBUG; - - $self->select_for_update; #mutex - - warn "$me running pre-bill events for customer ". $self->custnum. "\n" - if $DEBUG; - - my $error = $self->do_cust_event( - 'debug' => ( $options{'debug'} || 0 ), - 'time' => $invoice_time, - 'check_freq' => $options{'check_freq'}, - 'stage' => 'pre-bill', - ); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - warn "$me done running pre-bill events for customer ". $self->custnum. "\n" - if $DEBUG; - - #keep auto-charge and non-auto-charge line items separate - my @passes = ( '', 'no_auto' ); - - my %cust_bill_pkg = map { $_ => [] } @passes; - - ### - # find the packages which are due for billing, find out how much they are - # & generate invoice database. - ### - - my %total_setup = map { my $z = 0; $_ => \$z; } @passes; - my %total_recur = map { my $z = 0; $_ => \$z; } @passes; - - my %taxlisthash = map { $_ => {} } @passes; - - my @precommit_hooks = (); - - $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks? - foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) { - - next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart}; - - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; - - #? to avoid use of uninitialized value errors... ? - $cust_pkg->setfield('bill', '') - unless defined($cust_pkg->bill); - - #my $part_pkg = $cust_pkg->part_pkg; - - my $real_pkgpart = $cust_pkg->pkgpart; - my %hash = $cust_pkg->hash; - - # we could implement this bit as FS::part_pkg::has_hidden, but we already - # suffer from performance issues - $options{has_hidden} = 0; - my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked; - $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); - - foreach my $part_pkg ( @part_pkg ) { - - $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); - - my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : ''; - - my $error = - $self->_make_lines( 'part_pkg' => $part_pkg, - 'cust_pkg' => $cust_pkg, - 'precommit_hooks' => \@precommit_hooks, - 'line_items' => $cust_bill_pkg{$pass}, - 'setup' => $total_setup{$pass}, - 'recur' => $total_recur{$pass}, - 'tax_matrix' => $taxlisthash{$pass}, - 'time' => $time, - 'real_pkgpart' => $real_pkgpart, - 'options' => \%options, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - - } #foreach my $part_pkg - - } #foreach my $cust_pkg - - #if the customer isn't on an automatic payby, everything can go on a single - #invoice anyway? - #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) { - #merge everything into one list - #} - - foreach my $pass (@passes) { # keys %cust_bill_pkg ) { - - my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} }); - - next unless @cust_bill_pkg; #don't create an invoice w/o line items - - if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || - !$conf->exists('postal_invoice-recurring_only') - ) - { - - my $postal_pkg = $self->charge_postal_fee(); - if ( $postal_pkg && !ref( $postal_pkg ) ) { - - $dbh->rollback if $oldAutoCommit; - return "can't charge postal invoice fee for customer ". - $self->custnum. ": $postal_pkg"; - - } elsif ( $postal_pkg ) { - - my $real_pkgpart = $postal_pkg->pkgpart; - # we could implement this bit as FS::part_pkg::has_hidden, but we already - # suffer from performance issues - $options{has_hidden} = 0; - my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked; - $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); - - foreach my $part_pkg ( @part_pkg ) { - my %postal_options = %options; - delete $postal_options{cancel}; - my $error = - $self->_make_lines( 'part_pkg' => $part_pkg, - 'cust_pkg' => $postal_pkg, - 'precommit_hooks' => \@precommit_hooks, - 'line_items' => \@cust_bill_pkg, - 'setup' => $total_setup{$pass}, - 'recur' => $total_recur{$pass}, - 'tax_matrix' => $taxlisthash{$pass}, - 'time' => $time, - 'real_pkgpart' => $real_pkgpart, - 'options' => \%postal_options, - ); - if ($error) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - # it's silly to have a zero value postal_pkg, but.... - @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg); - - } - - } - - my $listref_or_error = - $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time); - - unless ( ref( $listref_or_error ) ) { - $dbh->rollback if $oldAutoCommit; - return $listref_or_error; - } - - foreach my $taxline ( @$listref_or_error ) { - ${ $total_setup{$pass} } = - sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup ); - push @cust_bill_pkg, $taxline; - } - - #add tax adjustments - warn "adding tax adjustments...\n" if $DEBUG > 2; - foreach my $cust_tax_adjustment ( - qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum, - 'billpkgnum' => '', - } - ) - ) { - - my $tax = sprintf('%.2f', $cust_tax_adjustment->amount ); - - my $itemdesc = $cust_tax_adjustment->taxname; - $itemdesc = '' if $itemdesc eq 'Tax'; - - push @cust_bill_pkg, new FS::cust_bill_pkg { - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $itemdesc, - 'itemcomment' => $cust_tax_adjustment->comment, - 'cust_tax_adjustment' => $cust_tax_adjustment, - #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, - }; - - } - - my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } ); - - my @cust_bill = $self->cust_bill; - my $balance = $self->balance; - my $previous_balance = scalar(@cust_bill) - ? ( $cust_bill[$#cust_bill]->billing_balance || 0 ) - : 0; - - $previous_balance += $cust_bill[$#cust_bill]->charged - if scalar(@cust_bill); - #my $balance_adjustments = - # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged); - - #create the new invoice - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => ( $invoice_time ), - 'charged' => $charged, - 'billing_balance' => $balance, - 'previous_balance' => $previous_balance, - 'invoice_terms' => $options{'invoice_terms'}, - } ); - $error = $cust_bill->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; - } - - foreach my $cust_bill_pkg ( @cust_bill_pkg ) { - $cust_bill_pkg->invnum($cust_bill->invnum); - my $error = $cust_bill_pkg->insert; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item: $error"; - } - } - - } #foreach my $pass ( keys %cust_bill_pkg ) - - foreach my $hook ( @precommit_hooks ) { - eval { - &{$hook}; #($self) ? - }; - if ( $@ ) { - $dbh->rollback if $oldAutoCommit; - return "$@ running precommit hook $hook\n"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error -} - -#discard bundled packages of 0 value -sub _omit_zero_value_bundles { - - my @cust_bill_pkg = (); - my @cust_bill_pkg_bundle = (); - my $sum = 0; - - foreach my $cust_bill_pkg ( @_ ) { - if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) { - push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0; - @cust_bill_pkg_bundle = (); - $sum = 0; - } - $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur; - push @cust_bill_pkg_bundle, $cust_bill_pkg; - } - push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0; - - (@cust_bill_pkg); - -} - -=item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME - -This is a weird one. Perhaps it should not even be exposed. - -Generates tax line items (see L<FS::cust_bill_pkg>) for this customer. -Usually used internally by bill method B<bill>. - -If there is an error, returns the error, otherwise returns reference to a -list of line items suitable for insertion. - -=over 4 - -=item LINEITEMREF - -An array ref of the line items being billed. - -=item TAXHASHREF - -A strange beast. The keys to this hash are internal identifiers consisting -of the name of the tax object type, a space, and its unique identifier ( e.g. - 'cust_main_county 23' ). The values of the hash are listrefs. The first -item in the list is the tax object. The remaining items are either line -items or floating point values (currency amounts). - -The taxes are calculated on this entity. Calculated exemption records are -transferred to the LINEITEMREF items on the assumption that they are related. - -Read the source. - -=item INVOICE_TIME - -This specifies the date appearing on the associated invoice. Some -jurisdictions (i.e. Texas) have tax exemptions which are date sensitive. - -=back - -=cut -sub calculate_taxes { - my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_; - - my @tax_line_items = (); - - warn "having a look at the taxes we found...\n" if $DEBUG > 2; - - # keys are tax names (as printed on invoices / itemdesc ) - # values are listrefs of taxlisthash keys (internal identifiers) - my %taxname = (); - - # keys are taxlisthash keys (internal identifiers) - # values are (cumulative) amounts - my %tax = (); - - # keys are taxlisthash keys (internal identifiers) - # values are listrefs of cust_bill_pkg_tax_location hashrefs - my %tax_location = (); - - # keys are taxlisthash keys (internal identifiers) - # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs - my %tax_rate_location = (); - - foreach my $tax ( keys %$taxlisthash ) { - my $tax_object = shift @{ $taxlisthash->{$tax} }; - warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; - warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2; - my $hashref_or_error = - $tax_object->taxline( $taxlisthash->{$tax}, - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time - ); - return $hashref_or_error unless ref($hashref_or_error); - - unshift @{ $taxlisthash->{$tax} }, $tax_object; - - my $name = $hashref_or_error->{'name'}; - my $amount = $hashref_or_error->{'amount'}; - - #warn "adding $amount as $name\n"; - $taxname{ $name } ||= []; - push @{ $taxname{ $name } }, $tax; - - $tax{ $tax } += $amount; - - $tax_location{ $tax } ||= []; - if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) { - push @{ $tax_location{ $tax } }, - { - 'taxnum' => $tax_object->taxnum, - 'taxtype' => ref($tax_object), - 'pkgnum' => $tax_object->get('pkgnum'), - 'locationnum' => $tax_object->get('locationnum'), - 'amount' => sprintf('%.2f', $amount ), - }; - } - - $tax_rate_location{ $tax } ||= []; - if ( ref($tax_object) eq 'FS::tax_rate' ) { - my $taxratelocationnum = - $tax_object->tax_rate_location->taxratelocationnum; - push @{ $tax_rate_location{ $tax } }, - { - 'taxnum' => $tax_object->taxnum, - 'taxtype' => ref($tax_object), - 'amount' => sprintf('%.2f', $amount ), - 'locationtaxid' => $tax_object->location, - 'taxratelocationnum' => $taxratelocationnum, - }; - } - - } - - #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit - my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg; - foreach my $tax ( keys %$taxlisthash ) { - foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) { - next unless ref($_) eq 'FS::cust_bill_pkg'; - - push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, - splice( @{ $_->_cust_tax_exempt_pkg } ); - } - } - - #consolidate and create tax line items - warn "consolidating and generating...\n" if $DEBUG > 2; - foreach my $taxname ( keys %taxname ) { - my $tax = 0; - my %seen = (); - my @cust_bill_pkg_tax_location = (); - my @cust_bill_pkg_tax_rate_location = (); - warn "adding $taxname\n" if $DEBUG > 1; - foreach my $taxitem ( @{ $taxname{$taxname} } ) { - next if $seen{$taxitem}++; - warn "adding $tax{$taxitem}\n" if $DEBUG > 1; - $tax += $tax{$taxitem}; - push @cust_bill_pkg_tax_location, - map { new FS::cust_bill_pkg_tax_location $_ } - @{ $tax_location{ $taxitem } }; - push @cust_bill_pkg_tax_rate_location, - map { new FS::cust_bill_pkg_tax_rate_location $_ } - @{ $tax_rate_location{ $taxitem } }; - } - next unless $tax; - - $tax = sprintf('%.2f', $tax ); - - my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname, - 'disabled' => '', - }, - ); - - my @display = (); - if ( $pkg_category and - $conf->config('invoice_latexsummary') || - $conf->config('invoice_htmlsummary') - ) - { - - my %hash = ( 'section' => $pkg_category->categoryname ); - push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; - - } - - push @tax_line_items, new FS::cust_bill_pkg { - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - 'display' => \@display, - 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, - 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location, - }; - - } - - \@tax_line_items; -} - -sub _make_lines { - my ($self, %params) = @_; - - my $part_pkg = $params{part_pkg} or die "no part_pkg specified"; - my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified"; - my $precommit_hooks = $params{precommit_hooks} or die "no package specified"; - my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified"; - my $total_setup = $params{setup} or die "no setup accumulator specified"; - my $total_recur = $params{recur} or die "no recur accumulator specified"; - my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified"; - my $time = $params{'time'} or die "no time specified"; - my (%options) = %{$params{options}}; - - my $dbh = dbh; - my $real_pkgpart = $params{real_pkgpart}; - my %hash = $cust_pkg->hash; - my $old_cust_pkg = new FS::cust_pkg \%hash; - - my @details = (); - my @discounts = (); - my $lineitems = 0; - - $cust_pkg->pkgpart($part_pkg->pkgpart); - - ### - # bill setup - ### - - my $setup = 0; - my $unitsetup = 0; - if ( $options{'resetup'} - || ( ! $cust_pkg->setup - && ( ! $cust_pkg->start_date - || $cust_pkg->start_date <= $time - ) - && ( ! $conf->exists('disable_setup_suspended_pkgs') - || ( $conf->exists('disable_setup_suspended_pkgs') && - ! $cust_pkg->getfield('susp') - ) - ) - ) - ) - { - - warn " bill setup\n" if $DEBUG > 1; - $lineitems++; - - $setup = eval { $cust_pkg->calc_setup( $time, \@details ) }; - return "$@ running calc_setup for $cust_pkg\n" - if $@; - - $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh - - $cust_pkg->setfield('setup', $time) - unless $cust_pkg->setup; - #do need it, but it won't get written to the db - #|| $cust_pkg->pkgpart != $real_pkgpart; - - $cust_pkg->setfield('start_date', '') - if $cust_pkg->start_date; - - } - - ### - # bill recurring fee - ### - - #XXX unit stuff here too - my $recur = 0; - my $unitrecur = 0; - my $sdate; - if ( ! $cust_pkg->get('susp') - and ! $cust_pkg->get('start_date') - and ( $part_pkg->getfield('freq') ne '0' - && ( $cust_pkg->getfield('bill') || 0 ) <= $time - ) - || ( $part_pkg->plan eq 'voip_cdr' - && $part_pkg->option('bill_every_call') - ) - || ( $options{cancel} ) - ) { - - # XXX should this be a package event? probably. events are called - # at collection time at the moment, though... - $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG) - if $part_pkg->can('reset_usage'); - #don't want to reset usage just cause we want a line item?? - #&& $part_pkg->pkgpart == $real_pkgpart; - - warn " bill recur\n" if $DEBUG > 1; - $lineitems++; - - # XXX shared with $recur_prog - $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill ) - || $cust_pkg->setup - || $time; - - #over two params! lets at least switch to a hashref for the rest... - my $increment_next_bill = ( $part_pkg->freq ne '0' - && ( $cust_pkg->getfield('bill') || 0 ) <= $time - && !$options{cancel} - ); - my %param = ( 'precommit_hooks' => $precommit_hooks, - 'increment_next_bill' => $increment_next_bill, - 'discounts' => \@discounts, - 'real_pkgpart' => $real_pkgpart, - ); - - my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur'; - $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) }; - return "$@ running $method for $cust_pkg\n" - if ( $@ ); - - if ( $increment_next_bill ) { - - my $next_bill = $part_pkg->add_freq($sdate); - return "unparsable frequency: ". $part_pkg->freq - if $next_bill == -1; - - #pro-rating magic - if $recur_prog fiddled $sdate, want to use that - # only for figuring next bill date, nothing else, so, reset $sdate again - # here - $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill; - $cust_pkg->last_bill($sdate); - - $cust_pkg->setfield('bill', $next_bill ); - - } - - } - - warn "\$setup is undefined" unless defined($setup); - warn "\$recur is undefined" unless defined($recur); - warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); - - ### - # If there's line items, create em cust_bill_pkg records - # If $cust_pkg has been modified, update it (if we're a real pkgpart) - ### - - if ( $lineitems || $options{has_hidden} ) { - - if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) { - # hmm.. and if just the options are modified in some weird price plan? - - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" - if $DEBUG >1; - - my $error = $cust_pkg->replace( $old_cust_pkg, - 'options' => { $cust_pkg->options }, - ); - return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error" - if $error; #just in case - } - - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); - if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { - return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; - } - if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { - return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; - } - - if ( $setup != 0 || - $recur != 0 || - !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines - { - - warn " charges (setup=$setup, recur=$recur); adding line items\n" - if $DEBUG > 1; - - my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I'); - if ( $DEBUG > 1 ) { - warn " adding customer package invoice detail: $_\n" - foreach @cust_pkg_detail; - } - push @details, @cust_pkg_detail; - - my $cust_bill_pkg = new FS::cust_bill_pkg { - 'pkgnum' => $cust_pkg->pkgnum, - 'setup' => $setup, - 'unitsetup' => $unitsetup, - 'recur' => $recur, - 'unitrecur' => $unitrecur, - 'quantity' => $cust_pkg->quantity, - 'details' => \@details, - 'discounts' => \@discounts, - 'hidden' => $part_pkg->hidden, - }; - - if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) { - $cust_bill_pkg->sdate( $hash{last_bill} ); - $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1 - $cust_bill_pkg->edate( $time ) if $options{cancel}; - } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) { - $cust_bill_pkg->sdate( $sdate ); - $cust_bill_pkg->edate( $cust_pkg->bill ); - #$cust_bill_pkg->edate( $time ) if $options{cancel}; - } - - $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart) - unless $part_pkg->pkgpart == $real_pkgpart; - - $$total_setup += $setup; - $$total_recur += $recur; - - ### - # handle taxes - ### - - my $error = - $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options); - return $error if $error; - - push @$cust_bill_pkgs, $cust_bill_pkg; - - } #if $setup != 0 || $recur != 0 - - } #if $line_items - - ''; - -} - -sub _handle_taxes { - my $self = shift; - my $part_pkg = shift; - my $taxlisthash = shift; - my $cust_bill_pkg = shift; - my $cust_pkg = shift; - my $invoice_time = shift; - my $real_pkgpart = shift; - my $options = shift; - - my %cust_bill_pkg = (); - my %taxes = (); - - my @classes; - #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U'; - push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage; - push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); - push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); - - if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) { - - if ( $conf->exists('enable_taxproducts') - && ( scalar($part_pkg->part_pkg_taxoverride) - || $part_pkg->has_taxproduct - ) - ) - { - - if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { - return "fatal: Can't (yet) use tax-pkg_address with taxproducts"; - } - - foreach my $class (@classes) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, $class ); - return $err_or_ref unless ref($err_or_ref); - $taxes{$class} = $err_or_ref; - } - - unless (exists $taxes{''}) { - my $err_or_ref = $self->_gather_taxes( $part_pkg, '' ); - return $err_or_ref unless ref($err_or_ref); - $taxes{''} = $err_or_ref; - } - - } else { - - my @loc_keys = qw( city county state country ); - my %taxhash; - if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { - my $cust_location = $cust_pkg->cust_location; - %taxhash = map { $_ => $cust_location->$_() } @loc_keys; - } else { - my $prefix = - ( $conf->exists('tax-ship_address') && length($self->ship_last) ) - ? 'ship_' - : ''; - %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys; - } - - $taxhash{'taxclass'} = $part_pkg->taxclass; - - my @taxes = (); - my %taxhash_elim = %taxhash; - my @elim = qw( city county state ); - do { - - #first try a match with taxclass - @taxes = qsearch( 'cust_main_county', \%taxhash_elim ); - - if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) { - #then try a match without taxclass - my %no_taxclass = %taxhash_elim; - $no_taxclass{ 'taxclass' } = ''; - @taxes = qsearch( 'cust_main_county', \%no_taxclass ); - } - - $taxhash_elim{ shift(@elim) } = ''; - - } while ( !scalar(@taxes) && scalar(@elim) ); - - @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } - @taxes - if $self->cust_main_exemption; #just to be safe - - if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { - foreach (@taxes) { - $_->set('pkgnum', $cust_pkg->pkgnum ); - $_->set('locationnum', $cust_pkg->locationnum ); - } - } - - $taxes{''} = [ @taxes ]; - $taxes{'setup'} = [ @taxes ]; - $taxes{'recur'} = [ @taxes ]; - $taxes{$_} = [ @taxes ] foreach (@classes); - - # # maybe eliminate this entirely, along with all the 0% records - # unless ( @taxes ) { - # return - # "fatal: can't find tax rate for state/county/country/taxclass ". - # join('/', map $taxhash{$_}, qw(state county country taxclass) ); - # } - - } #if $conf->exists('enable_taxproducts') ... - - } - - my @display = (); - my $separate = $conf->exists('separate_usage'); - my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart }; - my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!'); - my $section = $temp_pkg->part_pkg->categoryname; - if ( $separate || $section || $usage_mandate ) { - - my %hash = ( 'section' => $section ); - - $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!'); - my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!'); - if ( $separate ) { - push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; - push @display, new FS::cust_bill_pkg_display { type => 'R', %hash }; - } else { - push @display, new FS::cust_bill_pkg_display - { type => '', - %hash, - ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ), - }; - } - - if ($separate && $section && $summary) { - push @display, new FS::cust_bill_pkg_display { type => 'U', - summary => 'Y', - %hash, - }; - } - if ($usage_mandate || $section && $summary) { - $hash{post_total} = 'Y'; - } - - if ($separate || $usage_mandate) { - $hash{section} = $section if ($separate || $usage_mandate); - push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; - } - - } - $cust_bill_pkg->set('display', \@display); - - my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; - foreach my $key (keys %tax_cust_bill_pkg) { - my @taxes = @{ $taxes{$key} || [] }; - my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; - - my %localtaxlisthash = (); - foreach my $tax ( @taxes ) { - - my $taxname = ref( $tax ). ' '. $tax->taxnum; -# $taxname .= ' pkgnum'. $cust_pkg->pkgnum. -# ' locationnum'. $cust_pkg->locationnum -# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum; - - $taxlisthash->{ $taxname } ||= [ $tax ]; - push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; - - $localtaxlisthash{ $taxname } ||= [ $tax ]; - push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg; - - } - - warn "finding taxed taxes...\n" if $DEBUG > 2; - foreach my $tax ( keys %localtaxlisthash ) { - my $tax_object = shift @{ $localtaxlisthash{$tax} }; - warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n" - if $DEBUG > 2; - next unless $tax_object->can('tax_on_tax'); - - foreach my $tot ( $tax_object->tax_on_tax( $self ) ) { - my $totname = ref( $tot ). ' '. $tot->taxnum; - - warn "checking $totname which we call ". $tot->taxname. " as applicable\n" - if $DEBUG > 2; - next unless exists( $localtaxlisthash{ $totname } ); # only increase - # existing taxes - warn "adding $totname to taxed taxes\n" if $DEBUG > 2; - my $hashref_or_error = - $tax_object->taxline( $localtaxlisthash{$tax}, - 'custnum' => $self->custnum, - 'invoice_time' => $invoice_time, - ); - return $hashref_or_error - unless ref($hashref_or_error); - - $taxlisthash->{ $totname } ||= [ $tot ]; - push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount}; - - } - } - - } - - ''; -} - -sub _gather_taxes { - my $self = shift; - my $part_pkg = shift; - my $class = shift; - - my @taxes = (); - my $geocode = $self->geocode('cch'); - - my @taxclassnums = map { $_->taxclassnum } - $part_pkg->part_pkg_taxoverride($class); - - unless (@taxclassnums) { - @taxclassnums = map { $_->taxclassnum } - grep { $_->taxable eq 'Y' } - $part_pkg->part_pkg_taxrate('cch', $geocode, $class); - } - warn "Found taxclassnum values of ". join(',', @taxclassnums) - if $DEBUG; - - my $extra_sql = - "AND (". - join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")"; - - @taxes = qsearch({ 'table' => 'tax_rate', - 'hashref' => { 'geocode' => $geocode, }, - 'extra_sql' => $extra_sql, - }) - if scalar(@taxclassnums); - - warn "Found taxes ". - join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" - if $DEBUG; - - [ @taxes ]; - -} - -=item collect [ HASHREF | OPTION => VALUE ... ] - -(Attempt to) collect money for this customer's outstanding invoices (see -L<FS::cust_bill>). Usually used after the bill method. - -Actions are now triggered by billing events; see L<FS::part_event> and the -billing events web interface. Old-style invoice events (see -L<FS::part_bill_event>) have been deprecated. - -If there is an error, returns the error, otherwise returns false. - -Options are passed as name-value pairs. - -Currently available options are: - -=over 4 - -=item invoice_time - -Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. - -=item retry - -Retry card/echeck/LEC transactions even when not scheduled by invoice events. - -=item check_freq - -"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) - -=item quiet - -set true to surpress email card/ACH decline notices. - -=item debug - -Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) - -=back - -# =item payby -# -# allows for one time override of normal customer billing method - -=cut - -sub collect { - my( $self, %options ) = @_; - my $invoice_time = $options{'invoice_time'} || time; - - #put below somehow? - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - if ( $DEBUG ) { - my $balance = $self->balance; - warn "$me collect customer ". $self->custnum. ": balance $balance\n" - } - - if ( exists($options{'retry_card'}) ) { - carp 'retry_card option passed to collect is deprecated; use retry'; - $options{'retry'} ||= $options{'retry_card'}; - } - if ( exists($options{'retry'}) && $options{'retry'} ) { - my $error = $self->retry_realtime; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return $error; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - #never want to roll back an event just because it returned an error - local $FS::UID::AutoCommit = 1; #$oldAutoCommit; - - $self->do_cust_event( - 'debug' => ( $options{'debug'} || 0 ), - 'time' => $invoice_time, - 'check_freq' => $options{'check_freq'}, - 'stage' => 'collect', - ); - -} +Documentation on billing methods has been moved to +L<FS::cust_main::Billing>. =item do_cust_event [ HASHREF | OPTION => VALUE ... ] @@ -4380,1065 +3108,10 @@ sub retry_realtime { =cut -=item realtime_collect [ OPTION => VALUE ... ] - -Runs a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime -gateway. See L<http://420.am/business-onlinepayment> and -L<http://420.am/business-onlinethirdpartypayment> for supported gateways. - -On failure returns an error message. - -Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url. - -Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum> - -I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified -then it is deduced from the customer record. - -If no I<amount> is specified, then the customer balance is used. - -The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -if set, will override the value from the customer record. - -I<description> is a free-text field passed to the gateway. It defaults to -the value defined by the business-onlinepayment-description configuration -option, or "Internet services" if that is unset. - -If an I<invnum> is specified, this payment (if successful) is applied to the -specified invoice. If you don't specify an I<invnum> you might want to -call the B<apply_payments> method or set the I<apply> option. - -I<apply> can be set to true to apply a resulting payment. - -I<quiet> can be set true to surpress email decline notices. - -I<paynum_ref> can be set to a scalar reference. It will be filled in with the -resulting paynum, if any. - -I<payunique> is a unique identifier for this payment. - -I<session_id> is a session identifier associated with this payment. - -I<depend_jobnum> allows payment capture to unlock export jobs - -=cut - -sub realtime_collect { - my( $self, %options ) = @_; - - if ( $DEBUG ) { - warn "$me realtime_collect:\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - $options{amount} = $self->balance unless exists( $options{amount} ); - $options{method} = FS::payby->payby2bop($self->payby) - unless exists( $options{method} ); - - return $self->realtime_bop({%options}); - -} - -=item realtime_bop { [ ARG => VALUE ... ] } - -Runs a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L<http://420.am/business-onlinepayment> for supported gateways. - -Required arguments in the hashref are I<method>, and I<amount> - -Available methods are: I<CC>, I<ECHECK> and I<LEC> - -Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id> +=item REALTIME BILLING METHODS -The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -if set, will override the value from the customer record. - -I<description> is a free-text field passed to the gateway. It defaults to -the value defined by the business-onlinepayment-description configuration -option, or "Internet services" if that is unset. - -If an I<invnum> is specified, this payment (if successful) is applied to the -specified invoice. If you don't specify an I<invnum> you might want to -call the B<apply_payments> method or set the I<apply> option. - -I<apply> can be set to true to apply a resulting payment. - -I<quiet> can be set true to surpress email decline notices. - -I<paynum_ref> can be set to a scalar reference. It will be filled in with the -resulting paynum, if any. - -I<payunique> is a unique identifier for this payment. - -I<session_id> is a session identifier associated with this payment. - -I<depend_jobnum> allows payment capture to unlock export jobs - -(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) - -=cut - -# some helper routines -sub _bop_recurring_billing { - my( $self, %opt ) = @_; - - my $method = scalar($conf->config('credit_card-recurring_billing_flag')); - - if ( defined($method) && $method eq 'transaction_is_recur' ) { - - return 1 if $opt{'trans_is_recur'}; - - } else { - - my %hash = ( 'custnum' => $self->custnum, - 'payby' => 'CARD', - ); - - return 1 - if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } ) - || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD', - $opt{'payinfo'} ) - } ); - - } - - return 0; - -} - -sub _payment_gateway { - my ($self, $options) = @_; - - $options->{payment_gateway} = $self->agent->payment_gateway( %$options ) - unless exists($options->{payment_gateway}); - - $options->{payment_gateway}; -} - -sub _bop_auth { - my ($self, $options) = @_; - - ( - 'login' => $options->{payment_gateway}->gateway_username, - 'password' => $options->{payment_gateway}->gateway_password, - ); -} - -sub _bop_options { - my ($self, $options) = @_; - - $options->{payment_gateway}->gatewaynum - ? $options->{payment_gateway}->options - : @{ $options->{payment_gateway}->get('options') }; - -} - -sub _bop_defaults { - my ($self, $options) = @_; - - unless ( $options->{'description'} ) { - if ( $conf->exists('business-onlinepayment-description') ) { - my $dtempl = $conf->config('business-onlinepayment-description'); - - my $agent = $self->agent->agent; - #$pkgs... not here - $options->{'description'} = eval qq("$dtempl"); - } else { - $options->{'description'} = 'Internet services'; - } - } - - $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} ); - $options->{invnum} ||= ''; - $options->{payname} = $self->payname unless exists( $options->{payname} ); -} - -sub _bop_content { - my ($self, $options) = @_; - my %content = (); - - my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip; - $content{customer_ip} = $payip if length($payip); - - $content{invoice_number} = $options->{'invnum'} - if exists($options->{'invnum'}) && length($options->{'invnum'}); - - $content{email_customer} = - ( $conf->exists('business-onlinepayment-email_customer') - || $conf->exists('business-onlinepayment-email-override') ); - - my ($payname, $payfirst, $paylast); - if ( $options->{payname} && $options->{method} ne 'ECHECK' ) { - ($payname = $options->{payname}) =~ - /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - $content{last_name} = $paylast; - $content{first_name} = $payfirst; - - $content{name} = $payname; - - $content{address} = exists($options->{'address1'}) - ? $options->{'address1'} - : $self->address1; - my $address2 = exists($options->{'address2'}) - ? $options->{'address2'} - : $self->address2; - $content{address} .= ", ". $address2 if length($address2); - - $content{city} = exists($options->{city}) - ? $options->{city} - : $self->city; - $content{state} = exists($options->{state}) - ? $options->{state} - : $self->state; - $content{zip} = exists($options->{zip}) - ? $options->{'zip'} - : $self->zip; - $content{country} = exists($options->{country}) - ? $options->{country} - : $self->country; - - $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/ - $content{phone} = $self->daytime || $self->night; - - \%content; -} - -my %bop_method2payby = ( - 'CC' => 'CARD', - 'ECHECK' => 'CHEK', - 'LEC' => 'LECB', -); - -sub realtime_bop { - my $self = shift; - - my %options = (); - if (ref($_[0]) eq 'HASH') { - %options = %{$_[0]}; - } else { - my ( $method, $amount ) = ( shift, shift ); - %options = @_; - $options{method} = $method; - $options{amount} = $amount; - } - - if ( $DEBUG ) { - warn "$me realtime_bop (new): $options{method} $options{amount}\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - return $self->fake_bop(%options) if $options{'fake'}; - - $self->_bop_defaults(\%options); - - ### - # set trans_is_recur based on invnum if there is one - ### - - my $trans_is_recur = 0; - if ( $options{'invnum'} ) { - - my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); - die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; - - my @part_pkg = - map { $_->part_pkg } - grep { $_ } - map { $_->cust_pkg } - $cust_bill->cust_bill_pkg; - - $trans_is_recur = 1 - if grep { $_->freq ne '0' } @part_pkg; - - } - - ### - # select a gateway - ### - - my $payment_gateway = $self->_payment_gateway( \%options ); - my $namespace = $payment_gateway->gateway_namespace; - - eval "use $namespace"; - die $@ if $@; - - ### - # check for banned credit card/ACH - ### - - my $ban = qsearchs('banned_pay', { - 'payby' => $bop_method2payby{$options{method}}, - 'payinfo' => md5_base64($options{payinfo}), - } ); - return "Banned credit card" if $ban; - - ### - # massage data - ### - - my $bop_content = $self->_bop_content(\%options); - return $bop_content unless ref($bop_content); - - my @invoicing_list = $self->invoicing_list_emailonly; - if ( $conf->exists('emailinvoiceautoalways') - || $conf->exists('emailinvoiceauto') && ! @invoicing_list - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my $paydate = ''; - my %content = (); - if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) { - - $content{card_number} = $options{payinfo}; - $paydate = exists($options{'paydate'}) - ? $options{'paydate'} - : $self->paydate; - $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - my $paycvv = exists($options{'paycvv'}) - ? $options{'paycvv'} - : $self->paycvv; - $content{cvv2} = $paycvv - if length($paycvv); - - my $paystart_month = exists($options{'paystart_month'}) - ? $options{'paystart_month'} - : $self->paystart_month; - - my $paystart_year = exists($options{'paystart_year'}) - ? $options{'paystart_year'} - : $self->paystart_year; - - $content{card_start} = "$paystart_month/$paystart_year" - if $paystart_month && $paystart_year; - - my $payissue = exists($options{'payissue'}) - ? $options{'payissue'} - : $self->payissue; - $content{issue_number} = $payissue if $payissue; - - if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'}, - 'trans_is_recur' => $trans_is_recur, - ) - ) - { - $content{recurring_billing} = 'YES'; - $content{acct_code} = 'rebill' - if $conf->exists('credit_card-recurring_billing_acct_code'); - } - - } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){ - ( $content{account_number}, $content{routing_code} ) = - split('@', $options{payinfo}); - $content{bank_name} = $options{payname}; - $content{bank_state} = exists($options{'paystate'}) - ? $options{'paystate'} - : $self->getfield('paystate'); - $content{account_type} = exists($options{'paytype'}) - ? uc($options{'paytype'}) || 'CHECKING' - : uc($self->getfield('paytype')) || 'CHECKING'; - $content{account_name} = $self->getfield('first'). ' '. - $self->getfield('last'); - - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{state_id} = exists($options{'stateid'}) - ? $options{'stateid'} - : $self->getfield('stateid'); - $content{state_id_state} = exists($options{'stateid_state'}) - ? $options{'stateid_state'} - : $self->getfield('stateid_state'); - $content{customer_ssn} = exists($options{'ss'}) - ? $options{'ss'} - : $self->ss; - } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) { - $content{phone} = $options{payinfo}; - } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) { - #move along - } else { - #die an evil death - } - - ### - # run transaction(s) - ### - - my $balance = exists( $options{'balance'} ) - ? $options{'balance'} - : $self->balance; - - $self->select_for_update; #mutex ... just until we get our pending record in - - #the checks here are intended to catch concurrent payments - #double-form-submission prevention is taken care of in cust_pay_pending::check - - #check the balance - return "The customer's balance has changed; $options{method} transaction aborted." - if $self->balance < $balance; - #&& $self->balance < $options{amount}; #might as well anyway? - - #also check and make sure there aren't *other* pending payments for this cust - - my @pending = qsearch('cust_pay_pending', { - 'custnum' => $self->custnum, - 'status' => { op=>'!=', value=>'done' } - }); - return "A payment is already being processed for this customer (". - join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ). - "); $options{method} transaction aborted." - if scalar(@pending); - - #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out - - my $cust_pay_pending = new FS::cust_pay_pending { - 'custnum' => $self->custnum, - #'invnum' => $options{'invnum'}, - 'paid' => $options{amount}, - '_date' => '', - 'payby' => $bop_method2payby{$options{method}}, - 'payinfo' => $options{payinfo}, - 'paydate' => $paydate, - 'recurring_billing' => $content{recurring_billing}, - 'pkgnum' => $options{'pkgnum'}, - 'status' => 'new', - 'gatewaynum' => $payment_gateway->gatewaynum || '', - 'session_id' => $options{session_id} || '', - 'jobnum' => $options{depend_jobnum} || '', - }; - $cust_pay_pending->payunique( $options{payunique} ) - if defined($options{payunique}) && length($options{payunique}); - my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted - return $cpp_new_err if $cpp_new_err; - - my( $action1, $action2 ) = - split( /\s*\,\s*/, $payment_gateway->gateway_action ); - - my $transaction = new $namespace( $payment_gateway->gateway_module, - $self->_bop_options(\%options), - ); - - $transaction->content( - 'type' => $options{method}, - $self->_bop_auth(\%options), - 'action' => $action1, - 'description' => $options{'description'}, - 'amount' => $options{amount}, - #'invoice_number' => $options{'invnum'}, - 'customer_id' => $self->custnum, - %$bop_content, - 'reference' => $cust_pay_pending->paypendingnum, #for now - 'email' => $email, - %content, #after - ); - - $cust_pay_pending->status('pending'); - my $cpp_pending_err = $cust_pay_pending->replace; - return $cpp_pending_err if $cpp_pending_err; - - #config? - my $BOP_TESTING = 0; - my $BOP_TESTING_SUCCESS = 1; - - unless ( $BOP_TESTING ) { - $transaction->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); - $transaction->submit(); - } else { - if ( $BOP_TESTING_SUCCESS ) { - $transaction->is_success(1); - $transaction->authorization('fake auth'); - } else { - $transaction->is_success(0); - $transaction->error_message('fake failure'); - } - } - - if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) { - - return { reference => $cust_pay_pending->paypendingnum, - map { $_ => $transaction->$_ } qw ( popup_url collectitems ) }; - - } elsif ( $transaction->is_success() && $action2 ) { - - $cust_pay_pending->status('authorized'); - my $cpp_authorized_err = $cust_pay_pending->replace; - return $cpp_authorized_err if $cpp_authorized_err; - - my $auth = $transaction->authorization; - my $ordernum = $transaction->can('order_number') - ? $transaction->order_number - : ''; - - my $capture = - new Business::OnlinePayment( $payment_gateway->gateway_module, - $self->_bop_options(\%options), - ); - - my %capture = ( - %content, - type => $options{method}, - action => $action2, - $self->_bop_auth(\%options), - order_number => $ordernum, - amount => $options{amount}, - authorization => $auth, - description => $options{'description'}, - ); - - foreach my $field (qw( authorization_source_code returned_ACI - transaction_identifier validation_code - transaction_sequence_num local_transaction_date - local_transaction_time AVS_result_code )) { - $capture{$field} = $transaction->$field() if $transaction->can($field); - } - - $capture->content( %capture ); - - $capture->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); - $capture->submit(); - - unless ( $capture->is_success ) { - my $e = "Authorization successful but capture failed, custnum #". - $self->custnum. ': '. $capture->result_code. - ": ". $capture->error_message; - warn $e; - return $e; - } - - } - - ### - # remove paycvv after initial transaction - ### - - #false laziness w/misc/process/payment.cgi - check both to make sure working - # correctly - if ( length($self->paycvv) - && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save') - ) { - my $error = $self->remove_cvv; - if ( $error ) { - warn "WARNING: error removing cvv: $error\n"; - } - } - - ### - # Tokenize - ### - - - if ( $transaction->can('card_token') && $transaction->card_token ) { - - $self->card_token($transaction->card_token); - - if ( $options{'payinfo'} eq $self->payinfo ) { - $self->payinfo($transaction->card_token); - my $error = $self->replace; - if ( $error ) { - warn "WARNING: error storing token: $error, but proceeding anyway\n"; - } - } - - } - - ### - # result handling - ### - - $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); - -} - -=item fake_bop - -=cut - -sub fake_bop { - my $self = shift; - - my %options = (); - if (ref($_[0]) eq 'HASH') { - %options = %{$_[0]}; - } else { - my ( $method, $amount ) = ( shift, shift ); - %options = @_; - $options{method} = $method; - $options{amount} = $amount; - } - - if ( $options{'fake_failure'} ) { - return "Error: No error; test failure requested with fake_failure"; - } - - #my $paybatch = ''; - #if ( $payment_gateway->gatewaynum ) { # agent override - # $paybatch = $payment_gateway->gatewaynum. '-'; - #} - # - #$paybatch .= "$processor:". $transaction->authorization; - # - #$paybatch .= ':'. $transaction->order_number - # if $transaction->can('order_number') - # && length($transaction->order_number); - - my $paybatch = 'FakeProcessor:54:32'; - - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $self->custnum, - 'invnum' => $options{'invnum'}, - 'paid' => $options{amount}, - '_date' => '', - 'payby' => $bop_method2payby{$options{method}}, - #'payinfo' => $payinfo, - 'payinfo' => '4111111111111111', - 'paybatch' => $paybatch, - #'paydate' => $paydate, - 'paydate' => '2012-05-01', - } ); - $cust_pay->payunique( $options{payunique} ) if length($options{payunique}); - - my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); - - if ( $error ) { - $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert( $options{'manual'} ? - ( 'manual' => 1 ) : () - ); - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH debited but database not updated - '. - "error inserting (fake!) payment: $error2". - " (previously tried insert with invnum #$options{'invnum'}" . - ": $error )"; - warn $e; - return $e; - } - } - - if ( $options{'paynum_ref'} ) { - ${ $options{'paynum_ref'} } = $cust_pay->paynum; - } - - return ''; #no error - -} - - -# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ] -# -# Wraps up processing of a realtime credit card, ACH (electronic check) or -# phone bill transaction. - -sub _realtime_bop_result { - my( $self, $cust_pay_pending, $transaction, %options ) = @_; - if ( $DEBUG ) { - warn "$me _realtime_bop_result: pending transaction ". - $cust_pay_pending->paypendingnum. "\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - my $payment_gateway = $options{payment_gateway} - or return "no payment gateway in arguments to _realtime_bop_result"; - - $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined'); - my $cpp_captured_err = $cust_pay_pending->replace; - return $cpp_captured_err if $cpp_captured_err; - - if ( $transaction->is_success() ) { - - my $paybatch = ''; - if ( $payment_gateway->gatewaynum ) { # agent override - $paybatch = $payment_gateway->gatewaynum. '-'; - } - - $paybatch .= $payment_gateway->gateway_module. ":". - $transaction->authorization; - - $paybatch .= ':'. $transaction->order_number - if $transaction->can('order_number') - && length($transaction->order_number); - - my $cust_pay = new FS::cust_pay ( { - 'custnum' => $self->custnum, - 'invnum' => $options{'invnum'}, - 'paid' => $cust_pay_pending->paid, - '_date' => '', - 'payby' => $cust_pay_pending->payby, - 'payinfo' => $options{'payinfo'}, - 'paybatch' => $paybatch, - 'paydate' => $cust_pay_pending->paydate, - 'pkgnum' => $cust_pay_pending->pkgnum, - } ); - #doesn't hurt to know, even though the dup check is in cust_pay_pending now - $cust_pay->payunique( $options{payunique} ) - if defined($options{payunique}) && length($options{payunique}); - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction - - my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); - - if ( $error ) { - $cust_pay->invnum(''); #try again with no specific invnum - my $error2 = $cust_pay->insert( $options{'manual'} ? - ( 'manual' => 1 ) : () - ); - if ( $error2 ) { - # gah. but at least we have a record of the state we had to abort in - # from cust_pay_pending now. - my $e = "WARNING: $options{method} captured but payment not recorded -". - " error inserting payment (". $payment_gateway->gateway_module. - "): $error2". - " (previously tried insert with invnum #$options{'invnum'}" . - ": $error ) - pending payment saved as paypendingnum ". - $cust_pay_pending->paypendingnum. "\n"; - warn $e; - return $e; - } - } - - my $jobnum = $cust_pay_pending->jobnum; - if ( $jobnum ) { - my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); - - unless ( $placeholder ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - my $e = "WARNING: $options{method} captured but job $jobnum not ". - "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n"; - warn $e; - return $e; - } - - $error = $placeholder->delete; - - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - my $e = "WARNING: $options{method} captured but could not delete ". - "job $jobnum for paypendingnum ". - $cust_pay_pending->paypendingnum. ": $error\n"; - warn $e; - return $e; - } - - } - - if ( $options{'paynum_ref'} ) { - ${ $options{'paynum_ref'} } = $cust_pay->paynum; - } - - $cust_pay_pending->status('done'); - $cust_pay_pending->statustext('captured'); - $cust_pay_pending->paynum($cust_pay->paynum); - my $cpp_done_err = $cust_pay_pending->replace; - - if ( $cpp_done_err ) { - - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - my $e = "WARNING: $options{method} captured but payment not recorded - ". - "error updating status for paypendingnum ". - $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; - warn $e; - return $e; - - } else { - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - if ( $options{'apply'} ) { - my $apply_error = $self->apply_payments_and_credits; - if ( $apply_error ) { - warn "WARNING: error applying payment: $apply_error\n"; - #but we still should return no error cause the payment otherwise went - #through... - } - } - - return ''; #no error - - } - - } else { - - my $perror = $payment_gateway->gateway_module. " error: ". - $transaction->error_message; - - my $jobnum = $cust_pay_pending->jobnum; - if ( $jobnum ) { - my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); - - if ( $placeholder ) { - my $error = $placeholder->depended_delete; - $error ||= $placeholder->delete; - warn "error removing provisioning jobs after declined paypendingnum ". - $cust_pay_pending->paypendingnum. "\n"; - } else { - my $e = "error finding job $jobnum for declined paypendingnum ". - $cust_pay_pending->paypendingnum. "\n"; - warn $e; - } - - } - - unless ( $transaction->error_message ) { - - my $t_response; - if ( $transaction->can('response_page') ) { - $t_response = { - 'page' => ( $transaction->can('response_page') - ? $transaction->response_page - : '' - ), - 'code' => ( $transaction->can('response_code') - ? $transaction->response_code - : '' - ), - 'headers' => ( $transaction->can('response_headers') - ? $transaction->response_headers - : '' - ), - }; - } else { - $t_response .= - "No additional debugging information available for ". - $payment_gateway->gateway_module; - } - - $perror .= "No error_message returned from ". - $payment_gateway->gateway_module. " -- ". - ( ref($t_response) ? Dumper($t_response) : $t_response ); - - } - - if ( !$options{'quiet'} && !$realtime_bop_decline_quiet - && $conf->exists('emaildecline') - && grep { $_ ne 'POST' } $self->invoicing_list - && ! grep { $transaction->error_message =~ /$_/ } - $conf->config('emaildecline-exclude') - ) { - - # Send a decline alert to the customer. - my $msgnum = $conf->config('decline_msgnum', $self->agentnum); - my $error = ''; - if ( $msgnum ) { - # include the raw error message in the transaction state - $cust_pay_pending->setfield('error', $transaction->error_message); - my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); - $error = $msg_template->send( 'cust_main' => $self, - 'object' => $cust_pay_pending ); - } - else { #!$msgnum - - my @templ = $conf->config('declinetemplate'); - my $template = new Text::Template ( - TYPE => 'ARRAY', - SOURCE => [ map "$_\n", @templ ], - ) or return "($perror) can't create template: $Text::Template::ERROR"; - $template->compile() - or return "($perror) can't compile template: $Text::Template::ERROR"; - - my $templ_hash = { - 'company_name' => - scalar( $conf->config('company_name', $self->agentnum ) ), - 'company_address' => - join("\n", $conf->config('company_address', $self->agentnum ) ), - 'error' => $transaction->error_message, - }; - - my $error = send_email( - 'from' => $conf->config('invoice_from', $self->agentnum ), - 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], - 'subject' => 'Your payment could not be processed', - 'body' => [ $template->fill_in(HASH => $templ_hash) ], - ); - } - - $perror .= " (also received error sending decline notification: $error)" - if $error; - - } - - $cust_pay_pending->status('done'); - $cust_pay_pending->statustext("declined: $perror"); - my $cpp_done_err = $cust_pay_pending->replace; - if ( $cpp_done_err ) { - my $e = "WARNING: $options{method} declined but pending payment not ". - "resolved - error updating status for paypendingnum ". - $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; - warn $e; - $perror = "$e ($perror)"; - } - - return $perror; - } - -} - -=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ] - -Verifies successful third party processing of a realtime credit card, -ACH (electronic check) or phone bill transaction via a -Business::OnlineThirdPartyPayment realtime gateway. See -L<http://420.am/business-onlinethirdpartypayment> for supported gateways. - -Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique> - -The additional options I<payname>, I<city>, I<state>, -I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -if set, will override the value from the customer record. - -I<description> is a free-text field passed to the gateway. It defaults to -"Internet services". - -If an I<invnum> is specified, this payment (if successful) is applied to the -specified invoice. If you don't specify an I<invnum> you might want to -call the B<apply_payments> method. - -I<quiet> can be set true to surpress email decline notices. - -I<paynum_ref> can be set to a scalar reference. It will be filled in with the -resulting paynum, if any. - -I<payunique> is a unique identifier for this payment. - -Returns a hashref containing elements bill_error (which will be undefined -upon success) and session_id of any associated session. - -=cut - -sub realtime_botpp_capture { - my( $self, $cust_pay_pending, %options ) = @_; - if ( $DEBUG ) { - warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - eval "use Business::OnlineThirdPartyPayment"; - die $@ if $@; - - ### - # select the gateway - ### - - my $method = FS::payby->payby2bop($cust_pay_pending->payby); - - my $payment_gateway = $cust_pay_pending->gatewaynum - ? qsearchs( 'payment_gateway', - { gatewaynum => $cust_pay_pending->gatewaynum } - ) - : $self->agent->payment_gateway( 'method' => $method, - # 'invnum' => $cust_pay_pending->invnum, - # 'payinfo' => $cust_pay_pending->payinfo, - ); - - $options{payment_gateway} = $payment_gateway; # for the helper subs - - ### - # massage data - ### - - my @invoicing_list = $self->invoicing_list_emailonly; - if ( $conf->exists('emailinvoiceautoalways') - || $conf->exists('emailinvoiceauto') && ! @invoicing_list - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my %content = (); - - $content{email_customer} = - ( $conf->exists('business-onlinepayment-email_customer') - || $conf->exists('business-onlinepayment-email-override') ); - - ### - # run transaction(s) - ### - - my $transaction = - new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module, - $self->_bop_options(\%options), - ); - - $transaction->reference({ %options }); - - $transaction->content( - 'type' => $method, - $self->_bop_auth(\%options), - 'action' => 'Post Authorization', - 'description' => $options{'description'}, - 'amount' => $cust_pay_pending->paid, - #'invoice_number' => $options{'invnum'}, - 'customer_id' => $self->custnum, - 'referer' => 'http://cleanwhisker.420.am/', - 'reference' => $cust_pay_pending->paypendingnum, - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - # plus whatever is required for bogus capture avoidance - ); - - $transaction->submit(); - - my $error = - $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); - - { - bill_error => $error, - session_id => $cust_pay_pending->session_id, - } - -} - -=item default_payment_gateway DEPRECATED -- use agent->payment_gateway - -=cut - -sub default_payment_gateway { - my( $self, $method ) = @_; - - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); - - #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n"; - - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $action, @bop_options ) = - $conf->config($bop_config); - $action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; - - ( $processor, $login, $password, $action, @bop_options ) -} +Documentation on realtime billing methods has been moved to +L<FS::cust_main::Billing_Realtime>. =item remove_cvv @@ -5458,332 +3131,6 @@ sub remove_cvv { ''; } -=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] - -Refunds a realtime credit card, ACH (electronic check) or phone bill transaction -via a Business::OnlinePayment realtime gateway. See -L<http://420.am/business-onlinepayment> for supported gateways. - -Available methods are: I<CC>, I<ECHECK> and I<LEC> - -Available options are: I<amount>, I<reason>, I<paynum>, I<paydate> - -Most gateways require a reference to an original payment transaction to refund, -so you probably need to specify a I<paynum>. - -I<amount> defaults to the original amount of the payment if not specified. - -I<reason> specifies a reason for the refund. - -I<paydate> specifies the expiration date for a credit card overriding the -value from the customer record or the payment record. Specified as yyyy-mm-dd - -Implementation note: If I<amount> is unspecified or equal to the amount of the -orignal payment, first an attempt is made to "void" the transaction via -the gateway (to cancel a not-yet settled transaction) and then if that fails, -the normal attempt is made to "refund" ("credit") the transaction via the -gateway is attempted. - -#The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, -#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, -#if set, will override the value from the customer record. - -#If an I<invnum> is specified, this payment (if successful) is applied to the -#specified invoice. If you don't specify an I<invnum> you might want to -#call the B<apply_payments> method. - -=cut - -#some false laziness w/realtime_bop, not enough to make it worth merging -#but some useful small subs should be pulled out -sub realtime_refund_bop { - my $self = shift; - - my %options = (); - if (ref($_[0]) eq 'HASH') { - %options = %{$_[0]}; - } else { - my $method = shift; - %options = @_; - $options{method} = $method; - } - - if ( $DEBUG ) { - warn "$me realtime_refund_bop (new): $options{method} refund\n"; - warn " $_ => $options{$_}\n" foreach keys %options; - } - - ### - # look up the original payment and optionally a gateway for that payment - ### - - my $cust_pay = ''; - my $amount = $options{'amount'}; - - my( $processor, $login, $password, @bop_options, $namespace ) ; - my( $auth, $order_number ) = ( '', '', '' ); - - if ( $options{'paynum'} ) { - - warn " paynum: $options{paynum}\n" if $DEBUG > 1; - $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) - or return "Unknown paynum $options{'paynum'}"; - $amount ||= $cust_pay->paid; - - $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ - or return "Can't parse paybatch for paynum $options{'paynum'}: ". - $cust_pay->paybatch; - my $gatewaynum = ''; - ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); - - if ( $gatewaynum ) { #gateway for the payment to be refunded - - my $payment_gateway = - qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); - die "payment gateway $gatewaynum not found" - unless $payment_gateway; - - $processor = $payment_gateway->gateway_module; - $login = $payment_gateway->gateway_username; - $password = $payment_gateway->gateway_password; - $namespace = $payment_gateway->gateway_namespace; - @bop_options = $payment_gateway->options; - - } else { #try the default gateway - - my $conf_processor; - my $payment_gateway = - $self->agent->payment_gateway('method' => $options{method}); - - ( $conf_processor, $login, $password, $namespace ) = - map { my $method = "gateway_$_"; $payment_gateway->$method } - qw( module username password namespace ); - - @bop_options = $payment_gateway->gatewaynum - ? $payment_gateway->options - : @{ $payment_gateway->get('options') }; - - return "processor of payment $options{'paynum'} $processor does not". - " match default processor $conf_processor" - unless $processor eq $conf_processor; - - } - - - } else { # didn't specify a paynum, so look for agent gateway overrides - # like a normal transaction - - my $payment_gateway = - $self->agent->payment_gateway( 'method' => $options{method}, - #'payinfo' => $payinfo, - ); - my( $processor, $login, $password, $namespace ) = - map { my $method = "gateway_$_"; $payment_gateway->$method } - qw( module username password namespace ); - - my @bop_options = $payment_gateway->gatewaynum - ? $payment_gateway->options - : @{ $payment_gateway->get('options') }; - - } - return "neither amount nor paynum specified" unless $amount; - - eval "use $namespace"; - die $@ if $@; - - my %content = ( - 'type' => $options{method}, - 'login' => $login, - 'password' => $password, - 'order_number' => $order_number, - 'amount' => $amount, - 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/ - ); - $content{authorization} = $auth - if length($auth); #echeck/ACH transactions have an order # but no auth - #(at least with authorize.net) - - my $disable_void_after; - if ($conf->exists('disable_void_after') - && $conf->config('disable_void_after') =~ /^(\d+)$/) { - $disable_void_after = $1; - } - - #first try void if applicable - if ( $cust_pay && $cust_pay->paid == $amount - && ( - ( not defined($disable_void_after) ) - || ( time < ($cust_pay->_date + $disable_void_after ) ) - ) - ) { - warn " attempting void\n" if $DEBUG > 1; - my $void = new Business::OnlinePayment( $processor, @bop_options ); - if ( $void->can('info') ) { - if ( $cust_pay->payby eq 'CARD' - && $void->info('CC_void_requires_card') ) - { - $content{'card_number'} = $cust_pay->payinfo; - } elsif ( $cust_pay->payby eq 'CHEK' - && $void->info('ECHECK_void_requires_account') ) - { - ( $content{'account_number'}, $content{'routing_code'} ) = - split('@', $cust_pay->payinfo); - $content{'name'} = $self->get('first'). ' '. $self->get('last'); - } - } - $void->content( 'action' => 'void', %content ); - $void->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); - $void->submit(); - if ( $void->is_success ) { - my $error = $cust_pay->void($options{'reason'}); - if ( $error ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH voided but database not updated - '. - "error voiding payment: $error"; - warn $e; - return $e; - } - warn " void successful\n" if $DEBUG > 1; - return ''; - } - } - - warn " void unsuccessful, trying refund\n" - if $DEBUG > 1; - - #massage data - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - - my($payname, $payfirst, $paylast); - if ( $self->payname && $options{method} ne 'ECHECK' ) { - $payname = $self->payname; - $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ - or return "Illegal payname $payname"; - ($payfirst, $paylast) = ($1, $2); - } else { - $payfirst = $self->getfield('first'); - $paylast = $self->getfield('last'); - $payname = "$payfirst $paylast"; - } - - my @invoicing_list = $self->invoicing_list_emailonly; - if ( $conf->exists('emailinvoiceautoalways') - || $conf->exists('emailinvoiceauto') && ! @invoicing_list - || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { - push @invoicing_list, $self->all_emails; - } - - my $email = ($conf->exists('business-onlinepayment-email-override')) - ? $conf->config('business-onlinepayment-email-override') - : $invoicing_list[0]; - - my $payip = exists($options{'payip'}) - ? $options{'payip'} - : $self->payip; - $content{customer_ip} = $payip - if length($payip); - - my $payinfo = ''; - if ( $options{method} eq 'CC' ) { - - if ( $cust_pay ) { - $content{card_number} = $payinfo = $cust_pay->payinfo; - (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate) - =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ && - ($content{expiration} = "$2/$1"); # where available - } else { - $content{card_number} = $payinfo = $self->payinfo; - (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate) - =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - } - - } elsif ( $options{method} eq 'ECHECK' ) { - - if ( $cust_pay ) { - $payinfo = $cust_pay->payinfo; - } else { - $payinfo = $self->payinfo; - } - ( $content{account_number}, $content{routing_code} )= split('@', $payinfo ); - $content{bank_name} = $self->payname; - $content{account_type} = 'CHECKING'; - $content{account_name} = $payname; - $content{customer_org} = $self->company ? 'B' : 'I'; - $content{customer_ssn} = $self->ss; - } elsif ( $options{method} eq 'LEC' ) { - $content{phone} = $payinfo = $self->payinfo; - } - - #then try refund - my $refund = new Business::OnlinePayment( $processor, @bop_options ); - my %sub_content = $refund->content( - 'action' => 'credit', - 'customer_id' => $self->custnum, - 'last_name' => $paylast, - 'first_name' => $payfirst, - 'name' => $payname, - 'address' => $address, - 'city' => $self->city, - 'state' => $self->state, - 'zip' => $self->zip, - 'country' => $self->country, - 'email' => $email, - 'phone' => $self->daytime || $self->night, - %content, #after - ); - warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) - if $DEBUG > 1; - $refund->test_transaction(1) - if $conf->exists('business-onlinepayment-test_transaction'); - $refund->submit(); - - return "$processor error: ". $refund->error_message - unless $refund->is_success(); - - my $paybatch = "$processor:". $refund->authorization; - $paybatch .= ':'. $refund->order_number - if $refund->can('order_number') && $refund->order_number; - - while ( $cust_pay && $cust_pay->unapplied < $amount ) { - my @cust_bill_pay = $cust_pay->cust_bill_pay; - last unless @cust_bill_pay; - my $cust_bill_pay = pop @cust_bill_pay; - my $error = $cust_bill_pay->delete; - last if $error; - } - - my $cust_refund = new FS::cust_refund ( { - 'custnum' => $self->custnum, - 'paynum' => $options{'paynum'}, - 'refund' => $amount, - '_date' => '', - 'payby' => $bop_method2payby{$options{method}}, - 'payinfo' => $payinfo, - 'paybatch' => $paybatch, - 'reason' => $options{'reason'} || 'card or ACH refund', - } ); - my $error = $cust_refund->insert; - if ( $error ) { - $cust_refund->paynum(''); #try again with no specific paynum - my $error2 = $cust_refund->insert; - if ( $error2 ) { - # gah, even with transactions. - my $e = 'WARNING: Card/ACH refunded but database not updated - '. - "error inserting refund ($processor): $error2". - " (previously tried insert with paynum #$options{'paynum'}" . - ": $error )"; - warn $e; - return $e; - } - } - - ''; #no error - -} - =item batch_card OPTION => VALUE... Adds a payment for this invoice to the pending credit card batch (see @@ -5914,244 +3261,6 @@ sub batch_card { ''; } -=item apply_payments_and_credits [ OPTION => VALUE ... ] - -Applies unapplied payments and credits. - -In most cases, this new method should be used in place of sequential -apply_payments and apply_credits methods. - -A hash of optional arguments may be passed. Currently "manual" is supported. -If true, a payment receipt is sent instead of a statement when -'payment_receipt_email' configuration option is set. - -If there is an error, returns the error, otherwise returns false. - -=cut - -sub apply_payments_and_credits { - my( $self, %options ) = @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - foreach my $cust_bill ( $self->open_cust_bill ) { - my $error = $cust_bill->apply_payments_and_credits(%options); - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "Error applying: $error"; - } - } - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - ''; #no error - -} - -=item apply_credits OPTION => VALUE ... - -Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>) -to outstanding invoice balances in chronological order (or reverse -chronological order if the I<order> option is set to B<newest>) and returns the -value of any remaining unapplied credits available for refund (see -L<FS::cust_refund>). - -Dies if there is an error. - -=cut - -sub apply_credits { - my $self = shift; - my %opt = @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - unless ( $self->total_unapplied_credits ) { - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - return 0; - } - - my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } - qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); - - my @invoices = $self->open_cust_bill; - @invoices = sort { $b->_date <=> $a->_date } @invoices - if defined($opt{'order'}) && $opt{'order'} eq 'newest'; - - if ( $conf->exists('pkg-balances') ) { - # limit @credits to those w/ a pkgnum grepped from $self - my %pkgnums = (); - foreach my $i (@invoices) { - foreach my $li ( $i->cust_bill_pkg ) { - $pkgnums{$li->pkgnum} = 1; - } - } - @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits; - } - - my $credit; - - foreach my $cust_bill ( @invoices ) { - - if ( !defined($credit) || $credit->credited == 0) { - $credit = pop @credits or last; - } - - my $owed; - if ( $conf->exists('pkg-balances') && $credit->pkgnum ) { - $owed = $cust_bill->owed_pkgnum($credit->pkgnum); - } else { - $owed = $cust_bill->owed; - } - unless ( $owed > 0 ) { - push @credits, $credit; - next; - } - - my $amount = min( $credit->credited, $owed ); - - my $cust_credit_bill = new FS::cust_credit_bill ( { - 'crednum' => $credit->crednum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - $cust_credit_bill->pkgnum( $credit->pkgnum ) - if $conf->exists('pkg-balances') && $credit->pkgnum; - my $error = $cust_credit_bill->insert; - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - - redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); - - } - - my $total_unapplied_credits = $self->total_unapplied_credits; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return $total_unapplied_credits; -} - -=item apply_payments [ OPTION => VALUE ... ] - -Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>) -to outstanding invoice balances in chronological order. - - #and returns the value of any remaining unapplied payments. - -A hash of optional arguments may be passed. Currently "manual" is supported. -If true, a payment receipt is sent instead of a statement when -'payment_receipt_email' configuration option is set. - -Dies if there is an error. - -=cut - -sub apply_payments { - my( $self, %options ) = @_; - - local $SIG{HUP} = 'IGNORE'; - local $SIG{INT} = 'IGNORE'; - local $SIG{QUIT} = 'IGNORE'; - local $SIG{TERM} = 'IGNORE'; - local $SIG{TSTP} = 'IGNORE'; - local $SIG{PIPE} = 'IGNORE'; - - my $oldAutoCommit = $FS::UID::AutoCommit; - local $FS::UID::AutoCommit = 0; - my $dbh = dbh; - - $self->select_for_update; #mutex - - #return 0 unless - - my @payments = sort { $b->_date <=> $a->_date } - grep { $_->unapplied > 0 } - $self->cust_pay; - - my @invoices = sort { $a->_date <=> $b->_date} - grep { $_->owed > 0 } - $self->cust_bill; - - if ( $conf->exists('pkg-balances') ) { - # limit @payments to those w/ a pkgnum grepped from $self - my %pkgnums = (); - foreach my $i (@invoices) { - foreach my $li ( $i->cust_bill_pkg ) { - $pkgnums{$li->pkgnum} = 1; - } - } - @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments; - } - - my $payment; - - foreach my $cust_bill ( @invoices ) { - - if ( !defined($payment) || $payment->unapplied == 0 ) { - $payment = pop @payments or last; - } - - my $owed; - if ( $conf->exists('pkg-balances') && $payment->pkgnum ) { - $owed = $cust_bill->owed_pkgnum($payment->pkgnum); - } else { - $owed = $cust_bill->owed; - } - unless ( $owed > 0 ) { - push @payments, $payment; - next; - } - - my $amount = min( $payment->unapplied, $owed ); - - my $cust_bill_pay = new FS::cust_bill_pay ( { - 'paynum' => $payment->paynum, - 'invnum' => $cust_bill->invnum, - 'amount' => $amount, - } ); - $cust_bill_pay->pkgnum( $payment->pkgnum ) - if $conf->exists('pkg-balances') && $payment->pkgnum; - my $error = $cust_bill_pay->insert(%options); - if ( $error ) { - $dbh->rollback or die $dbh->errstr if $oldAutoCommit; - die $error; - } - - redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); - - } - - my $total_unapplied_payments = $self->total_unapplied_payments; - - $dbh->commit or die $dbh->errstr if $oldAutoCommit; - - return $total_unapplied_payments; -} - =item total_owed Returns the total owed for this customer on all invoices diff --git a/FS/FS/cust_main/Billing.pm b/FS/FS/cust_main/Billing.pm new file mode 100644 index 000000000..a262cf6c9 --- /dev/null +++ b/FS/FS/cust_main/Billing.pm @@ -0,0 +1,1549 @@ +package FS::cust_main::Billing; + +use strict; +use vars qw( $conf $DEBUG $me ); +use Carp; +use FS::UID qw( dbh ); +use FS::Record qw( qsearch qsearchs ); +use FS::cust_bill; +use FS::cust_bill_pkg; +use FS::cust_bill_pkg_display; +use FS::cust_bill_pay; +use FS::cust_credit_bill; +use FS::cust_pkg; +use FS::cust_tax_adjustment; +use FS::tax_rate; +use FS::tax_rate_location; +use FS::cust_bill_pkg_tax_location; +use FS::cust_bill_pkg_tax_rate_location; + +# 1 is mostly method/subroutine entry and options +# 2 traces progress of some operations +# 3 is even more information including possibly sensitive data +$DEBUG = 0; +$me = '[FS::cust_main::Billing]'; + +install_callback FS::UID sub { + $conf = new FS::Conf; + #yes, need it for stuff below (prolly should be cached) +}; + +=head1 NAME + +FS::cust_main::Billing - Billing mixin for cust_main + +=head1 SYNOPSIS + +=head1 DESCRIPTIONS + +These methods are available on FS::cust_main objects. + +=head1 METHODS + +=over 4 + +=item bill_and_collect + +Cancels and suspends any packages due, generates bills, applies payments and +credits, and applies collection events to run cards, send bills and notices, +etc. + +By default, warns on errors and continues with the next operation (but see the +"fatal" flag below). + +Options are passed as name-value pairs. Currently available options are: + +=over 4 + +=item time + +Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + +=item invoice_time + +Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. + +=item check_freq + +"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) + +=item resetup + +If set true, re-charges setup fees. + +=item fatal + +If set any errors prevent subsequent operations from continusing. If set +specifically to "return", returns the error (or false, if there is no error). +Any other true value causes errors to die. + +=item debug + +Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) + +=item job + +Optional FS::queue entry to receive status updates. + +=back + +Options are passed to the B<bill> and B<collect> methods verbatim, so all +options of those methods are also available. + +=cut + +sub bill_and_collect { + my( $self, %options ) = @_; + + my $error; + + #$options{actual_time} not $options{time} because freeside-daily -d is for + #pre-printing invoices + + $options{'actual_time'} ||= time; + my $job = $options{'job'}; + + $job->update_statustext('0,cleaning expired packages') if $job; + $error = $self->cancel_expired_pkgs( $options{actual_time} ); + if ( $error ) { + $error = "Error expiring custnum ". $self->custnum. ": $error"; + if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } + elsif ( $options{fatal} ) { die $error; } + else { warn $error; } + } + + $error = $self->suspend_adjourned_pkgs( $options{actual_time} ); + if ( $error ) { + $error = "Error adjourning custnum ". $self->custnum. ": $error"; + if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } + elsif ( $options{fatal} ) { die $error; } + else { warn $error; } + } + + $job->update_statustext('20,billing packages') if $job; + $error = $self->bill( %options ); + if ( $error ) { + $error = "Error billing custnum ". $self->custnum. ": $error"; + if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } + elsif ( $options{fatal} ) { die $error; } + else { warn $error; } + } + + $job->update_statustext('50,applying payments and credits') if $job; + $error = $self->apply_payments_and_credits; + if ( $error ) { + $error = "Error applying custnum ". $self->custnum. ": $error"; + if ( $options{fatal} && $options{fatal} eq 'return' ) { return $error; } + elsif ( $options{fatal} ) { die $error; } + else { warn $error; } + } + + $job->update_statustext('70,running collection events') if $job; + unless ( $conf->exists('cancelled_cust-noevents') + && ! $self->num_ncancelled_pkgs + ) { + $error = $self->collect( %options ); + if ( $error ) { + $error = "Error collecting custnum ". $self->custnum. ": $error"; + if ($options{fatal} && $options{fatal} eq 'return') { return $error; } + elsif ($options{fatal} ) { die $error; } + else { warn $error; } + } + } + $job->update_statustext('100,finished') if $job; + + ''; + +} + +sub cancel_expired_pkgs { + my ( $self, $time, %options ) = @_; + + my @cancel_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => " AND expire IS NOT NULL AND expire > 0 AND expire <= $time " + } ); + + my @errors = (); + + foreach my $cust_pkg ( @cancel_pkgs ) { + my $cpr = $cust_pkg->last_cust_pkg_reason('expire'); + my $error = $cust_pkg->cancel($cpr ? ( 'reason' => $cpr->reasonnum, + 'reason_otaker' => $cpr->otaker + ) + : () + ); + push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error; + } + + scalar(@errors) ? join(' / ', @errors) : ''; + +} + +sub suspend_adjourned_pkgs { + my ( $self, $time, %options ) = @_; + + my @susp_pkgs = $self->ncancelled_pkgs( { + 'extra_sql' => + " AND ( susp IS NULL OR susp = 0 ) + AND ( ( bill IS NOT NULL AND bill != 0 AND bill < $time ) + OR ( adjourn IS NOT NULL AND adjourn != 0 AND adjourn <= $time ) + ) + ", + } ); + + #only because there's no SQL test for is_prepaid :/ + @susp_pkgs = + grep { ( $_->part_pkg->is_prepaid + && $_->bill + && $_->bill < $time + ) + || ( $_->adjourn + && $_->adjourn <= $time + ) + + } + @susp_pkgs; + + my @errors = (); + + foreach my $cust_pkg ( @susp_pkgs ) { + my $cpr = $cust_pkg->last_cust_pkg_reason('adjourn') + if ($cust_pkg->adjourn && $cust_pkg->adjourn < $^T); + my $error = $cust_pkg->suspend($cpr ? ( 'reason' => $cpr->reasonnum, + 'reason_otaker' => $cpr->otaker + ) + : () + ); + push @errors, 'pkgnum '.$cust_pkg->pkgnum.": $error" if $error; + } + + scalar(@errors) ? join(' / ', @errors) : ''; + +} + +=item bill OPTIONS + +Generates invoices (see L<FS::cust_bill>) for this customer. Usually used in +conjunction with the collect method by calling B<bill_and_collect>. + +If there is an error, returns the error, otherwise returns false. + +Options are passed as name-value pairs. Currently available options are: + +=over 4 + +=item resetup + +If set true, re-charges setup fees. + +=item time + +Bills the customer as if it were that time. Specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); + +=item pkg_list + +An array ref of specific packages (objects) to attempt billing, instead trying all of them. + + $cust_main->bill( pkg_list => [$pkg1, $pkg2] ); + +=item not_pkgpart + +A hashref of pkgparts to exclude from this billing run (can also be specified as a comma-separated scalar). + +=item invoice_time + +Used in conjunction with the I<time> option, this option specifies the date of for the generated invoices. Other calculations, such as whether or not to generate the invoice in the first place, are not affected. + +=item cancel + +This boolean value informs the us that the package is being cancelled. This +typically might mean not charging the normal recurring fee but only usage +fees since the last billing. Setup charges may be charged. Not all package +plans support this feature (they tend to charge 0). + +=item invoice_terms + +Optional terms to be printed on this invoice. Otherwise, customer-specific +terms or the default terms are used. + +=back + +=cut + +sub bill { + my( $self, %options ) = @_; + return '' if $self->payby eq 'COMP'; + warn "$me bill customer ". $self->custnum. "\n" + if $DEBUG; + + my $time = $options{'time'} || time; + my $invoice_time = $options{'invoice_time'} || $time; + + $options{'not_pkgpart'} ||= {}; + $options{'not_pkgpart'} = { map { $_ => 1 } + split(/\s*,\s*/, $options{'not_pkgpart'}) + } + unless ref($options{'not_pkgpart'}); + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + warn "$me acquiring lock on customer ". $self->custnum. "\n" + if $DEBUG; + + $self->select_for_update; #mutex + + warn "$me running pre-bill events for customer ". $self->custnum. "\n" + if $DEBUG; + + my $error = $self->do_cust_event( + 'debug' => ( $options{'debug'} || 0 ), + 'time' => $invoice_time, + 'check_freq' => $options{'check_freq'}, + 'stage' => 'pre-bill', + ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + warn "$me done running pre-bill events for customer ". $self->custnum. "\n" + if $DEBUG; + + #keep auto-charge and non-auto-charge line items separate + my @passes = ( '', 'no_auto' ); + + my %cust_bill_pkg = map { $_ => [] } @passes; + + ### + # find the packages which are due for billing, find out how much they are + # & generate invoice database. + ### + + my %total_setup = map { my $z = 0; $_ => \$z; } @passes; + my %total_recur = map { my $z = 0; $_ => \$z; } @passes; + + my %taxlisthash = map { $_ => {} } @passes; + + my @precommit_hooks = (); + + $options{'pkg_list'} ||= [ $self->ncancelled_pkgs ]; #param checks? + foreach my $cust_pkg ( @{ $options{'pkg_list'} } ) { + + next if $options{'not_pkgpart'}->{$cust_pkg->pkgpart}; + + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; + + #? to avoid use of uninitialized value errors... ? + $cust_pkg->setfield('bill', '') + unless defined($cust_pkg->bill); + + #my $part_pkg = $cust_pkg->part_pkg; + + my $real_pkgpart = $cust_pkg->pkgpart; + my %hash = $cust_pkg->hash; + + # we could implement this bit as FS::part_pkg::has_hidden, but we already + # suffer from performance issues + $options{has_hidden} = 0; + my @part_pkg = $cust_pkg->part_pkg->self_and_bill_linked; + $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); + + foreach my $part_pkg ( @part_pkg ) { + + $cust_pkg->set($_, $hash{$_}) foreach qw ( setup last_bill bill ); + + my $pass = ($cust_pkg->no_auto || $part_pkg->no_auto) ? 'no_auto' : ''; + + my $error = + $self->_make_lines( 'part_pkg' => $part_pkg, + 'cust_pkg' => $cust_pkg, + 'precommit_hooks' => \@precommit_hooks, + 'line_items' => $cust_bill_pkg{$pass}, + 'setup' => $total_setup{$pass}, + 'recur' => $total_recur{$pass}, + 'tax_matrix' => $taxlisthash{$pass}, + 'time' => $time, + 'real_pkgpart' => $real_pkgpart, + 'options' => \%options, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + } #foreach my $part_pkg + + } #foreach my $cust_pkg + + #if the customer isn't on an automatic payby, everything can go on a single + #invoice anyway? + #if ( $cust_main->payby !~ /^(CARD|CHEK)$/ ) { + #merge everything into one list + #} + + foreach my $pass (@passes) { # keys %cust_bill_pkg ) { + + my @cust_bill_pkg = _omit_zero_value_bundles(@{ $cust_bill_pkg{$pass} }); + + next unless @cust_bill_pkg; #don't create an invoice w/o line items + + if ( scalar( grep { $_->recur && $_->recur > 0 } @cust_bill_pkg) || + !$conf->exists('postal_invoice-recurring_only') + ) + { + + my $postal_pkg = $self->charge_postal_fee(); + if ( $postal_pkg && !ref( $postal_pkg ) ) { + + $dbh->rollback if $oldAutoCommit; + return "can't charge postal invoice fee for customer ". + $self->custnum. ": $postal_pkg"; + + } elsif ( $postal_pkg ) { + + my $real_pkgpart = $postal_pkg->pkgpart; + # we could implement this bit as FS::part_pkg::has_hidden, but we already + # suffer from performance issues + $options{has_hidden} = 0; + my @part_pkg = $postal_pkg->part_pkg->self_and_bill_linked; + $options{has_hidden} = 1 if ($part_pkg[1] && $part_pkg[1]->hidden); + + foreach my $part_pkg ( @part_pkg ) { + my %postal_options = %options; + delete $postal_options{cancel}; + my $error = + $self->_make_lines( 'part_pkg' => $part_pkg, + 'cust_pkg' => $postal_pkg, + 'precommit_hooks' => \@precommit_hooks, + 'line_items' => \@cust_bill_pkg, + 'setup' => $total_setup{$pass}, + 'recur' => $total_recur{$pass}, + 'tax_matrix' => $taxlisthash{$pass}, + 'time' => $time, + 'real_pkgpart' => $real_pkgpart, + 'options' => \%postal_options, + ); + if ($error) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + # it's silly to have a zero value postal_pkg, but.... + @cust_bill_pkg = _omit_zero_value_bundles(@cust_bill_pkg); + + } + + } + + my $listref_or_error = + $self->calculate_taxes( \@cust_bill_pkg, $taxlisthash{$pass}, $invoice_time); + + unless ( ref( $listref_or_error ) ) { + $dbh->rollback if $oldAutoCommit; + return $listref_or_error; + } + + foreach my $taxline ( @$listref_or_error ) { + ${ $total_setup{$pass} } = + sprintf('%.2f', ${ $total_setup{$pass} } + $taxline->setup ); + push @cust_bill_pkg, $taxline; + } + + #add tax adjustments + warn "adding tax adjustments...\n" if $DEBUG > 2; + foreach my $cust_tax_adjustment ( + qsearch('cust_tax_adjustment', { 'custnum' => $self->custnum, + 'billpkgnum' => '', + } + ) + ) { + + my $tax = sprintf('%.2f', $cust_tax_adjustment->amount ); + + my $itemdesc = $cust_tax_adjustment->taxname; + $itemdesc = '' if $itemdesc eq 'Tax'; + + push @cust_bill_pkg, new FS::cust_bill_pkg { + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $itemdesc, + 'itemcomment' => $cust_tax_adjustment->comment, + 'cust_tax_adjustment' => $cust_tax_adjustment, + #'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, + }; + + } + + my $charged = sprintf('%.2f', ${ $total_setup{$pass} } + ${ $total_recur{$pass} } ); + + my @cust_bill = $self->cust_bill; + my $balance = $self->balance; + my $previous_balance = scalar(@cust_bill) + ? ( $cust_bill[$#cust_bill]->billing_balance || 0 ) + : 0; + + $previous_balance += $cust_bill[$#cust_bill]->charged + if scalar(@cust_bill); + #my $balance_adjustments = + # sprintf('%.2f', $balance - $prior_prior_balance - $prior_charged); + + #create the new invoice + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->custnum, + '_date' => ( $invoice_time ), + 'charged' => $charged, + 'billing_balance' => $balance, + 'previous_balance' => $previous_balance, + 'invoice_terms' => $options{'invoice_terms'}, + } ); + $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice for customer #". $self->custnum. ": $error"; + } + + foreach my $cust_bill_pkg ( @cust_bill_pkg ) { + $cust_bill_pkg->invnum($cust_bill->invnum); + my $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item: $error"; + } + } + + } #foreach my $pass ( keys %cust_bill_pkg ) + + foreach my $hook ( @precommit_hooks ) { + eval { + &{$hook}; #($self) ? + }; + if ( $@ ) { + $dbh->rollback if $oldAutoCommit; + return "$@ running precommit hook $hook\n"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error +} + +#discard bundled packages of 0 value +sub _omit_zero_value_bundles { + + my @cust_bill_pkg = (); + my @cust_bill_pkg_bundle = (); + my $sum = 0; + + foreach my $cust_bill_pkg ( @_ ) { + if (scalar(@cust_bill_pkg_bundle) && !$cust_bill_pkg->pkgpart_override) { + push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0; + @cust_bill_pkg_bundle = (); + $sum = 0; + } + $sum += $cust_bill_pkg->setup + $cust_bill_pkg->recur; + push @cust_bill_pkg_bundle, $cust_bill_pkg; + } + push @cust_bill_pkg, @cust_bill_pkg_bundle if $sum > 0; + + (@cust_bill_pkg); + +} + +=item calculate_taxes LINEITEMREF TAXHASHREF INVOICE_TIME + +This is a weird one. Perhaps it should not even be exposed. + +Generates tax line items (see L<FS::cust_bill_pkg>) for this customer. +Usually used internally by bill method B<bill>. + +If there is an error, returns the error, otherwise returns reference to a +list of line items suitable for insertion. + +=over 4 + +=item LINEITEMREF + +An array ref of the line items being billed. + +=item TAXHASHREF + +A strange beast. The keys to this hash are internal identifiers consisting +of the name of the tax object type, a space, and its unique identifier ( e.g. + 'cust_main_county 23' ). The values of the hash are listrefs. The first +item in the list is the tax object. The remaining items are either line +items or floating point values (currency amounts). + +The taxes are calculated on this entity. Calculated exemption records are +transferred to the LINEITEMREF items on the assumption that they are related. + +Read the source. + +=item INVOICE_TIME + +This specifies the date appearing on the associated invoice. Some +jurisdictions (i.e. Texas) have tax exemptions which are date sensitive. + +=back + +=cut +sub calculate_taxes { + my ($self, $cust_bill_pkg, $taxlisthash, $invoice_time) = @_; + + my @tax_line_items = (); + + warn "having a look at the taxes we found...\n" if $DEBUG > 2; + + # keys are tax names (as printed on invoices / itemdesc ) + # values are listrefs of taxlisthash keys (internal identifiers) + my %taxname = (); + + # keys are taxlisthash keys (internal identifiers) + # values are (cumulative) amounts + my %tax = (); + + # keys are taxlisthash keys (internal identifiers) + # values are listrefs of cust_bill_pkg_tax_location hashrefs + my %tax_location = (); + + # keys are taxlisthash keys (internal identifiers) + # values are listrefs of cust_bill_pkg_tax_rate_location hashrefs + my %tax_rate_location = (); + + foreach my $tax ( keys %$taxlisthash ) { + my $tax_object = shift @{ $taxlisthash->{$tax} }; + warn "found ". $tax_object->taxname. " as $tax\n" if $DEBUG > 2; + warn " ". join('/', @{ $taxlisthash->{$tax} } ). "\n" if $DEBUG > 2; + my $hashref_or_error = + $tax_object->taxline( $taxlisthash->{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time + ); + return $hashref_or_error unless ref($hashref_or_error); + + unshift @{ $taxlisthash->{$tax} }, $tax_object; + + my $name = $hashref_or_error->{'name'}; + my $amount = $hashref_or_error->{'amount'}; + + #warn "adding $amount as $name\n"; + $taxname{ $name } ||= []; + push @{ $taxname{ $name } }, $tax; + + $tax{ $tax } += $amount; + + $tax_location{ $tax } ||= []; + if ( $tax_object->get('pkgnum') || $tax_object->get('locationnum') ) { + push @{ $tax_location{ $tax } }, + { + 'taxnum' => $tax_object->taxnum, + 'taxtype' => ref($tax_object), + 'pkgnum' => $tax_object->get('pkgnum'), + 'locationnum' => $tax_object->get('locationnum'), + 'amount' => sprintf('%.2f', $amount ), + }; + } + + $tax_rate_location{ $tax } ||= []; + if ( ref($tax_object) eq 'FS::tax_rate' ) { + my $taxratelocationnum = + $tax_object->tax_rate_location->taxratelocationnum; + push @{ $tax_rate_location{ $tax } }, + { + 'taxnum' => $tax_object->taxnum, + 'taxtype' => ref($tax_object), + 'amount' => sprintf('%.2f', $amount ), + 'locationtaxid' => $tax_object->location, + 'taxratelocationnum' => $taxratelocationnum, + }; + } + + } + + #move the cust_tax_exempt_pkg records to the cust_bill_pkgs we will commit + my %packagemap = map { $_->pkgnum => $_ } @$cust_bill_pkg; + foreach my $tax ( keys %$taxlisthash ) { + foreach ( @{ $taxlisthash->{$tax} }[1 ... scalar(@{ $taxlisthash->{$tax} })] ) { + next unless ref($_) eq 'FS::cust_bill_pkg'; + + push @{ $packagemap{$_->pkgnum}->_cust_tax_exempt_pkg }, + splice( @{ $_->_cust_tax_exempt_pkg } ); + } + } + + #consolidate and create tax line items + warn "consolidating and generating...\n" if $DEBUG > 2; + foreach my $taxname ( keys %taxname ) { + my $tax = 0; + my %seen = (); + my @cust_bill_pkg_tax_location = (); + my @cust_bill_pkg_tax_rate_location = (); + warn "adding $taxname\n" if $DEBUG > 1; + foreach my $taxitem ( @{ $taxname{$taxname} } ) { + next if $seen{$taxitem}++; + warn "adding $tax{$taxitem}\n" if $DEBUG > 1; + $tax += $tax{$taxitem}; + push @cust_bill_pkg_tax_location, + map { new FS::cust_bill_pkg_tax_location $_ } + @{ $tax_location{ $taxitem } }; + push @cust_bill_pkg_tax_rate_location, + map { new FS::cust_bill_pkg_tax_rate_location $_ } + @{ $tax_rate_location{ $taxitem } }; + } + next unless $tax; + + $tax = sprintf('%.2f', $tax ); + + my $pkg_category = qsearchs( 'pkg_category', { 'categoryname' => $taxname, + 'disabled' => '', + }, + ); + + my @display = (); + if ( $pkg_category and + $conf->config('invoice_latexsummary') || + $conf->config('invoice_htmlsummary') + ) + { + + my %hash = ( 'section' => $pkg_category->categoryname ); + push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; + + } + + push @tax_line_items, new FS::cust_bill_pkg { + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + 'display' => \@display, + 'cust_bill_pkg_tax_location' => \@cust_bill_pkg_tax_location, + 'cust_bill_pkg_tax_rate_location' => \@cust_bill_pkg_tax_rate_location, + }; + + } + + \@tax_line_items; +} + +sub _make_lines { + my ($self, %params) = @_; + + my $part_pkg = $params{part_pkg} or die "no part_pkg specified"; + my $cust_pkg = $params{cust_pkg} or die "no cust_pkg specified"; + my $precommit_hooks = $params{precommit_hooks} or die "no package specified"; + my $cust_bill_pkgs = $params{line_items} or die "no line buffer specified"; + my $total_setup = $params{setup} or die "no setup accumulator specified"; + my $total_recur = $params{recur} or die "no recur accumulator specified"; + my $taxlisthash = $params{tax_matrix} or die "no tax accumulator specified"; + my $time = $params{'time'} or die "no time specified"; + my (%options) = %{$params{options}}; + + my $dbh = dbh; + my $real_pkgpart = $params{real_pkgpart}; + my %hash = $cust_pkg->hash; + my $old_cust_pkg = new FS::cust_pkg \%hash; + + my @details = (); + my @discounts = (); + my $lineitems = 0; + + $cust_pkg->pkgpart($part_pkg->pkgpart); + + ### + # bill setup + ### + + my $setup = 0; + my $unitsetup = 0; + if ( $options{'resetup'} + || ( ! $cust_pkg->setup + && ( ! $cust_pkg->start_date + || $cust_pkg->start_date <= $time + ) + && ( ! $conf->exists('disable_setup_suspended_pkgs') + || ( $conf->exists('disable_setup_suspended_pkgs') && + ! $cust_pkg->getfield('susp') + ) + ) + ) + ) + { + + warn " bill setup\n" if $DEBUG > 1; + $lineitems++; + + $setup = eval { $cust_pkg->calc_setup( $time, \@details ) }; + return "$@ running calc_setup for $cust_pkg\n" + if $@; + + $unitsetup = $cust_pkg->part_pkg->unit_setup || $setup; #XXX uuh + + $cust_pkg->setfield('setup', $time) + unless $cust_pkg->setup; + #do need it, but it won't get written to the db + #|| $cust_pkg->pkgpart != $real_pkgpart; + + $cust_pkg->setfield('start_date', '') + if $cust_pkg->start_date; + + } + + ### + # bill recurring fee + ### + + #XXX unit stuff here too + my $recur = 0; + my $unitrecur = 0; + my $sdate; + if ( ! $cust_pkg->get('susp') + and ! $cust_pkg->get('start_date') + and ( $part_pkg->getfield('freq') ne '0' + && ( $cust_pkg->getfield('bill') || 0 ) <= $time + ) + || ( $part_pkg->plan eq 'voip_cdr' + && $part_pkg->option('bill_every_call') + ) + || ( $options{cancel} ) + ) { + + # XXX should this be a package event? probably. events are called + # at collection time at the moment, though... + $part_pkg->reset_usage($cust_pkg, 'debug'=>$DEBUG) + if $part_pkg->can('reset_usage'); + #don't want to reset usage just cause we want a line item?? + #&& $part_pkg->pkgpart == $real_pkgpart; + + warn " bill recur\n" if $DEBUG > 1; + $lineitems++; + + # XXX shared with $recur_prog + $sdate = ( $options{cancel} ? $cust_pkg->last_bill : $cust_pkg->bill ) + || $cust_pkg->setup + || $time; + + #over two params! lets at least switch to a hashref for the rest... + my $increment_next_bill = ( $part_pkg->freq ne '0' + && ( $cust_pkg->getfield('bill') || 0 ) <= $time + && !$options{cancel} + ); + my %param = ( 'precommit_hooks' => $precommit_hooks, + 'increment_next_bill' => $increment_next_bill, + 'discounts' => \@discounts, + 'real_pkgpart' => $real_pkgpart, + ); + + my $method = $options{cancel} ? 'calc_cancel' : 'calc_recur'; + $recur = eval { $cust_pkg->$method( \$sdate, \@details, \%param ) }; + return "$@ running $method for $cust_pkg\n" + if ( $@ ); + + if ( $increment_next_bill ) { + + my $next_bill = $part_pkg->add_freq($sdate); + return "unparsable frequency: ". $part_pkg->freq + if $next_bill == -1; + + #pro-rating magic - if $recur_prog fiddled $sdate, want to use that + # only for figuring next bill date, nothing else, so, reset $sdate again + # here + $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; + #no need, its in $hash{last_bill}# my $last_bill = $cust_pkg->last_bill; + $cust_pkg->last_bill($sdate); + + $cust_pkg->setfield('bill', $next_bill ); + + } + + } + + warn "\$setup is undefined" unless defined($setup); + warn "\$recur is undefined" unless defined($recur); + warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + + ### + # If there's line items, create em cust_bill_pkg records + # If $cust_pkg has been modified, update it (if we're a real pkgpart) + ### + + if ( $lineitems || $options{has_hidden} ) { + + if ( $cust_pkg->modified && $cust_pkg->pkgpart == $real_pkgpart ) { + # hmm.. and if just the options are modified in some weird price plan? + + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" + if $DEBUG >1; + + my $error = $cust_pkg->replace( $old_cust_pkg, + 'options' => { $cust_pkg->options }, + ); + return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error" + if $error; #just in case + } + + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { + return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; + } + if ( $recur < 0 && ! $conf->exists('allow_negative_charges') ) { + return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; + } + + if ( $setup != 0 || + $recur != 0 || + !$part_pkg->hidden && $options{has_hidden} ) #include some $0 lines + { + + warn " charges (setup=$setup, recur=$recur); adding line items\n" + if $DEBUG > 1; + + my @cust_pkg_detail = map { $_->detail } $cust_pkg->cust_pkg_detail('I'); + if ( $DEBUG > 1 ) { + warn " adding customer package invoice detail: $_\n" + foreach @cust_pkg_detail; + } + push @details, @cust_pkg_detail; + + my $cust_bill_pkg = new FS::cust_bill_pkg { + 'pkgnum' => $cust_pkg->pkgnum, + 'setup' => $setup, + 'unitsetup' => $unitsetup, + 'recur' => $recur, + 'unitrecur' => $unitrecur, + 'quantity' => $cust_pkg->quantity, + 'details' => \@details, + 'discounts' => \@discounts, + 'hidden' => $part_pkg->hidden, + }; + + if ( $part_pkg->option('recur_temporality', 1) eq 'preceding' ) { + $cust_bill_pkg->sdate( $hash{last_bill} ); + $cust_bill_pkg->edate( $sdate - 86399 ); #60s*60m*24h-1 + $cust_bill_pkg->edate( $time ) if $options{cancel}; + } else { #if ( $part_pkg->option('recur_temporality', 1) eq 'upcoming' ) { + $cust_bill_pkg->sdate( $sdate ); + $cust_bill_pkg->edate( $cust_pkg->bill ); + #$cust_bill_pkg->edate( $time ) if $options{cancel}; + } + + $cust_bill_pkg->pkgpart_override($part_pkg->pkgpart) + unless $part_pkg->pkgpart == $real_pkgpart; + + $$total_setup += $setup; + $$total_recur += $recur; + + ### + # handle taxes + ### + + my $error = + $self->_handle_taxes($part_pkg, $taxlisthash, $cust_bill_pkg, $cust_pkg, $options{invoice_time}, $real_pkgpart, \%options); + return $error if $error; + + push @$cust_bill_pkgs, $cust_bill_pkg; + + } #if $setup != 0 || $recur != 0 + + } #if $line_items + + ''; + +} + +sub _handle_taxes { + my $self = shift; + my $part_pkg = shift; + my $taxlisthash = shift; + my $cust_bill_pkg = shift; + my $cust_pkg = shift; + my $invoice_time = shift; + my $real_pkgpart = shift; + my $options = shift; + + my %cust_bill_pkg = (); + my %taxes = (); + + my @classes; + #push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->type eq 'U'; + push @classes, $cust_bill_pkg->usage_classes if $cust_bill_pkg->usage; + push @classes, 'setup' if ($cust_bill_pkg->setup && !$options->{cancel}); + push @classes, 'recur' if ($cust_bill_pkg->recur && !$options->{cancel}); + + if ( $self->tax !~ /Y/i && $self->payby ne 'COMP' ) { + + if ( $conf->exists('enable_taxproducts') + && ( scalar($part_pkg->part_pkg_taxoverride) + || $part_pkg->has_taxproduct + ) + ) + { + + if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { + return "fatal: Can't (yet) use tax-pkg_address with taxproducts"; + } + + foreach my $class (@classes) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, $class ); + return $err_or_ref unless ref($err_or_ref); + $taxes{$class} = $err_or_ref; + } + + unless (exists $taxes{''}) { + my $err_or_ref = $self->_gather_taxes( $part_pkg, '' ); + return $err_or_ref unless ref($err_or_ref); + $taxes{''} = $err_or_ref; + } + + } else { + + my @loc_keys = qw( city county state country ); + my %taxhash; + if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { + my $cust_location = $cust_pkg->cust_location; + %taxhash = map { $_ => $cust_location->$_() } @loc_keys; + } else { + my $prefix = + ( $conf->exists('tax-ship_address') && length($self->ship_last) ) + ? 'ship_' + : ''; + %taxhash = map { $_ => $self->get("$prefix$_") } @loc_keys; + } + + $taxhash{'taxclass'} = $part_pkg->taxclass; + + my @taxes = (); + my %taxhash_elim = %taxhash; + my @elim = qw( city county state ); + do { + + #first try a match with taxclass + @taxes = qsearch( 'cust_main_county', \%taxhash_elim ); + + if ( !scalar(@taxes) && $taxhash_elim{'taxclass'} ) { + #then try a match without taxclass + my %no_taxclass = %taxhash_elim; + $no_taxclass{ 'taxclass' } = ''; + @taxes = qsearch( 'cust_main_county', \%no_taxclass ); + } + + $taxhash_elim{ shift(@elim) } = ''; + + } while ( !scalar(@taxes) && scalar(@elim) ); + + @taxes = grep { ! $_->taxname or ! $self->tax_exemption($_->taxname) } + @taxes + if $self->cust_main_exemption; #just to be safe + + if ( $conf->exists('tax-pkg_address') && $cust_pkg->locationnum ) { + foreach (@taxes) { + $_->set('pkgnum', $cust_pkg->pkgnum ); + $_->set('locationnum', $cust_pkg->locationnum ); + } + } + + $taxes{''} = [ @taxes ]; + $taxes{'setup'} = [ @taxes ]; + $taxes{'recur'} = [ @taxes ]; + $taxes{$_} = [ @taxes ] foreach (@classes); + + # # maybe eliminate this entirely, along with all the 0% records + # unless ( @taxes ) { + # return + # "fatal: can't find tax rate for state/county/country/taxclass ". + # join('/', map $taxhash{$_}, qw(state county country taxclass) ); + # } + + } #if $conf->exists('enable_taxproducts') ... + + } + + my @display = (); + my $separate = $conf->exists('separate_usage'); + my $temp_pkg = new FS::cust_pkg { pkgpart => $real_pkgpart }; + my $usage_mandate = $temp_pkg->part_pkg->option('usage_mandate', 'Hush!'); + my $section = $temp_pkg->part_pkg->categoryname; + if ( $separate || $section || $usage_mandate ) { + + my %hash = ( 'section' => $section ); + + $section = $temp_pkg->part_pkg->option('usage_section', 'Hush!'); + my $summary = $temp_pkg->part_pkg->option('summarize_usage', 'Hush!'); + if ( $separate ) { + push @display, new FS::cust_bill_pkg_display { type => 'S', %hash }; + push @display, new FS::cust_bill_pkg_display { type => 'R', %hash }; + } else { + push @display, new FS::cust_bill_pkg_display + { type => '', + %hash, + ( ( $usage_mandate ) ? ( 'summary' => 'Y' ) : () ), + }; + } + + if ($separate && $section && $summary) { + push @display, new FS::cust_bill_pkg_display { type => 'U', + summary => 'Y', + %hash, + }; + } + if ($usage_mandate || $section && $summary) { + $hash{post_total} = 'Y'; + } + + if ($separate || $usage_mandate) { + $hash{section} = $section if ($separate || $usage_mandate); + push @display, new FS::cust_bill_pkg_display { type => 'U', %hash }; + } + + } + $cust_bill_pkg->set('display', \@display); + + my %tax_cust_bill_pkg = $cust_bill_pkg->disintegrate; + foreach my $key (keys %tax_cust_bill_pkg) { + my @taxes = @{ $taxes{$key} || [] }; + my $tax_cust_bill_pkg = $tax_cust_bill_pkg{$key}; + + my %localtaxlisthash = (); + foreach my $tax ( @taxes ) { + + my $taxname = ref( $tax ). ' '. $tax->taxnum; +# $taxname .= ' pkgnum'. $cust_pkg->pkgnum. +# ' locationnum'. $cust_pkg->locationnum +# if $conf->exists('tax-pkg_address') && $cust_pkg->locationnum; + + $taxlisthash->{ $taxname } ||= [ $tax ]; + push @{ $taxlisthash->{ $taxname } }, $tax_cust_bill_pkg; + + $localtaxlisthash{ $taxname } ||= [ $tax ]; + push @{ $localtaxlisthash{ $taxname } }, $tax_cust_bill_pkg; + + } + + warn "finding taxed taxes...\n" if $DEBUG > 2; + foreach my $tax ( keys %localtaxlisthash ) { + my $tax_object = shift @{ $localtaxlisthash{$tax} }; + warn "found possible taxed tax ". $tax_object->taxname. " we call $tax\n" + if $DEBUG > 2; + next unless $tax_object->can('tax_on_tax'); + + foreach my $tot ( $tax_object->tax_on_tax( $self ) ) { + my $totname = ref( $tot ). ' '. $tot->taxnum; + + warn "checking $totname which we call ". $tot->taxname. " as applicable\n" + if $DEBUG > 2; + next unless exists( $localtaxlisthash{ $totname } ); # only increase + # existing taxes + warn "adding $totname to taxed taxes\n" if $DEBUG > 2; + my $hashref_or_error = + $tax_object->taxline( $localtaxlisthash{$tax}, + 'custnum' => $self->custnum, + 'invoice_time' => $invoice_time, + ); + return $hashref_or_error + unless ref($hashref_or_error); + + $taxlisthash->{ $totname } ||= [ $tot ]; + push @{ $taxlisthash->{ $totname } }, $hashref_or_error->{amount}; + + } + } + + } + + ''; +} + +sub _gather_taxes { + my $self = shift; + my $part_pkg = shift; + my $class = shift; + + my @taxes = (); + my $geocode = $self->geocode('cch'); + + my @taxclassnums = map { $_->taxclassnum } + $part_pkg->part_pkg_taxoverride($class); + + unless (@taxclassnums) { + @taxclassnums = map { $_->taxclassnum } + grep { $_->taxable eq 'Y' } + $part_pkg->part_pkg_taxrate('cch', $geocode, $class); + } + warn "Found taxclassnum values of ". join(',', @taxclassnums) + if $DEBUG; + + my $extra_sql = + "AND (". + join(' OR ', map { "taxclassnum = $_" } @taxclassnums ). ")"; + + @taxes = qsearch({ 'table' => 'tax_rate', + 'hashref' => { 'geocode' => $geocode, }, + 'extra_sql' => $extra_sql, + }) + if scalar(@taxclassnums); + + warn "Found taxes ". + join(',', map{ ref($_). " ". $_->get($_->primary_key) } @taxes). "\n" + if $DEBUG; + + [ @taxes ]; + +} + +=item collect [ HASHREF | OPTION => VALUE ... ] + +(Attempt to) collect money for this customer's outstanding invoices (see +L<FS::cust_bill>). Usually used after the bill method. + +Actions are now triggered by billing events; see L<FS::part_event> and the +billing events web interface. Old-style invoice events (see +L<FS::part_bill_event>) have been deprecated. + +If there is an error, returns the error, otherwise returns false. + +Options are passed as name-value pairs. + +Currently available options are: + +=over 4 + +=item invoice_time + +Use this time when deciding when to print invoices and late notices on those invoices. The default is now. It is specified as a UNIX timestamp; see L<perlfunc/"time">). Also see L<Time::Local> and L<Date::Parse> for conversion functions. + +=item retry + +Retry card/echeck/LEC transactions even when not scheduled by invoice events. + +=item check_freq + +"1d" for the traditional, daily events (the default), or "1m" for the new monthly events (part_event.check_freq) + +=item quiet + +set true to surpress email card/ACH decline notices. + +=item debug + +Debugging level. Default is 0 (no debugging), or can be set to 1 (passed-in options), 2 (traces progress), 3 (more information), or 4 (include full search queries) + +=back + +# =item payby +# +# allows for one time override of normal customer billing method + +=cut + +sub collect { + my( $self, %options ) = @_; + my $invoice_time = $options{'invoice_time'} || time; + + #put below somehow? + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + if ( $DEBUG ) { + my $balance = $self->balance; + warn "$me collect customer ". $self->custnum. ": balance $balance\n" + } + + if ( exists($options{'retry_card'}) ) { + carp 'retry_card option passed to collect is deprecated; use retry'; + $options{'retry'} ||= $options{'retry_card'}; + } + if ( exists($options{'retry'}) && $options{'retry'} ) { + my $error = $self->retry_realtime; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + #never want to roll back an event just because it returned an error + local $FS::UID::AutoCommit = 1; #$oldAutoCommit; + + $self->do_cust_event( + 'debug' => ( $options{'debug'} || 0 ), + 'time' => $invoice_time, + 'check_freq' => $options{'check_freq'}, + 'stage' => 'collect', + ); + +} + + +=item apply_payments_and_credits [ OPTION => VALUE ... ] + +Applies unapplied payments and credits. + +In most cases, this new method should be used in place of sequential +apply_payments and apply_credits methods. + +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. + +If there is an error, returns the error, otherwise returns false. + +=cut + +sub apply_payments_and_credits { + my( $self, %options ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + foreach my $cust_bill ( $self->open_cust_bill ) { + my $error = $cust_bill->apply_payments_and_credits(%options); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error applying: $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; #no error + +} + +=item apply_credits OPTION => VALUE ... + +Applies (see L<FS::cust_credit_bill>) unapplied credits (see L<FS::cust_credit>) +to outstanding invoice balances in chronological order (or reverse +chronological order if the I<order> option is set to B<newest>) and returns the +value of any remaining unapplied credits available for refund (see +L<FS::cust_refund>). + +Dies if there is an error. + +=cut + +sub apply_credits { + my $self = shift; + my %opt = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + unless ( $self->total_unapplied_credits ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return 0; + } + + my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } + qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); + + my @invoices = $self->open_cust_bill; + @invoices = sort { $b->_date <=> $a->_date } @invoices + if defined($opt{'order'}) && $opt{'order'} eq 'newest'; + + if ( $conf->exists('pkg-balances') ) { + # limit @credits to those w/ a pkgnum grepped from $self + my %pkgnums = (); + foreach my $i (@invoices) { + foreach my $li ( $i->cust_bill_pkg ) { + $pkgnums{$li->pkgnum} = 1; + } + } + @credits = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @credits; + } + + my $credit; + + foreach my $cust_bill ( @invoices ) { + + if ( !defined($credit) || $credit->credited == 0) { + $credit = pop @credits or last; + } + + my $owed; + if ( $conf->exists('pkg-balances') && $credit->pkgnum ) { + $owed = $cust_bill->owed_pkgnum($credit->pkgnum); + } else { + $owed = $cust_bill->owed; + } + unless ( $owed > 0 ) { + push @credits, $credit; + next; + } + + my $amount = min( $credit->credited, $owed ); + + my $cust_credit_bill = new FS::cust_credit_bill ( { + 'crednum' => $credit->crednum, + 'invnum' => $cust_bill->invnum, + 'amount' => $amount, + } ); + $cust_credit_bill->pkgnum( $credit->pkgnum ) + if $conf->exists('pkg-balances') && $credit->pkgnum; + my $error = $cust_credit_bill->insert; + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + + redo if ($cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); + + } + + my $total_unapplied_credits = $self->total_unapplied_credits; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return $total_unapplied_credits; +} + +=item apply_payments [ OPTION => VALUE ... ] + +Applies (see L<FS::cust_bill_pay>) unapplied payments (see L<FS::cust_pay>) +to outstanding invoice balances in chronological order. + + #and returns the value of any remaining unapplied payments. + +A hash of optional arguments may be passed. Currently "manual" is supported. +If true, a payment receipt is sent instead of a statement when +'payment_receipt_email' configuration option is set. + +Dies if there is an error. + +=cut + +sub apply_payments { + my( $self, %options ) = @_; + + local $SIG{HUP} = 'IGNORE'; + local $SIG{INT} = 'IGNORE'; + local $SIG{QUIT} = 'IGNORE'; + local $SIG{TERM} = 'IGNORE'; + local $SIG{TSTP} = 'IGNORE'; + local $SIG{PIPE} = 'IGNORE'; + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + $self->select_for_update; #mutex + + #return 0 unless + + my @payments = sort { $b->_date <=> $a->_date } + grep { $_->unapplied > 0 } + $self->cust_pay; + + my @invoices = sort { $a->_date <=> $b->_date} + grep { $_->owed > 0 } + $self->cust_bill; + + if ( $conf->exists('pkg-balances') ) { + # limit @payments to those w/ a pkgnum grepped from $self + my %pkgnums = (); + foreach my $i (@invoices) { + foreach my $li ( $i->cust_bill_pkg ) { + $pkgnums{$li->pkgnum} = 1; + } + } + @payments = grep { ! $_->pkgnum || $pkgnums{$_->pkgnum} } @payments; + } + + my $payment; + + foreach my $cust_bill ( @invoices ) { + + if ( !defined($payment) || $payment->unapplied == 0 ) { + $payment = pop @payments or last; + } + + my $owed; + if ( $conf->exists('pkg-balances') && $payment->pkgnum ) { + $owed = $cust_bill->owed_pkgnum($payment->pkgnum); + } else { + $owed = $cust_bill->owed; + } + unless ( $owed > 0 ) { + push @payments, $payment; + next; + } + + my $amount = min( $payment->unapplied, $owed ); + + my $cust_bill_pay = new FS::cust_bill_pay ( { + 'paynum' => $payment->paynum, + 'invnum' => $cust_bill->invnum, + 'amount' => $amount, + } ); + $cust_bill_pay->pkgnum( $payment->pkgnum ) + if $conf->exists('pkg-balances') && $payment->pkgnum; + my $error = $cust_bill_pay->insert(%options); + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + die $error; + } + + redo if ( $cust_bill->owed > 0) && ! $conf->exists('pkg-balances'); + + } + + my $total_unapplied_payments = $self->total_unapplied_payments; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + return $total_unapplied_payments; +} + +1; diff --git a/FS/FS/cust_main/Billing_Realtime.pm b/FS/FS/cust_main/Billing_Realtime.pm new file mode 100644 index 000000000..e0e24b134 --- /dev/null +++ b/FS/FS/cust_main/Billing_Realtime.pm @@ -0,0 +1,1439 @@ +package FS::cust_main::Billing_Realtime; + +use strict; +use vars qw( $conf $DEBUG $me ); +use FS::UID qw( dbh ); +use FS::Record qw( qsearch qsearchs ); +use FS::payby; +use FS::cust_pay; +use FS::cust_pay_pending; +use FS::cust_refund; + +#$realtime_bop_decline_quiet = 0; + +# 1 is mostly method/subroutine entry and options +# 2 traces progress of some operations +# 3 is even more information including possibly sensitive data +$DEBUG = 0; +$me = '[FS::cust_main::Billing_Realtime]'; + +install_callback FS::UID sub { + $conf = new FS::Conf; + #yes, need it for stuff below (prolly should be cached) +}; + +=head1 NAME + +FS::cust_main::Billing_Realtime - Realtime billing mixin for cust_main + +=head1 SYNOPSIS + +=head1 DESCRIPTIONS + +These methods are available on FS::cust_main objects. + +=head1 METHODS + +=over 4 + +=item realtime_collect [ OPTION => VALUE ... ] + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment or Business::OnlineThirdPartyPayment realtime +gateway. See L<http://420.am/business-onlinepayment> and +L<http://420.am/business-onlinethirdpartypayment> for supported gateways. + +On failure returns an error message. + +Returns false or a hashref upon success. The hashref contains keys popup_url reference, and collectitems. The first is a URL to which a browser should be redirected for completion of collection. The second is a reference id for the transaction suitable for the end user. The collectitems is a reference to a list of name value pairs suitable for assigning to a html form and posted to popup_url. + +Available options are: I<method>, I<amount>, I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id>, I<pkgnum> + +I<method> is one of: I<CC>, I<ECHECK> and I<LEC>. If none is specified +then it is deduced from the customer record. + +If no I<amount> is specified, then the customer balance is used. + +The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +the value defined by the business-onlinepayment-description configuration +option, or "Internet services" if that is unset. + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method or set the I<apply> option. + +I<apply> can be set to true to apply a resulting payment. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +I<session_id> is a session identifier associated with this payment. + +I<depend_jobnum> allows payment capture to unlock export jobs + +=cut + +sub realtime_collect { + my( $self, %options ) = @_; + + if ( $DEBUG ) { + warn "$me realtime_collect:\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + $options{amount} = $self->balance unless exists( $options{amount} ); + $options{method} = FS::payby->payby2bop($self->payby) + unless exists( $options{method} ); + + return $self->realtime_bop({%options}); + +} + +=item realtime_bop { [ ARG => VALUE ... ] } + +Runs a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L<http://420.am/business-onlinepayment> for supported gateways. + +Required arguments in the hashref are I<method>, and I<amount> + +Available methods are: I<CC>, I<ECHECK> and I<LEC> + +Available optional arguments are: I<description>, I<invnum>, I<apply>, I<quiet>, I<paynum_ref>, I<payunique>, I<session_id> + +The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +the value defined by the business-onlinepayment-description configuration +option, or "Internet services" if that is unset. + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method or set the I<apply> option. + +I<apply> can be set to true to apply a resulting payment. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +I<session_id> is a session identifier associated with this payment. + +I<depend_jobnum> allows payment capture to unlock export jobs + +(moved from cust_bill) (probably should get realtime_{card,ach,lec} here too) + +=cut + +# some helper routines +sub _bop_recurring_billing { + my( $self, %opt ) = @_; + + my $method = scalar($conf->config('credit_card-recurring_billing_flag')); + + if ( defined($method) && $method eq 'transaction_is_recur' ) { + + return 1 if $opt{'trans_is_recur'}; + + } else { + + my %hash = ( 'custnum' => $self->custnum, + 'payby' => 'CARD', + ); + + return 1 + if qsearch('cust_pay', { %hash, 'payinfo' => $opt{'payinfo'} } ) + || qsearch('cust_pay', { %hash, 'paymask' => $self->mask_payinfo('CARD', + $opt{'payinfo'} ) + } ); + + } + + return 0; + +} + +sub _payment_gateway { + my ($self, $options) = @_; + + $options->{payment_gateway} = $self->agent->payment_gateway( %$options ) + unless exists($options->{payment_gateway}); + + $options->{payment_gateway}; +} + +sub _bop_auth { + my ($self, $options) = @_; + + ( + 'login' => $options->{payment_gateway}->gateway_username, + 'password' => $options->{payment_gateway}->gateway_password, + ); +} + +sub _bop_options { + my ($self, $options) = @_; + + $options->{payment_gateway}->gatewaynum + ? $options->{payment_gateway}->options + : @{ $options->{payment_gateway}->get('options') }; + +} + +sub _bop_defaults { + my ($self, $options) = @_; + + unless ( $options->{'description'} ) { + if ( $conf->exists('business-onlinepayment-description') ) { + my $dtempl = $conf->config('business-onlinepayment-description'); + + my $agent = $self->agent->agent; + #$pkgs... not here + $options->{'description'} = eval qq("$dtempl"); + } else { + $options->{'description'} = 'Internet services'; + } + } + + $options->{payinfo} = $self->payinfo unless exists( $options->{payinfo} ); + $options->{invnum} ||= ''; + $options->{payname} = $self->payname unless exists( $options->{payname} ); +} + +sub _bop_content { + my ($self, $options) = @_; + my %content = (); + + my $payip = exists($options->{'payip'}) ? $options->{'payip'} : $self->payip; + $content{customer_ip} = $payip if length($payip); + + $content{invoice_number} = $options->{'invnum'} + if exists($options->{'invnum'}) && length($options->{'invnum'}); + + $content{email_customer} = + ( $conf->exists('business-onlinepayment-email_customer') + || $conf->exists('business-onlinepayment-email-override') ); + + my ($payname, $payfirst, $paylast); + if ( $options->{payname} && $options->{method} ne 'ECHECK' ) { + ($payname = $options->{payname}) =~ + /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + $content{last_name} = $paylast; + $content{first_name} = $payfirst; + + $content{name} = $payname; + + $content{address} = exists($options->{'address1'}) + ? $options->{'address1'} + : $self->address1; + my $address2 = exists($options->{'address2'}) + ? $options->{'address2'} + : $self->address2; + $content{address} .= ", ". $address2 if length($address2); + + $content{city} = exists($options->{city}) + ? $options->{city} + : $self->city; + $content{state} = exists($options->{state}) + ? $options->{state} + : $self->state; + $content{zip} = exists($options->{zip}) + ? $options->{'zip'} + : $self->zip; + $content{country} = exists($options->{country}) + ? $options->{country} + : $self->country; + + $content{referer} = 'http://cleanwhisker.420.am/'; #XXX fix referer :/ + $content{phone} = $self->daytime || $self->night; + + \%content; +} + +my %bop_method2payby = ( + 'CC' => 'CARD', + 'ECHECK' => 'CHEK', + 'LEC' => 'LECB', +); + +sub realtime_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) eq 'HASH') { + %options = %{$_[0]}; + } else { + my ( $method, $amount ) = ( shift, shift ); + %options = @_; + $options{method} = $method; + $options{amount} = $amount; + } + + if ( $DEBUG ) { + warn "$me realtime_bop (new): $options{method} $options{amount}\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + return $self->fake_bop(%options) if $options{'fake'}; + + $self->_bop_defaults(\%options); + + ### + # set trans_is_recur based on invnum if there is one + ### + + my $trans_is_recur = 0; + if ( $options{'invnum'} ) { + + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); + die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; + + my @part_pkg = + map { $_->part_pkg } + grep { $_ } + map { $_->cust_pkg } + $cust_bill->cust_bill_pkg; + + $trans_is_recur = 1 + if grep { $_->freq ne '0' } @part_pkg; + + } + + ### + # select a gateway + ### + + my $payment_gateway = $self->_payment_gateway( \%options ); + my $namespace = $payment_gateway->gateway_namespace; + + eval "use $namespace"; + die $@ if $@; + + ### + # check for banned credit card/ACH + ### + + my $ban = qsearchs('banned_pay', { + 'payby' => $bop_method2payby{$options{method}}, + 'payinfo' => md5_base64($options{payinfo}), + } ); + return "Banned credit card" if $ban; + + ### + # massage data + ### + + my $bop_content = $self->_bop_content(\%options); + return $bop_content unless ref($bop_content); + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $paydate = ''; + my %content = (); + if ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'CC' ) { + + $content{card_number} = $options{payinfo}; + $paydate = exists($options{'paydate'}) + ? $options{'paydate'} + : $self->paydate; + $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $paycvv + if length($paycvv); + + my $paystart_month = exists($options{'paystart_month'}) + ? $options{'paystart_month'} + : $self->paystart_month; + + my $paystart_year = exists($options{'paystart_year'}) + ? $options{'paystart_year'} + : $self->paystart_year; + + $content{card_start} = "$paystart_month/$paystart_year" + if $paystart_month && $paystart_year; + + my $payissue = exists($options{'payissue'}) + ? $options{'payissue'} + : $self->payissue; + $content{issue_number} = $payissue if $payissue; + + if ( $self->_bop_recurring_billing( 'payinfo' => $options{'payinfo'}, + 'trans_is_recur' => $trans_is_recur, + ) + ) + { + $content{recurring_billing} = 'YES'; + $content{acct_code} = 'rebill' + if $conf->exists('credit_card-recurring_billing_acct_code'); + } + + } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'ECHECK' ){ + ( $content{account_number}, $content{routing_code} ) = + split('@', $options{payinfo}); + $content{bank_name} = $options{payname}; + $content{bank_state} = exists($options{'paystate'}) + ? $options{'paystate'} + : $self->getfield('paystate'); + $content{account_type} = exists($options{'paytype'}) + ? uc($options{'paytype'}) || 'CHECKING' + : uc($self->getfield('paytype')) || 'CHECKING'; + $content{account_name} = $self->getfield('first'). ' '. + $self->getfield('last'); + + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{state_id} = exists($options{'stateid'}) + ? $options{'stateid'} + : $self->getfield('stateid'); + $content{state_id_state} = exists($options{'stateid_state'}) + ? $options{'stateid_state'} + : $self->getfield('stateid_state'); + $content{customer_ssn} = exists($options{'ss'}) + ? $options{'ss'} + : $self->ss; + } elsif ( $namespace eq 'Business::OnlinePayment' && $options{method} eq 'LEC' ) { + $content{phone} = $options{payinfo}; + } elsif ( $namespace eq 'Business::OnlineThirdPartyPayment' ) { + #move along + } else { + #die an evil death + } + + ### + # run transaction(s) + ### + + my $balance = exists( $options{'balance'} ) + ? $options{'balance'} + : $self->balance; + + $self->select_for_update; #mutex ... just until we get our pending record in + + #the checks here are intended to catch concurrent payments + #double-form-submission prevention is taken care of in cust_pay_pending::check + + #check the balance + return "The customer's balance has changed; $options{method} transaction aborted." + if $self->balance < $balance; + #&& $self->balance < $options{amount}; #might as well anyway? + + #also check and make sure there aren't *other* pending payments for this cust + + my @pending = qsearch('cust_pay_pending', { + 'custnum' => $self->custnum, + 'status' => { op=>'!=', value=>'done' } + }); + return "A payment is already being processed for this customer (". + join(', ', map 'paypendingnum '. $_->paypendingnum, @pending ). + "); $options{method} transaction aborted." + if scalar(@pending); + + #okay, good to go, if we're a duplicate, cust_pay_pending will kick us out + + my $cust_pay_pending = new FS::cust_pay_pending { + 'custnum' => $self->custnum, + #'invnum' => $options{'invnum'}, + 'paid' => $options{amount}, + '_date' => '', + 'payby' => $bop_method2payby{$options{method}}, + 'payinfo' => $options{payinfo}, + 'paydate' => $paydate, + 'recurring_billing' => $content{recurring_billing}, + 'pkgnum' => $options{'pkgnum'}, + 'status' => 'new', + 'gatewaynum' => $payment_gateway->gatewaynum || '', + 'session_id' => $options{session_id} || '', + 'jobnum' => $options{depend_jobnum} || '', + }; + $cust_pay_pending->payunique( $options{payunique} ) + if defined($options{payunique}) && length($options{payunique}); + my $cpp_new_err = $cust_pay_pending->insert; #mutex lost when this is inserted + return $cpp_new_err if $cpp_new_err; + + my( $action1, $action2 ) = + split( /\s*\,\s*/, $payment_gateway->gateway_action ); + + my $transaction = new $namespace( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + $transaction->content( + 'type' => $options{method}, + $self->_bop_auth(\%options), + 'action' => $action1, + 'description' => $options{'description'}, + 'amount' => $options{amount}, + #'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + %$bop_content, + 'reference' => $cust_pay_pending->paypendingnum, #for now + 'email' => $email, + %content, #after + ); + + $cust_pay_pending->status('pending'); + my $cpp_pending_err = $cust_pay_pending->replace; + return $cpp_pending_err if $cpp_pending_err; + + #config? + my $BOP_TESTING = 0; + my $BOP_TESTING_SUCCESS = 1; + + unless ( $BOP_TESTING ) { + $transaction->test_transaction(1) + if $conf->exists('business-onlinepayment-test_transaction'); + $transaction->submit(); + } else { + if ( $BOP_TESTING_SUCCESS ) { + $transaction->is_success(1); + $transaction->authorization('fake auth'); + } else { + $transaction->is_success(0); + $transaction->error_message('fake failure'); + } + } + + if ( $transaction->is_success() && $namespace eq 'Business::OnlineThirdPartyPayment' ) { + + return { reference => $cust_pay_pending->paypendingnum, + map { $_ => $transaction->$_ } qw ( popup_url collectitems ) }; + + } elsif ( $transaction->is_success() && $action2 ) { + + $cust_pay_pending->status('authorized'); + my $cpp_authorized_err = $cust_pay_pending->replace; + return $cpp_authorized_err if $cpp_authorized_err; + + my $auth = $transaction->authorization; + my $ordernum = $transaction->can('order_number') + ? $transaction->order_number + : ''; + + my $capture = + new Business::OnlinePayment( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + my %capture = ( + %content, + type => $options{method}, + action => $action2, + $self->_bop_auth(\%options), + order_number => $ordernum, + amount => $options{amount}, + authorization => $auth, + description => $options{'description'}, + ); + + foreach my $field (qw( authorization_source_code returned_ACI + transaction_identifier validation_code + transaction_sequence_num local_transaction_date + local_transaction_time AVS_result_code )) { + $capture{$field} = $transaction->$field() if $transaction->can($field); + } + + $capture->content( %capture ); + + $capture->test_transaction(1) + if $conf->exists('business-onlinepayment-test_transaction'); + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization successful but capture failed, custnum #". + $self->custnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + ### + # remove paycvv after initial transaction + ### + + #false laziness w/misc/process/payment.cgi - check both to make sure working + # correctly + if ( length($self->paycvv) + && ! grep { $_ eq cardtype($options{payinfo}) } $conf->config('cvv-save') + ) { + my $error = $self->remove_cvv; + if ( $error ) { + warn "WARNING: error removing cvv: $error\n"; + } + } + + ### + # Tokenize + ### + + + if ( $transaction->can('card_token') && $transaction->card_token ) { + + $self->card_token($transaction->card_token); + + if ( $options{'payinfo'} eq $self->payinfo ) { + $self->payinfo($transaction->card_token); + my $error = $self->replace; + if ( $error ) { + warn "WARNING: error storing token: $error, but proceeding anyway\n"; + } + } + + } + + ### + # result handling + ### + + $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); + +} + +=item fake_bop + +=cut + +sub fake_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) eq 'HASH') { + %options = %{$_[0]}; + } else { + my ( $method, $amount ) = ( shift, shift ); + %options = @_; + $options{method} = $method; + $options{amount} = $amount; + } + + if ( $options{'fake_failure'} ) { + return "Error: No error; test failure requested with fake_failure"; + } + + #my $paybatch = ''; + #if ( $payment_gateway->gatewaynum ) { # agent override + # $paybatch = $payment_gateway->gatewaynum. '-'; + #} + # + #$paybatch .= "$processor:". $transaction->authorization; + # + #$paybatch .= ':'. $transaction->order_number + # if $transaction->can('order_number') + # && length($transaction->order_number); + + my $paybatch = 'FakeProcessor:54:32'; + + my $cust_pay = new FS::cust_pay ( { + 'custnum' => $self->custnum, + 'invnum' => $options{'invnum'}, + 'paid' => $options{amount}, + '_date' => '', + 'payby' => $bop_method2payby{$options{method}}, + #'payinfo' => $payinfo, + 'payinfo' => '4111111111111111', + 'paybatch' => $paybatch, + #'paydate' => $paydate, + 'paydate' => '2012-05-01', + } ); + $cust_pay->payunique( $options{payunique} ) if length($options{payunique}); + + my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); + + if ( $error ) { + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert( $options{'manual'} ? + ( 'manual' => 1 ) : () + ); + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH debited but database not updated - '. + "error inserting (fake!) payment: $error2". + " (previously tried insert with invnum #$options{'invnum'}" . + ": $error )"; + warn $e; + return $e; + } + } + + if ( $options{'paynum_ref'} ) { + ${ $options{'paynum_ref'} } = $cust_pay->paynum; + } + + return ''; #no error + +} + + +# item _realtime_bop_result CUST_PAY_PENDING, BOP_OBJECT [ OPTION => VALUE ... ] +# +# Wraps up processing of a realtime credit card, ACH (electronic check) or +# phone bill transaction. + +sub _realtime_bop_result { + my( $self, $cust_pay_pending, $transaction, %options ) = @_; + if ( $DEBUG ) { + warn "$me _realtime_bop_result: pending transaction ". + $cust_pay_pending->paypendingnum. "\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + my $payment_gateway = $options{payment_gateway} + or return "no payment gateway in arguments to _realtime_bop_result"; + + $cust_pay_pending->status($transaction->is_success() ? 'captured' : 'declined'); + my $cpp_captured_err = $cust_pay_pending->replace; + return $cpp_captured_err if $cpp_captured_err; + + if ( $transaction->is_success() ) { + + my $paybatch = ''; + if ( $payment_gateway->gatewaynum ) { # agent override + $paybatch = $payment_gateway->gatewaynum. '-'; + } + + $paybatch .= $payment_gateway->gateway_module. ":". + $transaction->authorization; + + $paybatch .= ':'. $transaction->order_number + if $transaction->can('order_number') + && length($transaction->order_number); + + my $cust_pay = new FS::cust_pay ( { + 'custnum' => $self->custnum, + 'invnum' => $options{'invnum'}, + 'paid' => $cust_pay_pending->paid, + '_date' => '', + 'payby' => $cust_pay_pending->payby, + 'payinfo' => $options{'payinfo'}, + 'paybatch' => $paybatch, + 'paydate' => $cust_pay_pending->paydate, + 'pkgnum' => $cust_pay_pending->pkgnum, + } ); + #doesn't hurt to know, even though the dup check is in cust_pay_pending now + $cust_pay->payunique( $options{payunique} ) + if defined($options{payunique}) && length($options{payunique}); + + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + #start a transaction, insert the cust_pay and set cust_pay_pending.status to done in a single transction + + my $error = $cust_pay->insert($options{'manual'} ? ( 'manual' => 1 ) : () ); + + if ( $error ) { + $cust_pay->invnum(''); #try again with no specific invnum + my $error2 = $cust_pay->insert( $options{'manual'} ? + ( 'manual' => 1 ) : () + ); + if ( $error2 ) { + # gah. but at least we have a record of the state we had to abort in + # from cust_pay_pending now. + my $e = "WARNING: $options{method} captured but payment not recorded -". + " error inserting payment (". $payment_gateway->gateway_module. + "): $error2". + " (previously tried insert with invnum #$options{'invnum'}" . + ": $error ) - pending payment saved as paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + warn $e; + return $e; + } + } + + my $jobnum = $cust_pay_pending->jobnum; + if ( $jobnum ) { + my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); + + unless ( $placeholder ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but job $jobnum not ". + "found for paypendingnum ". $cust_pay_pending->paypendingnum. "\n"; + warn $e; + return $e; + } + + $error = $placeholder->delete; + + if ( $error ) { + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but could not delete ". + "job $jobnum for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $error\n"; + warn $e; + return $e; + } + + } + + if ( $options{'paynum_ref'} ) { + ${ $options{'paynum_ref'} } = $cust_pay->paynum; + } + + $cust_pay_pending->status('done'); + $cust_pay_pending->statustext('captured'); + $cust_pay_pending->paynum($cust_pay->paynum); + my $cpp_done_err = $cust_pay_pending->replace; + + if ( $cpp_done_err ) { + + $dbh->rollback or die $dbh->errstr if $oldAutoCommit; + my $e = "WARNING: $options{method} captured but payment not recorded - ". + "error updating status for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; + warn $e; + return $e; + + } else { + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + + if ( $options{'apply'} ) { + my $apply_error = $self->apply_payments_and_credits; + if ( $apply_error ) { + warn "WARNING: error applying payment: $apply_error\n"; + #but we still should return no error cause the payment otherwise went + #through... + } + } + + return ''; #no error + + } + + } else { + + my $perror = $payment_gateway->gateway_module. " error: ". + $transaction->error_message; + + my $jobnum = $cust_pay_pending->jobnum; + if ( $jobnum ) { + my $placeholder = qsearchs( 'queue', { 'jobnum' => $jobnum } ); + + if ( $placeholder ) { + my $error = $placeholder->depended_delete; + $error ||= $placeholder->delete; + warn "error removing provisioning jobs after declined paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + } else { + my $e = "error finding job $jobnum for declined paypendingnum ". + $cust_pay_pending->paypendingnum. "\n"; + warn $e; + } + + } + + unless ( $transaction->error_message ) { + + my $t_response; + if ( $transaction->can('response_page') ) { + $t_response = { + 'page' => ( $transaction->can('response_page') + ? $transaction->response_page + : '' + ), + 'code' => ( $transaction->can('response_code') + ? $transaction->response_code + : '' + ), + 'headers' => ( $transaction->can('response_headers') + ? $transaction->response_headers + : '' + ), + }; + } else { + $t_response .= + "No additional debugging information available for ". + $payment_gateway->gateway_module; + } + + $perror .= "No error_message returned from ". + $payment_gateway->gateway_module. " -- ". + ( ref($t_response) ? Dumper($t_response) : $t_response ); + + } + + if ( !$options{'quiet'} && !$FS::cust_main::realtime_bop_decline_quiet + && $conf->exists('emaildecline') + && grep { $_ ne 'POST' } $self->invoicing_list + && ! grep { $transaction->error_message =~ /$_/ } + $conf->config('emaildecline-exclude') + ) { + + # Send a decline alert to the customer. + my $msgnum = $conf->config('decline_msgnum', $self->agentnum); + my $error = ''; + if ( $msgnum ) { + # include the raw error message in the transaction state + $cust_pay_pending->setfield('error', $transaction->error_message); + my $msg_template = qsearchs('msg_template', { msgnum => $msgnum }); + $error = $msg_template->send( 'cust_main' => $self, + 'object' => $cust_pay_pending ); + } + else { #!$msgnum + + my @templ = $conf->config('declinetemplate'); + my $template = new Text::Template ( + TYPE => 'ARRAY', + SOURCE => [ map "$_\n", @templ ], + ) or return "($perror) can't create template: $Text::Template::ERROR"; + $template->compile() + or return "($perror) can't compile template: $Text::Template::ERROR"; + + my $templ_hash = { + 'company_name' => + scalar( $conf->config('company_name', $self->agentnum ) ), + 'company_address' => + join("\n", $conf->config('company_address', $self->agentnum ) ), + 'error' => $transaction->error_message, + }; + + my $error = send_email( + 'from' => $conf->config('invoice_from', $self->agentnum ), + 'to' => [ grep { $_ ne 'POST' } $self->invoicing_list ], + 'subject' => 'Your payment could not be processed', + 'body' => [ $template->fill_in(HASH => $templ_hash) ], + ); + } + + $perror .= " (also received error sending decline notification: $error)" + if $error; + + } + + $cust_pay_pending->status('done'); + $cust_pay_pending->statustext("declined: $perror"); + my $cpp_done_err = $cust_pay_pending->replace; + if ( $cpp_done_err ) { + my $e = "WARNING: $options{method} declined but pending payment not ". + "resolved - error updating status for paypendingnum ". + $cust_pay_pending->paypendingnum. ": $cpp_done_err \n"; + warn $e; + $perror = "$e ($perror)"; + } + + return $perror; + } + +} + +=item realtime_botpp_capture CUST_PAY_PENDING [ OPTION => VALUE ... ] + +Verifies successful third party processing of a realtime credit card, +ACH (electronic check) or phone bill transaction via a +Business::OnlineThirdPartyPayment realtime gateway. See +L<http://420.am/business-onlinethirdpartypayment> for supported gateways. + +Available options are: I<description>, I<invnum>, I<quiet>, I<paynum_ref>, I<payunique> + +The additional options I<payname>, I<city>, I<state>, +I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +if set, will override the value from the customer record. + +I<description> is a free-text field passed to the gateway. It defaults to +"Internet services". + +If an I<invnum> is specified, this payment (if successful) is applied to the +specified invoice. If you don't specify an I<invnum> you might want to +call the B<apply_payments> method. + +I<quiet> can be set true to surpress email decline notices. + +I<paynum_ref> can be set to a scalar reference. It will be filled in with the +resulting paynum, if any. + +I<payunique> is a unique identifier for this payment. + +Returns a hashref containing elements bill_error (which will be undefined +upon success) and session_id of any associated session. + +=cut + +sub realtime_botpp_capture { + my( $self, $cust_pay_pending, %options ) = @_; + if ( $DEBUG ) { + warn "$me realtime_botpp_capture: pending transaction $cust_pay_pending\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + eval "use Business::OnlineThirdPartyPayment"; + die $@ if $@; + + ### + # select the gateway + ### + + my $method = FS::payby->payby2bop($cust_pay_pending->payby); + + my $payment_gateway = $cust_pay_pending->gatewaynum + ? qsearchs( 'payment_gateway', + { gatewaynum => $cust_pay_pending->gatewaynum } + ) + : $self->agent->payment_gateway( 'method' => $method, + # 'invnum' => $cust_pay_pending->invnum, + # 'payinfo' => $cust_pay_pending->payinfo, + ); + + $options{payment_gateway} = $payment_gateway; # for the helper subs + + ### + # massage data + ### + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my %content = (); + + $content{email_customer} = + ( $conf->exists('business-onlinepayment-email_customer') + || $conf->exists('business-onlinepayment-email-override') ); + + ### + # run transaction(s) + ### + + my $transaction = + new Business::OnlineThirdPartyPayment( $payment_gateway->gateway_module, + $self->_bop_options(\%options), + ); + + $transaction->reference({ %options }); + + $transaction->content( + 'type' => $method, + $self->_bop_auth(\%options), + 'action' => 'Post Authorization', + 'description' => $options{'description'}, + 'amount' => $cust_pay_pending->paid, + #'invoice_number' => $options{'invnum'}, + 'customer_id' => $self->custnum, + 'referer' => 'http://cleanwhisker.420.am/', + 'reference' => $cust_pay_pending->paypendingnum, + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + # plus whatever is required for bogus capture avoidance + ); + + $transaction->submit(); + + my $error = + $self->_realtime_bop_result( $cust_pay_pending, $transaction, %options ); + + { + bill_error => $error, + session_id => $cust_pay_pending->session_id, + } + +} + +=item default_payment_gateway + +DEPRECATED -- use agent->payment_gateway + +=cut + +sub default_payment_gateway { + my( $self, $method ) = @_; + + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + + #warn "default_payment_gateway deprecated -- use agent->payment_gateway\n"; + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method =~ /^(ECHECK|CHEK)$/ && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config($bop_config); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + ( $processor, $login, $password, $action, @bop_options ) +} + +=item realtime_refund_bop METHOD [ OPTION => VALUE ... ] + +Refunds a realtime credit card, ACH (electronic check) or phone bill transaction +via a Business::OnlinePayment realtime gateway. See +L<http://420.am/business-onlinepayment> for supported gateways. + +Available methods are: I<CC>, I<ECHECK> and I<LEC> + +Available options are: I<amount>, I<reason>, I<paynum>, I<paydate> + +Most gateways require a reference to an original payment transaction to refund, +so you probably need to specify a I<paynum>. + +I<amount> defaults to the original amount of the payment if not specified. + +I<reason> specifies a reason for the refund. + +I<paydate> specifies the expiration date for a credit card overriding the +value from the customer record or the payment record. Specified as yyyy-mm-dd + +Implementation note: If I<amount> is unspecified or equal to the amount of the +orignal payment, first an attempt is made to "void" the transaction via +the gateway (to cancel a not-yet settled transaction) and then if that fails, +the normal attempt is made to "refund" ("credit") the transaction via the +gateway is attempted. + +#The additional options I<payname>, I<address1>, I<address2>, I<city>, I<state>, +#I<zip>, I<payinfo> and I<paydate> are also available. Any of these options, +#if set, will override the value from the customer record. + +#If an I<invnum> is specified, this payment (if successful) is applied to the +#specified invoice. If you don't specify an I<invnum> you might want to +#call the B<apply_payments> method. + +=cut + +#some false laziness w/realtime_bop, not enough to make it worth merging +#but some useful small subs should be pulled out +sub realtime_refund_bop { + my $self = shift; + + my %options = (); + if (ref($_[0]) eq 'HASH') { + %options = %{$_[0]}; + } else { + my $method = shift; + %options = @_; + $options{method} = $method; + } + + if ( $DEBUG ) { + warn "$me realtime_refund_bop (new): $options{method} refund\n"; + warn " $_ => $options{$_}\n" foreach keys %options; + } + + ### + # look up the original payment and optionally a gateway for that payment + ### + + my $cust_pay = ''; + my $amount = $options{'amount'}; + + my( $processor, $login, $password, @bop_options, $namespace ) ; + my( $auth, $order_number ) = ( '', '', '' ); + + if ( $options{'paynum'} ) { + + warn " paynum: $options{paynum}\n" if $DEBUG > 1; + $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) + or return "Unknown paynum $options{'paynum'}"; + $amount ||= $cust_pay->paid; + + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-\/ ]*)(:([\w\-]+))?$/ + or return "Can't parse paybatch for paynum $options{'paynum'}: ". + $cust_pay->paybatch; + my $gatewaynum = ''; + ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); + + if ( $gatewaynum ) { #gateway for the payment to be refunded + + my $payment_gateway = + qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); + die "payment gateway $gatewaynum not found" + unless $payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + $namespace = $payment_gateway->gateway_namespace; + @bop_options = $payment_gateway->options; + + } else { #try the default gateway + + my $conf_processor; + my $payment_gateway = + $self->agent->payment_gateway('method' => $options{method}); + + ( $conf_processor, $login, $password, $namespace ) = + map { my $method = "gateway_$_"; $payment_gateway->$method } + qw( module username password namespace ); + + @bop_options = $payment_gateway->gatewaynum + ? $payment_gateway->options + : @{ $payment_gateway->get('options') }; + + return "processor of payment $options{'paynum'} $processor does not". + " match default processor $conf_processor" + unless $processor eq $conf_processor; + + } + + + } else { # didn't specify a paynum, so look for agent gateway overrides + # like a normal transaction + + my $payment_gateway = + $self->agent->payment_gateway( 'method' => $options{method}, + #'payinfo' => $payinfo, + ); + my( $processor, $login, $password, $namespace ) = + map { my $method = "gateway_$_"; $payment_gateway->$method } + qw( module username password namespace ); + + my @bop_options = $payment_gateway->gatewaynum + ? $payment_gateway->options + : @{ $payment_gateway->get('options') }; + + } + return "neither amount nor paynum specified" unless $amount; + + eval "use $namespace"; + die $@ if $@; + + my %content = ( + 'type' => $options{method}, + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'referer' => 'http://cleanwhisker.420.am/', #XXX fix referer :/ + ); + $content{authorization} = $auth + if length($auth); #echeck/ACH transactions have an order # but no auth + #(at least with authorize.net) + + my $disable_void_after; + if ($conf->exists('disable_void_after') + && $conf->config('disable_void_after') =~ /^(\d+)$/) { + $disable_void_after = $1; + } + + #first try void if applicable + if ( $cust_pay && $cust_pay->paid == $amount + && ( + ( not defined($disable_void_after) ) + || ( time < ($cust_pay->_date + $disable_void_after ) ) + ) + ) { + warn " attempting void\n" if $DEBUG > 1; + my $void = new Business::OnlinePayment( $processor, @bop_options ); + if ( $void->can('info') ) { + if ( $cust_pay->payby eq 'CARD' + && $void->info('CC_void_requires_card') ) + { + $content{'card_number'} = $cust_pay->payinfo; + } elsif ( $cust_pay->payby eq 'CHEK' + && $void->info('ECHECK_void_requires_account') ) + { + ( $content{'account_number'}, $content{'routing_code'} ) = + split('@', $cust_pay->payinfo); + $content{'name'} = $self->get('first'). ' '. $self->get('last'); + } + } + $void->content( 'action' => 'void', %content ); + $void->test_transaction(1) + if $conf->exists('business-onlinepayment-test_transaction'); + $void->submit(); + if ( $void->is_success ) { + my $error = $cust_pay->void($options{'reason'}); + if ( $error ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH voided but database not updated - '. + "error voiding payment: $error"; + warn $e; + return $e; + } + warn " void successful\n" if $DEBUG > 1; + return ''; + } + } + + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; + + #massage data + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + my($payname, $payfirst, $paylast); + if ( $self->payname && $options{method} ne 'ECHECK' ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/ + or return "Illegal payname $payname"; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('last'); + $payname = "$payfirst $paylast"; + } + + my @invoicing_list = $self->invoicing_list_emailonly; + if ( $conf->exists('emailinvoiceautoalways') + || $conf->exists('emailinvoiceauto') && ! @invoicing_list + || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { + push @invoicing_list, $self->all_emails; + } + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; + + my $payip = exists($options{'payip'}) + ? $options{'payip'} + : $self->payip; + $content{customer_ip} = $payip + if length($payip); + + my $payinfo = ''; + if ( $options{method} eq 'CC' ) { + + if ( $cust_pay ) { + $content{card_number} = $payinfo = $cust_pay->payinfo; + (exists($options{'paydate'}) ? $options{'paydate'} : $cust_pay->paydate) + =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/ && + ($content{expiration} = "$2/$1"); # where available + } else { + $content{card_number} = $payinfo = $self->payinfo; + (exists($options{'paydate'}) ? $options{'paydate'} : $self->paydate) + =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } + + } elsif ( $options{method} eq 'ECHECK' ) { + + if ( $cust_pay ) { + $payinfo = $cust_pay->payinfo; + } else { + $payinfo = $self->payinfo; + } + ( $content{account_number}, $content{routing_code} )= split('@', $payinfo ); + $content{bank_name} = $self->payname; + $content{account_type} = 'CHECKING'; + $content{account_name} = $payname; + $content{customer_org} = $self->company ? 'B' : 'I'; + $content{customer_ssn} = $self->ss; + } elsif ( $options{method} eq 'LEC' ) { + $content{phone} = $payinfo = $self->payinfo; + } + + #then try refund + my $refund = new Business::OnlinePayment( $processor, @bop_options ); + my %sub_content = $refund->content( + 'action' => 'credit', + 'customer_id' => $self->custnum, + 'last_name' => $paylast, + 'first_name' => $payfirst, + 'name' => $payname, + 'address' => $address, + 'city' => $self->city, + 'state' => $self->state, + 'zip' => $self->zip, + 'country' => $self->country, + 'email' => $email, + 'phone' => $self->daytime || $self->night, + %content, #after + ); + warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) + if $DEBUG > 1; + $refund->test_transaction(1) + if $conf->exists('business-onlinepayment-test_transaction'); + $refund->submit(); + + return "$processor error: ". $refund->error_message + unless $refund->is_success(); + + my $paybatch = "$processor:". $refund->authorization; + $paybatch .= ':'. $refund->order_number + if $refund->can('order_number') && $refund->order_number; + + while ( $cust_pay && $cust_pay->unapplied < $amount ) { + my @cust_bill_pay = $cust_pay->cust_bill_pay; + last unless @cust_bill_pay; + my $cust_bill_pay = pop @cust_bill_pay; + my $error = $cust_bill_pay->delete; + last if $error; + } + + my $cust_refund = new FS::cust_refund ( { + 'custnum' => $self->custnum, + 'paynum' => $options{'paynum'}, + 'refund' => $amount, + '_date' => '', + 'payby' => $bop_method2payby{$options{method}}, + 'payinfo' => $payinfo, + 'paybatch' => $paybatch, + 'reason' => $options{'reason'} || 'card or ACH refund', + } ); + my $error = $cust_refund->insert; + if ( $error ) { + $cust_refund->paynum(''); #try again with no specific paynum + my $error2 = $cust_refund->insert; + if ( $error2 ) { + # gah, even with transactions. + my $e = 'WARNING: Card/ACH refunded but database not updated - '. + "error inserting refund ($processor): $error2". + " (previously tried insert with paynum #$options{'paynum'}" . + ": $error )"; + warn $e; + return $e; + } + } + + ''; #no error + +} + +=back + +=head1 BUGS + +Not autoloaded. + +=head1 SEE ALSO + +L<FS::cust_main>, L<FS::cust_main::Billing> + +=cut + +1; diff --git a/FS/FS/part_pkg.pm b/FS/FS/part_pkg.pm index 21ab97568..c08188bcd 100644 --- a/FS/FS/part_pkg.pm +++ b/FS/FS/part_pkg.pm @@ -16,6 +16,7 @@ use FS::type_pkgs; use FS::part_pkg_option; use FS::pkg_class; use FS::agent; +use FS::part_pkg_taxrate; use FS::part_pkg_taxoverride; use FS::part_pkg_taxproduct; use FS::part_pkg_link; diff --git a/FS/MANIFEST b/FS/MANIFEST index db3f5cfe6..64c7a0696 100644 --- a/FS/MANIFEST +++ b/FS/MANIFEST @@ -68,6 +68,8 @@ FS/cust_bill_pkg_detail.pm FS/cust_credit.pm FS/cust_credit_bill.pm FS/cust_main.pm +FS/cust_main/Billing.pm +FS/cust_main/Billing_Realtime.pm FS/cust_main/Import.pm FS/cust_main_Mixin.pm FS/cust_main_county.pm |