104 lines
2.4 KiB
Plaintext
104 lines
2.4 KiB
Plaintext
|
#!/usr/bin/perl
|
||
|
|
|
||
|
|
# Simple mirror utility using LWP
|
||
|
|
|
||
|
|
=head1 NAME
|
||
|
|
|
||
|
|
lwp-mirror - Simple mirror utility
|
||
|
|
|
||
|
|
=head1 SYNOPSIS
|
||
|
|
|
||
|
|
lwp-mirror [-v] [-t timeout] <url> <local file>
|
||
|
|
|
||
|
|
=head1 DESCRIPTION
|
||
|
|
|
||
|
|
This program can be used to mirror a document from a WWW server. The
|
||
|
|
document is only transferred if the remote copy is newer than the local
|
||
|
|
copy. If the local copy is newer nothing happens.
|
||
|
|
|
||
|
|
Use the C<-v> option to print the version number of this program.
|
||
|
|
|
||
|
|
The timeout value specified with the C<-t> option. The timeout value
|
||
|
|
is the time that the program will wait for response from the remote
|
||
|
|
server before it fails. The default unit for the timeout value is
|
||
|
|
seconds. You might append "m" or "h" to the timeout value to make it
|
||
|
|
minutes or hours, respectively.
|
||
|
|
|
||
|
|
Because this program is implemented using the LWP library, it only
|
||
|
|
supports the protocols that LWP supports.
|
||
|
|
|
||
|
|
=head1 SEE ALSO
|
||
|
|
|
||
|
|
L<lwp-request>, L<LWP>
|
||
|
|
|
||
|
|
=head1 AUTHOR
|
||
|
|
|
||
|
|
Gisle Aas <gisle@aas.no>
|
||
|
|
|
||
|
|
=cut
|
||
|
|
|
||
|
|
use strict;
|
||
|
|
use warnings;
|
||
|
|
use LWP::Simple qw(mirror is_success status_message $ua);
|
||
|
|
use Getopt::Long qw(GetOptions);
|
||
|
|
use Encode;
|
||
|
|
use Encode::Locale;
|
||
|
|
|
||
|
|
my $progname = $0;
|
||
|
|
$progname =~ s,.*/,,; # use basename only
|
||
|
|
$progname =~ s/\.\w*$//; #strip extension if any
|
||
|
|
|
||
|
|
my %opts;
|
||
|
|
unless (GetOptions(\%opts, 'h', 'v', 't=i')) {
|
||
|
|
usage();
|
||
|
|
}
|
||
|
|
|
||
|
|
if ($opts{v}) {
|
||
|
|
require LWP;
|
||
|
|
my $DISTNAME = 'libwww-perl-' . $LWP::VERSION;
|
||
|
|
die <<"EOT";
|
||
|
|
This is lwp-mirror version $LWP::Simple::VERSION ($DISTNAME)
|
||
|
|
|
||
|
|
Copyright 1995-1999, Gisle Aas.
|
||
|
|
|
||
|
|
This program is free software; you can redistribute it and/or
|
||
|
|
modify it under the same terms as Perl itself.
|
||
|
|
EOT
|
||
|
|
}
|
||
|
|
|
||
|
|
my $url = decode(locale => shift) or usage();
|
||
|
|
my $file = encode(locale_fs => decode(locale => shift)) or usage();
|
||
|
|
usage() if $opts{h} or @ARGV;
|
||
|
|
|
||
|
|
if ($opts{t}) {
|
||
|
|
if ($opts{t} =~ /^(\d+)([smh])?/) {
|
||
|
|
my $timeout = $1;
|
||
|
|
$timeout *= 60 if ($2 eq "m");
|
||
|
|
$timeout *= 3600 if ($2 eq "h");
|
||
|
|
$ua->timeout($timeout);
|
||
|
|
}
|
||
|
|
else {
|
||
|
|
die "$progname: Illegal timeout value!\n";
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
my $rc = mirror($url, $file);
|
||
|
|
|
||
|
|
if ($rc == 304) {
|
||
|
|
print STDERR "$progname: $file is up to date\n";
|
||
|
|
}
|
||
|
|
elsif (!is_success($rc)) {
|
||
|
|
print STDERR "$progname: $rc ", status_message($rc), " ($url)\n";
|
||
|
|
exit 1;
|
||
|
|
}
|
||
|
|
exit;
|
||
|
|
|
||
|
|
|
||
|
|
sub usage {
|
||
|
|
die <<"EOT";
|
||
|
|
Usage: $progname [-options] <url> <file>
|
||
|
|
-v print version number of program
|
||
|
|
-t <timeout> Set timeout value
|
||
|
|
EOT
|
||
|
|
}
|