- bring prepaid support into this century (close: Bug#1124)
[freeside.git] / FS / FS / cust_main.pm
index 50cee48..e5748ec 100644 (file)
@@ -1,10 +1,11 @@
 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"
@@ -43,6 +44,8 @@ use FS::Msgcat qw(gettext);
 
 @ISA = qw( FS::Record );
 
+@EXPORT_OK = qw( smart_search );
+
 $realtime_bop_decline_quiet = 0;
 
 $DEBUG = 0;
@@ -172,7 +175,7 @@ FS::Record.  The following fields are currently supported:
 
 =item ship_fax - phone (optional)
 
-=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a credit - see L<FS::prepay_credit> and sets billing type to I<BILL>)
+=item payby - I<CARD> (credit card - automatic), I<DCRD> (credit card - on-demand), I<CHEK> (electronic check - automatic), I<DCHK> (electronic check - on-demand), I<LECB> (Phone bill billing), I<BILL> (billing), I<COMP> (free), or I<PREPAY> (special billing type: applies a payment from a prepaid card - see L<FS::prepay_credit> - and sets billing type to I<BILL>)
 
 =item payinfo - card number, P.O., comp issuer (4-8 lowercase alphanumerics; think username) or prepayment identifier (see L<FS::prepay_credit>)
 
@@ -268,20 +271,28 @@ sub insert {
   local $FS::UID::AutoCommit = 0;
   my $dbh = dbh;
 
-  my $amount = 0;
+  my $prepay_credit = '';
   my $seconds = 0;
   if ( $self->payby eq 'PREPAY' ) {
     $self->payby('BILL');
-    my $prepay_credit = qsearchs(
+    $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;
+    unless ( $prepay_credit ) {
+      $dbh->rollback if $oldAutoCommit;
+      return "Invalid prepaid card: ". $self->payinfo;
+    }
     $seconds = $prepay_credit->seconds;
+    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;
@@ -318,15 +329,18 @@ sub insert {
     return "No svc_acct record to apply pre-paid time";
   }
 
-  if ( $amount ) {
-    my $cust_credit = new FS::cust_credit {
+  if ( $prepay_credit && $prepay_credit->amount ) {
+    my $cust_pay = new FS::cust_pay {
       'custnum' => $self->custnum,
-      'amount'  => $amount,
+      'paid'    => $prepay_credit->amount,
+      #'_date'   => #date the prepaid card was purchased???
+      'payby'   => 'PREP',
+      'payinfo' => $prepay_credit->identifier,
     };
-    $error = $cust_credit->insert;
+    $error = $cust_pay->insert;
     if ( $error ) {
       $dbh->rollback if $oldAutoCommit;
-      return "inserting credit (transaction rolled back): $error";
+      return "inserting prepayment (transaction rolled back): $error";
     }
   }
 
@@ -1006,6 +1020,27 @@ sub unsuspended_pkgs {
   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>
@@ -1117,6 +1152,7 @@ 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 if $DEBUG;
 
   my $time = $options{'time'} || time;
@@ -1318,7 +1354,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;
@@ -1578,6 +1614,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;
       }
 
@@ -2633,6 +2670,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,
@@ -2913,6 +2963,7 @@ sub susp_sql { "
     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 )
             )
 "; }
 
@@ -2976,6 +3027,94 @@ sub fuzzy_search {
 
 =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