freeside · fozzmoo · Aug 30, 2013 · Sep 18, 2013 · Sep 23, 2013 · Oct 28, 2013
diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm
@@ -2506,6 +2506,12 @@ and customer address. Include units.',
     'type'        => 'selectmultiple',
     'select_enum' => [ qw(CARD DCRD CHEK DCHK LECB BILL CASH WEST MCRD PPAL COMP) ],
   },
+  {
+    'key'         => 'banned-pay-pad',
+    'section'     => 'billing',
+    'description' => 'Optional padding for banned pay tables. If you already have entries, don\'t enable as your old entries won\'t work.',
+    'type'        => 'text',
+  },
 
   {
     'key'         => 'payby-default',
@@ -3848,6 +3854,14 @@ and customer address. Include units.',
     'type'        => 'checkbox',
   },
 
+    {
+    'key'         => 'fuzzy-method',
+    'section'     => 'UI',
+    'description' => 'What underlying strategy should be used for fuzzy searches? Defaults to "String::Approx".',
+    'type'        => 'select',
+    'select_enum' => ['String::Approx', 'PG levenschtein', 'pg_trgm'],
+  },
+
   {
     'key'         => 'fuzzy-fuzziness',
     'section'     => 'UI',

diff --git a/FS/FS/UID.pm b/FS/FS/UID.pm
@@ -4,19 +4,22 @@ use strict;
 use vars qw(
   @ISA @EXPORT_OK $DEBUG $me $cgi $freeside_uid $conf_dir $cache_dir
   $secrets $datasrc $db_user $db_pass $schema $dbh $driver_name
-  $AutoCommit %callback @callback $callback_hack $use_confcompat
+  $olddbh $AutoCommit %callback @callback $callback_hack $use_confcompat
 );
 use subs qw( getsecrets );
 use Exporter;
 use Carp qw( carp croak cluck confess );
 use DBI;
 use IO::File;
 use FS::CurrentUser;
+use File::Slurp;  # Exports read_file
+use JSON;
+use Try::Tiny;
 
 @ISA = qw(Exporter);
 @EXPORT_OK = qw( checkeuid checkruid cgi setcgi adminsuidsetup forksuidsetup
                  preuser_setup
-                 getotaker dbh datasrc getsecrets driver_name myconnect
+                 getotaker dbh olddbh datasrc getsecrets driver_name myconnect
                  use_confcompat
                );
 
@@ -173,26 +176,40 @@ sub callback_setup {
 }
 
 sub myconnect {
-  my $handle = DBI->connect( getsecrets(), { 'AutoCommit'         => 0,
-                                             'ChopBlanks'         => 1,
-                                             'ShowErrorStatement' => 1,
-                                             'pg_enable_utf8'     => 1,
-                                             #'mysql_enable_utf8'  => 1,
-                                           }
-                           )
-    or die "DBI->connect error: $DBI::errstr\n";
-
-  if ( $schema ) {
-    use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
-    my $driver = _load_driver($handle);
-    if ( $driver =~ /^Pg/ ) {
-      no warnings 'redefine';
-      eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
-      die $@ if $@;
+    my $conn_label = shift || 'main';
+
+    my $secrets = getsecrets();
+    # Select named connection or fall back to 'main'
+    my $conn =  $secrets->{$conn_label}
+                ?   $secrets->{$conn_label}
+                :   $secrets->{'main'};
+
+    my $handle = DBI->connect( 
+        @{$conn}{qw/datasrc db_user db_pass/}, { 
+            'AutoCommit'         => 0,
+            'ChopBlanks'         => 1,
+            'ShowErrorStatement' => 1,
+            'pg_enable_utf8'     => 1,
+            'mysql_enable_utf8'  => 1, 
+        })
+        or die "DBI->connect error: $DBI::errstr\n";
+
+    # Populate these FS::UID global scalars
+    $datasrc = $conn->{'datasrc'};
+    $db_user = $conn->{'db_user'};
+    $db_pass = $conn->{'db_pass'};
+    $schema  = $conn->{'schema'};
+
+    if ( $schema ) {
+        use DBIx::DBSchema::_util qw(_load_driver ); #quelle hack
+        my $driver = _load_driver($handle);
+        if ( $driver =~ /^Pg/ ) {
+            no warnings 'redefine';
+            eval "sub DBIx::DBSchema::DBD::${driver}::default_db_schema {'$schema'}";
+            die $@ if $@;
+        }
     }
-  }
-
-  $handle;
+    $handle;
 }
 
 =item install_callback
@@ -246,7 +263,25 @@ Returns the DBI database handle.
 =cut
 
 sub dbh {
-  $dbh;
+    my $conn_name = shift;
+
+    if ($conn_name) {
+        $olddbh = $dbh;
+        $dbh = myconnect($conn_name);
+    }
+    return $dbh;
+}
+
+=item olddbh 
+
+Returns and restores the old DBI database handle
+
+=cut
+
+sub olddbh {
+    $dbh = $olddbh;
+
+    return $dbh;
 }
 
 =item datasrc
@@ -314,13 +349,33 @@ the `/usr/local/etc/freeside/secrets' file.
 =cut
 
 sub getsecrets {
+    # Try to parse secrets file as JSON 
+    my $json_text = read_file("$conf_dir/secrets");
+    my $json = JSON->new;
+
+    my $structure = {};
+    try {
+        $structure  = $json->decode($json_text);
+        $datasrc    = $structure->{'main'}{'datasrc'};
+        $db_user    = $structure->{'main'}{'db_user'};
+        $db_pass    = $structure->{'main'}{'db_pass'};
+        $schema     = $structure->{'main'}{'schema'};
+    }
+    catch {
+        ($datasrc, $db_user, $db_pass, $schema) = 
+            map { /^(.*)$/; $1 } readline(new IO::File "/tmp/secrets")
+            or die "Can't get secrets: $conf_dir/secrets: $!\n";
+        $structure->{'main'} = {};
+        $structure->{'main'}{'datasrc'} = $datasrc;
+        $structure->{'main'}{'db_user'} = $db_user;
+        $structure->{'main'}{'db_pass'} = $db_pass;
+        $structure->{'main'}{'schema'} = $schema;
+    };
 
-  ($datasrc, $db_user, $db_pass, $schema) = 
-    map { /^(.*)$/; $1 } readline(new IO::File "$conf_dir/secrets")
-      or die "Can't get secrets: $conf_dir/secrets: $!\n";
-  undef $driver_name;
+    warn "Secrets file may be invalid." 
+        unless $structure->{'main'}{'datasrc'} =~ /^dbi:\w+/i;
 
-  ($datasrc, $db_user, $db_pass);
+    return $structure;
 }
 
 =item use_confcompat

diff --git a/FS/FS/banned_pay.pm b/FS/FS/banned_pay.pm
@@ -146,7 +146,7 @@ sub ban_search {
     'table'     => 'banned_pay',
     'hashref'   => {
                      'payby'   => $opt{payby},
-                     'payinfo' => md5_base64($opt{payinfo}),
+                     'payinfo' => md5_base64($conf->config('banned-pay-pad') . $opt{payinfo}),
                    },
     'extra_sql' => 'AND ( end_date IS NULL OR end_date >= '. time. ' ) ',
   });

diff --git a/FS/FS/cust_main.pm b/FS/FS/cust_main.pm
@@ -1647,6 +1647,8 @@ use FS::cust_main::Search;
 sub queue_fuzzyfiles_update {
   my $self = shift;
 
+  return unless ($conf->config('fuzzy-method') eq 'String::Approx');
+
   local $SIG{HUP} = 'IGNORE';
   local $SIG{INT} = 'IGNORE';
   local $SIG{QUIT} = 'IGNORE';
@@ -2266,7 +2268,7 @@ sub _banned_pay_hashref {
 sub _new_banned_pay_hashref {
   my $self = shift;
   my $hr = $self->_banned_pay_hashref;
-  $hr->{payinfo} = md5_base64($hr->{payinfo});
+  $hr->{payinfo} = md5_base64($conf->config('banned-pay-pad') . $hr->{payinfo});
   $hr;
 }
 

diff --git a/FS/FS/cust_main/Search.pm b/FS/FS/cust_main/Search.pm
@@ -351,8 +351,8 @@ sub smart_search {
 
       if ( $first && $last ) {
         push @cust_main, FS::cust_main::Search->fuzzy_search(
-          { 'last'   => $last,    #fuzzy hashref
-            'first'  => $first }, #
+          { 'cust_main.last'   => $last,    #fuzzy hashref
+            'cust_main.first'  => $first }, #
           %fuzopts
         );
       }
@@ -975,7 +975,21 @@ sub search {
 
 Performs a fuzzy (approximate) search and returns the matching FS::cust_main
 records.  Currently, I<first>, I<last>, I<company> and/or I<address1> may be
-specified.
+specified. 
+
+Depending on the value of the C<fuzzy-method> config value, this subroutine 
+will use a different approach. If the value is I<String::Approx>,
+Freeside legacy behavior will ensue and the search will be done against
+plain text files using the L<String::Approx> module. If the value is 
+I<PG levenstein>, the search will employ the fuzzystrmatch PostgreSQL 
+extension to do the search. If the value is I<pg_trgm>, the search will
+employ the pg_trgm PostgreSQL extension to do a trigram match search.
+
+The I<fuzzy-fuzziness> configuration setting sets either the Levenshtein
+distance (for I<PG levenshtein> or I<String::Approx> values of
+I<fuzzy-method>) or the lowest value for the pg_trgm C<similarity()> call
+(Identical strings return 1. Less similar strings return values approaching
+0.)
 
 Additional options are the same as FS::Record::qsearch
 
@@ -985,61 +999,116 @@ sub fuzzy_search {
   my $self = shift;
   my $fuzzy = shift;
   # sensible defaults, then merge in any passed options
-  my %fuzopts = (
-    'table'     => 'cust_main',
-    'addl_from' => '',
-    'extra_sql' => '',
-    'hashref'   => {},
-    @_
-  );
 
-  my @cust_main = ();
-
-  my @fuzzy_mod = 'i';
   my $conf = new FS::Conf;
   my $fuzziness = $conf->config('fuzzy-fuzziness');
-  push @fuzzy_mod, $fuzziness if $fuzziness;
-
-  check_and_rebuild_fuzzyfiles();
-  foreach my $field ( keys %$fuzzy ) {
-
-    my $all = $self->all_X($field);
-    next unless scalar(@$all);
+	my %fuzopts = (
+		'table'         => 'cust_main',
+		'addl_from'     => '',
+		'extra_sql'     => '',
+		'order_by'      => undef,
+		'extra_param'   => [],
+		'hashref'       => {},
+		@_
+	);
+
+
+  # PG levenschtein matching
+  if ($conf->config('fuzzy-method') eq 'PG levenschtein') {
+    foreach my $field ( keys %$fuzzy ) {
+      my $joins = {};
+      if ( $field =~ /^cust_location/  and !$joins->{'cust_location'}) {
+        $fuzopts{'addl_from'} .= ' JOIN cust_location USING (custnum) ';
+				$joins->{'cust_location'} = 1;
+      }
+      if ( $field =~ /^contact/ and !$joins->{'contact'} ) {
+        $fuzopts{'addl_from'} .= ' JOIN contact USING (custnum) ';
+				$joins->{'contact'} = 1;
+      }
 
-    my %match = ();
-    $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, \@fuzzy_mod, @$all ) );
-    next if !keys(%match);
+      $fuzopts{'extra_sql'} .= ' AND ' if length($fuzopts{'extra_sql'});
+      $fuzopts{'extra_sql'} .= " levenshtein(lower($field), lower(?)) < $fuzziness ";
+      push @{$fuzopts{'extra_param'}}, $fuzzy->{$field};
+    }
 
-    my $in_matches = 'IN (' .
-                     join(',', map { dbh->quote($_) } keys %match) .
-                     ')';
+    return qsearch({
+			%fuzopts,
+			debug => 1,
+    });
 
-    my $extra_sql = $fuzopts{extra_sql};
-    if ($extra_sql =~ /^\s*where /i or keys %{ $fuzopts{hashref} }) {
-      $extra_sql .= ' AND ';
-    } else {
-      $extra_sql .= 'WHERE ';
-    }
-    $extra_sql .= "$field $in_matches";
+  }	# pg_trgm 
+  elsif ($conf->config('fuzzy-method') eq 'pg_trgm') {
+
+	  if ($fuzziness) {
+			dbh->do("SELECT set_limit(?)", {}, $fuzziness);
+		}
+    my $joins = {};
+    foreach my $field ( keys %$fuzzy ) {
+      if ( $field =~ /^cust_location/  and !$joins->{'cust_location'}) {
+        $fuzopts{'addl_from'} .= ' JOIN cust_location USING (custnum) ';
+				$joins->{'cust_location'} = 1;
+      }
+      if ( $field =~ /^contact/ and !$joins->{'contact'} ) {
+        $fuzopts{'addl_from'} .= ' JOIN contact USING (custnum) ';
+				$joins->{'contact'} = 1;
+      }
 
-    my $addl_from = $fuzopts{addl_from};
-    if ( $field =~ /^cust_location/ ) {
-      $addl_from .= ' JOIN cust_location USING (custnum)';
+			$fuzopts{'extra_sql'} .= " AND $field % ? ";
+      push @{$fuzopts{'extra_param'}}, $fuzzy->{$field};
     }
 
-    push @cust_main, qsearch({
+    return qsearch({
       %fuzopts,
-      'addl_from' => $addl_from,
-      'extra_sql' => $extra_sql,
     });
-  }
+  } # The old String::Approx method
+  else {
+    my @cust_main = ();
 
-  # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
-  my %saw = ();
-  @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
+    my @fuzzy_mod = 'i';
+    push @fuzzy_mod, $fuzziness if $fuzziness;
 
-  @cust_main;
+    check_and_rebuild_fuzzyfiles();
+    foreach my $field ( keys %$fuzzy ) {
+
+      my $all = $self->all_X($field);
+      next unless scalar(@$all);
+
+      my %match = ();
+      $match{$_}=1 foreach ( amatch( $fuzzy->{$field}, \@fuzzy_mod, @$all ) );
+      next if !keys(%match);
+
+      my $in_matches = 'IN (' .
+                      join(',', map { dbh->quote($_) } keys %match) .
+                      ')';
+
+      my $extra_sql = $fuzopts{extra_sql};
+      if ($extra_sql =~ /^\s*where /i or keys %{ $fuzopts{hashref} }) {
+        $extra_sql .= ' AND ';
+      } else {
+        $extra_sql .= 'WHERE ';
+      }
+      $extra_sql .= "$field $in_matches";
+
+      my $addl_from = $fuzopts{addl_from};
+      if ( $field =~ /^cust_location\./ ) {
+        $addl_from .= ' JOIN cust_location USING (custnum)';
+      } elsif ( $field =~ /^contact\./ ) {
+        $addl_from .= ' JOIN contact USING (custnum)';
+      }
 
+      push @cust_main, qsearch({
+      	%fuzopts,
+      	'addl_from' => $addl_from,
+      	'extra_sql' => $extra_sql,
+      });
+    }
+
+    # we want the components of $fuzzy ANDed, not ORed, but still don't want dupes
+    my %saw = ();
+    @cust_main = grep { ++$saw{$_->custnum} == scalar(keys %$fuzzy) } @cust_main;
+
+    return @cust_main;
+  } 
 }
 
 =back