Geo::Postcodes::Update - Helper module for keeping the postcodes up to date

 #! /usr/bin/perl -w
 use strict;
 use Geo::Postcodes::Update;

 my $class     = 'NO';
 my $file      = 'tilbud5';
 my $url       = 'http://epab.posten.no/Norsk/Nedlasting/_Files/tilbud5';
 my $procedure = \&parse_no;
 my $update    = @ARGV && $ARGV[0] eq "-update";

 Geo::Postcodes::Update::update($class, $file, $url, $procedure, $update);

 sub parse_no
 {
   my @in = @_;
   my @out;
   ...
   return @out;
 }

package Geo::Postcodes::Update;

#################################################################################
#                                                                               #
#           This file is written by Arne Sommer - perl@bbop.org                 #
#                                                                               #
#################################################################################

use strict;
use warnings;

use LWP::Simple (); 

our $VERSION = '0.311';

#################################################################################

sub update
{
  my $module_name   = shift;
  my $file_name     = shift;
  my $full_url      = shift; # Can be 'undef'
  my $procedure     = shift;
  my $update        = shift; # Do not update the module, but show the resulting perl code.

  $module_name = "$module_name.pm" unless $module_name =~ /\.pm$/;
 
  unless (-e $module_name)
  {
    if (-e "lib/Geo/Postcodes/")
    {
      chdir("lib/Geo/Postcodes/");
    }
    elsif (-e "../lib/Geo/Postcodes/")
    {
      chdir("../lib/Geo/Postcodes/");
    }
  }

  die("Unable to find '$module_name'") unless -e $module_name;

  my $in = "../../../misc/$file_name";

  my $downloaded = 0;

  unless (-e $in)
  {
    print "The file 'misc/$file_name' does not exist.\n";
    $downloaded = _download_it($full_url, $in) if $full_url;
  }

  die "Unable to open the file 'misc/$file_name'.\n - Unable to update the module.\n" unless -e $in;

  unless (_update_module($module_name, $in, $procedure, $update))
  {
    unless ($downloaded)
    {
      $downloaded = _download_it($full_url, $in) if $full_url;

      _update_module($module_name, $in, $procedure, $update) if $downloaded;
    }
  }
}

################################################################################

sub _download_it
{
  my $full_url = shift;
  my $in       = shift;

  if (_ask("Do you want to download '$full_url'"))
  {
    if (-e $in)
    {
      rename($in, $in . "." . time());
    }

    if (LWP::Simple::getstore($full_url, $in))
    {
      print "Downloaded file '$full_url'.\n";
      return 1;

      print "Unable to download file '$full_url'.\n";
      return 0;
    }
  }
}

################################################################################

sub _update_module
{
  my $module_name = shift;
  my $in          = shift;
  my $procedure   = shift;
  my $update      = shift;

  my $file = $in =~ /(misc.*)/; # Get rid of the leading "../../.." to avoid confusion.

  unless ($update) # No update of the module.
  {
    print "Verbose mode; no file update.\n";
    print "----------------------------------------------------\n";
    print "## misc/update begin\n";
    print "## This data structure was auto generated on " . localtime() . ". Do NOT edit it!\n\n";

    open(IN, $in) or die "Unable to open the file $file.\n";
    my @new = &$procedure(<IN>);
    print @new;
    close IN;
    print "----------------------------------------------------\n";
    print "(Verbose mode, no file update!)\n";
    print "Run the program with the '-update' argument to update the module.\n";
    return 1;
  }

  open(OLD, $module_name) or die "Unable to open the file $module_name.\n";
  open(NEW,    ">$module_name.new") or die "Unable to open the file '$module_name.new'.\n";

  ## Copy the old file - part 1

  my $part = 1; # 1 (first) 2 (skip) 3 (last)
  my @part1;
  my @part2;    # For comparison.
  my @part3;

  foreach (<OLD>)
  {
    if (m{^\#\# misc/update begin})
    {
      $part = 2; # This part we skip.
    }
    elsif (m{^\#\# misc/update end})
    {
      $part = 3; push(@part3, $_);
    }
    elsif ($part == 1) { push(@part1, $_); }
    elsif ($part == 2) { push(@part2, $_); }
    elsif ($part == 3) { push(@part3, $_); }
  }

  close OLD;
  print NEW @part1;

  ## Update the postal info - part 2

  print NEW "## misc/update begin\n";
  print NEW "## This data structure was auto generated on " . localtime() . ". Do NOT edit it!\n\n";

  open(IN, $in) or die "Unable to open the file $file.\n";

  my @new = &$procedure(<IN>);

  print NEW @new;
  close IN;

  ## Copy the old file - part 3

  print NEW @part3;
  close NEW;

  ## Check for equality ###

  my $old_line; my $new_line;

  my $difference = 0;

  shift @part2; shift @part2; # Get rid of some initial lines.

FRCH:
  foreach $new_line (@new)
  {
    $old_line = shift(@part2) || "";
    if ($old_line ne $new_line)
    {
      $difference++;
      last FRCH;
    }
  }

  if ($difference)
  {
    my $source = "$module_name." . time;
    rename($module_name, $source) or die "Unable to rename file $module_name.\n";
    rename("$module_name.new", $module_name);
    print "The postcodes are updated in the module.\n";
    print " - The old file is available as '$source'\n";
    return 1;
  }
  else
  {
    $in =~ m{.*/(.*)}; # Drop all the leading line nose; e.g. 'tilbud5' instead of 
                       #  '../../../misc/tilbud5'.

    print "The postcodes in the module are the same as in the file '$1'.\n";
    print " - The module did not need an update.\n";
    unlink "$module_name.new";
    return 0;
  }
}

################################################################################

sub _ask
{
  my $question = shift;
  print "$question (y/n): ";
  my $answer = <STDIN>;
  return $answer =~ /y/i; # Accept Y as well.
}

################################################################################

__END__