Added fb2_rezip-2-f.pl forking multiprocess flavour of fb2_rezip-2.pl

2019-04-28 17:09:39 +03:00
parent 79a36a63f3
commit d3997b5a83
1 changed files with 186 additions and 0 deletions
--- a/fb2_rezip-2-f.pl
+++ b/fb2_rezip-2-f.pl
@@ -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;
+}