r2719 - people/goneri/SvnBuildStat-WWW/script
Gonéri Le Bouder
goneri-guest at alioth.debian.org
Thu May 24 16:28:13 UTC 2007
Author: goneri-guest
Date: 2007-05-24 16:28:13 +0000 (Thu, 24 May 2007)
New Revision: 2719
Added:
people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl
Modified:
people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
Log:
split move the tarball checking stuff out of
script/svnbuildstat_update-db.pl
Added: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl (rev 0)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl 2007-05-24 16:28:13 UTC (rev 2719)
@@ -0,0 +1,101 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use LWP::UserAgent;
+use Data::Dumper;
+
+use Thread::Pool::Simple;
+use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
+use SvnBuildStat::Schema;
+use SvnBuildStat::Config;
+
+print "# Check tarball presence\n";
+my $maxThreadPerPool=30;
+
+my $poolUpdateTarballPresent;
+
+my $config;
+my $schema;
+
+# TODO: This func should be shared in a library
+sub mkTarballFromPackage {
+ my $package = shift;
+
+ my $majorrelease = $$package->svndebrelease;
+ $majorrelease =~ s/-[0-9A-Za-z\.~]*$//;
+ return unless $majorrelease;
+
+ $$package->name.'_'.$majorrelease.".orig.tar.gz";
+}
+
+sub updateTarballPresent {
+ print "updateTarballPresent\n";
+ my $package = shift;
+
+ my $istarballpresent = 0;
+ my $isindebian = 0;
+
+ return unless $$package->name;
+ return unless $$package->svndebrelease;
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("SvnBuildStat/0.1 ");
+
+ # This code should provably me moved somewhere else
+ my $debmirror = 'http://ftp.debian.org/debian';
+ my $debdiff .= $$package->name."_".$$package->svndebrelease.".diff.gz";
+ my $tarball = mkTarballFromPackage($package);
+
+ if ($tarball) {
+ foreach my $section (qw/main contrib non-free/) {
+ my $tmp = "/$1/".$$package->name if $$package->name =~ /^(.)/;
+ my $debdiffuri = $debmirror.'/pool/'.$section.$tmp.'/'.$debdiff;
+ my $tarballuri = $debmirror.'/pool/'.$section.$tmp.'/'.$tarball;
+# print "Looking for debdiff :".$debdiffuri."\n";
+ my $req = HTTP::Request->new(HEAD => $debdiffuri);
+ my $res = $ua->request($req);
+ $$package->isindebian(1) if $res->is_success;
+
+ print "Looking for tarball :'".$tarballuri."'\n";
+ $req = HTTP::Request->new(HEAD => $tarballuri);
+ $res = $ua->request($req);
+ if ($res->is_success) {
+ $istarballpresent = 1;
+ $$package->tarballuri('@DEBMIRROR@/pool/'.$section.$tmp.'/'.$tarball);
+ print "OK in Debian\n";
+ last;
+ }
+ }
+
+ if ((!$istarballpresent) && $$package->tarballuri) {
+ print $$package->tarballuri."\n";
+ 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;
+ }
+ }
+
+ $$package->istarballpresent($istarballpresent);
+ $$package->update();
+}
+
+$config = new SvnBuildStat::Config();
+$schema = SvnBuildStat::Schema->connect(
+ $config->db_dsn,
+ $config->db_user,
+ $config->db_password,
+ {AutoCommit => 1, debug => 1}
+);
+
+$poolUpdateTarballPresent = Thread::Pool::Simple->new(
+ max => $maxThreadPerPool,
+ do => [\&updateTarballPresent],
+ );
+
+my $package_rs = $schema->resultset('Package');
+while (my $package = $package_rs->next) {
+ $poolUpdateTarballPresent->add(\$package);
+}
+$poolUpdateTarballPresent->join();
Property changes on: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db-tarball.pl
___________________________________________________________________
Name: svn:executable
+ *
Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl 2007-05-24 16:20:53 UTC (rev 2718)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl 2007-05-24 16:28:13 UTC (rev 2719)
@@ -23,17 +23,12 @@
my $maxThreadPerPool=10;
-my $uri;
-my $folder;
my $config;
my $schema;
-
-
my $poolImportPkg;
-my $poolImportRepository;
-my $poolUpdateTarballPresent;
+# TODO: This func should be shared in a library
sub mkTarballFromPackage {
my $package = shift;
@@ -45,6 +40,7 @@
sub importPkg {
+ print "ImportPkg\n";
my( $repository, $uri, $tarballinrepository) = @_;
my @maintainer;
@@ -79,13 +75,15 @@
}
}
}
- die unless $packagesrc;
- my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
- $package->update_from_related('repository_id',$$repository);
+ die "Parse error" unless $packagesrc;
my @changelog = `svn cat $uri/debian/changelog`;
if (@changelog && $changelog[0] =~ /^.*\ \((.*)\)/) {
- $package->svndebrelease($1);
+ 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};
@@ -98,71 +96,29 @@
} else {
print "Failed to find $tarball\n";
}
- }
- $package->uri($uri);
- $package->tarballuri($tarballuri);
+ $package->uri($uri);
+ $package->tarballuri($tarballuri);
- $package->rev($rev) if $rev;
- $package->repository_id($$repository);
+ $package->rev($rev) if $rev;
+ $package->repository_id($$repository);
- foreach my $maintainer (@maintainer) {
- my $package_maintainer =
- $package->find_or_create_related('package_maintainers', {
- 'maintainer_id' => $maintainer->id});
- }
- $package->update();
-}
-
-
-sub updateTarballPresent {
- my $package = shift;
-
- my $istarballpresent = 0;
- my $isindebian = 0;
-
- return unless $$package->name;
-
- my $ua = LWP::UserAgent->new;
- $ua->agent("SvnBuildStat/0.1 ");
-
- # This code should provably me moved somewhere else
- my $debmirror = 'http://ftp.debian.org/debian';
- my $debdiff .= $$package->name."_".$$package->svndebrelease.".diff.gz";
- my $tarball = mkTarballFromPackage($package);
- foreach my $section (qw/main contrib non-free/) {
- my $tmp = "/$1/".$$package->name if $$package->name =~ /^(.)/;
- my $debdiffuri = $debmirror.'/pool/'.$section.$tmp.'/'.$debdiff;
- my $tarballuri = $debmirror.'/pool/'.$section.$tmp.'/'.$tarball;
-# print "Looking for debdiff :".$debdiffuri."\n";
- my $req = HTTP::Request->new(HEAD => $debdiffuri);
- my $res = $ua->request($req);
- $$package->isindebian(1) if $res->is_success;
-
- print "Looking for tarball :'".$tarballuri."'\n";
- $req = HTTP::Request->new(HEAD => $tarballuri);
- $res = $ua->request($req);
- if ($res->is_success) {
- $istarballpresent = 1;
- $$package->tarballuri('@DEBMIRROR@/pool/'.$section.$tmp.'/'.$tarball);
- print "OK in Debian\n";
- last;
+ foreach my $maintainer (@maintainer) {
+ my $package_maintainer =
+ $package->find_or_create_related('package_maintainers', {
+ 'maintainer_id' => $maintainer->id});
}
- }
+ print "Update package\n";
+ $package->update();
- if ((!$istarballpresent) && $$package->tarballuri) {
- print $$package->tarballuri."\n";
- 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;
+ } else {
+ print "Failed to parse $uri/debian/changelog\n";
+ return;
}
-
- $$package->istarballpresent($istarballpresent);
- $$package->update();
}
+
$config = new SvnBuildStat::Config();
$schema = SvnBuildStat::Schema->connect(
$config->db_dsn,
@@ -185,8 +141,9 @@
my $uri = $$repository->uri.'/'.$_;
$tarballinrepository->{basename($_)}=$uri if /\.tar\.gz$/;
$uri =~ s/\/$//;
- next if /(tags|branches)/; # I want trunk !
- next unless /debian\/control$/; # I want trunk !
+ next if /(tags|branches)/; # 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$//;
push @uri, $uri;
}
@@ -194,7 +151,7 @@
foreach my $uri (@uri) {
# look for packages
print "->".$uri."\n";
- my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository);
+ my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository) or die "Fucked!\n";
print "poolImportPkg->".$pid."\n";
}
print "end import Repo\n";
@@ -205,29 +162,12 @@
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";
+ importRepository(\$repository);
}
$poolImportPkg->join;
-$poolImportRepository->join;
-
-print "# Check tarball presence\n";
-
-my $package_rs = $schema->resultset('Package');
-while (my $package = $package_rs->next) {
- $poolUpdateTarballPresent->add(\$package);
-}
-$poolUpdateTarballPresent->join();
More information about the Pkg-games-commits
mailing list