From f76c85531d9eadda54aaa6df452f402332ce893d Mon Sep 17 00:00:00 2001
From: Sergei <eleksir@exs-elm.ru>
Date: Sat, 11 Mar 2017 16:30:48 +0000
Subject: [PATCH] fb2_rezip-2.pl: recompress zip archive with thousands of
 files to thousands of zip files.

---
 fb2_rezip-2.pl | 134 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 134 insertions(+)
 create mode 100644 fb2_rezip-2.pl

diff --git a/fb2_rezip-2.pl b/fb2_rezip-2.pl
new file mode 100644
index 0000000..0b9f138
--- /dev/null
+++ b/fb2_rezip-2.pl
@@ -0,0 +1,134 @@
+#!/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();
+
+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';
+
+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 ) {
+		syswrite STDERR, sprintf("Unable to read %s, skipping\n", $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)){
+			printf("Unable to extract %s, skipping.\n", $mbr->{'fileName'});
+			next;
+		}
+
+		mkzip($content, $mbr);
+		undef $content;
+		undef $mbr;
+		$mbrnum++;
+	}
+
+	@members = -1; undef @members;
+	undef $zip;
+	undef $mbrnum;
+}
+
+@ziplist = -1; undef @ziplist;
+syswrite STDOUT, "\nDone.\n";
+exit 0;
+
+sub mkzip(@){
+	my $content = shift;
+	my $mbr = shift;
+
+	unless(defined($FILECOUNTER)) {
+		$FILECOUNTER = 0;
+		pathgen();
+	} else {
+		if ($FILECOUNTER >= $FILES_PER_DIR) {
+			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 ) {
+			printf("Unable to create %s, quitting.", $destdir);
+			exit 1;
+		}
+	}
+
+	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 ) {
+			printf ("Warning: unable to write to %s/%s.zip\n", $destdir, $mbr->{'fileName'});
+		}
+	} else {
+		printf ("Warning: unable to add %s to zip-file\n", $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;
+		}
+	}
+}