package FS::cust_main;
use strict;
-use vars qw( @ISA $conf $DEBUG $import );
+use vars qw( @ISA @EXPORT_OK $conf $DEBUG $import );
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;
+use String::Approx qw(amatch);
use Business::CreditCard;
use FS::UID qw( getotaker dbh );
use FS::Record qw( qsearchs qsearch dbdef );
@ISA = qw( FS::Record );
+@EXPORT_OK = qw( smart_search );
+
$realtime_bop_decline_quiet = 0;
$DEBUG = 0;
grep { ! $_->susp } $self->ncancelled_pkgs;
}
+=item num_cancelled_pkgs
+
+Returns the number of cancelled packages (see L<FS::cust_pkg>) 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</unflagged_suspended_pkgs>
sub bill {
my( $self, %options ) = @_;
+ return '' if $self->payby eq 'COMP';
+ warn "bill customer ". $self->custnum if $DEBUG;
+
my $time = $options{'time'} || time;
my $error;
#NO!! next if $cust_pkg->cancel;
next if $cust_pkg->getfield('cancel');
+ warn " bill package ". $cust_pkg->pkgnum 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;
# 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" 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
! $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" 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) =
}
$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') ) {
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,
|| $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;
} #if $setup != 0 || $recur != 0
- } #if $cust_pkg_mod_flag
+ } #if $cust_pkg->modified
} #foreach my $cust_pkg
$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" if $DEBUG;
unless ( $balance > 0 ) { #redundant?????
$dbh->rollback if $oldAutoCommit; #hmm
return '';
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;
}
eval "use Business::OnlinePayment";
die $@ if $@;
- #overrides
- $self->set( $_ => $options{$_} )
- foreach grep { exists($options{$_}) }
- qw( payname address1 address2 city state zip payinfo paydate paycvv);
-
#load up config
my $bop_config = 'business-onlinepayment';
$bop_config .= '-ach'
#massage data
- my $address = $self->address1;
- $address .= ", ". $self->address2 if $self->address2;
-
+ my $address = exists($options{'address1'})
+ ? $options{'address1'}
+ : $self->address1;
+ my $address2 = exists($options{'address2'})
+ ? $options{'address2'}
+ : $self->address2;
+ $address .= ", ". $address2 if length($address2);
+
+ my $o_payname = exists($options{'payname'})
+ ? $options{'payname'}
+ : $self->payname;
my($payname, $payfirst, $paylast);
- if ( $self->payname && $method ne 'ECHECK' ) {
- $payname = $self->payname;
- $payname =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
+ if ( $o_payname && $method ne 'ECHECK' ) {
+ ($payname = $o_payname) =~ /^\s*([\w \,\.\-\']*)?\s+([\w\,\.\-\']+)\s*$/
or return "Illegal payname $payname";
($payfirst, $paylast) = ($1, $2);
} else {
}
my $email = $invoicing_list[0];
+ my $payinfo = exists($options{'payinfo'})
+ ? $options{'payinfo'}
+ : $self->payinfo;
+
my %content = ();
if ( $method eq 'CC' ) {
- $content{card_number} = $self->payinfo;
- $self->paydate =~ /^\d{2}(\d{2})[\/\-](\d+)[\/\-]\d+$/;
+ $content{card_number} = $payinfo;
+ my $paydate = exists($options{'paydate'})
+ ? $options{'paydate'}
+ : $self->paydate;
+ $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);
+ if ( defined $self->dbdef_table->column('paycvv') ) {
+ my $paycvv = exists($options{'paycvv'})
+ ? $options{'paycvv'}
+ : $self->paycvv;
+ $content{cvv2} = $self->paycvv
+ if length($paycvv);
+ }
$content{recurring_billing} = 'YES'
if qsearch('cust_pay', { 'custnum' => $self->custnum,
'payby' => 'CARD',
- 'payinfo' => $self->payinfo, } );
+ 'payinfo' => $payinfo,
+ } );
} elsif ( $method eq 'ECHECK' ) {
- my($account_number,$routing_code) = $self->payinfo;
( $content{account_number}, $content{routing_code} ) =
- split('@', $self->payinfo);
- $content{bank_name} = $self->payname;
+ split('@', $payinfo);
+ $content{bank_name} = $o_payname;
$content{account_type} = 'CHECKING';
$content{account_name} = $payname;
$content{customer_org} = $self->company ? 'B' : 'I';
- $content{customer_ssn} = $self->ss;
+ $content{customer_ssn} = exists($options{'ss'})
+ ? $options{'ss'}
+ : $self->ss;
} elsif ( $method eq 'LEC' ) {
- $content{phone} = $self->payinfo;
+ $content{phone} = $payinfo;
}
#transaction(s)
'first_name' => $payfirst,
'name' => $payname,
'address' => $address,
- 'city' => $self->city,
- 'state' => $self->state,
- 'zip' => $self->zip,
- 'country' => $self->country,
+ 'city' => ( exists($options{'city'})
+ ? $options{'city'}
+ : $self->city ),
+ 'state' => ( exists($options{'state'})
+ ? $options{'state'}
+ : $self->state ),
+ 'zip' => ( exists($options{'zip'})
+ ? $options{'zip'}
+ : $self->zip ),
+ 'country' => ( exists($options{'country'})
+ ? $options{'country'}
+ : $self->country ),
'referer' => 'http://cleanwhisker.420.am/',
'email' => $email,
'phone' => $self->daytime || $self->night,
# correctly
if ( defined $self->dbdef_table->column('paycvv')
&& length($self->paycvv)
- && ! grep { $_ eq cardtype($self->payinfo) } $conf->config('cvv-save')
- && ! length($options{'paycvv'})
+ && ! grep { $_ eq cardtype($payinfo) } $conf->config('cvv-save')
) {
- my $new = new FS::cust_main { $self->hash };
- $new->paycvv('');
- my $error = $new->replace($self);
+ my $error = $self->remove_cvv;
if ( $error ) {
warn "error removing cvv: $error\n";
}
'paid' => $amount,
'_date' => '',
'payby' => $method2payby{$method},
- 'payinfo' => $self->payinfo,
+ 'payinfo' => $payinfo,
'paybatch' => $paybatch,
} );
my $error = $cust_pay->insert;
}
+=item remove_cvv
+
+Removes the I<paycvv> field from the database directly.
+
+If there is an error, returns the error, otherwise returns false.
+
+=cut
+
+sub remove_cvv {
+ my $self = shift;
+ my $sth = dbh->prepare("UPDATE cust_main SET paycvv = '' WHERE custnum = ?")
+ or return dbh->errstr;
+ $sth->execute($self->custnum)
+ or return $sth->errstr;
+ $self->paycvv('');
+ '';
+}
+
=item realtime_refund_bop METHOD [ OPTION => VALUE ... ]
Refunds a realtime credit card, ACH (electronic check) or phone bill transaction
eval "use Business::OnlinePayment";
die $@ if $@;
- ##overrides
- #$self->set( $_ => $options{$_} )
- # foreach grep { exists($options{$_}) }
- # qw( payname address1 address2 city state zip payinfo paydate paycvv);
-
#load up config
my $bop_config = 'business-onlinepayment';
$bop_config .= '-ach'
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 );
}
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?
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'});
$payname = "$payfirst $paylast";
}
- my %content = ();
if ( $method eq 'CC' ) {
$content{card_number} = $self->payinfo;
# 'payinfo' => $self->payinfo, } );
} elsif ( $method eq 'ECHECK' ) {
- my($account_number,$routing_code) = $self->payinfo;
( $content{account_number}, $content{routing_code} ) =
split('@', $self->payinfo);
$content{bank_name} = $self->payname;
#then try refund
my $refund = new Business::OnlinePayment( $processor, @bop_options );
$refund->content(
- 'type' => $method,
'action' => 'credit',
- 'login' => $login,
- 'password' => $password,
- 'order_number' => $order_number,
- 'amount' => $amount,
- 'authorization' => $auth,
'customer_id' => $self->custnum,
'last_name' => $paylast,
'first_name' => $payfirst,
'state' => $self->state,
'zip' => $self->zip,
'country' => $self->country,
- 'referer' => 'http://cleanwhisker.420.am/',
%content, #after
);
$refund->submit();
'payby' => $method2payby{$method},
'payinfo' => $self->payinfo,
'paybatch' => $paybatch,
- 'reason' => $options{'reason'} || 'card refund',
+ 'reason' => $options{'reason'} || 'card or ACH refund',
} );
my $error = $cust_refund->insert;
if ( $error ) {
$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,
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,
} );
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 )
+ AND ( cust_pkg.cancel IS NULL OR cust_pkg.cancel = 0 )
)
"; }
)
"; }
+=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<last> or I<company> may be specified (the
+appropriate ship_ field is also searched if applicable).
+
+Additional options are the same as FS::Record::qsearch
+
+=cut
+
+sub fuzzy_search {
+ my( $self, $fuzzy, $hash, @opt) = @_;
+ #$self
+ $hash ||= {};
+ my @cust_main = ();
+
+ check_and_rebuild_fuzzyfiles();
+ foreach my $field ( keys %$fuzzy ) {
+ my $sub = \&{"all_$field"};
+ my %match = ();
+ $match{$_}=1 foreach ( amatch($fuzzy->{$field}, ['i'], @{ &$sub() } ) );
+
+ 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');
+ }
+ }
+
+ my %saw = ();
+ @cust_main = grep { !$saw{$_->custnum}++ } @cust_main;
+
+ @cust_main;
+
+}
+
=back
=head1 SUBROUTINES
=over 4
+=item smart_search OPTION => VALUE ...
+
+Accepts the following options: I<search>, 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<agentnum>).
+
+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