view release on metacpan or  search on metacpan

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

			GeoLite2-Country-CSV
			GeoLite2-City-CSV
			)) {
	my $f = "$db.zip";
	printf STDERR     "%34s %s\n",     dtsz ($f), $f;
	my $url = join "&" => "$base$db", "license_key=$key", "suffix=zip";
	$opt_v > 5 and warn "Fetching $url ...\n";
	my $c = mirror ($url, $f);
	printf STDERR "%4d %29s %s\n", $c, dtsz ($f), $f;
	}
    }

my $zcfn = "GeoLite2-Country-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading Country       info ...";
    my %ctry;
    $dbh->do ("$truncate continent");
    foreach my $cnm (grep m{\bGeoLite2-Country-Locations-en.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# geoname_id,locale_code,continent_code,continent_name,country_iso_code,country_name,is_in_european_union
	# 49518,en,AF,Africa,RW,Rwanda,0
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    $cont{$_{continent_code}} ||= $_{continent_name};
	    my $id = $_{geoname_id} or return;
	    my $ctry = {
		id		=> $id,
		name		=> $_{country_name},
		iso		=> $_{country_iso_code},
		continent	=> $_{continent_code},
		eu		=> $_{is_in_european_union},
		};
	    $ctry{$id} //= $ctry;
	    #$ctry{$_{country_iso_code}} //= $ctry;
	    });
	}
    {	$dbh->do ("$truncate continent");
	$dbh->commit;
	my $sti = $dbh->prepare ("insert into continent values (?, ?)");
	$sti->execute ($_, $cont{$_}) for keys %cont;
	$sti->finish;
	$dbh->commit;
	}
    {	$dbh->do ("$truncate country");
	$dbh->commit;
	my $sti = $dbh->prepare ("insert into country values (?, ?, ?, ?, ?)");
	$sti->execute (@{$_}{qw( id name iso continent eu )}) for values %ctry;
	$sti->finish;
	$dbh->commit;
	}

    say "Reading Country  IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-Country-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
	# 1.0.0.0/24,2077456,2077456,,0,0
	$dbh->do ("$truncate ipv4");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into ipv4 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},
		};
	    $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 )});
	    });
	$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;
    }
else {
    my $sth = $dbh->prepare ("select * from continent");
    $sth->execute;
    while (my $r = $sth->fetch) {
	$cont{$r->[0]} = $r->[1];
	}
    }

$zcfn = "GeoLite2-ASN-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading Provider IPv4 info ...";
    foreach my $cnm (grep m{\bGeoLite2-ASN-Blocks-IPv4.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# network,autonomous_system_number,autonomous_system_organization
	# 1.0.0.0/24,13335,"Cloudflare, Inc."
	$dbh->do ("$truncate provider");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into provider 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		=> $_{autonomous_system_number} || undef, # All NULL
		name		=> $_{autonomous_system_organization},
		ip_from		=> $f,
		ip_to		=> $t,
		ip_from_n	=> $F,
		ip_to_n		=> $T,
		};
	    $sti->execute (@{$rec}{qw( cidr id name ip_from ip_to ip_from_n ip_to_n )});
	    });
	$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;
    }

$zcfn = "GeoLite2-City-CSV.zip";
if ($conf{update} && -s $zcfn and ($stmp{$zcfn} // -1) < (stat $zcfn)[9]) {
    my $zip = Archive::Zip->new;
    $zip->read ($zcfn)		and die "Cannot unzip $zcfn\n";
    my @cmn = $zip->memberNames	or  die "$zcfn hasd no members\n";

    say "Reading City          info ...";
    my (%country, %city);
    {	my $sth = $dbh->prepare ("select id, name from country");
	$sth->execute;
	while (my $r = $sth->fetch) { $country{$r->[1]} = $r->[0] }
	}
    foreach my $cnm (grep m{\bGeoLite2-City-Locations-en.csv$}i => @cmn) {
	my $m = $zip->memberNamed ($cnm)	or next;
	my $c = $m->contents			or next;
	# geoname_id,locale_code,continent_code,continent_name,country_iso_code,
	#   country_name,subdivision_1_iso_code,subdivision_1_name,
	#   subdivision_2_iso_code,subdivision_2_name,city_name,metro_code,
	#   time_zone,is_in_european_union
	# 5819,en,EU,Europe,CY,Cyprus,02,Limassol,,,Souni,,Asia/Nicosia,1
	$dbh->do ("$truncate city");
	$dbh->commit;
	my $n;
	my $sti = $dbh->prepare ("insert into city values (?, ?, ?, ?, ?, ?)");
	csv (in => \$c, headers => "auto", out => undef, on_in => sub {
	    ++$n % 1000 or print STDERR " $n\r";
	    my $rec = {
		id		=> $_{geoname_id},
		name		=> $_{city_name},
		country_id	=> $country{$_{country_name}},
		metro_code	=> $_{metro_code},
		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}};
	}