r70131 - in /branches/upstream/libcatalyst-perl/current: ./ lib/ lib/Catalyst/ lib/Catalyst/DispatchType/ lib/Catalyst/Request/ lib/Catalyst/Script/ t/aggregate/ t/lib/TestApp/Controller/ t/lib/TestApp/Controller/Engine/Request/

jawnsy-guest at users.alioth.debian.org jawnsy-guest at users.alioth.debian.org
Tue Mar 1 02:33:00 UTC 2011


Author: jawnsy-guest
Date: Tue Mar  1 02:32:50 2011
New Revision: 70131

URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70131
Log:
[svn-upgrade] new version libcatalyst-perl (5.80032)

Added:
    branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t
    branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t
Removed:
    branches/upstream/libcatalyst-perl/current/t/aggregate/live__component_controller_action_chained2.t
Modified:
    branches/upstream/libcatalyst-perl/current/Changes
    branches/upstream/libcatalyst-perl/current/MANIFEST
    branches/upstream/libcatalyst-perl/current/META.yml
    branches/upstream/libcatalyst-perl/current/lib/Catalyst.pm
    branches/upstream/libcatalyst-perl/current/lib/Catalyst/DispatchType/Chained.pm
    branches/upstream/libcatalyst-perl/current/lib/Catalyst/Request/Upload.pm
    branches/upstream/libcatalyst-perl/current/lib/Catalyst/Response.pm
    branches/upstream/libcatalyst-perl/current/lib/Catalyst/Runtime.pm
    branches/upstream/libcatalyst-perl/current/lib/Catalyst/Script/Server.pm
    branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained.t
    branches/upstream/libcatalyst-perl/current/t/aggregate/unit_core_script_server.t
    branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
    branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Root.pm

Modified: branches/upstream/libcatalyst-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/Changes?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/Changes (original)
+++ branches/upstream/libcatalyst-perl/current/Changes Tue Mar  1 02:32:50 2011
@@ -1,4 +1,36 @@
 # This file documents the revision history for Perl extension Catalyst.
+
+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
 

Modified: branches/upstream/libcatalyst-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/MANIFEST?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/MANIFEST (original)
+++ branches/upstream/libcatalyst-perl/current/MANIFEST Tue Mar  1 02:32:50 2011
@@ -74,11 +74,11 @@
 t/aggregate/custom_live_path_bug.t
 t/aggregate/deprecated_test_import.t
 t/aggregate/error_page_dump.t
-t/aggregate/live__component_controller_action_chained2.t
 t/aggregate/live_component_controller_action_action.t
 t/aggregate/live_component_controller_action_auto.t
 t/aggregate/live_component_controller_action_begin.t
 t/aggregate/live_component_controller_action_chained.t
+t/aggregate/live_component_controller_action_chained2.t
 t/aggregate/live_component_controller_action_default.t
 t/aggregate/live_component_controller_action_detach.t
 t/aggregate/live_component_controller_action_end.t
@@ -112,6 +112,7 @@
 t/aggregate/live_engine_request_remote_user.t
 t/aggregate/live_engine_request_uploads.t
 t/aggregate/live_engine_request_uri.t
+t/aggregate/live_engine_response_body.t
 t/aggregate/live_engine_response_cookies.t
 t/aggregate/live_engine_response_emptybody.t
 t/aggregate/live_engine_response_errors.t

Modified: branches/upstream/libcatalyst-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/META.yml?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/META.yml (original)
+++ branches/upstream/libcatalyst-perl/current/META.yml Tue Mar  1 02:32:50 2011
@@ -69,4 +69,4 @@
   homepage: http://dev.catalyst.perl.org/
   license: http://dev.perl.org/licenses/
   repository: http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/
-version: 5.80031
+version: 5.80032

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst.pm Tue Mar  1 02:32:50 2011
@@ -79,7 +79,7 @@
 
 # Remember to update this in Catalyst::Runtime as well!
 
-our $VERSION = '5.80031';
+our $VERSION = '5.80032';
 
 sub import {
     my ( $class, @arguments ) = @_;
@@ -1660,7 +1660,9 @@
     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;
 
@@ -3224,6 +3226,8 @@
 
 rainboxx: Matthias Dietrich, C<perl at rainboxx.de>
 
+dd070: Dhaval Dhanani <dhaval070 at gmail.com>
+
 =head1 LICENSE
 
 This library is free software. You can redistribute it and/or modify it under

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst/DispatchType/Chained.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst/DispatchType/Chained.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst/DispatchType/Chained.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst/DispatchType/Chained.pm Tue Mar  1 02:32:50 2011
@@ -187,7 +187,6 @@
     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 @@
                               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 @@
                 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 @@
                 # 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 @@
                     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 @@
                         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 ();
 }
 

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst/Request/Upload.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst/Request/Upload.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst/Request/Upload.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst/Request/Upload.pm Tue Mar  1 02:32:50 2011
@@ -5,7 +5,7 @@
 
 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 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 @@
 
     binmode( $handle, $layer );
 
