#!/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://cars.uchicago.edu/~ravel/
##
##       The latest versions of Athena, Artemis, and horae_update
##                      can always be found at
##               http://cars.uchicago.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 Argonne National 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 (including Mac OSX).  This is not
## the way to update the horae package on Windoze machine.
##
######################################################################


##use strict;
use Getopt::Long;
use XML::Simple;

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

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 known to carry the tarball
        --file         specify previously downloaded tarball
        --force        download and install, igoring comparison of version
                          numbers on the server and the local machine
        --auto         loop through available mirrors to find a download,
                          this is useful for cron jobs
        --prefix       specify an installation location

The only good way to know which mirror might be carrying the tarball
is to run this script once or to check on the SourceForge web site.

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.11\n";
print STDOUT " = Attempting SourceForge mirror $mirror\n" if ($mirror);
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   => "feff.phys.washington.edu", # deprecated
	     path   => "software/exafs/packages",  # deprecated
	     dir    => 'http://sourceforge.net/export/rss2_projfiles.php?group_id=80919',
	     latest => 0,
	    );

## fetch a directory listing from the main SF site
print STDOUT " = Attempting to fetch a release listing from\n =    $horae{dir}\n";
my $content;
my $rss;   # hash_ref holding contents of RSS file from SF
my $response = $ua->get($horae{dir});
if ($response->is_success) {
  $content = $response->content;
  $rss = XMLin($content);	# slurp RSS file into hash
} 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 ($rss->{channel}->{item}->[0]->{title} =~ /(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 and $file){
  print STDOUT "*  Forcing installation of $file, as requested\n\n";
} elsif ($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;
my $found_tarbell = 1;
if ($file and (-e $file) and (-s $file)) {
  print STDOUT "*  using tarball $file as requested\n";
  $horae{latest} = $1 if ($file =~ /(.+)\.tar\.gz/);
  $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;
} elsif (not $mirror) {
  $found_tarball = 0;
} else {
  ## unlink any previous attempt to download this file, unless explicitly using the existing version
  unlink "$horae{latest}.tar.gz";
  my $success = fetch($mirror, $horae{latest});
  if ($success) {
    open ISHTML, "$horae{latest}.tar.gz";
    my $this = <ISHTML>;
    ($found_tarball = 0) if ($this =~ /html/i);
    close ISHTML;
    unlink "$horae{latest}.tar.gz";
  }
};

if (not $found_tarball) {
  ## 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 flag will loop through these until
  ## it finds the tarball, otherwise a menu is presented to the user.
  $ua -> mirror("http://prdownloads.sourceforge.net/ifeffit/$horae{latest}.tar.gz?download",
		"...horae.sites");
  my @sites = ();
  my $choices = "";
  my $i = 0;
  open F, "...horae.sites";
  my $mirrors = 0;
  while (<F>) {
    ($mirrors = 1) if (/Download Mirrors/);
    ($mirrors = 2) if (/Select Preferred Mirror/);
    last if ($mirrors == 2);
    next if ($mirrors == 0);
    next unless (/<td><a href=/);
    ++$i;
    my $city = <F>;
    $city = substr($city, 6, -6);
    $city =~ s/^\s+//;
    my $continent = <F>;
    $continent = substr($continent, 6, -6);
    my $name = <F>;
    ($name = $1) if ($name =~ /use_mirror=(.+)\"/);
    my $url = $name . ".dl.sourceforge.net/sourceforge/ifeffit/";
    push @sites, [$city, $continent, $name, $url];
    $choices .= sprintf "%2d %-27s %-15s  (%s)\n", $i, $city, $continent, $name;
  };
  close F;
  unlink ("...horae.sites");
  die "\n\nCould not find any SourceForge servers with the latest tarball.\nYou might want to try manually downloading from SourceForge.\n" unless @sites;

  my $choice = 0;
  if ($auto) {
    foreach my $s (@sites) {
      print "*  Trying to fetch from $s->[2] in $s->[0]\n";
      my $success = fetch($s->[2], $horae{latest});
      last if $success;
    };
    die "Could not download the tarball on any server\n" unless (-e "$horae{latest}.tar.gz");
  } else {
    while (($choice < 1) or ($choice > $i)) {
      print "\n\nThe horae tarball has not yet been found.\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+/);
    };
    my $cc = $choice -1;
    print "\nYou chose $sites[$cc]->[0]\n";
    my $success = fetch($sites[$cc]->[2], $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") or $used_preexisting);

## 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";
if ($prefix) {
  @ARGV = ("--prefix=$prefix");
  print STDOUT " **      installing to prefix=$prefix\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!  That's not a 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>]
                 [--prefix=<path>] [--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.11.

=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>

Specify a SourceForge server known to carry the tarball.  This flag
can be used to avoid the interactive step of choosing the mirror from
the list of available mirrors.  If the tarball is not carried by that
server, the interactive step will happen.  See the C<--auto> flag for
another way of avoiding the interactive step.

=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.

=item --prefix=</installation/path>

If you want the horae package installed to a particular location, use
this command line argument.  It's value is passed along to
Makefile.PL, which will use this as the installation location and
write out short scripts for inclusion in your login scrips.

=back

=head1 TO DO

=over 4

=item 1

Use Archive::Tar rather than a system call for unpacking the tarball.
Note that A::T has been installed if the CPAN has been installed.

=back

=head1 RELEASE HISTORY

  0.11 (11 December 2005) Using RSS file from SF to determine current
       version number.  Modified interaction with mirrors.  Tweak
       screen scraper for determining mirrors carrying tarball.
  0.10 (14 September 2005) Added a --prefix flag that gets passed
       along to Makefile.PL
  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://cars.uchicago.edu/~ravel/software/exafs/>

copyright (c) 2004-2005 Bruce Ravel

=cut