--- mirror_cpan.pl 2003/02/01 00:51:51 1.2 +++ mirror_cpan.pl 2004/01/20 19:48:05 1.5 @@ -15,7 +15,8 @@ ### CONFIG #my $REMOTE = "http://ftp.linux.hr/CPAN/"; -my $REMOTE = "http://www.cpan.org/"; +#my $REMOTE = "http://www.cpan.org/"; +my $REMOTE = "http://cpan.pliva.hr/"; # my $REMOTE = "http://fi.cpan.org/"; # my $REMOTE = "http://au.cpan.org/"; # my $REMOTE = "file://Users/merlyn/MIRROR/CPAN/"; @@ -33,6 +34,8 @@ use File::Basename qw(dirname); use File::Spec::Functions qw(catfile devnull); use File::Find qw(find); +use Getopt::Long; +use IO::Zlib; ## LWP - use URI (); @@ -44,6 +47,16 @@ ## Archive::Tar - use Archive::Tar qw(); +## process command-line arguments +my $result = GetOptions( + "local=s" => \$LOCAL, + "remote=s" => \$REMOTE, + "verbose!" => \$TRACE, + "debug!" => \$TRACE + ); + +print "local path: $LOCAL\nremote URI: $REMOTE\n" if ($TRACE); + ## first, get index files my_mirror($_) for qw( authors/01mailrc.txt.gz @@ -117,13 +130,13 @@ sub clean_unmirrored { find sub { - return if /\.readme$/; # don't erase readme files + return if /\.readme.gz$/; # don't erase readme files check_readme($File::Find::name); return unless -f and not $mirrored{$File::Find::name}; print "$File::Find::name ... removed\n" if $TRACE; unlink $_ or warn "Cannot remove $File::Find::name: $!"; my $path = $File::Find::name; - if ($path =~ s/(\.tar\.gz|\.tgz)/.readme/g && -f $path) { + if ($path =~ s/(\.tar\.gz|\.tgz)/.readme.gz/g && -f $path) { # only if we erase archive also! unlink $path or warn "Cannot remove $path: $!"; } @@ -135,19 +148,23 @@ my $path = shift; # fixup some things my $readme_path = $path; - $readme_path =~ s/\.(tar\.gz|\.tgz)/.readme/g || return; # just .tar.gz is supported! + $readme_path =~ s/\.(tar\.gz|\.tgz)/.readme.gz/g || return; # just .tar.gz is supported! my $at = Archive::Tar->new($path) or die "Archive::Tar failed on $path\n"; if (! -f $readme_path) { # create readme file - my @readmes = sort grep m{^[^/]+/README\z}, $at->list_files(); + my @readmes = sort grep m{^[^/]+/README\z}i, $at->list_files(); my $readme; if ($readme = shift @readmes) { - open(R, "> $readme_path") || die "Cannot create $readme_path: $!"; - print R $at->get_content($readme); - close(R); + my $fh = IO::Zlib->new($readme_path, "wb"); + if (defined $fh) { + print $fh $at->get_content($readme); + $fh->close; + } else { + die "Cannot create $readme_path: $!"; + } print "$readme_path ... created\n" if $TRACE;