Added fb2_rezip-2-f.pl forking multiprocess flavour of fb2_rezip-2.pl
This commit is contained in:
eleksir
186
fb2_rezip-2-f.pl
Normal file
186
fb2_rezip-2-f.pl
Normal file
@@ -0,0 +1,186 @@
|
|||||||
|
#!/opt/bin/perl
|
||||||
|
|
||||||
|
# recompress all .zip-files in current dir to Books/*/*/*.zip dir tree: 1 file per zip archive entity
|
||||||
|
#
|
||||||
|
# looks like old Archive::Zip have tiny mem leak - it leaks ~50+ Mb per 15k files
|
||||||
|
|
||||||
|
|
||||||
|
use strict;
|
||||||
|
use warnings "all";
|
||||||
|
|
||||||
|
use File::Path;
|
||||||
|
use Archive::Zip qw(:ERROR_CODES :CONSTANTS);
|
||||||
|
|
||||||
|
sub mkzip(@);
|
||||||
|
sub pathgen();
|
||||||
|
sub err($);
|
||||||
|
sub help($);
|
||||||
|
|
||||||
|
help($0) unless (defined($ARGV[0]));
|
||||||
|
|
||||||
|
my $FILES_PER_DIR = 1000;
|
||||||
|
my $DIRS_PER_DIR = 1000;
|
||||||
|
my $BASEDIR = $ARGV[0];
|
||||||
|
my @OUTPATH = ($BASEDIR, undef, undef);
|
||||||
|
my $FILECOUNTER = undef;
|
||||||
|
my $TMPDIR = 'tmp';
|
||||||
|
my $CHILDREN = 0;
|
||||||
|
my $CHILDREN_MAX = `nproc`;
|
||||||
|
|
||||||
|
opendir(DIR, ".");
|
||||||
|
my @ziplist = grep { /\.zip$/ } readdir(DIR);
|
||||||
|
closedir(DIR);
|
||||||
|
@ziplist = reverse (sort (@ziplist));
|
||||||
|
|
||||||
|
while (my $zipfile = pop (@ziplist)) {
|
||||||
|
syswrite STDOUT, "Processing $zipfile.\n";
|
||||||
|
my $zip = Archive::Zip->new;
|
||||||
|
Archive::Zip::setChunkSize(1048576);
|
||||||
|
|
||||||
|
unless ( $zip->read( $zipfile ) == AZ_OK ) {
|
||||||
|
err (sprintf ("Unable to read %s, skipping", $zipfile));
|
||||||
|
undef $zip;
|
||||||
|
undef $zipfile;
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
undef $zipfile;
|
||||||
|
my @members = reverse ($zip->members());
|
||||||
|
my $mbrnum = 1;
|
||||||
|
my $mbrlen = int (@members);
|
||||||
|
|
||||||
|
while (my $mbr = pop (@members)) {
|
||||||
|
syswrite STDOUT, sprintf ("Entity %s/%s.\r", $mbrnum, $mbrlen);
|
||||||
|
my $content = $zip->contents($mbr);
|
||||||
|
|
||||||
|
unless (defined ($content)) {
|
||||||
|
err (sprintf ("Unable to extract %s, skipping.", $mbr->{'fileName'}));
|
||||||
|
next;
|
||||||
|
}
|
||||||
|
|
||||||
|
unless (defined($FILECOUNTER)) {
|
||||||
|
$FILECOUNTER = 0;
|
||||||
|
pathgen();
|
||||||
|
} else {
|
||||||
|
if ($FILECOUNTER >= ($FILES_PER_DIR - 1)) {
|
||||||
|
pathgen();
|
||||||
|
$FILECOUNTER = 0;
|
||||||
|
} else {
|
||||||
|
$FILECOUNTER++;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $destdir = join ('/', @OUTPATH);
|
||||||
|
|
||||||
|
unless (-d $destdir) {
|
||||||
|
# actually we need to check if path really created
|
||||||
|
if ( scalar (mkpath ($destdir)) < 1 ) {
|
||||||
|
err (sprintf ("Unable to create %s, quitting.", $destdir));
|
||||||
|
exit 1;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
my $pid = fork();
|
||||||
|
|
||||||
|
if ($pid) { # Parent
|
||||||
|
$CHILDREN++;
|
||||||
|
} elsif ($pid == 0) { # Child
|
||||||
|
mkzip ($content, $mbr, $destdir);
|
||||||
|
exit 0;
|
||||||
|
} else { # Unable to fork
|
||||||
|
die "ERROR: Could not fork new process: $!\n\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
while ($CHILDREN >= $CHILDREN_MAX) {
|
||||||
|
my $shouldSleep = 1;
|
||||||
|
|
||||||
|
if ((my $pid = wait()) > 0) {
|
||||||
|
$CHILDREN--;
|
||||||
|
$shouldSleep = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
select (undef, undef, undef, 0.1) if ($shouldSleep == 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
undef $content;
|
||||||
|
undef $mbr;
|
||||||
|
undef $destdir;
|
||||||
|
undef $pid;
|
||||||
|
$mbrnum++;
|
||||||
|
}
|
||||||
|
|
||||||
|
@members = -1; undef @members;
|
||||||
|
undef $zip;
|
||||||
|
undef $mbrnum;
|
||||||
|
}
|
||||||
|
|
||||||
|
while ($CHILDREN > 0) {
|
||||||
|
my $shouldSleep = 1;
|
||||||
|
|
||||||
|
if ((my $pid = wait()) > 0) {
|
||||||
|
$CHILDREN--;
|
||||||
|
$shouldSleep = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
select (undef, undef, undef, 0.05) if ($shouldSleep == 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
@ziplist = -1; undef @ziplist;
|
||||||
|
syswrite STDOUT, "\nDone.\n";
|
||||||
|
exit 0;
|
||||||
|
|
||||||
|
sub mkzip(@){
|
||||||
|
my $content = shift;
|
||||||
|
my $mbr = shift;
|
||||||
|
my $destdir = shift;
|
||||||
|
|
||||||
|
my $newzip = Archive::Zip->new();
|
||||||
|
my $zippy = $newzip->addString($content);
|
||||||
|
|
||||||
|
if (defined($zippy)) {
|
||||||
|
$zippy->fileName($mbr->{'fileName'});
|
||||||
|
$zippy->setLastModFileDateTimeFromUnix( $mbr->{'lastModFileDateTime'} );
|
||||||
|
$zippy->desiredCompressionMethod(COMPRESSION_DEFLATED);
|
||||||
|
$zippy->desiredCompressionLevel(COMPRESSION_LEVEL_BEST_COMPRESSION);
|
||||||
|
|
||||||
|
unless ( $newzip->writeToFileNamed("$destdir/$mbr->{'fileName'}.zip") == AZ_OK ) {
|
||||||
|
err (sprintf ("Warning: unable to write to %s/%s.zip", $destdir, $mbr->{'fileName'}));
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
err (sprintf ("Warning: unable to add %s to zip-file", $mbr->{'fileName'}));
|
||||||
|
}
|
||||||
|
|
||||||
|
undef $zippy;
|
||||||
|
undef $newzip;
|
||||||
|
undef $content;
|
||||||
|
undef $mbr;
|
||||||
|
undef $destdir;
|
||||||
|
}
|
||||||
|
|
||||||
|
sub pathgen() {
|
||||||
|
unless (defined($OUTPATH[1])) {
|
||||||
|
$OUTPATH[1] = 0;
|
||||||
|
}
|
||||||
|
|
||||||
|
unless (defined($OUTPATH[2])) {
|
||||||
|
$OUTPATH[2] = 0;
|
||||||
|
} else {
|
||||||
|
$OUTPATH[2]++;
|
||||||
|
|
||||||
|
if ($OUTPATH[2] > $DIRS_PER_DIR) {
|
||||||
|
$OUTPATH[1]++;
|
||||||
|
$OUTPATH[2] = 0;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
sub err($) {
|
||||||
|
my $msg = shift;
|
||||||
|
syswrite STDERR, "$msg\n";
|
||||||
|
}
|
||||||
|
|
||||||
|
sub help($) {
|
||||||
|
my $me = shift;
|
||||||
|
printf ("Usage: %s path/to/destination/directory\n", $me);
|
||||||
|
exit 0;
|
||||||
|
}
|
||||||
Reference in New Issue
Block a user