#!/usr/bin/perl -w
######################################################################
## horae_update: network updater for athena, artemis, and hephaestus
##
##          horae_update is copyright (c) 2004-2005 Bruce Ravel
##                              ravel _A_T_ phys.washington.edu
##                      http://feff.phys.washington.edu/~ravel/
##
##       The latest versions of Athena, Artemis, and horae_update
##                      can always be found at
##           http://feff.phys.washington.edu/~ravel/software/
##
## -------------------------------------------------------------------
##     All rights reserved. This program is free software; you can
##     redistribute it and/or modify it provided that the above notice
##     of copyright, these terms of use, and the disclaimer of
##     warranty below appear in the source code and documentation, and
##     that none of the names of The Naval Research Laboratory, The
##     University of Chicago, University of Washington, or the authors
##     appear in advertising or endorsement of works derived from this
##     software without specific prior written permission from all
##     parties.
##
##     THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
##     EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
##     OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
##     NONINFRINGEMENT.  IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
##     HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
##     WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
##     FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
##     OTHER DEALINGS IN THIS SOFTWARE.
## -------------------------------------------------------------------
######################################################################
##
## This script is for unix systems!
##
######################################################################


##use strict;
use Getopt::Long;

my ($force, $file, $proxy, $timeout, $mirror, $auto) = (0,0,"",30,"",0);
&GetOptions(help       => \&usage,
	    h	       => \&usage,
	    force      => \$force,
	    auto       => \$auto,
	    "file=s"   => \$file,
	    "proxy=s"  => \$proxy,
	    "mirror=s" => \$mirror,);

sub usage {
  print <<EOH
horae_update : automated web updater for athena, artemis, and hephaestus

usage: horae_update [--force] [--proxy=<URL>] [--timeout=<seconds>]
                    [--mirror=<mirror>] [--file=<tarball>] [--help] [-h]

        option          effect
      -----------------------------------
        --help, -h     print usage message and exit
        --proxy        specify a proxy server
        --timeout      specify a timeout in seconds (default=30)
        --mirror       SourceForge mirror
        --file         specify previously downloaded tarball
        --force        download and install, igoring comparison of version
                          numbers on the server and the local machine

The available SourceForge mirrors are aleron (Reston, VA, USA), belnet
(Brussels, Belgium), umn (Minneapolis, MN, USA), unc (Chapel Hill, NC,
USA), heanet (Dublin, Ireland), ovh (Paris, France), puzzle (Bern,
Switzerland), optusnet (Sydney, Australia), and voxel (New York, New
York, USA).  aleron is the default.

Do "perldoc horae_update" for more information

EOH
  ;
  exit;
};

## need to see what version of the tarball is already installed,
## taking care with the cases of it not being installed and of a
## version prior to 020 being installed
my $already_installed = eval "require Ifeffit::Tools;";
my $installed_version = 0;
if ($already_installed) {
  no warnings;
  import Ifeffit::Tools;
  $installed_version = $Ifeffit::Tools::VERSION;
  ($installed_version = 0) if ($installed_version =~ /^\s*$/);
  if ($installed_version =~ /(.+)(\d)rc(\d+)/) {
    ## if the installed version is 034rc1, this is translated to
    ## 033.1.  that way it will get installed if 033 in on the
    ## machine, but not if 034 is on.
    $installed_version = $1 . $2-1 . "." . $3;
  };
};

## write progress to a log file
$| = 1;
open STDOUT, "| tee horae_update.log";


## set the sourceforge mirror
$mirror ||= 'aleron';
$mirror = lc($mirror);
my %location = (aleron	 => "Reston, VA, USA",
		belnet	 => "Brussels, Belgium",
		umn	 => "Minneapolis, MN, USA",
		unc	 => "Chapel Hill, NC, USA",
		heanet	 => "Dublin, Ireland",
		ovh	 => "Paris, France",
		puzzle	 => "Bern, Switzerland",
		optusnet => "Sydney, Australia",
		voxel	 => "New York, New York, USA",
	       );
my $location_regex = join("|",keys(%location));
($mirror = 'aleron') unless ($mirror =~ /^($location_regex)$/);


print STDOUT " = Horae Updater (using LWP::UserAgent) version 0.9\n";
print STDOUT " = Using SourceForge mirror $mirror ($location{$mirror})\n";
print STDOUT " = Using proxy server $proxy\n" if $proxy;
print STDOUT " = Timeout = $timeout seconds\n";

