Merge branch 'check_return_of_write_to_psgi_input' of https://github.com/billmoseley...
John Napiorkowski [Thu, 29 Oct 2015 14:44:53 +0000 (09:44 -0500)]
23 files changed:
.travis.yml
Changes
README.mkdn
lib/Catalyst.pm
lib/Catalyst/Action.pm
lib/Catalyst/Component.pm
lib/Catalyst/Contributing.pod
lib/Catalyst/Delta.pod
lib/Catalyst/Middleware/Stash.pm
lib/Catalyst/Request.pm
lib/Catalyst/Request/PartData.pm
lib/Catalyst/Response.pm
lib/Catalyst/RouteMatching.pod
lib/Catalyst/Runtime.pm
lib/Catalyst/UTF8.pod
lib/Catalyst/Upgrading.pod
t/aggregate/unit_core_uri_for.t
t/arg_constraints.t
t/body_fh.t
t/middleware-stash.t
t/unicode_plugin_config.t
t/unicode_plugin_live.t
t/utf_incoming.t

index d8b448a..4db74ef 100644 (file)
@@ -18,7 +18,7 @@ install:
 
    # author deps -- wish there was a better way
    - cpanm --notest --metacpan --skip-satisfied CatalystX::LeakChecker Catalyst::Devel Catalyst::Engine::PSGI Starman MooseX::Daemonize Test::WWW::Mechanize::Catalyst Catalyst::Plugin::Params::Nested
-   - cpanm --notest --metacpan --skip-satisfied Test::Without::Module Test::NoTabs Test::Pod Test::Pod::Coverage Test::Spelling Pod::Coverage::TrustPod
+   - cpanm --notest --metacpan --skip-satisfied Test::Without::Module Test::NoTabs Test::Pod Test::Pod::Coverage Test::Spelling Pod::Coverage::TrustPod Type::Tiny
    - cpanm --notest --metacpan --skip-satisfied --installdeps .
    - echo y | perl Makefile.PL
 
diff --git a/Changes b/Changes
index d842512..4d86d01 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,5 +1,57 @@
 # This file documents the revision history for Perl extension Catalyst.
 
