X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=c44c89377ff3f20fdedd2bb9c8bde10a7bef1a81;hp=c3a3e3fc694026aa4e9bfa2f6debd306b8a04b4f;hb=8c1f9804d9a02c0c054eededeb500c72a640249a;hpb=7cb7cd1990ccd45f50eabce4ca8a57cf1eb69abd diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index c3a3e3fc6..c44c89377 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -17,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; @@ -28,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 ); @@ -280,14 +282,14 @@ 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 ) { # CUST_PKG_HASHREF @@ -297,7 +299,7 @@ sub insert { $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 ); @@ -308,7 +310,7 @@ sub insert { $error = $svc_something->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting svc_ (transaction rolled back): $error"; } } } @@ -324,7 +326,7 @@ sub insert { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "checking invoicing_list (transaction rolled back): $error"; } $self->invoicing_list( $invoicing_list ); } @@ -337,7 +339,7 @@ sub insert { $error = $cust_credit->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return $error; + return "inserting credit (transaction rolled back): $error"; } } @@ -500,7 +502,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." @@ -513,6 +517,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 { @@ -523,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' => '', @@ -565,13 +571,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' => '', @@ -648,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"); } @@ -955,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; @@ -1238,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. @@ -1347,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.18 2001-08-17 10:55:04 ivan Exp $ +$Id: cust_main.pm,v 1.27 2001-09-02 02:46:55 ivan Exp $ =head1 BUGS @@ -1368,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