#!/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;
}