r70133 - in /trunk/libcatalyst-perl: ./ debian/ 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:43:19 UTC 2011
Author: jawnsy-guest
Date: Tue Mar 1 02:43:11 2011
New Revision: 70133
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=70133
Log:
integrate new upstream version
Added:
trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained2.t
- copied unchanged from r70132, branches/upstream/libcatalyst-perl/current/t/aggregate/live_component_controller_action_chained2.t
trunk/libcatalyst-perl/t/aggregate/live_engine_response_body.t
- copied unchanged from r70132, branches/upstream/libcatalyst-perl/current/t/aggregate/live_engine_response_body.t
Removed:
trunk/libcatalyst-perl/t/aggregate/live__component_controller_action_chained2.t
Modified:
trunk/libcatalyst-perl/Changes
trunk/libcatalyst-perl/MANIFEST
trunk/libcatalyst-perl/META.yml
trunk/libcatalyst-perl/debian/changelog
trunk/libcatalyst-perl/lib/Catalyst.pm
trunk/libcatalyst-perl/lib/Catalyst/DispatchType/Chained.pm
trunk/libcatalyst-perl/lib/Catalyst/Request/Upload.pm
trunk/libcatalyst-perl/lib/Catalyst/Response.pm
trunk/libcatalyst-perl/lib/Catalyst/Runtime.pm
trunk/libcatalyst-perl/lib/Catalyst/Script/Server.pm
trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained.t
trunk/libcatalyst-perl/t/aggregate/unit_core_script_server.t
trunk/libcatalyst-perl/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
trunk/libcatalyst-perl/t/lib/TestApp/Controller/Root.pm
Modified: trunk/libcatalyst-perl/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/Changes?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/Changes (original)
+++ trunk/libcatalyst-perl/Changes Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/MANIFEST?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/MANIFEST (original)
+++ trunk/libcatalyst-perl/MANIFEST Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/META.yml?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/META.yml (original)
+++ trunk/libcatalyst-perl/META.yml Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/debian/changelog?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/debian/changelog (original)
+++ trunk/libcatalyst-perl/debian/changelog Tue Mar 1 02:43:11 2011
@@ -1,4 +1,4 @@
-libcatalyst-perl (5.80031-1) UNRELEASED; urgency=low
+libcatalyst-perl (5.80032-1) UNRELEASED; urgency=low
TODO: look into copyright...
@@ -6,7 +6,7 @@
* Cleaned up dependencies (put each on their own lines) to make
diffs more useful
- -- Jonathan Yu <jawnsy at cpan.org> Fri, 18 Feb 2011 20:55:44 -0500
+ -- Jonathan Yu <jawnsy at cpan.org> Mon, 28 Feb 2011 21:57:15 -0500
libcatalyst-perl (5.80030-1) unstable; urgency=low
Modified: trunk/libcatalyst-perl/lib/Catalyst.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/lib/Catalyst/DispatchType/Chained.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst/DispatchType/Chained.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst/DispatchType/Chained.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst/DispatchType/Chained.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/lib/Catalyst/Request/Upload.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst/Request/Upload.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst/Request/Upload.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst/Request/Upload.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/lib/Catalyst/Response.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst/Response.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst/Response.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst/Response.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/lib/Catalyst/Runtime.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst/Runtime.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst/Runtime.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst/Runtime.pm Tue Mar 1 02:43:11 2011
@@ -7,7 +7,7 @@
# Remember to update this in Catalyst as well!
-our $VERSION = '5.80031';
+our $VERSION = '5.80032';
=head1 NAME
Modified: trunk/libcatalyst-perl/lib/Catalyst/Script/Server.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/lib/Catalyst/Script/Server.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/lib/Catalyst/Script/Server.pm (original)
+++ trunk/libcatalyst-perl/lib/Catalyst/Script/Server.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained.t?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained.t (original)
+++ trunk/libcatalyst-perl/t/aggregate/live_component_controller_action_chained.t Tue Mar 1 02:43:11 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' );
- }
}
#
Modified: trunk/libcatalyst-perl/t/aggregate/unit_core_script_server.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/t/aggregate/unit_core_script_server.t?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/t/aggregate/unit_core_script_server.t (original)
+++ trunk/libcatalyst-perl/t/aggregate/unit_core_script_server.t Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/t/lib/TestApp/Controller/Engine/Request/Uploads.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/t/lib/TestApp/Controller/Engine/Request/Uploads.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/t/lib/TestApp/Controller/Engine/Request/Uploads.pm (original)
+++ trunk/libcatalyst-perl/t/lib/TestApp/Controller/Engine/Request/Uploads.pm Tue Mar 1 02:43:11 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: trunk/libcatalyst-perl/t/lib/TestApp/Controller/Root.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libcatalyst-perl/t/lib/TestApp/Controller/Root.pm?rev=70133&op=diff
==============================================================================
--- trunk/libcatalyst-perl/t/lib/TestApp/Controller/Root.pm (original)
+++ trunk/libcatalyst-perl/t/lib/TestApp/Controller/Root.pm Tue Mar 1 02:43:11 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