Skip to content

Commit

Permalink
Latest DB.pm from snippets
Browse files Browse the repository at this point in the history
  • Loading branch information
nigelhorne committed Dec 5, 2019
1 parent abd0fa9 commit 7d541b1
Show file tree
Hide file tree
Showing 6 changed files with 135 additions and 52 deletions.
2 changes: 1 addition & 1 deletion lib/Geo/Coder/Free.pm
Original file line number Diff line number Diff line change
Expand Up @@ -152,7 +152,7 @@ sub geocode {
} elsif(@_ % 2 == 0) {
%param = @_;
} else {
$param{location} = shift;
$param{'location'} = shift;
}

if($self->{'openaddr'}) {
Expand Down
164 changes: 121 additions & 43 deletions lib/Geo/Coder/Free/DB.pm
Original file line number Diff line number Diff line change
Expand Up @@ -32,23 +32,24 @@ package Geo::Coder::Free::DB;
# my $row = $foo->fetchrow_hashref(customer_id => '12345);
# print Data::Dumper->new([$row])->Dump();

# FIXME: there needs to be a column called 'entry' which is used for sort
# TODO: support a directory hierachy of databases
# TODO: consider returning an object or array of objects, rather than hashes
# TODO: Add redis database - could be of use for Geo::Coder::Free
# use select() to select a database - use the table arg
# new(database => 'redis://servername');

use warnings;
use strict;

use DBD::SQLite::Constants qw/:file_open/; # For SQLITE_OPEN_READONLY
use File::Basename;
use DBI;
use File::Spec;
use File::pfopen 0.02;
use File::Temp;
use Gzip::Faster;
use DBD::SQLite::Constants qw/:file_open/; # For SQLITE_OPEN_READONLY
use Error::Simple;
use Carp;

our @databases;
our $directory;
our $logger;
our $cache;
Expand Down Expand Up @@ -81,9 +82,6 @@ sub init {
$directory ||= $args{'directory'};
$logger ||= $args{'logger'};
$cache ||= $args{'cache'};
if($args{'databases'}) {
@databases = $args{'databases'};
}
}

sub set_logger {
Expand All @@ -104,6 +102,8 @@ sub set_logger {
$self->{'logger'} = $args{'logger'};
}

# Open the database.

sub _open {
my $self = shift;
my %args = (
Expand All @@ -129,6 +129,10 @@ sub _open {
}

if(-r $slurp_file) {
require DBI;

DBI->import();

$dbh = DBI->connect("dbi:SQLite:dbname=$slurp_file", undef, undef, {
sqlite_open_flags => SQLITE_OPEN_READONLY,
});
Expand All @@ -137,10 +141,14 @@ sub _open {
if($self->{'logger'}) {
$self->{'logger'}->debug("read in $table from SQLite $slurp_file");
}
$self->{'type'} = 'DBI';
} else {
my $fin;
($fin, $slurp_file) = File::pfopen::pfopen($dir, $table, 'csv.gz:db.gz');
if(defined($slurp_file) && (-r $slurp_file)) {
require Gzip::Faster;
Gzip::Faster->import();

close($fin);
$fin = File::Temp->new(SUFFIX => '.csv', UNLINK => 0);
print $fin gunzip_file($slurp_file);
Expand Down Expand Up @@ -185,7 +193,11 @@ sub _open {
f_file => $slurp_file,
escape_char => '\\',
sep_char => $sep_char,
auto_diag => 1,
# Don't do this, causes "Bizarre copy of HASH
# in scalar assignment in error_diag
# RT121127
# auto_diag => 1,
auto_diag => 0,
# Don't do this, it causes "Attempt to free unreferenced scalar"
# callbacks => {
# after_parse => sub {
Expand Down Expand Up @@ -245,6 +257,7 @@ sub _open {
$self->{'data'}[$i++] = $d;
}
}
$self->{'type'} = 'CSV';
} else {
$slurp_file = File::Spec->catfile($dir, "$table.xml");
if(-r $slurp_file) {
Expand All @@ -257,11 +270,10 @@ sub _open {
} else {
throw Error::Simple("Can't open $dir/$table");
}
$self->{'type'} = 'XML';
}
}

push @databases, $table;

$self->{$table} = $dbh;
my @statb = stat($slurp_file);
$self->{'_updated'} = $statb[9];
Expand Down Expand Up @@ -289,20 +301,51 @@ sub selectall_hash {
if($self->{'logger'}) {
$self->{'logger'}->trace("$table: selectall_hash fast track return");
}
return @{$self->{'data'}};
# This use of a temporary variable is to avoid
# "Implicit scalar context for array in return"
# return @{$self->{'data'}};
my @rc = @{$self->{'data'}};
return @rc;
}
# if((scalar(keys %params) == 1) && $self->{'data'} && defined($params{'entry'})) {
# }

my $query = "SELECT * FROM $table";
my $query;
if($self->{'type'} eq 'CSV') {
# $query = "SELECT * FROM $table WHERE entry IS NOT NULL AND entry NOT LIKE '#%'";
$query = "SELECT * FROM $table";
} else {
$query = "SELECT * FROM $table";
}
my @query_args;
foreach my $c1(sort keys(%params)) { # sort so that the key is always the same
if(scalar(@query_args) == 0) {
$query .= ' WHERE';
my $arg = $params{$c1};
if(ref($arg)) {
if($self->{'logger'}) {
$self->{'logger'}->fatal("selectall_hash $query: argument is not a string");
}
throw Error::Simple("$query: argument is not a string");
}
if(!defined($arg)) {
throw Error::Simple("$query: value for $c1 is not defined");
}
# if(scalar(@query_args) || ($self->{'type'} eq 'CSV')) {
if(scalar(@query_args)) {
if($arg =~ /\@/) {
$query .= " AND $c1 LIKE ?";
} else {
$query .= " AND $c1 = ?";
}
} else {
$query .= ' AND';
if($arg =~ /\@/) {
$query .= " WHERE $c1 LIKE ?";
} else {
$query .= " WHERE $c1 = ?";
}
}
$query .= " $c1 = ?";
push @query_args, $params{$c1};
push @query_args, $arg;
}
# $query .= ' ORDER BY entry';
if($self->{'logger'}) {
if(defined($query_args[0])) {
$self->{'logger'}->debug("selectall_hash $query: ", join(', ', @query_args));
Expand All @@ -317,12 +360,17 @@ sub selectall_hash {
my $c;
if($c = $self->{cache}) {
if(my $rc = $c->get($key)) {
return @{$rc};
# This use of a temporary variable is to avoid
# "Implicit scalar context for array in return"
# return @{$rc};
my @rc = @{$rc};
return @rc;
}
}

if(my $sth = $self->{$table}->prepare($query)) {
$sth->execute(@query_args) || throw Error::Simple("$query: @query_args");
$sth->execute(@query_args) ||
throw Error::Simple("$query: @query_args");

my @rc;
while(my $href = $sth->fetchrow_hashref()) {
Expand All @@ -335,7 +383,9 @@ sub selectall_hash {

return @rc;
}
$self->{'logger'}->warn("selectall_hash failure on $query: @query_args");
if($self->{'logger'}) {
$self->{'logger'}->warn("selectall_hash failure on $query: @query_args");
}
throw Error::Simple("$query: @query_args");
}

Expand All @@ -357,34 +407,52 @@ sub fetchrow_hashref {
} else {
$query .= $table;
}
my @args;
# if($self->{'type'} eq 'CSV') {
# $query .= " WHERE entry IS NOT NULL AND entry NOT LIKE '#%'";
# }
my @query_args;
foreach my $c1(sort keys(%params)) { # sort so that the key is always the same
if(scalar(@args) == 0) {
$query .= ' WHERE';
} else {
$query .= ' AND';
if(my $arg = $params{$c1}) {
# if(scalar(@query_args) || ($self->{'type'} eq 'CSV')) {
if(scalar(@query_args)) {
if($arg =~ /\@/) {
$query .= " AND $c1 LIKE ?";
} else {
$query .= " AND $c1 = ?";
}
} else {
if($arg =~ /\@/) {
$query .= " WHERE $c1 LIKE ?";
} else {
$query .= " WHERE $c1 = ?";
}
}
push @query_args, $arg;
}
$query .= " $c1 = ?";
push @args, $params{$c1};
}
# $query .= ' ORDER BY entry LIMIT 1';
$query .= ' LIMIT 1';
if($self->{'logger'}) {
if(defined($args[0])) {
$self->{'logger'}->debug("fetchrow_hashref $query: ", join(', ', @args));
if(defined($query_args[0])) {
$self->{'logger'}->debug("fetchrow_hashref $query: ", join(', ', @query_args));
} else {
$self->{'logger'}->debug("fetchrow_hashref $query");
}
}
my $key = "fetchrow $query " . join(', ', @args);
my $key;
if(defined($query_args[0])) {
$key = "fetchrow $query " . join(', ', @query_args);
} else {
$key = "fetchrow $query";
}
my $c;
if($c = $self->{cache}) {
if(my $rc = $c->get($key)) {
return $rc;
}
}
my $sth = $self->{$table}->prepare($query) or die $self->{$table}->errstr();
$sth->execute(@args) || throw Error::Simple("$query: @args");
$sth->execute(@query_args) || throw Error::Simple("$query: @query_args");
if($c) {
my $rc = $sth->fetchrow_hashref();
$c->set($key, $rc, '1 hour');
Expand Down Expand Up @@ -462,23 +530,33 @@ sub AUTOLOAD {

my $query;
if(wantarray && !delete($params{'distinct'})) {
$query = "SELECT $column FROM $table";
if($self->{'type'} eq 'CSV') {
$query = "SELECT $column FROM $table WHERE entry IS NOT NULL AND entry NOT LIKE '#%'";
} else {
$query = "SELECT $column FROM $table";
}
} else {
$query = "SELECT DISTINCT $column FROM $table";
if($self->{'type'} eq 'CSV') {
$query = "SELECT DISTINCT $column FROM $table WHERE entry IS NOT NULL AND entry NOT LIKE '#%'";
} else {
$query = "SELECT DISTINCT $column FROM $table";
}
}
my @args;
foreach my $c1(keys(%params)) {
if(!defined($params{$c1})) {
$self->{'logger'}->debug("AUTOLOAD params $c1 isn't defined");
}
# $query .= " AND $c1 LIKE ?";
if(scalar(@args) == 0) {
$query .= ' WHERE';
while(my ($key, $value) = each %params) {
if(defined($value)) {
# $query .= " AND $key LIKE ?";
if(scalar(@args)) {
$query .= " AND $key = ?";
} else {
$query .= " WHERE $key = ?";
}
push @args, $value;
} else {
$query .= ' AND';
if($self->{'logger'}) {
$self->{'logger'}->debug("AUTOLOAD params $key isn't defined");
}
}
$query .= " $c1 = ?";
push @args, $params{$c1};
}
$query .= " ORDER BY $column";
if(!wantarray) {
Expand Down
6 changes: 3 additions & 3 deletions lib/Geo/Coder/Free/MaxMind.pm
Original file line number Diff line number Diff line change
Expand Up @@ -281,7 +281,7 @@ sub geocode {
# ::diag(__LINE__);
if(defined($county) && ($county eq 'London')) {
@admin2s = $self->{'admin2'}->selectall_hash(asciiname => $location);
} else {
} elsif(defined($county)) {
# ::diag(__LINE__, ": $county");
@admin2s = $self->{'admin2'}->selectall_hash(asciiname => $county);
}
Expand Down Expand Up @@ -340,7 +340,7 @@ sub geocode {
last;
}
}
} else {
} elsif(defined($county)) {
# e.g. states in the US
if(!defined($self->{'admin1'})) {
$self->{'admin1'} = Geo::Coder::Free::DB::MaxMind::admin1->new() or die "Can't open the admin1 database";
Expand Down Expand Up @@ -394,7 +394,7 @@ sub geocode {
if(wantarray) {
my @rc = $self->{'cities'}->selectall_hash($options);
if(scalar(@rc) == 0) {
@rc = $self->{'cities'}->selectall_hash('Region' => $options->{'Region'});
@rc = $self->{'cities'}->selectall_hash('Region' => ($options->{'Region'} // $param{'region'}));
if(scalar(@rc) == 0) {
# ::diag(__LINE__, ': no matches: ', Data::Dumper->new([$options])->Dump());
return;
Expand Down
2 changes: 1 addition & 1 deletion t/openaddr.t
Original file line number Diff line number Diff line change
Expand Up @@ -192,7 +192,7 @@ OPENADDR: {

$location = $geo_coder->geocode('716 Yates Street, Victoria, British Columbia, Canada');
cmp_deeply($location,
methods('lat' => num(48.43, 1e-2), 'long' => num(-123.36, 1e-2)));
methods('lat' => num(48.43, 1e-2), 'long' => num(-123.37, 1e-2)));

$location = $geo_coder->geocode(location => 'Caboolture, Queensland, Australia');
ok(defined($location));
Expand Down
2 changes: 1 addition & 1 deletion t/scantext.t
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ SCANTEXT: {

ok($location->{'location'} eq 'Ramsgate, Kent, England');

@locations = $geocoder->geocode(scantext => 'Hello World', region => 'gb');
@locations = $geocoder->geocode(scantext => 'Hello World', region => 'GB');
ok(ref($locations[0]) eq '');

@locations = $geocoder->geocode(scantext => 'Hello World');
Expand Down
Loading

0 comments on commit 7d541b1

Please sign in to comment.