## We are going to need LWP.  Check to see if it is there, if it is
## not and root is running this script, fetch LWP from CPAN.
unless (defined (eval "require LWP::UserAgent;")) {
  if ( $> ) {
    print STDOUT <<EOH

    *** You need to install perl\'s web services modules.
    *** The easiest way to do this is to become root and
    *** then issue this command:
    ***      perl -MCPAN -e shell
    *** then, at the CPAN prompt, type
    ***      install LWP

EOH
  ;
    die "\n";
  } else {
    print STDOUT <<EOH

 = Hmmm.... you do not seem to have perl\'s web services installed
 = I am going to attempt to load the CPAN module and grab LWP
 = from a nearby CPAN site.  If you have never used CPAN before,
 = you may need to answer some questions.  This requires that you
 = have access to the internet.

EOH
  ;
    print STDOUT "*  Shall I go ahead and try CPAN?  (y/n) ";
    my $yn = <>;
    exit unless ($yn =~ /^y/i);
    require CPAN;
    CPAN::Shell->install("LWP");
  };
  unless (defined (eval "require LWP::UserAgent;")) {
    die " = Apparently attempting to fetch LWP from CPAN didn't work.  I give up!\n";
  };
};


## since we have successfully imported LWP, set up the user agent for
## use in this transfer, set the prozy and timeout
import LWP::UserAgent;
my $ua = LWP::UserAgent->new;
## what about the HTTP_PROXY or CGI_HTTP_PROXY environment variables...?
$ua->proxy('http', $proxy) if $proxy;
$ua->timeout($timeout);

## set some variables about where to find the horae tarball on the web
my %horae = (site => "cars9.uchicago.edu",
	     path => "software/exafs/packages",);
##$horae{dir} = "http://$horae{site}/~ravel/$horae{path}/";
$horae{dir} = 'http://sourceforge.net/project/showfiles.php?group_id=80919&package_id=110138';
my $content;

## fetch a directory listing from the main SF site
print STDOUT " = Attempting to fetch a directory listing from\n =    $horae{dir}\n";
my $response = $ua->get($horae{dir});
if ($response->is_success) {
  $content = $response->content;
} else {
  print STDOUT $response -> message;
  die "could not fetch $horae{dir} from server\n";
};

## compare the SF version with the version on this computer
($horae{latest} = $1) if ($content =~ /(horae-\d+)/);
die " *** Yikes!  Apparently no horae tarballs were found at SourceForge!\n" unless $horae{latest};
my $version = (split(/-/, $horae{latest}))[1];
unless ($force) {
  unless ($version > $installed_version) {
    warn "\n**  Well, the current version on the server is $horae{latest} and you\n";
    warn "    appear to be running horae-$Ifeffit::Tools::VERSION.\n";
    die  "            exiting...\n";
  };
};

## dispatch a note about the up/downgrade to come
print STDOUT "\n*  Found the latest version as $horae{latest}\n";
if ($version > $installed_version) {
  print STDOUT "   Upgrading from version horae-$Ifeffit::Tools::VERSION\n\n";
} else {
  print STDOUT "   Downgrading from version horae-$Ifeffit::Tools::VERSION\n\n";
};


## the --force option should override using the file found in the CWD
## (see if/elsif block just below)
if ($force) {
  unlink "$horae{latest}.tar.gz" if (-e "$horae{latest}.tar.gz");
  print STDOUT "*  Forcing installation of $horae{latest}.tar.gz from the server, as requested\n\n";
};


my $used_preexisting = 0;
if ($file and (-e $file) and (-s $file)) {
  print STDOUT "*  using tarball $file as requested\n";
  $used_preexisting = 1;
} elsif ((-e "$horae{latest}.tar.gz") and (-s "$horae{latest}.tar.gz")) {
  print STDOUT "*  It seems you have already downloaded the tarball.  I'll use the\n";
  print STDOUT "   one that's already here\n";
  $used_preexisting = 1;
} else {
  ## loop though the servers looking for one that responds
  foreach my $site ($mirror, keys(%location)) {
    my $success = fetch($site, $horae{latest});
    last if $success;
  };
};

