X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=382cc492df7c34fbd4745769e69c09ee793d4ad5;hp=e6b7531c48c13bb86ecaebed5713c0de056ddd3f;hb=6412f71a3557249225abf5eb2096ebad1729c585;hpb=2066bf9d3ebb4e53c49ab8b4b447c4eb88e425a4 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index e6b7531c4..382cc492d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -6,7 +6,8 @@ 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; @@ -16,7 +17,7 @@ use Mail::Internet; use Mail::Header; use Business::CreditCard; use FS::UID qw( getotaker dbh ); -use FS::Record qw( qsearchs qsearch ); +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"; } }; @@ -187,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 @@ -204,15 +218,16 @@ 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. -There is a special insert mode in which you pass a data structure to the insert -method containing FS::cust_pkg and FS::svc_I objects. When -running under a transactional database, all records are inserted atomicly, or -the transaction is rolled back. There should be a better explanation of this, +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; @@ -223,6 +238,15 @@ but until then, here's an example: ); $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 { @@ -257,24 +281,24 @@ sub insert { my $error = $prepay_credit->delete; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "removing prepay_credit (transaction rolled back): $error"; } } my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting cust_main record (transaction rolled back): $error"; } - if ( @param ) { + 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 $error; + return "inserting cust_pkg (transaction rolled back): $error"; } foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { $svc_something->pkgnum( $cust_pkg->pkgnum ); @@ -285,7 +309,7 @@ sub insert { $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting svc_ (transaction rolled back): $error"; } } } @@ -296,6 +320,16 @@ sub insert { 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, @@ -304,7 +338,7 @@ sub insert { $error = $cust_credit->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting credit (transaction rolled back): $error"; } } @@ -392,11 +426,58 @@ sub delete { } -=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 @@ -420,6 +501,9 @@ sub check { || $self->ut_text('city') || $self->ut_textn('county') || $self->ut_textn('state') + || $self->ut_country('country') + || $self->ut_anything('comments') + || $self->ut_numbern('referral_custnum') ; #barf. need message catalogs. i18n. etc. $error .= "Please select a referral." @@ -432,6 +516,10 @@ sub check { return "Unknown referral" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); + return "Unknown referring custnum ". $self->referral_custnum + unless ! $self->referral_custnum + || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); + if ( $self->ss eq '' ) { $self->ss(''); } else { @@ -442,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' => '', @@ -465,11 +551,15 @@ sub check { ; 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_$_") } - qw( last first company address1 address2 city county state zip - country daytime night fax ) - ) # if any address fields differ + if ( grep { $self->getfield($_) ne $self->getfield("ship_$_") } @addfields + && grep $self->getfield("ship_$_"), grep $_ ne 'state', @addfields + ) { my $error = $self->ut_name('ship_last') @@ -480,13 +570,11 @@ sub check { || $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 - $self->ship_country =~ /^(\w\w)$/ - or return "Illegal ship_country: ". $self->ship_country; - $self->ship_country($1); unless ( qsearchs('cust_main_county', { 'country' => $self->ship_country, 'state' => '', @@ -563,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"); } @@ -945,6 +1031,14 @@ sub collect { 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/ ) { #fix exp. date for cybercash @@ -958,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, @@ -1019,6 +1111,73 @@ sub collect { 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 { $dbh->rollback if $oldAutoCommit; return "Unknown real-time processor $processor\n"; @@ -1189,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.15 2001-07-30 10:41:44 ivan Exp $ +$Id: cust_main.pm,v 1.24 2001-09-01 21:52:20 jeff Exp $ =head1 BUGS @@ -1210,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