1 |
#!/usr/bin/perl |
2 |
|
3 |
use strict; |
4 |
use warnings; |
5 |
|
6 |
use lib qw( /data/libs/nfo/perl/libs ); |
7 |
use shortcuts qw( run_cmd ); |
8 |
use Data::Storage::Handler::File::Basic qw( s2f ); |
9 |
use Data::Mungle::Transform::String qw( getLastPart ); |
10 |
|
11 |
my $config = { baseurl => "http://cvs.netfrag.org/" }; |
12 |
my $wget = "/usr/bin/wget --quiet"; |
13 |
|
14 |
my $settings = { |
15 |
from => shift, |
16 |
to => shift, |
17 |
}; |
18 |
|
19 |
sub main { |
20 |
die("Please specify 'from'") if !$settings->{from}; |
21 |
$settings->{to} = getLastPart($settings->{from}) if !$settings->{to}; |
22 |
die("Please specify 'to'") if !$settings->{to}; |
23 |
|
24 |
buildCvsUrl(); |
25 |
die("'url' could not be built.") if !$settings->{url}; |
26 |
|
27 |
print "Fetching '$settings->{from}' from '$settings->{url}' to '$settings->{to}'.\n"; |
28 |
|
29 |
my $status = fetchurl($settings->{url}, $settings->{to}); |
30 |
#s2f($to, $doc); |
31 |
} |
32 |
|
33 |
sub buildCvsUrl { |
34 |
return if !$settings->{from}; |
35 |
$settings->{from} =~ s/^--cvs=//; |
36 |
$settings->{url} = $config->{baseurl} . $settings->{from}; |
37 |
} |
38 |
|
39 |
sub fetchurl { |
40 |
my $url = shift; |
41 |
my $target = shift; |
42 |
my $result = 1; |
43 |
my $cmd = "$wget --mirror $url --output-document=$target"; |
44 |
run_cmd($cmd); |
45 |
return $result; |
46 |
} |
47 |
|
48 |
main(); |
49 |
|
50 |
1; |