diff --git a/rrclone-mt.pl b/rrclone-mt.pl index 04d2f4e..f3ec962 100644 --- a/rrclone-mt.pl +++ b/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($) {