[Collab-qa-commits] r503 - svnbuildstat/trunk/script
goneri-guest at alioth.debian.org
goneri-guest at alioth.debian.org
Sat Nov 10 13:28:54 UTC 2007
Author: goneri-guest
Date: 2007-11-10 13:28:54 +0000 (Sat, 10 Nov 2007)
New Revision: 503
Added:
svnbuildstat/trunk/script/svnbuildstat_update-db-svn.pl
Removed:
svnbuildstat/trunk/script/svnbuildstat_update-db.pl
Log:
rename script/svnbuildstat_update-db.pl to script/svnbuildstat_update-db-svn.pl
since it works only with svn.
Copied: svnbuildstat/trunk/script/svnbuildstat_update-db-svn.pl (from rev 502, svnbuildstat/trunk/script/svnbuildstat_update-db.pl)
===================================================================
--- svnbuildstat/trunk/script/svnbuildstat_update-db-svn.pl (rev 0)
+++ svnbuildstat/trunk/script/svnbuildstat_update-db-svn.pl 2007-11-10 13:28:54 UTC (rev 503)
@@ -0,0 +1,479 @@
+#!/usr/bin/perl -w
+use File::Temp qw/ tempfile /;
+
+use strict;
+
+use LWP::UserAgent;
+use Data::Dumper;
+use File::Basename;
+use Time::Local 'timelocal_nocheck';
+
+use threads;
+use threads::shared;
+use Thread::Pool::Simple;
+
+use Thread::Pool::Simple;
+use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
+use SvnBuildStat::Schema;
+use SvnBuildStat::Config;
+use Logger::Syslog;
+
+my $config;
+my $schema;
+
+my $poolImportPkg;
+
+sub getRev {
+ my $uri = shift;
+
+ foreach (`LC_ALL=C svn info $uri`) {
+ return $1 if /Last Changed Rev:\ (\d+)/;
+ }
+
+ return;
+}
+
+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/;
+# print "\n--->".$tarballuri."\n";
+
+ return $tarballuri;
+}
+
+sub getOnDebianData {
+ my $package = shift;
+ return unless $$package->name;
+ return unless $$package->svndebrelease;
+ my $svndebrelease = $$package->svndebrelease;
+ $svndebrelease =~ s/^\d+://; # remove the EPOCH
+
+ my $isindebian = 'f';
+ my $tarballuri;
+ my $isnative = 'f';
+
+ my $ua = LWP::UserAgent->new;
+ $ua->agent("SvnBuildStat/0.1 ");
+
+ if ($$package->svndebrelease !~ /-[\d+\.]+$/) {
+ $isnative = 't';
+ } else {
+ my $debmirror = 'http://ftp.debian.org/debian';
+ my $debdiff .= $$package->name."_".$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;
+ if (testUrl($debdiffuri)) {
+ $isindebian = 't';
+ }
+ if (testUrl($tmp_tarballuri)) {
+ $tarballuri = $tmp_tarballuri;
+ $tarballuri =~ s/^$debmirror/\@DEBMIRROR@/;
+ }
+ }
+ }
+ }
+ return { tarballuri => $tarballuri, isindebian => $isindebian, isnative => $isnative };
+}
+
+sub getUscanData {
+ my $package = shift;
+ my $cmd;
+
+ return unless $$package->svndebrelease;
+ return unless $$package->vcsuri;
+
+ $cmd = "svn cat ".$$package->vcsuri."/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\.~]*$//;
+ $majorrelease =~ s/dfsg.*//;
+ $majorrelease =~ s/\d+://;
+ $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 = 'f';
+ my $iswatchfilebroken = 'f';
+ my $upstreamrelease;
+ foreach (@uscan) {
+# print;
+ $tarballuri = $1 if (/^<upstream-url>(.+tar\.gz)<\/upstream-url>$/i);
+ $isuptodate = 't' if (/^<status>up to date<\/status>$/);
+ $upstreamrelease = $1 if (/^<upstream-version>(.+)<\/upstream-version>$/);
+ $iswatchfilebroken = 't' if (/^<errors>/);
+ }
+ $iswatchfilebroken = 't' unless $upstreamrelease;
+ $tarballuri = '' unless $isuptodate eq 't';
+
+ return {tarballuri => $tarballuri, isuptodate => $isuptodate, upstreamrelease => $upstreamrelease, iswatchfilebroken => $iswatchfilebroken};
+}
+
+sub updateChangelog {
+ my $package = shift;
+
+ print "UPDATE CHANGELOG\n";
+
+ my $last_rev;
+ my $vcschangelog_rs = $schema->resultset('Vcschangelog')->search({
+ package_id => $$package->id,
+ }, {order_by => "rev DESC"});
+ $last_rev = $vcschangelog_rs->first->rev if ($vcschangelog_rs->first);
+ if (!$last_rev) {
+ my $build_rs = $schema->resultset('Build')->search({
+ package_id => $$package->id,
+ }, {order_by => "rev"});
+ $last_rev = $build_rs->first->rev if ($build_rs->first);
+ }
+
+ return unless $last_rev;
+ print "LAST REV:". $last_rev."\n";
+
+ my $cmd = "LC_ALL=C svn log -r ".$last_rev.":".$$package->rev." ".$$package->vcsuri;
+ my $begin;
+ my $entry;
+ foreach (`$cmd`) {
+ if (/^------------------------------------------------------------------------/) {
+ $begin = 1;
+ $entry->update if $entry;
+ $entry = undef;
+ } elsif ($begin) {
+ if (/r(\d+)\s\|\s(\S+)\s\|\s(20\d\d-\d\d-\d\d\s\d\d:\d\d:\d\d)/) {
+ my $rev = $1;
+ my $login = $2;
+ my $date = $3;
+ my $userlogin = $schema->resultset('Userlogin')->find_or_create({name=>$login});
+ $entry = $schema->resultset('Vcschangelog')->create({
+ userlogin_id =>$userlogin->id,
+ package_id => $$package->id,
+ date => $date,
+ rev => $rev,
+ });
+
+ $begin = 0;
+ }
+
+ } elsif ($entry) {
+ $entry->log($entry->log.$_);
+ }
+
+ }
+ $entry->update if $entry;
+}
+
+sub importPkg {
+ my( $repository, $uri, $tarballonrepository) = @_;
+
+ my @maintainer;
+ my $packagesrc;
+ my $svndebrelease;
+ my $tarballuri;
+ my $rev = getRev($uri);
+ my $todo;
+ my $currentpendingbug;
+ my $currentchangelogentry;
+# arch
+ my $i386 = 'f';
+ my $powerpc = 'f';
+ my $sparc = 'f';
+ my $amd64 = 'f';
+
+
+ return unless $rev;
+
+ my @control = `svn cat $uri/debian/control`;
+ return unless @control;
+ foreach (@control) {
+ $packagesrc = $1 if /^Source:\ *(.*)/;
+ if (/^(Maintainer|Uploaders):\ *(.*)/) {
+ my $tmp = $2;
+ foreach (split /,/, $tmp) {
+ if (/(.+)<(.+)>/) {
+ my $name = $1;
+ my $email = $2;
+ $name =~ s/^\ *//;
+ $name =~ s/\ $//;
+ my $maintainer = $schema->resultset('Maintainer')->find_or_create({email=>$email});
+ $maintainer->name($name);
+ $maintainer->update();
+ push @maintainer, $maintainer;
+ }
+
+ }
+ } elsif (/^Architecture: (.*)/) {
+ my $arch = $1;
+ $i386 = 't' if $arch =~ /(any|all|i386)/;
+ $powerpc = 't' if $arch =~ /(any|all|powerpc)/;
+ $sparc = 't' if $arch =~ /(any|all|sparc)/;
+ $amd64 = 't' if $arch =~ /(any|all|amd64)/;
+ }
+ }
+ if (!$packagesrc) {
+
+ print "Parse error: $uri/debian/control";
+ return;
+
+ }
+ my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
+
+ # if the source is not in the pool I can suppose the tarball was missing for the last
+ # check and so I need to check periodicly to see if the status has changed
+ if (defined($rev) && defined ($package->rev) && $rev > $package->rev) {
+ if (!$package->issrcinmypool) {
+ my ($year, $mon, $day, $hour, $min, $sec) = ($package->lastcheck =~ /(\d{4})-(\d+)-(\d+)\ (\d+):(\d+):(\d+)/);
+ my $lastcheck = timelocal_nocheck($sec, $min, $hour, $day, $mon, $year);
+ if ($lastcheck > time - 3600*24) {
+ print "No need to refresh ".$package->name."\n";
+ return;
+ }
+ }
+ return;
+ }
+ print "GO ".$package->name."\n";
+
+ $package->issrcinmypool (0);
+
+ my @changelog = `svn cat $uri/debian/changelog`;
+ if (@changelog) {
+ if ($changelog[0] =~ /^.*\ \((.*)\)/) {
+$package->realsvndebrelease($1)
+ }
+
+ foreach (@changelog) {
+ if (/^\S/ && $currentchangelogentry) {
+ # I ignore svn-bp empty template entry
+ if ($currentchangelogentry =~ /^.*\n\s\s\*\sNOT RELEASED YET\n\n\s--.*/m) {
+ $currentchangelogentry = '';
+ } else {
+ last;
+ }
+ }
+ $currentchangelogentry .= $_;
+ }
+
+ if ($currentchangelogentry =~ /^.*\ \((.*)\)/) {
+ $svndebrelease = $1;
+ }
+ # looks for bug closed in the changelog entry
+ # the regex come from the BTS documentation
+ # TODO dpkg-parsechangelog is probably more suitable for the job :D
+ foreach ($currentchangelogentry =~ /closes:\s*(?:bug)?\#\s*\d+(?:,\s*(?:bug)?\#\s*\d+)*/ig) {
+ s/([A-Za-z]|#|:|\s)//g;
+ $currentpendingbug .= $_.',' if $_;
+ }
+
+ } else {
+
+ print "Parse error: $uri/debian/changelog\n";
+ return;
+
+ }
+
+ my @todo = `svn cat $uri/debian/TODO`;
+ @todo = `svn cat $uri/debian/TODO.Debian` unless @todo;
+ @todo = `svn cat $uri/debian/todo` unless @todo;
+ if (@todo) {
+ $todo .= $_ foreach @todo;
+ }
+ $package->update_from_related('repository_id',$$repository);
+
+ $package->svndebrelease ($svndebrelease);
+ $package->vcsuri($uri);
+ $package->repository_id($$repository);
+ foreach my $maintainer (@maintainer) {
+ my $package_maintainer =
+ $package->find_or_create_related('package_maintainers', {
+ 'maintainer_id' => $maintainer->id});
+ }
+
+
+# updateChangelog(\$package);
+ # Search for the tarball
+ my $tarball = mkTarballFromPackage(\$package);
+ my $uscandata = getUscanData(\$package);
+ my $ondebiandata = getOnDebianData(\$package);
+ my $tarballurlfromtarballlayout = createTarballUrlFromTarballlayout($repository,\$package);
+ $package->iswatchfilebroken($uscandata->{iswatchfilebroken});
+ # Is the tarball on a Debian mirror?
+ if ($ondebiandata->{isnative} eq 't') {
+ $package->isnative(1);
+ $package->tarballuri('');
+ $package->istarballpresent(0);
+ } else {
+ $package->isnative(0);
+ 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
+ } 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 {
+ $package->tarballuri('');
+ $package->istarballpresent(0);
+ }
+ }
+
+ #
+ $package->isuptodate($uscandata->{isuptodate});
+ $package->upstreamrelease($uscandata->{upstreamrelease});
+ $package->isindebian($ondebiandata->{isindebian});
+
+ $package->i386($i386);
+ $package->powerpc($powerpc);
+ $package->sparc($sparc);
+ $package->amd64($amd64);
+ $package->todo($todo);
+ $package->currentchangelogentry($currentchangelogentry);
+ $package->currentpendingbug($currentpendingbug);
+ $package->lastcheck('now');
+ $package->rev($rev); # at the end since it marks in the new status of the package ins the DB
+ $package->update();
+}
+
+
+$config = new SvnBuildStat::Config();
+$schema = SvnBuildStat::Schema->connect(
+ $config->db_dsn,
+ $config->db_user,
+ $config->db_password,
+ {AutoCommit => 1, debug => 1}
+);
+
+sub importRepository {
+ my $repository = shift;
+
+
+ my $tarballonrepository;
+ print "Repository: ".$$repository->name."\n";
+ my $t = 'svn ls -R '.$$repository->vcsuri;
+ my $rev = getRev($$repository->vcsuri);
+ if(! $rev) {
+ print "Failed to get the current revision of ".$$repository->name."\n";
+ return;
+ }
+
+ if ($$repository->rev eq $rev && $$repository->lastcheck) {
+ # If he repository is up to date, a still do a refresh every 48h
+ # this because of the tarball check
+ #
+ my ($year, $mon, $day, $hour, $min, $sec) = ($$repository->lastcheck =~ /(\d{4})-(\d+)-(\d+)\ (\d+):(\d+):(\d+)/);
+ my $lastcheck = timelocal_nocheck($sec, $min, $hour, $day, $mon, $year);
+ if ($lastcheck > time - 3600*48) {
+ print "No need to refresh ".$$repository->name."\n";
+ return;
+ }
+ }
+
+ my @uri;
+
+ foreach (`$t`) {
+ chomp;
+ my $uri = $$repository->vcsuri.'/'.$_;
+ $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
+ next unless /debian\/control$/;
+ $uri =~ s/(|\/)debian\/control$//;
+ push @uri, $uri;
+ }
+
+ foreach my $uri (@uri) {
+ # look for packages
+ $poolImportPkg->add($repository,$uri,$tarballonrepository) or die "Fucked\n";
+ }
+
+ $$repository->rev($rev);
+ $$repository->lastcheck('now');
+ $$repository->update();
+
+ print "end import Repo\n";
+}
+###################################################
+###################################################
+###################################################
+###################################################
+###################################################
+############### MAIN ##############################
+###################################################
+###################################################
+
+info ("starting");
+########## THREAD POOLS #####
+$poolImportPkg = Thread::Pool::Simple->new(
+ min => 5,
+ max => 5,
+ load => 3,
+ do => [\&importPkg],
+ lifespan => 1
+ );
+
+########
+
+# Import packages
+my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
+while (my $repository = $repository_rs->next) {
+ importRepository(\$repository) or warn "importRepository failed for ".$repository->name."\n";
+}
+$poolImportPkg->join;
+
+# Purge the removed packages
+# This semems to be fucked?
+#my $interval = "< repository_id.lastcheck - interval '1 day'";
+#my $package_rs = $schema->resultset('Package')->search({'me.lastcheck' => \$interval} , {join => => 'repository_id'});
+#$package_rs->delete_all;
+
+info ("stopping");
+
Deleted: svnbuildstat/trunk/script/svnbuildstat_update-db.pl
===================================================================
--- svnbuildstat/trunk/script/svnbuildstat_update-db.pl 2007-11-10 13:27:14 UTC (rev 502)
+++ svnbuildstat/trunk/script/svnbuildstat_update-db.pl 2007-11-10 13:28:54 UTC (rev 503)
@@ -1,479 +0,0 @@
-#!/usr/bin/perl -w
-use File::Temp qw/ tempfile /;
-
-use strict;
-
-use LWP::UserAgent;
-use Data::Dumper;
-use File::Basename;
-use Time::Local 'timelocal_nocheck';
-
-use threads;
-use threads::shared;
-use Thread::Pool::Simple;
-
-use Thread::Pool::Simple;
-use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
-use SvnBuildStat::Schema;
-use SvnBuildStat::Config;
-use Logger::Syslog;
-
-my $config;
-my $schema;
-
-my $poolImportPkg;
-
-sub getRev {
- my $uri = shift;
-
- foreach (`LC_ALL=C svn info $uri`) {
- return $1 if /Last Changed Rev:\ (\d+)/;
- }
-
- return;
-}
-
-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/;
-# print "\n--->".$tarballuri."\n";
-
- return $tarballuri;
-}
-
-sub getOnDebianData {
- my $package = shift;
- return unless $$package->name;
- return unless $$package->svndebrelease;
- my $svndebrelease = $$package->svndebrelease;
- $svndebrelease =~ s/^\d+://; # remove the EPOCH
-
- my $isindebian = 'f';
- my $tarballuri;
- my $isnative = 'f';
-
- my $ua = LWP::UserAgent->new;
- $ua->agent("SvnBuildStat/0.1 ");
-
- if ($$package->svndebrelease !~ /-[\d+\.]+$/) {
- $isnative = 't';
- } else {
- my $debmirror = 'http://ftp.debian.org/debian';
- my $debdiff .= $$package->name."_".$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;
- if (testUrl($debdiffuri)) {
- $isindebian = 't';
- }
- if (testUrl($tmp_tarballuri)) {
- $tarballuri = $tmp_tarballuri;
- $tarballuri =~ s/^$debmirror/\@DEBMIRROR@/;
- }
- }
- }
- }
- return { tarballuri => $tarballuri, isindebian => $isindebian, isnative => $isnative };
-}
-
-sub getUscanData {
- my $package = shift;
- my $cmd;
-
- return unless $$package->svndebrelease;
- return unless $$package->vcsuri;
-
- $cmd = "svn cat ".$$package->vcsuri."/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\.~]*$//;
- $majorrelease =~ s/dfsg.*//;
- $majorrelease =~ s/\d+://;
- $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 = 'f';
- my $iswatchfilebroken = 'f';
- my $upstreamrelease;
- foreach (@uscan) {
-# print;
- $tarballuri = $1 if (/^<upstream-url>(.+tar\.gz)<\/upstream-url>$/i);
- $isuptodate = 't' if (/^<status>up to date<\/status>$/);
- $upstreamrelease = $1 if (/^<upstream-version>(.+)<\/upstream-version>$/);
- $iswatchfilebroken = 't' if (/^<errors>/);
- }
- $iswatchfilebroken = 't' unless $upstreamrelease;
- $tarballuri = '' unless $isuptodate eq 't';
-
- return {tarballuri => $tarballuri, isuptodate => $isuptodate, upstreamrelease => $upstreamrelease, iswatchfilebroken => $iswatchfilebroken};
-}
-
-sub updateChangelog {
- my $package = shift;
-
- print "UPDATE CHANGELOG\n";
-
- my $last_rev;
- my $vcschangelog_rs = $schema->resultset('Vcschangelog')->search({
- package_id => $$package->id,
- }, {order_by => "rev DESC"});
- $last_rev = $vcschangelog_rs->first->rev if ($vcschangelog_rs->first);
- if (!$last_rev) {
- my $build_rs = $schema->resultset('Build')->search({
- package_id => $$package->id,
- }, {order_by => "rev"});
- $last_rev = $build_rs->first->rev if ($build_rs->first);
- }
-
- return unless $last_rev;
- print "LAST REV:". $last_rev."\n";
-
- my $cmd = "LC_ALL=C svn log -r ".$last_rev.":".$$package->rev." ".$$package->vcsuri;
- my $begin;
- my $entry;
- foreach (`$cmd`) {
- if (/^------------------------------------------------------------------------/) {
- $begin = 1;
- $entry->update if $entry;
- $entry = undef;
- } elsif ($begin) {
- if (/r(\d+)\s\|\s(\S+)\s\|\s(20\d\d-\d\d-\d\d\s\d\d:\d\d:\d\d)/) {
- my $rev = $1;
- my $login = $2;
- my $date = $3;
- my $userlogin = $schema->resultset('Userlogin')->find_or_create({name=>$login});
- $entry = $schema->resultset('Vcschangelog')->create({
- userlogin_id =>$userlogin->id,
- package_id => $$package->id,
- date => $date,
- rev => $rev,
- });
-
- $begin = 0;
- }
-
- } elsif ($entry) {
- $entry->log($entry->log.$_);
- }
-
- }
- $entry->update if $entry;
-}
-
-sub importPkg {
- my( $repository, $uri, $tarballonrepository) = @_;
-
- my @maintainer;
- my $packagesrc;
- my $svndebrelease;
- my $tarballuri;
- my $rev = getRev($uri);
- my $todo;
- my $currentpendingbug;
- my $currentchangelogentry;
-# arch
- my $i386 = 'f';
- my $powerpc = 'f';
- my $sparc = 'f';
- my $amd64 = 'f';
-
-
- return unless $rev;
-
- my @control = `svn cat $uri/debian/control`;
- return unless @control;
- foreach (@control) {
- $packagesrc = $1 if /^Source:\ *(.*)/;
- if (/^(Maintainer|Uploaders):\ *(.*)/) {
- my $tmp = $2;
- foreach (split /,/, $tmp) {
- if (/(.+)<(.+)>/) {
- my $name = $1;
- my $email = $2;
- $name =~ s/^\ *//;
- $name =~ s/\ $//;
- my $maintainer = $schema->resultset('Maintainer')->find_or_create({email=>$email});
- $maintainer->name($name);
- $maintainer->update();
- push @maintainer, $maintainer;
- }
-
- }
- } elsif (/^Architecture: (.*)/) {
- my $arch = $1;
- $i386 = 't' if $arch =~ /(any|all|i386)/;
- $powerpc = 't' if $arch =~ /(any|all|powerpc)/;
- $sparc = 't' if $arch =~ /(any|all|sparc)/;
- $amd64 = 't' if $arch =~ /(any|all|amd64)/;
- }
- }
- if (!$packagesrc) {
-
- print "Parse error: $uri/debian/control";
- return;
-
- }
- my $package = $schema->resultset('Package')->find_or_create({name => $packagesrc});
-
- # if the source is not in the pool I can suppose the tarball was missing for the last
- # check and so I need to check periodicly to see if the status has changed
- if (defined($rev) && defined ($package->rev) && $rev > $package->rev) {
- if (!$package->issrcinmypool) {
- my ($year, $mon, $day, $hour, $min, $sec) = ($package->lastcheck =~ /(\d{4})-(\d+)-(\d+)\ (\d+):(\d+):(\d+)/);
- my $lastcheck = timelocal_nocheck($sec, $min, $hour, $day, $mon, $year);
- if ($lastcheck > time - 3600*24) {
- print "No need to refresh ".$package->name."\n";
- return;
- }
- }
- return;
- }
- print "GO ".$package->name."\n";
-
- $package->issrcinmypool (0);
-
- my @changelog = `svn cat $uri/debian/changelog`;
- if (@changelog) {
- if ($changelog[0] =~ /^.*\ \((.*)\)/) {
-$package->realsvndebrelease($1)
- }
-
- foreach (@changelog) {
- if (/^\S/ && $currentchangelogentry) {
- # I ignore svn-bp empty template entry
- if ($currentchangelogentry =~ /^.*\n\s\s\*\sNOT RELEASED YET\n\n\s--.*/m) {
- $currentchangelogentry = '';
- } else {
- last;
- }
- }
- $currentchangelogentry .= $_;
- }
-
- if ($currentchangelogentry =~ /^.*\ \((.*)\)/) {
- $svndebrelease = $1;
- }
- # looks for bug closed in the changelog entry
- # the regex come from the BTS documentation
- # TODO dpkg-parsechangelog is probably more suitable for the job :D
- foreach ($currentchangelogentry =~ /closes:\s*(?:bug)?\#\s*\d+(?:,\s*(?:bug)?\#\s*\d+)*/ig) {
- s/([A-Za-z]|#|:|\s)//g;
- $currentpendingbug .= $_.',' if $_;
- }
-
- } else {
-
- print "Parse error: $uri/debian/changelog\n";
- return;
-
- }
-
- my @todo = `svn cat $uri/debian/TODO`;
- @todo = `svn cat $uri/debian/TODO.Debian` unless @todo;
- @todo = `svn cat $uri/debian/todo` unless @todo;
- if (@todo) {
- $todo .= $_ foreach @todo;
- }
- $package->update_from_related('repository_id',$$repository);
-
- $package->svndebrelease ($svndebrelease);
- $package->vcsuri($uri);
- $package->repository_id($$repository);
- foreach my $maintainer (@maintainer) {
- my $package_maintainer =
- $package->find_or_create_related('package_maintainers', {
- 'maintainer_id' => $maintainer->id});
- }
-
-
-# updateChangelog(\$package);
- # Search for the tarball
- my $tarball = mkTarballFromPackage(\$package);
- my $uscandata = getUscanData(\$package);
- my $ondebiandata = getOnDebianData(\$package);
- my $tarballurlfromtarballlayout = createTarballUrlFromTarballlayout($repository,\$package);
- $package->iswatchfilebroken($uscandata->{iswatchfilebroken});
- # Is the tarball on a Debian mirror?
- if ($ondebiandata->{isnative} eq 't') {
- $package->isnative(1);
- $package->tarballuri('');
- $package->istarballpresent(0);
- } else {
- $package->isnative(0);
- 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
- } 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 {
- $package->tarballuri('');
- $package->istarballpresent(0);
- }
- }
-
- #
- $package->isuptodate($uscandata->{isuptodate});
- $package->upstreamrelease($uscandata->{upstreamrelease});
- $package->isindebian($ondebiandata->{isindebian});
-
- $package->i386($i386);
- $package->powerpc($powerpc);
- $package->sparc($sparc);
- $package->amd64($amd64);
- $package->todo($todo);
- $package->currentchangelogentry($currentchangelogentry);
- $package->currentpendingbug($currentpendingbug);
- $package->lastcheck('now');
- $package->rev($rev); # at the end since it marks in the new status of the package ins the DB
- $package->update();
-}
-
-
-$config = new SvnBuildStat::Config();
-$schema = SvnBuildStat::Schema->connect(
- $config->db_dsn,
- $config->db_user,
- $config->db_password,
- {AutoCommit => 1, debug => 1}
-);
-
-sub importRepository {
- my $repository = shift;
-
-
- my $tarballonrepository;
- print "Repository: ".$$repository->name."\n";
- my $t = 'svn ls -R '.$$repository->vcsuri;
- my $rev = getRev($$repository->vcsuri);
- if(! $rev) {
- print "Failed to get the current revision of ".$$repository->name."\n";
- return;
- }
-
- if ($$repository->rev eq $rev && $$repository->lastcheck) {
- # If he repository is up to date, a still do a refresh every 48h
- # this because of the tarball check
- #
- my ($year, $mon, $day, $hour, $min, $sec) = ($$repository->lastcheck =~ /(\d{4})-(\d+)-(\d+)\ (\d+):(\d+):(\d+)/);
- my $lastcheck = timelocal_nocheck($sec, $min, $hour, $day, $mon, $year);
- if ($lastcheck > time - 3600*48) {
- print "No need to refresh ".$$repository->name."\n";
- return;
- }
- }
-
- my @uri;
-
- foreach (`$t`) {
- chomp;
- my $uri = $$repository->vcsuri.'/'.$_;
- $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
- next unless /debian\/control$/;
- $uri =~ s/(|\/)debian\/control$//;
- push @uri, $uri;
- }
-
- foreach my $uri (@uri) {
- # look for packages
- $poolImportPkg->add($repository,$uri,$tarballonrepository) or die "Fucked\n";
- }
-
- $$repository->rev($rev);
- $$repository->lastcheck('now');
- $$repository->update();
-
- print "end import Repo\n";
-}
-###################################################
-###################################################
-###################################################
-###################################################
-###################################################
-############### MAIN ##############################
-###################################################
-###################################################
-
-info ("starting");
-########## THREAD POOLS #####
-$poolImportPkg = Thread::Pool::Simple->new(
- min => 5,
- max => 5,
- load => 3,
- do => [\&importPkg],
- lifespan => 1
- );
-
-########
-
-# Import packages
-my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
-while (my $repository = $repository_rs->next) {
- importRepository(\$repository) or warn "importRepository failed for ".$repository->name."\n";
-}
-$poolImportPkg->join;
-
-# Purge the removed packages
-# This semems to be fucked?
-#my $interval = "< repository_id.lastcheck - interval '1 day'";
-#my $package_rs = $schema->resultset('Package')->search({'me.lastcheck' => \$interval} , {join => => 'repository_id'});
-#$package_rs->delete_all;
-
-info ("stopping");
-
More information about the Collab-qa-commits
mailing list