## if the selected server responds but does not have the tarball, then
## SF responds with a web page asking the user to choose a different
## mirror.  I have to scrape this web page to get a selection of
## available mirrors.  The --auto falg will loop through these until
## it finds the tarball, other wise a menu is presented to the user.
open ISHTML, "$horae{latest}.tar.gz";
my $this = <ISHTML>;
my ($i, $choices, @sites, @locations) = (0, "", (), ());
if ($this =~ /html/i) {
  while (<ISHTML>) {
    while (/<TD align=center>([^<>]*?)<\/TD><TD align=center>([^<>]*?)<\/TD><TD align=center><A HREF=\/ifeffit\/horae-\d+.tar.gz\?.*?use_mirror=([^>]*)/gi) {
      ++$i;
      $sites[$i] = $3;
      $locations[$i] = "$1, $2";
      $locations[$i] =~ s/^\s+//;
      $choices .= sprintf "%2d %-15s  (%s)\n", $i, $sites[$i], $locations[$i];
    };
  };
  die "\n\nCould not find any SourceForge servers with the latest tarball.\nYou might want to try manually downloading from SourceForge.\n" unless @sites;
  close ISHTML;
  my $choice = 0;
  if ($auto) {
    foreach my $s (0..$#sites) {
      print "Trying to fetch from $sites[$s] in $locations[$s]\n";
      my $success = fetch($sites[$s], $horae{latest});
      last if $success;
    };
  } else {
    while (($choice < 1) or ($choice > $i)) {
      print "\n\nThe horae tarball could not be found at your selected server.\n\n";
      print "Please choose from one of the following servers: (1 - $i or q to quit)\n\n";
      print $choices;
      print "Your choice> ";
      $choice = <STDIN>;
      exit if (lc($choice) =~ /^\s*[eqx]/);
      ($choice = 0) unless ($choice =~ /\d+/);
    };
    print "\nYou chose $sites[$choice]\n";
    my $success = fetch($sites[$choice], $horae{latest});
  };
};

if ($used_preexisting) {
  print STDOUT "**  Extracting package files from $horae{latest}.tar.gz\n\n";
  my $unpack = system "gzip -dc $horae{latest}.tar.gz | tar xf -";
  ## test return value of that system call
  if ($unpack) {
    warn "**  Uh oh!  There was trouble unpacking the pre-existing tarball.\n";
    die  "            exiting...\n";
  };
};


die " AARGH!  Could not find a copy of the tarball at any SourceForge server!\n"
  unless (-e "$horae{latest}.tar.gz");

## the package has been downloaded and unpacked at this point, so cd
## to the directory and build the package
print STDOUT "\n*  Changing directory to $horae{latest}\n\n";
chdir $horae{latest};
print STDOUT "*  Beginning build incantation \"perl Makefile.PL; make; make install\"\n";
print STDOUT "**    (perl Makefile.PL)\n";
do "Makefile.PL";
print STDOUT "**    (make)\n";
system "make";
if ( $> ) {
  print STDOUT <<EOH

**  You must be root to install the horae programs.
    Become root, then issue this command:
          make install
    in the $horae{latest} directory.

EOH
  ;
} else {
  print STDOUT "**    (make install)\n";
  system "make install";
};

## all done!
print STDOUT "\n\n*           All done!\n";


## attempt to download and unpack a tarball.  return 1 upon success.
## return 0 is the tarball cannot be downloaded or if the file
## downloaded is not a tarball.
sub fetch {
  ## args: SF mirror, horae-NNN version
  my ($site, $horae) = @_;
  my $url = 'http://' . $site .'.dl.sourceforge.net/sourceforge/ifeffit/' . $horae . '.tar.gz';
  print STDOUT "*  Attempting to fetch the latest tarball from\n      $url\n";
  my $response = $ua->mirror("$url", "$horae.tar.gz");
  if ($response->is_success) {
    print STDOUT "\n**  Wrote file $horae.tar.gz\n";
    ## unzip and untar the tarball
    print STDOUT "**  Extracting package files from $horae.tar.gz\n";
    my $unpack = system "gzip -dc $horae.tar.gz | tar xf -";
    ## test return value of that system call
    if ($unpack) {
      print STDOUT "**  Uh oh!  There was trouble unpacking the tarball.\n";
      return 0;
    };
    return 1;
  } else {
    print STDOUT "**  ", $response -> message, $/;
    print STDOUT "**  Could not fetch $horae.tar.gz from $site\n";
    return 0;
  };
};


__END__


=head1 NAME

HORAE_UPDATE - A network updater for athena, artemis, and hephaestus

=head1 SYNOPSIS

    horae_update [--force] [--proxy=<URL>] [--timeout=<seconds>]
                 [--mirror=<mirror>] [--auto] [--file=<tarball>]
                 [--help] [-h]


