X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=7962f6dfac9410ff3ddfe32c24051bf0387d5f3a;hp=1540b61a39ed94a1d1c3a2085566fb96ce99795b;hb=b19897e1db4c110d7d7e8b52800cda5ab58ce9e0;hpb=0cbeb01df08457b056a7ae775b4924c266b4228b diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1540b61a3..7962f6dfa 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,24 +1,32 @@ package FS::cust_main; use strict; -use vars qw( @ISA $conf $DEBUG $import ); +use vars qw( @ISA @EXPORT_OK $DEBUG $me $conf @encrypted_fields + $import $skip_fuzzyfiles $ignore_expired_card ); use vars qw( $realtime_bop_decline_quiet ); #ugh use Safe; use Carp; +use Exporter; BEGIN { eval "use Time::Local;"; die "Time::Local minimum version 1.05 required with Perl versions before 5.6" if $] < 5.006 && !defined($Time::Local::VERSION); - eval "use Time::Local qw(timelocal timelocal_nocheck);"; + #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 Locale::Country; 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; use FS::cust_bill_pkg; use FS::cust_pay; @@ -37,17 +45,29 @@ 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 ); +@EXPORT_OK = qw( smart_search ); + $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; -#$DEBUG = 1; +$me = '[FS::cust_main]'; $import = 0; +$skip_fuzzyfiles = 0; +$ignore_expired_card = 0; + +@encrypted_fields = ('payinfo', 'paycvv'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { @@ -60,7 +80,7 @@ sub _cache { my $self = shift; my ( $hashref, $cache ) = @_; if ( exists $hashref->{'pkgnum'} ) { -# #@{ $self->{'_pkgnum'} } = (); + #@{ $self->{'_pkgnum'} } = (); my $subcache = $cache->subcache( 'pkgnum', 'cust_pkg', $hashref->{custnum}); $self->{'_pkgnum'} = $subcache; #push @{ $self->{'_pkgnum'} }, @@ -100,8 +120,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 @@ -171,16 +189,94 @@ FS::Record. The following fields are currently supported: =item ship_fax - phone (optional) -=item payby - I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) +=item payby + +I (credit card - automatic), I (credit card - on-demand), I (electronic check - automatic), I (electronic check - on-demand), I (Phone bill billing), I (billing), I (free), or I (special billing type: applies a credit - see L and sets billing type to I) + +=item payinfo + +Card Number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) + +=cut + +sub payinfo { + my($self,$payinfo) = @_; + if ( defined($payinfo) ) { + $self->paymask($payinfo); + $self->setfield('payinfo', $payinfo); # This is okay since we are the 'setter' + } else { + $payinfo = $self->getfield('payinfo'); # This is okay since we are the 'getter' + return $payinfo; + } +} + + +=item paycvv + +Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card + +=cut + +=item paymask - Masked payment type + +=over 4 + +=item Credit Cards + +Mask all but the last four characters. + +=item Checks + +Mask all but last 2 of account number and bank routing number. + +=item Others + +Do nothing, return the unmasked string. -=item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) +=back + +=cut -=item paycvv - Card Verification Value, "CVV2" (also known as CVC2 or CID), the 3 or 4 digit number on the back (or front, for American Express) of the credit card +sub paymask { + my($self,$value)=@_; + + # If it doesn't exist then generate it + my $paymask=$self->getfield('paymask'); + if (!defined($value) && (!defined($paymask) || $paymask eq '')) { + $value = $self->payinfo; + } + + if ( defined($value) && !$self->is_encrypted($value)) { + my $payinfo = $value; + my $payby = $self->payby; + 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) + my( $account, $aba ) = split('@', $payinfo ); + $paymask = 'x'x(length($account)-2). substr($account,(length($account)-2))."@".$aba; + } else { # Tie up loose ends + $paymask = $payinfo; + } + $self->setfield('paymask', $paymask); # This is okay since we are the 'setter' + } elsif (defined($value) && $self->is_encrypted($value)) { + $paymask = 'N/A'; + } + 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 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) @@ -189,6 +285,8 @@ FS::Record. The following fields are currently supported: =item referral_custnum - referring customer number +=item spool_cdr - Enable individual CDR spooling, empty or `Y' + =back =head1 METHODS @@ -239,7 +337,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 @@ -252,7 +350,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; @@ -267,27 +365,38 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - my $seconds = 0; + my $prepay_identifier = ''; + my( $amount, $seconds ) = ( 0, 0 ); + my $payby = ''; if ( $self->payby eq 'PREPAY' ) { + $self->payby('BILL'); - my $prepay_credit = qsearchs( - 'prepay_credit', - { 'identifier' => $self->payinfo }, - '', - 'FOR UPDATE' - ); - warn "WARNING: can't find pre-found prepay_credit: ". $self->payinfo - unless $prepay_credit; - $amount = $prepay_credit->amount; - $seconds = $prepay_credit->seconds; - my $error = $prepay_credit->delete; + $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; - return "removing prepay_credit (transaction rolled back): $error"; + #return "error applying prepaid card (transaction rolled back): $error"; + 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; @@ -295,7 +404,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 ) { @@ -305,7 +416,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; @@ -318,23 +431,28 @@ sub insert { } if ( $amount ) { - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - }; - $error = $cust_credit->insert; + 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 credit (transaction rolled back): $error"; + return "inserting payment (transaction rolled back): $error"; } } - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + unless ( $import || $skip_fuzzyfiles ) { + warn " queueing fuzzyfiles update\n" + if $DEBUG > 1; + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } + warn " insert complete; committing transaction\n" + if $DEBUG > 1; + $dbh->commit or die $dbh->errstr if $oldAutoCommit; ''; @@ -355,12 +473,15 @@ be a better explanation of this, but until then, here's an example: ); $cust_main->order_pkgs( \%hash, \'0', 'noexport'=>1 ); +Services can be new, in which case they are inserted, or existing unaudited +services, in which case they are linked to the newly-created package. + 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 @@ -378,7 +499,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; @@ -403,12 +524,19 @@ sub order_pkgs { return "inserting cust_pkg (transaction rolled back): $error"; } foreach my $svc_something ( @{$cust_pkgs->{$cust_pkg}} ) { - $svc_something->pkgnum( $cust_pkg->pkgnum ); - if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { - $svc_something->seconds( $svc_something->seconds + $$seconds ); - $$seconds = 0; + if ( $svc_something->svcnum ) { + my $old_cust_svc = $svc_something->cust_svc; + my $new_cust_svc = new FS::cust_svc { $old_cust_svc->hash }; + $new_cust_svc->pkgnum( $cust_pkg->pkgnum); + $error = $new_cust_svc->replace($old_cust_svc); + } else { + $svc_something->pkgnum( $cust_pkg->pkgnum ); + if ( $seconds && $$seconds && $svc_something->isa('FS::svc_acct') ) { + $svc_something->seconds( $svc_something->seconds + $$seconds ); + $$seconds = 0; + } + $error = $svc_something->insert(%svc_options); } - $error = $svc_something->insert(%svc_options); if ( $error ) { $dbh->rollback if $oldAutoCommit; #return "inserting svc_ (transaction rolled back): $error"; @@ -421,6 +549,223 @@ sub order_pkgs { ''; #no error } +=item recharge_prepay IDENTIFIER | PREPAY_CREDIT_OBJ [ , AMOUNTREF, SECONDSREF ] + +Recharges this (existing) customer with the specified prepaid card (see +L), specified either by I or as an +FS::prepay_credit object. If there is an error, returns the error, otherwise +returns false. + +Optionally, two scalar references can be passed as well. They will have their +values filled in with the amount and number of seconds applied by this prepaid +card. + +=cut + +sub recharge_prepay { + my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + + 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( $amount, $seconds ) = ( 0, 0 ); + + my $error = $self->get_prepay($prepay_credit, \$amount, \$seconds) + || $self->increment_seconds($seconds) + || $self->insert_cust_pay_prepay( $amount, + ref($prepay_credit) + ? $prepay_credit->identifier + : $prepay_credit + ); + + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return $error; + } + + if ( defined($amountref) ) { $$amountref = $amount; } + if ( defined($secondsref) ) { $$secondsref = $seconds; } + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item get_prepay IDENTIFIER | PREPAY_CREDIT_OBJ , AMOUNTREF, SECONDSREF + +Looks up and deletes a prepaid card (see L), +specified either by I or as an FS::prepay_credit object. + +References to I and I scalars should be passed as arguments +and will be incremented by the values of the prepaid card. + +If the prepaid card specifies an I (see L), it is used to +check or set this customer's I. + +If there is an error, returns the error, otherwise returns false. + +=cut + + +sub get_prepay { + my( $self, $prepay_credit, $amountref, $secondsref ) = @_; + + 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; + + unless ( ref($prepay_credit) ) { + + my $identifier = $prepay_credit; + + $prepay_credit = qsearchs( + 'prepay_credit', + { 'identifier' => $prepay_credit }, + '', + 'FOR UPDATE' + ); + + unless ( $prepay_credit ) { + $dbh->rollback if $oldAutoCommit; + return "Invalid prepaid card: ". $identifier; + } + + } + + if ( $prepay_credit->agentnum ) { + if ( $self->agentnum && $self->agentnum != $prepay_credit->agentnum ) { + $dbh->rollback if $oldAutoCommit; + return "prepaid card not valid for agent ". $self->agentnum; + } + $self->agentnum($prepay_credit->agentnum); + } + + my $error = $prepay_credit->delete; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "removing prepay_credit (transaction rolled back): $error"; + } + + $$amountref += $prepay_credit->amount; + $$secondsref += $prepay_credit->seconds; + + $dbh->commit or die $dbh->errstr if $oldAutoCommit; + ''; + +} + +=item increment_seconds SECONDS + +Updates this customer's single or primary account (see L) by +the specified number of seconds. If there is an error, returns the error, +otherwise returns false. + +=cut + +sub increment_seconds { + my( $self, $seconds ) = @_; + warn "$me increment_seconds called: $seconds seconds\n" + if $DEBUG; + + my @cust_pkg = grep { $_->part_pkg->svcpart('svc_acct') } + $self->ncancelled_pkgs; + + if ( ! @cust_pkg ) { + return 'No packages with primary or single services found'. + ' to apply pre-paid time'; + } elsif ( scalar(@cust_pkg) > 1 ) { + #maybe have a way to specify the package/account? + return 'Multiple packages found to apply pre-paid time'; + } + + my $cust_pkg = $cust_pkg[0]; + warn " found package pkgnum ". $cust_pkg->pkgnum. "\n" + if $DEBUG > 1; + + my @cust_svc = + $cust_pkg->cust_svc( $cust_pkg->part_pkg->svcpart('svc_acct') ); + + if ( ! @cust_svc ) { + return 'No account found to apply pre-paid time'; + } elsif ( scalar(@cust_svc) > 1 ) { + return 'Multiple accounts found to apply pre-paid time'; + } + + my $svc_acct = $cust_svc[0]->svc_x; + warn " found service svcnum ". $svc_acct->pkgnum. + ' ('. $svc_acct->email. ")\n" + if $DEBUG > 1; + + $svc_acct->increment_seconds($seconds); + +} + +=item insert_cust_pay_prepay AMOUNT [ PAYINFO ] + +Inserts a prepayment 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_prepay { + 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' => sprintf('%.2f', $amount), + #'_date' => #date the prepaid card was purchased??? + 'payby' => $payby, + 'payinfo' => $payinfo, + }; + $cust_pay->insert; + +} + =item reexport This method is deprecated. See the I option to the insert and @@ -435,7 +780,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'; @@ -579,6 +924,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'; @@ -587,12 +934,30 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; - if ( $self->payby eq 'COMP' && $self->payby ne $old->payby - && $conf->config('users-allow_comp') ) { - return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); + # If the mask is blank then try to set it - if we can... + if (!defined($self->getfield('paymask')) || $self->getfield('paymask') eq '') { + $self->paymask($self->payinfo); + } + + # We absolutely have to have an old vs. new record to make this work. + if (!defined($old)) { + $old = qsearchs( 'cust_main', { 'custnum' => $self->custnum } ); } + my $curuser = $FS::CurrentUser::CurrentUser; + if ( $self->payby eq 'COMP' + && $self->payby ne $old->payby + && ! $curuser->access_right('Complimentary customer') + ) + { + return "You are not permitted to create complimentary accounts."; + } + + 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; @@ -624,10 +989,12 @@ sub replace { } } - $error = $self->queue_fuzzyfiles_update; - if ( $error ) { - $dbh->rollback if $oldAutoCommit; - return "updating fuzzy search cache: $error"; + unless ( $import || $skip_fuzzyfiles ) { + $error = $self->queue_fuzzyfiles_update; + if ( $error ) { + $dbh->rollback if $oldAutoCommit; + return "updating fuzzy search cache: $error"; + } } $dbh->commit or die $dbh->errstr if $oldAutoCommit; @@ -680,18 +1047,20 @@ sub queue_fuzzyfiles_update { Checks all fields to make sure this is a valid customer record. If there is an error, returns the error, otherwise returns false. Called by the insert -and repalce methods. +and replace methods. =cut 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') || $self->ut_number('agentnum') + || $self->ut_textn('agent_custid') || $self->ut_number('refnum') || $self->ut_name('last') || $self->ut_name('first') @@ -716,7 +1085,7 @@ sub check { return "Unknown refnum" unless qsearchs( 'part_referral', { 'refnum' => $self->refnum } ); - return "Unknown referring custnum ". $self->referral_custnum + return "Unknown referring custnum: ". $self->referral_custnum unless ! $self->referral_custnum || qsearchs( 'cust_main', { 'custnum' => $self->referral_custnum } ); @@ -786,7 +1155,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, @@ -809,11 +1178,34 @@ 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. + + my $check_payinfo = 1; + + if ($self->is_encrypted($self->payinfo)) { + $check_payinfo = 0; + } + $self->payby($1); - if ( $self->payby eq 'CARD' || $self->payby eq 'DCRD' ) { + if ( $check_payinfo && $self->payby =~ /^(CARD|DCRD)$/ ) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -823,10 +1215,20 @@ 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); + if ( $ban ) { + return 'Banned credit card: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + if ( defined $self->dbdef_table->column('paycvv') ) { - if ( length($self->paycvv) ) { + if (length($self->paycvv) && !$self->is_encrypted($self->paycvv)) { if ( cardtype($self->payinfo) eq 'American Express card' ) { $self->paycvv =~ /^(\d{4})$/ or return "CVV2 (CID) for American Express cards is four digits."; @@ -841,15 +1243,52 @@ sub check { } } - } elsif ( $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); + if ( $ban ) { + return 'Banned ACH account: banned on '. + time2str('%a %h %o at %r', $ban->_date). + ' by '. $ban->otaker. + ' (ban# '. $ban->bannum. ')'; + } + } elsif ( $self->payby eq 'LECB' ) { my $payinfo = $self->payinfo; @@ -867,9 +1306,12 @@ sub check { } elsif ( $self->payby eq 'COMP' ) { - if ( !$self->custnum && $conf->config('users-allow_comp') ) { + my $curuser = $FS::CurrentUser::CurrentUser; + if ( ! $self->custnum + && ! $curuser->access_right('Complimentary customer') + ) + { return "You are not permitted to create complimentary accounts." - unless grep { $_ eq getotaker } $conf->config('users-allow_comp'); } $error = $self->ut_textn('payinfo'); @@ -890,8 +1332,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 ); @@ -905,7 +1347,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)$/ && @@ -914,17 +1358,20 @@ sub check { ) { $self->payname( $self->first. " ". $self->getfield('last') ); } else { - $self->payname =~ /^([\w \,\.\-\']+)$/ + $self->payname =~ /^([\w \,\.\-\'\&]+)$/ or return gettext('illegal_name'). " payname: ". $self->payname; $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; } @@ -1005,6 +1452,27 @@ sub unsuspended_pkgs { grep { ! $_->susp } $self->ncancelled_pkgs; } +=item num_cancelled_pkgs + +Returns the number of cancelled packages (see L) for this +customer. + +=cut + +sub num_cancelled_pkgs { + my $self = shift; + $self->num_pkgs("cancel IS NOT NULL AND cust_pkg.cancel != 0"); +} + +sub num_pkgs { + my( $self, $sql ) = @_; + my $sth = dbh->prepare( + "SELECT COUNT(*) FROM cust_pkg WHERE custnum = ? AND $sql" + ) or die dbh->errstr; + $sth->execute($self->custnum) or die $sth->errstr; + $sth->fetchrow_arrayref->[0]; +} + =item unsuspend Unsuspends all unflagged suspended packages (see L @@ -1021,7 +1489,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 @@ -1033,8 +1502,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 @@ -1049,8 +1519,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 @@ -1066,19 +1537,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. @@ -1116,6 +1624,10 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + return '' if $self->payby eq 'COMP'; + warn "$me bill customer ". $self->custnum. "\n" + if $DEBUG; + my $time = $options{'time'} || time; my $error; @@ -1134,17 +1646,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 } ) @@ -1153,74 +1678,62 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG > 1; + #? to avoid use of uninitialized value errors... ? $cust_pkg->setfield('bill', '') unless defined($cust_pkg->bill); my $part_pkg = $cust_pkg->part_pkg; - #so we don't modify cust_pkg record unnecessarily - my $cust_pkg_mod_flag = 0; my %hash = $cust_pkg->hash; my $old_cust_pkg = new FS::cust_pkg \%hash; my @details = (); + ### # bill setup + ### + my $setup = 0; if ( !$cust_pkg->setup || $options{'resetup'} ) { - 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; - $setup_prog = '0' if $setup_prog =~ /^\s*$/; - - #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); - $setup = eval $setup_prog; - unless ( defined($setup) ) { + + warn " bill setup\n" if $DEBUG > 1; + + $setup = eval { $cust_pkg->calc_setup( $time ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->setup pkgpart ". $part_pkg->pkgpart. - "(expression $setup_prog): $@"; + return "$@ running calc_setup for $cust_pkg\n"; } + $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - $cust_pkg_mod_flag=1; } - #bill recurring fee + ### + # bill recurring fee + ### + my $recur = 0; my $sdate; if ( $part_pkg->getfield('freq') ne '0' && ! $cust_pkg->getfield('susp') && ( $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; - $recur_prog = '0' if $recur_prog =~ /^\s*$/; - # shared with $recur_prog + warn " bill recur\n" if $DEBUG > 1; + + # XXX shared with $recur_prog $sdate = $cust_pkg->bill || $cust_pkg->setup || $time; - #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); - $recur = eval $recur_prog; - unless ( defined($recur) ) { + #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 "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. - "(expression $recur_prog): $@"; + return "$@ running calc_recur for $cust_pkg\n"; } + #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) my ($sec,$min,$hour,$mday,$mon,$year) = @@ -1242,25 +1755,36 @@ 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; } $cust_pkg->setfield('bill', timelocal_nocheck($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); - if ( $cust_pkg_mod_flag ) { + ### + # 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 >1; + $error=$cust_pkg->replace($old_cust_pkg); if ( $error ) { #just in case $dbh->rollback if $oldAutoCommit; return "Error modifying pkgnum ". $cust_pkg->pkgnum. ": $error"; } + $setup = sprintf( "%.2f", $setup ); $recur = sprintf( "%.2f", $recur ); if ( $setup < 0 && ! $conf->exists('allow_negative_charges') ) { @@ -1271,8 +1795,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); 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, @@ -1280,35 +1809,40 @@ 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', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => $part_pkg->taxclass, - } ); + my $prefix = + ( $conf->exists('tax-ship_address') && length($self->ship_last) ) + ? 'ship_' + : ''; + my %taxhash = map { $_ => $self->get("$prefix$_") } + qw( state county country ); + + $taxhash{'taxclass'} = $part_pkg->taxclass; + + my @taxes = qsearch( 'cust_main_county', \%taxhash ); + unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => $self->state, - 'county' => $self->county, - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{'taxclass'} = ''; + @taxes = qsearch( 'cust_main_county', \%taxhash ); } #one more try at a whole-country tax rate unless ( @taxes ) { - @taxes = qsearch( 'cust_main_county', { - 'state' => '', - 'county' => '', - 'country' => $self->country, - 'taxclass' => '', - } ); + $taxhash{$_} = '' foreach qw( state county ); + @taxes = qsearch( 'cust_main_county', \%taxhash ); } # maybe eliminate this entirely, along with all the 0% records @@ -1316,8 +1850,10 @@ sub bill { $dbh->rollback if $oldAutoCommit; return "fatal: can't find tax rate for state/county/country/taxclass ". - join('/', ( map $self->$_(), qw(state county country) ), - $part_pkg->taxclass ). "\n"; + join('/', ( map $self->get("$prefix$_"), + qw(state county country) + ), + $part_pkg->taxclass ). "\n"; } foreach my $tax ( @taxes ) { @@ -1331,8 +1867,9 @@ sub bill { || $tax->recurtax =~ /^Y$/i; next unless $taxable_charged; - if ( $tax->exempt_amount > 0 ) { - my ($mon,$year) = (localtime($sdate) )[4,5]; + if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { + #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+)$/ ) { @@ -1340,40 +1877,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 @@ -1391,89 +1962,54 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #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"; } } @@ -1506,16 +2042,12 @@ 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. +quiet - set true to surpress email card/ACH decline notices. -report_badcard - This option is deprecated. +freq - "1d" for the traditional, daily events (the default), or "1m" for the +new monthly events -force_print - This option is deprecated; see the invoice events web interface. - -quiet - set true to surpress email card/ACH decline notices. +payby - allows for one time override of normal customer billing method =cut @@ -1538,7 +2070,8 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; + warn "$me collect customer ". $self->custnum. ": balance $balance\n" + if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1556,6 +2089,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 @@ -1563,8 +2103,8 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" - 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 @@ -1577,20 +2117,28 @@ sub collect { 'status' => 'done', } ) } - qsearch('part_bill_event', { 'payby' => $self->payby, - 'disabled' => '', } ) + qsearch( { + 'table' => 'part_bill_event', + 'hashref' => { 'payby' => (exists($options{'payby'}) + ? $options{'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; { local $realtime_bop_decline_quiet = 1 if $options{'quiet'}; + local $SIG{__DIE__}; # don't want Mason __DIE__ handler active $error = eval $part_bill_event->eventcode; } @@ -1711,7 +2259,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. @@ -1724,31 +2272,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'} @@ -1777,13 +2378,19 @@ sub realtime_bop { || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { push @invoicing_list, $self->all_emails; } - my $email = $invoicing_list[0]; - my $payinfo = exists($options{'payinfo'}) - ? $options{'payinfo'} - : $self->payinfo; + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; 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; @@ -1793,13 +2400,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, @@ -1821,7 +2442,9 @@ sub realtime_bop { $content{phone} = $payinfo; } - #transaction(s) + ### + # run transaction(s) + ### my( $action1, $action2 ) = split(/\s*\,\s*/, $action ); @@ -1890,7 +2513,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; @@ -1899,7 +2522,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') @@ -1908,11 +2534,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 = ( @@ -1921,7 +2550,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); @@ -1978,14 +2613,39 @@ sub realtime_bop { 'body' => [ $template->fill_in(HASH => $templ_hash) ], ); - $perror .= " (also received error sending decline notification: $error)" - if $error; + $perror .= " (also received error sending decline notification: $error)" + if $error; + + } + + return $perror; + } + +} + +=item default_payment_gateway + +=cut + +sub default_payment_gateway { + my( $self, $method ) = @_; - } - - return $perror; - } + 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 @@ -2033,7 +2693,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. @@ -2044,59 +2704,118 @@ 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; + my %content = ( + 'type' => $method, + 'login' => $login, + 'password' => $password, + 'order_number' => $order_number, + 'amount' => $amount, + 'referer' => 'http://cleanwhisker.420.am/', + ); + $content{authorization} = $auth + if length($auth); #echeck/ACH transactions have an order # but no auth + #(at least with authorize.net) + #first try void if applicable if ( $cust_pay && $cust_pay->paid == $amount ) { #and check dates? + warn " attempting void\n" if $DEBUG > 1; my $void = new Business::OnlinePayment( $processor, @bop_options ); - $void->content( - 'type' => $method, - 'action' => 'void', - 'login' => $login, - 'password' => $password, - 'order_number' => $order_number, - 'amount' => $amount, - 'authorization' => $auth, - 'referer' => 'http://cleanwhisker.420.am/', - ); + $void->content( 'action' => 'void', %content ); $void->submit(); if ( $void->is_success ) { my $error = $cust_pay->void($options{'reason'}); @@ -2107,10 +2826,14 @@ sub realtime_refund_bop { warn $e; return $e; } + warn " void successful\n" if $DEBUG > 1; return ''; } } + warn " void unsuccessful, trying refund\n" + if $DEBUG > 1; + #massage data my $address = $self->address1; $address .= ", ". $self->address2 if $self->address2; @@ -2127,44 +2850,35 @@ sub realtime_refund_bop { $payname = "$payfirst $paylast"; } - my %content = (); - if ( $method eq 'CC' ) { - - $content{card_number} = $self->payinfo; - $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; - $content{expiration} = "$2/$1"; - - #$content{cvv2} = $self->paycvv - # if defined $self->dbdef_table->column('paycvv') - # && length($self->paycvv); + my $payinfo = ''; + if ( $method eq 'CC' ) { - #$content{recurring_billing} = 'YES' - # if qsearch('cust_pay', { 'custnum' => $self->custnum, - # 'payby' => 'CARD', - # 'payinfo' => $self->payinfo, } ); + if ( $cust_pay ) { + $content{card_number} = $payinfo = $cust_pay->payinfo; + #$self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + #$content{expiration} = "$2/$1"; + } else { + $content{card_number} = $payinfo = $self->payinfo; + $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/; + $content{expiration} = "$2/$1"; + } } elsif ( $method eq 'ECHECK' ) { ( $content{account_number}, $content{routing_code} ) = - split('@', $self->payinfo); + split('@', $payinfo = $self->payinfo); $content{bank_name} = $self->payname; $content{account_type} = 'CHECKING'; $content{account_name} = $payname; $content{customer_org} = $self->company ? 'B' : 'I'; $content{customer_ssn} = $self->ss; } elsif ( $method eq 'LEC' ) { - $content{phone} = $self->payinfo; + $content{phone} = $payinfo = $self->payinfo; } #then try refund my $refund = new Business::OnlinePayment( $processor, @bop_options ); - $refund->content( - 'type' => $method, + my %sub_content = $refund->content( 'action' => 'credit', - 'login' => $login, - 'password' => $password, - 'order_number' => $order_number, - 'amount' => $amount, - 'authorization' => $auth, 'customer_id' => $self->custnum, 'last_name' => $paylast, 'first_name' => $payfirst, @@ -2174,9 +2888,10 @@ sub realtime_refund_bop { 'state' => $self->state, 'zip' => $self->zip, 'country' => $self->country, - 'referer' => 'http://cleanwhisker.420.am/', %content, #after ); + warn join('', map { " $_ => $sub_content{$_}\n" } keys %sub_content ) + if $DEBUG > 1; $refund->submit(); return "$processor error: ". $refund->error_message @@ -2206,9 +2921,9 @@ sub realtime_refund_bop { 'refund' => $amount, '_date' => '', 'payby' => $method2payby{$method}, - 'payinfo' => $self->payinfo, + 'payinfo' => $payinfo, 'paybatch' => $paybatch, - 'reason' => $options{'reason'} || 'card refund', + 'reason' => $options{'reason'} || 'card or ACH refund', } ); my $error = $cust_refund->insert; if ( $error ) { @@ -2434,6 +3149,29 @@ sub balance_date { ); } +=item in_transit_payments + +Returns the total of requests for payments for this customer pending in +batches in transit to the bank. See L and L + +=cut + +sub in_transit_payments { + my $self = shift; + my $in_transit_payments = 0; + foreach my $pay_batch ( qsearch('pay_batch', { + 'status' => 'I', + } ) ) { + foreach my $cust_pay_batch ( qsearch('cust_pay_batch', { + 'batchnum' => $pay_batch->batchnum, + 'custnum' => $self->custnum, + } ) ) { + $in_transit_payments += $cust_pay_batch->amount; + } + } + sprintf( "%.2f", $in_transit_payments ); +} + =item paydate_monthyear Returns a two-element list consisting of the month and year of this customer's @@ -2454,15 +3192,17 @@ sub paydate_monthyear { =item payinfo_masked -Returns a "masked" payinfo field with all but the last four characters replaced -by 'x'es. Useful for displaying credit cards. +Returns a "masked" payinfo field appropriate to the payment type. Masked characters are replaced by 'x'es. Use this to display publicly accessable account Information. + +Credit Cards - Mask all but the last four characters. +Checks - Mask all but last 2 of account number and bank routing number. +Others - Do nothing, return the unmasked string. =cut sub payinfo_masked { my $self = shift; - my $payinfo = $self->payinfo; - 'x'x(length($payinfo)-4). substr($payinfo,(length($payinfo)-4)); + return $self->paymask; } =item invoicing_list [ ARRAYREF ] @@ -2482,6 +3222,7 @@ This interface may change in the future. sub invoicing_list { my( $self, $arrayref ) = @_; + if ( $arrayref ) { my @cust_main_invoice; if ( $self->custnum ) { @@ -2516,12 +3257,14 @@ sub invoicing_list { warn $error if $error; } } + if ( $self->custnum ) { map { $_->address } qsearch( 'cust_main_invoice', { 'custnum' => $self->custnum } ); } else { (); } + } =item check_invoicing_list ARRAYREF @@ -2534,6 +3277,11 @@ is an error, returns the error, otherwise returns false. sub check_invoicing_list { my( $self, $arrayref ) = @_; foreach my $address ( @{$arrayref} ) { + + if ($address eq 'FAX' and $self->getfield('fax') eq '') { + return 'Can\'t add FAX invoice destination with a blank FAX number.'; + } + my $cust_main_invoice = new FS::cust_main_invoice ( { 'custnum' => $self->custnum, 'dest' => $address, @@ -2594,6 +3342,18 @@ sub invoicing_list_addpost { $self->invoicing_list(\@invoicing_list); } +=item invoicing_list_emailonly + +Returns the list of email invoice recipients (invoicing_list without non-email +destinations such as POST and FAX). + +=cut + +sub invoicing_list_emailonly { + my $self = shift; + grep { $_ !~ /^([A-Z]+)$/ } $self->invoicing_list; +} + =item referral_cust_main [ DEPTH [ EXCLUDE_HASHREF ] ] Returns an array of customers referred by this customer (referral_custnum set @@ -2651,6 +3411,19 @@ sub referral_cust_pkg { $self->referral_cust_main($depth); } +=item referring_cust_main + +Returns the single cust_main record for the customer who referred this customer +(referral_custnum), or false. + +=cut + +sub referring_cust_main { + my $self = shift; + return '' unless $self->referral_custnum; + qsearchs('cust_main', { 'custnum' => $self->referral_custnum } ); +} + =item credit AMOUNT, REASON Applies a credit to this customer. If there is an error, returns the error, @@ -2695,9 +3468,11 @@ sub charge { my $part_pkg = new FS::part_pkg ( { 'pkg' => $pkg, 'comment' => $comment, - 'setup' => $amount, + #'setup' => $amount, + #'recur' => '0', + 'plan' => 'flat', + 'plandata' => "setup_fee=$amount", 'freq' => 0, - 'recur' => '0', 'disabled' => 'Y', 'taxclass' => $taxclass, } ); @@ -2829,11 +3604,64 @@ 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 country_full + +Returns this customer's full country name + +=cut + +sub country_full { + my $self = shift; + code2country($self->country); +} + =item status Returns a status string for this customer, currently: @@ -2844,6 +3672,8 @@ Returns a status string for this customer, currently: =item active - One or more recurring packages is active +=item inactive - No active recurring packages, but otherwise unsuspended/uncancelled (the inactive status is new - previously inactive customers were mis-identified as cancelled) + =item suspended - All non-cancelled recurring packages are suspended =item cancelled - All recurring packages are cancelled @@ -2854,7 +3684,7 @@ Returns a status string for this customer, currently: sub status { my $self = shift; - for my $status (qw( prospect active suspended cancelled )) { + for my $status (qw( prospect active inactive suspended cancelled )) { my $method = $status.'_sql'; my $numnum = ( my $sql = $self->$method() ) =~ s/cust_main\.custnum/?/g; my $sth = dbh->prepare("SELECT $sql") or die dbh->errstr; @@ -2869,12 +3699,15 @@ Returns a hex triplet color string for this customer's status. =cut -my %statuscolor = ( - 'prospect' => '000000', - 'active' => '00CC00', - 'suspended' => 'FF9900', - 'cancelled' => 'FF0000', +use vars qw(%statuscolor); +%statuscolor = ( + 'prospect' => '7e0079', #'000000', #black? naw, purple + 'active' => '00CC00', #green + 'inactive' => '0000CC', #blue + 'suspended' => 'FF9900', #yellow + 'cancelled' => 'FF0000', #red ); + sub statuscolor { my $self = shift; $statuscolor{$self->status}; @@ -2893,26 +3726,44 @@ with no packages ever ordered) =cut +use vars qw($select_count_pkgs); +$select_count_pkgs = + "SELECT COUNT(*) FROM cust_pkg + WHERE cust_pkg.custnum = cust_main.custnum"; + +sub select_count_pkgs_sql { + $select_count_pkgs; +} + sub prospect_sql { " - 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) + 0 = ( $select_count_pkgs ) "; } =item active_sql -Returns an SQL expression identifying active cust_main records. +Returns an SQL expression identifying active cust_main records (customers with +no active recurring packages, but otherwise unsuspended/uncancelled). =cut sub active_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 ) - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } +=item inactive_sql + +Returns an SQL expression identifying inactive cust_main records (customers with +active recurring packages). + +=cut + +sub inactive_sql { " + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) + AND + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->inactive_sql. " ) +"; } + =item susp_sql =item suspended_sql @@ -2920,16 +3771,12 @@ Returns an SQL expression identifying suspended cust_main records. =cut + sub suspended_sql { susp_sql(@_); } sub susp_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 ) - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.susp IS NULL OR cust_pkg.susp = 0 ) - ) + 0 < ( $select_count_pkgs AND ". FS::cust_pkg->suspended_sql. " ) + AND + 0 = ( $select_count_pkgs AND ". FS::cust_pkg->active_sql. " ) "; } =item cancel_sql @@ -2940,21 +3787,45 @@ Returns an SQL expression identifying cancelled cust_main records. =cut sub cancelled_sql { cancel_sql(@_); } -sub cancel_sql { " - 0 < ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - ) - AND 0 = ( SELECT COUNT(*) FROM cust_pkg - WHERE cust_pkg.custnum = cust_main.custnum - AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) - ) +sub cancel_sql { + + my $recurring_sql = FS::cust_pkg->recurring_sql; + #my $recurring_sql = " + # '0' != ( select freq from part_pkg + # where cust_pkg.pkgpart = part_pkg.pkgpart ) + #"; + + " + 0 < ( $select_count_pkgs ) + AND 0 = ( $select_count_pkgs AND $recurring_sql + AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 ) + ) + "; +} + +=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_pkgs + AND ( cust_pkg.cancel IS NULL + OR cust_pkg.cancel = 0 + ) + ) + OR 0 = ( $select_count_pkgs ) + ) "; } =item fuzzy_search FUZZY_HASHREF [ HASHREF, SELECT, EXTRA_SQL, CACHE_OBJ ] Performs a fuzzy (approximate) search and returns the matching FS::cust_main -records. Currently, only I or I may be specified (the -appropriate ship_ field is also searched if applicable). +records. Currently, I, I and/or I may be specified (the +appropriate ship_ field is also searched). Additional options are the same as FS::Record::qsearch @@ -2968,19 +3839,25 @@ sub fuzzy_search { check_and_rebuild_fuzzyfiles(); foreach my $field ( keys %$fuzzy ) { - my $sub = \&{"all_$field"}; my %match = (); - $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) ); + $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, + ['i'], + @{ $self->all_X($field) } + ) + ); + my @fcust = (); foreach ( keys %match ) { - push @cust_main, qsearch('cust_main', { %$hash, $field=>$_}, @opt); - push @cust_main, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt) - if defined dbdef->table('cust_main')->column('ship_last'); + push @fcust, qsearch('cust_main', { %$hash, $field=>$_}, @opt); + push @fcust, qsearch('cust_main', { %$hash, "ship_$field"=>$_}, @opt); } + my %fsaw = (); + push @cust_main, grep { ! $fsaw{$_->custnum}++ } @fcust; } + # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes my %saw = (); - @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; + @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main; @cust_main; @@ -2992,91 +3869,292 @@ sub fuzzy_search { =over 4 -=item check_and_rebuild_fuzzyfiles +=item smart_search OPTION => VALUE ... -=cut +Accepts the following options: I, the string to search for. The string +will be searched for as a customer number, phone number, name or company name, +first searching for an exact match then fuzzy and substring matches (in some +cases - see the source code for the exact heuristics used). -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; -} +Any additional options treated as an additional qualifier on the search +(i.e. I). -=item rebuild_fuzzyfiles +Returns a (possibly empty) array of FS::cust_main objects. =cut -sub rebuild_fuzzyfiles { +sub smart_search { + my %options = @_; - use Fcntl qw(:flock); + #here is the agent virtualization + my $agentnums_sql = $FS::CurrentUser::CurrentUser->agentnums_sql; - my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + my @cust_main = (); + + my $search = delete $options{'search'}; + ( my $alphanum_search = $search ) =~ s/\W//g; + + if ( $alphanum_search =~ /^1?(\d{3})(\d{3})(\d{4})(\d*)$/ ) { #phone# search + + #false laziness w/Record::ut_phone + my $phonen = "$1-$2-$3"; + $phonen .= " x$4" if $4; + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { %options }, + 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). + ' ( '. + join(' OR ', map "$_ = '$phonen'", + qw( daytime night fax + ship_daytime ship_night ship_fax ) + ). + ' ) '. + " AND $agentnums_sql", #agent virtualization + } ); + + unless ( @cust_main || $phonen =~ /x\d+$/ ) { #no exact match + #try looking for matches with extensions unless one was specified + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { %options }, + 'extra_sql' => ( scalar(keys %options) ? ' AND ' : ' WHERE ' ). + ' ( '. + join(' OR ', map "$_ LIKE '$phonen\%'", + qw( daytime night + ship_daytime ship_night ) + ). + ' ) '. + " AND $agentnums_sql", #agent virtualization + } ); + + } + + } elsif ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { 'custnum' => $1, %options }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualization + } ); + + } elsif ( $search =~ /^\s*(\S.*\S)\s+\((.+), ([^,]+)\)\s*$/ ) { + + my($company, $last, $first) = ( $1, $2, $3 ); + + # "Company (Last, First)" + #this is probably something a browser remembered, + #so just do an exact search + + foreach my $prefix ( '', 'ship_' ) { + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { $prefix.'first' => $first, + $prefix.'last' => $last, + $prefix.'company' => $company, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", + } ); + } + + } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { # value search + # try (ship_){last,company} - #last + my $value = lc($1); - 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: $!"; + # # remove "(Last, First)" in "Company (Last, First)", otherwise the + # # full strings the browser remembers won't work + # $value =~ s/\([\w \,\.\-\']*\)$//; #false laziness w/Record::ut_name - 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'); + use Lingua::EN::NameParse; + my $NameParse = new Lingua::EN::NameParse( + auto_clean => 1, + allow_reversed => 1, + ); + + my($last, $first) = ( '', '' ); + #maybe disable this too and just rely on NameParse? + if ( $value =~ /^(.+),\s*([^,]+)$/ ) { # Last, First + + ($last, $first) = ( $1, $2 ); + + #} elsif ( $value =~ /^(.+)\s+(.+)$/ ) { + } elsif ( ! $NameParse->parse($value) ) { + + my %name = $NameParse->components; + $first = $name{'given_name_1'}; + $last = $name{'surname_1'}; + + } + + if ( $first && $last ) { + + my($q_last, $q_first) = ( dbh->quote($last), dbh->quote($first) ); + + #exact + my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; + $sql .= " + ( ( LOWER(last) = $q_last AND LOWER(first) = $q_first ) + OR ( LOWER(ship_last) = $q_last AND LOWER(ship_first) = $q_first ) + )"; + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => \%options, + 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization + } ); + + # or it just be something that was typed in... (try that in a sec) + + } + + my $q_value = dbh->quote($value); + + #exact + my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; + $sql .= " ( LOWER(last) = $q_value + OR LOWER(company) = $q_value + OR LOWER(ship_last) = $q_value + OR LOWER(ship_company) = $q_value + )"; + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => \%options, + 'extra_sql' => "$sql AND $agentnums_sql", #agent virtualization + } ); + + unless ( @cust_main ) { #no exact match, trying substring/fuzzy + + #still some false laziness w/ search/cust_main.cgi + + #substring + + my @hashrefs = ( + { 'company' => { op=>'ILIKE', value=>"%$value%" }, }, + { 'ship_company' => { op=>'ILIKE', value=>"%$value%" }, }, + ); + + if ( $first && $last ) { + + push @hashrefs, + { 'first' => { op=>'ILIKE', value=>"%$first%" }, + 'last' => { op=>'ILIKE', value=>"%$last%" }, + }, + { 'ship_first' => { op=>'ILIKE', value=>"%$first%" }, + 'ship_last' => { op=>'ILIKE', value=>"%$last%" }, + }, + ; + + } else { + + push @hashrefs, + { 'last' => { op=>'ILIKE', value=>"%$value%" }, }, + { 'ship_last' => { op=>'ILIKE', value=>"%$value%" }, }, + ; + } + + foreach my $hashref ( @hashrefs ) { + + push @cust_main, qsearch( { + 'table' => 'cust_main', + 'hashref' => { %$hashref, + %options, + }, + 'extra_sql' => " AND $agentnums_sql", #agent virtualizaiton + } ); - 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; + #fuzzy + my @fuzopts = ( + \%options, #hashref + '', #select + " AND $agentnums_sql", #extra_sql #agent virtualization + ); - #company + if ( $first && $last ) { + push @cust_main, FS::cust_main->fuzzy_search( + { 'last' => $last, #fuzzy hashref + 'first' => $first }, # + @fuzopts + ); + } + foreach my $field ( 'last', 'company' ) { + push @cust_main, + FS::cust_main->fuzzy_search( { $field => $value }, @fuzopts ); + } - 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'); + #eliminate duplicates + my %saw = (); + @cust_main = grep { !$saw{$_->custnum}++ } @cust_main; - 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; + @cust_main; } -=item all_last +=item check_and_rebuild_fuzzyfiles =cut -sub all_last { +use vars qw(@fuzzyfields); +@fuzzyfields = ( 'last', 'first', 'company' ); + +sub check_and_rebuild_fuzzyfiles { 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; + rebuild_fuzzyfiles() if grep { ! -e "$dir/cust_main.$_" } @fuzzyfields +} + +=item rebuild_fuzzyfiles + +=cut + +sub rebuild_fuzzyfiles { + + use Fcntl qw(:flock); + + my $dir = $FS::UID::conf_dir. "cache.". $FS::UID::datasrc; + mkdir $dir, 0700 unless -d $dir; + + foreach my $fuzzy ( @fuzzyfields ) { + + open(LOCK,">>$dir/cust_main.$fuzzy") + or die "can't open $dir/cust_main.$fuzzy: $!"; + flock(LOCK,LOCK_EX) + or die "can't lock $dir/cust_main.$fuzzy: $!"; + + my @all = map $_->getfield($fuzzy), qsearch('cust_main', {}); + push @all, + grep $_, map $_->getfield("ship_$fuzzy"), qsearch('cust_main',{}); + + open (CACHE,">$dir/cust_main.$fuzzy.tmp") + or die "can't open $dir/cust_main.$fuzzy.tmp: $!"; + print CACHE join("\n", @all), "\n"; + close CACHE or die "can't close $dir/cust_main.$fuzzy.tmp: $!"; + + rename "$dir/cust_main.$fuzzy.tmp", "$dir/cust_main.$fuzzy"; + close LOCK; + } + } -=item all_company +=item all_X =cut -sub all_company { +sub all_X { + my( $self, $field ) = @_; 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; + open(CACHE,"<$dir/cust_main.$field") + or die "can't open $dir/cust_main.$field: $!"; + my @array = map { chomp; $_; } ; + close CACHE; \@array; } @@ -3138,8 +4216,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 $@; @@ -3245,8 +4321,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 $@;