[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