X-Git-Url: http://git.freeside.biz/gitweb/?a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=5d68dddb1d9ef40bd7c2093bec24b9b4f4911d6d;hb=b0c95cb531f14d955b246b94c2bd8548eb8f0241;hp=1540b61a39ed94a1d1c3a2085566fb96ce99795b;hpb=0cbeb01df08457b056a7ae775b4924c266b4228b;p=freeside.git diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 1540b61a3..5d68dddb1 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -1,15 +1,18 @@ 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 ); 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 Date::Format; #use Date::Manip; @@ -19,6 +22,7 @@ use FS::UID qw( getotaker dbh ); use FS::Record qw( qsearchs qsearch dbdef ); use FS::Misc qw( send_email ); use FS::cust_pkg; +use FS::cust_svc; use FS::cust_bill; use FS::cust_bill_pkg; use FS::cust_pay; @@ -42,12 +46,17 @@ use FS::Msgcat qw(gettext); @ISA = qw( FS::Record ); +@EXPORT_OK = qw( smart_search ); + $realtime_bop_decline_quiet = 0; $DEBUG = 0; -#$DEBUG = 1; +$me = '[FS::cust_main]'; $import = 0; +$skip_fuzzyfiles = 0; + +@encrypted_fields = ('payinfo', 'paycvv'); #ask FS::UID to run this stuff for us later #$FS::UID::callback{'FS::cust_main'} = sub { @@ -171,11 +180,84 @@ 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. + +=back + +=cut + +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 'DCARD') { # 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 payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L) -=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 =item paydate - expiration date, mm/yyyy, m/yyyy, mm/yy or m/yy @@ -267,25 +349,21 @@ sub insert { local $FS::UID::AutoCommit = 0; my $dbh = dbh; - my $amount = 0; - my $seconds = 0; + my $prepay_identifier = ''; + my( $amount, $seconds ) = ( 0, 0 ); 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(''); + + 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; } + } my $error = $self->SUPER::insert; @@ -318,21 +396,19 @@ sub insert { } if ( $amount ) { - my $cust_credit = new FS::cust_credit { - 'custnum' => $self->custnum, - 'amount' => $amount, - }; - $error = $cust_credit->insert; + $error = $self->insert_cust_pay_prepay($amount, $prepay_identifier); if ( $error ) { $dbh->rollback if $oldAutoCommit; - return "inserting credit (transaction rolled back): $error"; + return "inserting prepayment (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 ) { + $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; @@ -355,6 +431,9 @@ 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 @@ -403,12 +482,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 +507,195 @@ 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; + + 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; + + $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 { + my( $self, $amount ) = splice(@_, 0, 2); + 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' => 'PREP', + 'payinfo' => $payinfo, + }; + $cust_pay->insert; + +} + =item reexport This method is deprecated. See the I option to the insert and @@ -587,6 +862,16 @@ sub replace { local $SIG{TSTP} = 'IGNORE'; local $SIG{PIPE} = 'IGNORE'; + # 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 } ); + } + if ( $self->payby eq 'COMP' && $self->payby ne $old->payby && $conf->config('users-allow_comp') ) { return "You are not permitted to create complimentary accounts." @@ -624,10 +909,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,7 +967,7 @@ 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 @@ -716,7 +1003,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 } ); @@ -811,9 +1098,19 @@ sub check { $self->payby =~ /^(CARD|DCRD|CHEK|DCHK|LECB|BILL|COMP|PREPAY)$/ or return "Illegal payby: ". $self->payby; + + # 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 eq 'CARD' || $self->payby eq 'DCRD')) { my $payinfo = $self->payinfo; $payinfo =~ s/\D//g; @@ -826,7 +1123,7 @@ sub check { return gettext('unknown_card_type') if cardtype($self->payinfo) eq "Unknown"; 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,7 +1138,7 @@ sub check { } } - } elsif ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' ) { + } elsif ($check_payinfo && ( $self->payby eq 'CHEK' || $self->payby eq 'DCHK' )) { my $payinfo = $self->payinfo; $payinfo =~ s/[^\d\@]//g; @@ -914,7 +1211,7 @@ 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); } @@ -1005,6 +1302,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 @@ -1116,6 +1434,9 @@ 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; + my $time = $options{'time'} || time; my $error; @@ -1153,14 +1474,14 @@ sub bill { #NO!! next if $cust_pkg->cancel; next if $cust_pkg->getfield('cancel'); + warn " bill package ". $cust_pkg->pkgnum. "\n" if $DEBUG; + #? 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; @@ -1169,27 +1490,16 @@ sub bill { # 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; + + $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 $@; } + $cust_pkg->setfield('setup', $time) unless $cust_pkg->setup; - $cust_pkg_mod_flag=1; } #bill recurring fee @@ -1199,28 +1509,18 @@ sub bill { ! $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; + + # 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) ) { + $recur = eval { $cust_pkg->calc_recur( \$sdate, \@details ) }; + if ( $@ ) { $dbh->rollback if $oldAutoCommit; - return "Error eval-ing part_pkg->recur pkgpart ". $part_pkg->pkgpart. - "(expression $recur_prog): $@"; + return $@; } + #change this bit to use Date::Manip? CAREFUL with timezones (see # mailing list archive) my ($sec,$min,$hour,$mday,$mon,$year) = @@ -1248,19 +1548,22 @@ sub bill { } $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->modified ) { + + warn " package ". $cust_pkg->pkgnum. " modified; updating\n" if $DEBUG; + $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') ) { @@ -1272,6 +1575,8 @@ sub bill { 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; my $cust_bill_pkg = new FS::cust_bill_pkg ({ 'pkgnum' => $cust_pkg->pkgnum, 'setup' => $setup, @@ -1331,7 +1636,7 @@ sub bill { || $tax->recurtax =~ /^Y$/i; next unless $taxable_charged; - if ( $tax->exempt_amount > 0 ) { + if ( $tax->exempt_amount && $tax->exempt_amount > 0 ) { my ($mon,$year) = (localtime($sdate) )[4,5]; $mon++; my $freq = $part_pkg->freq || 1; @@ -1391,7 +1696,7 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #foreach my $cust_pkg @@ -1538,7 +1843,7 @@ sub collect { $self->select_for_update; #mutex my $balance = $self->balance; - warn "collect customer". $self->custnum. ": balance $balance" if $DEBUG; + warn "collect customer ". $self->custnum. ": balance $balance\n" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -1563,7 +1868,7 @@ sub collect { last if $self->balance <= 0; - warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")" + warn "invnum ". $cust_bill->invnum. " (owed ". $cust_bill->owed. ")\n" if $DEBUG; foreach my $part_bill_event ( @@ -1591,6 +1896,7 @@ sub collect { 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; } @@ -1777,7 +2083,10 @@ sub realtime_bop { || ( $conf->exists('emailinvoiceonly') && ! @invoicing_list ) ) { push @invoicing_list, $self->all_emails; } - my $email = $invoicing_list[0]; + + my $email = ($conf->exists('business-onlinepayment-email-override')) + ? $conf->config('business-onlinepayment-email-override') + : $invoicing_list[0]; my $payinfo = exists($options{'payinfo'}) ? $options{'payinfo'} @@ -2068,13 +2377,13 @@ sub realtime_refund_bop { my $cust_pay = ''; my $amount = $options{'amount'}; - my( $pay_processor, $auth, $order_number ); + my( $pay_processor, $auth, $order_number ) = ( '', '', '' ); if ( $options{'paynum'} ) { warn "FS::cust_main::realtime_bop: paynum: $options{paynum}\n" if $DEBUG; $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 =~ /^(\w+):([\w-]*)(:(\w+))?$/ or return "Can't parse paybatch for paynum $options{'paynum'}: ". $cust_pay->paybatch; ( $pay_processor, $auth, $order_number ) = ( $1, $2, $4 ); @@ -2084,19 +2393,23 @@ sub realtime_refund_bop { } 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 "FS::cust_main::realtime_bop: attempting void\n" if $DEBUG; 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 +2420,14 @@ sub realtime_refund_bop { warn $e; return $e; } + warn "FS::cust_main::realtime_bop: void successful\n" if $DEBUG; return ''; } } + warn "FS::cust_main::realtime_bop: void unsuccessful, trying refund\n" + if $DEBUG; + #massage data my $address = $self->address1; $address .= ", ". $self->address2 if $self->address2; @@ -2127,44 +2444,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"; + my $payinfo = ''; + if ( $method eq 'CC' ) { - #$content{cvv2} = $self->paycvv - # if defined $self->dbdef_table->column('paycvv') - # && length($self->paycvv); - - #$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 +2482,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 +2515,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 ) { @@ -2454,15 +2763,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 ] @@ -2534,6 +2845,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, @@ -2651,6 +2967,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 +3024,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 +3160,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: @@ -2905,9 +3278,15 @@ 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 ) ) @@ -2924,11 +3303,14 @@ sub suspended_sql { susp_sql(@_); } sub susp_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 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 ) ) "; } @@ -2946,6 +3328,7 @@ sub cancel_sql { " ) AND 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 ) ) "; } @@ -2992,6 +3375,94 @@ sub fuzzy_search { =over 4 +=item smart_search OPTION => VALUE ... + +Accepts the following options: I, the string to search for. The string +will be searched for as a customer number, last name or company name, first +searching for an exact match then fuzzy and substring matches. + +Any additional options treated as an additional qualifier on the search +(i.e. I). + +Returns a (possibly empty) array of FS::cust_main objects. + +=cut + +sub smart_search { + my %options = @_; + my $search = delete $options{'search'}; + my @cust_main = (); + + if ( $search =~ /^\s*(\d+)\s*$/ ) { # customer # search + + push @cust_main, qsearch('cust_main', { 'custnum' => $1, %options } ); + + } elsif ( $search =~ /^\s*(\S.*\S)\s*$/ ) { #value search + + my $value = lc($1); + my $q_value = dbh->quote($value); + + #exact + my $sql = scalar(keys %options) ? ' AND ' : ' WHERE '; + $sql .= " ( LOWER(last) = $q_value OR LOWER(company) = $q_value"; + $sql .= " OR LOWER(ship_last) = $q_value OR LOWER(ship_company) = $q_value" + if defined dbdef->table('cust_main')->column('ship_last'); + $sql .= ' )'; + + push @cust_main, qsearch( 'cust_main', \%options, '', $sql ); + + unless ( @cust_main ) { #no exact match, trying substring/fuzzy + + #still some false laziness w/ search/cust_main.cgi + + #substring + push @cust_main, qsearch( 'cust_main', + { 'last' => { 'op' => 'ILIKE', + 'value' => "%$q_value%" }, + %options, + } + ); + push @cust_main, qsearch( 'cust_main', + { 'ship_last' => { 'op' => 'ILIKE', + 'value' => "%$q_value%" }, + %options, + + } + ) + if defined dbdef->table('cust_main')->column('ship_last'); + + push @cust_main, qsearch( 'cust_main', + { 'company' => { 'op' => 'ILIKE', + 'value' => "%$q_value%" }, + %options, + } + ); + push @cust_main, qsearch( 'cust_main', + { 'ship_company' => { 'op' => 'ILIKE', + 'value' => "%$q_value%" }, + %options, + } + ) + if defined dbdef->table('cust_main')->column('ship_last'); + + #fuzzy + push @cust_main, FS::cust_main->fuzzy_search( + { 'last' => $value }, + \%options, + ); + push @cust_main, FS::cust_main->fuzzy_search( + { 'company' => $value }, + \%options, + ); + + } + + } + + @cust_main; + +} + =item check_and_rebuild_fuzzyfiles =cut