[Bps-public-commit] Test-Chimps-Client branch, master, updated. 8ca639cc3ec198e6bf90ee91e426211bb8997edd

Ruslan Zakirov ruz at bestpractical.com
Tue May 26 05:10:52 EDT 2009


The branch, master has been updated
       via  8ca639cc3ec198e6bf90ee91e426211bb8997edd (commit)
       via  b5bd512f6240faf4f0f733565482086e2292e88b (commit)
       via  a219a4b4b3209496f0c6038f6f6997f72732ba13 (commit)
       via  0fd5c356e5c9e099dc61fedd8cfb0f6236d5718d (commit)
       via  30bf1c1d59cbdce659109d47e85201a4b7e5f84d (commit)
       via  02ddbc0e7123e0afc5a13b6a734a8b42fd963582 (commit)
       via  99de35319b6a57fadeb453b739839caa845feaba (commit)
       via  1081ca21f6fea4b01cee8d0d816c2172055f1423 (commit)
       via  9ebdaf5c0e8b71e194555d585cb6760940b713e9 (commit)
       via  33a380d2ea3bc8a2238e496dbf0b3456d748b3a1 (commit)
       via  dca4008dbf22674021b2b02b031fa8c597bd2c98 (commit)
      from  d1fa0813093eb42b07153f7408cade179d075a64 (commit)

Summary of changes:
 Makefile.PL                     |    5 ++
 lib/Test/Chimps/Smoker.pm       |   28 ++++++------
 lib/Test/Chimps/Smoker/Git.pm   |    2 +-
 lib/Test/Chimps/Smoker/SVN.pm   |   17 ++++++-
 t/lib/Test/Chimps/TestServer.pm |   97 +++++++++++++++++++++++++++++++++++++++
 5 files changed, 132 insertions(+), 17 deletions(-)
 create mode 100644 t/lib/Test/Chimps/TestServer.pm

- Log -----------------------------------------------------------------
commit dca4008dbf22674021b2b02b031fa8c597bd2c98
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:17:40 2009 +0400

    * write a server for testing smoker

diff --git a/t/lib/Test/Chimps/TestServer.pm b/t/lib/Test/Chimps/TestServer.pm
new file mode 100644
index 0000000..16399e6
--- /dev/null
+++ b/t/lib/Test/Chimps/TestServer.pm
@@ -0,0 +1,97 @@
+package Test::Chimps::TestServer;
+
+use strict;
+use warnings;
+
+use base qw(Test::HTTP::Server::Simple HTTP::Server::Simple::CGI Class::Accessor::Fast);
+__PACKAGE__->mk_accessors(qw(reports_in));
+
+use File::Spec;
+use File::Temp qw(tempdir);
+use File::Path qw(remove_tree);
+use TAP::Harness::Archive;
+
+sub new {
+    my $proto = shift;
+    my $self = $proto->SUPER::new( @_ );
+
+    $self->reports_in( tempdir(CLEANUP => 1) or die "couldn't create a tmp directory" );
+
+    return $self;
+}
+
+sub handle_request {
+    my $self = shift;
+    my $cgi  = shift;
+  
+    my $archive = $cgi->upload('archive')
+        or die "No archive in the request";
+
+    my $index = ($self->last_report_index||0) + 1;
+    my $fname = File::Spec->catfile( $self->reports_in, $index .'.tar.gz');
+
+    open my $fh, '>:raw', $fname or die "Couldn't open file '$fname': $!";
+    print $fh do { local $/; <$archive> };
+    close $fh;
+
+    print "HTTP/1.1 200 OK\r\n";
+    print "Content-Type: text/plain\r\n";
+    print "\r\n";
+    print "ok\r\n";
+}
+
+sub last_report_index {
+    my $self = shift;
+    my $dir = $self->reports_in;
+
+    opendir my $dh, $dir or die "can't opendir '$dir': $!";
+    my ($i) = sort { $b cmp $a } map {/(\d+)/; $1} grep /^\d+\.tar\.gz$/, readdir $dh;
+    closedir $dh;
+
+    return $i;
+}
+
+sub flush_reports {
+    my $self = shift;
+
+    my $dir = $self->reports_in;
+
+    opendir my $dh, $dir or die "can't opendir '$dir': $!";
+    my @reports = grep /^\d+\.tar\.gz$/, readdir $dh;
+    closedir $dh;
+
+    unlink $_ or die "Couldn't delete file $_"
+        foreach map File::Spec->catfile($dir, $_), @reports;
+}
+
+sub reports {
+    my $self = shift;
+    my $index = $self->last_report_index;
+    return () unless $index;
+
+    return map $self->report($_), 1 .. $index;
+}
+
+sub report {
+    my $self = shift;
+    my $index = shift;
+
+    my %res;
+
+    my $agg = TAP::Harness::Archive->aggregator_from_archive({
+        archive => File::Spec->catfile( $self->reports_in, $index.".tar.gz"),
+        parser_callbacks => {},
+        meta_yaml_callback => sub {
+            $res{'meta'} = $_[0]->[0]
+        },
+        made_parser_callback => sub {
+            my ($parser, $file, $full_path) = @_;
+            open my $tap_fh, '<:raw', $full_path
+                or die "couldn't open $full_path: $!";
+            $res{'TAP'} = do { local $/; <$tap_fh> };
+        },
+    });
+    return \%res;
+}
+
+1;

