Merge branch 'master' into psgi
Florian Ragwitz [Tue, 1 Mar 2011 13:49:57 +0000 (14:49 +0100)]
* master: (22 commits)
  Change repos metadata to git
  Version 5.80032
  Pass the extra restart options
  Fix test
  Changelog
  added myself (dd070) in contributors list
  removed duplicate parameters in return value of _restarter_args
  added more parameters in return value of _restarter_args
  Add a few tests
  Patch to make restarter class configurable / settable in prefs
  Apply more correct fix than 8df53b (I hope)
  Rename test
  Make tests more clear
  Merge revert 8df53bed
  Un-TODO abraxxa's tests
  This scares me, but it fixes stuf work work
  Fix 5.80 bug which causes slurp to fail if called multiple times
  Fix body predicate bug/back compat issue
  Version 5.80031
  added test for chained dispatcher fail on multiple CaptureArgs(0) parts introduced in 5.80030
  ...

Conflicts:
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/Engine/FastCGI.pm
lib/Catalyst/Runtime.pm

14 files changed:
Changes
Makefile.PL
lib/Catalyst.pm
lib/Catalyst/DispatchType/Chained.pm
lib/Catalyst/Request/Upload.pm
lib/Catalyst/Response.pm
lib/Catalyst/Script/Server.pm
t/aggregate/live_component_controller_action_chained.t
t/aggregate/live_component_controller_action_chained2.t [moved from t/aggregate/live__component_controller_action_chained2.t with 85% similarity]
t/aggregate/live_engine_response_body.t [new file with mode: 0644]
t/aggregate/unit_core_script_server.t
t/lib/TestApp/Controller/Action/Chained.pm
t/lib/TestApp/Controller/Engine/Request/Uploads.pm
t/lib/TestApp/Controller/Root.pm

diff --git a/Changes b/Changes
index e6b1277..8663141 100644 (file)
--- a/Changes
+++ b/Changes
@@ -5,7 +5,7 @@
    any changes with the new Catalyst major version.
 
  - Fixed issues auto-loading engine with older scripts.
+
  - Catalyst::Engine::Wx is officially unsupported and BROKEN. If you
    are using this engine then please get in touch with us and we'll
    be happy to help with the changes it needs to be compatible with
 
  - XXX removal of engine_class?
  - XXX removal of setup_engine($name)?
