view release on metacpan or  search on metacpan

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

		tz		=> $_{time_zone},
		eu		=> $_{is_in_european_union},
		};
	    # Subdivisions to store?
	    $sti->execute (@{$rec}{qw( id name country_id metro_code tz eu )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    say "Reading City     IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-City-Blocks-IPv4.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# network,geoname_id,registered_country_geoname_id,
	#   represented_country_geoname_id,is_anonymous_proxy,
	#   is_satellite_provider,postal_code,latitude,longitude,accuracy_radius
	# 1.0.0.0/24,2062391,2077456,,0,0,5412,-34.1551,138.7482,1000
	$dbh->do ("$truncate ipc4");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into ipc4 values (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $cidr = $_{network};
	    my @rng = Net::CIDR::cidr2range ($cidr);
	    my ($f, $t) = split m/\s*-\s*/ => $rng[0];
	    my ($F, $T) = map { unpack "L>", inet_aton $_ } $f, $t;
	    my $rec = {
		cidr		=> $cidr,
		id		=> $_{geoname_id} || undef,
		ip_from		=> $f,
		ip_to		=> $t,
		ip_from_n	=> $F,
		ip_to_n		=> $T,
		reg_country_id	=> $_{registered_country_geoname_id}  || undef,
		rep_country_id	=> $_{represented_country_geoname_id} || undef,
		anon_proxy	=> $_{is_anonymous_proxy},
		satellite	=> $_{is_satellite_provider},
		postal_code	=> $_{postal_code},
		latitude	=> $_{latitude},
		longitude	=> $_{longitude},
		accuracy	=> $_{accuracy_radius},
		};
	    $sti->execute (@{$rec}{qw( cidr id ip_from ip_to ip_from_n ip_to_n
		reg_country_id rep_country_id anon_proxy satellite postal_code
		latitude longitude accuracy )});
	    });
	$sti->finish;
	$dbh->commit;
	}
    my $t = (stat $zcfn)[9];
    if ($stmp{$zcfn}) {
	$dbh->do ("update stamps set stamp = $t where name = '$zcfn'");
	}
    else {
	$dbh->do ("insert into stamps values ('$zcfn', $t)");
	}
    $dbh->commit;
    }

binmode STDERR, ":encoding(utf-8)";
binmode STDOUT, ":encoding(utf-8)";

if ($query_c) {
    @ARGV = ();
    my %ctry;
    my $sth = $dbh->prepare ("select id, name, continent from country");
    $sth->execute;
    $sth->bind_columns (\my ($id, $name, $cont));
    while ($sth->fetch) {
	$name =~ m/^ $query_c $/ix and $ctry{full}{$id} = [ $name, $cont, 0, 0 ];
	$name =~ m/  $query_c  /ix and $ctry{part}{$id} = [ $name, $cont, 0, 0 ];
	}
    $sth->finish;
    if    (keys %{$ctry{full}}) {
	%ctry = %{$ctry{full}};
	}
    elsif (keys %{$ctry{part}}) {
	%ctry = %{$ctry{part}};
	}
    else {
	$dbh->rollback;
	die "No matching country found for $query_c\n";
	}

    $sth = $dbh->prepare (join " " =>
	"select   cidr, reg_country_id, ip_from_n, ip_to_n",
	"from     ipv4",
	"order by reg_country_id, cidr");
    $sth->execute;
    $sth->bind_columns (\my $cidr, \$id, \my $from, \my $to);
    while ($sth->fetch) {
	defined $id or next;
	my $c = $ctry{$id} or next;
	say $cidr;
	$c->[2]++;
	$c->[3] += $to - $from + 1;
	}
    $sth->finish;
    $dbh->rollback;

    if ($opt_v) {
	my @w = (6, 10, 40, 15);
	printf STDERR "%s\n%$w[0]s %$w[1]s %-$w[2]s %s\n%s %s %s %s\n",
	    "Selected CIDR's", "# CIDR", "# IP", "Country", "Continent",
	    map { "-" x $_ } @w;
	printf STDERR "%$w[0]d %$w[1]d %-$w[2].$w[2]s %s\n",
	    @{$_}[2, 3, 0], $cont{$_->[1]} for
		sort { $a->[0] cmp $b->[0] } values %ctry;
	}

    exit 0;
    }

my %seen;
my %found;
while (@ARGV) {
    my $ip = shift or next;

    my $host;
    if ($ip =~ m/^\d{1,3}(?:\.\d{1,3}){3}$/ and my $n = inet_aton ($ip)) {
	$seen{$ip}++;