commit 33a380d2ea3bc8a2238e496dbf0b3456d748b3a1
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:20:34 2009 +0400

    * increment iterations checker even when return value is false

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 2d45418..d75effc 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -232,9 +232,9 @@ sub _smoke_n_times {
             CORE::sleep $self->sleep if $self->sleep;
         }
     } else {
-        for (my $i = 0; $i < $n;) {
-            $i++ if $self->_smoke_projects($projects);
-            CORE::sleep $self->sleep if $self->sleep;
+        for (my $i = 0; $i < $n; $i++) {
+            $self->_smoke_projects($projects);
+            CORE::sleep $self->sleep if $i+1 < $n && $self->sleep;
         }
     }
 }

commit 9ebdaf5c0e8b71e194555d585cb6760940b713e9
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:22:00 2009 +0400

    * don't calculate value we don't use

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index d75effc..7fb5ae8 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -390,8 +390,7 @@ sub _checkout_project {
     $source->checkout( revision => $revision );
 
     my $tmpdir = $source->directory;
-    my $projectdir = $self->meta->{ $project->{'name'} }{'root'}
-        = File::Spec->catdir($tmpdir, $project->{root_dir});
+    my $projectdir = File::Spec->catdir($tmpdir, $project->{root_dir});
 
     my @libs = map File::Spec->catdir($projectdir, $_),
       'blib/lib', @{ $project->{libs} || [] };

commit 1081ca21f6fea4b01cee8d0d816c2172055f1423
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:22:31 2009 +0400

    * get rid of uninit warning

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 7fb5ae8..086128c 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -460,7 +460,7 @@ sub _clean_project {
 sub _list_dbs {
     local $ENV{DBI_USER} = "postgres";
     local $@;
-    return map {s/.*dbname=(.*)/$1/ ? $_ : () }
+    return map {s/.*dbname=(.*)/$1/ ? $_ : () } grep defined && length,
       eval { DBI->data_sources("Pg") };
 }
 

commit 99de35319b6a57fadeb453b739839caa845feaba
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:23:44 2009 +0400

    * explicit declaration of the master

diff --git a/lib/Test/Chimps/Smoker/Git.pm b/lib/Test/Chimps/Smoker/Git.pm
index 8a73573..c81e791 100644
--- a/lib/Test/Chimps/Smoker/Git.pm
+++ b/lib/Test/Chimps/Smoker/Git.pm
@@ -49,7 +49,7 @@ sub checkout {
     my $self = shift;
     my %args = @_;
 
-    system qw(git checkout), $args{'revision'};
+    system qw(git checkout), ($args{'revision'} || 'master');
 }
 
 sub next {

commit 02ddbc0e7123e0afc5a13b6a734a8b42fd963582
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:40:21 2009 +0400

    * update dependencies

diff --git a/Makefile.PL b/Makefile.PL
index 54dcc4b..bb6fbcd 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -6,6 +6,9 @@ readme_from     'lib/Test/Chimps/Client.pm';
 requires('Class::Accessor');
 requires('DBI');
 requires('Cwd');
+requires('File::Spec');
+requires('File::Path');
+requires('File::Temp');
 requires('Scalar::Util');
 requires('LWP::UserAgent');
 requires('HTTP::Request::Common');
@@ -14,6 +17,8 @@ requires('TAP::Harness::Archive');
 requires('YAML::Syck');
 
 build_requires('Test::Dependencies');
+build_requires('Test::HTTP::Server::Simple');
+build_requires('HTTP::Server::Simple::CGI');
 
 auto_install;
 WriteAll;

commit 30bf1c1d59cbdce659109d47e85201a4b7e5f84d
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:40:53 2009 +0400

    * use C::A instead of C::A::F as it's used everywhere

diff --git a/t/lib/Test/Chimps/TestServer.pm b/t/lib/Test/Chimps/TestServer.pm
index 16399e6..e128988 100644
--- a/t/lib/Test/Chimps/TestServer.pm
+++ b/t/lib/Test/Chimps/TestServer.pm
@@ -3,7 +3,7 @@ package Test::Chimps::TestServer;
 use strict;
 use warnings;
 
-use base qw(Test::HTTP::Server::Simple HTTP::Server::Simple::CGI Class::Accessor::Fast);
+use base qw(Test::HTTP::Server::Simple HTTP::Server::Simple::CGI Class::Accessor);
 __PACKAGE__->mk_accessors(qw(reports_in));
 
 use File::Spec;

commit 0fd5c356e5c9e099dc61fedd8cfb0f6236d5718d
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:41:59 2009 +0400

    * always chdir and test return value of chdir

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 086128c..06a7b1f 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -369,12 +369,17 @@ sub _clone_project {
     my $project = shift;
 
     my $source = $self->source( $project->{'name'} );
-    return 1 if $source->cloned;
+    if ( $source->cloned ) {
+        chdir $source->directory
+            or die "Couldn't change dir to ". $source->directory .": $!";
+        return 1;
+    }
 
     my $tmpdir = tempdir("chimps-XXXXXXX", TMPDIR => 1);
     $source->directory( $tmpdir );
+    chdir $source->directory
+        or die "Couldn't change dir to ". $source->directory .": $!";
     $source->clone;
-    chdir $tmpdir;
 
     $source->cloned(1);
 
@@ -387,10 +392,11 @@ sub _checkout_project {
     my $revision = shift;
 
     my $source = $self->source( $project->{'name'} );
+    my $co_dir = $source->directory;
+    chdir $co_dir or die "Couldn't change dir to $co_dir: $!";
     $source->checkout( revision => $revision );
 
-    my $tmpdir = $source->directory;
-    my $projectdir = File::Spec->catdir($tmpdir, $project->{root_dir});
+    my $projectdir = File::Spec->catdir($co_dir, $project->{root_dir});
 
     my @libs = map File::Spec->catdir($projectdir, $_),
       'blib/lib', @{ $project->{libs} || [] };

commit a219a4b4b3209496f0c6038f6f6997f72732ba13
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 12:55:50 2009 +0400

    * if a repo is cloned, it doesn't mean it's been checked out

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index 06a7b1f..c30d117 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -410,7 +410,7 @@ sub _checkout_project {
     my @otherlibs;
     if (defined $project->{dependencies}) {
         foreach my $dep (@{$project->{dependencies}}) {
-            if ( $self->source( $dep )->cloned ) {
+            if ( $self->meta->{ $dep }{'libs'} ) {
                 push @otherlibs, @{ $self->meta->{ $dep }{'libs'} };
                 next;
             }

commit b5bd512f6240faf4f0f733565482086e2292e88b
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 13:00:17 2009 +0400

    * that was incorrect to skip checkout when we know libs
    
    If a project is smoked and then it's a dependency, we should
    switch to the head

diff --git a/lib/Test/Chimps/Smoker.pm b/lib/Test/Chimps/Smoker.pm
index c30d117..b032a7b 100644
--- a/lib/Test/Chimps/Smoker.pm
+++ b/lib/Test/Chimps/Smoker.pm
@@ -410,11 +410,6 @@ sub _checkout_project {
     my @otherlibs;
     if (defined $project->{dependencies}) {
         foreach my $dep (@{$project->{dependencies}}) {
-            if ( $self->meta->{ $dep }{'libs'} ) {
-                push @otherlibs, @{ $self->meta->{ $dep }{'libs'} };
-                next;
-            }
-
             print "processing dependency $dep\n";
             my $config = $self->config->{ $dep };
             $self->_clone_project( $config );

commit 8ca639cc3ec198e6bf90ee91e426211bb8997edd
Author: Ruslan Zakirov <Ruslan.Zakirov at gmail.com>
Date:   Tue May 26 13:05:50 2009 +0400

    * add run_cmd method and switch between update or checkout

diff --git a/lib/Test/Chimps/Smoker/SVN.pm b/lib/Test/Chimps/Smoker/SVN.pm
index e9ed9f6..3b47264 100644
--- a/lib/Test/Chimps/Smoker/SVN.pm
+++ b/lib/Test/Chimps/Smoker/SVN.pm
@@ -28,12 +28,17 @@ sub checkout {
     my $self = shift;
     my %args = @_;
 
-    system("svn", "co", "-r", ($args{'revision'} || 'HEAD'), $self->uri, $self->directory);
+    unless ( -e '.svn' ) {
+        $self->run_cmd("checkout", "-r", ($args{'revision'} || 'HEAD'), $self->uri, $self->directory);
+    }
+    else {
+        $self->run_cmd("update", "-r", ($args{'revision'} || 'HEAD'), $self->directory);
+    }
 }
 
 sub clean {
     my $self = shift;
-    system(qw(svn revert -R .));
+    return $self->run_cmd(qw(revert -R .));
 }
 
 sub next {
@@ -47,4 +52,12 @@ sub next {
     return (revision => $next, committer => $committer);
 }
 
+sub run_cmd {
+    my $self = shift;
+    my @args = @_;
+    system("svn", @args) == 0
+        or die "Couldn't run `". join(' ', "svn", @args ) ."`: $!";
+    return 1;
+}
+
 1;

-----------------------------------------------------------------------



More information about the Bps-public-commit mailing list