[Catalyst-commits] r9906 - in Catalyst-Devel/1.00/branches/improved-restarter/t: . lib lib/TestApp lib/TestApp/Controller lib/TestApp/Controller/Subdir1 lib/TestApp/Controller/Subdir2

autarch at dev.catalyst.perl.org autarch at dev.catalyst.perl.org
Tue Apr 28 01:50:00 GMT 2009


Author: autarch
Date: 2009-04-28 02:50:00 +0100 (Tue, 28 Apr 2009)
New Revision: 9906

Added:
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Foo.pm
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Root.pm
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/Foo.pm
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/
   Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/Foo.pm
   Catalyst-Devel/1.00/branches/improved-restarter/t/optional_http-server-restart.t
Log:
Add some tests for the restarter. These are not very reliable and seem very timing dependent. I _have_ seen them run all the way through successfully. They need a lot of improvement to be truly useful.

Added: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Foo.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Foo.pm	2009-04-28 01:50:00 UTC (rev 9906)
@@ -0,0 +1,5 @@
+package TestApp::Controller::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+no Moose;
+__PACKAGE__->meta->make_immutable;


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Foo.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native

Added: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Root.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Root.pm	2009-04-28 01:50:00 UTC (rev 9906)
@@ -0,0 +1,61 @@
+package TestApp::Controller::Root;
+
+use strict;
+use warnings;
+use parent 'Catalyst::Controller';
+
+#
+# Sets the actions in this controller to be registered with no prefix
+# so they function identically to actions created in MyApp.pm
+#
+__PACKAGE__->config->{namespace} = '';
+
+=head1 NAME
+
+TestApp::Controller::Root - Root Controller for TestApp
+
+=head1 DESCRIPTION
+
+[enter your description here]
+
+=head1 METHODS
+
+=cut
+
+=head2 index
+
+=cut
+
+sub index :Path :Args(0) {
+    my ( $self, $c ) = @_;
+
+    # Hello World
+    $c->response->body( $c->welcome_message );
+}
+
+sub default :Path {
+    my ( $self, $c ) = @_;
+    $c->response->body( 'Page not found' );
+    $c->response->status(404);
+}
+
+=head2 end
+
+Attempt to render a view, if needed.
+
+=cut
+
+sub end : ActionClass('RenderView') {}
+
+=head1 AUTHOR
+
+Dave Rolsky,,,
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+1;


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Root.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native

Added: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/Foo.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/Foo.pm	2009-04-28 01:50:00 UTC (rev 9906)
@@ -0,0 +1,4 @@
+package TestApp::Controller::Subdir1::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir1/Foo.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native

Added: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/Foo.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/Foo.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/Foo.pm	2009-04-28 01:50:00 UTC (rev 9906)
@@ -0,0 +1,4 @@
+package TestApp::Controller::Subdir2::Foo;
+use Moose;
+BEGIN { extends 'Catalyst::Controller' }
+1;


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/t/lib/TestApp/Controller/Subdir2/Foo.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native

