27 |
|
|
28 |
my $TRACE = 0; |
my $TRACE = 0; |
29 |
|
|
30 |
|
# This may or may not save you some disks space (depending on filesystem |
31 |
|
# that you use to store CPAN mirror) |
32 |
|
# |
33 |
|
# If you want to create gziped readme files, change $readme_ext to |
34 |
|
# my $readme_ext = '.readme.gz'; |
35 |
|
# |
36 |
|
# I found out that gziping readme files doesn't save any |
37 |
|
# space at one server and saves space on my laptop. YMMV |
38 |
|
my $readme_ext = '.readme.gz'; |
39 |
|
|
40 |
### END CONFIG |
### END CONFIG |
41 |
|
|
42 |
## core - |
## core - |
140 |
|
|
141 |
sub clean_unmirrored { |
sub clean_unmirrored { |
142 |
find sub { |
find sub { |
143 |
return if /\.readme.gz$/; # don't erase readme files |
return if /${readme_ext}$/; # don't erase readme files |
144 |
check_readme($File::Find::name); |
check_readme($File::Find::name); |
145 |
return unless -f and not $mirrored{$File::Find::name}; |
return unless -f and not $mirrored{$File::Find::name}; |
146 |
print "$File::Find::name ... removed\n" if $TRACE; |
print "$File::Find::name ... removed\n" if $TRACE; |
147 |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
unlink $_ or warn "Cannot remove $File::Find::name: $!"; |
148 |
my $path = $File::Find::name; |
my $path = $File::Find::name; |
149 |
if ($path =~ s/(\.tar\.gz|\.tgz)/.readme.gz/g && -f $path) { |
if ($path =~ s/(\.tar\.gz|\.tgz)/${readme_ext}/g && -f $path) { |
150 |
# only if we erase archive also! |
# only if we erase archive also! |
151 |
unlink $path or warn "Cannot remove $path: $!"; |
unlink $path or warn "Cannot remove $path: $!"; |
152 |
} |
} |
158 |
my $path = shift; |
my $path = shift; |
159 |
# fixup some things |
# fixup some things |
160 |
my $readme_path = $path; |
my $readme_path = $path; |
161 |
$readme_path =~ s/\.(tar\.gz|\.tgz)/.readme.gz/g || return; # just .tar.gz is supported! |
$readme_path =~ s/\.(tar\.gz|\.tgz)/${readme_ext}/g || return; # just .tar.gz is supported! |
162 |
|
|
163 |
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"; |
164 |
|
|
168 |
my $readme; |
my $readme; |
169 |
|
|
170 |
if ($readme = shift @readmes) { |
if ($readme = shift @readmes) { |
171 |
my $fh = IO::Zlib->new($readme_path, "wb"); |
my $fh; |
172 |
|
if ($readme_ext =~ m/\.gz/) { |
173 |
|
$fh = IO::Zlib->new($readme_path, "wb"); |
174 |
|
} else { |
175 |
|
$fh = IO::File->new($readme_path, "w"); |
176 |
|
} |
177 |
if (defined $fh) { |
if (defined $fh) { |
178 |
print $fh $at->get_content($readme); |
print $fh $at->get_content($readme); |
179 |
$fh->close; |
$fh->close; |