X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=0a7f1f7cb968f2b85693280dc65db167458b128d;hp=7b75bea1eb7b295d289e87479e143d66f65d1f6d;hb=8ca6f203e5dae208d7af581d68671fe47c5e1a1a;hpb=d220c8a4bfa1aee8f17ed71c2dba655160dd3595 diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 7b75bea1e..0a7f1f7cb 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,12 +1,9 @@ -#this is so kludgy i'd be embarassed if it wasn't cybercash's fault -package main; -use vars qw($paymentserversecret $paymentserverport $paymentserverhost); - 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 +13,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,7 +24,10 @@ 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; +use FS::queue; @ISA = qw( FS::Record ); @@ -62,15 +62,16 @@ $FS::UID::callback{'FS::cust_main'} = sub { die "CCMckLib3_2::InitConfig fatal error: $errmsg\n"; } $processor='cybercash3.2'; - } elsif ( $conf->exists('cybercash2') ) { - require CCLib; - #qw(sendmserver); - ( $main::paymentserverhost, - $main::paymentserverport, - $main::paymentserversecret, - $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 +150,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 +188,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,28 +207,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. -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; tie %hash, 'Tie::RefHash'; #this part is important - %hash = { + %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 @param = @_; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -208,6 +249,7 @@ sub insert { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -227,25 +269,25 @@ sub insert { $seconds = $prepay_credit->seconds; my $error = $prepay_credit->delete; if ( $error ) { - $dbh->rollback; - return $error; + $dbh->rollback if $oldAutoCommit; + return "removing prepay_credit (transaction rolled back): $error"; } } my $error = $self->SUPER::insert; if ( $error ) { - $dbh->rollback; - return $error; + $dbh->rollback if $oldAutoCommit; + return "inserting cust_main record (transaction rolled back): $error"; } - if ( @_ ) { - my $cust_pkgs = shift; + 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; - return $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 ); @@ -255,18 +297,28 @@ sub insert { } $error = $svc_something->insert; if ( $error ) { - $dbh->rollback; - return $error; + $dbh->rollback if $oldAutoCommit; + return "inserting svc_ (transaction rolled back): $error"; } } } } if ( $seconds ) { - $dbh->rollback; + $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, @@ -274,12 +326,28 @@ sub insert { }; $error = $cust_credit->insert; if ( $error ) { - $dbh->rollback; - return $error; + $dbh->rollback if $oldAutoCommit; + return "inserting credit (transaction rolled back): $error"; + } + } + + my $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; + } + + if ( defined $self->dbdef_table->column('ship_last') && $self->ship_last ) { + $queue = new FS::queue { 'job' => 'FS::cust_main::append_fuzzyfiles' }; + $error = $queue->insert($self->getfield('last'), $self->company); + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "queueing job (transaction rolled back): $error"; } } - $dbh->commit or die $dbh->errstr; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; } @@ -304,13 +372,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'; @@ -318,34 +379,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; + } } - $self->SUPER::delete; + my $error = $self->SUPER::delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + $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 @@ -361,13 +498,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_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" @@ -376,13 +521,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(''); @@ -394,8 +535,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' => '', @@ -413,12 +552,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; @@ -467,8 +656,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"); } @@ -526,10 +713,16 @@ sub ncancelled_pkgs { Generates invoices (see L) for this customer. Usually used in conjunction with the collect method. +Options are passed as name-value pairs. + The only currently available option is `time', which bills the customer as if it were that time. It is specified as a UNIX timestamp; see L). Also see L and L for conversion -functions. +functions. For example: + + use Date::Parse; + ... + $cust_main->bill( 'time' => str2time('April 20th, 2001') ); If there is an error, returns the error, otherwise returns false. @@ -549,11 +742,15 @@ 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. my( $total_setup, $total_recur ) = ( 0, 0 ); - my @cust_bill_pkg; + my @cust_bill_pkg = (); foreach my $cust_pkg ( qsearch('cust_pkg',{'custnum'=> $self->getfield('custnum') } ) @@ -576,17 +773,24 @@ sub bill { my $setup = 0; unless ( $cust_pkg->setup ) { my $setup_prog = $part_pkg->getfield('setup'); + $setup_prog =~ /^(.*)$/ or do { + $dbh->rollback if $oldAutoCommit; + return "Illegal setup for pkgpart ". $part_pkg->pkgpart. + ": $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? $setup = $cpt->reval($setup_prog); unless ( defined($setup) ) { - warn "Error reval-ing part_pkg->setup pkgpart ", - $part_pkg->pkgpart, ": $@"; - } else { - $cust_pkg->setfield('setup',$time); - $cust_pkg_mod_flag=1; + $dbh->rollback if $oldAutoCommit; + return "Error reval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. + ": $@"; } + $cust_pkg->setfield('setup',$time); + $cust_pkg_mod_flag=1; } #bill recurring fee @@ -597,40 +801,57 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) < $time ) { my $recur_prog = $part_pkg->getfield('recur'); + $recur_prog =~ /^(.*)$/ or do { + $dbh->rollback if $oldAutoCommit; + return "Illegal recur for pkgpart ". $part_pkg->pkgpart. + ": $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? $recur = $cpt->reval($recur_prog); unless ( defined($recur) ) { - warn "Error reval-ing part_pkg->recur pkgpart ", - $part_pkg->pkgpart, ": $@"; - } else { - #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; - my ($sec,$min,$hour,$mday,$mon,$year) = - (localtime($sdate) )[0,1,2,3,4,5]; - $mon += $part_pkg->getfield('freq'); - until ( $mon < 12 ) { $mon -= 12; $year++; } - $cust_pkg->setfield('bill', - timelocal($sec,$min,$hour,$mday,$mon,$year)); - $cust_pkg_mod_flag = 1; + $dbh->rollback if $oldAutoCommit; + return "Error reval-ing part_pkg->recur pkgpart ". + $part_pkg->pkgpart. ": $@"; } + #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; + my ($sec,$min,$hour,$mday,$mon,$year) = + (localtime($sdate) )[0,1,2,3,4,5]; + $mon += $part_pkg->getfield('freq'); + until ( $mon < 12 ) { $mon -= 12; $year++; } + $cust_pkg->setfield('bill', + timelocal($sec,$min,$hour,$mday,$mon,$year)); + $cust_pkg_mod_flag = 1; } - 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); + 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); if ( $error ) { #just in case - warn "Error modifying pkgnum ", $cust_pkg->pkgnum, ": $error"; - } else { - $setup = sprintf( "%.2f", $setup ); - $recur = sprintf( "%.2f", $recur ); + $dbh->rollback if $oldAutoCommit; + return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; + } + $setup = sprintf( "%.2f", $setup ); + $recur = sprintf( "%.2f", $recur ); + if ( $setup < 0 ) { + $dbh->rollback if $oldAutoCommit; + return "negative setup $setup for pkgnum ". $cust_pkg->pkgnum; + } + if ( $recur < 0 ) { + $dbh->rollback if $oldAutoCommit; + return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; + } + if ( $setup > 0 || $recur > 0 ) { my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -648,11 +869,12 @@ 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' - ) { + unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { my $cust_main_county = qsearchs('cust_main_county',{ 'state' => $self->state, 'county' => $self->county, @@ -674,28 +896,29 @@ sub bill { } my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->getfield('custnum'), - '_date' => $time, + 'custnum' => $self->custnum, + '_date' => $time, '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 "can't create invoice for customer #". $self->custnum. ": $error"; + } my $invnum = $cust_bill->invnum; my $cust_bill_pkg; foreach $cust_bill_pkg ( @cust_bill_pkg ) { - $cust_bill_pkg->setfield( 'invnum', $invnum ); + warn $cust_bill_pkg->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 "can't create invoice line item for customer #". $self->custnum. + ": $error"; + } } + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; #no error } @@ -709,13 +932,15 @@ a credit card (`CARD'), or just add any necessary (pseudo-)payment (`COMP'). If there is an error, returns the error, otherwise returns false. +Options are passed as name-value pairs. + Currently available options are: 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). Also see L and L for conversion functions. -batch_card - Set this true to batch cards (see L). By +batch_card - Set this true to batch cards (see L). By default, cards are processed immediately, which will generate an error if CyberCash is not installed. @@ -728,10 +953,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'; @@ -740,22 +961,34 @@ sub collect { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + my $oldAutoCommit = $FS::UID::AutoCommit; + local $FS::UID::AutoCommit = 0; + my $dbh = dbh; + + my $balance = $self->balance; + warn "collect: balance $balance" if $Debug; + unless ( $balance > 0 ) { #redundant????? + $dbh->rollback if $oldAutoCommit; #hmm + return ''; + } + foreach my $cust_bill ( qsearch('cust_bill', { 'custnum' => $self->custnum, } ) ) { #this has to be before next's - my $amount = sprintf( "%.2f", $total_owed < $cust_bill->owed - ? $total_owed + my $amount = sprintf( "%.2f", $balance < $cust_bill->owed + ? $balance : $cust_bill->owed ); - $total_owed = sprintf( "%.2f", $total_owed - $amount ); + $balance = sprintf( "%.2f", $balance - $amount ); next unless $cust_bill->owed > 0; + # don't try to charge for the same invoice if it's already in a batch 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; + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ", amount $amount, balance $balance)" if $Debug; next unless $amount > 0; @@ -813,16 +1046,30 @@ 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; - if ( $processor =~ /^cybercash/ ) { + #fix exp. date + #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + my $exp = "$2/$1"; + + if ( $processor eq 'cybercash3.2' ) { #fix exp. date for cybercash #$self->paydate =~ /^(\d+)\/\d*(\d{2})$/; @@ -835,10 +1082,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, @@ -854,15 +1099,7 @@ sub collect { ); my %result; - if ( $processor eq 'cybercash2' ) { - $^W=0; #CCLib isn't -w safe, ugh! - %result = &CCLib::sendmserver(@full_xaction); - $^W=1; - } elsif ( $processor eq 'cybercash3.2' ) { - %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); - } else { - return "Unknown real-time processor $processor\n"; - } + %result = &CCMckDirectLib3_2::SendCC2_1Server(@full_xaction); #if ( $result{'MActionCode'} == 7 ) { #cybercash smps v.1.1.3 #if ( $result{'action-code'} == 7 ) { #cybercash smps v.2.1 @@ -876,17 +1113,140 @@ 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 $bop_processor = $1; + + 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 @invoicing_list = grep { $_ ne 'POST' } $self->invoicing_list; + if ( $conf->exists('emailinvoiceonly') ) { + @invoicing_list = $self->default_invoicing_list + unless @invoicing_list; + } + my $email = $invoicing_list[0]; + + my( $action1, $action2 ) = split(/\s*\,\s*/, $bop_action ); + + my $transaction = + new Business::OnlinePayment( $bop_processor, @bop_options ); + $transaction->content( + 'type' => 'CC', + 'login' => $bop_login, + 'password' => $bop_password, + 'action' => $action1, + 'description' => 'Internet Services', + '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, + 'referer' => 'http://cleanwhisker.420.am/', + 'email' => $email, + ); + $transaction->submit(); + + if ( $transaction->is_success() && $action2 ) { + my $auth = $transaction->authorization; + my $ordernum = $transaction->order_number; + #warn "********* $auth ***********\n"; + #warn "********* $ordernum ***********\n"; + my $capture = + new Business::OnlinePayment( $bop_processor, @bop_options ); + + $capture->content( + action => $action2, + login => $bop_login, + password => $bop_password, + order_number => $ordernum, + amount => $amount, + authorization => $auth, + description => 'Internet Services', + ); + + $capture->submit(); + + unless ( $capture->is_success ) { + my $e = "Authorization sucessful but capture failed, invnum #". + $cust_bill->invnum. ': '. $capture->result_code. + ": ". $capture->error_message; + warn $e; + return $e; + } + + } + + 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"; } @@ -910,15 +1270,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; ''; } @@ -926,7 +1291,7 @@ sub collect { =item total_owed Returns the total owed for this customer on all invoices -(see L). +(see L). =cut @@ -941,9 +1306,110 @@ 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 = $cust_bill->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. +Returns the total outstanding credit (see L) for this +customer. See L. =cut @@ -958,15 +1424,36 @@ sub total_credited { sprintf( "%.2f", $total_credit ); } +=item total_unapplied_payments + +Returns the total unapplied payments (see L) for this customer. +See L. + +=cut + +sub total_unapplied_payments { + my $self = shift; + my $total_unapplied = 0; + foreach my $cust_pay ( qsearch('cust_pay', { + 'custnum' => $self->custnum, + } ) ) { + $total_unapplied += $cust_pay->unapplied; + } + sprintf( "%.2f", $total_unapplied ); +} + =item balance -Returns the balance for this customer (total owed minus total credited). +Returns the balance for this customer (total_owed minus total_credited +minus total_unapplied_payments). =cut sub balance { my $self = shift; - sprintf( "%.2f", $self->total_owed - $self->total_credited ); + sprintf( "%.2f", + $self->total_owed - $self->total_credited - $self->total_unapplied_payments + ); } =item invoicing_list [ ARRAYREF ] @@ -1050,11 +1537,194 @@ sub check_invoicing_list { ''; } +=item default_invoicing_list + +=cut + +sub default_invoicing_list { + my $self = shift; + my @list = (); + foreach my $cust_pkg ( $self->all_pkgs ) { + my @cust_svc = qsearch('cust_svc', { 'pkgnum' => $cust_pkg->pkgnum } ); + my @svc_acct = + map { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + grep { qsearchs('svc_acct', { 'svcnum' => $_->svcnum } ) } + @cust_svc; + push @list, map { $_->email } @svc_acct; + } + $self->invoicing_list(\@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 check_and_rebuild_fuzzyfiles + +=cut + +sub check_and_rebuild_fuzzyfiles { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + -e "$dir/cust_main.last" && -e "$dir/cust_main.company" + or &rebuild_fuzzyfiles; +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + #last + + open(LASTLOCK,">>$dir/cust_main.last") + or die "can't open $dir/cust_main.last: $!"; + flock(LASTLOCK,LOCK_EX) + or die "can't lock $dir/cust_main.last: $!"; + + 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 (LASTCACHE,">$dir/cust_main.last.tmp") + or die "can't open $dir/cust_main.last.tmp: $!"; + print LASTCACHE join("\n", @all_last), "\n"; + close LASTCACHE or die "can't close $dir/cust_main.last.tmp: $!"; + + rename "$dir/cust_main.last.tmp", "$dir/cust_main.last"; + close LASTLOCK; + + #company + + open(COMPANYLOCK,">>$dir/cust_main.company") + or die "can't open $dir/cust_main.company: $!"; + flock(COMPANYLOCK,LOCK_EX) + or die "can't lock $dir/cust_main.company: $!"; + + my @all_company = grep $_ ne '', map $_->company, qsearch('cust_main',{}); + push @all_company, + grep $_ ne '', map $_->ship_company, qsearch('cust_main', {}) + if defined dbdef->table('cust_main')->column('ship_last'); + + open (COMPANYCACHE,">$dir/cust_main.company.tmp") + or die "can't open $dir/cust_main.company.tmp: $!"; + print COMPANYCACHE join("\n", @all_company), "\n"; + close COMPANYCACHE or die "can't close $dir/cust_main.company.tmp: $!"; + + rename "$dir/cust_main.company.tmp", "$dir/cust_main.company"; + close COMPANYLOCK; + +} + +=item all_last + +=cut + +sub all_last { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(LASTCACHE,"<$dir/cust_main.last") + or die "can't open $dir/cust_main.last: $!"; + my @array = map { chomp; $_; } ; + close LASTCACHE; + \@array; +} + +=item all_company + +=cut + +sub all_company { + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + open(COMPANYCACHE,"<$dir/cust_main.company") + or die "can't open $dir/cust_main.last: $!"; + my @array = map { chomp; $_; } ; + close COMPANYCACHE; + \@array; +} + +=item append_fuzzyfiles LASTNAME COMPANY + +=cut + +sub append_fuzzyfiles { + my( $last, $company ) = @_; + + &check_and_rebuild_fuzzyfiles; + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + + if ( $last ) { + + open(LAST,">>$dir/cust_main.last") + or die "can't open $dir/cust_main.last: $!"; + flock(LAST,LOCK_EX) + or die "can't lock $dir/cust_main.last: $!"; + + print LAST "$last\n"; + + flock(LAST,LOCK_UN) + or die "can't unlock $dir/cust_main.last: $!"; + close LAST; + } + + if ( $company ) { + + open(COMPANY,">>$dir/cust_main.company") + or die "can't open $dir/cust_main.company: $!"; + flock(COMPANY,LOCK_EX) + or die "can't lock $dir/cust_main.company: $!"; + + print COMPANY "$company\n"; + + flock(COMPANY,LOCK_UN) + or die "can't unlock $dir/cust_main.company: $!"; + + close COMPANY; + } + + 1; +} + =head1 VERSION -$Id: cust_main.pm,v 1.10 2001-02-03 14:03:50 ivan Exp $ +$Id: cust_main.pm,v 1.38 2001-09-26 09:17:06 ivan Exp $ =head1 BUGS @@ -1071,8 +1741,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