[Collab-qa-commits] r1163 - in buildstat/trunk/buildstat-server/script: . attic standalone
goneri at alioth.debian.org
goneri at alioth.debian.org
Tue Aug 26 16:03:24 UTC 2008
Author: goneri
Date: 2008-08-26 16:03:24 +0000 (Tue, 26 Aug 2008)
New Revision: 1163
Added:
buildstat/trunk/buildstat-server/script/attic/clean.pl
buildstat/trunk/buildstat-server/script/attic/debug/
buildstat/trunk/buildstat-server/script/attic/lintian_agent.pl
buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-buildinprogress.pl
buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-repository.pl
buildstat/trunk/buildstat-server/script/standalone/
buildstat/trunk/buildstat-server/script/standalone/svnbuildstat_www_create.pl
Removed:
buildstat/trunk/buildstat-server/script/clean.pl
buildstat/trunk/buildstat-server/script/debug/
buildstat/trunk/buildstat-server/script/lintian_agent.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_purge-buildinprogress.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_purge-repository.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_server.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_www_cgi.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_www_create.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_www_fastcgi.pl
buildstat/trunk/buildstat-server/script/svnbuildstat_www_test.pl
Log:
some clean up
Copied: buildstat/trunk/buildstat-server/script/attic/clean.pl (from rev 1159, buildstat/trunk/buildstat-server/script/clean.pl)
===================================================================
--- buildstat/trunk/buildstat-server/script/attic/clean.pl (rev 0)
+++ buildstat/trunk/buildstat-server/script/attic/clean.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -0,0 +1,40 @@
+#!/usr/bin/perl -w
+use strict;
+
+use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
+use SvnBuildStat::Schema;
+use SvnBuildStat::Config;
+
+
+my $pkgname = shift;
+
+
+
+my $config = new SvnBuildStat::Config();
+my $schema = SvnBuildStat::Schema->connect(
+ $config->db_dsn,
+ $config->db_user,
+ $config->db_password,
+ {AutoCommit => 1, debug => 1}
+);
+
+
+
+my $package = $schema->resultset('Package')->search({name => $pkgname})->first;
+die unless $package;
+
+#my $build_rs = $schema->resultset('Build')->search({package_id => $package->id, rev => $package->rev});
+my $build_rs = $schema->resultset('Build')->search({package_id => $package->id});
+
+$build_rs->delete_all;
+while (my $build = $build_rs->next) {
+print "->".$build->id."\n";
+}
+
+## Import packages
+#my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
+#while (my $repository = $repository_rs->next) {
+# # importRepository(\$repository);
+# $poolImportRepository->add(\$repository) or die "Fucked\n";
+#}#
+#print "threads launched\n";
Copied: buildstat/trunk/buildstat-server/script/attic/debug (from rev 1159, buildstat/trunk/buildstat-server/script/debug)
Copied: buildstat/trunk/buildstat-server/script/attic/lintian_agent.pl (from rev 1159, buildstat/trunk/buildstat-server/script/lintian_agent.pl)
===================================================================
--- buildstat/trunk/buildstat-server/script/attic/lintian_agent.pl (rev 0)
+++ buildstat/trunk/buildstat-server/script/attic/lintian_agent.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -0,0 +1,122 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+#use lib "/home/sites/svnbuildstat.debian.net/svnbuildstat/lib";
+
+use Data::Dumper;
+use Net::FTP;
+use File::Glob ':glob';
+use Sys::Hostname;
+#use SvnBuildStat::Config;
+use LWP::Simple;
+use POSIX ":sys_wait_h";
+use File::Basename;
+use File::stat;
+use HTTP::Request::Common;
+use LWP::UserAgent;
+use HTTP::Response;
+
+my $hostname = hostname();
+my $server = "http://wawax.info:3000";
+my $admin = "Gonéri Le Bouder <goneri\@rulezlan.org>";
+chomp (my $arch = `dpkg-architecture -qDEB_HOST_ARCH`);
+
+sub getQAJob {
+ my $p;
+ my $report = {};
+
+ my $ua = LWP::UserAgent->new();
+ my $req = POST $server."/controls/getQAJob", Content_Type => 'form-data',
+ Content => [
+ submit => 1,
+ content => "qatool=lintian\n",
+ ];
+ my $response = $ua->request($req);
+ return unless $response->is_success();
+
+ foreach (split $/, $response->content) {
+ chomp;
+
+ $report->{$1} = $2 if (/(.*)=(.*)/);
+ }
+ print Dumper($report);
+ return unless $report->{files};
+ return unless $report->{id};
+ $report;
+}
+
+
+sub sendReport {
+
+ my ($report, $threadbuildarea) = @_;
+
+ print "sending result that are in $threadbuildarea\n";
+
+ $report->{'arch'} = $arch;
+ $report->{'admin'} = $admin;
+ $report->{hostname} = $hostname;
+ #$report->{distro} = $distro;
+
+ #$report->{'agent_release'} = $RELEASE;
+ $report->{'pbuilder_release'} = `dpkg-query -W -f='\${Version}' pbuilder`;
+
+ my $tmp = basename($report->{dsc});
+ $tmp =~ s/\.dsc//;
+ my $prefix = $tmp."_".$arch."_$hostname";
+ my $logfile = $prefix.'.log';
+ my $infofile = $prefix.'.info';
+
+ open (BUILDLOGTMP, "<","$threadbuildarea/build.log.tmp") or die;
+ seek(BUILDLOGTMP, -20000, 2); # I just keep the end of the logfile
+ open (BUILDLOG, ">", "$threadbuildarea/".$logfile) or die;
+ # If I'm not at the end of BUILDLOGTMP it means that seek moved me
+ print BUILDLOG "(log file truncated) ... " if tell(BUILDLOGTMP);
+
+ foreach (<BUILDLOGTMP>) {
+ # To avoid strange breakage I do some clean up in the log file
+ s/[[:cntrl:]]//g;
+ print BUILDLOG $_."\n";
+ }
+ close BUILDLOGTMP;
+ close BUILDLOG;
+ unlink "$threadbuildarea/build.log.tmp";
+
+# Prepare and send the report
+# my $ftp = Net::FTP->new($ftphost, Debug => 0) or die "Cannot connect
+# to ".$ftphost.": $@";
+# $ftp->login($ftplogin,$ftppassword) or die "Cannot login ", $ftp->message;
+# $ftp->binary or die "Cannot switch to binary mode ", $ftp->message;
+# my $dir = $report->{package_id}.'-'.time;
+# $ftp->mkdir($dir); # Do not die since mkdir fails if the
+ # directory exist
+# $ftp->cwd($dir) or die "Can't cwd ", $ftp->message;
+
+ postFile($threadbuildarea."/".$logfile);
+ $report->{logfile} = $logfile;
+ if (bsd_glob($threadbuildarea.'/*.changes')) {
+ print "build is ok\n";
+ $report->{build} = "ok";
+ foreach (bsd_glob($threadbuildarea.'/*.deb'), bsd_glob($threadbuildarea.'/*.udeb')) {
+ $report->{binarypackages} = basename($_).' ';
+ postFile($_);
+ }
+ } else {
+ print "build is nok\n";
+ $report->{build} = "nok";
+ }
+
+
+ open (BUILDREPORT,">",$threadbuildarea."/".$infofile) or die "Can't open infofile";
+ foreach (sort keys %$report) {
+ chomp $report->{$_};
+ print BUILDREPORT $_."=".$report->{$_}."\n";
+ }
+ print BUILDREPORT "-END-\n";
+ close BUILDREPORT;
+ postFile ($threadbuildarea."/".$infofile);
+
+}
+
+
+print Dumper (getQAJob());
Copied: buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-buildinprogress.pl (from rev 1159, buildstat/trunk/buildstat-server/script/svnbuildstat_purge-buildinprogress.pl)
===================================================================
--- buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-buildinprogress.pl (rev 0)
+++ buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-buildinprogress.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -0,0 +1,63 @@
+#!/usr/bin/perl -w
+use strict;
+SERIOUSLY OUDATED, DONT USE
+use Time::Local;
+
+use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
+use SvnBuildStat::Schema;
+use SvnBuildStat::Config;
+
+my $config = new SvnBuildStat::Config();
+my $schema = SvnBuildStat::Schema->connect(
+ $config->db_dsn,
+ $config->db_user,
+ $config->db_password,
+ {AutoCommit => 1, debug => 1}
+);
+sub postgresTimeToUnix {
+ my $time = shift;
+ if ( $time ) {
+ my ($year, $mon, $day, $hour, $min, $sec) = ($time =~ /(\d{4})-(\d{2})-(\d{2})\ (\d{1,2}):(\d{2}):(\d{2})/);
+ return timelocal($sec, $min, $hour, $day, $mon, $year);
+ }
+ 0
+}
+
+sub purgePkg {
+ my $package = shift;
+ print "purge".$$package->name."\n";
+
+ $schema->resultset('Build')->search({package_id => $$package->id})->delete_all;
+ $schema->resultset('PackageMaintainer')->search({package_id => $$package->id})->delete_all;
+ $schema->resultset('Package')->search({id => $$package->id})->delete_all;
+}
+
+
+$schema->resultset('Build')->search({isbuildinprogress => 1})->delete_all;
+
+#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time)
+# 2007-06-21 18:05:31.516643
+#my $time = "$year-$mon-$mday $hour-$min-$sec";
+
+my $repository_rs = $schema->resultset('Repository');
+while (my $repository = $repository_rs->next) {
+ print $repository->name."\n";
+
+ my $package_rs = $schema->resultset('Package')->search({repository_id => $repository->id});
+
+ while (my $package = $package_rs->next) {
+ if (postgresTimeToUnix($package->lastcheck) < postgresTimeToUnix($repository->lastcheck) - 3600 * 48) {
+ purgePkg(\$package);
+ }
+ }
+}
+#
+#while (my $package = $package_rs->next) {
+# my $lastcheck = 0;
+# if ( $package->lastcheck ) {
+# my ($year, $mon, $day, $hour, $min, $sec) = ($package->lastcheck =~ /(\d{4})-(\d{2})-(\d{2})\ (\d{1,2}):(\d{2}):(\d{2})/);
+# $lastcheck = timelocal($sec, $min, $hour, $day, $mon, $year);
+# }
+# print "removing ".$package->name."\n";
+# $package->delete ({'cascade_delete' => 1});
+#}
Copied: buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-repository.pl (from rev 1159, buildstat/trunk/buildstat-server/script/svnbuildstat_purge-repository.pl)
===================================================================
--- buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-repository.pl (rev 0)
+++ buildstat/trunk/buildstat-server/script/attic/svnbuildstat_purge-repository.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -0,0 +1,101 @@
+#!/usr/bin/perl -w
+SERIOUSLY OUTDATED, DONT USE
+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 $vcstype = $package->repository_id->repositoryfamily_id->vcs_id->name;
+ 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 &&
+ (($vcstype eq "svn" && $vcsrelease < $package->rev)||
+ ( $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.".$$;
Deleted: buildstat/trunk/buildstat-server/script/clean.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/clean.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/clean.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,40 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-
-use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
-use SvnBuildStat::Schema;
-use SvnBuildStat::Config;
-
-
-my $pkgname = shift;
-
-
-
-my $config = new SvnBuildStat::Config();
-my $schema = SvnBuildStat::Schema->connect(
- $config->db_dsn,
- $config->db_user,
- $config->db_password,
- {AutoCommit => 1, debug => 1}
-);
-
-
-
-my $package = $schema->resultset('Package')->search({name => $pkgname})->first;
-die unless $package;
-
-#my $build_rs = $schema->resultset('Build')->search({package_id => $package->id, rev => $package->rev});
-my $build_rs = $schema->resultset('Build')->search({package_id => $package->id});
-
-$build_rs->delete_all;
-while (my $build = $build_rs->next) {
-print "->".$build->id."\n";
-}
-
-## Import packages
-#my $repository_rs = $schema->resultset('Repository')->search({enabled => 'true'});
-#while (my $repository = $repository_rs->next) {
-# # importRepository(\$repository);
-# $poolImportRepository->add(\$repository) or die "Fucked\n";
-#}#
-#print "threads launched\n";
Deleted: buildstat/trunk/buildstat-server/script/lintian_agent.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/lintian_agent.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/lintian_agent.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,122 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-
-#use lib "/home/sites/svnbuildstat.debian.net/svnbuildstat/lib";
-
-use Data::Dumper;
-use Net::FTP;
-use File::Glob ':glob';
-use Sys::Hostname;
-#use SvnBuildStat::Config;
-use LWP::Simple;
-use POSIX ":sys_wait_h";
-use File::Basename;
-use File::stat;
-use HTTP::Request::Common;
-use LWP::UserAgent;
-use HTTP::Response;
-
-my $hostname = hostname();
-my $server = "http://wawax.info:3000";
-my $admin = "Gonéri Le Bouder <goneri\@rulezlan.org>";
-chomp (my $arch = `dpkg-architecture -qDEB_HOST_ARCH`);
-
-sub getQAJob {
- my $p;
- my $report = {};
-
- my $ua = LWP::UserAgent->new();
- my $req = POST $server."/controls/getQAJob", Content_Type => 'form-data',
- Content => [
- submit => 1,
- content => "qatool=lintian\n",
- ];
- my $response = $ua->request($req);
- return unless $response->is_success();
-
- foreach (split $/, $response->content) {
- chomp;
-
- $report->{$1} = $2 if (/(.*)=(.*)/);
- }
- print Dumper($report);
- return unless $report->{files};
- return unless $report->{id};
- $report;
-}
-
-
-sub sendReport {
-
- my ($report, $threadbuildarea) = @_;
-
- print "sending result that are in $threadbuildarea\n";
-
- $report->{'arch'} = $arch;
- $report->{'admin'} = $admin;
- $report->{hostname} = $hostname;
- #$report->{distro} = $distro;
-
- #$report->{'agent_release'} = $RELEASE;
- $report->{'pbuilder_release'} = `dpkg-query -W -f='\${Version}' pbuilder`;
-
- my $tmp = basename($report->{dsc});
- $tmp =~ s/\.dsc//;
- my $prefix = $tmp."_".$arch."_$hostname";
- my $logfile = $prefix.'.log';
- my $infofile = $prefix.'.info';
-
- open (BUILDLOGTMP, "<","$threadbuildarea/build.log.tmp") or die;
- seek(BUILDLOGTMP, -20000, 2); # I just keep the end of the logfile
- open (BUILDLOG, ">", "$threadbuildarea/".$logfile) or die;
- # If I'm not at the end of BUILDLOGTMP it means that seek moved me
- print BUILDLOG "(log file truncated) ... " if tell(BUILDLOGTMP);
-
- foreach (<BUILDLOGTMP>) {
- # To avoid strange breakage I do some clean up in the log file
- s/[[:cntrl:]]//g;
- print BUILDLOG $_."\n";
- }
- close BUILDLOGTMP;
- close BUILDLOG;
- unlink "$threadbuildarea/build.log.tmp";
-
-# Prepare and send the report
-# my $ftp = Net::FTP->new($ftphost, Debug => 0) or die "Cannot connect
-# to ".$ftphost.": $@";
-# $ftp->login($ftplogin,$ftppassword) or die "Cannot login ", $ftp->message;
-# $ftp->binary or die "Cannot switch to binary mode ", $ftp->message;
-# my $dir = $report->{package_id}.'-'.time;
-# $ftp->mkdir($dir); # Do not die since mkdir fails if the
- # directory exist
-# $ftp->cwd($dir) or die "Can't cwd ", $ftp->message;
-
- postFile($threadbuildarea."/".$logfile);
- $report->{logfile} = $logfile;
- if (bsd_glob($threadbuildarea.'/*.changes')) {
- print "build is ok\n";
- $report->{build} = "ok";
- foreach (bsd_glob($threadbuildarea.'/*.deb'), bsd_glob($threadbuildarea.'/*.udeb')) {
- $report->{binarypackages} = basename($_).' ';
- postFile($_);
- }
- } else {
- print "build is nok\n";
- $report->{build} = "nok";
- }
-
-
- open (BUILDREPORT,">",$threadbuildarea."/".$infofile) or die "Can't open infofile";
- foreach (sort keys %$report) {
- chomp $report->{$_};
- print BUILDREPORT $_."=".$report->{$_}."\n";
- }
- print BUILDREPORT "-END-\n";
- close BUILDREPORT;
- postFile ($threadbuildarea."/".$infofile);
-
-}
-
-
-print Dumper (getQAJob());
Copied: buildstat/trunk/buildstat-server/script/standalone/svnbuildstat_www_create.pl (from rev 1159, buildstat/trunk/buildstat-server/script/svnbuildstat_www_create.pl)
===================================================================
--- buildstat/trunk/buildstat-server/script/standalone/svnbuildstat_www_create.pl (rev 0)
+++ buildstat/trunk/buildstat-server/script/standalone/svnbuildstat_www_create.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -0,0 +1,74 @@
+#!/usr/bin/perl -w
+
+use strict;
+use warnings;
+use Getopt::Long;
+use Pod::Usage;
+use Catalyst::Helper;
+
+my $force = 0;
+my $mech = 0;
+my $help = 0;
+
+GetOptions(
+ 'nonew|force' => \$force,
+ 'mech|mechanize' => \$mech,
+ 'help|?' => \$help
+ );
+
+pod2usage(1) if ( $help || !$ARGV[0] );
+
+my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
+
+pod2usage(1) unless $helper->mk_component( 'SvnBuildStat::WWW', @ARGV );
+
+1;
+
+=head1 NAME
+
+svnbuildstat_www_create.pl - Create a new Catalyst Component
+
+=head1 SYNOPSIS
+
+svnbuildstat_www_create.pl [options] model|view|controller name [helper] [options]
+
+ Options:
+ -force don't create a .new file where a file to be created exists
+ -mechanize use Test::WWW::Mechanize::Catalyst for tests if available
+ -help display this help and exits
+
+ Examples:
+ svnbuildstat_www_create.pl controller My::Controller
+ svnbuildstat_www_create.pl -mechanize controller My::Controller
+ svnbuildstat_www_create.pl view My::View
+ svnbuildstat_www_create.pl view MyView TT
+ svnbuildstat_www_create.pl view TT TT
+ svnbuildstat_www_create.pl model My::Model
+ svnbuildstat_www_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
+ dbi:SQLite:/tmp/my.db
+ svnbuildstat_www_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
+ dbi:Pg:dbname=foo root 4321
+
+ See also:
+ perldoc Catalyst::Manual
+ perldoc Catalyst::Manual::Intro
+
+=head1 DESCRIPTION
+
+Create a new Catalyst Component.
+
+Existing component files are not overwritten. If any of the component files
+to be created already exist the file will be written with a '.new' suffix.
+This behavior can be suppressed with the C<-force> option.
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri at oook.de>
+Maintained by the Catalyst Core Team.
+
+=head1 COPYRIGHT
+
+This library is free software, you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_purge-buildinprogress.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_purge-buildinprogress.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_purge-buildinprogress.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,63 +0,0 @@
-#!/usr/bin/perl -w
-use strict;
-SERIOUSLY OUDATED, DONT USE
-use Time::Local;
-
-use lib '/home/sites/svnbuildstat.debian.net/svnbuildstat/lib';
-use SvnBuildStat::Schema;
-use SvnBuildStat::Config;
-
-my $config = new SvnBuildStat::Config();
-my $schema = SvnBuildStat::Schema->connect(
- $config->db_dsn,
- $config->db_user,
- $config->db_password,
- {AutoCommit => 1, debug => 1}
-);
-sub postgresTimeToUnix {
- my $time = shift;
- if ( $time ) {
- my ($year, $mon, $day, $hour, $min, $sec) = ($time =~ /(\d{4})-(\d{2})-(\d{2})\ (\d{1,2}):(\d{2}):(\d{2})/);
- return timelocal($sec, $min, $hour, $day, $mon, $year);
- }
- 0
-}
-
-sub purgePkg {
- my $package = shift;
- print "purge".$$package->name."\n";
-
- $schema->resultset('Build')->search({package_id => $$package->id})->delete_all;
- $schema->resultset('PackageMaintainer')->search({package_id => $$package->id})->delete_all;
- $schema->resultset('Package')->search({id => $$package->id})->delete_all;
-}
-
-
-$schema->resultset('Build')->search({isbuildinprogress => 1})->delete_all;
-
-#my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time)
-# 2007-06-21 18:05:31.516643
-#my $time = "$year-$mon-$mday $hour-$min-$sec";
-
-my $repository_rs = $schema->resultset('Repository');
-while (my $repository = $repository_rs->next) {
- print $repository->name."\n";
-
- my $package_rs = $schema->resultset('Package')->search({repository_id => $repository->id});
-
- while (my $package = $package_rs->next) {
- if (postgresTimeToUnix($package->lastcheck) < postgresTimeToUnix($repository->lastcheck) - 3600 * 48) {
- purgePkg(\$package);
- }
- }
-}
-#
-#while (my $package = $package_rs->next) {
-# my $lastcheck = 0;
-# if ( $package->lastcheck ) {
-# my ($year, $mon, $day, $hour, $min, $sec) = ($package->lastcheck =~ /(\d{4})-(\d{2})-(\d{2})\ (\d{1,2}):(\d{2}):(\d{2})/);
-# $lastcheck = timelocal($sec, $min, $hour, $day, $mon, $year);
-# }
-# print "removing ".$package->name."\n";
-# $package->delete ({'cascade_delete' => 1});
-#}
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_purge-repository.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_purge-repository.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_purge-repository.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,101 +0,0 @@
-#!/usr/bin/perl -w
-SERIOUSLY OUTDATED, DONT USE
-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 $vcstype = $package->repository_id->repositoryfamily_id->vcs_id->name;
- 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 &&
- (($vcstype eq "svn" && $vcsrelease < $package->rev)||
- ( $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.".$$;
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_server.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_server.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_server.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,111 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN {
- $ENV{CATALYST_ENGINE} ||= 'HTTP';
- $ENV{CATALYST_SCRIPT_GEN} = 30;
- require Catalyst::Engine::HTTP;
-}
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-
-my $debug = 0;
-my $fork = 0;
-my $help = 0;
-my $host = undef;
-my $port = 3000;
-my $keepalive = 0;
-my $restart = 0;
-my $restart_delay = 1;
-my $restart_regex = '\.yml$|\.yaml$|\.pm$';
-my $restart_directory = undef;
-
-my @argv = @ARGV;
-
-GetOptions(
- 'debug|d' => \$debug,
- 'fork' => \$fork,
- 'help|?' => \$help,
- 'host=s' => \$host,
- 'port=s' => \$port,
- 'keepalive|k' => \$keepalive,
- 'restart|r' => \$restart,
- 'restartdelay|rd=s' => \$restart_delay,
- 'restartregex|rr=s' => \$restart_regex,
- 'restartdirectory=s' => \$restart_directory,
-);
-
-pod2usage(1) if $help;
-
-if ( $restart ) {
- $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
-}
-if ( $debug ) {
- $ENV{CATALYST_DEBUG} = 1;
-}
-
-# This is require instead of use so that the above environment
-# variables can be set at runtime.
-require SvnBuildStat;
-
-SvnBuildStat->run( $port, $host, {
- argv => \@argv,
- 'fork' => $fork,
- keepalive => $keepalive,
- restart => $restart,
- restart_delay => $restart_delay,
- restart_regex => qr/$restart_regex/,
- restart_directory => $restart_directory,
-} );
-
-1;
-
-=head1 NAME
-
-svnbuildstat_www_server.pl - Catalyst Testserver
-
-=head1 SYNOPSIS
-
-svnbuildstat_www_server.pl [options]
-
- Options:
- -d -debug force debug mode
- -f -fork handle each request in a new process
- (defaults to false)
- -? -help display this help and exits
- -host host (defaults to all)
- -p -port port (defaults to 3000)
- -k -keepalive enable keep-alive connections
- -r -restart restart when files get modified
- (defaults to false)
- -rd -restartdelay delay between file checks
- -rr -restartregex regex match files that trigger
- a restart when modified
- (defaults to '\.yml$|\.yaml$|\.pm$')
- -restartdirectory the directory to search for
- modified files
- (defaults to '../')
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Run a Catalyst Testserver for this application.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-Maintained by the Catalyst Core Team.
-
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_www_cgi.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_www_cgi.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_www_cgi.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,37 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN { $ENV{CATALYST_ENGINE} ||= 'CGI' }
-
-use strict;
-use warnings;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-use SvnBuildStat::WWW;
-
-SvnBuildStat::WWW->run;
-
-1;
-
-=head1 NAME
-
-svnbuildstat_www_cgi.pl - Catalyst CGI
-
-=head1 SYNOPSIS
-
-See L<Catalyst::Manual>
-
-=head1 DESCRIPTION
-
-Run a Catalyst application as a cgi script.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-
-=head1 COPYRIGHT
-
-
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_www_create.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_www_create.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_www_create.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,74 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use Catalyst::Helper;
-
-my $force = 0;
-my $mech = 0;
-my $help = 0;
-
-GetOptions(
- 'nonew|force' => \$force,
- 'mech|mechanize' => \$mech,
- 'help|?' => \$help
- );
-
-pod2usage(1) if ( $help || !$ARGV[0] );
-
-my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, mech => $mech } );
-
-pod2usage(1) unless $helper->mk_component( 'SvnBuildStat::WWW', @ARGV );
-
-1;
-
-=head1 NAME
-
-svnbuildstat_www_create.pl - Create a new Catalyst Component
-
-=head1 SYNOPSIS
-
-svnbuildstat_www_create.pl [options] model|view|controller name [helper] [options]
-
- Options:
- -force don't create a .new file where a file to be created exists
- -mechanize use Test::WWW::Mechanize::Catalyst for tests if available
- -help display this help and exits
-
- Examples:
- svnbuildstat_www_create.pl controller My::Controller
- svnbuildstat_www_create.pl -mechanize controller My::Controller
- svnbuildstat_www_create.pl view My::View
- svnbuildstat_www_create.pl view MyView TT
- svnbuildstat_www_create.pl view TT TT
- svnbuildstat_www_create.pl model My::Model
- svnbuildstat_www_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\
- dbi:SQLite:/tmp/my.db
- svnbuildstat_www_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\
- dbi:Pg:dbname=foo root 4321
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Create a new Catalyst Component.
-
-Existing component files are not overwritten. If any of the component files
-to be created already exist the file will be written with a '.new' suffix.
-This behavior can be suppressed with the C<-force> option.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-Maintained by the Catalyst Core Team.
-
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_www_fastcgi.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_www_fastcgi.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_www_fastcgi.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,80 +0,0 @@
-#!/usr/bin/perl -w
-
-BEGIN { $ENV{CATALYST_ENGINE} ||= 'FastCGI' }
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-use SvnBuildStat::WWW;
-
-my $help = 0;
-my ( $listen, $nproc, $pidfile, $manager, $detach, $keep_stderr );
-
-GetOptions(
- 'help|?' => \$help,
- 'listen|l=s' => \$listen,
- 'nproc|n=i' => \$nproc,
- 'pidfile|p=s' => \$pidfile,
- 'manager|M=s' => \$manager,
- 'daemon|d' => \$detach,
- 'keeperr|e' => \$keep_stderr,
-);
-
-pod2usage(1) if $help;
-
-SvnBuildStat::WWW->run(
- $listen,
- { nproc => $nproc,
- pidfile => $pidfile,
- manager => $manager,
- detach => $detach,
- keep_stderr => $keep_stderr,
- }
-);
-
-1;
-
-=head1 NAME
-
-svnbuildstat_www_fastcgi.pl - Catalyst FastCGI
-
-=head1 SYNOPSIS
-
-svnbuildstat_www_fastcgi.pl [options]
-
- Options:
- -? -help display this help and exits
- -l -listen Socket path to listen on
- (defaults to standard input)
- can be HOST:PORT, :PORT or a
- filesystem path
- -n -nproc specify number of processes to keep
- to serve requests (defaults to 1,
- requires -listen)
- -p -pidfile specify filename for pid file
- (requires -listen)
- -d -daemon daemonize (requires -listen)
- -M -manager specify alternate process manager
- (FCGI::ProcManager sub-class)
- or empty string to disable
- -e -keeperr send error messages to STDOUT, not
- to the webserver
-
-=head1 DESCRIPTION
-
-Run a Catalyst application as fastcgi.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-Maintained by the Catalyst Core Team.
-
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
Deleted: buildstat/trunk/buildstat-server/script/svnbuildstat_www_test.pl
===================================================================
--- buildstat/trunk/buildstat-server/script/svnbuildstat_www_test.pl 2008-08-26 15:59:59 UTC (rev 1162)
+++ buildstat/trunk/buildstat-server/script/svnbuildstat_www_test.pl 2008-08-26 16:03:24 UTC (rev 1163)
@@ -1,54 +0,0 @@
-#!/usr/bin/perl -w
-
-use strict;
-use warnings;
-use Getopt::Long;
-use Pod::Usage;
-use FindBin;
-use lib "$FindBin::Bin/../lib";
-use Catalyst::Test 'SvnBuildStat';
-
-my $help = 0;
-
-GetOptions( 'help|?' => \$help );
-
-pod2usage(1) if ( $help || !$ARGV[0] );
-
-print request($ARGV[0])->content . "\n";
-
-1;
-
-=head1 NAME
-
-svnbuildstat_www_test.pl - Catalyst Test
-
-=head1 SYNOPSIS
-
-svnbuildstat_www_test.pl [options] uri
-
- Options:
- -help display this help and exits
-
- Examples:
- svnbuildstat_www_test.pl http://localhost/some_action
- svnbuildstat_www_test.pl /some_action
-
- See also:
- perldoc Catalyst::Manual
- perldoc Catalyst::Manual::Intro
-
-=head1 DESCRIPTION
-
-Run a Catalyst action from the command line.
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-Maintained by the Catalyst Core Team.
-
-=head1 COPYRIGHT
-
-This library is free software, you can redistribute it and/or modify
-it under the same terms as Perl itself.
-
-=cut
More information about the Collab-qa-commits
mailing list