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; |
use Getopt::Long; |
38 |
|
use IO::Zlib; |
39 |
|
|
40 |
## LWP - |
## LWP - |
41 |
use URI (); |
use URI (); |
130 |
|
|
131 |
sub clean_unmirrored { |
sub clean_unmirrored { |
132 |
find sub { |
find sub { |
133 |
return if /\.readme$/; # don't erase readme files |
return if /\.readme.gz$/; # don't erase readme files |
134 |
check_readme($File::Find::name); |
check_readme($File::Find::name); |
135 |
return unless -f and not $mirrored{$File::Find::name}; |
return unless -f and not $mirrored{$File::Find::name}; |
136 |
print "$File::Find::name ... removed\n" if $TRACE; |
print "$File::Find::name ... removed\n" if $TRACE; |
137 |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
138 |
my $path = $File::Find::name; |
my $path = $File::Find::name; |
139 |
if ($path =~ s/(\.tar\.gz|\.tgz)/.readme/g && -f $path) { |
if ($path =~ s/(\.tar\.gz|\.tgz)/.readme.gz/g && -f $path) { |
140 |
# only if we erase archive also! |
# only if we erase archive also! |
141 |
unlink $path or warn "Cannot remove $path: $!"; |
unlink $path or warn "Cannot remove $path: $!"; |
142 |
} |
} |
148 |
my $path = shift; |
my $path = shift; |
149 |
# fixup some things |
# fixup some things |
150 |
my $readme_path = $path; |
my $readme_path = $path; |
151 |
$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! |
152 |
|
|
153 |
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"; |
154 |
|
|
155 |
if (! -f $readme_path) { |
if (! -f $readme_path) { |
156 |
# create readme file |
# create readme file |
157 |
my @readmes = sort grep m{^[^/]+/README\z}, $at->list_files(); |
my @readmes = sort grep m{^[^/]+/README\z}i, $at->list_files(); |
158 |
my $readme; |
my $readme; |
159 |
|
|
160 |
if ($readme = shift @readmes) { |
if ($readme = shift @readmes) { |
161 |
open(R, "> $readme_path") || die "Cannot create $readme_path: $!"; |
my $fh = IO::Zlib->new($readme_path, "wb"); |
162 |
print R $at->get_content($readme); |
if (defined $fh) { |
163 |
close(R); |
print $fh $at->get_content($readme); |
164 |
|
$fh->close; |
165 |
|
} else { |
166 |
|
die "Cannot create $readme_path: $!"; |
167 |
|
} |
168 |
|
|
169 |
print "$readme_path ... created\n" if $TRACE; |
print "$readme_path ... created\n" if $TRACE; |
170 |
|
|