X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=298c01deef6a9d41a6d434790ae874bd86aa08e4;hb=f7cb5dd91c8fee24591541d00781bfbf60c31a21;hp=775523a56b7630eb15bb185d529bc30515198a3b;hpb=04cc48bd2a049909af54b9e58afebffe51cdd1b2;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 775523a56..298c01dee 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2,7 +2,7 @@ package FS::cust_main; use strict; use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields - $import $skip_fuzzyfiles ); + $import $skip_fuzzyfiles $ignore_expired_card ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; @@ -14,13 +14,16 @@ BEGIN { #eval "use Time::Local qw(timelocal timelocal_nocheck);"; eval "use Time::Local qw(timelocal_nocheck);"; } +use Digest::MD5 qw(md5_base64); use Date::Format; +use Date::Parse; #use Date::Manip; use String::Approx qw(amatch); -use Business::CreditCard; +use Business::CreditCard 0.28; use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); +use FS::Msgcat qw(gettext); use FS::cust_pkg; use FS::cust_svc; use FS::cust_bill; @@ -41,8 +44,11 @@ use FS::part_pkg; use FS::part_bill_event; use FS::cust_bill_event; use FS::cust_tax_exempt; +use FS::cust_tax_exempt_pkg; use FS::type_pkgs; -use FS::Msgcat qw(gettext); +use FS::payment_gateway; +use FS::agent_payment_gateway; +use FS::banned_pay; @ISA = qw( FS::Record ); @@ -50,11 +56,15 @@ use FS::Msgcat qw(gettext); $realtime_bop_decline_quiet = 0; +# 1 is mostly method/subroutine entry and options +# 2 traces progress of some operations +# 3 is even more information including possibly sensitive data $DEBUG = 0; $me = '[FS::cust_main]'; $import = 0; $skip_fuzzyfiles = 0; +$ignore_expired_card = 0; @encrypted_fields = ('payinfo', 'paycvv'); @@ -109,8 +119,6 @@ FS::cust_main - Object methods for cust_main records $error = $record->collect; $error = $record->collect %options; $error = $record->collect 'invoice_time' => $time, - 'batch_card' => 'yes', - 'report_badcard' => 'yes', ; =head1 DESCRIPTION @@ -240,7 +248,7 @@ sub paymask { if ( defined($value) && !$self->is_encrypted($value)) { my $payinfo = $value; my $payby = $self->payby; - if ($payby eq 'CARD' || $payby eq 'DCARD') { # Credit Cards (Show last four) + if ($payby eq 'CARD' || $payby eq 'DCRD') { # Credit Cards (Show last four) $paymask = 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); } elsif ($payby eq 'CHEK' || $payby eq 'DCHK' ) { # Checks (Show last 2 @ bank) @@ -256,13 +264,18 @@ sub paymask { return $paymask; } +=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item paystart_month - start date month (maestro/solo cards only) +=item paystart_year - start date year (maestro/solo cards only) -=item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy +=item payissue - issue number (maestro/solo cards only) =item payname - name on card or billing name +=item payip - IP address from which payment information was received + =item tax - tax exempt, empty or `Y' =item otaker - order taker (assigned automatically, see L) @@ -271,6 +284,8 @@ sub paymask { =item referral_custnum - referring customer number +=item spool_cdr - Enable individual CDR spooling, empty or `Y' + =back =head1 METHODS @@ -321,7 +336,7 @@ Currently available options are: I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such -as running the customer's credit card sucessfully). +as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with @@ -334,7 +349,7 @@ sub insert { my $cust_pkgs = @_ ? shift : {}; my $invoicing_list = @_ ? shift : ''; my %options = @_; - warn "FS::cust_main::insert called with options ". + warn "$me insert called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -351,12 +366,16 @@ sub insert { my $prepay_identifier = ''; my( $amount, $seconds ) = ( 0, 0 ); + my $payby = ''; if ( $self->payby eq 'PREPAY' ) { $self->payby('BILL'); $prepay_identifier = $self->payinfo; $self->payinfo(''); + warn " looking up prepaid card $prepay_identifier\n" + if $DEBUG > 1; + my $error = $self->get_prepay($prepay_identifier, \$amount, \$seconds); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -364,8 +383,19 @@ sub insert { return $error; } + $payby = 'PREP' if $amount; + + } elsif ( $self->payby =~ /^(CASH|WEST|MCRD)$/ ) { + + $payby = $1; + $self->payby('BILL'); + $amount = $self->paid; + } + warn " inserting $self\n" + if $DEBUG > 1; + my $error = $self->SUPER::insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -373,7 +403,9 @@ sub insert { return $error; } - # invoicing list + warn " setting invoicing list\n" + if $DEBUG > 1; + if ( $invoicing_list ) { $error = $self->check_invoicing_list( $invoicing_list ); if ( $error ) { @@ -383,7 +415,9 @@ sub insert { $self->invoicing_list( $invoicing_list ); } - # packages + warn " ordering packages\n" + if $DEBUG > 1; + $error = $self->order_pkgs($cust_pkgs, \$seconds, %options); if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -396,14 +430,18 @@ sub insert { } if ( $amount ) { - $error = $self->insert_prepay($amount, $prepay_identifier); + warn " inserting initial $payby payment of $amount\n" + if $DEBUG > 1; + $error = $self->insert_cust_pay($payby, $amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting prepayment (transaction rolled back): $error"; + return "inserting payment (transaction rolled back): $error"; } } unless ( $import || $skip_fuzzyfiles ) { + warn " queueing fuzzyfiles update\n" + if $DEBUG > 1; $error = $self->queue_fuzzyfiles_update; if ( $error ) { $dbh->rollback if $oldAutoCommit; @@ -411,6 +449,9 @@ sub insert { } } + warn " insert complete; committing transaction\n" + if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -439,7 +480,7 @@ Currently available options are: I and I. If I is set, all provisioning jobs will have a dependancy on the supplied jobnum (they will not run until the specific job completes). This can be used to defer provisioning until some action completes (such -as running the customer's credit card sucessfully). +as running the customer's credit card successfully). The I option is deprecated. If I is set true, no provisioning jobs (exports) are scheduled. (You can schedule them later with @@ -457,7 +498,7 @@ sub order_pkgs { my %svc_options = (); $svc_options{'depend_jobnum'} = $options{'depend_jobnum'} if exists $options{'depend_jobnum'}; - warn "FS::cust_main::order_pkgs called with options ". + warn "$me order_pkgs called with options ". join(', ', map { "$_: $options{$_}" } keys %options ). "\n" if $DEBUG; @@ -653,7 +694,7 @@ sub increment_seconds { my $cust_pkg = $cust_pkg[0]; warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" - if $DEBUG; + if $DEBUG > 1; my @cust_svc = $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); @@ -667,7 +708,7 @@ sub increment_seconds { my $svc_acct = $cust_svc[0]->svc_x; warn " found service svcnum ". $svc_acct->pkgnum. ' ('. $svc_acct->email. ")\n" - if $DEBUG; + if $DEBUG > 1; $svc_acct->increment_seconds($seconds); @@ -682,14 +723,42 @@ If there is an error, returns the error, otherwise returns false. =cut sub insert_cust_pay_prepay { - my( $self, $amount ) = splice(@_, 0, 2); + shift->insert_cust_pay('PREP', @_); +} + +=item insert_cust_pay_cash AMOUNT [ PAYINFO ] + +Inserts a cash payment in the specified amount for this customer. An optional +second argument can specify the payment identifier for tracking purposes. +If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_cash { + shift->insert_cust_pay('CASH', @_); +} + +=item insert_cust_pay_west AMOUNT [ PAYINFO ] + +Inserts a Western Union payment in the specified amount for this customer. An +optional second argument can specify the prepayment identifier for tracking +purposes. If there is an error, returns the error, otherwise returns false. + +=cut + +sub insert_cust_pay_west { + shift->insert_cust_pay('WEST', @_); +} + +sub insert_cust_pay { + my( $self, $payby, $amount ) = splice(@_, 0, 3); my $payinfo = scalar(@_) ? shift : ''; my $cust_pay = new FS::cust_pay { 'custnum' => $self->custnum, - 'paid' => $amount, + 'paid' => sprintf('%.2f', $amount), #'_date' => #date the prepaid card was purchased??? - 'payby' => 'PREP', + 'payby' => $payby, 'payinfo' => $payinfo, }; $cust_pay->insert; @@ -710,7 +779,7 @@ otherwise returns false. sub reexport { my $self = shift; - carp "warning: FS::cust_main::reexport is deprectated; ". + carp "WARNING: FS::cust_main::reexport is deprectated; ". "use the depend_jobnum option to insert or order_pkgs to delay export"; local $SIG{HUP} = 'IGNORE'; @@ -854,6 +923,8 @@ sub replace { my $self = shift; my $old = shift; my @param = @_; + warn "$me replace called\n" + if $DEBUG; local $SIG{HUP} = 'IGNORE'; local $SIG{INT} = 'IGNORE'; @@ -878,6 +949,11 @@ sub replace { unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } + local($ignore_expired_card) = 1 + if $old->payby =~ /^(CARD|DCRD)$/ + && $self->payby =~ /^(CARD|DCRD)$/ + && $old->payinfo eq $self->payinfo; + my $oldAutoCommit = $FS::UID::AutoCommit; local $FS::UID::AutoCommit = 0; my $dbh = dbh; @@ -974,7 +1050,8 @@ and replace methods. sub check { my $self = shift; - #warn "BEFORE: \n". $self->_dump; + warn "$me check BEFORE: \n". $self->_dump + if $DEBUG > 2; my $error = $self->ut_numbern('custnum') @@ -1073,7 +1150,7 @@ sub check { } ) ) { return "Unknown ship_state/ship_county/ship_country: ". $self->ship_state. "/". $self->ship_county. "/". $self->ship_country - unless qsearchs('cust_main_county',{ + unless qsearch('cust_main_county',{ 'state' => $self->ship_state, 'county' => $self->ship_county, 'country' => $self->ship_country, @@ -1096,9 +1173,22 @@ sub check { } } - $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ + $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY|CASH|WEST|MCRD)$/ or return "Illegal payby: ". $self->payby; + $error = $self->ut_numbern('paystart_month') + || $self->ut_numbern('paystart_year') + || $self->ut_numbern('payissue') + ; + return $error if $error; + + if ( $self->payip eq '' ) { + $self->payip(''); + } else { + $error = $self->ut_ip('payip'); + return $error if $error; + } + # If it is encrypted and the private key is not availaible then we can't # check the credit card. @@ -1110,7 +1200,7 @@ sub check { $self->payby($1); - if ( $check_payinfo && ($self->payby eq 'CARD' || $self->payby eq 'DCRD')) { + if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -1120,8 +1210,13 @@ sub check { $self->payinfo($payinfo); validate($payinfo) or return gettext('invalid_card'); # . ": ". $self->payinfo; + return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; + + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + return "Banned credit card" if $ban; + if ( defined $self->dbdef_table->column('paycvv') ) { if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { if ( cardtype($self->payinfo) eq 'American Express card' ) { @@ -1138,15 +1233,47 @@ sub check { } } - } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) { + my $cardtype = cardtype($payinfo); + if ( $cardtype =~ /^(Switch|Solo)$/i ) { + + return "Start date or issue number is required for $cardtype cards" + unless $self->paystart_month && $self->paystart_year or $self->payissue; + + return "Start month must be between 1 and 12" + if $self->paystart_month + and $self->paystart_month < 1 || $self->paystart_month > 12; + + return "Start year must be 1990 or later" + if $self->paystart_year + and $self->paystart_year < 1990; + + return "Issue number must be beween 1 and 99" + if $self->payissue + and $self->payissue < 1 || $self->payissue > 99; + + } else { + $self->paystart_month(''); + $self->paystart_year(''); + $self->payissue(''); + } + + } elsif ( $check_payinfo && $self->payby =~ /^(CHEK|DCHK)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; - $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; - $payinfo = "$1\@$2"; + if ( $conf->exists('echeck-nonus') ) { + $payinfo =~ /^(\d+)\@(\d+)$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + } else { + $payinfo =~ /^(\d+)\@(\d{9})$/ or return 'invalid echeck account@aba'; + $payinfo = "$1\@$2"; + } $self->payinfo($payinfo); $self->paycvv('') if $self->dbdef_table->column('paycvv'); + my $ban = qsearchs('banned_pay', $self->_banned_pay_hashref); + return "Banned ACH account" if $ban; + } elsif ( $self->payby eq 'LECB' ) { my $payinfo = $self->payinfo; @@ -1187,8 +1314,8 @@ sub check { } if ( $self->paydate eq '' || $self->paydate eq '-' ) { - return "Expriation date required" - unless $self->payby =~ /^(BILL|PREPAY|CHEK|LECB)$/; + return "Expiration date required" + unless $self->payby =~ /^(BILL|PREPAY|CHEK|DCHK|LECB|CASH|WEST|MCRD)$/; $self->paydate(''); } else { my( $m, $y ); @@ -1202,7 +1329,9 @@ sub check { $self->paydate("$y-$m-01"); my($nowm,$nowy)=(localtime(time))[4,5]; $nowm++; $nowy+=1900; return gettext('expired_card') - if !$import && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); + if !$import + && !$ignore_expired_card + && ( $y<$nowy || ( $y==$nowy && $1<$nowm ) ); } if ( $self->payname eq '' && $self->payby !~ /^(CHEK|DCHK)$/ && @@ -1216,12 +1345,15 @@ sub check { $self->payname($1); } - $self->tax =~ /^(Y?)$/ or return "Illegal tax: ". $self->tax; - $self->tax($1); + foreach my $flag (qw( tax spool_cdr )) { + $self->$flag() =~ /^(Y?)$/ or return "Illegal $flag: ". $self->$flag(); + $self->$flag($1); + } $self->otaker(getotaker) unless $self->otaker; - #warn "AFTER: \n". $self->_dump; + warn "$me check AFTER: \n". $self->_dump + if $DEBUG > 2; $self->SUPER::check; } @@ -1339,7 +1471,8 @@ sub unsuspend { =item suspend Suspends all unsuspended packages (see L) for this customer. -Always returns a list: an empty list on success or a list of errors. + +Returns a list: an empty list on success or a list of errors. =cut @@ -1351,8 +1484,9 @@ sub suspend { =item suspend_if_pkgpart PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) matching the listed -PKGPARTs (see L). Always returns a list: an empty list on -success or a list of errors. +PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1367,8 +1501,9 @@ sub suspend_if_pkgpart { =item suspend_unless_pkgpart PKGPART [ , PKGPART ... ] Suspends all unsuspended packages (see L) unless they match the -listed PKGPARTs (see L). Always returns a list: an empty list -on success or a list of errors. +listed PKGPARTs (see L). + +Returns a list: an empty list on success or a list of errors. =cut @@ -1384,19 +1519,56 @@ sub suspend_unless_pkgpart { Cancels all uncancelled packages (see L) for this customer. -Available options are: I +Available options are: I, I, and I I can be set true to supress email cancellation notices. +# I can be set to a cancellation reason (see L) + +I can be set true to ban this customer's credit card or ACH information, +if present. + Always returns a list: an empty list on success or a list of errors. =cut sub cancel { my $self = shift; + my %opt = @_; + + if ( $opt{'ban'} && $self->payby =~ /^(CARD|DCRD|CHEK|DCHK)$/ ) { + + #should try decryption (we might have the private key) + # and if not maybe queue a job for the server that does? + return ( "Can't (yet) ban encrypted credit cards" ) + if $self->is_encrypted($self->payinfo); + + my $ban = new FS::banned_pay $self->_banned_pay_hashref; + my $error = $ban->insert; + return ( $error ) if $error; + + } + grep { $_ } map { $_->cancel(@_) } $self->ncancelled_pkgs; } +sub _banned_pay_hashref { + my $self = shift; + + my %payby2ban = ( + 'CARD' => 'CARD', + 'DCRD' => 'CARD', + 'CHEK' => 'CHEK', + 'DCHK' => 'CHEK' + ); + + { + 'payby' => $payby2ban{$self->payby}, + 'payinfo' => md5_base64($self->payinfo), + #'reason' => + }; +} + =item agent Returns the agent (see L) for this customer. @@ -1435,7 +1607,8 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; return '' if $self->payby eq 'COMP'; - warn "bill customer ". $self->custnum. "\n" if $DEBUG; + warn "$me bill customer ". $self->custnum. "\n" + if $DEBUG; my $time = $options{'time'} || time; @@ -1455,17 +1628,30 @@ sub bill { $self->select_for_update; #mutex + #create a new invoice + #(we'll remove it later if it doesn't actually need to be generated [contains + # no line items] and we're inside a transaciton so nothing else will see it) + my $cust_bill = new FS::cust_bill ( { + 'custnum' => $self->custnum, + '_date' => $time, + #'charged' => $charged, + 'charged' => 0, + } ); + $error = $cust_bill->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice for customer #". $self->custnum. ": $error"; + } + my $invnum = $cust_bill->invnum; + + ### # 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( $taxable_setup, $taxable_recur ) = ( 0, 0 ); - my @cust_bill_pkg = (); - #my $tax = 0;## - #my $taxable_charged = 0;## - #my $charged = 0;## + ### + my( $total_setup, $total_recur ) = ( 0, 0 ); my %tax; + my @precommit_hooks = (); foreach my $cust_pkg ( qsearch('cust_pkg', { 'custnum' => $self->custnum } ) @@ -1474,7 +1660,7 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); - warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG; + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') @@ -1487,22 +1673,28 @@ sub bill { my @details = (); + ### # bill setup + ### + my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - warn " bill setup\n" if $DEBUG; + warn " bill setup\n" if $DEBUG > 1; $setup = eval { $cust_pkg->calc_setup( $time ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_setup for $cust_pkg\n"; } $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; } - #bill recurring fee + ### + # bill recurring fee + ### + my $recur = 0; my $sdate; if ( $part_pkg->getfield('freq') ne '0' && @@ -1510,15 +1702,18 @@ sub bill { ( $cust_pkg->getfield('bill') || 0 ) <= $time ) { - warn " bill recur\n" if $DEBUG; + warn " bill recur\n" if $DEBUG > 1; # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + #over two params! lets at least switch to a hashref for the rest... + my %param = ( 'precommit_hooks' => \@precommit_hooks, ); + + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details, \%param ) }; if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return $@; + return "$@ running calc_recur for $cust_pkg\n"; } #change this bit to use Date::Manip? CAREFUL with timezones (see @@ -1542,6 +1737,9 @@ sub bill { } elsif ( $part_pkg->freq =~ /^(\d+)d$/ ) { my $days = $1; $mday += $days; + } elsif ( $part_pkg->freq =~ /^(\d+)h$/ ) { + my $hours = $1; + $hour += $hours; } else { $dbh->rollback if $oldAutoCommit; return "unparsable frequency: ". $part_pkg->freq; @@ -1554,9 +1752,14 @@ sub bill { warn "\$recur is undefined" unless defined($recur); warn "\$cust_pkg->bill is undefined" unless defined($cust_pkg->bill); + ### + # If $cust_pkg has been modified, update it and create cust_bill_pkg records + ### + if ( $cust_pkg->modified ) { - warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" + if $DEBUG >1; $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case @@ -1574,10 +1777,13 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "negative recur $recur for pkgnum ". $cust_pkg->pkgnum; } + if ( $setup != 0 || $recur != 0 ) { - warn " charges (setup=$setup, recur=$recur); queueing line items\n" - if $DEBUG; + + warn " charges (setup=$setup, recur=$recur); adding line items\n" + if $DEBUG > 1; my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'invnum' => $invnum, 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, 'recur' => $recur, @@ -1585,10 +1791,18 @@ sub bill { 'edate' => $cust_pkg->bill, 'details' => \@details, }); - push @cust_bill_pkg, $cust_bill_pkg; + $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item for invoice #$invnum: $error"; + } $total_setup += $setup; $total_recur += $recur; + ### + # handle taxes + ### + unless ( $self->tax =~ /Y/i || $self->payby eq 'COMP' ) { my @taxes = qsearch( 'cust_main_county', { @@ -1637,7 +1851,8 @@ sub bill { next unless $taxable_charged; if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { - my ($mon,$year) = (localtime($sdate) )[4,5]; + #my ($mon,$year) = (localtime($sdate) )[4,5]; + my ($mon,$year) = (localtime( $sdate || $cust_bill->_date ) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; if ( $freq !~ /(\d+)$/ ) { @@ -1645,40 +1860,74 @@ sub bill { return "daily/weekly package definitions not (yet?)". " compatible with monthly tax exemptions"; } - my $taxable_per_month = sprintf("%.2f", $taxable_charged / $freq ); + my $taxable_per_month = + sprintf("%.2f", $taxable_charged / $freq ); + + #call the whole thing off if this customer has any old + #exemption records... + my @cust_tax_exempt = + qsearch( 'cust_tax_exempt' => { custnum=> $self->custnum } ); + if ( @cust_tax_exempt ) { + $dbh->rollback if $oldAutoCommit; + return + 'this customer still has old-style tax exemption records; '. + 'run bin/fs-migrate-cust_tax_exempt?'; + } + foreach my $which_month ( 1 .. $freq ) { - my %hash = ( - 'custnum' => $self->custnum, - 'taxnum' => $tax->taxnum, - 'year' => 1900+$year, - 'month' => $mon++, - ); - #until ( $mon < 12 ) { $mon -= 12; $year++; } - until ( $mon < 13 ) { $mon -= 12; $year++; } - my $cust_tax_exempt = - qsearchs('cust_tax_exempt', \%hash) - || new FS::cust_tax_exempt( { %hash, 'amount' => 0 } ); - my $remaining_exemption = sprintf("%.2f", - $tax->exempt_amount - $cust_tax_exempt->amount ); + + #maintain the new exemption table now + my $sql = " + SELECT SUM(amount) + FROM cust_tax_exempt_pkg + LEFT JOIN cust_bill_pkg USING ( billpkgnum ) + LEFT JOIN cust_bill USING ( invnum ) + WHERE custnum = ? + AND taxnum = ? + AND year = ? + AND month = ? + "; + my $sth = dbh->prepare($sql) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + $sth->execute( + $self->custnum, + $tax->taxnum, + 1900+$year, + $mon, + ) or do { + $dbh->rollback if $oldAutoCommit; + return "fatal: can't lookup exising exemption: ". dbh->errstr; + }; + my $existing_exemption = $sth->fetchrow_arrayref->[0] || 0; + + my $remaining_exemption = + $tax->exempt_amount - $existing_exemption; if ( $remaining_exemption > 0 ) { my $addl = $remaining_exemption > $taxable_per_month ? $taxable_per_month : $remaining_exemption; $taxable_charged -= $addl; - my $new_cust_tax_exempt = new FS::cust_tax_exempt ( { - $cust_tax_exempt->hash, - 'amount' => - sprintf("%.2f", $cust_tax_exempt->amount + $addl), + + my $cust_tax_exempt_pkg = new FS::cust_tax_exempt_pkg ( { + 'billpkgnum' => $cust_bill_pkg->billpkgnum, + 'taxnum' => $tax->taxnum, + 'year' => 1900+$year, + 'month' => $mon, + 'amount' => sprintf("%.2f", $addl ), } ); - $error = $new_cust_tax_exempt->exemptnum - ? $new_cust_tax_exempt->replace($cust_tax_exempt) - : $new_cust_tax_exempt->insert; + $error = $cust_tax_exempt_pkg->insert; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "fatal: can't update cust_tax_exempt: $error"; + return "fatal: can't insert cust_tax_exempt_pkg: $error"; } - } # if $remaining_exemption > 0 + + #++ + $mon++; + #until ( $mon < 12 ) { $mon -= 12; $year++; } + until ( $mon < 13 ) { $mon -= 12; $year++; } } #foreach $which_month @@ -1700,85 +1949,50 @@ sub bill { } #foreach my $cust_pkg - my $charged = sprintf( "%.2f", $total_setup + $total_recur ); -# my $taxable_charged = sprintf( "%.2f", $taxable_setup + $taxable_recur ); - - unless ( @cust_bill_pkg ) { #don't create invoices with no line items + unless ( $cust_bill->cust_bill_pkg ) { + $cust_bill->delete; #don't create an invoice w/o line items $dbh->commit or die $dbh->errstr if $oldAutoCommit; return ''; - } - -# unless ( $self->tax =~ /Y/i -# || $self->payby eq 'COMP' -# || $taxable_charged == 0 ) { -# my $cust_main_county = qsearchs('cust_main_county',{ -# 'state' => $self->state, -# 'county' => $self->county, -# 'country' => $self->country, -# } ) or die "fatal: can't find tax rate for state/county/country ". -# $self->state. "/". $self->county. "/". $self->country. "\n"; -# my $tax = sprintf( "%.2f", -# $taxable_charged * ( $cust_main_county->getfield('tax') / 100 ) -# ); - - if ( dbdef->table('cust_bill_pkg')->column('itemdesc') ) { #1.5 schema - - foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { - my $tax = sprintf("%.2f", $tax{$taxname} ); - $charged = sprintf( "%.2f", $charged+$tax ); - - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - 'itemdesc' => $taxname, - }); - push @cust_bill_pkg, $cust_bill_pkg; - } - - } else { #1.4 schema + } - my $tax = 0; - foreach ( values %tax ) { $tax += $_ }; - $tax = sprintf("%.2f", $tax); - if ( $tax > 0 ) { - $charged = sprintf( "%.2f", $charged+$tax ); + my $charged = sprintf( "%.2f", $total_setup + $total_recur ); - my $cust_bill_pkg = new FS::cust_bill_pkg ({ - 'pkgnum' => 0, - 'setup' => $tax, - 'recur' => 0, - 'sdate' => '', - 'edate' => '', - }); - push @cust_bill_pkg, $cust_bill_pkg; + foreach my $taxname ( grep { $tax{$_} > 0 } keys %tax ) { + my $tax = sprintf("%.2f", $tax{$taxname} ); + $charged = sprintf( "%.2f", $charged+$tax ); + + my $cust_bill_pkg = new FS::cust_bill_pkg ({ + 'invnum' => $invnum, + 'pkgnum' => 0, + 'setup' => $tax, + 'recur' => 0, + 'sdate' => '', + 'edate' => '', + 'itemdesc' => $taxname, + }); + $error = $cust_bill_pkg->insert; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "can't create invoice line item for invoice #$invnum: $error"; } + $total_setup += $tax; } - my $cust_bill = new FS::cust_bill ( { - 'custnum' => $self->custnum, - '_date' => $time, - 'charged' => $charged, - } ); - $error = $cust_bill->insert; + $cust_bill->charged( sprintf( "%.2f", $total_setup + $total_recur ) ); + $error = $cust_bill->replace; if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice for customer #". $self->custnum. ": $error"; + return "can't update charged for invoice #$invnum: $error"; } - my $invnum = $cust_bill->invnum; - my $cust_bill_pkg; - foreach $cust_bill_pkg ( @cust_bill_pkg ) { - #warn $invnum; - $cust_bill_pkg->invnum($invnum); - $error = $cust_bill_pkg->insert; - if ( $error ) { + foreach my $hook ( @precommit_hooks ) { + eval { + &{$hook}; #($self) ? + }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "can't create invoice line item for customer #". $self->custnum. - ": $error"; + return "$@ running precommit hook $hook\n"; } } @@ -1811,17 +2025,11 @@ for conversion functions. retry - Retry card/echeck/LEC transactions even when not scheduled by invoice events. -retry_card - Deprecated alias for 'retry' - -batch_card - This option is deprecated. See the invoice events web interface -to control whether cards are batched or run against a realtime gateway. - -report_badcard - This option is deprecated. - -force_print - This option is deprecated; see the invoice events web interface. - quiet - set true to surpress email card/ACH decline notices. +freq - "1d" for the traditional, daily events (the default), or "1m" for the +new monthly events + =cut sub collect { @@ -1843,7 +2051,8 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG; + warn "$me collect customer ". $self->custnum. ": balance $balance\n" + if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1861,6 +2070,13 @@ sub collect { } } + my $extra_sql = ''; + if ( defined $options{'freq'} && $options{'freq'} eq '1m' ) { + $extra_sql = " AND freq = '1m' "; + } else { + $extra_sql = " AND ( freq = '1d' OR freq IS NULL OR freq = '' ) "; + } + foreach my $cust_bill ( $self->open_cust_bill ) { # don't try to charge for the same invoice if it's already in a batch @@ -1868,8 +2084,8 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" - if $DEBUG; + warn " invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" + if $DEBUG > 1; foreach my $part_bill_event ( sort { $a->seconds <=> $b->seconds @@ -1882,15 +2098,19 @@ sub collect { 'status' => 'done', } ) } - qsearch('part_bill_event', { 'payby' => $self->payby, - 'disabled' => '', } ) + qsearch( { + 'table' => 'part_bill_event', + 'hashref' => { 'payby' => $self->payby, + 'disabled' => '', }, + 'extra_sql' => $extra_sql, + } ) ) { last if $cust_bill->owed <= 0 # don't run subsequent events if owed<=0 || $self->balance <= 0; # or if balance<=0 - warn "calling invoice event (". $part_bill_event->eventcode. ")\n" - if $DEBUG; + warn " calling invoice event (". $part_bill_event->eventcode. ")\n" + if $DEBUG > 1; my $cust_main = $self; #for callback my $error; @@ -2017,7 +2237,7 @@ if set, will override the value from the customer record. I is a free-text field passed to the gateway. It defaults to "Internet services". -If an I is specified, this payment (if sucessful) is applied to the +If an I is specified, this payment (if successful) is applied to the specified invoice. If you don't specify an I you might want to call the B method. @@ -2030,31 +2250,84 @@ I can be set true to surpress email decline notices. sub realtime_bop { my( $self, $method, $amount, %options ) = @_; if ( $DEBUG ) { - warn "$self $method $amount\n"; + warn "$me realtime_bop: $method $amount\n"; warn " $_ => $options{$_}\n" foreach keys %options; } $options{'description'} ||= 'Internet services'; - #pre-requisites - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); eval "use Business::OnlinePayment"; die $@ if $@; - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $action, @bop_options ) = - $conf->config($bop_config); - $action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; + my $payinfo = exists($options{'payinfo'}) + ? $options{'payinfo'} + : $self->payinfo; - #massage data + ### + # select a gateway + ### + + my $taxclass = ''; + if ( $options{'invnum'} ) { + my $cust_bill = qsearchs('cust_bill', { 'invnum' => $options{'invnum'} } ); + die "invnum ". $options{'invnum'}. " not found" unless $cust_bill; + my @taxclasses = + map { $_->part_pkg->taxclass } + grep { $_ } + map { $_->cust_pkg } + $cust_bill->cust_bill_pkg; + unless ( grep { $taxclasses[0] ne $_ } @taxclasses ) { #unless there are + #different taxclasses + $taxclass = $taxclasses[0]; + } + } + + #look for an agent gateway override first + my $cardtype; + if ( $method eq 'CC' ) { + $cardtype = cardtype($payinfo); + } elsif ( $method eq 'ECHECK' ) { + $cardtype = 'ACH'; + } else { + $cardtype = $method; + } + + my $override = + qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => $taxclass, } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => $taxclass, } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => '', } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => '', } ); + + my $payment_gateway = ''; + my( $processor, $login, $password, $action, @bop_options ); + if ( $override ) { #use a payment gateway override + + $payment_gateway = $override->payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + $action = $payment_gateway->gateway_action; + @bop_options = $payment_gateway->options; + + } else { #use the standard settings from the config + + ( $processor, $login, $password, $action, @bop_options ) = + $self->default_payment_gateway($method); + + } + + ### + # massage data + ### my $address = exists($options{'address1'}) ? $options{'address1'} @@ -2088,11 +2361,14 @@ sub realtime_bop { ? $conf->config('business-onlinepayment-email-override') : $invoicing_list[0]; - my $payinfo = exists($options{'payinfo'}) - ? $options{'payinfo'} - : $self->payinfo; - my %content = (); + + my $payip = exists($options{'payip'}) + ? $options{'payip'} + : $self->payip; + $content{customer_ip} = $payip + if length($payip); + if ( $method eq 'CC' ) { $content{card_number} = $payinfo; @@ -2102,13 +2378,27 @@ sub realtime_bop { $paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; $content{expiration} = "$2/$1"; - if ( defined $self->dbdef_table->column('paycvv') ) { - my $paycvv = exists($options{'paycvv'}) - ? $options{'paycvv'} - : $self->paycvv; - $content{cvv2} = $self->paycvv - if length($paycvv); - } + my $paycvv = exists($options{'paycvv'}) + ? $options{'paycvv'} + : $self->paycvv; + $content{cvv2} = $self->paycvv + if length($paycvv); + + my $paystart_month = exists($options{'paystart_month'}) + ? $options{'paystart_month'} + : $self->paystart_month; + + my $paystart_year = exists($options{'paystart_year'}) + ? $options{'paystart_year'} + : $self->paystart_year; + + $content{card_start} = "$paystart_month/$paystart_year" + if $paystart_month && $paystart_year; + + my $payissue = exists($options{'payissue'}) + ? $options{'payissue'} + : $self->payissue; + $content{issue_number} = $payissue if $payissue; $content{recurring_billing} = 'YES' if qsearch('cust_pay', { 'custnum' => $self->custnum, @@ -2130,7 +2420,9 @@ sub realtime_bop { $content{phone} = $payinfo; } - #transaction(s) + ### + # run transaction(s) + ### my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); @@ -2199,7 +2491,7 @@ sub realtime_bop { $capture->submit(); unless ( $capture->is_success ) { - my $e = "Authorization sucessful but capture failed, custnum #". + my $e = "Authorization successful but capture failed, custnum #". $self->custnum. ': '. $capture->result_code. ": ". $capture->error_message; warn $e; @@ -2208,7 +2500,10 @@ sub realtime_bop { } - #remove paycvv after initial transaction + ### + # remove paycvv after initial transaction + ### + #false laziness w/misc/process/payment.cgi - check both to make sure working # correctly if ( defined $self->dbdef_table->column('paycvv') @@ -2217,11 +2512,14 @@ sub realtime_bop { ) { my $error = $self->remove_cvv; if ( $error ) { - warn "error removing cvv: $error\n"; + warn "WARNING: error removing cvv: $error\n"; } } - #result handling + ### + # result handling + ### + if ( $transaction->is_success() ) { my %method2payby = ( @@ -2230,7 +2528,13 @@ sub realtime_bop { 'LEC' => 'LECB', ); - my $paybatch = "$processor:". $transaction->authorization; + my $paybatch = ''; + if ( $payment_gateway ) { # agent override + $paybatch = $payment_gateway->gatewaynum. '-'; + } + + $paybatch .= "$processor:". $transaction->authorization; + $paybatch .= ':'. $transaction->order_number if $transaction->can('order_number') && length($transaction->order_number); @@ -2297,6 +2601,31 @@ sub realtime_bop { } +=item default_payment_gateway + +=cut + +sub default_payment_gateway { + my( $self, $method ) = @_; + + die "Real-time processing not enabled\n" + unless $conf->exists('business-onlinepayment'); + + #load up config + my $bop_config = 'business-onlinepayment'; + $bop_config .= '-ach' + if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); + my ( $processor, $login, $password, $action, @bop_options ) = + $conf->config($bop_config); + $action ||= 'normal authorization'; + pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; + die "No real-time processor is enabled - ". + "did you set the business-onlinepayment configuration value?\n" + unless $processor; + + ( $processor, $login, $password, $action, @bop_options ) +} + =item remove_cvv Removes the I field from the database directly. @@ -2342,7 +2671,7 @@ gateway is attempted. #I, I and I are also available. Any of these options, #if set, will override the value from the customer record. -#If an I is specified, this payment (if sucessful) is applied to the +#If an I is specified, this payment (if successful) is applied to the #specified invoice. If you don't specify an I you might want to #call the B method. @@ -2353,43 +2682,98 @@ gateway is attempted. sub realtime_refund_bop { my( $self, $method, %options ) = @_; if ( $DEBUG ) { - warn "$self $method refund\n"; + warn "$me realtime_refund_bop: $method refund\n"; warn " $_ => $options{$_}\n" foreach keys %options; } - #pre-requisites - die "Real-time processing not enabled\n" - unless $conf->exists('business-onlinepayment'); eval "use Business::OnlinePayment"; die $@ if $@; - #load up config - my $bop_config = 'business-onlinepayment'; - $bop_config .= '-ach' - if $method eq 'ECHECK' && $conf->exists($bop_config. '-ach'); - my ( $processor, $login, $password, $unused_action, @bop_options ) = - $conf->config($bop_config); - #$action ||= 'normal authorization'; - pop @bop_options if scalar(@bop_options) % 2 && $bop_options[-1] =~ /^\s*$/; - die "No real-time processor is enabled - ". - "did you set the business-onlinepayment configuration value?\n" - unless $processor; + ### + # look up the original payment and optionally a gateway for that payment + ### my $cust_pay = ''; my $amount = $options{'amount'}; - my( $pay_processor, $auth, $order_number ) = ( '', '', '' ); + + my( $processor, $login, $password, @bop_options ) ; + my( $auth, $order_number ) = ( '', '', '' ); + if ( $options{'paynum'} ) { - warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; + + warn " paynum: $options{paynum}\n" if $DEBUG > 1; $cust_pay = qsearchs('cust_pay', { paynum=>$options{'paynum'} } ) or return "Unknown paynum $options{'paynum'}"; $amount ||= $cust_pay->paid; - $cust_pay->paybatch =~ /^(\w+):([\w-]*)(:(\w+))?$/ + + $cust_pay->paybatch =~ /^((\d+)\-)?(\w+):\s*([\w\-]*)(:([\w\-]+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; - ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 ); - return "processor of payment $options{'paynum'} $pay_processor does not". - " match current processor $processor" - unless $pay_processor eq $processor; + my $gatewaynum = ''; + ( $gatewaynum, $processor, $auth, $order_number ) = ( $2, $3, $4, $6 ); + + if ( $gatewaynum ) { #gateway for the payment to be refunded + + my $payment_gateway = + qsearchs('payment_gateway', { 'gatewaynum' => $gatewaynum } ); + die "payment gateway $gatewaynum not found" + unless $payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + @bop_options = $payment_gateway->options; + + } else { #try the default gateway + + my( $conf_processor, $unused_action ); + ( $conf_processor, $login, $password, $unused_action, @bop_options ) = + $self->default_payment_gateway($method); + + return "processor of payment $options{'paynum'} $processor does not". + " match default processor $conf_processor" + unless $processor eq $conf_processor; + + } + + + } else { # didn't specify a paynum, so look for agent gateway overrides + # like a normal transaction + + my $cardtype; + if ( $method eq 'CC' ) { + $cardtype = cardtype($self->payinfo); + } elsif ( $method eq 'ECHECK' ) { + $cardtype = 'ACH'; + } else { + $cardtype = $method; + } + my $override = + qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => $cardtype, + taxclass => '', } ) + || qsearchs('agent_payment_gateway', { agentnum => $self->agentnum, + cardtype => '', + taxclass => '', } ); + + if ( $override ) { #use a payment gateway override + + my $payment_gateway = $override->payment_gateway; + + $processor = $payment_gateway->gateway_module; + $login = $payment_gateway->gateway_username; + $password = $payment_gateway->gateway_password; + #$action = $payment_gateway->gateway_action; + @bop_options = $payment_gateway->options; + + } else { #use the standard settings from the config + + my $unused_action; + ( $processor, $login, $password, $unused_action, @bop_options ) = + $self->default_payment_gateway($method); + + } + } return "neither amount nor paynum specified" unless $amount; @@ -2407,7 +2791,7 @@ sub realtime_refund_bop { #first try void if applicable if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? - warn "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG; + warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); $void->content( 'action' => 'void', %content ); $void->submit(); @@ -2420,13 +2804,13 @@ sub realtime_refund_bop { warn $e; return $e; } - warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG; + warn " void successful\n" if $DEBUG > 1; return ''; } } - warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n" - if $DEBUG; + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; #massage data my $address = $self->address1; @@ -3160,11 +3544,53 @@ Returns a name string for this customer, either "Company (Last, First)" or sub name { my $self = shift; - my $name = $self->get('last'). ', '. $self->first; + my $name = $self->contact; $name = $self->company. " ($name)" if $self->company; $name; } +=item ship_name + +Returns a name string for this (service/shipping) contact, either +"Company (Last, First)" or "Last, First". + +=cut + +sub ship_name { + my $self = shift; + if ( $self->get('ship_last') ) { + my $name = $self->ship_contact; + $name = $self->ship_company. " ($name)" if $self->ship_company; + $name; + } else { + $self->name; + } +} + +=item contact + +Returns this customer's full (billing) contact name only, "Last, First" + +=cut + +sub contact { + my $self = shift; + $self->get('last'). ', '. $self->first; +} + +=item ship_contact + +Returns this customer's full (shipping) contact name only, "Last, First" + +=cut + +sub ship_contact { + my $self = shift; + $self->get('ship_last') + ? $self->get('ship_last'). ', '. $self->ship_first + : $self->contact; +} + =item status Returns a status string for this customer, currently: @@ -3236,17 +3662,10 @@ Returns an SQL expression identifying active cust_main records. =cut -my $recurring_sql = " - '0' != ( select freq from part_pkg - where cust_pkg.pkgpart = part_pkg.pkgpart ) -"; - sub active_sql { " 0 < ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) + AND ". FS::cust_pkg->active_sql. " ) "; } @@ -3257,6 +3676,12 @@ Returns an SQL expression identifying suspended cust_main records. =cut +#my $recurring_sql = FS::cust_pkg->recurring_sql; +my $recurring_sql = " + '0' != ( select freq from part_pkg + where cust_pkg.pkgpart = part_pkg.pkgpart ) +"; + sub suspended_sql { susp_sql(@_); } sub susp_sql { " 0 < ( SELECT COUNT(*) FROM cust_pkg @@ -3266,9 +3691,7 @@ sub susp_sql { " ) AND 0 = ( SELECT COUNT(*) FROM cust_pkg WHERE cust_pkg.custnum = cust_main.custnum - AND $recurring_sql - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + AND ". FS::cust_pkg->active_sql. " ) "; } @@ -3291,6 +3714,27 @@ sub cancel_sql { " ) "; } +=item uncancel_sql +=item uncancelled_sql + +Returns an SQL expression identifying un-cancelled cust_main records. + +=cut + +sub uncancelled_sql { uncancel_sql(@_); } +sub uncancel_sql { " + ( 0 < ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum + ) + ) +"; } + =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] Performs a fuzzy (approximate) search and returns the matching FS::cust_main @@ -3440,6 +3884,7 @@ sub rebuild_fuzzyfiles { use Fcntl qw(:flock); my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + mkdir $dir, 0700 unless -d $dir; #last @@ -3567,8 +4012,6 @@ sub batch_import { my $pkgpart = $param->{pkgpart}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@; @@ -3674,8 +4117,6 @@ sub batch_charge { my $fh = $param->{filehandle}; my @fields = @{$param->{fields}}; - eval "use Date::Parse;"; - die $@ if $@; eval "use Text::CSV_XS;"; die $@ if $@;