X-Git-Url: http://git.freeside.biz/gitweb/?p=freeside.git;a=blobdiff_plain;f=FS%2FFS%2Fcust_main.pm;h=50cee480333876d6f3c3a3415443fee02f72b546;hp=58d1a28f54ab318d019038e5b7ff627710ff41a8;hb=6fe8172b11d0369d0b1274d6825ec0c57afe8001;hpb=a5b491b6948fdac9750843e2bacf65284fdae5ba diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm index 58d1a28f5..50cee4803 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -9,10 +9,12 @@ 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 ); @@ -1115,6 +1117,8 @@ If there is an error, returns the error, otherwise returns false. sub bill { my( $self, %options ) = @_; + warn "bill customer ". $self->custnum if $DEBUG; + my $time = $options{'time'} || time; my $error; @@ -1152,14 +1156,14 @@ sub bill { #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; @@ -1168,27 +1172,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" 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 @@ -1198,28 +1191,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" 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) = @@ -1247,19 +1230,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') ) { @@ -1271,6 +1257,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, @@ -1390,7 +1378,7 @@ sub bill { } #if $setup != 0 || $recur != 0 - } #if $cust_pkg_mod_flag + } #if $cust_pkg->modified } #foreach my $cust_pkg @@ -1537,7 +1525,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" if $DEBUG; unless ( $balance > 0 ) { #redundant????? $dbh->rollback if $oldAutoCommit; #hmm return ''; @@ -2067,13 +2055,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 ); @@ -2083,19 +2071,22 @@ 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? 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'}); @@ -2126,7 +2117,6 @@ sub realtime_refund_bop { $payname = "$payfirst $paylast"; } - my %content = (); if ( $method eq 'CC' ) { $content{card_number} = $self->payinfo; @@ -2157,13 +2147,7 @@ sub realtime_refund_bop { #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, @@ -2173,7 +2157,6 @@ sub realtime_refund_bop { 'state' => $self->state, 'zip' => $self->zip, 'country' => $self->country, - 'referer' => 'http://cleanwhisker.420.am/', %content, #after ); $refund->submit(); @@ -2207,7 +2190,7 @@ sub realtime_refund_bop { '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 ) { @@ -2694,9 +2677,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, } ); @@ -2949,6 +2934,42 @@ sub cancel_sql { " ) "; } +=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). + +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