+    $handle->seek(0, SEEK_SET);
     while ( $handle->sysread( my $buffer, 8192 ) ) {
         $content .= $buffer;
     }
 
+    $handle->seek(0, SEEK_SET);
     return $content;
 }
 

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst/Response.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst/Response.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst/Response.pm Tue Mar  1 02:32:50 2011
@@ -6,7 +6,8 @@
 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);

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst/Runtime.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst/Runtime.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst/Runtime.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst/Runtime.pm Tue Mar  1 02:32:50 2011
@@ -7,7 +7,7 @@
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.80031';
+our $VERSION = '5.80032';
 
 =head1 NAME
 

Modified: branches/upstream/libcatalyst-perl/current/lib/Catalyst/Script/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/lib/Catalyst/Script/Server.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/lib/Catalyst/Script/Server.pm (original)
+++ branches/upstream/libcatalyst-perl/current/lib/Catalyst/Script/Server.pm Tue Mar  1 02:32:50 2011
@@ -144,8 +144,21 @@
         ($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;
@@ -165,9 +178,9 @@
         # fail.
         $| = 1 if $ENV{HARNESS_ACTIVE};
 
-        require Catalyst::Restarter;
-
-        my $subclass = Catalyst::Restarter->pick_subclass;
+        Catalyst::Utils::ensure_class_loaded($self->restarter_class);
+
+        my $subclass = $self->restarter_class->pick_subclass;
 
         my $restarter = $subclass->new(
             $self->_restarter_args()

Modified: branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained.t?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained.t (original)
+++ branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained.t Tue Mar  1 02:32:50 2011
@@ -865,12 +865,9 @@
 
         ok( my $response = request('http://localhost/chained/mult_nopp2/action'),
             "Complex path with multiple non-capturing pathparts" );
-        TODO: {
-        local $TODO = 'Known bug';
         is( $response->header('X-Catalyst-Executed'),
             $expected, 'Executed actions' );
         is( $response->content, '; ', 'Content OK' );
-        }
     }
 
     #

Added: branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t?rev=70131&op=file
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t (added)
+++ branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t Tue Mar  1 02:32:50 2011
@@ -1,0 +1,27 @@
+use strict;
+use warnings;
+use FindBin qw/$Bin/;
+use lib "$Bin/../lib";
+use Catalyst::Test 'ChainedActionsApp';
+use Test::More;
+
+plan 'skip_all' if $ENV{CATALYST_SERVER}; # This is not TestApp
+
+content_like('/', qr/Application Home Page/, 'Application home');
+content_like('/15/GoldFinger', qr/List project GoldFinger pages/, 'GoldFinger Project Index');
+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/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: {
+      local $TODO = q(new chained action test case that fails yet.);
+      content_like('/downloads/', qr/This is downloads index/, 'downloads');
+}
+
+action_notfound('/c');
+
+done_testing;
+

Added: branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t?rev=70131&op=file
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t (added)
+++ branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t Tue Mar  1 02:32:50 2011
@@ -1,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;

Modified: branches/upstream/libcatalyst-perl/current/t/aggregate/unit_core_script_server.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/aggregate/unit_core_script_server.t?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/aggregate/unit_core_script_server.t (original)
+++ branches/upstream/libcatalyst-perl/current/t/aggregate/unit_core_script_server.t Tue Mar  1 02:32:50 2011
@@ -79,6 +79,19 @@
 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 {
@@ -130,8 +143,13 @@
 }
 
 sub restartopthash {
-    return {
-        follow_symlinks => 0,
-        @_,
+    my $opthash = opthash(@_);
+    my $val = {
+        application_name => 'TestAppToTestScripts',
+        port => '3000',
+        debug => undef,
+        host => undef,
+        %$opthash,
     };
+    return $val;
 }

Modified: branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Engine/Request/Uploads.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Engine/Request/Uploads.pm (original)
+++ branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Engine/Request/Uploads.pm Tue Mar  1 02:32:50 2011
@@ -6,6 +6,10 @@
 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 );
 }
 

Modified: branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Root.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Root.pm?rev=70131&op=diff
==============================================================================
--- branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Root.pm (original)
+++ branches/upstream/libcatalyst-perl/current/t/lib/TestApp/Controller/Root.pm Tue Mar  1 02:32:50 2011
@@ -75,6 +75,13 @@
     $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) = @_;
 }




More information about the Pkg-perl-cvs-commits mailing list