Initial class construction
This commit is contained in:
103
Git/usr/bin/vendor_perl/lwp-mirror
Normal file
103
Git/usr/bin/vendor_perl/lwp-mirror
Normal file
@ -0,0 +1,103 @@
|
||||
#!/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
|
||||
}
|
Reference in New Issue
Block a user