From: Jay Hannah Date: Tue, 16 Jan 2018 22:36:20 +0000 (-0600) Subject: Merge branch 'pr/135' into release-candidates/rc-5.90116 X-Git-Tag: 5.90116~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=199731fb710c6a165793f055f85de60539039dfe;hp=c7e57864972917f9db617f3401aa5ba1a2715e9d Merge branch 'pr/135' into release-candidates/rc-5.90116 --- diff --git a/.travis.yml b/.travis.yml index b3bb3b9..9a04424 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,8 @@ language: perl sudo: false perl: + - "5.24" + - "5.22" - "5.20" - "5.18" - "5.16" @@ -51,7 +53,7 @@ script: - cpanm --test-only --metacpan Catalyst::Component::InstancePerContext - cpanm --test-only --metacpan Catalyst::Plugin::Session - cpanm --test-only --metacpan Catalyst::Plugin::Session::State::Cookie - - cpanm --test-only --metacpan Catalyst::Plugin::Static::Simple + - cpanm --test-only --verbose --metacpan Catalyst::Plugin::Static::Simple - cpanm --test-only --metacpan Catalyst::Plugin::ConfigLoader - cpanm --test-only --metacpan Catalyst::Plugin::ConfigLoader - cpanm --test-only --metacpan Catalyst::Authentication::Credential::HTTP diff --git a/Changes b/Changes index c634d3a..0fc85ac 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,74 @@ # This file documents the revision history for Perl extension Catalyst. +5.90115 - 2017-05-01 + - fixes for silent bad behavior in Catalyst::ScriptRole and 'ensure_class_loaded' + (hobbs++) + - do not require MXRWO if Moose is new enough to have cored it (ether++) + - documentation improvements (ether++) + - Encoding documentation improvements (colinnewell++) + - Improve documentation and test cases for 'abort_chain_on_error_fix' configuration + option (melmothx++) + - Better debug output when using Hash::MultiValue (tremor69++) + - Fixes for detecting debug terminal size (simonamor++) + +5.90114 - 2016-12-19 + - Fixed regression introduced in the last version (5.90113) which caused + application to hang when the action private name contained a string + like 'foo/bar..html'. If you are running 5.90113 you should consider this + a required update. + - Tweaked travis CI script. + +5.90113 - 2016-12-15 + - Fixed issue with $controller->action_for when targeting an action in + a namespace nested inside the current controller and the current controller + is a 'root' controller. + - Enhanced $controller->action_for so that you can reference the 'parent' + controller via relative path (eg ->action_for('../foo')). + - Backcompat fix for people that made the mistake of doing $c->{stash} + - Sort controllers in setup_actions so cross-controller precedence is + consistent. + +5.90112 - 2016-07-25 + - Spelling fixes from Debian group. + - Fixed regression introduced in last release that caused the code to crap out + if you set the encoding to 'undef'. + +5.90111 - 2016-07-20 + - Improved documentation around some of the unicode changes; tests (melmothx++) + +5.90110 - 2016-07-20 + - Better catching of HTTP style exceptions so that you can reliable use one to + override many core method. + - Documention on better ways to catch and handle Unicode errors + - We now check the unicode in your URL request queries and raise an error if the + check fails. This was done to be consistent with what we do in other parts of + the code (such as in args, or POSTed parameters). If this breaks your code in + ways you don't want to fix, you may disable this using the global configuration + setting, "do_not_check_query_encoding". + - Removed configuration setting, "decode_query_using_global_encoding" since it no + longer does anything useful. Query decoding follows from whatever you set the + global encoding to, unless you specify an alternative or to not decode. + +5.90106 - 2016-07-05 + - Fixed regression in debug screen rendering of the private names in chained + actions caused by commit 5dd46e24eedec447bdfbc4061ed683b5a17a7b0c. + - Fixed incorrect date entered for the release of 5.90105 + - Fixed some incorrect code in a test case that might be causing test fails + in some configurations. + +5.90105 - 2016-06-08 + - Tweak some test cases to try and prevent them from failing in limited cases. + - Changed how we compose traits onto the response, request, and stats class so + that we compose just once at setup time (performance optimization). Also added + a debug screen at startup to display composed classes to help with debugging. + - Fixed a regressed caused by the changes we made to the way ->state works so that + now when you forward to an action and that action throws an exception, $c->state + is set to 0, instead of the value of the exeption (this is to be as indicated by + the documentation). (cventers++ for reported bug and test case). + - Changed the code that detects if you try to set HTTP headers after headers are + finalized to not warn if you are just requested the response header state. Tweaked + this error message a bit to help people understand it. + 5.90104 - 2016-04-04 - Merged pull request #131, fix for noisy debug logs when used type constraints in your actions. Additional changes to the developer debug screen output to diff --git a/Makefile.PL b/Makefile.PL index 68dd556..f1d8607 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -26,7 +26,7 @@ author 'Sebastian Riedel '; authority('cpan:MSTROUT'); all_from 'lib/Catalyst/Runtime.pm'; -requires 'List::MoreUtils'; +requires 'List::Util' => '1.45'; requires 'namespace::autoclean' => '0.28'; requires 'namespace::clean' => '0.23'; requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; @@ -34,7 +34,7 @@ requires 'Class::Load' => '0.12'; requires 'Data::OptList'; requires 'Moose' => '1.03'; requires 'MooseX::MethodAttributes::Role::AttrContainer::Inheritable' => '0.24'; -requires 'MooseX::Role::WithOverloading' => '0.09'; +requires 'MooseX::Role::WithOverloading' => '0.09' unless can_use('Moose', '2.1300'); requires 'Carp' => '1.25'; requires 'Class::C3::Adopt::NEXT' => '0.07'; requires 'CGI::Simple::Cookie' => '1.109'; @@ -120,7 +120,6 @@ author_requires( @author_requires, map {; $_ => 0 } qw( File::Copy::Recursive - Test::Without::Module Starman MooseX::Daemonize Test::NoTabs @@ -142,6 +141,7 @@ resources( 'license', => 'http://dev.perl.org/licenses/', 'homepage', => 'http://dev.catalyst.perl.org/', # r/w: catagits@git.shadowcat.co.uk:Catalyst-Runtime.git + # web: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=summary 'repository', => 'git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git', ); diff --git a/README.mkdn b/README.mkdn index ad3aa2d..203d418 100644 --- a/README.mkdn +++ b/README.mkdn @@ -2,23 +2,11 @@ Catalyst - The Elegant MVC Web Application Framework -
- - CPAN version - Catalyst></a>
-    <a href=Kwalitee Score -
- # SYNOPSIS See the [Catalyst::Manual](https://metacpan.org/pod/Catalyst::Manual) distribution for comprehensive documentation and tutorials. - # Building Catalyst for development - cpanm --local-lib=~/perl5 local::lib && eval $(perl -I ~/perl5/lib/perl5/ -Mlocal::lib) - cpanm --installdeps --with-develop . - perl Makefile.PL - # Install Catalyst::Devel for helpers and other development tools # use the helper to create a new application catalyst.pl MyApp @@ -296,7 +284,7 @@ the relationship between `$c->go` will perform a full dispatch on the specified action or method, with localized `$c->action` and `$c->namespace`. Like `detach`, `go` escapes the processing of the current request chain on completion, and -does not return to its cunless blessed $cunless blessed $caller. +does not return to its caller. @arguments are arguments to the final destination of $action. @captures are arguments to the intermediate steps, if any, on the way to the final sub of @@ -362,6 +350,11 @@ Contains the return value of the last executed action. Note that << $c->state >> operates in a scalar context which means that all values it returns are scalar. +Please note that if an action throws an exception, the value of state +should no longer be considered the return if the last action. It is generally +going to be 0, which indicates an error state. Examine $c->error for error +details. + ## $c->clear\_errors Clear errors. You probably don't want to clear the errors unless you are @@ -378,11 +371,17 @@ Returns true if you have errors ## $c->last\_error Returns the most recent error in the stack (the one most recently added...) -or nothing if there are no errors. +or nothing if there are no errors. This does not modify the contents of the +error stack. ## shift\_errors -shifts the most recently added error off the error stack and returns if. Returns +shifts the most recently added error off the error stack and returns it. Returns +nothing if there are no more errors. + +## pop\_errors + +pops the most recently added error off the error stack and returns it. Returns nothing if there are no more errors. ## COMPONENT ACCESSORS @@ -637,11 +636,11 @@ Example: ## do stuff here.. }; -## $c->uri\_for( $path?, @args?, \\%query\_values? ) +## $c->uri\_for( $path?, @args?, \\%query\_values?, \\$fragment? ) -## $c->uri\_for( $action, \\@captures?, @args?, \\%query\_values? ) +## $c->uri\_for( $action, \\@captures?, @args?, \\%query\_values?, \\$fragment? ) -## $c->uri\_for( $action, \[@captures, @args\], \\%query\_values? ) +## $c->uri\_for( $action, \[@captures, @args\], \\%query\_values?, \\$fragment? ) Constructs an absolute [URI](https://metacpan.org/pod/URI) object based on the application root, the provided path, and the additional arguments and query parameters provided. @@ -659,6 +658,15 @@ relative to the application root (if it does). It is then merged with `$c->request->base`; any `@args` are appended as additional path components; and any `%query_values` are appended as `?foo=bar` parameters. +**NOTE** If you are using this 'stringy' first argument, we skip encoding and +allow you to declare something like: + + $c->uri_for('/foo/bar#baz') + +Where 'baz' is a URI fragment. We consider this first argument string to be +'expert' mode where you are expected to create a valid URL and we for the most +part just pass it through without a lot of internal effort to escape and encode. + If the first argument is a [Catalyst::Action](https://metacpan.org/pod/Catalyst::Action) it represents an action which will have its path resolved using `$c->dispatcher->uri_for_action`. The optional `\@captures` argument (an arrayref) allows passing the captured @@ -976,7 +984,26 @@ Returns or sets the request class. Defaults to [Catalyst::Request](https://metac ## $app->request\_class\_traits -An arrayref of [Moose::Role](https://metacpan.org/pod/Moose::Role)s which are applied to the request class. +An arrayref of [Moose::Role](https://metacpan.org/pod/Moose::Role)s which are applied to the request class. You can +name the full namespace of the role, or a namespace suffix, which will then +be tried against the following standard namespace prefixes. + + $MyApp::TraitFor::Request::$trait_suffix + Catalyst::TraitFor::Request::$trait_suffix + +So for example if you set: + + MyApp->request_class_traits(['Foo']); + +We try each possible role in turn (and throw an error if none load) + + Foo + MyApp::TraitFor::Request::Foo + Catalyst::TraitFor::Request::Foo + +The namespace part 'TraitFor::Request' was chosen to assist in backwards +compatibility with [CatalystX::RoleApplicator](https://metacpan.org/pod/CatalystX::RoleApplicator) which previously provided +these features in a stand alone package. ## $app->composed\_request\_class @@ -988,7 +1015,26 @@ Returns or sets the response class. Defaults to [Catalyst::Response](https://met ## $app->response\_class\_traits -An arrayref of [Moose::Role](https://metacpan.org/pod/Moose::Role)s which are applied to the response class. +An arrayref of [Moose::Role](https://metacpan.org/pod/Moose::Role)s which are applied to the response class. You can +name the full namespace of the role, or a namespace suffix, which will then +be tried against the following standard namespace prefixes. + + $MyApp::TraitFor::Response::$trait_suffix + Catalyst::TraitFor::Response::$trait_suffix + +So for example if you set: + + MyApp->response_class_traits(['Foo']); + +We try each possible role in turn (and throw an error if none load) + + Foo + MyApp::TraitFor::Response::Foo + Catalyst::TraitFor::Responset::Foo + +The namespace part 'TraitFor::Response' was chosen to assist in backwards +compatibility with [CatalystX::RoleApplicator](https://metacpan.org/pod/CatalystX::RoleApplicator) which previously provided +these features in a stand alone package. ## $app->composed\_response\_class @@ -1191,15 +1237,44 @@ Sets up the input/output encoding. See [ENCODING](https://metacpan.org/pod/ENCOD ## handle\_unicode\_encoding\_exception -Hook to let you customize how encoding errors are handled. By default -we just throw an exception. Receives a hashref of debug information. -Example: +Hook to let you customize how encoding errors are handled. By default +we just throw an exception and the default error page will pick it up. +Receives a hashref of debug information. Example of call (from the +Catalyst internals): - $c->handle_unicode_encoding_exception({ - param_value => $value, - error_msg => $_, - encoding_step => 'params', - }); + my $decoded_after_fail = $c->handle_unicode_encoding_exception({ + param_value => $value, + error_msg => $_, + encoding_step => 'params', + }); + +The calling code expects to receive a decoded string or an exception. + +You can override this for custom handling of unicode errors. By +default we just die. If you want a custom response here, one approach +is to throw an HTTP style exception, instead of returning a decoded +string or throwing a generic exception. + + sub handle_unicode_encoding_exception { + my ($c, $params) = @_; + HTTP::Exception::BAD_REQUEST->throw(status_message=>$params->{error_msg}); + } + +Alternatively you can 'catch' the error, stash it and write handling code later +in your application: + + sub handle_unicode_encoding_exception { + my ($c, $params) = @_; + $c->stash(BAD_UNICODE_DATA=>$params); + # return a dummy string. + return 1; + } + +NOTE:</b> Please keep in mind that once an error like this occurs, +the request setup is still ongoing, which means the state of `$c` and +related context parts like the request and response may not be setup +up correctly (since we haven't finished the setup yet). If you throw +an exception the setup is aborted. ## $c->setup\_log @@ -1365,7 +1440,26 @@ A arrayref of [Moose::Role](https://metacpan.org/pod/Moose::Role)s that are appl ## $app->composed\_stats\_class -this is the stats\_class composed with any 'stats\_class\_traits'. +this is the stats\_class composed with any 'stats\_class\_traits'. You can +name the full namespace of the role, or a namespace suffix, which will then +be tried against the following standard namespace prefixes. + + $MyApp::TraitFor::Stats::$trait_suffix + Catalyst::TraitFor::Stats::$trait_suffix + +So for example if you set: + + MyApp->stats_class_traits(['Foo']); + +We try each possible role in turn (and throw an error if none load) + + Foo + MyApp::TraitFor::Stats::Foo + Catalyst::TraitFor::Stats::Foo + +The namespace part 'TraitFor::Stats' was chosen to assist in backwards +compatibility with [CatalystX::RoleApplicator](https://metacpan.org/pod/CatalystX::RoleApplicator) which previously provided +these features in a stand alone package. ## $c->use\_stats @@ -1445,7 +1539,7 @@ variable should be used for determining the request path. decoded, this means that applications using this mode can correctly handle URIs including the %2F character (i.e. with `AllowEncodedSlashes` set to `On` in Apache). - Given that this method of path resolution is probably more correct, it is recommended that you use + Given that this method of path resolution is provably more correct, it is recommended that you use this unless you have a specific need to deploy your application in a non-standard environment, and you are aware of the implications of not being able to handle encoded URI paths correctly. @@ -1459,7 +1553,7 @@ variable should be used for determining the request path. - `using_frontend_proxy_path` - Enabled [Plack::Middleware::ReverseProxyPath](https://metacpan.org/pod/Plack::Middleware::ReverseProxyPath) on your application (if installed, otherwise log an error). This is useful if your application is not running on the 'root' (or /) of your host server. **NOTE** if you use this feature you should add the required -middleware to your project dependency list since it's not automatically a dependency of [Catalyst](https://metacpan.org/pod/Catalyst). +middleware to your project dependency list since its not automatically a dependency of [Catalyst](https://metacpan.org/pod/Catalyst). This has been done since not all people need this feature and we wish to restrict the growth of [Catalyst](https://metacpan.org/pod/Catalyst) dependencies. - `encoding` - See ["ENCODING"](#encoding) @@ -1469,18 +1563,19 @@ This has been done since not all people need this feature and we wish to restric - `abort_chain_on_error_fix` - When there is an error in an action chain, the default behavior is to continue - processing the remaining actions and then catch the error upon chain end. This - can lead to running actions when the application is in an unexpected state. If - you have this issue, setting this config value to true will promptly exit a - chain when there is an error raised in any action (thus terminating the chain - early.) + Defaults to true. + + When there is an error in an action chain, the default behavior is to + abort the processing of the remaining actions to avoid running them + when the application is in an unexpected state. - use like: + Before version 5.90070, the default used to be false. To keep the old + behaviour, you can explicitly set the value to false. E.g. - __PACKAGE__->config(abort_chain_on_error_fix => 1); + __PACKAGE__->config(abort_chain_on_error_fix => 0); - In the future this might become the default behavior. + If this setting is set to false, then the remaining actions are + performed and the error is caught at the end of the chain. - `use_hash_multivalue_in_request` @@ -1527,8 +1622,14 @@ This has been done since not all people need this feature and we wish to restric in Catalyst version 5.90080+ break some of your query code, you may disable the UTF-8 decoding globally using this configuration. - This setting takes precedence over `default_query_encoding` and - `decode_query_using_global_encoding` + This setting takes precedence over `default_query_encoding` + +- `do_not_check_query_encoding` + + Catalyst versions 5.90080 - 5.90106 would decode query parts of an incoming + request but would not raise an exception when the decoding failed due to + incorrect unicode. It now does, but if this change is giving you trouble + you may disable it by setting this configuration to true. - `default_query_encoding` @@ -1537,13 +1638,6 @@ This has been done since not all people need this feature and we wish to restric specify a fixed value for how to decode your query. You might need this if you are doing a lot of custom encoding of your URLs and not using UTF-8. - This setting take precedence over `decode_query_using_global_encoding`. - -- `decode_query_using_global_encoding` - - Setting this to true will default your query decoding to whatever your - general global encoding is (the default is UTF-8). - - `use_chained_args_0_special_case` In older versions of Catalyst, when more than one action matched the same path @@ -1904,6 +1998,11 @@ the encoding configuration to undef. This is recommended for temporary backwards compatibility only. +To turn it off for a single request use the [clear\_encoding](https://metacpan.org/pod/clear_encoding) +method to turn off encoding for this request. This can be useful +when you are setting the body to be an arbitrary block of bytes, +especially if that block happens to be a block of UTF8 text. + Encoding is automatically applied when the content-type is set to a type that can be encoded. Currently we encode when the content type matches the following regular expression: @@ -2032,6 +2131,8 @@ Caelum: Rafael Kitover chansen: Christian Hansen +Chase Venters `chase.venters@gmail.com` + chicks: Christopher Hicks Chisel Wright `pause@herlpacker.co.uk` @@ -2094,8 +2195,6 @@ konobi: Scott McWhirter marcus: Marcus Ramberg -Mischa Spiegelmock - miyagawa: Tatsuhiko Miyagawa mgrimes: Mark Grimes diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 602316a..8c598ba 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -27,7 +27,6 @@ use HTML::Entities; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use Class::C3::Adopt::NEXT; -use List::MoreUtils qw/uniq/; use attributes; use String::RewritePrefix; use Catalyst::EngineLoader; @@ -51,6 +50,7 @@ use Catalyst::Middleware::Stash; use Plack::Util; use Class::Load 'load_class'; use Encode 2.21 'decode_utf8', 'encode_utf8'; +use Scalar::Util; BEGIN { require 5.008003; } @@ -81,6 +81,8 @@ sub _build_request_constructor_args { sub composed_request_class { my $class = shift; + return $class->_composed_request_class if $class->_composed_request_class; + my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]}); # For each trait listed, figure out what the namespace is. First we try the $trait @@ -92,8 +94,14 @@ sub composed_request_class { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; - return $class->_composed_request_class || - $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits)); + if ($class->debug && scalar(@normalized_traits)) { + my $column_width = Catalyst::Utils::term_width() - 6; + my $t = Text::SimpleTable->new($column_width); + $t->row($_) for @normalized_traits; + $class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" ); + } + + return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits)); } has response => ( @@ -115,6 +123,8 @@ sub _build_response_constructor_args { sub composed_response_class { my $class = shift; + return $class->_composed_response_class if $class->_composed_response_class; + my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]}); my $trait_ns = 'TraitFor::Response'; @@ -122,8 +132,14 @@ sub composed_response_class { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; - return $class->_composed_response_class || - $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits)); + if ($class->debug && scalar(@normalized_traits)) { + my $column_width = Catalyst::Utils::term_width() - 6; + my $t = Text::SimpleTable->new($column_width); + $t->row($_) for @normalized_traits; + $class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" ); + } + + return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits)); } has namespace => (is => 'rw'); @@ -166,6 +182,8 @@ __PACKAGE__->stats_class('Catalyst::Stats'); sub composed_stats_class { my $class = shift; + return $class->_composed_stats_class if $class->_composed_stats_class; + my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]}); my $trait_ns = 'TraitFor::Stats'; @@ -173,14 +191,20 @@ sub composed_stats_class { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; - return $class->_composed_stats_class || - $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits)); + if ($class->debug && scalar(@normalized_traits)) { + my $column_width = Catalyst::Utils::term_width() - 6; + my $t = Text::SimpleTable->new($column_width); + $t->row($_) for @normalized_traits; + $class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" ); + } + + return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits)); } __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); # Remember to update this in Catalyst::Runtime as well! -our $VERSION = '5.90104'; +our $VERSION = '5.90115'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases sub import { @@ -222,11 +246,6 @@ sub _application { $_[0] } Catalyst - The Elegant MVC Web Application Framework -=for html -CPAN version -Catalyst></a>
-<a href=Kwalitee Score - =head1 SYNOPSIS See the L distribution for comprehensive @@ -450,7 +469,7 @@ or stash it like so: and access it from the stash. -Keep in mind that the C method used is that of the caller action. So a C<$c-Edetach> inside a forwarded action would run the C method from the original action requested. +Keep in mind that the C method used is that of the caller action. So a C<< $c->detach >> inside a forwarded action would run the C method from the original action requested. =cut @@ -1473,6 +1492,11 @@ EOF $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81."); } + # call these so we pre setup the composed classes + $class->composed_request_class; + $class->composed_response_class; + $class->composed_stats_class; + $class->setup_finalize; # Flush the log for good measure (in case something turned off 'autoflush' early) @@ -1676,23 +1700,20 @@ sub uri_for { # somewhat lifted from URI::_query's query_form $query = '?'.join('&', map { my $val = $params->{$_}; - #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP - s/ /+/g; - my $key = $_; + my $key = encode_utf8($_); + # using the URI::Escape pattern here so utf8 chars survive + $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; + $key =~ s/ /+/g; + $val = '' unless defined $val; (map { - my $param = "$_"; - $param = encode_utf8($param); + my $param = encode_utf8($_); # using the URI::Escape pattern here so utf8 chars survive $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $param =~ s/ /+/g; - $key = encode_utf8($key); - # using the URI::Escape pattern here so utf8 chars survive - $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; - $key =~ s/ /+/g; - - "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); + "${key}=$param"; + } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } @@ -2292,6 +2313,10 @@ sub finalize_encoding { (defined($res->body)) and (ref(\$res->body) eq 'SCALAR') ) { + # if you are finding yourself here and your body is already encoded correctly + # and you want to turn this off, use $c->clear_encoding to prevent encoding + # at this step, or set encoding to undef in the config to do so for the whole + # application. See the ENCODING documentaiton for better notes. $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) ); # Set the charset if necessary. This might be a bit bonkers since encodable response @@ -2437,9 +2462,6 @@ sub prepare { # VERY ugly and probably shouldn't rely on ->finalize actually working catch { # failed prepare is always due to an invalid request, right? - $c->response->status(400); - $c->response->content_type('text/plain'); - $c->response->body('Bad Request'); # Note we call finalize and then die here, which escapes # finalize being called in the enclosing block.. # It in fact couldn't be called, as we don't return $c.. @@ -2447,11 +2469,25 @@ sub prepare { # breaking compat for people doing crazy things (we should set # the 400 and just return the ctx here IMO, letting finalize get called # above... - $c->finalize; - die $_; + if ( $c->_handle_http_exception($_) ) { + foreach my $err (@{$c->error}) { + $c->log->error($err); + } + $c->clear_errors; + $c->log->_flush if $c->log->can('_flush'); + $_->can('rethrow') ? $_->rethrow : croak $_; + } else { + $c->response->status(400); + $c->response->content_type('text/plain'); + $c->response->body('Bad Request'); + $c->finalize; + die $_; + } }; $c->log_request; + $c->{stash} = $c->stash; + Scalar::Util::weaken($c->{stash}); return $c; } @@ -2700,9 +2736,16 @@ sub log_request_parameters { next if ! keys %$params; my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); for my $key ( sort keys %$params ) { - my $param = $params->{$key}; - my $value = defined($param) ? $param : ''; - $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); + my @values = (); + if(ref $params eq 'Hash::MultiValue') { + @values = $params->get_all($key); + } else { + my $param = $params->{$key}; + if( defined($param) ) { + @values = ref $param eq 'ARRAY' ? @$param : $param; + } + } + $t->row( $key.( scalar @values > 1 ? ' [multiple]' : ''), join(', ', @values) ); } $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw ); } @@ -3533,15 +3576,44 @@ sub setup_encoding { =head2 handle_unicode_encoding_exception -Hook to let you customize how encoding errors are handled. By default -we just throw an exception. Receives a hashref of debug information. -Example: +Hook to let you customize how encoding errors are handled. By default +we just throw an exception and the default error page will pick it up. +Receives a hashref of debug information. Example of call (from the +Catalyst internals): - $c->handle_unicode_encoding_exception({ + my $decoded_after_fail = $c->handle_unicode_encoding_exception({ param_value => $value, error_msg => $_, - encoding_step => 'params', - }); + encoding_step => 'params', + }); + +The calling code expects to receive a decoded string or an exception. + +You can override this for custom handling of unicode errors. By +default we just die. If you want a custom response here, one approach +is to throw an HTTP style exception, instead of returning a decoded +string or throwing a generic exception. + + sub handle_unicode_encoding_exception { + my ($c, $params) = @_; + HTTP::Exception::BAD_REQUEST->throw(status_message=>$params->{error_msg}); + } + +Alternatively you can 'catch' the error, stash it and write handling code later +in your application: + + sub handle_unicode_encoding_exception { + my ($c, $params) = @_; + $c->stash(BAD_UNICODE_DATA=>$params); + # return a dummy string. + return 1; + } + +NOTE: Please keep in mind that once an error like this occurs, +the request setup is still ongoing, which means the state of C<$c> and +related context parts like the request and response may not be setup +up correctly (since we haven't finished the setup yet). If you throw +an exception the setup is aborted. =cut @@ -3582,16 +3654,20 @@ sub _handle_unicode_decoding { } sub _handle_param_unicode_decoding { - my ( $self, $value ) = @_; + my ( $self, $value, $check ) = @_; return unless defined $value; # not in love with just ignoring undefs - jnap return $value if blessed($value); #don't decode when the value is an object. my $enc = $self->encoding; + + return $value unless $enc; # don't decode if no encoding is specified + + $check ||= $self->_encode_check; return try { - $enc->decode( $value, $self->_encode_check ); + $enc->decode( $value, $check); } catch { - $self->handle_unicode_encoding_exception({ + return $self->handle_unicode_encoding_exception({ param_value => $value, error_msg => $_, encoding_step => 'params', @@ -4226,18 +4302,20 @@ value to undef. C -When there is an error in an action chain, the default behavior is to continue -processing the remaining actions and then catch the error upon chain end. This -can lead to running actions when the application is in an unexpected state. If -you have this issue, setting this config value to true will promptly exit a -chain when there is an error raised in any action (thus terminating the chain -early.) +Defaults to true. + +When there is an error in an action chain, the default behavior is to +abort the processing of the remaining actions to avoid running them +when the application is in an unexpected state. -use like: +Before version 5.90070, the default used to be false. To keep the old +behaviour, you can explicitly set the value to false. E.g. - __PACKAGE__->config(abort_chain_on_error_fix => 1); + __PACKAGE__->config(abort_chain_on_error_fix => 0); + +If this setting is set to false, then the remaining actions are +performed and the error is caught at the end of the chain. -In the future this might become the default behavior. =item * @@ -4292,8 +4370,16 @@ evil clients, this might cause you trouble. If you find the changes introduced in Catalyst version 5.90080+ break some of your query code, you may disable the UTF-8 decoding globally using this configuration. -This setting takes precedence over C and -C +This setting takes precedence over C + +=item * + +C + +Catalyst versions 5.90080 - 5.90106 would decode query parts of an incoming +request but would not raise an exception when the decoding failed due to +incorrect unicode. It now does, but if this change is giving you trouble +you may disable it by setting this configuration to true. =item * @@ -4304,15 +4390,6 @@ is our reading of the relevant specifications. This setting allows one to specify a fixed value for how to decode your query. You might need this if you are doing a lot of custom encoding of your URLs and not using UTF-8. -This setting take precedence over C. - -=item * - -C - -Setting this to true will default your query decoding to whatever your -general global encoding is (the default is UTF-8). - =item * C @@ -4692,6 +4769,11 @@ the encoding configuration to undef. This is recommended for temporary backwards compatibility only. +To turn it off for a single request use the L +method to turn off encoding for this request. This can be useful +when you are setting the body to be an arbitrary block of bytes, +especially if that block happens to be a block of UTF8 text. + Encoding is automatically applied when the content-type is set to a type that can be encoded. Currently we encode when the content type matches the following regular expression: @@ -4814,7 +4896,7 @@ andrewalker: André Walker Andrew Bramble -Andrew Ford EA.Ford@ford-mason.co.ukE +Andrew Ford Andrew Ruthven @@ -4828,17 +4910,19 @@ Caelum: Rafael Kitover chansen: Christian Hansen +Chase Venters + chicks: Christopher Hicks -Chisel Wright C +Chisel Wright -Danijel Milicevic C +Danijel Milicevic davewood: David Schmidt -David Kamholz Edkamholz@cpan.orgE +David Kamholz -David Naughton, C +David Naughton David E. Wheeler @@ -4860,7 +4944,7 @@ gabb: Danijel Milicevic Gary Ashton Jones -Gavin Henry C +Gavin Henry Geoff Richards @@ -4872,7 +4956,7 @@ ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho -jester: Jesse Sheidlower C +jester: Jesse Sheidlower jhannah: Jay Hannah @@ -4882,9 +4966,9 @@ Johan Lindstrom jon: Jon Schutz -Jonathan Rockway C<< >> +Jonathan Rockway -Kieren Diment C +Kieren Diment konobi: Scott McWhirter @@ -4920,7 +5004,9 @@ rafl: Florian Ragwitz random: Roland Lammel -Robert Sedlacek C<< >> +revmischa: Mischa Spiegelmock + +Robert Sedlacek SpiceMan: Marcel Montes @@ -4934,17 +5020,17 @@ Ulf Edvinsson vanstyn: Henry Van Styn -Viljo Marrandi C +Viljo Marrandi -Will Hawes C +Will Hawes willert: Sebastian Willert wreis: Wallace Reis -Yuval Kogman, C +Yuval Kogman -rainboxx: Matthias Dietrich, C +rainboxx: Matthias Dietrich dd070: Dhaval Dhanani diff --git a/lib/Catalyst/Component/ContextClosure.pm b/lib/Catalyst/Component/ContextClosure.pm index 9c3139a..b25cc46 100644 --- a/lib/Catalyst/Component/ContextClosure.pm +++ b/lib/Catalyst/Component/ContextClosure.pm @@ -67,7 +67,7 @@ L =head1 AUTHOR -Florian Ragwitz Erafl@debian.orgE +Florian Ragwitz =end stopwords diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index ad88a51..f65ee10 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -5,8 +5,7 @@ use Class::MOP; use Class::Load ':all'; use String::RewritePrefix; use Moose::Util qw/find_meta/; -use List::Util qw/first/; -use List::MoreUtils qw/uniq/; +use List::Util qw/first uniq/; use namespace::clean -except => 'meta'; BEGIN { @@ -662,10 +661,25 @@ arguments, when it is instantiated: From L, stashes the application instance as $self->_application. -=head2 $self->action_for('name') +=head2 $self->action_for($action_name) -Returns the Catalyst::Action object (if any) for a given method name -in this component. +Returns the Catalyst::Action object (if any) for a given action in this +controller or relative to it. You may refer to actions in controllers +nested under the current controllers namespace, or in controllers 'up' +from the current controller namespace. For example: + + package MyApp::Controller::One::Two; + use base 'Catalyst::Controller'; + + sub foo :Local { + my ($self, $c) = @_; + $self->action_for('foo'); # action 'foo' in Controller 'One::Two' + $self->action_for('three/bar'); # action 'bar' in Controller 'One::Two::Three' + $self->action_for('../boo'); # action 'boo' in Controller 'One' + } + +This returns 'undef' if there is no action matching the requested action +name (after any path normalization) so you should check for this as needed. =head2 $self->action_namespace($c) @@ -847,9 +861,9 @@ The following is exactly the same: package MyApp::Controller::Zoo; - sub foo : Local Does('Moo') { ... } # Catalyst::ActionRole:: - sub bar : Local Does('~Moo') { ... } # MyApp::ActionRole::Moo - sub baz : Local Does('+MyApp::ActionRole::Moo') { ... } + sub foo : Local Does('Buzz') { ... } # Catalyst::ActionRole:: + sub bar : Local Does('~Buzz') { ... } # MyApp::ActionRole::Buzz + sub baz : Local Does('+MyApp::ActionRole::Buzz') { ... } =head2 GET diff --git a/lib/Catalyst/Delta.pod b/lib/Catalyst/Delta.pod index 32a4fe9..045767c 100755 --- a/lib/Catalyst/Delta.pod +++ b/lib/Catalyst/Delta.pod @@ -7,6 +7,23 @@ Catalyst::Delta - Overview of changes between versions of Catalyst This is an overview of the user-visible changes to Catalyst between major Catalyst releases. +=head2 VERSION 5.90105 + +This version primarily fixed a regression in the way we preserved $c->state +which the previous version introduced. Now in the case when you forward to +an action, should that action throw an exception it sets state to 0 and is +sure that the return value is false. This is to meet expected behavior based +on the documentation. If you relied on the last update behavior you may not have +regressions but it was thought that we should make the code behave as documented +for more than 10 years. + +We also changed how we compose the request, response and stats base class. We +now compose the base class with any configured traits once at the end of the +application setup, rather than for each request. This reduced request overhead +when you are composing lots of traits. It possible this may break some code that +was adding traits after the application setup was finalized. Please shout out if +this actually causes you trouble and we'll do the best to accommodate. + =head2 VERSION 5.90102 - 5.90103 A significant change is that we now preserve the value of $c->state from action diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index 3cd15f0..138727c 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -162,7 +162,7 @@ sub list { push(@rows, [ '', $name ]); } - my $endpoint_arg_info; + my $endpoint_arg_info = $endpoint; if($endpoint->has_args_constraints) { my $tc = join ',', @{$endpoint->args_constraints}; $endpoint_arg_info .= " ($tc)"; @@ -702,7 +702,7 @@ controller. For Example: # in MyApp::Controller::Foo sub bar : Chained CaptureArgs(1) { ... } - # in MyApp::Controller::Foo::Moo + # in MyApp::Controller::Foo::Bar sub bar : ChainedParent Args(1) { ... } This builds a chain like C. @@ -715,7 +715,7 @@ parts of the path (separated by C) this action wants to capture as its arguments. If it doesn't expect any, just specify C<:CaptureArgs(0)>. The captures get passed to the action's C<@_> right after the context, but you can also find them as array references in -C<$c-Erequest-Ecaptures-E[$level]>. The C<$level> is the +C<< $c->request->captures->[$level] >>. The C<$level> is the level of the action in the chain that captured the parts of the path. An action that is part of a chain (that is, one that has a C<:Chained> @@ -764,7 +764,7 @@ of path parts after the endpoint. Just as with C<:CaptureArgs>, the arguments get passed to the action in C<@_> after the context object. They can also be reached through -C<$c-Erequest-Earguments>. +C<< $c->request->arguments >>. You should see 'Args' in L for more details on using type constraints in your Args declarations. diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 46f41f8..cf98256 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -239,7 +239,7 @@ Documented in L sub forward { my $self = shift; no warnings 'recursion'; - $self->_do_forward(forward => @_); + return $self->_do_forward(forward => @_); } sub _do_forward { @@ -261,6 +261,12 @@ sub _do_forward { no warnings 'recursion'; $action->dispatch( $c ); + #If there is an error, all bets off regarding state. Documentation + #Specifies that when you forward, if there's an error you must expect + #state to be 0. + if( @{ $c->error }) { + $c->state(0); + } return $c->state; } @@ -401,9 +407,14 @@ sub prepare_action { if ( $c->debug && @args ); } -=head2 $self->get_action( $action, $namespace ) +=head2 $self->get_action( $action_name, $namespace ) + +returns a named action from a given namespace. C<$action_name> +may be a relative path on that C<$namespace> such as -returns a named action from a given namespace. + $self->get_action('../bar', 'foo/baz'); + +In which case we look for the action at 'foo/bar'. =cut @@ -413,17 +424,22 @@ sub get_action { $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) ); - return $self->_action_hash->{"${namespace}/${name}"}; + return $self->get_action_by_path("${namespace}/${name}"); } =head2 $self->get_action_by_path( $path ); Returns the named action by its full private path. +This method performs some normalization on C<$path> so that if +it includes '..' it will do the right thing (for example if +C<$path> is '/foo/../bar' that is normalized to '/bar'. + =cut sub get_action_by_path { my ( $self, $path ) = @_; + $path =~s/[^\/]+\/\.\.\/// while $path=~m/[^\/]+\/\.\.\//; $path =~ s/^\///; $path = "/$path" unless $path =~ /\//; $self->_action_hash->{$path}; @@ -614,7 +630,7 @@ sub setup_actions { $self->_load_dispatch_types( @{ $self->preload_dispatch_types } ); @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes; - foreach my $comp ( values %{ $c->components } ) { + foreach my $comp ( map @{$_}{sort keys %$_}, $c->components ) { $comp = $comp->() if ref($comp) eq 'CODE'; $comp->register_actions($c) if $comp->can('register_actions'); } diff --git a/lib/Catalyst/Engine.pm b/lib/Catalyst/Engine.pm index 8480b71..70f49fb 100644 --- a/lib/Catalyst/Engine.pm +++ b/lib/Catalyst/Engine.pm @@ -574,15 +574,18 @@ sub prepare_query_parameters { my ($self, $c) = @_; my $env = $c->request->env; my $do_not_decode_query = $c->config->{do_not_decode_query}; - my $default_query_encoding = $c->config->{default_query_encoding} || - ($c->config->{decode_query_using_global_encoding} ? - $c->encoding : 'UTF-8'); + my $old_encoding; + if(my $new = $c->config->{default_query_encoding}) { + $old_encoding = $c->encoding; + $c->encoding($new); + } + + my $check = $c->config->{do_not_check_query_encoding} ? undef :$c->_encode_check; my $decoder = sub { my $str = shift; return $str if $do_not_decode_query; - return $str unless $default_query_encoding; - return decode( $default_query_encoding, $str); + return $c->_handle_param_unicode_decoding($str, $check); }; my $query_string = exists $env->{QUERY_STRING} @@ -612,6 +615,7 @@ sub prepare_query_parameters { } + $c->encoding($old_encoding) if $old_encoding; $c->request->query_parameters( $c->request->_use_hash_multivalue ? $p : $p->mixed ); } diff --git a/lib/Catalyst/Exception/Basic.pm b/lib/Catalyst/Exception/Basic.pm index 713bb5f..253b6a8 100644 --- a/lib/Catalyst/Exception/Basic.pm +++ b/lib/Catalyst/Exception/Basic.pm @@ -1,6 +1,8 @@ package Catalyst::Exception::Basic; -use MooseX::Role::WithOverloading; +use Moose::Role; +use if !eval { require Moose; Moose->VERSION('2.1300') }, + 'MooseX::Role::WithOverloading'; use Carp; use namespace::clean -except => 'meta'; diff --git a/lib/Catalyst/Exception/Interface.pm b/lib/Catalyst/Exception/Interface.pm index aae67f2..73e4cc0 100644 --- a/lib/Catalyst/Exception/Interface.pm +++ b/lib/Catalyst/Exception/Interface.pm @@ -1,6 +1,8 @@ package Catalyst::Exception::Interface; -use MooseX::Role::WithOverloading; +use Moose::Role; +use if !eval { require Moose; Moose->VERSION('2.1300') }, + 'MooseX::Role::WithOverloading'; use namespace::clean -except => 'meta'; use overload diff --git a/lib/Catalyst/Response.pm b/lib/Catalyst/Response.pm index e87ba61..94ee3f3 100644 --- a/lib/Catalyst/Response.pm +++ b/lib/Catalyst/Response.pm @@ -103,12 +103,24 @@ has _context => ( clearer => '_clear_context', ); -before [qw(status headers content_encoding content_length content_type header)] => sub { +before [qw(status headers content_encoding content_length content_type )] => sub { my $self = shift; - $self->_context->log->warn( + $self->_context->log->warn( "Useless setting a header value after finalize_headers and the response callback has been called." . - " Not what you want." ) + " Since we don't support tail headers this will not work as you might expect." ) + if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); +}; + +# This has to be different since the first param to ->header is the header name and presumably +# you should be able to request the header even after finalization, just not try to change it. +before 'header' => sub { + my $self = shift; + my $header = shift; + + $self->_context->log->warn( + "Useless setting a header value after finalize_headers and the response callback has been called." . + " Since we don't support tail headers this will not work as you might expect." ) if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); }; diff --git a/lib/Catalyst/Runtime.pm b/lib/Catalyst/Runtime.pm index 835066b..24ddcc7 100644 --- a/lib/Catalyst/Runtime.pm +++ b/lib/Catalyst/Runtime.pm @@ -7,7 +7,7 @@ BEGIN { require 5.008003; } # Remember to update this in Catalyst as well! -our $VERSION = '5.90104'; +our $VERSION = '5.90115'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases =head1 NAME diff --git a/lib/Catalyst/ScriptRole.pm b/lib/Catalyst/ScriptRole.pm index f8a12da..845e891 100644 --- a/lib/Catalyst/ScriptRole.pm +++ b/lib/Catalyst/ScriptRole.pm @@ -4,15 +4,14 @@ use Pod::Usage; use MooseX::Getopt; use Catalyst::EngineLoader; use Moose::Util::TypeConstraints; -use Catalyst::Utils qw/ ensure_class_loaded /; -use Class::Load 'load_class'; +use Catalyst::Utils; use namespace::autoclean; subtype 'Catalyst::ScriptRole::LoadableClass', as 'ClassName'; coerce 'Catalyst::ScriptRole::LoadableClass', from 'Str', - via { ensure_class_loaded($_); 1 }; + via { Catalyst::Utils::ensure_class_loaded($_); $_ }; with 'MooseX::Getopt' => { -version => 0.48, @@ -88,7 +87,7 @@ sub _plack_engine_name {} sub _run_application { my $self = shift; my $app = $self->application_name; - load_class($app); + Catalyst::Utils::ensure_class_loaded($app); my $server; if (my $e = $self->_plack_engine_name ) { $server = $self->load_engine($e, $self->_plack_loader_args); diff --git a/lib/Catalyst/Test.pm b/lib/Catalyst/Test.pm index e121b35..ef2ff18 100644 --- a/lib/Catalyst/Test.pm +++ b/lib/Catalyst/Test.pm @@ -256,6 +256,15 @@ header configuration; currently only supports setting 'host' value. my $res = request('foo/bar?test=1'); my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'}); +Alternately, you can pass in an L object to set arbitrary +request headers. + + my $res = request(GET '/foo/bar', + X-Foo => 'Bar', + Authorization => 'Bearer JWT_HERE', + ... + ); + =head2 ($res, $c) = ctx_request( ... ); Works exactly like L, except it also returns the Catalyst context object, diff --git a/lib/Catalyst/Upgrading.pod b/lib/Catalyst/Upgrading.pod index 1c9de49..fd5a6cc 100644 --- a/lib/Catalyst/Upgrading.pod +++ b/lib/Catalyst/Upgrading.pod @@ -72,7 +72,7 @@ use of the non core method in your code as future changes to Catalyst will be synchronized to the core method first. We reserve the right to cease support of the non core version should we reach a point in time where it cannot be properly supported as an external module. Luckily this should be a trivial -search and replace. Change all occurences of: +search and replace. Change all occurrences of: CatalystX::InjectComponent->inject(...) diff --git a/lib/Catalyst/Utils.pm b/lib/Catalyst/Utils.pm index 9fb1e92..fc877d4 100644 --- a/lib/Catalyst/Utils.pm +++ b/lib/Catalyst/Utils.pm @@ -413,11 +413,14 @@ sub term_width { } else { warn "There was an error trying to detect your terminal size: $@\n"; } + }; + + unless ($width) { warn 'Trouble trying to detect your terminal size, looking at $ENV{COLUMNS}'."\n"; $width = $ENV{COLUMNS} if exists($ENV{COLUMNS}) && $ENV{COLUMNS} =~ m/^\d+$/; - }; + } do { warn "Cannot determine desired terminal width, using default of 80 columns\n"; diff --git a/t/abort-chain-1.t b/t/abort-chain-1.t new file mode 100644 index 0000000..dba8593 --- /dev/null +++ b/t/abort-chain-1.t @@ -0,0 +1,50 @@ +#!perl + +use strict; +use warnings; +use Test::More tests => 1; +use HTTP::Request::Common; + +BEGIN { + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + use Moose; + use MooseX::MethodAttributes; + extends 'Catalyst::Controller'; + + has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); + sub increment { + my $self = shift; + $self->counter($self->counter + 1); + } + sub root :Chained('/') :PathPart('') :CaptureArgs(0) { + my ($self, $c, $arg) = @_; + die "Died in root"; + } + sub main :Chained('root') :PathPart('') :Args(0) { + my ($self, $c, $arg) = @_; + $self->increment; + die "Died in main"; + } + sub hits :Path('hits') :Args(0) { + my ($self, $c, $arg) = @_; + $c->response->body($self->counter); + } + __PACKAGE__->config(namespace => ''); +} +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + use Catalyst; + __PACKAGE__->setup; +} + +use Catalyst::Test 'TestApp'; + +{ + my $res = request('/'); +} +{ + my $res = request('/hits'); + is $res->content, 0, "main action not touched on crash with no explicit setting"; +} diff --git a/t/abort-chain-2.t b/t/abort-chain-2.t new file mode 100644 index 0000000..370868c --- /dev/null +++ b/t/abort-chain-2.t @@ -0,0 +1,51 @@ +#!perl + +use strict; +use warnings; +use Test::More tests => 1; +use HTTP::Request::Common; + +BEGIN { + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + use Moose; + use MooseX::MethodAttributes; + extends 'Catalyst::Controller'; + + has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); + sub increment { + my $self = shift; + $self->counter($self->counter + 1); + } + sub root :Chained('/') :PathPart('') :CaptureArgs(0) { + my ($self, $c, $arg) = @_; + die "Died in root"; + } + sub main :Chained('root') :PathPart('') :Args(0) { + my ($self, $c, $arg) = @_; + $self->increment; + die "Died in main"; + } + sub hits :Path('hits') :Args(0) { + my ($self, $c, $arg) = @_; + $c->response->body($self->counter); + } + __PACKAGE__->config(namespace => ''); +} +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + use Catalyst; + __PACKAGE__->config(abort_chain_on_error_fix => 1); + __PACKAGE__->setup; +} + +use Catalyst::Test 'TestApp'; + +{ + my $res = request('/'); +} +{ + my $res = request('/hits'); + is $res->content, 0, "main action not touched on crash with explicit setting to true"; +} diff --git a/t/abort-chain-3.t b/t/abort-chain-3.t new file mode 100644 index 0000000..1b0f928 --- /dev/null +++ b/t/abort-chain-3.t @@ -0,0 +1,51 @@ +#!perl + +use strict; +use warnings; +use Test::More tests => 1; +use HTTP::Request::Common; + +BEGIN { + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + use Moose; + use MooseX::MethodAttributes; + extends 'Catalyst::Controller'; + + has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); + sub increment { + my $self = shift; + $self->counter($self->counter + 1); + } + sub root :Chained('/') :PathPart('') :CaptureArgs(0) { + my ($self, $c, $arg) = @_; + die "Died in root"; + } + sub main :Chained('root') :PathPart('') :Args(0) { + my ($self, $c, $arg) = @_; + $self->increment; + die "Died in main"; + } + sub hits :Path('hits') :Args(0) { + my ($self, $c, $arg) = @_; + $c->response->body($self->counter); + } + __PACKAGE__->config(namespace => ''); +} +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + use Catalyst; + __PACKAGE__->config(abort_chain_on_error_fix => 0); + __PACKAGE__->setup; +} + +use Catalyst::Test 'TestApp'; + +{ + my $res = request('/'); +} +{ + my $res = request('/hits'); + is $res->content, 1, "main action performed on crash with explicit setting to false"; +} diff --git a/t/aggregate/live_component_controller_actionroles.t b/t/aggregate/live_component_controller_actionroles.t index 0bf1b0c..a78fbec 100644 --- a/t/aggregate/live_component_controller_actionroles.t +++ b/t/aggregate/live_component_controller_actionroles.t @@ -8,9 +8,9 @@ use lib "$FindBin::Bin/../lib"; use Catalyst::Test 'TestApp'; my %roles = ( - foo => 'TestApp::ActionRole::Moo', - bar => 'TestApp::ActionRole::Moo', - baz => 'Moo', + foo => 'TestApp::ActionRole::Guff', + bar => 'TestApp::ActionRole::Guff', + baz => 'Guff', quux => 'Catalyst::ActionRole::Zoo', ); @@ -24,9 +24,9 @@ while (my ($path, $role) = each %roles) { { my $resp = request("/actionroles/corge"); ok($resp->is_success); - is($resp->content, 'TestApp::ActionRole::Moo'); + is($resp->content, 'TestApp::ActionRole::Guff'); is($resp->header('X-Affe'), 'Tiger'); - is($resp->header('X-Action-After'), 'moo'); + is($resp->header('X-Action-After'), 'moo'); } { my $resp = request("/actionroles/frew"); diff --git a/t/aggregate/unit_core_log_autoflush.t b/t/aggregate/unit_core_log_autoflush.t index 530d475..bb2aae5 100755 --- a/t/aggregate/unit_core_log_autoflush.t +++ b/t/aggregate/unit_core_log_autoflush.t @@ -35,7 +35,7 @@ like $MESSAGES[0], qr/^\[info\] hello there!$/, { - package Catalyst::Log::Subclass; + package Catalyst::Log::SubclassAutoflush; use base qw/Catalyst::Log/; sub _send_to_log { @@ -47,9 +47,9 @@ like $MESSAGES[0], qr/^\[info\] hello there!$/, @MESSAGES = (); # clear the message log -my $SUBCLASS = 'Catalyst::Log::Subclass'; +my $SUBCLASS = 'Catalyst::Log::SubclassAutoflush'; can_ok $SUBCLASS, 'new'; -ok $log = Catalyst::Log::Subclass->new, +ok $log = $SUBCLASS->new, '... and the log subclass constructor should return a new object'; isa_ok $log, $SUBCLASS, '... and the object it returns'; isa_ok $log, $LOG, '... and it also'; diff --git a/t/aggregate/unit_core_script_server-without_modules.t b/t/aggregate/unit_core_script_server-without_modules.t index 0fdaa87..d6bbcaf 100644 --- a/t/aggregate/unit_core_script_server-without_modules.t +++ b/t/aggregate/unit_core_script_server-without_modules.t @@ -10,26 +10,19 @@ BEGIN { $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP' if $] < '5.008007' } use Test::More; use Try::Tiny; -plan skip_all => "Need Test::Without::Module for this test" - unless try { require Test::Without::Module; 1 }; - -Test::Without::Module->import(qw( +my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( Starman::Server Plack::Handler::Starman MooseX::Daemonize MooseX::Daemonize::Pid::File MooseX::Daemonize::Core -)); - -require "$Bin/../aggregate/unit_core_script_server.t"; +); +local @INC = (sub { + return unless exists $hidden{$_[1]}; + die "Can't locate $_[1] in \@INC (hidden)\n"; +}, @INC); -Test::Without::Module->unimport(qw( - Starman::Server - Plack::Handler::Starman - MooseX::Daemonize - MooseX::Daemonize::Pid::File - MooseX::Daemonize::Core -)); +do "$Bin/../aggregate/unit_core_script_server.t" + or die $@ || 'test returned false'; 1; - diff --git a/t/aggregate/unit_core_uri_for.t b/t/aggregate/unit_core_uri_for.t index ab256f0..887aa4a 100644 --- a/t/aggregate/unit_core_uri_for.t +++ b/t/aggregate/unit_core_uri_for.t @@ -60,6 +60,12 @@ is( ); is( + Catalyst::uri_for( $context, '/bar', 'with space', { 'also with' => 'space here' })->as_string, + 'http://127.0.0.1/foo/bar/with%20space?also+with=space+here', + 'Spaces encoded correctly' +); + +is( Catalyst::uri_for( $context, '/bar#fragment', { param1 => 'value1' } )->as_string, 'http://127.0.0.1/foo/bar?param1=value1#fragment', 'URI for path with fragment and query params 1' @@ -127,6 +133,12 @@ is( 'Plus is not encoded, called with only class name' ); +is( + Catalyst::uri_for( 'TestApp', '/bar', 'with space', { 'also with' => 'space here' })->as_string, + '/bar/with%20space?also+with=space+here', + 'Spaces encoded correctly, called with only class name' +); + TODO: { local $TODO = 'broken by 5.7008'; is( diff --git a/t/author/spelling.t b/t/author/spelling.t index c90f51a..e5b01bc 100644 --- a/t/author/spelling.t +++ b/t/author/spelling.t @@ -60,8 +60,10 @@ add_stopwords(qw( Marrandi McWhirter Milicevic + Mischa Miyagawa Montes + Napiorkowski Naughton Oleg Ragwitz @@ -79,11 +81,13 @@ add_stopwords(qw( Sedlacek Sheidlower SpiceMan + Spiegelmock Styn Szilakszi Tatsuhiko Ulf Upasana + Venters Vilain Viljo Wardley @@ -121,7 +125,6 @@ add_stopwords(qw( miyagawa mst multipart - Napiorkowski naughton ningu nothingmuch @@ -130,6 +133,7 @@ add_stopwords(qw( phaylon rafl rainboxx + revmischa sri szbalint uploadtmp diff --git a/t/class_traits.t b/t/class_traits.t index 8c65b38..d6a0c50 100644 --- a/t/class_traits.t +++ b/t/class_traits.t @@ -4,28 +4,46 @@ use Test::More; use Class::MOP; BEGIN { + my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( + Foo + Bar + ); + unshift @INC, sub { + return unless exists $hidden{$_[1]}; + die "Can't locate $_[1] in \@INC (hidden)\n"; + }; +} + +BEGIN { package TestRole; + $INC{'TestRole'} = __FILE__; use Moose::Role; sub a { 'a' } sub b { 'b' } package Catalyst::TraitFor::Request::Foo; + $INC{'Catalyst/TraitFor/Request/Foo.pm'} = __FILE__; use Moose::Role; sub c { 'c' } package TestApp::TraitFor::Request::Bar; + $INC{'TestApp/TraitFor/Request/Bar.pm'} = __FILE__; use Moose::Role; sub d { 'd' } package Catalyst::TraitFor::Response::Foo; + $INC{'Catalyst/TraitFor/Response/Foo.pm'} = __FILE__; + use Moose::Role; sub c { 'c' } package TestApp::TraitFor::Response::Bar; + $INC{'TestApp/TraitFor/Response/Bar.pm'} = __FILE__; + use Moose::Role; sub d { 'd' } @@ -33,6 +51,7 @@ BEGIN { { package TestApp; + $INC{'TestApp.pm'} = __FILE__; use Catalyst; diff --git a/t/class_traits_CAR_bug.t b/t/class_traits_CAR_bug.t new file mode 100644 index 0000000..cc57bc1 --- /dev/null +++ b/t/class_traits_CAR_bug.t @@ -0,0 +1,81 @@ +use strict; +use warnings; +use Test::More; +use Class::MOP; + +BEGIN { + use Test::More; + eval "use Catalyst::Action::REST; 1" || do { + plan skip_all => "Trouble loading Catalyst::Action::REST => $@"; + }; +} + +BEGIN { + my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( + Foo + Bar + ); + unshift @INC, sub { + return unless exists $hidden{$_[1]}; + die "Can't locate $_[1] in \@INC (hidden)\n"; + }; +} + +BEGIN { + package TestRole; + $INC{'TestRole'} = __FILE__; + use Moose::Role; + + sub a { 'a' } + sub b { 'b' } + + package Catalyst::TraitFor::Request::Foo; + $INC{'Catalyst/TraitFor/Request/Foo.pm'} = __FILE__; + use Moose::Role; + + sub c { 'c' } + + package TestApp::TraitFor::Request::Bar; + $INC{'TestApp/TraitFor/Request/Bar.pm'} = __FILE__; + use Moose::Role; + + sub d { 'd' } + + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + + +} + +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + + use Catalyst; + + __PACKAGE__->request_class_traits([qw/TestRole Foo Bar/]); + __PACKAGE__->setup; +} + + +foreach my $class_prefix (qw/request/) { + my $method = 'composed_' .$class_prefix. '_class'; + ok( + Class::MOP::class_of(TestApp->$method)->does_role('TestRole'), + "$method does TestRole", + ); +} + +use Catalyst::Test 'TestApp'; + +my ($res, $c) = ctx_request '/'; + +is $c->req->a, 'a'; +is $c->req->b, 'b'; +is $c->req->c, 'c'; +is $c->req->d, 'd'; + +done_testing; diff --git a/t/evil_stash.t b/t/evil_stash.t new file mode 100644 index 0000000..e97a131 --- /dev/null +++ b/t/evil_stash.t @@ -0,0 +1,37 @@ +use warnings; +use strict; +use Test::More; + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + sub root :Path('') Args(0) { + my ($self, $c) = @_; + $c->{stash}->{foo} = 'bar'; + $c->stash(baz=>'boor'); + $c->{stash}->{baz} = $c->stash->{baz} . 2; + + Test::More::is($c->stash->{foo}, 'bar'); + Test::More::is($c->stash->{baz}, 'boor2'); + Test::More::is($c->{stash}->{foo}, 'bar'); + Test::More::is($c->{stash}->{baz}, 'boor2'); + + $c->res->body('return'); + } + + package MyApp; + use Catalyst; + MyApp->setup; +} + +use HTTP::Request::Common; +use Catalyst::Test 'MyApp'; + +{ + ok my $res = request POST 'root/'; +} + +done_testing(); diff --git a/t/execute_exception.t b/t/execute_exception.t new file mode 100644 index 0000000..b880b06 --- /dev/null +++ b/t/execute_exception.t @@ -0,0 +1,60 @@ +use warnings; +use strict; +use Test::More; +use HTTP::Request::Common; + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + MyApp::Controller::Root->config(namespace=>''); + + sub could_throw :Private { + my ($self, $c) = @_; + if ($c->req->args->[0] eq 'y') { + die 'Bad stuff happened'; + } + else { + return 5; + } + } + + sub do_throw :Local { + my ($self, $c) = @_; + + my $ret = $c->forward('/could_throw/y'); + Test::More::is($c->state, 0, 'Throwing: state is correct'); + Test::More::is($ret, 0, 'Throwing: return is correct'); + Test::More::ok($c->has_errors, 'Throwing: has errors'); + } + + sub dont_throw :Local { + my ($self, $c) = @_; + + my $ret = $c->forward('/could_throw/n'); + Test::More::is($c->state, 5, 'Not throwing: state is correct'); + Test::More::is($ret, 5, 'Not throwing: return is correct'); + Test::More::ok(!$c->has_errors, 'Throwing: no errors'); + } + + package MyApp; + use Catalyst; + + MyApp->config(show_internal_actions=>1); + MyApp->setup; +} + +use Catalyst::Test 'MyApp'; + +{ + my ($res, $c); + + ctx_request("/dont_throw"); + ctx_request("/do_throw"); + ctx_request("/dont_throw"); +} + +done_testing; + diff --git a/t/lib/Catalyst/ActionRole/Moo.pm b/t/lib/Catalyst/ActionRole/Guff.pm similarity index 80% rename from t/lib/Catalyst/ActionRole/Moo.pm rename to t/lib/Catalyst/ActionRole/Guff.pm index 3d4aa51..4f8e046 100644 --- a/t/lib/Catalyst/ActionRole/Moo.pm +++ b/t/lib/Catalyst/ActionRole/Guff.pm @@ -1,4 +1,4 @@ -package Catalyst::ActionRole::Moo; +package Catalyst::ActionRole::Guff; use Moose::Role; diff --git a/t/lib/Moo.pm b/t/lib/Guff.pm similarity index 91% rename from t/lib/Moo.pm rename to t/lib/Guff.pm index c28806a..16e558e 100644 --- a/t/lib/Moo.pm +++ b/t/lib/Guff.pm @@ -1,4 +1,4 @@ -package Moo; +package Guff; use Moose::Role; diff --git a/t/lib/TestApp/ActionRole/Moo.pm b/t/lib/TestApp/ActionRole/Guff.pm similarity index 77% rename from t/lib/TestApp/ActionRole/Moo.pm rename to t/lib/TestApp/ActionRole/Guff.pm index d0fd290..3e8fdd9 100644 --- a/t/lib/TestApp/ActionRole/Moo.pm +++ b/t/lib/TestApp/ActionRole/Guff.pm @@ -1,4 +1,4 @@ -package TestApp::ActionRole::Moo; +package TestApp::ActionRole::Guff; use Moose::Role; diff --git a/t/lib/TestApp/Controller/ActionRoles.pm b/t/lib/TestApp/Controller/ActionRoles.pm index 37c24f9..69206bb 100644 --- a/t/lib/TestApp/Controller/ActionRoles.pm +++ b/t/lib/TestApp/Controller/ActionRoles.pm @@ -11,12 +11,12 @@ __PACKAGE__->config( }, ); -sub foo : Local Does('Moo') {} -sub bar : Local Does('~Moo') {} -sub baz : Local Does('+Moo') {} +sub foo : Local Does('Guff') {} +sub bar : Local Does('~Guff') {} +sub baz : Local Does('+Guff') {} sub quux : Local Does('Zoo') {} -sub corge : Local Does('Moo') ActionClass('TestAfter') { +sub corge : Local Does('Guff') ActionClass('TestAfter') { my ($self, $ctx) = @_; $ctx->stash(after_message => 'moo'); } diff --git a/t/lib/TestAppArgsEmptyParens.pm b/t/lib/TestAppArgsEmptyParens.pm index 051a850..c7684ec 100644 --- a/t/lib/TestAppArgsEmptyParens.pm +++ b/t/lib/TestAppArgsEmptyParens.pm @@ -1,4 +1,5 @@ package TestAppArgsEmptyParens::Controller::Root; +$INC{'TestAppArgsEmptyParens/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; @@ -12,6 +13,8 @@ sub chain_base :Chained(/) PathPart('chain_base') CaptureArgs(0) { } TestAppArgsEmptyParens::Controller::Root->config(namespace=>''); package TestAppArgsEmptyParens; +$INC{'TestAppArgsEmptyParens.pm'} = __FILE__; + use Catalyst; use TestLogger; diff --git a/t/relative_root_action_for_bug.t b/t/relative_root_action_for_bug.t new file mode 100644 index 0000000..06cd0c2 --- /dev/null +++ b/t/relative_root_action_for_bug.t @@ -0,0 +1,93 @@ +use warnings; +use strict; +use Test::More; + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + sub root :Chained(/) PathPart('') CaptureArgs(0) { + my ($self, $c) = @_; + } + + sub top :Chained('root') Args(0) { + my ($self, $c) = @_; + Test::More::is $self->action_for('top'), 'top'; + Test::More::is $self->action_for('story/story'), 'story/story'; + } + + sub default : Path { + + my ($self, $c) = @_; + $c->response->body("Ok"); + } + + MyApp::Controller::Root->config(namespace=>''); + + package MyApp::Controller::Story; + $INC{'MyApp/Controller/Story.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + sub root :Chained(/root) PathPart('') CaptureArgs(0) { + my ($self, $c) = @_; + } + + sub story :Chained(root) Args(0) { + my ($self, $c) = @_; + + Test::More::is $self->action_for('story'), 'story/story'; + Test::More::is $self->action_for('author/author'), 'story/author/author'; + } + + __PACKAGE__->meta->make_immutable; + + package MyApp::Controller::Story::Author; + $INC{'MyApp/Controller/Story/Author.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + + extends 'Catalyst::Controller'; + + sub root :Chained(/story/root) PathPart('') CaptureArgs(0) { + my ($self, $c) = @_; + } + + sub author :Chained(root) Args(0) { + my ($self, $c, $id) = @_; + Test::More::is $self->action_for('author'), 'story/author/author'; + Test::More::is $self->action_for('../story'), 'story/story'; + Test::More::is $self->action_for('../../top'), 'top'; + } + + __PACKAGE__->meta->make_immutable; + + package MyApp; + $INC{'MyApp.pm'} = __FILE__; + + use Catalyst; + + MyApp->setup; +} + +use Catalyst::Test 'MyApp'; + +ok request '/top'; +ok request '/story'; +ok request '/author'; +ok request '/double'; +ok request '/double/file.ext'; +ok request '/double/file..ext'; + + +done_testing(13); + diff --git a/t/undef_encoding_regression.t b/t/undef_encoding_regression.t new file mode 100644 index 0000000..049ac71 --- /dev/null +++ b/t/undef_encoding_regression.t @@ -0,0 +1,42 @@ +use utf8; +use warnings; +use strict; +use Test::More; +use HTTP::Request::Common; +use HTTP::Message::PSGI (); +use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; + +{ + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + sub heart :Local Args(1) { + my ($self, $c, $arg) = @_; + + Test::More::is $c->req->query_parameters->{a}, 111; + Test::More::is $c->req->query_parameters->{b}, 222; + Test::More::is $arg, 1; + + $c->response->content_type('text/html'); + $c->response->body("

This is path local

"); + } + + package MyApp; + use Catalyst; + + MyApp->config(encoding => undef); + + Test::More::ok(MyApp->setup, 'setup app'); +} + +use Catalyst::Test 'MyApp'; + +{ + my $res = request "/root/heart/1?a=111&b=222"; + is $res->code, 200, 'OK'; + is $res->content, '

This is path local

'; +} + +done_testing; diff --git a/t/unicode-exception-bug.t b/t/unicode-exception-bug.t new file mode 100644 index 0000000..14031b0 --- /dev/null +++ b/t/unicode-exception-bug.t @@ -0,0 +1,76 @@ +use strict; +use warnings; +use Test::More; + +BEGIN { + package TestApp::Exception; + $INC{'TestApp/Exception.pm'} = __FILE__; + + sub new { + my ($class, $code, $headers, $body) = @_; + return bless +{res => [$code, $headers, $body]}, $class; + } + + sub throw { die shift->new(@_) } + + sub as_psgi { + my ($self, $env) = @_; + my ($code, $headers, $body) = @{$self->{res}}; + + return [$code, $headers, $body]; # for now + + return sub { + my $responder = shift; + $responder->([$code, $headers, $body]); + }; + } + + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + extends 'Catalyst::Controller'; + + sub main :Path('') :Args(1) { + my ($self, $c, $arg) = @_; + $c->res->body('

OK

'); + $c->res->content_type('text/html'); + } + + TestApp::Controller::Root->config(namespace => ''); +} + +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + + use Catalyst; + use TestApp::Exception; + + sub handle_unicode_encoding_exception { + my ( $self, $param_value, $error_msg ) = @_; + TestApp::Exception->throw( + 200, ['content-type'=>'text/plain'], ['Bad unicode data']); + } + + __PACKAGE__->setup; +} + + +use Catalyst::Test 'TestApp'; + +{ + my $res = request('/ok'); + is ($res->status_line, "200 OK"); + is ($res->content, '

OK

'); +} + +{ + my $res = request('/%E2%C3%83%C6%92%C3%8'); + is ($res->content, 'Bad unicode data'); +} + +done_testing; + +#TestApp->to_app; diff --git a/t/unicode-exception-return-value.t b/t/unicode-exception-return-value.t new file mode 100644 index 0000000..3f52a2a --- /dev/null +++ b/t/unicode-exception-return-value.t @@ -0,0 +1,96 @@ +use strict; +use warnings; +use Test::More; +use HTTP::Request::Common; + +BEGIN { + package TestApp::Controller::Root; + $INC{'TestApp/Controller/Root.pm'} = __FILE__; + + use Moose; + use MooseX::MethodAttributes; + extends 'Catalyst::Controller'; + + sub main :Path('') :Args(1) { + my ($self, $c, $arg) = @_; + my $body = $arg . "\n"; + my $query_params = $c->request->query_params; + my $body_params = $c->request->body_params; + foreach my $key (sort keys %$query_params) { + $body .= "Q $key => " . $query_params->{$key} . "\n"; + } + foreach my $key (sort keys %$body_params) { + $body .= "B $key => " . $body_params->{$key} . "\n"; + } + $c->res->body($body); + $c->res->content_type('text/plain'); + } + TestApp::Controller::Root->config(namespace => ''); +} + +{ + package TestApp; + $INC{'TestApp.pm'} = __FILE__; + + use Catalyst; + + sub handle_unicode_encoding_exception { + my ( $self, $param_value, $error_msg ) = @_; + # totally dummy: we return any invalid string with a fixed + # value. a more clever thing would be try to decode it from + # latin1 or latin2. + return "INVALID-UNICODE"; + } + + __PACKAGE__->setup; +} + + +use Catalyst::Test 'TestApp'; + +{ + my $res = request('/ok'); + is ($res->content, "ok\n", "app is echoing arguments"); +} + +{ + my $res = request('/%E2%C3%83%C6%92%C3%8'); + is ($res->content, "INVALID-UNICODE\n", + "replacement ok in arguments"); +} +{ + my $res = request('/p?valid_key=%e2'); + is ($res->content, "p\nQ valid_key => INVALID-UNICODE\n", + "replacement ok in query"); +} +{ + my $res = request('/p?%e2=%e2'); + is ($res->content, "p\nQ INVALID-UNICODE => INVALID-UNICODE\n", + "replacement ok in query"); +} +{ + my $req = POST "/p", Content => "%e2=%e2"; + my $res = request($req); + is ($res->content, "p\nB INVALID-UNICODE => INVALID-UNICODE\n", "replacement ok in body"); +} +{ + my $req = POST "/p", Content => "valid_key=%e2"; + my $res = request($req); + is ($res->content, "p\nB valid_key => INVALID-UNICODE\n", "replacement ok in body"); +} +{ + # and a superset of problems: + my $req = POST "/%e5?%e3=%e3", Content => "%e4=%e4"; + my $res = request($req); + my $expected = <<'BODY'; +INVALID-UNICODE +Q INVALID-UNICODE => INVALID-UNICODE +B INVALID-UNICODE => INVALID-UNICODE +BODY + is ($res->content, $expected, "Found the replacement strings everywhere"); +} + + +done_testing; + +#TestApp->to_app; diff --git a/t/useless_set_headers.t b/t/useless_set_headers.t new file mode 100644 index 0000000..0db6fda --- /dev/null +++ b/t/useless_set_headers.t @@ -0,0 +1,67 @@ +use warnings; +use strict; +use Test::More; +use HTTP::Request::Common; + +{ + package TestAppStats::Log; + $INC{'TestAppStats/Log.pm'} = __FILE__; + + use base qw/Catalyst::Log/; + + my @warn; + + sub my_warnings { $warn[0] }; + sub warn { shift; push(@warn, @_) } + + package MyApp::Controller::Root; + $INC{'MyApp/Controller/Root.pm'} = __FILE__; + + use base 'Catalyst::Controller'; + + sub get_header_ok :Local { + my ($self, $c) = @_; + $c->res->body('get_header_ok'); + } + + sub set_header_nok :Local { + my ($self, $c) = @_; + $c->res->body('set_header_nok'); + } + + package MyApp; + $INC{'MyApp.pm'} = __FILE__; + + use Catalyst; + use Moose; + + sub debug { 1 } + + __PACKAGE__->log(TestAppStats::Log->new); + + after 'finalize' => sub { + my ($c) = @_; + if($c->res->body eq 'set_header_nok') { + Test::More::ok 1, 'got this far'; # got this far + $c->res->header('REQUEST_METHOD', 'bad idea'); + } elsif($c->res->body eq 'get_header_ok') { + Test::More::ok $c->res->header('x-catalyst'), 'Can query a header without causing trouble'; + } + }; + + MyApp->setup; +} + +use Catalyst::Test 'MyApp'; + +ok request(GET '/root/get_header_ok'), 'got good request for get_header_ok'; +ok !TestAppStats::Log::my_warnings, 'no warnings'; +ok request(GET '/root/set_header_nok'), 'got good request for set_header_nok'; +ok TestAppStats::Log::my_warnings, 'has a warning'; +like TestAppStats::Log::my_warnings, qr'Useless setting a header value after finalize_headers', 'got expected warnings'; + +# We need to specify the number in order to be sure we are testing +# it all correctly. If you change the number of tests please keep +# this up to date. DO NOT REMOVE THIS! + +done_testing(7); diff --git a/t/utf_incoming.t b/t/utf_incoming.t index 21683cf..5293951 100644 --- a/t/utf_incoming.t +++ b/t/utf_incoming.t @@ -7,6 +7,7 @@ use HTTP::Message::PSGI (); use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; use File::Spec; use JSON::MaybeXS; +use Data::Dumper; use Scalar::Util (); # Test cases for incoming utf8 @@ -223,6 +224,13 @@ use Scalar::Util (); $c->response->body($c->req->body_parameters->{arg}); } + sub echo_param :Local { + my ($self, $c) = @_; + $c->response->content_type('text/plain'); + $c->response->body($c->req->query_parameters->{arg}); + } + + package MyApp; use Catalyst; @@ -529,6 +537,29 @@ SKIP: { is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value'; } +{ + my $invalid = '%e2'; + # in url + { + my $req = GET "/$invalid"; + my $res = request $req; + is ($res->code, '400', "Invalid url param is 400"); + } + # in body + { + my $req = POST "/root/echo_arg", Content => "arg0=$invalid"; + my $res = request $req; + is ($res->code, '400', "Invalid post param is 400"); + } + # in query + { + # failing since 5.90080 + my $req = GET "/root/echo_param?arg=$invalid"; + my $res = request $req; + is ($res->code, '400', "Invalid get param is 400") or diag Dumper($res->decoded_content); + } +} + ## should we use binmode on filehandles to force the encoding...? ## Not sure what else to do with multipart here, if docs are enough...