File: horae_update

package info (click to toggle)
ifeffit 1:1.3.0-3
  • links: PTS
  • area: contrib
  • in suites: etch, etch-m68k
  • size: 13,652 kB
  • ctags: 7,237
  • sloc: fortran: 33,599; ansic: 26,405; sh: 7,184; makefile: 5,469; python: 3,273; perl: 3,146; tcl: 95
file content (501 lines) | stat: -rwxr-xr-x 18,274 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
#!/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