The horae_update script is used to check a web repository for the
latest version of the horae package and download that package if it is
more recent than what is installed on the local machine.  This script
can be run by hand from the command line or as a periodic, scheduled
process (such as a cron job).

The script gets the listing of horae package releases from SourceForge
and scrapes that web page for the most recent release.  If the local
machine needs to be updated, a SourceForge mirror will be contacted
for downloading the package.  Once downloaded, this script will upack
the package and install it using the standard procedures for
installing perl packages.

The full installation requires that the script is run as root.  If run
as a normal user, the package will be downloaded, upacked, and built,
but not installed.

The script uses the LWP package, which is the set of Perl modules for
doing network programming.  If they are not found on the local
machine, the CPAN module will be run in an attempt to download and
install LWP.  That requires running the script as root.

This is horae_update version 0.9.

=head1 COMMAND LINE OPTIONS

=over 4

=item --help, -h

Write a note about the command line switches to the screen and quit.

=item --force

This causes the script to ignore the comparison between the currently
installed version and the version on SourceForge.  With this switch,
the most recent version on SourceForge will be downloaded and
installed regardless of the version on the local machine.

=item --proxy=<URL>

If the local machine must connect to a proxy, use this command line
argument to specify the proxy server.  The argument should be the URL
of the proxy server.

=item --timeout=<time_in_seconds>

Set the timeout for the user agent.  The default is 30 seconds.  After
this time, the agent will give up on the current SourceForge server
and try the next one in the list.  If you make this too short, it is
possible that no server will work.  If you make it too long, you may
get bored waiting for the updater to finish.  You may consider setting
this longer than 30 seconds if you are in a continent without a
SourceForge server.

=item --mirror=<site>

By default the Aleron SourceForge mirror in Reston, VA, USA is used.
One of the other mirrors can be specified with this argument.  The
allowed values are

   aleron    Reston, VA, USA
   umn       Minneapolis, MN, USA
   unc       Chapel Hill, NC, USA
   voxel     New York, New York, USA
   belnet    Brussels, Belgium
   heanet    Dublin, Ireland
   ovh	     Paris, France
   puzzle    Bern, Switzerland
   optusnet  Sydney, Australia


=item --auto

If the tarball is not found at the selected mirror, SourceForge
returns a web page asking for a selection from a list of mirrors that
do have the tarball.  The default behavior of the script is to present
a menu asking you to choose from the available servers.  If
horae_update is run with the --auto flag, it will loop through the
available servers until the tarball is found.  The advantage of the
--auto flag is that is makes horae_update suitable for a cron job.
The disadvantage is that it may try to grab the tarball from someplace
very distant.  If you run the updater by hand, I recommend you not use
this flag.  If you run it as a cron job, you B<must> use this flag.

=item --file=<file>

If you have downloaded the latest package by some other means, you can
specify it with this argument.  In that case, the downloading is
skipped and this file is unpacked, built, and installed.

=back

=head1 TO DO

=over 4

=item 1

Use Archive::Tar rather than a system call for unpacking the tarball.

=back

=head1 RELEASE HISTORY

  0.9 (25 April, 2005) Added a screen scraper to present a menu of
      available mirrors if the default does nothave the tarball.
      Added the --auto flag.
  0.8 (13 October 2004) Fixed a print-related bug that prevented the
      script from doing the "make install" step.  Removed the --devel
      switch.
  0.7 (3 August, 2004) Update to include new SF servers.  Cycle
      through SF servers looking for one that answers.  Added a
      configurable timeout.  Added the --devel switch.
  0.6 (25 May, 2004) Switch to LWP::UserAgent and add --proxy
      argument, use SourceForge rather than Univ. of Washington for
      downloads, add --mirror argument, wrote a pod
  0.5 (12 April, 2004) Handle installed versions with rc in their
      version numbers
  0.4 (11 December, 2003) Changed some language and added markup so
      that the log can be read efficiently using outline-mode in emacs
  0.3 (6 May, 2003) Compare version numbers on local host and on
      server, also check to see if a tarball is already in CWD, allow
      several options (--help, --force, and --file) using Getopt::Long,
      test return value of system call to unpack archive
  0.2 (31 January, 2003) Use getstore function and check HTTP status,
      improved regex for distinguishing a tarball from any other file
      with the string "horae" in it
  0.1 (28 January, 2003) Initial release


=head1 AUTHOR

Bruce Ravel, bravel_REMOVE_THIS_@anl.gov

L<http://cars9.uchicago.edu/~ravel/software/exafs/>

copyright (c) 2004-2005 Bruce Ravel

=cut