diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 03280c4840..30f1d709c2 100644 --- 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 index 9c52f08834..3910d1e509 100644 --- a/FS/FS/UID.pm +++ b/FS/FS/UID.pm @@ -4,7 +4,7 @@ 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; @@ -12,11 +12,14 @@ 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 index 713c81adfd..b4a4e79a70 100644 --- 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 index 0c50b8462f..6ac0c90e59 100644 --- 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 index f14f897ea4..0ca0c04aa9 100644 --- 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, I, I and/or I may be -specified. +specified. + +Depending on the value of the C config value, this subroutine +will use a different approach. If the value is I, +Freeside legacy behavior will ensue and the search will be done against +plain text files using the L module. If the value is +I, the search will employ the fuzzystrmatch PostgreSQL +extension to do the search. If the value is I, the search will +employ the pg_trgm PostgreSQL extension to do a trigram match search. + +The I configuration setting sets either the Levenshtein +distance (for I or I values of +I) or the lowest value for the pg_trgm C 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 diff --git a/httemplate/edit/elements/edit.html b/httemplate/edit/elements/edit.html index 3270f04438..73d6241a01 100644 --- a/httemplate/edit/elements/edit.html +++ b/httemplate/edit/elements/edit.html @@ -519,7 +519,7 @@ % if ( $f->{curr_value_callback} ) { % $curr_value = &{ $f->{curr_value_callback} }( $cgi, $object, $field ), % } else { -% $curr_value = $object->$field(); +% $curr_value = $object->$field() if defined $field; % } % $curr_value = &{ $opt{'value_callback'} }( $f->{'field'}, $curr_value ) % if $opt{'value_callback'} && $mode ne 'error';