+5.90101 - 2015-09-04
+  - Fixed a regression introduced in the last release which caused test
+    case failure when using a version of Perl 5.14 or older.
+
+5.90100 - 2015-08-24
+  - Document using namespace::autoclean with controllers that have actions
+    with type constraints.
+  - Look for type constraints in super classes and consumed roles.
+  - Change the way the stash middleware works to no longer localize $psgi_env.
+  - If you delegate control to a sub Catalyst application, that application
+    may now return information to the parent application via the stash.
+  - Fix for RT#106373 (Issue when you try to install and also have an old
+    version of Test::Mechanize::WWW::Catalyst)
+
+5.90097 - 2015-07-28
+  - $c->uri_for now defines a final argument for setting the URL fragment
+  /URL anchor.  This is now the canonical approach to setting a fragment
+  via uri_for.
+  - Reverted how we treat $c->uri_for($path) where $path is a string.  When
+    we introduced the UTF-8 work we started encoding stringy paths, which
+    breaks code that did not expect that.  We now consider stringy $path to
+    be 'expert' mode and you are expected to perform all nessary encoding.
+
+5.90096 - 2015-07-27
+  - Fixed regression introduced in previous release that prevented a URI
+    fragment from getting properly encoded.  Added more tests around this
+    to define behavior better.
+
+5.90095 - 2015-07-27
+  - Minor test case tweak that I hope solve some minor hiesenfails reported
+    on CPAN testers.
+  - (https://github.com/perl-catalyst/catalyst-runtime/pull/109) added som
+    additional directions to how to setup a development sandbox
+  - (https://github.com/perl-catalyst/catalyst-runtime/pull/108) fix bug in
+    encoding where URI fragment seperator '#' in ->uri_for would get encoded.
+
+5.90094 - 2015-07-24
+  - When there is a multipart POST request and the parts have extended
+    HTTP headers, try harder to decode and squeeze a meaningful value
+    out of it before giving up and crying.  Updated docs and tests to
+    reflect this change.  This should solve problems when your clients
+    are posting multipart form values with special character sets.
+  - Fixed issue where last_error actually returned the first error.  Took
+    the change to add a 'pop_errors' to give the inverse of shift_errors.
+  - Merged Pull Requests:
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/95
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/96
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/97
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/98
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/106
+    - https://github.com/perl-catalyst/catalyst-runtime/pull/107
+
 5.90093 - 2015-05-29
   - Fixed a bug where if you used $res->write and then $res->body, the
     contents of body would be double encoded (gshank++).
index f30025c..74be19d 100644 (file)
@@ -14,6 +14,11 @@ Catalyst - The Elegant MVC Web Application Framework
 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
@@ -1440,7 +1445,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 provably more correct, it is recommended that you use
+        Given that this method of path resolution is probably 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.
 
@@ -1454,7 +1459,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 its not automatically a dependency of [Catalyst](https://metacpan.org/pod/Catalyst).
+middleware to your project dependency list since it's 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)
@@ -1515,7 +1520,7 @@ This has been done since not all people need this feature and we wish to restric
 - `do_not_decode_query`
 
     If true, then do not try to character decode any wide characters in your
-    request URL query or keywords.  Most readings of the relevent specifications
+    request URL query or keywords.  Most readings of the relevant specifications
     suggest these should be UTF-\* encoded, which is the default that [Catalyst](https://metacpan.org/pod/Catalyst)
     will use, hwoever if you are creating a lot of URLs manually or have external
     evil clients, this might cause you trouble.  If you find the changes introduced
@@ -2009,7 +2014,7 @@ acme: Leon Brocard <leon@astray.com>
 
 abraxxa: Alexander Hartmaier <abraxxa@cpan.org>
 
-andrewalker: André Walker <andre@cpan.org>
+andrewalker: André Walker <andre@cpan.org>
 
 Andrew Bramble
 
@@ -2067,7 +2072,7 @@ groditi: Guillermo Roditi <groditi@gmail.com>
 
 hobbs: Andrew Rodland <andrew@cleverdomain.org>
 
-ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
+ilmari: Dagfinn Ilmari Mannsåker <ilmari@ilmari.org>
 
 jcamacho: Juan Camacho
 
@@ -2089,6 +2094,8 @@ konobi: Scott McWhirter <konobi@cpan.org>
 
 marcus: Marcus Ramberg <mramberg@cpan.org>
 
+Mischa Spiegelmock <revmischa@cpan.org>
+
 miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
 
 mgrimes: Mark Grimes <mgrimes@cpan.org>
index 0148bd2..c290fff 100644 (file)
@@ -180,7 +180,7 @@ sub composed_stats_class {
 __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC);
 
 # Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.90093';
+our $VERSION = '5.90101';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 sub import {
@@ -521,7 +521,7 @@ L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>,
 C<< $c->go >> will perform a full dispatch on the specified action or method,
 with localized C<< $c->action >> and C<< $c->namespace >>. Like C<detach>,
 C<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
@@ -640,22 +640,42 @@ sub has_errors { scalar(@{shift->error}) ? 1:0 }
 =head2 $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.
 
 =cut
 
-sub last_error { my ($err, @errs) = @{shift->error}; return $err }
+sub last_error {
+  my (@errs) = @{shift->error};
+  return scalar(@errs) ? $errs[-1]: undef;
+}
 
 =head2 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.
 
 =cut
 
 sub shift_errors {
     my ($self) = @_;
-    my ($err, @errors) = @{$self->error};
+    my @errors = @{$self->error};
+    my $err = shift(@errors);
+    $self->{error} = \@errors;
+    return $err;
+}
+
+=head2 pop_errors
+
+pops the most recently added error off the error stack and returns it.  Returns
+nothing if there are no more errors.
+
+=cut
+
+sub pop_errors {
+    my ($self) = @_;
+    my @errors = @{$self->error};
+    my $err = pop(@errors);
     $self->{error} = \@errors;
     return $err;
 }
@@ -1464,11 +1484,11 @@ sub setup_finalize {
     $class->setup_finished(1);
 }
 
-=head2 $c->uri_for( $path?, @args?, \%query_values? )
+=head2 $c->uri_for( $path?, @args?, \%query_values?, \$fragment? )
 
-=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? )
+=head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? )
 
-=head2 $c->uri_for( $action, [@captures, @args], \%query_values? )
+=head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? )
 
 Constructs an absolute L<URI> object based on the application root, the
 provided path, and the additional arguments and query parameters provided.
@@ -1486,6 +1506,15 @@ relative to the application root (if it does). It is then merged with
 C<< $c->request->base >>; any C<@args> are appended as additional path
 components; and any C<%query_values> are appended as C<?foo=bar> parameters.
 
+B<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 L<Catalyst::Action> it represents an action which
 will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The
 optional C<\@captures> argument (an arrayref) allows passing the captured
@@ -1528,11 +1557,24 @@ sub uri_for {
         $path .= '/';
     }
 
-    undef($path) if (defined $path && $path eq '');
+    my $fragment =  ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef );
+
+    unless(blessed $path) {
+      if ($path =~ s/#(.+)$//)  {
+        if(defined($1) and $fragment) {
+          carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'";
+        }
+        if(defined($1)) {
+          $fragment = $1;
+        }
+      }
+    }
 
     my $params =
       ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
 
+    undef($path) if (defined $path && $path eq '');
+
     carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
 
     my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef;
@@ -1611,7 +1653,6 @@ sub uri_for {
     }
 
     my $query = '';
-
     if (my @keys = keys %$params) {
       # somewhat lifted from URI::_query's query_form
       $query = '?'.join('&', map {
@@ -1640,7 +1681,16 @@ sub uri_for {
     $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
     $args = encode_utf8 $args;
     $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
-    
+
+    if(defined $fragment) {
+      if(blessed $path) {
+        $fragment = encode_utf8(${$fragment});
+        $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
+        $fragment =~ s/ /+/g;
+      }
+      $query .= "#$fragment";
+    }
+
     my $res = bless(\"${base}${args}${query}", $class);
     $res;
 }
index 32d9b99..fef451d 100644 (file)
@@ -20,7 +20,7 @@ L<Catalyst::Controller> subclasses.
 =cut
 
 use Moose;
-use Scalar::Util 'looks_like_number';
+use Scalar::Util 'looks_like_number', 'blessed';
 use Moose::Util::TypeConstraints ();
 with 'MooseX::Emulate::Class::Accessor::Fast';
 use namespace::clean -except => 'meta';
@@ -243,8 +243,55 @@ has captures_constraints => (
 
 sub resolve_type_constraint {
   my ($self, $name) = @_;
-  my @tc = eval "package ${\$self->class}; $name" or die "'$name' not a type constraint in ${\$self->private_path}";
-  if($tc[0]) {
+
+  if(defined($name) && blessed($name) && $name->can('check')) {
+    # Its already a TC, good to go.
+    return $name;
+  }
+
+  # This is broken for when there is more than one constraint
+  if($name=~m/::/) {
+    eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny";
+    my $tc =  Type::Registry->new->foreign_lookup($name);
+    return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}";
+  }
+  
+  my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name"));
+
+  unless(scalar @tc) {
+    # ok... so its not defined in the package.  we need to look at all the roles
+    # and superclasses, look for attributes and figure it out.
+    # Superclasses take precedence;
+
+    my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : ();
+    my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : ();
+
+    # So look thru all the super and roles in order and return the
+    # first type constraint found. We should probably find all matching
+    # type constraints and try to do some sort of resolution.
+
+    foreach my $parent (@roles, @supers) {
+      if(my $m = $parent->get_method($self->name)) {
+        if($m->can('attributes')) {
+          my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ }
+            grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ }
+              @{$m->attributes};
+          next unless $value eq $name;
+          my @tc = eval "package ${\$parent->name}; $name";
+          if(scalar(@tc)) {
+            return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
+          } else {
+            return;
+          }
+        } 
+      }
+    }
+    
+    my $classes = join(',', $self->class, @roles, @supers);
+    die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
+  }
+
+  if(scalar(@tc)) {
     return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc;
   } else {
     return;
index 0952b76..01e38f5 100644 (file)
@@ -289,6 +289,14 @@ And in a controller:
 
     my $type = $c->model('FooFactory', 1,2,3,4): # $type->isa('Type1')
 
+B<NOTE:> If you define a ACCEPT_CONTEXT method it MUST check to see if the
+second argument is blessed (is a context) or not (is an application class name) and
+it MUST return something valid for the case when the scope is application.  This is
+required because a component maybe be called from the application scope even if it
+requires a context and you must prevent errors from being issued if this happens.
+Remeber not all components that ACCEPT_CONTEXT actually need or use context information
+(and there is a school of thought that suggestions doing so is a design error anyway...)
+
 =head1 SEE ALSO
 
 L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
index 7faa66c..b4054df 100644 (file)
@@ -23,7 +23,7 @@ Going further, if we allow ourselves to look hard at projects outside of Perl we
 
 =head2 Reporting a bug
 
-Reported bugs via RT or Github Issues that come with attached test cases will be more likely addressed quickly than those that do not.  Proposing a bugfix patch is also alwaysvery welcomed, although it is recommended to stick as closely as possible to an actual bug (rather than a feature change) and to not include unneeded changes in your patch such as formatting corrections.  In any case it is recommended before spending a lot of time on a patch to discuss the issue and your proposed solution, else you risk spending a lot of time on code that may not get merged, which tends to be frustrating.
+Reported bugs via RT or L<Github Issues|https://github.com/perl-catalyst/catalyst-runtime/issues> that come with attached test cases will be more likely addressed quickly than those that do not.  Proposing a bugfix patch is also alwaysvery welcomed, although it is recommended to stick as closely as possible to an actual bug (rather than a feature change) and to not include unneeded changes in your patch such as formatting corrections.  In any case it is recommended before spending a lot of time on a patch to discuss the issue and your proposed solution, else you risk spending a lot of time on code that may not get merged, which tends to be frustrating.
 
 For bug patches you should create a new branch from the current master.
 
@@ -31,7 +31,7 @@ For bug patches you should create a new branch from the current master.
 
 You should first ask yourself if your new idea could rationally live in the extended Catalyst ecosystem independently on CPAN.  Ideas that have demonstrated worth over time as stand alone modules are more likely to be considered for core inclusion.  Additionally, ideas that are best achieved in core rather than as standalone, are more likely considered for core inclusion than those ideas which could just as well be stand alone.  For example, the PSGI integration project happened because it was clear that building Catalyst on top of PSGI standards would lead to a better overall version than keeping it stand alone.
 
-You should propose your new idea in a github issue, on IRC and ideally on the mailing list so that other people can comment on your idea and its merits prior to you writing code.  If you write code before proposing the idea you stand a high chance of being frustrated when you idea is not accepted.
+You should propose your new idea in a L<github issue|https://github.com/perl-catalyst/catalyst-runtime/issues>, on IRC and ideally on the mailing list so that other people can comment on your idea and its merits prior to you writing code.  If you write code before proposing the idea you stand a high chance of being frustrated when you idea is not accepted.
 
 =head2 AUTHOR
 
index 1366f09..7959a6e 100755 (executable)
@@ -7,6 +7,60 @@ 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.90100
+
+Support for type constraints in Args and CaptureArgs has been improved.  You may
+now inherit from a base controller that declares type constraints and use roles
+that declare type constraints.  See L<Catalyst::RouteMatching> for more.
+
+You may now. also use a full type constraint namespace instead of inporting type
+constraints into your package namespace.
+
+We changed the way the middleware stash works so that it no longer localizes
+the PSGI env hashref.  This was done to fix bugs where people set PSGI ENV hash
+keys and found them to dissappear in certain cases.  It also means that now if
+a sub applications sets stash variables, that stash will now bubble up to the
+parent application.  This may be a breaking change for you since previous
+versions of this code did not allow that.  A workaround is to explicitly delete
+stash keys in your sub application before returning control to the parent
+application.
+
+=head2 VERSION 5.90097
+
+=head3 Defined how $c->uri_for adds a URI fragment.
+
+We now have a specification for creating URIs with fragments (or HTML anchors).
+Previously you could do this as a side effect of how we create URIs but this
+side effect behavior was never documented or tested, and was broken when we
+introduced default UTF-8 encoding.  When creating URIs with fragments please
+follow the new, supported specification:
+
+    $c->uri_for($action_or_path, \@captures_or_args, @args, \$query, \$fragment);
+
+This will be a breaking change for some codebases, we recommend testing if
+you are creating URLs with fragments.
+
+B<NOTE> If you are using the alternative:
+
+    $c->uri_for('/foo/bar#baz')
+
+construction, we do not attempt to encode this and it will make a URL with a
+fragment of 'baz'.
+
+=head2 VERSION 5.90094
+
+=head3 Multipart form POST with character set headers
+
+When we did the UTF8 work, we punted on Form POSTs when the POST envelope was
+multipart and each part had complex headers such as content-types, character
+sets and so forth.  In those cases instead of returning a possibly incorrect
+value, we returned an object describing the part so that you could figure it
+out manually.  This turned out to be a bad workaround as people did not expect
+to find that object.  So we changed this to try much harder to get a correct
+value.  We still return an object if we fail but we try much harder now.  If
+you used to check for the object you might find that code is no longer needed
+(although checking for it should not hurt or break anything either).
+
 =head2 VERSION 5.90091
 
 =head3 'case_sensitive' configuration
index 4682da8..0ed488d 100644 (file)
@@ -9,7 +9,7 @@ use Carp 'croak';
 
 our @EXPORT_OK = qw(stash get_stash);
 
-sub PSGI_KEY () { 'Catalyst.Stash.v1' }
+sub PSGI_KEY () { 'Catalyst.Stash.v2' }
 
 sub get_stash {
   my $env = shift;
@@ -24,6 +24,7 @@ sub stash {
 }
 
 sub _create_stash {
+  my $self = shift;
   my $stash = shift || +{};
   return sub {
     if(@_) {
@@ -40,11 +41,10 @@ sub _create_stash {
 
 sub call {
   my ($self, $env) = @_;
-  my $new_env = +{ %$env };
-  my %stash = %{ ($env->{+PSGI_KEY} || sub {})->() || +{} };
+  $env->{+PSGI_KEY} = $self->_create_stash 
+    unless exists($env->{+PSGI_KEY});
 
-  $new_env->{+PSGI_KEY} = _create_stash( \%stash  );
-  return $self->app->($new_env);
+  return $self->app->($env);
 }
 
 =head1 NAME
@@ -60,11 +60,13 @@ alone distribution
 We store a coderef under the C<PSGI_KEY> which can be dereferenced with
 key values or nothing to access the underlying hashref.
 
-The stash middleware is designed so that you can 'nest' applications that
-use it.  If for example you have a L<Catalyst> application that is called
-by a controller under a parent L<Catalyst> application, the child application
-will inherit the full stash of the parent BUT any new keys added by the child
-will NOT bubble back up to the parent.  However, children of children will.
+Anything placed into the stash will be available in the stash of any 'mounted'
+Catalyst applictions.  A mounted Catalyst application may set the stash and
+'pass back' information to the parent application.  Non Catalyst applications
+may use this middleware to access and set stash values.
+
+Please note I highly recommend having a stronger interface than a stash key
+between applications.
 
 For more information the current test case t/middleware-stash.t is the best
 documentation.
index 523c3f2..1306b94 100644 (file)
@@ -339,32 +339,35 @@ sub prepare_body_parameters {
         my $proto_value = $part_data{$key};
         my ($val, @extra) = (ref($proto_value)||'') eq 'ARRAY' ? @$proto_value : ($proto_value);
 
+        $key = $c->_handle_param_unicode_decoding($key)
+          if ($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding});
+
         if(@extra) {
-          $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($_) } ($val,@extra)];
+          $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($c, $_) } ($val,@extra)];
         } else {
-          $params->{$key} = Catalyst::Request::PartData->build_from_part_data($val);
+          $params->{$key} = Catalyst::Request::PartData->build_from_part_data($c, $val);
         }
       }
     } else {
       $params = $self->_body->param;
-    }
 
-    # If we have an encoding configured (like UTF-8) in general we expect a client
-    # to POST with the encoding we fufilled the request in. Otherwise don't do any
-    # encoding (good change wide chars could be in HTML entity style llike the old
-    # days -JNAP
+      # If we have an encoding configured (like UTF-8) in general we expect a client
+      # to POST with the encoding we fufilled the request in. Otherwise don't do any
+      # encoding (good change wide chars could be in HTML entity style llike the old
+      # days -JNAP
 
-    # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
-    # and do any needed decoding.
+      # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure
+      # and do any needed decoding.
 
-    # This only does something if the encoding is set via the encoding param.  Remember
-    # this is assuming the client is not bad and responds with what you provided.  In
-    # general you can just use utf8 and get away with it.
-    #
-    # I need to see if $c is here since this also doubles as a builder for the object :(
+      # This only does something if the encoding is set via the encoding param.  Remember
+      # this is assuming the client is not bad and responds with what you provided.  In
+      # general you can just use utf8 and get away with it.
+      #
+      # I need to see if $c is here since this also doubles as a builder for the object :(
 
-    if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+      if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
         $params = $c->_handle_unicode_decoding($params);
+      }
     }
 
     my $return = $self->_use_hash_multivalue ?
@@ -570,10 +573,15 @@ be either a scalar or an arrayref containing scalars.
 These are the parameters from the POST part of the request, if any.
 
 B<NOTE> If your POST is multipart, but contains non file upload parts (such
-as an line part with an alternative encoding or content type) we cannot determine
-the correct way to extra a meaningful value from the upload.  In this case any
+as an line part with an alternative encoding or content type) we do our best to
+try and figure out how the value should be presented.  If there's a specified character
+set we will use that to decode rather than the default encoding set by the application.
+However if there are complex headers and we cannot determine
+the correct way to extra a meaningful value from the upload, in this case any
 part like this will be represented as an instance of L<Catalyst::Request::PartData>.
 
+Patches and review of this part of the code welcomed.
+
 =head2 $req->body_params
 
 Shortcut for body_parameters.
index 7089373..d6358f3 100644 (file)
@@ -2,6 +2,7 @@ package Catalyst::Request::PartData;
 
 use Moose;
 use HTTP::Headers;
+use Encode;
 
 has [qw/raw_data name size/] => (is=>'ro', required=>1);
 
@@ -11,7 +12,59 @@ has headers => (
   handles=>[qw/content_type content_encoding content_type_charset/]);
 
 sub build_from_part_data {
-  my ($class, $part_data) = @_;
+  my ($class, $c, $part_data) = @_;
+
+  # If the headers are complex, we need to work harder to figure out what to do
+  if(my $hdrs = $class->part_data_has_complex_headers($part_data)) {
+
+    # Ok so its one of two possibilities.  If I can inspect the headers and
+    # Figure out what to do, the I will return data.  Otherwise I will return
+    # a PartData object and expect you do deal with it.
+    # For now if I can find a charset in the content type I will just decode and
+    # assume I got it right (patches and bug reports welcomed).
+
+    # Any of these headers means I can't decode
+
+    if(
+        $hdrs->content_encoding
+    ) {
+      return $class->new(
+        raw_data => $part_data->{data},
+        name => $part_data->{name},
+        size => $part_data->{size},
+        headers => HTTP::Headers->new(%{ $part_data->{headers} }));
+    }
+
+    my ($ct, $charset) = $hdrs->content_type_charset;
+
+    if($ct) {
+      # Good news, we probably have data we can return.  If there is a charset
+      # then use that to decode otherwise use the default decoding.
+      if($charset) {
+        return  Encode::decode($charset, $part_data->{data})
+      } else {
+        if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+          return $c->_handle_param_unicode_decoding($part_data->{data});
+        } else {
+          return $part_data->{data}
+        }
+      }
+    } else {
+      # I have no idea what to do with this now..
+      return $class->new(
+        raw_data => $part_data->{data},
+        name => $part_data->{name},
+        size => $part_data->{size},
+        headers => HTTP::Headers->new(%{ $part_data->{headers} }));
+    }
+  } else {
+    if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) {
+      return $c->_handle_param_unicode_decoding($part_data->{data});
+    } else {
+      return $part_data->{data}
+    }
+  }
+
   return $part_data->{data} unless $class->part_data_has_complex_headers($part_data);
   return $class->new(
     raw_data => $part_data->{data},
@@ -22,7 +75,16 @@ sub build_from_part_data {
 
 sub part_data_has_complex_headers {
   my ($class, $part_data) = @_;
-  return scalar keys %{$part_data->{headers}} > 1 ? 1:0;
+  my %h = %{$part_data->{headers}};
+  my $hdrs = HTTP::Headers->new(%h);
+
+  # Remove non threatening headers.
+  $hdrs->remove_header('Content-Length', 'Expires', 'Last-Modified', 'Content-Language');
+
+  # If we still have more than one (Content-Disposition) header we need to understand
+  # that and deal with it.
+
+  return $hdrs->header_field_names > 1 ? $hdrs :0;
 }
 
 __PACKAGE__->meta->make_immutable;
index fa15afb..e87ba61 100644 (file)
@@ -482,6 +482,12 @@ http 1.1 webservers support this).
 If there is an encoding set, we encode each line of the response (the default
 encoding is UTF-8).
 
+=head2 $res->unencoded_write( $data )
+
+Works just like ->write but we don't apply any content encoding to C<$data>.  Use
+this if you are already encoding the $data or the data is arriving from an encoded
+storage.
+
 =head2 $res->write_fh
 
 Returns an instance of L<Catalyst::Response::Writer>, which is a lightweight
index 06df601..54dc51d 100644 (file)
@@ -87,10 +87,11 @@ is a simple example:
 
     use Moose;
     use MooseX::MethodAttributes;
+    use MooseX::Types::Moose qw(Int);
 
     extends 'Catalyst::Controller';
 
-    sub find :Path('') Args('Int') {
+    sub find :Path('') Args(Int) {
       my ($self, $c, $int) = @_;
     }
 
@@ -151,6 +152,115 @@ A tutorial on how to make custom type libraries is outside the scope of this doc
 recommend looking at the copious documentation in L<Type::Tiny> or in L<MooseX::Types> if
 you prefer that system.  The author recommends L<Type::Tiny> if you are unsure which to use.
 
+=head3 Type constraint namespace.
+
+By default we assume the namespace which defines the type constraint is in the package
+which contains the action declaring the arg or capture arg.  However if you do not wish
+to import type constraints into you package, you may use a fully qualified namespace for
+your type constraint.  If you do this you must install L<Type::Tiny> which defines the
+code used to lookup and normalize the various types of Type constraint libraries.
+
+Example:
+
+    package MyApp::Example;
+
+    use Moose;
+    use MooseX::MethodAttributes;
+
+    extends 'Catalyst::Controller';
+
+    sub an_int_ns :Local Args(MyApp::Types::Int) {
+      my ($self, $c, $int) = @_;
+      $c->res->body('an_int (withrole)');
+    }
+
+Would basically work the same as:
+
+    package MyApp::Example;
+
+    use Moose;
+    use MooseX::MethodAttributes;
+    use MyApp::Types 'Int';
+
+    extends 'Catalyst::Controller';
+
+    sub an_int_ns :Local Args(Int) {
+      my ($self, $c, $int) = @_;
+      $c->res->body('an_int (withrole)');
+    }
+
+=head3 namespace::autoclean
+
+If you want to use L<namespace::autoclean> in your controllers you must 'except' imported
+type constraints since the code that resolves type constraints in args / capture args
+run after the cleaning.  For example:
+
+    package MyApp::Controller::Autoclean;
+
+    use Moose;
+    use MooseX::MethodAttributes;
+    use namespace::autoclean -except => 'Int';
+    use MyApp::Types qw/Int/;
+
+    extends 'Catalyst::Controller';
+
+    sub an_int :Local Args(Int) {
+      my ($self, $c, $int) = @_;
+      $c->res->body('an_int (autoclean)');
+    }
+
+=head3 Using roles and base controller with type constraints
+
+If your controller is using a base class or a role that has an action with a type constraint
+you should declare your use of the type constraint in that role or base controller in the
+same way as you do in main controllers.  Catalyst will try to find the package with declares
+the type constraint first by looking in any roles and then in superclasses.  It will use the
+first package that defines the type constraint.  For example:
+
+    package MyApp::Role;
+
+    use Moose::Role;
+    use MooseX::MethodAttributes::Role;
+    use MyApp::Types qw/Int/;
+
+    sub an_int :Local Args(Int) {
+      my ($self, $c, $int) = @_;
+      $c->res->body('an_int (withrole)');
+    }
+
+    sub an_int_ns :Local Args(MyApp::Types::Int) {
+      my ($self, $c, $int) = @_;
+      $c->res->body('an_int (withrole)');
+    }
+
+    package MyApp::BaseController;
+
+    use Moose;
+    use MooseX::MethodAttributes;
+    use MyApp::Types qw/Int/;
+
+    extends 'Catalyst::Controller';
+
+    sub from_parent :Local Args(Int) {
+      my ($self, $c, $id) = @_;
+      $c->res->body('from_parent $id');
+    }
+
+    package MyApp::Controller::WithRole;
+
+    use Moose;
+    use MooseX::MethodAttributes;
+
+    extends 'MyApp::BaseController';
+
+    with 'MyApp::Role';
+
+If you have complex controller hierarchy, we
+do not at this time attempt to look for all packages with a match type constraint, but instead
+take the first one found.  In the future we may add code that attempts to insure a sane use
+of subclasses with type constraints but right now there are no clear use cases so report issues
+and interests.
+
 =head3 Match order when more than one Action matches a path.
 
 As previously described, L<Catalyst> will match 'the longest path', which generally means
index 8332312..a9c86d1 100644 (file)
@@ -7,7 +7,7 @@ BEGIN { require 5.008003; }
 
 # Remember to update this in Catalyst as well!
 
-our $VERSION = '5.90093';
+our $VERSION = '5.90101';
 $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases
 
 =head1 NAME
index 0f20099..d8bce96 100644 (file)
@@ -205,7 +205,7 @@ precedence:
 C<do_not_decode_query>
 
 If true, then do not try to character decode any wide characters in your
-request URL query or keywords.  You will need gto handle this manually in your action code
+request URL query or keywords.  You will need to handle this manually in your action code
 (although if you choose this setting, chances are you already do this).
 
 C<default_query_encoding>
@@ -307,10 +307,16 @@ In this case we've created a POST request but each part specifies its own conten
 character set (and setting a content encoding would also be possible).  Generally one
 would not run into this situation in a web browser context but for completeness sake
 Catalyst will notice if a multipart POST contains parts with complex or extended
-header information and in those cases it will not attempt to apply decoding to the
-form values.  Instead the part will be represented as an instance of an object
-L<Catalyst::Request::PartData> which will contain all the header information needed
-for you to perform custom parser of the data.
+header information.  In these cases we will try to inspect the meta data and do the
+right thing (in the above case we'd use SHIFT_JIS to decode, not UTF-8).  However if
+after inspecting the headers we cannot figure out how to decode the data, in those cases it
+will not attempt to apply decoding to the form values.  Instead the part will be represented as
+an instance of an object L<Catalyst::Request::PartData> which will contain all the header 
+information needed for you to perform custom parser of the data.
+
+Ideally we'd fix L<Catalyst> to be smarter about decoding so please submit your cases of
+this so we can add inteligence to the parser and find a way to extract a valid value out
+of it.
 
 =head1 UTF8 Encoding in Body Response
 
@@ -490,7 +496,7 @@ L<http://www.catalystframework.org/calendar/2013/12>, L<http://www.catalystframe
 L<http://www.catalystframework.org/calendar/2013/14>.
 
 The main difference this year is that previously calling ->write_fh would return the actual
-L<Plack> writer object that was supplied by your plack application handler, whereas now we wrap
+L<Plack> writer object that was supplied by your Plack application handler, whereas now we wrap
 that object in a lightweight decorator object that proxies the C<write> and C<close> methods
 and supplies an additional C<write_encoded> method.  C<write_encoded> does the exact same thing
 as C<write> except that it will first encode the string when necessary.  In general if you are
index 0d1a60b..432e3d0 100644 (file)
@@ -2,6 +2,68 @@
 
 Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst
 
+=head1 Upgrading to Catalyst 5.90100
+
+We changed the way the middleware stash works so that it no longer localizes
+the PSGI env hashref.  This was done to fix bugs where people set PSGI ENV hash
+keys and found them to dissappear in certain cases.  It also means that now if
+a sub applications sets stash variables, that stash will now bubble up to the
+parent application.  This may be a breaking change for you since previous
+versions of this code did not allow that.  A workaround is to explicitly delete
+stash keys in your sub application before returning control to the parent
+application.
+
+=head1 Upgrading to Catalyst 5.90097
+
+In older versions of Catalyst one could construct a L<URI> with a fragment (such as
+https://localhost/foo/bar#fragment) by using a '#' in the path or final argument, for
+example:
+
+    $c->uri_for($action, 'foo#fragment');
+
+This behavior was never documented and would break if using the Unicode plugin, or when
+adding a query to the arguments:
+
+    $c->uri_for($action, 'foo#fragment', +{ a=>1, b=>2});
+
+would define a fragment like "#fragment?a=1&b=2".
+
+When we introduced UTF-8 encoding by default in Catalyst 5.9008x this side effect behavior
+was broken since we started encoding the '#' when it was part of the URI path.
+
+In version 5.90095 and 5.90096 we attempted to fix this, but all we managed to do was break
+people with URIs that included '#' as part of the path data, when it was not expected to
+be a fragment delimiter.
+
+In general L<Catalyst> prefers an explicit specification rather than relying on side effects
+or domain specific mini languages.  As a result we are now defining how to set a fragment
+for a URI via ->uri_for:
+
+    $c->uri_for($action_or_path, \@captures_or_args, @args, \$query, \$fragment);
+
+If you are relying on the previous side effect behavior your URLs will now encode the '#'
+delimiter, which is going to be a breaking change for you.  You need to alter your code
+to match the new specification or modify uri_for for your local case.  Patches to solve
+this are very welcomed, as long as they don't break existing test cases.
+
+B<NOTE> If you are using the string form of the first argument:
+
+    $c->uri_for('/foo/bar#baz')
+
+construction, we do not attempt to encode this and it will make a URL with a
+fragment of 'baz'.
+
+
+=head1 Upgrading to Catalyst 5.90095
+
+The method C<last_error> in L</Catalyst> was actually returning the first error.  This has
+been fixed but there is a small chance it could be a breaking issue for you.  If this gives
+you trouble changing to C<shift_errors> is the easiest workaround (although that does
+modify the error stack so if you are relying on that not being changed you should try something
+like @{$c->errors}[-1] instead.  Since this method is relatively new and the cases when the
+error stack actually has more than one error in it, we feel the exposure is very low, but bug
+reports are very welcomed.
+
 =head1 Upgrading to Catalyst 5.90090
 
 L<Catalyst::Utils> has a new method 'inject_component' which works the same as the method of
index 3318192..a541508 100644 (file)
@@ -59,14 +59,23 @@ is(
     'Plus is not encoded'
 );
 
-TODO: {
-    local $TODO = 'broken by 5.7008';
-    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'
-    );
-}
+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'
+);
+
+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 3'
+);
+
+is(
+    Catalyst::uri_for( $context, '/foo#bar/baz', { param1 => 'value1' } )->as_string,
+    'http://127.0.0.1/foo/foo?param1=value1#bar/baz',
+    'URI for path with fragment and query params 3'
+);
 
 # test with utf-8
 is(
index 2a005b7..c1e3733 100644 (file)
@@ -43,6 +43,23 @@ BEGIN {
 }
 
 {
+  package MyApp::Role::Controller;
+  $INC{'MyApp/Role/Controller.pm'} = __FILE__;
+
+  use Moose::Role;
+  use MooseX::MethodAttributes::Role;
+  use MyApp::Types qw/Int Str/;
+
+  sub role_str :Path('role_test') Args(Str) {
+    my ($self, $c, $arg) = @_;
+    $c->res->body('role_str'.$arg);
+  }
+
+  sub role_int :Path('role_test') Args(Int) {
+    my ($self, $c, $arg) = @_;
+    $c->res->body('role_int'.$arg);
+  }
+
   package MyApp::Model::User;
   $INC{'MyApp/Model/User.pm'} = __FILE__;
 
@@ -70,6 +87,8 @@ BEGIN {
   use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User Heart/;
 
   extends 'Catalyst::Controller';
+  with 'MyApp::Role::Controller';
+
 
   sub user :Local Args(UserId) {
     my ($self, $c, $int) = @_;
@@ -179,6 +198,67 @@ BEGIN {
 
   MyApp::Controller::Root->config(namespace=>'');
 
+  package MyApp::Controller::Autoclean;
+  $INC{'MyApp/Controller/Autoclean.pm'} = __FILE__;
+
+  use Moose;
+  use MooseX::MethodAttributes;
+  use namespace::autoclean -except => 'Int';
+
+  use MyApp::Types qw/Int/;
+
+  extends 'Catalyst::Controller';
+
+  sub an_int :Local Args(Int) {
+    my ($self, $c, $int) = @_;
+    $c->res->body('an_int (autoclean)');
+  }
+
+  MyApp::Controller::Autoclean->config(namespace=>'autoclean');
+
+  package MyApp::Role;
+  $INC{'MyApp/Role.pm'} = __FILE__;
+
+  use Moose::Role;
+  use MooseX::MethodAttributes::Role;
+  use MyApp::Types qw/Int/;
+
+  sub an_int :Local Args(Int) {
+    my ($self, $c, $int) = @_;
+    $c->res->body('an_int (withrole)');
+  }
+
+  sub an_int_ns :Local Args(MyApp::Types::Int) {
+    my ($self, $c, $int) = @_;
+    $c->res->body('an_int (withrole)');
+  }
+
+  package MyApp::BaseController;
+  $INC{'MyApp/BaseController.pm'} = __FILE__;
+
+  use Moose;
+  use MooseX::MethodAttributes;
+  use MyApp::Types qw/Int/;
+
+  extends 'Catalyst::Controller';
+
+  sub from_parent :Local Args(Int) {
+    my ($self, $c, $id) = @_;
+    $c->res->body("from_parent $id");
+  }
+
+  package MyApp::Controller::WithRole;
+  $INC{'MyApp/Controller/WithRole.pm'} = __FILE__;
+
+  use Moose;
+  use MooseX::MethodAttributes;
+
+  extends 'MyApp::BaseController';
+
+  with 'MyApp::Role';
+
+  MyApp::Controller::WithRole->config(namespace=>'withrole');
+
   package MyApp;
   use Catalyst;
 
@@ -476,4 +556,41 @@ SKIP: {
 
 }
 
+# Test Roles
+
+{
+    my $res = request '/role_test/1';
+    is $res->content, 'role_int1';
+}
+
+{
+    my $res = request '/role_test/a';
+    is $res->content, 'role_stra';
+}
+
+
+{
+  my $res = request '/autoclean/an_int/1';
+  is $res->content, 'an_int (autoclean)';
+}
+
+{
+  my $res = request '/withrole/an_int_ns/S';
+  is $res->content, 'default';
+}
+
+{
+  my $res = request '/withrole/an_int_ns/111';
+  is $res->content, 'an_int (withrole)';
+}
+
+{
+  my $res = request '/withrole/an_int/1';
+  is $res->content, 'an_int (withrole)';
+}
+
+{
+  my $res = request '/withrole/from_parent/1';
+  is $res->content, 'from_parent 1';
+}
 done_testing;
index 447794a..3b7f616 100644 (file)
@@ -40,12 +40,14 @@ use Plack::Util;
     $c->res->body('manual_write');
   }
 
+  $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry...
+
   package MyApp;
   use Catalyst;
 
 }
 
-$INC{'MyApp/Controller/Root.pm'} = '1'; # sorry...
+
 
 ok(MyApp->setup);
 ok(my $psgi = MyApp->psgi_app);
index baeb108..dc22ab6 100644 (file)
@@ -3,6 +3,28 @@ use strict;
 
 {
 
+  package MyMiddleware;
+  $INC{'MyMiddleware'} = __FILE__;
+
+  our $INNER_VAR_EXPOSED;
+
+  use base 'Plack::Middleware';
+
+  sub call {
+    my ($self, $env) = @_;
+
+    my $res = $self->app->($env);
+
+    return $self->response_cb($res, sub{
+      my $inner = shift;
+
+      $INNER_VAR_EXPOSED = $env->{inner_var_from_catalyst};
+
+      return;
+    });
+
+  }
+
   package MyAppChild::Controller::User;
   $INC{'MyAppChild/Controller/User.pm'} = __FILE__;
 
@@ -14,6 +36,8 @@ use strict;
     $c->stash->{inner} = "inner";
     $c->res->body( "inner: ${\$c->stash->{inner}}, outer: ${\$c->stash->{outer}}");
 
+    $c->req->env->{inner_var_from_catalyst} = 'station';
+
     is_deeply [sort {$a cmp $b} keys(%{$c->stash})], ['inner','outer'], 'both keys in stash';
   }
 
@@ -34,11 +58,12 @@ use strict;
     $c->stash->{outer} = "outer";
     $c->res->from_psgi_response( MyAppChild->to_app->($c->req->env) );
 
-    is_deeply [keys(%{$c->stash})], ['outer'], 'only one key in stash';
+    is_deeply [sort keys(%{$c->stash})], ['inner','outer'];
   }
 
   package MyAppParent;
   use Catalyst;
+  MyAppParent->config(psgi_middleware=>['+MyMiddleware']);
   MyAppParent->setup;
 
 }
@@ -48,5 +73,6 @@ use Catalyst::Test 'MyAppParent';
 
 my $res = request '/user/stash';
 is $res->content, 'inner: inner, outer: outer', 'got expected response';
+is $MyMiddleware::INNER_VAR_EXPOSED, 'station', 'env does not get trampled';
 
 done_testing;
index 37c5c6b..8335b1f 100644 (file)
@@ -9,7 +9,7 @@ use FindBin qw($Bin);
 use lib "$Bin/lib";
 
 BEGIN {
-if ( !eval { require Test::WWW::Mechanize::Catalyst } || ! Test::WWW::Mechanize::Catalyst->VERSION('0.51') ) {
+if ( !eval { require Test::WWW::Mechanize::Catalyst; Test::WWW::Mechanize::Catalyst->VERSION('0.51')} ) {
     plan skip_all => 'Need Test::WWW::Mechanize::Catalyst for this test';
 }
 }
index 87d9061..901ae84 100644 (file)
@@ -8,9 +8,9 @@ use FindBin qw($Bin);
 use lib "$Bin/lib";
 
 BEGIN {
-if ( !eval { require Test::WWW::Mechanize::Catalyst } || ! Test::WWW::Mechanize::Catalyst->VERSION('0.51') ) {
+  if ( !eval { require Test::WWW::Mechanize::Catalyst; Test::WWW::Mechanize::Catalyst->VERSION('0.51') } ) {
     plan skip_all => 'Need Test::WWW::Mechanize::Catalyst for this test';
-}
+  }
 }
 
 # make sure testapp works
index ff61a6b..5f12ecb 100644 (file)
@@ -33,7 +33,7 @@ use Scalar::Util ();
   sub uri_for :Path('uri_for') {
     my ($self, $c) = @_;
     $c->response->content_type('text/html');
-    $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'})}");
+    $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'})}");
   }
 
   sub heart_with_arg :Path('a♥') Args(1)  {
@@ -121,6 +121,7 @@ use Scalar::Util ();
 
   sub file_upload :POST  Consumes(Multipart) Local {
     my ($self, $c) = @_;
+
     Test::More::is $c->req->body_parameters->{'♥'}, '♥♥';
     Test::More::ok my $upload = $c->req->uploads->{file};
     Test::More::is $upload->charset, 'UTF-8';
@@ -317,12 +318,12 @@ use Catalyst::Test 'MyApp';
 
 {
   my ($res, $c) = ctx_request "/root/uri_for";
-  my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'});
+  my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'});
 
   is $res->code, 200, 'OK';
   is decode_utf8($res->content), "$url", 'correct body'; #should do nothing
   is $res->content, "$url", 'correct body';
-  is $res->content_length, 90, 'correct length';
+  is $res->content_length, 104, 'correct length';
   is $res->content_charset, 'UTF-8';
 
   {
@@ -481,17 +482,10 @@ SKIP: {
 
   is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value';
   is $c->req->body_parameters->{'♥'}, '♥♥';
-
-  ok Scalar::Util::blessed($c->req->body_parameters->{'arg1'});
-  ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[0]);
-  ok Scalar::Util::blessed($c->req->body_parameters->{'arg2'}[1]);
-  ok Scalar::Util::blessed($c->req->body_parameters->{'♥♥♥'});
-
-  # Since the form post is COMPLEX you are expected to decode it yourself.
-  is Encode::decode('UTF-8', $c->req->body_parameters->{'arg1'}->raw_data), $utf8, 'decoded utf8 param';
-  is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[0]->raw_data), $shiftjs, 'decoded shiftjis param';
-  is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'arg2'}[1]->raw_data), $shiftjs, 'decoded shiftjis param';
-  is Encode::decode('SHIFT_JIS', $c->req->body_parameters->{'♥♥♥'}->raw_data), $shiftjs, 'decoded shiftjis param';
+  is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param';
+  is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param';
+  is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param';
+  is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param';
 
 }