r2749 - people/goneri/SvnBuildStat-WWW/script

[Gonéri Le Bouder]

Author: goneri-guest
Date: 2007-05-28 18:24:25 +0000 (Mon, 28 May 2007)
New Revision: 2749

Modified:
   people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl
   people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-uscan.pl
   people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
Log:
fix to avoid false "Missing tarball"


Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl	2007-05-28 17:47:35 UTC (rev 2748)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl	2007-05-28 18:24:25 UTC (rev 2749)
@@ -35,6 +35,7 @@
 
   my $istarballpresent = 0;
   my $isindebian = 0;
+  my $tarballisindebian;
 
   return unless $$package->name;
   return unless $$package->svndebrelease;
@@ -62,18 +63,18 @@
       $res = $ua->request($req);
       if ($res->is_success) {
 	$istarballpresent = 1;
-	$$package->tarballuri('@DEBMIRROR@/pool/'.$section.$tmp.'/'.$tarball);
+	$tarballuri = '@DEBMIRROR@/pool/'.$section.'/'.$tmp.'/'.$tarball;
+	$$package->tarballuri($tarballuri);
 	print "OK in Debian\n";
+	$tarballisindebian = 1;
 	last;
       }
     }
 
-    if ((!$istarballpresent) && $$package->tarballuri) {
-      print $$package->tarballuri."\n";
+    if (!$tarballisindebian && $$package->tarballuri()) {
       my $req = HTTP::Request->new(HEAD => $$package->tarballuri);
       my $res = $ua->request($req);
-      $istarballpresent = 1 if $res->is_success;
-      print "OK in Repo\n" if $istarballpresent;
+      $istarballpresent = $res->is_success?1:0;
     }
   }
 
@@ -96,6 +97,7 @@
 
 my $package_rs = $schema->resultset('Package');
 while (my $package = $package_rs->next) {
+#  next unless $package->name eq "libpdf-reuse-barcode-perl";
   $poolUpdateTarballPresent->add(\$package);
 }
 $poolUpdateTarballPresent->join();

Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-uscan.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-uscan.pl	2007-05-28 17:47:35 UTC (rev 2748)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-uscan.pl	2007-05-28 18:24:25 UTC (rev 2749)
@@ -63,8 +63,15 @@
 
   $$package->isuptodate($isuptodate);
   if ($isuptodate eq 't') {
-    if (defined ($tarballuri) && $tarballuri && !$$package->istarballpresent) {
-      $$package->tarballuri($tarballuri);
+    if (defined ($tarballuri) && $tarballuri && !$$package->tarballuri) {
+      my $req = HTTP::Request->new(HEAD => $tarballuri);
+      my $ua = LWP::UserAgent->new;
+      $ua->agent("SvnBuildStat/0.1 ");
+      my $res = $ua->request($req);
+      if ($res->is_success) {
+	$$package->istarballpresent(1);
+	$$package->tarballuri($tarballuri);
+      }
     }
   }
 

Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl	2007-05-28 17:47:35 UTC (rev 2748)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl	2007-05-28 18:24:25 UTC (rev 2749)
@@ -26,7 +26,7 @@
 my $config;
 my $schema;
 
-my $poolImportPkg;
+#my $poolImportPkg;
 
 # TODO: This func should be shared in a library
 sub mkTarballFromPackage {
@@ -81,24 +81,29 @@
     my $svndebrelease = $1;
     my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
     $package->update_from_related('repository_id',$$repository);
-    
-    $package->svndebrelease ($svndebrelease);
-    my $tarball = mkTarballFromPackage(\$package);
-    if (exists $tarballinrepository->{$tarball}) {
-      $tarballuri = $tarballinrepository->{$tarball};
-      # I convert the svn:// uri to a http one
-      $tarballuri =~ s!svn://svn.debian.org/svn/(.*)!http://svn.debian.org/wsvn/$1?op=file&rev=0&sc=0!;
-    } elsif ($$repository->tarballlayout) { # Else I try find the tarball with the tarballlayout
-      $tarballuri = $$repository->tarballlayout;
-      $tarballuri =~ s/\@TARBALL@/$tarball/;
-      $tarballuri =~ s/\@PACKAGE@/$packagesrc/;
-    } else {
-	print "Failed to find $tarball\n";
+   
+    if (!$package->istarballpresent) {
+      $package->svndebrelease ($svndebrelease);
+      my $tarball = mkTarballFromPackage(\$package);
+      if (exists $tarballinrepository->{$tarball}) {
+	$tarballuri = $tarballinrepository->{$tarball};
+	# I convert the svn:// uri to a http one
+	$tarballuri =~ s!svn://svn.debian.org/svn/(.*)!http://svn.debian.org/wsvn/$1?op=file&rev=0&sc=0!;
+      } elsif ($$repository->tarballlayout) { # Else I try find the tarball with the tarballlayout
+	$tarballuri = $$repository->tarballlayout;
+	$tarballuri =~ s/\@TARBALL@/$tarball/;
+	$tarballuri =~ s/\@PACKAGE@/$packagesrc/;
+      }
+      my $req = HTTP::Request->new(HEAD => $tarballuri);
+      my $ua = LWP::UserAgent->new;
+      $ua->agent("SvnBuildStat/0.1 ");
+      my $res = $ua->request($req);
+      my $istarballpresent = $res->is_success?1:0;
+      $package->istarballpresent($istarballpresent);
+      $package->tarballuri($tarballuri);
     }
 
-
     $package->uri($uri);
-    $package->tarballuri($tarballuri);
 
     $package->rev($rev) if $rev;
     $package->repository_id($$repository);
@@ -140,7 +145,7 @@
     my $uri = $$repository->uri.'/'.$_;
     $tarballinrepository->{basename($_)}=$uri if /\.tar\.gz$/;
     $uri =~ s/\/$//;
-    next if /(tags|branches)/; # I want trunk!
+    next if /\/(tags|branches|attic)\//; # I want trunk!
     next if /\/(sarge|etch)\//; # Try to avoid sarge and etch backport 
     next unless /debian\/control$/; # I want trunk!
     $uri =~ s/(|\/)debian\/control$//;
@@ -150,17 +155,17 @@
   foreach my $uri (@uri) {
     # look for packages
     print "->".$uri."\n";
-    my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository) or die "Fucked!\n";
-    print "poolImportPkg->".$pid."\n";
+    #my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository) or die "Fucked!\n";
+    importPkg($repository,$uri,$tarballinrepository);
   }
   print "end import Repo\n";
 }
 
 ########## THREAD POOLS #####
-$poolImportPkg = Thread::Pool::Simple->new(
-   max => $maxThreadPerPool,
-   do => [\&importPkg],
- );
+#$poolImportPkg = Thread::Pool::Simple->new(
+#   max => $maxThreadPerPool,
+#   do => [\&importPkg],
+# );
 
 ########
 
@@ -169,4 +174,4 @@
 while (my $repository = $repository_rs->next) {
   importRepository(\$repository);
 }
-$poolImportPkg->join;
+#$poolImportPkg->join;