view release on metacpan or  search on metacpan

lib/App/geoip.pm  view on Meta::CPAN

    "u|update!"		=> \$conf{update},
    "f|fetch!"		=> \$conf{fetch},
    "d|dist|distance!"	=> \$conf{distance},
    "w|whois!"		=> \$conf{whois},
    "s|short!"		=> \$conf{short},
    "j|json!"		=> \$conf{json},
    "J|json-pretty!"	=> \ my $opt_J,
    "l|local=s"		=> \$conf{local_location},

    "D|DB=s"		=> \$conf{dsn},

    # Queries
      "country=s"	=> \ my $query_c,

    "v|verbose:1"	=> \(my $opt_v = 0),
    ) or usage (1);

sub pod_text {
    require Pod::Text::Color;
    my $m = $ENV{NO_COLOR} ? "Pod::Text" : "Pod::Text::Color";
    my $p = $m->new ();
    open my $fh, ">", \my $out;
    $p->parse_from_file ($0, $fh);
    close $fh;
    print $out;
    exit 0;
    } # pod_text

sub pod_nroff {
    first { -x "$_/nroff" } grep { -d } split m/:+/ => $ENV{PATH} or pod_text ();

    require Pod::Man;
    my $p = Pod::Man->new ();
    open my $fh, "|-", "nroff", "-man";
    $p->parse_from_file ($0, $fh);
    close $fh;
    exit 0;
    } # pod_nroff

$opt_v >= 7 and _dump ("Configuration", \%conf);

if (defined $opt_J) {
    if ($opt_J) {
	$conf{json_pretty}++;
	$conf{json}++;
	}
    else {
	$conf{json_pretty} = 0;
	}
    }
$conf{json} and $opt_J = $conf{json_pretty};

if (@ARGV == 0 and my $eh = $ENV{GEOIP_HOST}) {
    $eh =~ s{[\s\r\n]+\z}{};
    # No IPv6 support yet
    if ($eh =~ m{^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$} and
	$1 > 0 && $1 < 256 && $2 < 256 && $3 < 256 && $4 < 256) {
	# Simplistic IPv4
	push @ARGV => $eh;
	}
    elsif ($eh =~ m/^\w[-.\w]{0,252}\z/) { # Skip invalid clipboard content
	# https://en.wikipedia.org/wiki/Hostname#Syntax
	for (split m/\./ => $eh) {
	    m/^\w[-\w]{0,62}$/ or die "$eh is not a valid hostname or IPv4\n";
	    }
	push @ARGV => $eh;
	}
    }

my $dbh = do {
    my $dsn = $conf{dsn} =~ s{^b=(?=\w+:)}{}ir; # catch -DB=.. instead of --DB=
    my $help = $dsn =~ m/^dbi:(\w+):/i
	? "Did you forget to install DBD::$1?"
	: "Maybe the matching DBD for $dsn is not installed";
    eval {
	my %seen;
	my $fail = sub {
	    my $e = DBI->errstr or return;
	    !$seen{$e}++ and warn "$e\n";
	    };
	local $SIG{__WARN__} = $fail;
	local $SIG{__DIE__}  = $fail;
	DBI->connect ($conf{dsn}, undef, undef, {
	    AutoCommit		=> 0,
	    RaiseError		=> 1,
	    PrintError		=> 1,
	    ShowErrorStatement	=> 1,
	    });
	} or die "Cannot continue without a working database\n$help\n";
    };

sub _dump {
    my ($label, $ref) = @_;
    print STDERR $use_data_peek
	? Data::Peek::DDumper ({ $label => $ref })
	: Data::Dumper->Dump ([$ref], [$label]);
    } # _dump

# Based on GeoIP2 CSV databases
#  City:   http://geolite.maxmind.com/download/geoip/database/GeoLite2-City-CSV.zip
#  Country http://geolite.maxmind.com/download/geoip/database/GeoLite2-Country-CSV.zip
#  ASN     http://geolite.maxmind.com/download/geoip/database/GeoLite2-ASN-CSV.zip

my $idx_type = $conf{dsn} =~ m/:Pg/     ? "using btree" : "";
my $truncate = $conf{dsn} =~ m/:SQLite/ ? "delete from" : "truncate table";

unless (grep m/\b country \b/ix => $dbh->tables (undef, undef, undef, undef)) {
    say "Create table stamps";
    $dbh->do (qq; create table stamps (
	name		text		not null	primary key,
	stamp		bigint);
	);
    say "Create table continent";
    $dbh->do (qq; create table continent (
	id		char (4)	not null	primary key,
	name		text);
	);
    say "Create table country";
    $dbh->do (qq; create table country (
	id		bigint		not null	primary key,
	name		text		not null,