Added: Catalyst-Devel/1.00/branches/improved-restarter/t/optional_http-server-restart.t
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/t/optional_http-server-restart.t	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/t/optional_http-server-restart.t	2009-04-28 01:50:00 UTC (rev 9906)
@@ -0,0 +1,264 @@
+# XXX - These tests seem to be somewhat flaky and timing-dependent. I
+# have seen them all run to completion, and I've seen them fail
+# partway through. If someone can come up with a better way to test
+# this stuff that'd be great.
+
+use strict;
+use warnings;
+
+use Test::More;
+BEGIN {
+    plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP};
+}
+
+use File::Copy qw( copy );
+use File::Path;
+use FindBin;
+use LWP::Simple;
+use IO::Socket;
+use IPC::Open3;
+use Time::HiRes qw/sleep/;
+use Catalyst::Helper;
+eval "use Catalyst::Devel 1.04;";
+
+plan skip_all => 'Catalyst::Devel >= 1.04 required' if $@;
+eval "use File::Copy::Recursive";
+plan skip_all => 'File::Copy::Recursive required' if $@;
+
+plan tests => 35;
+
+my $tmpdir = "$FindBin::Bin/../t/tmp";
+
+# clean up
+rmtree $tmpdir if -d $tmpdir;
+
+# create a TestApp and copy the test libs into it
+mkdir $tmpdir;
+chdir $tmpdir;
+
+my $helper = Catalyst::Helper->new(
+    {
+        '.newfiles' => 1,
+    }
+);
+
+$helper->mk_app('TestApp');
+
+chdir "$FindBin::Bin/..";
+
+copy_test_app();
+
+# remove TestApp's tests
+rmtree 't/tmp/TestApp/t';
+
+# spawn the standalone HTTP server
+my $port = 30000 + int rand( 1 + 10000 );
+
+my ( $pid, $server ) = start_server($port);
+
+# change various files
+my @files = (
+    "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm",
+    "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Foo.pm",
+    "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Root.pm",
+);
+
+# change some files and make sure the server restarts itself
+NON_ERROR_RESTART:
+for ( 1 .. 5 ) {
+    my $index = rand @files;
+    open my $pm, '>>', $files[$index]
+      or die "Unable to open $files[$index] for writing: $!";
+    print $pm "\n";
+    close $pm;
+
+    if ( ! look_for_restart() ) {
+    SKIP:
+        {
+            skip "Server did not restart, no sense in checking further", 1;
+        }
+        next NON_ERROR_RESTART;
+    }
+
+    my $response = get("http://localhost:$port/");
+    like( $response, qr/Welcome to the  world of Catalyst/,
+          'Non-error restart, request OK' );
+}
+
+# add errors to the file and make sure server does die
+DIES_ON_ERROR:
+for ( 1 .. 5 ) {
+    my $index = rand @files;
+    open my $pm, '>>', $files[$index]
+      or die "Unable to open $files[$index] for writing: $!";
+    print $pm "bleh";
+    close $pm;
+
+    if ( ! look_for_death() ) {
+    SKIP:
+        {
+            skip "Server restarted, no sense in checking further", 2;
+        }
+        next DIES_ON_ERROR;
+    }
+    copy_test_app();
+
+    if ( ! look_for_restart() ) {
+    SKIP:
+        {
+            skip "Server did not restart, no sense in checking further", 1;
+        }
+        next DIES_ON_ERROR;
+    }
+
+    my $response = get("http://localhost:$port/");
+    like( $response, qr/Welcome to the  world of Catalyst/,
+          'Non-error restart after death, request OK' );
+}
+
+# multiple restart directories
+
+# we need different options so we have to rebuild most
+# of the testing environment
+
+kill 'KILL', $pid or die "Cannot kill $pid: $!";
+close $server or die "Cannot close handle to server process: $!";
+wait;
+
+# pick next port because the last one might still be blocked from
+# previous server. This might fail if this port is unavailable
+# but picking the first one has the same problem so this is acceptable
+
+$port += 1;
+
+copy_test_app();
+
+ at files = (
+  "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Subdir1/Foo.pm",
+  "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Subdir2/Foo.pm",
+);
+
+my $app_root = "$FindBin::Bin/../t/tmp/TestApp";
+my $restartdirs = join ' ', map{
+    "-restartdirectory $app_root/lib/TestApp/Controller/Subdir$_"
+} 1, 2;
+
+( $pid, $server ) = start_server($port);
+
+MULTI_DIR_RESTART:
+for ( 1 .. 5 ) {
+    my $index = rand @files;
+    open my $pm, '>>', $files[$index]
+      or die "Unable to open $files[$index] for writing: $!";
+    print $pm "\n";
+    close $pm;
+
+    if ( ! look_for_restart() ) {
+    SKIP:
+        {
+            skip "Server did not restart, no sense in checking further", 1;
+        }
+        next MULTI_DIR_RESTART;
+    }
+
+    my $response = get("http://localhost:$port/");
+    like( $response, qr/Welcome to the  world of Catalyst/,
+          'Non-error restart with multiple watched dirs' );
+}
+
+kill 'KILL', $pid;
+close $server;
+wait;
+
+rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+
+sub copy_test_app {
+    { no warnings 'once'; $File::Copy::Recursive::RMTrgFil = 1; }
+    copy( 't/lib/TestApp.pm', 't/tmp/TestApp/lib/TestApp.pm' );
+    File::Copy::Recursive::dircopy( 't/lib/TestApp', 't/tmp/TestApp/lib/TestApp' );
+}
+
+sub start_server {
+    my $port = shift;
+
+    my $server;
+    my $pid = open3(
+        undef, $server, undef,
+        $^X,   "-I$FindBin::Bin/../lib",
+        "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
+        $port,                                                     '-restart'
+    ) or die "Unable to spawn standalone HTTP server: $!";
+
+    # switch to non-blocking reads so we can fail gracefully instead
+    # of just hanging forever
+    $server->blocking(0);
+
+    my $waited = 0;
+
+    diag('Waiting for server to start...');
+    while ( check_port( 'localhost', $port ) != 1 ) {
+        sleep 1;
+        $waited++;
+
+        if ( $waited >= 10 ) {
+            BAIL_OUT('Waited 10 seconds for server to start, to no avail');
+        }
+    }
+
+    return ($pid, $server);
+}
+
+sub check_port {
+    my ( $host, $port ) = @_;
+
+    my $remote = IO::Socket::INET->new(
+        Proto    => "tcp",
+        PeerAddr => $host,
+        PeerPort => $port
+    );
+    if ($remote) {
+        close $remote;
+        return 1;
+    }
+    else {
+        return 0;
+    }
+}
+
+sub look_for_restart {
+    # give the server time to notice the change and restart
+    my $count = 0;
+    my $line;
+
+    while ( ( $line || '' ) !~ /can connect/ ) {
+        $line = $server->getline;
+        sleep 0.1;
+        if ( $count++ > 300 ) {
+            fail "Server restarted";
+            return 0;
+        }
+    };
+
+    pass "Server restarted";
+
+    return 1;
+}
+
+sub look_for_death {
+    # give the server time to notice the change and restart
+    my $count = 0;
+    my $line;
+
+    while ( ( $line || '' ) !~ /failed/ ) {
+        $line = $server->getline;
+        sleep 0.1;
+        if ( $count++ > 300 ) {
+            fail "Server died";
+            return 0;
+        }
+    };
+
+    pass "Server died";
+
+    return 1;
+}


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/t/optional_http-server-restart.t
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native




More information about the Catalyst-commits mailing list