r2757 - people/goneri/SvnBuildStat-WWW/script
Gonéri Le Bouder
goneri-guest at alioth.debian.org
Tue May 29 17:53:31 UTC 2007
Author: goneri-guest
Date: 2007-05-29 17:53:30 +0000 (Tue, 29 May 2007)
New Revision: 2757
Modified:
people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
Log:
merge svnbuildstat_update-db-uscan.pl and svnbuildstat_update-db-tarball.pl
Modified: people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl
===================================================================
--- people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl 2007-05-28 21:52:15 UTC (rev 2756)
+++ people/goneri/SvnBuildStat-WWW/script/svnbuildstat_update-db.pl 2007-05-29 17:53:30 UTC (rev 2757)
@@ -1,4 +1,5 @@
#!/usr/bin/perl -w
+use File::Temp qw/ tempfile /;
#
# uscan --package gnome-bluetooth --dehs --upstream-version 0.8.0 --watchfile watch
#<dehs>
@@ -28,19 +29,118 @@
#my $poolImportPkg;
-# TODO: This func should be shared in a library
sub mkTarballFromPackage {
my $package = shift;
my $majorrelease = $$package->svndebrelease;
+ $majorrelease =~ s/^\d+://;
$majorrelease =~ s/-[0-9A-Za-z\.~]*$//;
$$package->name.'_'.$majorrelease.".orig.tar.gz";
}
+sub testUrl {
+ my $url = shift;
+ return unless $url;
+
+ my $req = HTTP::Request->new(HEAD => $url);
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("SvnBuildStat/0.1 ");
+ my $res = $ua->request($req);
+ $res->is_success;
+
+}
+
+sub createTarballUrlFromTarballlayout {
+ my ($repository, $package) = @_;
+
+ return unless $$repository->tarballlayout;
+ my $packagename = $package->name;
+ my $tarball = mkTarballFromPackage($package);
+ my $tarballuri = $$repository->tarballlayout;
+ $tarballuri =~ s/\@TARBALL@/$tarball/;
+ $tarballuri =~ s/\@PACKAGE@/$packagename/;
+
+ return $tarballuri;
+}
+
+sub getOnDebianData {
+ my $package = shift;
+ return unless $$package->name;
+ return unless $$package->svndebrelease;
+
+ my $isindebian = 'f';
+ my $tarballuri;
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("SvnBuildStat/0.1 ");
+
+ 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 =~ /^(lib.|.)/;
+ my $debdiffuri = $debmirror.'/pool/'.$section.'/'.$tmp.'/'.$debdiff;
+ my $tmp_tarballuri = $debmirror.'/pool/'.$section.'/'.$tmp.'/'.$tarball;
+ print $tmp_tarballuri."\n";
+ if (testUrl($debdiffuri)) {
+ $isindebian = 't';
+ }
+ if (testUrl($tmp_tarballuri)) {
+ $tarballuri = $tmp_tarballuri;
+ $tarballuri =~ s/^$debmirror/\@DEBMIRROR@/;
+ }
+ }
+
+ }
+print "tarballuri -> ".$tarballuri."\n";
+ return { tarballuri => $tarballuri, isindebian => $isindebian };
+}
+
+sub getUscanData {
+ my $package = shift;
+ my $cmd;
+
+ $cmd = "svn cat ".$$package->uri."/debian/watch";
+ my $watch = `$cmd`;
+
+ return unless $watch;
+
+ my ($fh, $watchfile) = tempfile(SUFFIX => '.uscan');
+ print $fh $watch;
+ close ($fh);
+
+ my $majorrelease = $$package->svndebrelease;
+ $majorrelease =~ s/^\d+://;
+ $majorrelease =~ s/-[0-9A-Za-z\.~]*$//;
+ $cmd = "uscan --package ".$$package->name." --dehs --upstream-version ".$majorrelease." --watchfile ".$watchfile;
+ print $cmd."\n";
+ my @uscan = `$cmd`;
+ unlink $watchfile or warn;
+ return unless @uscan > 2; # empty output
+
+ my $tarballuri;
+ my $isuptodate = 't';
+ my $upstreamrelease;
+ foreach (@uscan) {
+ print;
+ $tarballuri = $1 if (/^<upstream-url>(.+)<\/upstream-url>$/);
+ if (/^<status>/) {
+ $isuptodate = 'f' unless (/^<status>up to date<\/status>$/);
+ }
+ $upstreamrelease = $1 if (/^<upstream-version>(.+)<\/upstream-version>$/);
+ }
+ $tarballuri = '' unless $isuptodate eq 't';
+
+ return {tarballuri => $tarballuri, isuptodate => $isuptodate, upstreamrelease => $upstreamrelease};
+}
+
+
sub importPkg {
print "ImportPkg\n";
- my( $repository, $uri, $tarballinrepository) = @_;
+ my( $repository, $uri, $tarballonrepository) = @_;
my @maintainer;
my $packagesrc;
@@ -74,53 +174,70 @@
}
}
}
- die "Parse error" unless $packagesrc;
+ if (!$packagesrc) {
+ print "Parse error: $uri/debian/control";
+ return;
+
+ }
+
my @changelog = `svn cat $uri/debian/changelog`;
if (@changelog && $changelog[0] =~ /^.*\ \((.*)\)/) {
- my $svndebrelease = $1;
- my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
- $package->update_from_related('repository_id',$$repository);
-
- 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);
- if ($res->is_success) {
- $package->istarballpresent(1);
- $package->tarballuri($tarballuri);
- }
- }
- $package->uri($uri);
+ $svndebrelease = $1;
- $package->rev($rev) if $rev;
- $package->repository_id($$repository);
+ } else {
- foreach my $maintainer (@maintainer) {
- my $package_maintainer =
- $package->find_or_create_related('package_maintainers', {
- 'maintainer_id' => $maintainer->id});
- }
- print "Update package\n";
- $package->update();
+ print "Parse error: $uri/debian/changelog\n";
+ return;
+ }
+
+ my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
+ $package->update_from_related('repository_id',$$repository);
+ $package->svndebrelease ($svndebrelease);
+ $package->uri($uri);
+ $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});
+ }
+
+
+ # Search for the tarball
+ my $tarball = mkTarballFromPackage(\$package);
+ my $uscandata = getUscanData(\$package);
+ my $ondebiandata = getOnDebianData(\$package);
+ my $tarballurlfromtarballlayout = createTarballUrlFromTarballlayout($repository,\$package);
+ # Is the tarball on a Debian mirror?
+ if ($ondebiandata->{tarballuri}) {
+ $package->tarballuri($ondebiandata->{tarballuri});
+ $package->istarballpresent(1);
+ # Or on upstream repository (using uscan)
+ } elsif($uscandata->{tarballuri}) {
+ $package->tarballuri($uscandata->{tarballuri});
+ $package->istarballpresent(1);
+ # Or on a HTTP/FTP space is a tarball layout exists
+ # for this repository
+ } elsif (testUrl($tarballurlfromtarballlayout)) {
+ $package->tarballuri($tarballurlfromtarballlayout);
+ $package->istarballpresent(1);
+ # Or on the same repository
+ } elsif(exists $tarballonrepository->{$tarball}) {
+ my $t = $tarballonrepository->{$tarball};
+ $t =~ s!svn://svn.debian.org/svn/(.*)!http://svn.debian.org/wsvn/$1?op=file&rev=0&sc=0!;
} else {
- print "Failed to parse $uri/debian/changelog\n";
- return;
- }
+ $package->tarballuri('');
+ $package->istarballpresent(0);
+ }
+
+ #
+ $package->isuptodate($uscandata->{isuptodate});
+ $package->upstreamrelease($uscandata->{upstreamrelease});
+ $package->isindebian($ondebiandata->{isindebian});
+ $package->update();
}
@@ -135,7 +252,7 @@
sub importRepository {
my $repository = shift;
- my $tarballinrepository;
+ my $tarballonrepository;
print "Repository: ".$$repository->name."\n";
my $t = 'svn ls -R '.$$repository->uri;
@@ -144,7 +261,7 @@
foreach (`$t`) {
chomp;
my $uri = $$repository->uri.'/'.$_;
- $tarballinrepository->{basename($_)}=$uri if /\.tar\.gz$/;
+ $tarballonrepository->{basename($_)}=$uri if /\.tar\.gz$/;
$uri =~ s/\/$//;
next if /\/(tags|branches|attic)\//; # I want trunk!
next if /\/(sarge|etch)\//; # Try to avoid sarge and etch backport
@@ -156,8 +273,8 @@
foreach my $uri (@uri) {
# look for packages
print "->".$uri."\n";
- #my $pid = $poolImportPkg->add($repository,$uri,$tarballinrepository) or die "Fucked!\n";
- importPkg($repository,$uri,$tarballinrepository);
+ #my $pid = $poolImportPkg->add($repository,$uri,$tarballonrepository) or die "Fucked!\n";
+ importPkg($repository,$uri,$tarballonrepository);
}
print "end import Repo\n";
}
More information about the Pkg-games-commits
mailing list