rrclone-mt.pl refactored a bit to make it faster

* Changed TODO :)
* Disabled debug output by default
* Code cleanup
* Polling list of threads can be done once per second, this made delays in
  package downloads and processing of already downloded packages

rrclone-mt.pl

@@ -1,6 +1,4 @@
 #!/usr/bin/perl
-# TODO: implement fool proof paths check (add trailing backslash if it absent on url and path)
-#
 # simple RPM Repository cloning script
 
 # looks like some toxic ditribution polices for ill-driven distros like debian|ubuntu or less shitty like centos
@@ -11,6 +9,8 @@
 # for ubuntu: libjson-pp-perl, libfile-spec-perl, libxml-parser-perl, libio-compress-perl, liburi-perl
 # for slackware - everything is bundled with builtin perl :)
 
+# TODO: use another model of xml processing to use less memory
+
 use strict;
 use warnings "all";
 use Fcntl;
@@ -25,8 +25,8 @@ use URI::URL;
 use Data::Dumper;
 use HTTP::Tiny;
 use IO::Socket::SSL; # implicit requirement in order to HTTP::Tiny work with https
-# use Data::Dumper;
 
+sub mythread();
 sub dlfunc(@);
 sub urlencode($);
 sub getmetadata();
@@ -43,7 +43,7 @@ help(0) if ($ARGV[0] eq '--help');
 help(0) if ($ARGV[0] eq '-h');
 
 my $noclean = 0;
-my $DEBUG = 1;
+my $DEBUG = 0;
 
 if (defined($ARGV[0]) and $ARGV[0] eq '--noclean') {
 	$noclean = 1;
@@ -65,6 +65,9 @@ syswrite STDOUT, sprintf("Cloning %s to %s\n", $BASEURL, $BASEDIR);
 
 my @REPOFILES :shared;
 my @FILES;
+my @LINKS :shared;
+my @SIZES :shared;
+my $MUTEX :shared = 0; # while $MUTEX = 1, noone picks links
 
 my $primaryxmlgz = getmetadata();
 my $fh = new IO::Zlib;
@@ -86,8 +89,6 @@ my $p1 = new XML::Parser(Style => 'Tree');
 my $ref = $p1->parse($xmldata);
 undef $xmldata;
 my @array = @{ $ref->[1] };
-my @threads;
-my $tcount = 0;
 
 for (my $i = 0; $i < @array; $i++) {
 
@@ -111,20 +112,8 @@ for (my $i = 0; $i < @array; $i++) {
 
 		}
 
-		threads->create('dlfunc', $link, $size);
-
-		do {
-			my $flag = 0;
-			$tcount = threads->list();
-
-			foreach my $thread (threads->list(threads::joinable)) {
-				$thread->join();
-				$flag = 1;
-			}
-
-			select(undef, undef, undef, 0.25) unless ($flag == 1);
-
-		} while ($tcount > 3);
+		push @LINKS, $link;
+		push @SIZES, $size;
 
 		undef $size;
 		undef $link;
@@ -132,6 +121,15 @@ for (my $i = 0; $i < @array; $i++) {
 	}
 }
 
+@array = -1;
+undef $p1;
+
+for (my $i = 1; $i < 4; $i++) {
+	threads->create('mythread');
+}
+
+my $tcount = 0;
+
 do {
 	$tcount = threads->list();
 
@@ -139,9 +137,11 @@ do {
 		$thread->join();
 	}
 
-	select(undef, undef, undef, 0.25);
+	# list of threads can be polled once per second, it delays consecutive polls by one second
+	sleep(3);
 } while ($tcount > 0);
 
+undef $tcount;
 syswrite STDOUT, "Cloning done.\n";
 exit 0 if ($noclean == 1);
 
@@ -168,7 +168,9 @@ foreach my $fileOnDisk (@FILES) {
 }
 
 
-foreach my $file (@filesToDelete) {
+while (@filesToDelete > 0) {
+	my $file = pop(@filesToDelete);
+
 	unless (-d $file) {
 		dbg("  - Unlinking $file");
 		unlink $file;
@@ -202,6 +204,38 @@ HELP
 	exit $rc;
 }
 
+sub mythread() {
+	while ( 1 ) {
+		my $size;
+		my $link;
+
+		if ($MUTEX == 0) {
+			$MUTEX = 1;
+			$size = pop(@SIZES);
+			$link = pop(@LINKS);
+			$MUTEX = 0;
+		} else {
+# pop from 2 arrays takes very small amount of time,
+# in practice we do not need this micro-sleep
+#			select(undef, undef, undef, 0.05);
+			next;
+		}
+
+		if (@LINKS > 0) {
+			if ((defined($size)) and (defined($link))) {
+				dlfunc($link, $size);
+			}
+		} else {
+# handle last package in list
+			if ((defined($size)) and (defined($link))) {
+				dlfunc($link, $size);
+			} else {
+				last;
+			}
+		}
+	}
+}
+
 sub dlfunc(@) {
 	my $url = shift; # short (relative) URL without BASE part
 	my $size = shift;
@@ -299,6 +333,7 @@ sub getmetadata() {
 
 	}
 
+	@array = -1;
 	return $primaryxmlgz;
 }
 
@@ -332,11 +367,10 @@ sub path_normalize_by_string_manipulation ($) {
 }
 
 sub getfilenames($) {
-	my $path    = shift;
+	my $path = shift;
 
 	opendir (DIR, $path) or return "";
-	my @localfiles;
-	@localfiles =
+	my @localfiles =
 	map { $path . '/' . $_ }
 	grep { !/^\.{1,2}$/ }
 	readdir (DIR);
@@ -345,11 +379,10 @@ sub getfilenames($) {
 	foreach (@localfiles) {
 		next if(-l $_);
 
-		if( -d $_){
+		if(-d $_){
 			getfilenames($_);
 		}
 	}
-
 }
 
 sub noslash($) {