view release on metacpan or  search on metacpan

script/maint_ip_world_db  view on Meta::CPAN

            # "http://geolite.maxmind.com/download/geoip/database/GeoIPCountryCSV.zip"
           );
# file names within the archives
my @FNS = ("worldip.en.txt",
           # "GeoIPCountryWhois.csv"
          );

my @moname = ('Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
              'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec');
my $mainpack = 'L';
my ($testing, $dual_out, $resp, $dd);

# look for options (-testing, -dual_out, -user "user", -p "password")
my $i=0;

for (@ARGV) {
  if      (/^--?t/) {
    $testing = 1;
    $dd = 'blib/lib/auto/IP/World/';
  } elsif (/^--?d/) {
    $dual_out = 1;
    $dd = 'lib/auto/IP/World/';
    if (!-d $dd) {$dd = ''}
    $mainpack = 'V';
  }
  $i++;
}
# get the destination directory, make path to our output file
if (!$testing && !$dual_out) {
  # a production check-for-update run!
  eval "require IP::World";
  if ($@) {die "Can't load IP::World -- $@"}
  $dd = module_dir('IP::World') or die "Can't get the destination directory";
  $dd .= '/';
}
my $replfn = $dd.FN.($dual_out ? ".le" : ".dat");
my $replfn_exists = -e $replfn;
my $replMod = $replfn_exists ? (CORE::stat $replfn)[9] : 0;

# blow up in bad calling situations
if ($testing && $dual_out
 || $testing && !$replfn_exists) {
  die "bad call: -[-]t... and -[-]d, or -[-]t... and no included database";
}
my $outfn = $dd.FN.".".($replfn_exists ? 'tmp'
                                       : $dual_out ? 'le' : 'dat');
my $outfn2;
if ($dual_out) {
  $outfn2 = $dd.FN.".".($replfn_exists ? 'tbe' : 'be');
}

# create the user-agent object via the package at the start of this file
my $ua = LWP::UserAgent->new (timeout => 30);
# MaxMind occasionally block LWP::UserAgent's default User-Agent header,
# but I've been told that they don't mind if we lie. This one taken from
# a real browser during one of those outages worked OK
#    -- DCANTRELL
$ua->agent('Mozilla/5.0 (Macintosh; Intel Mac OS X 10_11_5) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/52.0.2743.116 Safari/537.36');

# only proxy handling is via environment variables
if ($ENV{http_proxy} || $ENV{HTTP_PROXY}) {$ua->env_proxy}

# if we have a file already, get mod times of the data sources
my $latestMod = 0;
if ($replfn_exists) {
  for my $url (@URLS) {
    $resp = $ua->head($url);
    if (!$resp->is_success) {
      die "Source file $url could not be found: ".status_message($resp->code);
    }
    $_ = $resp->last_modified;
    if ($_ > $latestMod) {$latestMod = $_}
} }
# we will build a new database if we're testing,
#   or either of the two sources is newer than our current DB
my @lines = (0) x @URLS;
my $running = 1;
my $ents = '';
my @ccs = ();
my @prevLast = (-1) x @URLS;
my $lastOut = -1;
my $unknowns = 0;
my $lastcc = '';

# all of these will be the same size as @URLS
my (@in, @start, @last, @cc, @fns);

if (!$replfn_exists
 || $latestMod > $replMod) {

  # we are going to build a new database or two
  # GET the file from each source into the dest dir, open them for reading
  for ($i=0; $i < @URLS; $i++) {

    if ($URLS[$i] !~ m'([^/]+)$') {die "Can't find base file name in $URLS[$i]"}
    my $fn = $dd.$1;

    # read the source archives from the internet
    $resp = $ua->get($URLS[$i], ':content_file' => $fn);
    if (!$resp->is_success) {
      die "Source file $URLS[$i] could not be fetched: "
          . status_message($resp->code);
    }
    # maintain the latest mod time among the sources
    $_ = $resp->last_modified;
    if ($_ > $latestMod) {$latestMod = $_}

    # save the file name
    push @fns, $fn;

    # open the subfile of the .zip archive that we want, through a pipe
    # if '.gz' files need to be added to the source lists,
    #  this will get more complicated
    open ($in[$i], "-|", "unzip", '-cq', $fn, $FNS[$i])
      or die "Can't open $fn for read: $!";
  }

  # start by reading the first record of each file
  for ($i=0; $i < @URLS; $i++) {getLine($i)}

  my ($minI, $lastCurr);