[Collab-qa-commits] r500 - svnbuildstat/trunk/script
goneri-guest at alioth.debian.org
goneri-guest at alioth.debian.org
Sat Nov 10 01:42:05 UTC 2007
Author: goneri-guest
Date: 2007-11-10 01:42:05 +0000 (Sat, 10 Nov 2007)
New Revision: 500
Added:
svnbuildstat/trunk/script/svnbuildstat_purge-repository.pl
Modified:
svnbuildstat/trunk/script/svnbuildstat_update-repository.pl
Log:
move the purge part of svnbuildstat_update-repository.pl in
svnbuildstat_purge-repository.pl.
Both scripts 'd been fully rewrite in order to support git and friends.
Added: svnbuildstat/trunk/script/svnbuildstat_purge-repository.pl
===================================================================
--- svnbuildstat/trunk/script/svnbuildstat_purge-repository.pl (rev 0)
+++ svnbuildstat/trunk/script/svnbuildstat_purge-repository.pl 2007-11-10 01:42:05 UTC (rev 500)
@@ -0,0 +1,102 @@
+#!/usr/bin/perl -w
+
+use strict;
+#chdir "/home/sites/nana.rulezlan.org/debian/" or die;
+
+use LWP::Simple;
+use File::Basename;
+use File::Glob qw/:globally/;
+use File::Find;
+use File::Touch;
+use File::Copy;
+use File::stat;
+use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
+use SvnBuildStat::Schema;
+use SvnBuildStat::Config;
+use Logger::Syslog;
+
+my $debmirror = "http://ftp.debian.org";
+my $config;
+my $schema;
+
+
+##########################################
+##########################################
+################## MAIN ##################
+##########################################
+##########################################
+foreach (<lock.*>) {
+ /lock.(\d+)/;
+ my $pid = $1;
+ if (open (CMDLINE, "/proc/$pid/cmdline")) {
+ my $content = <CMDLINE>;
+ if ($content =~ /svnbuildstat_update-repository\.pl/) {
+ die "an instance is already running (pid $pid)";
+ }
+ }
+ unlink 'lock.'.$pid;
+}
+touch "lock.$$";
+info ("starting");
+
+
+$config = new SvnBuildStat::Config();
+$schema = SvnBuildStat::Schema->connect(
+ $config->db_dsn,
+ $config->db_user,
+ $config->db_password,
+ {AutoCommit => 1, debug => 1}
+);
+# It's not a joke since I'll do rm -Rf in this directory and don't want to trash
+# the system yet :)
+die "server_repository is unset!\n" unless $config->server_repositorydir;
+
+#purgeOutDated();
+
+my $package_rs = $schema->resultset('Package')->search({issrcinmypool => 'false'});
+while (my $package = $package_rs->next) {
+ next unless $package->name;
+ next unless $package->realsvndebrelease;
+
+ my $vcs = $package->repository_id->repositoryfamily_id->vcs_id->name;
+ next unless $vcs;
+ my $workdir = $config->server_repositorydir.'/'.
+ $package->repository_id->team_id->shortname.'/'.
+ $package->name;
+
+ # vcs
+ foreach my $file (<$workdir/*.dsc>) {
+
+ my $sb = stat($file);
+ next unless (time - $sb->ctime > 36000);
+
+ if ($file =~ /^(.*_)(.*-[\d\.+]+)~$vcs(\w+)\.dsc/) {
+ my $begin = $1;
+ my $debrelease = $2;
+ my $vcsrelease = $3;
+ my $purge;
+
+ if ($package->svndebrelease ne $debrelease) {
+ $purge = 1;
+ }
+
+
+ if (!$purge &&
+ ($vcs eq "svn" && $vcsrelease < $package->rev)||
+ ($vcs eq "git" && $vcsrelease ne $package->rev)) {
+ $purge = 1;
+ }
+
+ if ($purge) {
+ print "unlink $begin$debrelease~$vcs$vcsrelease.dsc\n";
+ print "unlink $begin$debrelease~$vcs$vcsrelease.diff.gz\n";
+ }
+
+ }
+ }
+
+}
+
+
+info ("stopping");
+unlink "lock.".$$;
Property changes on: svnbuildstat/trunk/script/svnbuildstat_purge-repository.pl
___________________________________________________________________
Name: svn:executable
+ *
Modified: svnbuildstat/trunk/script/svnbuildstat_update-repository.pl
===================================================================
--- svnbuildstat/trunk/script/svnbuildstat_update-repository.pl 2007-11-07 13:19:04 UTC (rev 499)
+++ svnbuildstat/trunk/script/svnbuildstat_update-repository.pl 2007-11-10 01:42:05 UTC (rev 500)
@@ -1,210 +1,187 @@
#!/usr/bin/perl -w
use strict;
-print STDERR "WARNING: this script \"purge\" the working directory!!! Be careful\n";
-sleep 2;
-# TODO: purge the directory
-chdir "/home/sites/nana.rulezlan.org/debian/" or die;
-#use lib ".";
+#chdir "/home/sites/nana.rulezlan.org/debian/" or die;
use LWP::Simple;
use File::Basename;
use File::Glob qw/:globally/;
use File::Find;
use File::Touch;
-
+use File::Copy;
+use File::stat;
use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
-
-foreach (<lock.*>) {
- /lock.(\d+)/;
- my $pid = $1;
- if (open (CMDLINE, "/proc/$pid/cmdline")) {
- my $content = <CMDLINE>;
- if ($content =~ /svnbuildstat_update-repository\.pl/) {
- die "an instance is already running (pid $pid)";
- }
- }
- unlink 'lock.'.$pid;
-}
-touch "lock.$$";
use SvnBuildStat::Schema;
use SvnBuildStat::Config;
+use Logger::Syslog;
my $debmirror = "http://ftp.debian.org";
my $config;
my $schema;
-sub purge {
- opendir(DIR, '.') || die "can't opendir .: $!";
- while (my $entry = readdir(DIR)) {
- if( -d $entry ) {
- next if $entry =~ /^\.{1,2}/;
- } elsif ( -f $entry ) {
- next unless $entry =~ /.*\diff\.gz\.new\..*/;
- }
- print "remove: $entry\n";
- `rm -Rf $entry`;
- }
- closedir DIR;
-}
+sub addSubRevInChangelog {
-sub purgeOutDated {
- my $package_rs = $schema->resultset('Package');
- while (my $package = $package_rs->next) {
- next unless $package->name;
- next unless $package->svndebrelease;
+ my ($rootdir, $subrev) = @_;
+
+ open ORIG, "<$rootdir/debian/changelog" or return;
+ my @orig = <ORIG>;
+ close ORIG;
- my $svndebrelease = $package->realsvndebrelease;
- $svndebrelease =~ s/^\d+://;
+ return unless ($orig[0] =~ s/\((.*)\)/($1~$subrev)/);
- if (open REV, "<".$package->name."_".$svndebrelease.".rev") {
- my $revInRepo = <REV>;
- close REV;
- next if $revInRepo eq $package->rev;
- }
-
- $package->issrcinmypool('false');
- my $t = $package->name."_*";
- unlink foreach (CORE::glob($t));
+ open DEST, ">$rootdir/debian/changelog" or return;
+ foreach (@orig) {
+ print DEST;
}
+ close DEST;
+
}
-sub updateIsSrcInMyPoolFromFiles {
- my $package_rs = $schema->resultset('Package');
- while (my $package = $package_rs->next) {
- next unless $package->realsvndebrelease;
+sub fetchAndPrepareDirectoryForMergeWithUpstream {
- my $svndebrelease = $package->realsvndebrelease;
- $svndebrelease =~ s/^\d+://;
+ my ($package, $workdir) = @_;
- if ( -f $package->name."_".$svndebrelease.".dsc") {
- $package->issrcinmypool('true');
- } else {
- $package->issrcinmypool('false');
- }
- $package->update;
- }
-}
+ my $tarball = mkTarballFromPackage($package);
-sub updateSources {
- my $package_rs = $schema->resultset('Package')->search({issrcinmypool => 'false'});
- while (my $package = $package_rs->next) {
- next unless $package->realsvndebrelease;
+ return unless $tarball;
+ debug("looks for the tarball");
- my $svndebrelease = $package->realsvndebrelease;
- $svndebrelease =~ s/^\d+://;
- my $failedNotifFile = $package->name."_".$svndebrelease.".dsc.failed";
+ # TODO Will always fails because I should check the
+ # package repository directly
+ if (!-f "$workdir/$tarball") {
+ debug("the tarball is needed");
+ my $tarballuri = $$package->tarballuri;
+ return unless $tarballuri;
+ $tarballuri =~ s/\@DEBMIRROR@/$debmirror/;
- next if -f $failedNotifFile;
- next unless ($package->isnative or $package->istarballpresent);
- purge();
- my $log = [];
- if (!prepare(\$package, $log)) {
- if (open LOG, ">".$failedNotifFile) {
- print LOG $_ foreach (@$log);
- } else { warn "Can't write log file\n" }
+ if (is_error(getstore($tarballuri,"$workdir/$tarball"))) {
+# debug("failed to download ".$tarballuri);
+ return;
}
}
+
+ chdir $workdir or die;
+ my $rootdirectory;
+ foreach (`tar tf $tarball 2>&1`) {
+ if (/^(.\/|)(.*?)\//) {
+ if ($rootdirectory && $rootdirectory ne $2) {
+ info("tarball has more than one root directory! I ignore it");
+ return;
+ }
+ $rootdirectory = $2;
+ }
+ }
+ `tar xf $tarball 2>&1`;
+ if (($? >> 8)!=0) {
+ info("failed to untar $tarball");
+ return;
+ }
+ if (!move($rootdirectory, mkRootdirectoryFromPackage($package))) {
+ return;
+ }
+
+ 1;#OK
}
+sub mkRootdirectoryFromPackage {
+ my $package = shift;
+
+ my $majorrelease = $$package->svndebrelease;
+ return unless $majorrelease;
+ $majorrelease =~ s/^\d+://;
+ $majorrelease =~ s/-[+0-9A-Za-z\.~]*$//;
+
+ $$package->name.'-'.$majorrelease;
+}
+
sub mkTarballFromPackage {
my $package = shift;
+ return if $$package->isnative;
my $majorrelease = $$package->svndebrelease;
+ return unless $majorrelease;
$majorrelease =~ s/^\d+://;
$majorrelease =~ s/-[+0-9A-Za-z\.~]*$//;
$$package->name.'_'.$majorrelease.".orig.tar.gz";
}
-sub getRev {
- my $uri = shift;
+sub prepareFromSvn {
+ my ($package) = @_;
+ debug("prepareFromSvn: ".$$package->name);
- foreach (`LC_ALL=C svn info $uri`) {
- return $1 if /Last Changed Rev:\ (\d+)/;
- }
+ return unless $$package->uri;
- return;
-}
+ my $repo_shortname = $$package->repository_id->shortname;
+ next unless $repo_shortname;
-sub prepare {
- my ($package, $log) = @_;
+ my $directory = $$package->name;
+ # TODO replace repo_shortname/ by team short name
+ #my $workdir = $config->server_repositorydir."/$repo_shortname/".$$package->name."/tmp";
+ my $workdir = $config->server_repositorydir."/tmp";
+
+ `rm -Rf $workdir; mkdir -p $workdir`;
+ chdir $workdir or die;
- my $directory = $$package->name."-".$$package->svndebrelease;
- my $tarball = "";
+
if (!$$package->isnative) {
- $tarball = mkTarballFromPackage($package);
-
- if (!-f $tarball) {
- my $tarballuri = $$package->tarballuri;
- $tarballuri =~ s/\@DEBMIRROR@/$debmirror/;
-
- if (is_error(getstore($tarballuri,$tarball))) {
- push @$log, "[".$$package->name."]failed to download ".$tarballuri."\n";
- unlink $tarball;
- return;
- }
- }
-
- foreach (`tar xfv $tarball 2>&1`) {
- push @$log, $_;
- $directory = $2 if /^(.\/|)(.*?)\//;
- }
- if (($? >> 8)!=0) {
- push @$log, "[".$$package->name."]failed to untar\n";
- `rm -rf $directory $tarball`;
- return;
- }
+ return unless fetchAndPrepareDirectoryForMergeWithUpstream($package, $workdir);
}
+ print "cc\n";
- my $revBefore = getRev($$package->uri);
- my $cmd = "svn export ".$$package->uri." $directory --force 2>&1";
- push @$log, $_ foreach (`$cmd`);
- if (($? >> 8)!=0) {
- push @$log, "[".$$package->name."]failed to export ".$$package->uri."\n";
- `rm -rf $directory $tarball`;
- return;
+ my $rev;
+ my $packagerootdir = mkRootdirectoryFromPackage($package);
+ my $cmd = "LC_ALL=C svn export ".$$package->uri." $workdir/".$packagerootdir." --force 2>&1";
+ foreach (`$cmd`) {
+ $rev = $1 if /Exported revision (\d+)\./;
}
- my $revAfter = getRev($$package->uri);
- # I record the revision so I will be able to write it in the DB
- # with the build log
- if ($revBefore ne $revAfter) {
- push @$log, "svn revision changed during the svn export\n";
+ if (($? >> 8)!=0 || !$rev) {
+ info("failed to svn export ".$$package->uri);
return;
}
- #### to remove
- if (open TMP, ">$directory/debian/rev") {
- print TMP $revBefore;
- close TMP;
- } else {
- push @$log, "failed to open $directory/debian/rev\n";
- }
- ################
- if (open REV, ">".$$package->name."_".$$package->svndebrelease.".rev") {
- print REV $revBefore;
- close REV;
- } else {
- my $svndebrelease = $$package->realsvndebrelease;
- $svndebrelease =~ s/^\d+://;
- push @$log, "failed to open ".$$package->name."_".$svndebrelease.".rev\n";
- }
+ return unless addSubRevInChangelog($packagerootdir, "svn".$rev);
-
- push @$log, $_ foreach (`dpkg-source -b $directory 2>&1`);
+ print `dpkg-source -b -W $packagerootdir 2>&1`;
if (($? >> 8)!=0) {
- push @$log, "[".$$package->name."]failed to create .dsc\n";
- `rm -rf $directory $tarball`;
- return;
+ info ("failed to create .dsc");
+ return;
}
+ my $destdir = $config->server_repositorydir.'/'.
+ $$package->repository_id->team_id->shortname.'/'.
+ $$package->name;
+ `mkdir -p $destdir` unless -d $destdir;
+ foreach my $file (<$workdir/*>) {
+ next unless -f $file;
+ move ($file, $destdir);
+ }
+
$$package->issrcinmypool(1);
$$package->update;
-
- `rm -rf $directory`;
1;
}
+##########################################
+##########################################
+################## MAIN ##################
+##########################################
+##########################################
+foreach (<lock.*>) {
+ /lock.(\d+)/;
+ my $pid = $1;
+ if (open (CMDLINE, "/proc/$pid/cmdline")) {
+ my $content = <CMDLINE>;
+ if ($content =~ /svnbuildstat_update-repository\.pl/) {
+ die "an instance is already running (pid $pid)";
+ }
+ }
+ unlink 'lock.'.$pid;
+}
+touch "lock.$$";
+info ("starting");
+
+
$config = new SvnBuildStat::Config();
$schema = SvnBuildStat::Schema->connect(
$config->db_dsn,
@@ -212,10 +189,35 @@
$config->db_password,
{AutoCommit => 1, debug => 1}
);
+# It's not a joke since I'll do rm -Rf in this directory and don't want to trash
+# the system yet :)
+die "server_repository is unset!\n" unless $config->server_repositorydir;
-purgeOutDated();
-updateIsSrcInMyPoolFromFiles();
-updateSources();
+#purgeOutDated();
+my $package_rs = $schema->resultset('Package')->search({issrcinmypool => 'false'});
+while (my $package = $package_rs->next) {
+ next unless $package->name;
+ next unless $package->realsvndebrelease;
+
+ my $vcs = $package->repository_id->repositoryfamily_id->vcs_id->name;
+
+ next unless $vcs;
+
+# my $svndebrelease = $package->realsvndebrelease;
+# $svndebrelease =~ s/^\d+://;
+ #
+# my $targetdir = $repo_shortname."/".$vcs."/".$package->name."/".$
+# my $failedNotifFile = $package->name."_".$svndebrelease.".dsc.failed";
+ #
+# next if -f $failedNotifFile;
+
+ if ($vcs eq "svn") {
+ prepareFromSvn(\$package);
+ }
+
+}
+
+
+info ("stopping");
unlink "lock.".$$;
-sleep 60;
More information about the Collab-qa-commits
mailing list