From 06c0b7427611e97b9ab354a0b75cf41a7a09fa75 Mon Sep 17 00:00:00 2001 From: Doran Barton Date: Fri, 30 Aug 2013 14:07:57 -0600 Subject: [PATCH 1/4] Added multiple DB connection capability Conflicts: FS/FS/UID.pm --- FS/FS/UID.pm | 109 ++++++++++++++++++++++++++++++++++++++------------- 1 file changed, 82 insertions(+), 27 deletions(-) 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 From 1d34c609b135ab45be12ebc7aa86f6fbb914d321 Mon Sep 17 00:00:00 2001 From: "Jason (Jayce^) Hall" Date: Wed, 18 Sep 2013 15:08:39 -0600 Subject: [PATCH 2/4] Add in an optional banned-pay padding to prefix cards to be stored. This assists in PCI compliance, where even though the pad is stored in the db, having the cards stored in an unpadded md5 is considered a no no. --- FS/FS/Conf.pm | 6 ++++++ FS/FS/banned_pay.pm | 2 +- FS/FS/cust_main.pm | 2 +- 3 files changed, 8 insertions(+), 2 deletions(-) diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index 3c445200cc..b3bc011019 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -2484,6 +2484,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', 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 1d6e845888..53cb294c6d 100644 --- a/FS/FS/cust_main.pm +++ b/FS/FS/cust_main.pm @@ -2283,7 +2283,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; } From 356f3be1391b534ce7e49796542f6c08b5ce1321 Mon Sep 17 00:00:00 2001 From: Doran Barton Date: Thu, 14 Nov 2013 16:29:19 -0700 Subject: [PATCH 3/4] Check to see if $field is defined before calling as $object method. Was causing a nasty infinite loop on { type => 'columnstart' } fields. --- httemplate/edit/elements/edit.html | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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'; From 6ad5bbc8bb32360ad7c47b66cba6ee92589babd4 Mon Sep 17 00:00:00 2001 From: Doran Barton Date: Wed, 20 Nov 2013 14:20:11 -0700 Subject: [PATCH 4/4] Fuzzy search support for PostgreSQL pg_trgm and levenshtein extensions. --- FS/FS/Conf.pm | 8 ++ FS/FS/cust_main.pm | 2 + FS/FS/cust_main/Search.pm | 157 +++++++++++++++++++++++++++----------- 3 files changed, 123 insertions(+), 44 deletions(-) diff --git a/FS/FS/Conf.pm b/FS/FS/Conf.pm index aa44aa48d0..30f1d709c2 100644 --- a/FS/FS/Conf.pm +++ b/FS/FS/Conf.pm @@ -3854,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/cust_main.pm b/FS/FS/cust_main.pm index 2a3f0baa3e..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'; 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