r2640 - people/goneri/SvnBuildStat-WWW/script

[Gonéri Le Bouder]

Author: goneri-guest
Date: 2007-05-09 15:57:25 +0000 (Wed, 09 May 2007)
New Revision: 2640

Modified:
   people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
Log:
use of Thread::Pool::Simple

Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl	2007-05-08 21:06:26 UTC (rev 2639)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl	2007-05-09 15:57:25 UTC (rev 2640)
@@ -12,25 +12,28 @@
 
 use strict;
 
-use SVN::Client;
 use LWP::UserAgent;
 use Data::Dumper;
 use File::Basename;
 
-use lib '/usr/local/www/sites/nana.rulezlan.org/svnbuildstat/lib';
+use Thread::Pool::Simple;
+use lib '/usr/local/www/sites/svnbuildstat.debian.net/svnbuildstat/lib';
 use SvnBuildStat::Schema;
 use SvnBuildStat::Config;
 
-# TODO: SVN::Client->cat croak is it try to cat a invalid file
-$SVN::Error::handler=undef;
+my $maxThreadPerPool=10;
 
-my $ctx;
-#my $rev;
 my $uri;
 my $folder;
 my $config;
 my $schema;
 
+
+
+my $poolImportPkg;
+my $poolImportRepository;
+my $poolUpdateTarballPresent;
+
 sub mkTarballFromPackage {
   my $package = shift;
 
@@ -40,21 +43,7 @@
   $$package->name.'_'.$majorrelease.".orig.tar.gz";
 }
 
-sub getFile {
-  my $uri = shift;
 
-  my $fh;
-  my $tmp = '';
-  open ($fh, '>', \$tmp) or die;
-  $ctx->cat($fh, $uri, 'HEAD');
-  close ($fh);
-  return unless $tmp;
-
-  my @ret;
-  push @ret, $_ foreach (split $/,$tmp);
-  return @ret;
-}
-
 sub importPkg {
   my( $repository, $uri, $tarballinrepository) = @_;
 
@@ -67,9 +56,9 @@
   foreach (`LC_ALL=C svn info $uri`) {
     $rev = $1 if /Last Changed Rev:\ (\d+)/;
   }
-  print $rev."\n";
+  return unless $rev;
 
-  my @control = getFile($uri."/debian/control");
+  my @control = `svn cat $uri/debian/control`;
   return unless @control;
   foreach (@control) {
     $packagesrc = $1 if /^Source:\ *(.*)/;
@@ -94,7 +83,7 @@
   my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
   $package->update_from_related('repository_id',$$repository);
 
-  my @changelog = getFile($uri."/debian/changelog");
+  my @changelog = `svn cat $uri/debian/changelog`;
   if (@changelog && $changelog[0] =~ /^.*\ \((.*)\)/) {
     $package->svndebrelease($1);
     my $tarball = mkTarballFromPackage(\$package);
@@ -182,35 +171,63 @@
   {AutoCommit => 1, debug => 1}
 );
 
+sub importRepository {
+  my $repository = shift;
 
-$ctx = new SVN::Client(
-  auth => [SVN::Client::get_simple_provider(),
-  SVN::Client::get_simple_prompt_provider(\&simple_prompt,2),
-  SVN::Client::get_username_provider()]
-);
+  my $tarballinrepository;
+  print "Repository: ".$$repository->name."\n";
+  my $t = 'svn ls -R '.$$repository->uri;
 
-# Import packages
-my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
-while (my $repository = $repository_rs->next) {
-  my $tarballinrepository;
-  print "Repository: ".$repository->name."\n";
-  my $t = $ctx->ls($repository->uri,'HEAD',1);
-  foreach  (keys %$t) {
-   my $uri = $repository->uri.'/'.$_;
+  my @uri;
+
+  foreach (`$t`) {
+    chomp;
+    my $uri = $$repository->uri.'/'.$_;
+    $tarballinrepository->{basename($_)}=$uri if /\.tar\.gz$/;
     $uri =~ s/\/$//;
-    $tarballinrepository->{basename($_)}=$uri if /\.tar\.gz$/;
+    next if /(tags|branches)/; # I want trunk !
+    next unless /debian\/control$/; # I want trunk !
+    $uri =~ s/(|\/)debian\/control$//;
+    push @uri, $uri;
+  }
 
+  foreach my $uri (@uri) {
     # look for packages
-    next if /branche/; # I want trunk !
-    next unless /debian\/control$/; # I want trunk !
-    $uri =~ s/(|\/)debian\/control$//;
     print "->".$uri."\n";
-    importPkg(\$repository,$uri,$tarballinrepository);
+    my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository);
+    print "poolImportPkg->".$pid."\n";
   }
+  print "end import Repo\n";
 }
 
-# Check tarball presence 
+########## THREAD POOLS #####
+$poolImportPkg = Thread::Pool::Simple->new(
+   max => $maxThreadPerPool,
+   do => [\&importPkg],
+ );
+$poolImportRepository = Thread::Pool::Simple->new(
+    max => $maxThreadPerPool,
+    do => [\&importRepository],
+  );
+$poolUpdateTarballPresent = Thread::Pool::Simple->new(
+    max => $maxThreadPerPool,
+    do => [\&updateTarballPresent],
+  );
+########
+
+# Import packages
+my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
+while (my $repository = $repository_rs->next) {
+  my $pid = $poolImportRepository->add(\$repository);
+  print "poolImportRepository->".$pid."\n";
+}
+$poolImportPkg->join;
+$poolImportRepository->join;
+
+print "# Check tarball presence\n"; 
+
 my $package_rs = $schema->resultset('Package');
 while (my $package = $package_rs->next) {
-  updateTarballPresent(\$package);
+  $poolUpdateTarballPresent->add(\$package);
 }
+$poolUpdateTarballPresent->join();