X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=382cc492df7c34fbd4745769e69c09ee793d4ad5;hp=59ec41b81ad8217a655b26d62447d97da4b85d49;hb=6412f71a3557249225abf5eb2096ebad1729c585;hpb=959663cd4d4885295f44de43ac005e55d054102f diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 59ec41b81..382cc492d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,17 +6,18 @@ package FS::cust_main; use strict; use vars qw( @ISA $conf $lpr $processor $xaction $E_NoErr $invoice_from - $smtpmachine $Debug ); + $smtpmachine $Debug $bop_processor $bop_login $bop_password + $bop_action @bop_options); use Safe; use Carp; use Time::Local; use Date::Format; -use Date::Manip; +#use Date::Manip; use Mail::Internet; use Mail::Header; use Business::CreditCard; -use FS::UID qw( getotaker ); -use FS::Record qw( qsearchs qsearch ); +use FS::UID qw( getotaker dbh ); +use FS::Record qw( qsearchs qsearch dbdef ); use FS::cust_pkg; use FS::cust_bill; use FS::cust_bill_pkg; @@ -27,6 +28,7 @@ use FS::part_referral; use FS::cust_main_county; use FS::agent; use FS::cust_main_invoice; +use FS::cust_credit_bill; use FS::prepay_credit; @ISA = qw( FS::Record ); @@ -71,6 +73,16 @@ $FS::UID::callback{'FS::cust_main'} = sub { $xaction, ) = $conf->config('cybercash2'); $processor='cybercash2'; + } elsif ( $conf->exists('business-onlinepayment') ) { + ( $bop_processor, + $bop_login, + $bop_password, + $bop_action, + @bop_options + ) = $conf->config('business-onlinepayment'); + $bop_action ||= 'normal authorization'; + eval "use Business::OnlinePayment"; + $processor="Business::OnlinePayment::$bop_processor"; } }; @@ -149,6 +161,32 @@ FS::Record. The following fields are currently supported: =item fax - phone (optional) +=item ship_first - name + +=item ship_last - name + +=item ship_company - (optional) + +=item ship_address1 + +=item ship_address2 - (optional) + +=item ship_city + +=item ship_county - (optional, see L) + +=item ship_state - (see L) + +=item ship_zip + +=item ship_country - (see L) + +=item ship_daytime - phone (optional) + +=item ship_night - phone (optional) + +=item ship_fax - phone (optional) + =item payby - `CARD' (credit cards), `BILL' (billing), `COMP' (free), or `PREPAY' (special billing type: applies a credit - see L and sets billing type to BILL) =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) @@ -161,6 +199,8 @@ FS::Record. The following fields are currently supported: =item otaker - order taker (assigned automatically, see L) +=item comments - comments (optional) + =back =head1 METHODS @@ -178,21 +218,40 @@ points to. You can ask the object for a copy with the I method. sub table { 'cust_main'; } -=item insert +=item insert [ CUST_PKG_HASHREF [ , INVOICING_LIST_ARYREF ] ] Adds this customer to the database. If there is an error, returns the error, otherwise returns false. +CUST_PKG_HASHREF: If you pass a Tie::RefHash data structure to the insert +method containing FS::cust_pkg and FS::svc_I objects, all records +are inserted atomicly, or the transaction is rolled back (this requries a +transactional database). Passing an empty hash reference is equivalent to +not supplying this parameter. There should be a better explanation of this, +but until then, here's an example: + + use Tie::RefHash; + tie %hash, 'Tie::RefHash'; #this part is important + %hash = ( + $cust_pkg => [ $svc_acct ], + ... + ); + $cust_main->insert( \%hash ); + +INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will +be set as the invoicing list (see L<"invoicing_list">). Errors return as +expected and rollback the entire transaction; it is not necessary to call +check_invoicing_list first. The invoicing_list is set after the records in the +CUST_PKG_HASHREF above are inserted, so it is now possible set set an +invoicing_list destination to the newly-created svc_acct. Here's an example: + + $cust_main->insert( {}, [ $email, 'POST' ] ); + =cut sub insert { my $self = shift; - - my $flag = 0; - if ( $self->payby eq 'PREPAY' ) { - $self->payby('BILL'); - $flag = 1; - } + my @param = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -201,30 +260,89 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - my $error = $self->SUPER::insert; - return $error if $error; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; - if ( $flag ) { - my $prepay_credit = - qsearchs('prepay_credit', { 'identifier' => $self->payinfo } ); + my $amount = 0; + my $seconds = 0; + if ( $self->payby eq 'PREPAY' ) { + $self->payby('BILL'); + my $prepay_credit = qsearchs( + 'prepay_credit', + { 'identifier' => $self->payinfo }, + '', + 'FOR UPDATE' + ); warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo unless $prepay_credit; - my $amount = $prepay_credit->amount; + $amount = $prepay_credit->amount; + $seconds = $prepay_credit->seconds; my $error = $prepay_credit->delete; if ( $error ) { - warn "WARNING: can't delete prepay_credit: ". $self->payinfo; - } else { - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - }; - my $error = $cust_credit->insert; - warn "WARNING: error inserting cust_credit for prepay_credit: $error" - if $error; + $dbh->rollback if $oldAutoCommit; + return "removing prepay_credit (transaction rolled back): $error"; } + } + my $error = $self->SUPER::insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main record (transaction rolled back): $error"; } + if ( @param ) { # CUST_PKG_HASHREF + my $cust_pkgs = shift @param; + foreach my $cust_pkg ( keys %$cust_pkgs ) { + $cust_pkg->custnum( $self->custnum ); + $error = $cust_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting cust_pkg (transaction rolled back): $error"; + } + foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $seconds ); + $seconds = 0; + } + $error = $svc_something->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting svc_ (transaction rolled back): $error"; + } + } + } + } + + if ( $seconds ) { + $dbh->rollback if $oldAutoCommit; + return "No svc_acct record to apply pre-paid time"; + } + + if ( @param ) { # INVOICING_LIST_ARYREF + my $invoicing_list = shift @param; + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "checking invoicing_list (transaction rolled back): $error"; + } + $self->invoicing_list( $invoicing_list ); + } + + if ( $amount ) { + my $cust_credit = new FS::cust_credit { + 'custnum' => $self->custnum, + 'amount' => $amount, + }; + $error = $cust_credit->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "inserting credit (transaction rolled back): $error"; + } + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -249,13 +367,6 @@ or credits (see L). sub delete { my $self = shift; - if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) { - return "Can't delete a customer with invoices"; - } - if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) { - return "Can't delete a customer with credits"; - } - local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; local $SIG{QUIT} = 'IGNORE'; @@ -263,34 +374,110 @@ sub delete { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + if ( qsearch( 'cust_bill', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with invoices"; + } + if ( qsearch( 'cust_credit', { 'custnum' => $self->custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Can't delete a customer with credits"; + } + my @cust_pkg = qsearch( 'cust_pkg', { 'custnum' => $self->custnum } ); if ( @cust_pkg ) { my $new_custnum = shift; - return "Invalid new customer number: $new_custnum" - unless qsearchs( 'cust_main', { 'custnum' => $new_custnum } ); + unless ( qsearchs( 'cust_main', { 'custnum' => $new_custnum } ) ) { + $dbh->rollback if $oldAutoCommit; + return "Invalid new customer number: $new_custnum"; + } foreach my $cust_pkg ( @cust_pkg ) { my %hash = $cust_pkg->hash; $hash{'custnum'} = $new_custnum; my $new_cust_pkg = new FS::cust_pkg ( \%hash ); my $error = $new_cust_pkg->replace($cust_pkg); - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } } } foreach my $cust_main_invoice ( qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ) ) { my $error = $cust_main_invoice->delete; - return $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + } + + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; } - $self->SUPER::delete; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + } -=item replace OLD_RECORD +=item replace OLD_RECORD [ INVOICING_LIST_ARYREF ] Replaces the OLD_RECORD with this one in the database. If there is an error, returns the error, otherwise returns false. +INVOICING_LIST_ARYREF: If you pass an arrarref to the insert method, it will +be set as the invoicing list (see L<"invoicing_list">). Errors return as +expected and rollback the entire transaction; it is not necessary to call +check_invoicing_list first. Here's an example: + + $new_cust_main->replace( $old_cust_main, [ $email, 'POST' ] ); + +=cut + +sub replace { + my $self = shift; + my $old = shift; + my @param = @_; + + 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; + + my $error = $self->SUPER::replace($old); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( @param ) { # INVOICING_LIST_ARYREF + my $invoicing_list = shift @param; + $error = $self->check_invoicing_list( $invoicing_list ); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + $self->invoicing_list( $invoicing_list ); + } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + =item check Checks all fields to make sure this is a valid customer record. If there is @@ -306,16 +493,21 @@ sub check { $self->ut_numbern('custnum') || $self->ut_number('agentnum') || $self->ut_number('refnum') + || $self->ut_name('last') + || $self->ut_name('first') || $self->ut_textn('company') || $self->ut_text('address1') || $self->ut_textn('address2') || $self->ut_text('city') || $self->ut_textn('county') || $self->ut_textn('state') - || $self->ut_phonen('daytime') - || $self->ut_phonen('night') - || $self->ut_phonen('fax') + || $self->ut_country('country') + || $self->ut_anything('comments') + || $self->ut_numbern('referral_custnum') ; + #barf. need message catalogs. i18n. etc. + $error .= "Please select a referral." + if $error =~ /^Illegal or empty \(numeric\) refnum: /; return $error if $error; return "Unknown agent" @@ -324,13 +516,9 @@ sub check { return "Unknown referral" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); - $self->getfield('last') =~ /^([\w \,\.\-\']+)$/ - or return "Illegal last name: ". $self->getfield('last'); - $self->setfield('last',$1); - - $self->first =~ /^([\w \,\.\-\']+)$/ - or return "Illegal first name: ". $self->first; - $self->first($1); + return "Unknown referring custnum ". $self->referral_custnum + unless ! $self->referral_custnum + || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); if ( $self->ss eq '' ) { $self->ss(''); @@ -342,8 +530,6 @@ sub check { $self->ss("$1-$2-$3"); } - $self->country =~ /^(\w\w)$/ or return "Illegal country: ". $self->country; - $self->country($1); unless ( qsearchs('cust_main_county', { 'country' => $self->country, 'state' => '', @@ -357,9 +543,66 @@ sub check { } ); } - $self->zip =~ /^\s*(\w[\w\-\s]{3,8}\w)\s*$/ - or return "Illegal zip: ". $self->zip; - $self->zip($1); + $error = + $self->ut_phonen('daytime', $self->country) + || $self->ut_phonen('night', $self->country) + || $self->ut_phonen('fax', $self->country) + || $self->ut_zip('zip', $self->country) + ; + return $error if $error; + + my @addfields = qw( + last first company address1 address2 city county state zip + country daytime night fax + ); + + if ( defined $self->dbdef_table->column('ship_last') ) { + if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields + && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields + ) + { + my $error = + $self->ut_name('ship_last') + || $self->ut_name('ship_first') + || $self->ut_textn('ship_company') + || $self->ut_text('ship_address1') + || $self->ut_textn('ship_address2') + || $self->ut_text('ship_city') + || $self->ut_textn('ship_county') + || $self->ut_textn('ship_state') + || $self->ut_country('ship_country') + ; + return $error if $error; + + #false laziness with above + unless ( qsearchs('cust_main_county', { + 'country' => $self->ship_country, + 'state' => '', + } ) ) { + return "Unknown ship_state/ship_county/ship_country: ". + $self->ship_state. "/". $self->ship_county. "/". $self->ship_country + unless qsearchs('cust_main_county',{ + 'state' => $self->ship_state, + 'county' => $self->ship_county, + 'country' => $self->ship_country, + } ); + } + #eofalse + + $error = + $self->ut_phonen('ship_daytime', $self->ship_country) + || $self->ut_phonen('ship_night', $self->ship_country) + || $self->ut_phonen('ship_fax', $self->ship_country) + || $self->ut_zip('ship_zip', $self->ship_country) + ; + return $error if $error; + + } else { # ship_ info eq billing info, so don't store dup info in database + $self->setfield("ship_$_", '') + foreach qw( last first company address1 address2 city county state zip + country daytime night fax ); + } + } $self->payby =~ /^(CARD|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; @@ -399,7 +642,7 @@ sub check { } - if ( $self->paydate eq '' ) { + if ( $self->paydate eq '' || $self->paydate eq '-' ) { return "Expriation date required" unless $self->payby eq 'BILL' || $self->payby eq 'PREPAY'; $self->paydate(''); @@ -408,8 +651,6 @@ sub check { or return "Illegal expiration date: ". $self->paydate; if ( length($2) == 4 ) { $self->paydate("$2-$1-01"); - } elsif ( $2 > 97 ) { #should pry change to check for "this year" - $self->paydate("19$2-$1-01"); } else { $self->paydate("20$2-$1-01"); } @@ -450,15 +691,16 @@ Returns all non-cancelled packages (see L) for this customer. sub ncancelled_pkgs { my $self = shift; - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => '', - }), - qsearch( 'cust_pkg', { - 'custnum' => $self->custnum, - 'cancel' => 0, - }), - ; + @{ [ # force list context + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => '', + }), + qsearch( 'cust_pkg', { + 'custnum' => $self->custnum, + 'cancel' => 0, + }), + ] }; } =item bill OPTIONS @@ -489,6 +731,10 @@ sub bill { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + # find the packages which are due for billing, find out how much they are # & generate invoice database. @@ -516,6 +762,9 @@ sub bill { my $setup = 0; unless ( $cust_pkg->setup ) { my $setup_prog = $part_pkg->getfield('setup'); + $setup_prog =~ /^(.*)$/ #presumably trusted + or die "Illegal setup for package ". $cust_pkg->pkgnum. ": $setup_prog"; + $setup_prog = $1; my $cpt = new Safe; #$cpt->permit(); #what is necessary? $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? @@ -537,6 +786,9 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) < $time ) { my $recur_prog = $part_pkg->getfield('recur'); + $recur_prog =~ /^(.*)$/ #presumably trusted + or die "Illegal recur for package ". $cust_pkg->pkgnum. ": $recur_prog"; + $recur_prog = $1; my $cpt = new Safe; #$cpt->permit(); #what is necessary? $cpt->share(qw( $cust_pkg )); #can $cpt now use $cust_pkg methods? @@ -545,7 +797,8 @@ sub bill { warn "Error reval-ing part_pkg->recur pkgpart ", $part_pkg->pkgpart, ": $@"; } else { - #change this bit to use Date::Manip? + #change this bit to use Date::Manip? CAREFUL with timezones (see + # mailing list archive) #$sdate=$cust_pkg->bill || time; #$sdate=$cust_pkg->bill || $time; $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; @@ -559,9 +812,9 @@ sub bill { } } - warn "setup is undefinded" unless defined($setup); - warn "recur is undefinded" unless defined($recur); - warn "cust_pkg bill is undefinded" unless defined($cust_pkg->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 ( $cust_pkg_mod_flag ) { $error=$cust_pkg->replace($old_cust_pkg); @@ -587,7 +840,10 @@ sub bill { my $charged = sprintf( "%.2f", $total_setup + $total_recur ); - return '' if scalar(@cust_bill_pkg) == 0; + unless ( @cust_bill_pkg ) { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return ''; + } unless ( $self->getfield('tax') =~ /Y/i || $self->getfield('payby') eq 'COMP' @@ -618,11 +874,10 @@ sub bill { 'charged' => $charged, } ); $error = $cust_bill->insert; - #shouldn't happen, but how else to handle this? (wrap me in eval, to catch - # fatal errors) - die "Error creating cust_bill record: $error!\n", - "Check updated but unbilled packages for customer", $self->custnum, "\n" - if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error for customer #". $self->custnum; + } my $invnum = $cust_bill->invnum; my $cust_bill_pkg; @@ -630,11 +885,13 @@ sub bill { $cust_bill_pkg->setfield( 'invnum', $invnum ); $error = $cust_bill_pkg->insert; #shouldn't happen, but how else tohandle this? - die "Error creating cust_bill_pkg record: $error!\n", - "Check incomplete invoice ", $invnum, "\n" - if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "$error for customer #". $self->custnum; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -667,10 +924,6 @@ sub collect { my( $self, %options ) = @_; my $invoice_time = $options{'invoice_time'} || time; - my $total_owed = $self->balance; - warn "collect: total owed $total_owed " if $Debug; - return '' unless $total_owed > 0; #redundant????? - #put below somehow? local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -679,6 +932,17 @@ sub collect { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $total_owed = $self->balance; + warn "collect: total owed $total_owed " if $Debug; + unless ( $total_owed > 0 ) { #redundant????? + $dbh->rollback if $oldAutoCommit; + return ''; + } + foreach my $cust_bill ( qsearch('cust_bill', { 'custnum' => $self->custnum, } ) ) { @@ -752,14 +1016,28 @@ sub collect { 'paybatch' => '' } ); my $error = $cust_pay->insert; - return 'Error COMPing invnum #' . $cust_bill->invnum . - ':' . $error if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return 'Error COMPing invnum #'. $cust_bill->invnum. ": $error"; + } + } elsif ( $self->payby eq 'CARD' ) { if ( $options{'batch_card'} ne 'yes' ) { - return "Real time card processing not enabled!" unless $processor; + unless ( $processor ) { + $dbh->rollback if $oldAutoCommit; + return "Real time card processing not enabled!"; + } + + my $address = $self->address1; + $address .= ", ". $self->address2 if $self->address2; + + #fix exp. date + #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; if ( $processor =~ /^cybercash/ ) { @@ -774,10 +1052,8 @@ sub collect { my $payname = $self->payname || $self->getfield('first'). ' '. $self->getfield('last'); - my $address = $self->address1; - $address .= ", ". $self->address2 if $self->address2; - my $country = 'USA' if $self->country eq 'US'; + my $country = $self->country eq 'US' ? 'USA' : $self->country; my @full_xaction = ( $xaction, 'Order-ID' => $paybatch, @@ -800,7 +1076,8 @@ sub collect { } elsif ( $processor eq 'cybercash3.2' ) { %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); } else { - return "Unkonwn real-time processor $processor\n"; + $dbh->rollback if $oldAutoCommit; + return "Unknown real-time processor $processor"; } #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 @@ -815,18 +1092,95 @@ sub collect { 'paybatch' => "$processor:$paybatch", } ); my $error = $cust_pay->insert; - return 'Error applying payment, invnum #' . - $cust_bill->invnum. ':'. $error if $error; + if ( $error ) { + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $cust_bill->invnum. + " (CyberCash Order-ID $paybatch): $error"; + warn $e; + return $e; + } } elsif ( $result{'Mstatus'} ne 'failure-bad-money' || $options{'report_badcard'} ) { + $dbh->commit if $oldAutoCommit; return 'Cybercash error, invnum #' . $cust_bill->invnum. ':'. $result{'MErrMsg'}; } else { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; } + } elsif ( $processor =~ /^Business::OnlinePayment::(.*)$/ ) { + + my($payname, $payfirst, $paylast); + if ( $self->payname ) { + $payname = $self->payname; + $payname =~ /^\s*([\w \,\.\-\']*\w)?\s+([\w\,\.\-\']+)$/ + or do { + $dbh->rollback if $oldAutoCommit; + return "Illegal payname $payname"; + }; + ($payfirst, $paylast) = ($1, $2); + } else { + $payfirst = $self->getfield('first'); + $paylast = $self->getfield('first'); + $payname = "$payfirst $paylast"; + } + + my $transaction = new Business::OnlinePayment( $1, @bop_options ); + $transaction->content( + 'type' => 'CC', + 'login' => $bop_login, + 'password' => $bop_password, + 'action' => $bop_action, + 'amount' => $amount, + 'invoice_number' => $cust_bill->invnum, + '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, + 'card_number' => $self->payinfo, + 'expiration' => $exp, + ); + $transaction->submit(); + + if ( $transaction->is_success()) { + my $cust_pay = new FS::cust_pay ( { + 'invnum' => $cust_bill->invnum, + 'paid' => $amount, + '_date' => '', + 'payby' => 'CARD', + 'payinfo' => $self->payinfo, + 'paybatch' => "$processor:". $transaction->authorization, + } ); + my $error = $cust_pay->insert; + if ( $error ) { + # gah, even with transactions. + $dbh->commit if $oldAutoCommit; #well. + my $e = 'WARNING: Card debited but database not updated - '. + 'error applying payment, invnum #' . $cust_bill->invnum. + " ($processor): $error"; + warn $e; + return $e; + } + } elsif ( $options{'report_badcard'} ) { + $dbh->commit if $oldAutoCommit; + return "$processor error, invnum #". $cust_bill->invnum. ': '. + $transaction->result_code. ": ". $transaction->error_message; + } else { + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + return '' + } + } else { - return "Unkonwn real-time processor $processor\n"; + $dbh->rollback if $oldAutoCommit; + return "Unknown real-time processor $processor\n"; } } else { #batch card @@ -849,15 +1203,20 @@ sub collect { 'amount' => $amount, } ); my $error = $cust_pay_batch->insert; - return "Error adding to cust_pay_batch: $error" if $error; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "Error adding to cust_pay_batch: $error"; + } } } else { + $dbh->rollback if $oldAutoCommit; return "Unknown payment type ". $self->payby; } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -989,11 +1348,58 @@ sub check_invoicing_list { ''; } +=item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] + +Returns an array of customers referred by this customer (referral_custnum set +to this custnum). If DEPTH is given, recurses up to the given depth, returning +customers referred by customers referred by this customer and so on, inclusive. +The default behavior is DEPTH 1 (no recursion). + +=cut + +sub referral_cust_main { + my $self = shift; + my $depth = @_ ? shift : 1; + my $exclude = @_ ? shift : {}; + + my @cust_main = + map { $exclude->{$_->custnum}++; $_; } + grep { ! $exclude->{ $_->custnum } } + qsearch( 'cust_main', { 'referral_custnum' => $self->custnum } ); + + if ( $depth > 1 ) { + push @cust_main, + map { $_->referral_cust_main($depth-1, $exclude) } + @cust_main; + } + + @cust_main; +} + +=back + +=head1 SUBROUTINES + +=over 4 + +=item rebuild_fuzzyfile + +=cut + +sub rebuild_fuzzyfiles { + my @all_last = map $_->getfield('last'), qsearch('cust_main', {}); + push @all_last, + grep $_, map $_->getfield('ship_last'), qsearch('cust_main',{}) + if defined dbdef->table('cust_main')->column('ship_last'); +# open( + +} + =back =head1 VERSION -$Id: cust_main.pm,v 1.3 2000-01-31 05:22:23 ivan Exp $ +$Id: cust_main.pm,v 1.24 2001-09-01 21:52:20 jeff Exp $ =head1 BUGS @@ -1010,8 +1416,6 @@ CyberCash v2 forces us to define some variables in package main. There should probably be a configuration file with a list of allowed credit card types. -CyberCash is the only processor. - No multiple currency support (probably a larger project than just this module). =head1 SEE ALSO