-   
+
+5.80032 2011-02-23 01:10:00
+
+ Bug fixes:
+  - Fix compatibility issue with code which was testing the value of
+    $c->res->body multiple times. Previously this would cause the value
+    to be built, and ergo cause the $c->res->has_body predicate to start
+    returning true.
+    Having a response body is indicated by $c->res->body being defined.
+
+  - Fix bug with calling $upload->slurp multiple times in one request
+    not working as expected as the file handle wasn't returned to
+    the zero position. (Adam Sjøgren)
+
+  - Fix some weird perl 5.8 situations where $c can get squashed unexpectedly
+    in Catalyst::execute
+
+  - Fix chained dispatch where chains were being compared for length (number
+    of private parts in the chain) vs where they are being compared for
+    PathPart length (i.e. number of non-capturing URI elements in your path).
+
+    This bug meant that sometimes multiple Args or CaptureArgs (e.g. /*/*)
+    type paths would be preferred to those with fixed path elements
+    (e.g. /account/*)
+
+ New features:
+   - Add MYAPP_RESTARTER and CATALYST_RESTARTER environment variables to
+     allow the restarter class to be chosen per application or generally.
+
+     This feature was added to enable GUI restarters (such as the soon to
+     be released CatalystX::Restarter::GTK to be enabled more easily by
+     developers without changing their application code.
+
+5.80031 2011-01-31 08:13:02
+
+ Bug fixes:
+  - Update dependency on MooseX::Role::WithOverloading to ensure that
+    a version which can deal with / depends on a new Package::Stash
+    is installed. (As if some other dependency is pulled in during upgrading
+    which results in new Package::Stash, then it can leave you with a broken
+    version of MooseX::Role::WithOverloading.
+
+  - Fix undef warning in Catalyst::Engine::FastCGI when writing an empty
+    body (e.g. doing a redirect)
+
 5.89000 2011-01-24 09:28:45 (TRIAL release)
 
  This is a development release from psgi branch of Catalyst-Runtime.
index 5d0180e..562a976 100644 (file)
@@ -22,7 +22,7 @@ requires 'Class::MOP' => '0.95';
 requires 'Data::OptList';
 requires 'Moose' => '1.03';
 requires 'MooseX::MethodAttributes::Inheritable' => '0.24';
-requires 'MooseX::Role::WithOverloading' => '0.05';
+requires 'MooseX::Role::WithOverloading' => '0.09';
 requires 'MooseX::Types::LoadableClass' => '0.003';
 requires 'Carp';
 requires 'Class::C3::Adopt::NEXT' => '0.07';
@@ -94,7 +94,7 @@ resources(
     'IRC'         => 'irc://irc.perl.org/#catalyst',
     'license',    => 'http://dev.perl.org/licenses/',
     'homepage',   => 'http://dev.catalyst.perl.org/',
-    'repository', => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/',
+    'repository', => 'git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git',
 );
 
 install_script glob('script/*.pl');
index 3fc68c3..a854124 100644 (file)
@@ -1665,7 +1665,9 @@ sub execute {
     push( @{ $c->stack }, $code );
 
     no warnings 'recursion';
-    eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
+    # N.B. This used to be combined, but I have seen $c get clobbered if so, and
+    #      I have no idea how, ergo $ret (which appears to fix the issue)
+    eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) };
 
     $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
 
@@ -3235,6 +3237,8 @@ Yuval Kogman, C<nothingmuch@woobling.org>
 
 rainboxx: Matthias Dietrich, C<perl@rainboxx.de>
 
+dd070: Dhaval Dhanani <dhaval070@gmail.com>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify it under
index 7d0d42a..5ed6088 100644 (file)
@@ -187,7 +187,6 @@ sub recurse_match {
     return () unless $children;
     my $best_action;
     my @captures;
-    my $found=0;
     TRY: foreach my $try_part (sort { length($b) <=> length($a) }
                                    keys %$children) {
                                # $b then $a to try longest part first
@@ -198,7 +197,6 @@ sub recurse_match {
                               splice( # and strip them off @parts as well
                                 @parts, 0, scalar(@{[split('/', $try_part)]})
                               ))); # @{[]} to avoid split to @_
-            $found=1;
         }
         my @try_actions = @{$children->{$try_part}};
         TRY_ACTION: foreach my $action (@try_actions) {
@@ -214,7 +212,7 @@ sub recurse_match {
                 push(@captures, splice(@parts, 0, $capture_attr->[0]));
 
                 # try the remaining parts against children of this action
-                my ($actions, $captures, $action_parts, $found) = $self->recurse_match(
+                my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match(
                                              $c, '/'.$action->reverse, \@parts
                                            );
                 #    No best action currently
@@ -222,16 +220,17 @@ sub recurse_match {
                 # OR The action has equal parts but less captured data (ergo more defined)
                 if ($actions    &&
                     (!$best_action                                 ||
-                      $#$action_parts < $#{$best_action->{parts}}  ||
+                     $#$action_parts < $#{$best_action->{parts}}   ||
                      ($#$action_parts == $#{$best_action->{parts}} &&
-                      $#$captures < $#{$best_action->{captures}} && ($found > $best_action->{found})
-                  ))) {
+                      $#$captures < $#{$best_action->{captures}} &&
+                      $n_pathparts > $best_action->{n_pathparts}))) {
+                    my @pathparts = split /\//, $action->attributes->{PathPart}->[0];
                     $best_action = {
                         actions => [ $action, @$actions ],
                         captures=> [ @captures, @$captures ],
                         parts   => $action_parts,
-                        found=>$found
-                        };
+                        n_pathparts => scalar(@pathparts) + $n_pathparts,
+                    };
                 }
             }
             else {
@@ -240,7 +239,7 @@ sub recurse_match {
                     next TRY_ACTION unless $action->match($c);
                 }
                 my $args_attr = $action->attributes->{Args}->[0];
-
+                my @pathparts = split /\//, $action->attributes->{PathPart}->[0];
                 #    No best action currently
                 # OR This one matches with fewer parts left than the current best action,
                 #    And therefore is a better match
@@ -255,13 +254,13 @@ sub recurse_match {
                         actions => [ $action ],
                         captures=> [],
                         parts   => \@parts,
-                        found=>$found,
-                    }
+                        n_pathparts => scalar(@pathparts),
+                    };
                 }
             }
         }
     }
-    return @$best_action{qw/actions captures parts found/} if $best_action;
+    return @$best_action{qw/actions captures parts n_pathparts/} if $best_action;
     return ();
 }
 
index aee3625..1675531 100644 (file)
@@ -5,7 +5,7 @@ with 'MooseX::Emulate::Class::Accessor::Fast';
 
 use Catalyst::Exception;
 use File::Copy ();
-use IO::File   ();
+use IO::File   qw( SEEK_SET );
 use File::Spec::Unix;
 
 has filename => (is => 'rw');
@@ -128,6 +128,10 @@ Returns the size of the uploaded file in bytes.
 
 Returns a scalar containing the contents of the temporary file.
 
+Note that this method will cause the filehandle pointed to by
+C<< $upload->fh >> to be seeked to the start of the file,
+and the file handle to be put into binary mode.
+
 =cut
 
 sub slurp {
@@ -142,10 +146,12 @@ sub slurp {
 
     binmode( $handle, $layer );
 
+    $handle->seek(0, SEEK_SET);
     while ( $handle->sysread( my $buffer, 8192 ) ) {
         $content .= $buffer;
     }
 
+    $handle->seek(0, SEEK_SET);
     return $content;
 }
 
index 9c8a4b2..2bf4dfe 100644 (file)
@@ -6,7 +6,8 @@ use HTTP::Headers;
 with 'MooseX::Emulate::Class::Accessor::Fast';
 
 has cookies   => (is => 'rw', default => sub { {} });
-has body      => (is => 'rw', default => undef, lazy => 1, predicate => 'has_body');
+has body      => (is => 'rw', default => undef);
+sub has_body { defined($_[0]->body) }
 
 has location  => (is => 'rw');
 has status    => (is => 'rw', default => 200);
index 315fa54..0f55d86 100644 (file)
@@ -140,9 +140,22 @@ sub _restarter_args {
         ($self->_has_restart_delay     ? (sleep_interval  => $self->restart_delay)     : ()),
         ($self->_has_restart_directory ? (directories     => $self->restart_directory) : ()),
         ($self->_has_restart_regex     ? (filter          => $self->restart_regex)     : ()),
+    ),
+    (
+        map { $_ => $self->$_ } qw(application_name host port debug pidfile fork background keepalive)
     );
 }
 
+has restarter_class => (
+    is => 'ro',
+    isa => Str,
+    lazy => 1,
+    default => sub {
+        my $self = shift;
+        Catalyst::Utils::env_value($self->application_name, 'RESTARTER') || 'Catalyst::Restarter';
+    }
+);
+
 sub run {
     my $self = shift;
 
@@ -161,9 +174,9 @@ sub run {
         # fail.
         $| = 1 if $ENV{HARNESS_ACTIVE};
 
-        require Catalyst::Restarter;
+        Catalyst::Utils::ensure_class_loaded($self->restarter_class);
 
-        my $subclass = Catalyst::Restarter->pick_subclass;
+        my $subclass = $self->restarter_class->pick_subclass;
 
         my $restarter = $subclass->new(
             $self->_restarter_args()
index 7977875..efea301 100644 (file)
@@ -847,6 +847,30 @@ sub run_tests {
     }
 
     #
+    #   Complex path with multiple non-capturing pathparts
+    # PathPart('') CaptureArgs(0), PathPart('foo') CaptureArgs(0), PathPart('') Args(0)
+    # should win over PathPart('') CaptureArgs(1), PathPart('') Args(0)
+    #
+    {
+        my @expected = qw[
+          TestApp::Controller::Action::Chained->begin
+          TestApp::Controller::Action::Chained->mult_nopp2_base
+          TestApp::Controller::Action::Chained->mult_nopp2_nocap
+          TestApp::Controller::Action::Chained->mult_nopp2_action
+          TestApp::Controller::Action::Chained->mult_nopp2_action_default
+          TestApp::Controller::Action::Chained->end
+        ];
+
+        my $expected = join( ", ", @expected );
+
+        ok( my $response = request('http://localhost/chained/mult_nopp2/action'),
+            "Complex path with multiple non-capturing pathparts" );
+        is( $response->header('X-Catalyst-Executed'),
+            $expected, 'Executed actions' );
+        is( $response->content, '; ', 'Content OK' );
+    }
+
+    #
     #   Higher Args() hiding more specific CaptureArgs chains sections
     #
     {
@@ -12,8 +12,8 @@ content_like('/15/GoldFinger', qr/List project GoldFinger pages/, 'GoldFinger Pr
 content_like('/15/GoldFinger/4/007', qr/This is 007 page of GoldFinger project/, '007 page in GoldFinger Project');
 
 content_like('/account', qr/New account o login/, 'no account');
-content_like('/account/ferz', qr/This is account ferz/, 'account');
-content_like('/account/123', qr/This is account 123/, 'account');
+content_like('/account/ferz', qr/This is account ferz/, '/account/ferz');
+content_like('/account/123', qr/This is account 123/, '/account/123');
 content_like('/account/profile/007/James Bond', qr/This is profile of James Bond/, 'account');
 
 TODO: {
diff --git a/t/aggregate/live_engine_response_body.t b/t/aggregate/live_engine_response_body.t
new file mode 100644 (file)
index 0000000..cd0236b
--- /dev/null
@@ -0,0 +1,14 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Catalyst::Test 'TestApp';
+
+ok( request('/body_semipredicate')->is_success );
+
+done_testing;
index 0623cfe..f298fa9 100644 (file)
@@ -79,6 +79,19 @@ testRestart( ['-r', '--restart_directory', 'root'], restartopthash(directories =
 testRestart( ['-r', '--rr', 'foo'], restartopthash(filter => qr/foo/) );
 testRestart( ['-r', '--restart_regex', 'foo'], restartopthash(filter => qr/foo/) );
 
+local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER};
+local $ENV{CATALYST_RESTARTER};
+{
+    is _build_testapp([])->restarter_class, 'Catalyst::Restarter', 'default restarter with no $ENV{CATALYST_RESTARTER}';
+}
+{
+    local $ENV{CATALYST_RESTARTER} = "CatalystX::Restarter::Other";
+    is _build_testapp([])->restarter_class, $ENV{CATALYST_RESTARTER}, 'override restarter with $ENV{CATALYST_RESTARTER}';
+}
+{
+    local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER} = "CatalystX::Restarter::Other2";
+    is _build_testapp([])->restarter_class, $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}, 'override restarter with $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}';
+}
 done_testing;
 
 sub testOption {
@@ -132,8 +145,13 @@ sub opthash {
 }
 
 sub restartopthash {
-    return {
-        follow_symlinks => 0,
-        @_,
+    my $opthash = opthash(@_);
+    my $val = {
+        application_name => 'TestAppToTestScripts',
+        port => '3000',
+        debug => undef,
+        host => undef,
+        %$opthash,
     };
+    return $val;
 }
index cbba762..a393e77 100644 (file)
@@ -164,6 +164,14 @@ sub mult_nopp_id    : Chained('mult_nopp_base') PathPart('') CaptureArgs(1) { }
 sub mult_nopp_idall : Chained('mult_nopp_id') PathPart('') Args(0) { }
 sub mult_nopp_idnew : Chained('mult_nopp_id') PathPart('new') Args(0) { }
 
+sub mult_nopp2_base            : Chained('/') PathPart('chained/mult_nopp2') CaptureArgs(0) { }
+sub mult_nopp2_nocap           : Chained('mult_nopp2_base') PathPart('') CaptureArgs(0) { }
+sub mult_nopp2_action          : Chained('mult_nopp2_nocap') PathPart('action') CaptureArgs(0) { }
+sub mult_nopp2_action_default  : Chained('mult_nopp2_action') PathPart('') Args(0) { }
+sub mult_nopp2_action_with_arg : Chained('mult_nopp2_action') PathPart('') Args(1) { }
+sub mult_nopp2_load            : Chained('mult_nopp2_base') PathPart('') CaptureArgs(1) { }
+sub mult_nopp2_view            : Chained('mult_nopp2_load') PathPart('') Args(0) { }
+
 #
 #      Test Choice between branches and early return logic
 #   Declaration order is important for $children->{$*}, since this is first match best.
index f51df9d..37124cd 100644 (file)
@@ -6,6 +6,10 @@ use base 'Catalyst::Controller';
 sub slurp : Relative {
     my ( $self, $c ) = @_;
     $c->response->content_type('text/plain; charset=utf-8');
+    my $upload = $c->request->upload('slurp');
+    my $contents = $upload->slurp;
+    my $contents2 = $upload->slurp;
+    die("Slurp not callable multiple times") unless $contents eq $contents2;
     $c->response->output( $c->request->upload('slurp')->slurp );
 }
 
index e34eacd..ce3ee75 100644 (file)
@@ -75,6 +75,13 @@ EndOfBody
     $c->response->body($body);
 }
 
+sub body_semipredicate : Local {
+    my ($self, $c) = @_;
+    $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate
+    $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500.
+    $c->res->body('Body');
+}
+
 sub end : Private {
     my ($self,$c) = @_;
 }