15 |
### CONFIG |
### CONFIG |
16 |
|
|
17 |
#my $REMOTE = "http://ftp.linux.hr/CPAN/"; |
#my $REMOTE = "http://ftp.linux.hr/CPAN/"; |
18 |
my $REMOTE = "http://www.cpan.org/"; |
#my $REMOTE = "http://www.cpan.org/"; |
19 |
|
my $REMOTE = "http://cpan.pliva.hr/"; |
20 |
# my $REMOTE = "http://fi.cpan.org/"; |
# my $REMOTE = "http://fi.cpan.org/"; |
21 |
# my $REMOTE = "http://au.cpan.org/"; |
# my $REMOTE = "http://au.cpan.org/"; |
22 |
# my $REMOTE = "file://Users/merlyn/MIRROR/CPAN/"; |
# my $REMOTE = "file://Users/merlyn/MIRROR/CPAN/"; |
23 |
|
|
24 |
## warning: unknown files below this dir are deleted! |
## warning: unknown files below this dir are deleted! |
25 |
my $LOCAL = "/mirrors/cpan/CPAN/"; |
#my $LOCAL = "/mirrors/cpan/CPAN/"; |
26 |
|
my $LOCAL = "/rest/cpan/CPAN/"; |
27 |
|
|
28 |
my $TRACE = 0; |
my $TRACE = 0; |
29 |
|
|
34 |
use File::Basename qw(dirname); |
use File::Basename qw(dirname); |
35 |
use File::Spec::Functions qw(catfile devnull); |
use File::Spec::Functions qw(catfile devnull); |
36 |
use File::Find qw(find); |
use File::Find qw(find); |
37 |
|
use Getopt::Long; |
38 |
|
|
39 |
## LWP - |
## LWP - |
40 |
use URI (); |
use URI (); |
46 |
## Archive::Tar - |
## Archive::Tar - |
47 |
use Archive::Tar qw(); |
use Archive::Tar qw(); |
48 |
|
|
49 |
|
## process command-line arguments |
50 |
|
my $result = GetOptions( |
51 |
|
"local=s" => \$LOCAL, |
52 |
|
"remote=s" => \$REMOTE, |
53 |
|
"verbose!" => \$TRACE, |
54 |
|
"debug!" => \$TRACE |
55 |
|
); |
56 |
|
|
57 |
|
print "local path: $LOCAL\nremote URI: $REMOTE\n" if ($TRACE); |
58 |
|
|
59 |
## first, get index files |
## first, get index files |
60 |
my_mirror($_) for qw( |
my_mirror($_) for qw( |
61 |
authors/01mailrc.txt.gz |
authors/01mailrc.txt.gz |
135 |
print "$File::Find::name ... removed\n" if $TRACE; |
print "$File::Find::name ... removed\n" if $TRACE; |
136 |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
137 |
my $path = $File::Find::name; |
my $path = $File::Find::name; |
138 |
if ($path =~ s/\.tar\.gz/.readme/g && -f $path) { |
if ($path =~ s/(\.tar\.gz|\.tgz)/.readme/g && -f $path) { |
139 |
# only if we erase archive also! |
# only if we erase archive also! |
140 |
unlink $path or warn "Cannot remove $path: $!"; |
unlink $path or warn "Cannot remove $path: $!"; |
141 |
} |
} |
145 |
sub check_readme { |
sub check_readme { |
146 |
|
|
147 |
my $path = shift; |
my $path = shift; |
|
|
|
148 |
# fixup some things |
# fixup some things |
149 |
my $readme_path = $path; |
my $readme_path = $path; |
150 |
$readme_path =~ s/\.tar\.gz/.readme/g || return; # just .tar.gz is supported! |
$readme_path =~ s/\.(tar\.gz|\.tgz)/.readme/g || return; # just .tar.gz is supported! |
151 |
|
|
152 |
my $at = Archive::Tar->new($path) or die "Archive::Tar failed on $path\n"; |
my $at = Archive::Tar->new($path) or die "Archive::Tar failed on $path\n"; |
153 |
|
|