X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=c44c89377ff3f20fdedd2bb9c8bde10a7bef1a81;hp=00ddc828ef0c1e4bf6371e2f0f7320eaf5d65d33;hb=8c1f9804d9a02c0c054eededeb500c72a640249a;hpb=df962da38244a75e6a10277770b641bb73053e57 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 00ddc828e..c44c89377 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,8 @@ use FS::part_referral; use FS::cust_main_county; use FS::agent; use FS::cust_main_invoice; +use FS::cust_credit_bill; +use FS::cust_bill_pay; use FS::prepay_credit; @ISA = qw( FS::Record ); @@ -71,6 +74,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 +162,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 +200,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,15 +219,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; @@ -197,6 +239,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 { @@ -231,24 +282,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 ); @@ -259,7 +310,7 @@ sub insert { $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting svc_ (transaction rolled back): $error"; } } } @@ -270,6 +321,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, @@ -278,7 +339,7 @@ sub insert { $error = $cust_credit->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting credit (transaction rolled back): $error"; } } @@ -366,11 +427,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 @@ -386,12 +494,17 @@ 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_country('country') + || $self->ut_anything('comments') + || $self->ut_numbern('referral_custnum') ; #barf. need message catalogs. i18n. etc. $error .= "Please select a referral." @@ -404,13 +517,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(''); @@ -422,8 +531,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' => '', @@ -441,12 +548,62 @@ sub check { $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; - $self->zip =~ /^\s*(\w[\w\-\s]{2,8}\w)\s*$/ - or return "Illegal zip: ". $self->zip; - $self->zip($1); + 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; @@ -495,8 +652,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"); } @@ -608,6 +763,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? @@ -629,6 +787,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? @@ -796,6 +957,7 @@ sub collect { next unless $cust_bill->owed > 0; + # ?????????? next if qsearchs( 'cust_pay_batch', { 'invnum' => $cust_bill->invnum } ); warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, total_owed $total_owed)" if $Debug; @@ -871,6 +1033,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 @@ -884,10 +1054,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, @@ -945,6 +1113,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"; @@ -1006,6 +1241,106 @@ sub total_owed { sprintf( "%.2f", $total_bill ); } +=item apply_credits + +Applies (see L) unapplied credits (see L) +to outstanding invoice balances in chronological order and returns the value +of any remaining unapplied credits available for refund +(see L). + +=cut + +sub apply_credits { + my $self = shift; + + return 0 unless $self->total_credited; + + my @credits = sort { $b->_date <=> $a->_date} (grep { $_->credited > 0 } + qsearch('cust_credit', { 'custnum' => $self->custnum } ) ); + + my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } + qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + + my $credit; + + foreach my $cust_bill ( @invoices ) { + my $amount; + + if (!(defined $credit) || $credit->credited == 0) { + $credit = pop @credits or last; + } + + if ($cust_bill->owed >= $credit->credited) { + $amount=$credit->credited; + }else{ + $amount=$cust_bill->owed; + } + + my $cust_credit_bill = new FS::cust_credit_bill ( { + 'crednum' => $credit->crednum, + 'invnum' => $cust_bill->invnum, + 'amount' => $amount, + } ); + my $error = $cust_credit_bill->insert; + die $error if $error; + + redo if ($cust_bill->owed > 0); + + } + + return $self->total_credited; +} + +=item apply_payments + +Applies (see L) unapplied payments (see L) +to outstanding invoice balances in chronological order. + + #and returns the value of any remaining unapplied payments. + +=cut + +sub apply_payments { + my $self = shift; + + #return 0 unless + + my @payments = sort { $b->_date <=> $a->_date } ( grep { $_->unapplied > 0 } + qsearch('cust_pay', { 'custnum' => $self->custnum } ) ); + + my @invoices = sort { $a->_date <=> $b->_date} (grep { $_->owed > 0 } + qsearch('cust_bill', { 'custnum' => $self->custnum } ) ); + + my $payment; + + foreach my $cust_bill ( @invoices ) { + my $amount; + + if ( !defined $payment || $payment->unapplied = 0 ) { + $payment = pop @payments or last; + } + + if ( $cust_bill->owed >= $payment->unapplied ) { + $amount = $payment->unapplied; + } else { + $amount = $payment->owed; + } + + my $cust_bill_pay = new FS::cust_bill_pay ( { + 'paynum' => $payment->paynum, + 'invnum' => $cust_bill->invnum, + 'amount' => $amount, + } ); + my $error = $cust_bill_pay->insert; + die $error if $error; + + redo if ( $cust_bill->owed > 0); + + } + + # return 0; +} + =item total_credited Returns the total credits (see L) for this customer. @@ -1115,11 +1450,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.13 2001-05-07 02:07:38 ivan Exp $ +$Id: cust_main.pm,v 1.27 2001-09-02 02:46:55 ivan Exp $ =head1 BUGS @@ -1136,8 +1518,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