[Collab-qa-commits] r818 - svnbuildstat/trunk/script
goneri at alioth.debian.org
goneri at alioth.debian.org
Sat Apr 26 21:56:02 UTC 2008
Author: goneri
Date: 2008-04-26 21:56:02 +0000 (Sat, 26 Apr 2008)
New Revision: 818
Modified:
svnbuildstat/trunk/script/svnbuildstat_import-new-report.pl
Log:
create a hardlink to the tarball in the deb/ directory and some other changes
Modified: svnbuildstat/trunk/script/svnbuildstat_import-new-report.pl
===================================================================
--- svnbuildstat/trunk/script/svnbuildstat_import-new-report.pl 2008-04-26 19:35:46 UTC (rev 817)
+++ svnbuildstat/trunk/script/svnbuildstat_import-new-report.pl 2008-04-26 21:56:02 UTC (rev 818)
@@ -8,204 +8,162 @@
use Encode;
use File::stat;
use File::Copy;
+use File::Find;
+use File::Glob ':glob';
+use Config::IniFiles;
+use File::Basename;
+use Logger::Syslog;
-
-use SvnBuildStat::Config;
use SvnBuildStat::Schema;
+use SvnBuildStat::Common;
use Data::Dumper;
-my $cfg = Config::IniFiles->new( -file => $ENV{HOME}."/.svnbuildstat.ini" ) or die "Can't load config file";
-my $schema = SvnBuildStat::Schema->connect(
- $cfg->val('db', 'dsn'),
- $cfg->val('db', 'user'),
- $cfg->val('db', 'password'),
- {AutoCommit => 1, debug => 1}
-);
+my $cfg;
+my $schema;
-my @sourcedir;
-my @reporttarball;
-foreach (split / /,$config->report_sourcedir()) {
- if (!-d) {
- print STDERR "Error in the sourcedir section of the config file.".
- " $_ doesn't exist.\n";
- next;
- }
- push @reporttarball, <$_/*.tar>;
-}
-my $workdir = $config->report_workdir();
-my $rejecteddir = $config->report_rejecteddir();
-die "Please create `$workdir' directory." unless -d $workdir;
-die "Please create `$rejecteddir' directory." unless -d $rejecteddir;
+sub loadInfofile {
+ my $infofile = shift;
-my $build_rs = $schema->resultset('Build');
+ my $ret = {};
-# Load the new report
-foreach my $reporttarball (@reporttarball) {
- my $st = stat($reporttarball);
- if ((!$reporttarball =~ /.*\/(.+)_(\d+)_(.+)_(.+)\.tar$/) ||
- !$st || ($st->mtime < time - 3600)) {
- print "$reporttarball> tarball too old\n";
- move($reporttarball, $rejecteddir);
- next;
+ my $endOfFile;
+ if (open (INFOFILE, "<".$infofile)) {
+ foreach (<INFOFILE>) {
+ $ret->{$1} = $2 if /^(.*?)=(.*)$/;
+ }
+ close INFOFILE;
+ } else {
+ print "failed to open ".$infofile."\n";
+ return;
}
- print localtime().": new report ".$reporttarball."\n";
- `cd $workdir && tar xf $reporttarball`;
- my %report;
- if (!open INFO, "<$workdir/report/info") {
- print "$reporttarball> can't open info file\n";
- move($reporttarball, $rejecteddir);
- `rm -r $workdir/report`;
- next;
- }
- foreach (<INFO>) {
- $report{$1} = $2 if (/(.*)=(.*)/);
- }
- close INFO;
+ my $basename = basename($infofile);
+ $ret->{packagesrc} = $1 if $basename =~ /^(.*?)_/;
+ $ret->{infofile} = basename($infofile);
+ # to avoid error with split on undef value
+ $ret->{packages} = "" unless $ret->{packages};
- if (!($report{source})||!($report{hostname})||!($report{svn_rev})) {
- print "$reporttarball> invalide info file\n";
- move($reporttarball, $rejecteddir);
- `rm -r $workdir/report`;
- next;
- }
+ return unless $ret->{packagesrc} or $ret->{id};
+ return $ret;
+}
- foreach my $logfile (qw/build.log lintian.log linda.log piuparts.log/) {
- if (open TMP, "<$workdir/report/$logfile") {
- $report{$logfile} = '';
- foreach (<TMP>) {
- $report{$logfile} .= encode("UTF-8", $_);
- }
- close TMP;
- } else {
- $report{$logfile} = undef;
- }
- }
+sub cleanUp {
+ my ($dir, $infofile) = @_;
- my $package = $schema->resultset('Package')->search({name =>
- $report{source}})->first;
-
- if (!$package) {
- print "$reporttarball> unknow package: $report{source}\n";
- move($reporttarball, $rejecteddir);
- next;
+ debug ("purge of ".$infofile->{packagesrc});
+ foreach ($infofile->{infofile}, $infofile->{logfile}, split(' ', $infofile->{packages})) {
+ print " ->".$dir."/".$_."\n";
+ unlink $dir.'/'.$_;
}
- my $host = $schema->resultset('Host')->find_or_create(name => $report{hostname},
- arch => $report{arch});
- my $arch = $schema->resultset('Arch')->find_or_create(name => $report{arch});
+}
- my $build = $schema->resultset('Build')->find_or_create({
- package_id => $package->id,
- arch_id => $arch->id,
- rev => $report{svn_rev},
- });
- $build->time('now');
- $build->set_from_related('host_id', $host);
- $build->update;
- $build->svndebrelease ($report{release});
- $build->update;
- $build->update;
- $build->buildisok ($report{build} eq "ok"?"true":"false");
- $build->update;
- $build->duration
- ($report{'stamp_build-end'}-$report{'stamp_build-start'});
- $build->update;
- $build->build_log ($report{'build.log'});
- $build->update;
- $build->lintian_log ($report{'lintian.log'});
- $build->update;
- $build->update;
- $build->linda_log ($report{'linda.log'});
- $build->update;
- $build->piuparts_log ($report{'piuparts.log'});
- $build->update;
- $build->lintian_release ($report{lintian_release});
- $build->update;
- $build->linda_release ($report{linda_release});
- $build->piuparts_release ($report{piuparts_release});
- $build->update;
- $build->pbuilder_release ($report{pbuilder_release});
- $build->update;
- $build->agent_release ($report{agent_release});
- $build->update;
+sub importBuild {
+ return unless /\.info$/;
+ my $dir = $File::Find::dir;
- # lintian
- my %lintian;
- if ($report{'lintian.log'}) {
- foreach (split $/, $report{'lintian.log'}) {
- $lintian{$2} = $1 if (/^(.): \S*: (\S*)/);
- }
- }
+ print $File::Find::name."\n";
- my @lintian;
- foreach (keys %lintian) {
- my $iserror = ($lintian{$_} eq "E")?1:0;
+ my $infofile = loadInfofile($File::Find::name);
- my $lintian= $schema->resultset('Lintian')->find_or_create(name => $_);
- $lintian->iserror($iserror);
- my $build_lintian =
- $build->find_or_create_related('build_lintians', {
- lintian_id => $lintian->id});
- $lintian->update();
+ if (!-f $dir.'/'.$infofile->{logfile}) {
+ error ("ko can't find the log file ".$dir.'/'.$infofile->{logfile});
+ cleanUp ($dir, $infofile);
+ return;
}
- # linda
- my %linda;
- if ($report{'linda.log'}) {
- foreach (split $/, $report{'linda.log'}) {
- $linda{$2} = $1 if (/^(.):.*\((\S*)\)$/);
- }
+ my $arch = $schema->resultset('Arch')->find_or_create(name => $infofile->{arch});
+ my $changelogentry = $schema->resultset('Changelogentry')->search(id => $infofile->{id})->first;
+ if (!$changelogentry) {
+ error ("Can't find the changelogentry ".$infofile->{id});
+ cleanUp ($dir, $infofile);
+ return;
}
+ my $build = $schema->resultset('Build')->find_or_create({
+ changelogentry_id => $changelogentry->id,
+ arch_id => $arch->id,
+# host_id => $host TODO
+ });
- # Update package rev just in case it'd been updated during the build
- my $svnbase = $package->vcsuri;
- foreach (`LC_ALL=C svn info $svnbase`) {
- if (/Last Changed Rev:\ (\d+)/) {
- $package->rev($1);
- last;
- }
+ $build->time('now');
+ $build->svndebrelease ($infofile->{release});
+ $build->buildisok ($infofile->{build} eq "ok"?"true":"false");
+ $build->duration($infofile->{'stamp_build-end'}-$infofile->{'stamp_build-start'});
+
+ my $fullResultDirectory = SvnBuildStat::Common::getFullResultDirectory(\$build);
+ my $debTargetDirectory = $fullResultDirectory."/deb";
+# my $explodedTargetDirectory = $fullResultDirectory."/exploded";
+ recurseMkdir($fullResultDirectory);
+ recurseMkdir($debTargetDirectory);
+# recurseMkdir($explodedTargetDirectory);
+# if (!-d $fullResultDirectory || !-d $debTargetDirectory || !-d $explodedTargetDirectory) {
+ if (!-d $fullResultDirectory || !-d $debTargetDirectory) {
+ print("recuseMkdir failed\n");
+ info("recurseMkdir failed");
+ return;
}
+ copy ($dir.'/'.$infofile->{logfile}, $fullResultDirectory."/build.log") or warn;
+ copy ($File::Find::name, $fullResultDirectory."/build.info") or warn;
- $package->update;
- $package->update;
- my @linda;
- foreach (keys %linda) {
- my $iserror = ($linda{$_} eq "E")?1:0;
+ my @localfile;
+ foreach (split(' ', $infofile->{packages})) {
+ next unless /(deb|diff\.gz|dsc|changes)$/;
+
+ if (/^(\S+?)_\S+?_($SvnBuildStat::Common::archs)\.(udeb|deb)/) {
+ my $deb = $schema->resultset('Deb')->find_or_create(name => $1);
+ my $arch = $schema->resultset('Arch')->find_or_create(name => $2);
+ my $build_deb = $schema->resultset('BuildDeb')->find_or_create(
+ deb_id => $deb->id,
+ build_id => $build->id,
+ arch_id => $arch->id
+ );
+# recurseMkdir($explodedTargetDirectory."/".$_."/data") or warn;
+# recurseMkdir($explodedTargetDirectory."/".$_."/control") or warn;
+# system ("cd $explodedTargetDirectory/".$_." && ar x ".$dir.'/'.$_."&& cd control && tar xf ../control.tar.gz && cd ../data/ && tar xf ../data.tar.gz && rm ../control.tar.gz ../data.tar.gz");
- my $linda= $schema->resultset('Linda')->find_or_create(name => $_);
- $linda->iserror($iserror);
- my $build_linda =
- $build->find_or_create_related('build_lindas', {
- linda_id => $linda->id});
- $linda->update();
- }
+ }
- # piuparts
- if ($report{'piuparts.log'}) {
- foreach (split $/, $report{'piuparts.log'}) {
- $build->piupartsisok(1) if (/INFO: PASS: All tests./);
+ my $localfile = $dir.'/'.$_;
+ if (!-f $localfile) {
+ print STDERR "file not found during the copy: ".$localfile."\n";
+ error("file not found during the copy: ".$localfile);
+ cleanUp ($dir, $infofile);
+ return;
}
+ copy ($dir.'/'.$_, $debTargetDirectory."/".$_) or warn;
}
+# cleanUp ($dir, $infofile);
+# $build->update;
+ my $tarball = glob ($debTargetDirectory."/../../../*.orig.tar.gz");
+ if ($tarball) {
+ print $tarball."\n";
+ system("ln $tarball $debTargetDirectory/");
+ }
+ updateLastBuildSymlink(\$build);
- $build->update;
+}
- unlink $reporttarball or warn "Can't unlink $reporttarball\n";
+sub importQaJob {
+ return unless /\.job$/;
- `rm -r $workdir/report`;
- unlink $reporttarball;
}
-### PURGE of the lock file. To remove after the agent migration
-my @lockfile;
+$cfg= Config::IniFiles->new( -file => $ENV{HOME}."/.svnbuildstat.ini" ) or die "Can't load config file";
+$schema = SvnBuildStat::Schema->connect(
+ $cfg->val('db', 'dsn'),
+ $cfg->val('db', 'user'),
+ $cfg->val('db', 'password'),
+ {AutoCommit => 1, debug => 1}
+);
-foreach (split / /,$config->report_sourcedir()) {
- unlink if (-f && /lock$/);
-}
+my $uploaddir = $cfg->val('path', 'uploaddir');
+
+find(\&importBuild, $uploaddir);
+find(\&importQaJob, $uploaddir);
More information about the Collab-qa-commits
mailing list