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';
our $DETACH = Catalyst::Exception::Detach->new;
our $GO = Catalyst::Exception::Go->new;
-#I imagine that very few of these really
+#I imagine that very few of these really
#need to be class variables. if any.
#maybe we should just make them attributes with a default?
__PACKAGE__->mk_classdata($_)
}
my @middleware = map {
- ref $_ eq 'CODE' ?
- "Inline Coderef" :
- (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
+ ref $_ eq 'CODE' ?
+ "Inline Coderef" :
+ (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '')
|| '') } $class->registered_middlewares;
if (@middleware) {
# to do this early since encodable_response is false for this condition and we need
# to match the debug output for backcompat (there's a test for this...) -JNAP
if(
- $res->content_type_charset and $c->encoding and
+ $res->content_type_charset and $c->encoding and
(uc($c->encoding->mime_name) ne uc($res->content_type_charset))
) {
my $ct = lc($res->content_type_charset);
$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
- # is false when the set charset is not the same as the encoding mimetype (maybe
+ # is false when the set charset is not the same as the encoding mimetype (maybe
# confusing action at a distance here..
# Don't try to set the charset if one already exists or if headers are already finalized
$c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name)
The namespace part 'TraitFor::Request' was chosen to assist in backwards
compatibility with L<CatalystX::RoleApplicator> which previously provided
these features in a stand alone package.
-
+
=head2 $app->composed_request_class
This is the request class which has been composed with any request_class_traits.
$class->components->{ $component } = $class->setup_component($component);
}
- return $instance;
+ return $instance;
}
=head2 $app->config_for( $component_name )
return;
}
-## This exists just to supply a prebuild psgi app for mod_perl and for the
+## This exists just to supply a prebuild psgi app for mod_perl and for the
## build in server support (back compat support for pre psgi port behavior).
## This is so that we don't build a new psgi app for each request when using
## the mod_perl handler or the built in servers (http and fcgi, etc).
}
## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the
-## home directory and load that and return it (just assume it is doing the
+## home directory and load that and return it (just assume it is doing the
## right thing :) ). If that does not exist, call $app->psgi_app, wrap that
## in default_middleware and return it ( this is for backward compatibility
## with pre psgi port behavior ).
my ($fh, $req) = @_;
require JSON::MaybeXS;
my $slurped;
- return eval {
+ return eval {
local $/;
$slurped = $fh->getline;
JSON::MaybeXS::decode_json($slurped); # decode_json does utf8 decoding for us
(very uncommon) we cannot reliably convert that into field => value pairs. So
instead we create an instance of L<Catalyst::Request::PartData>. If this causes
issue for you, you can disable this by setting C<skip_complex_post_part_handling>
-to true (default is false).
+to true (default is false).
=item *
suggest these should be UTF-* encoded, which is the default that L<Catalyst>
will use, however 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
-in Catalyst version 5.90080+ break some of your query code, you may disable
+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<default_query_encoding>
that parses that content type into something Perl can readily access.
package MyApp::Web;
-
+
use Catalyst;
use JSON::MaybeXS;
-
+
__PACKAGE__->config(
data_handlers => {
'application/json' => sub { local $/; decode_json $_->getline },
},
## Any other configuration.
);
-
+
__PACKAGE__->setup;
By default L<Catalyst> comes with a generic JSON data handler similar to the
with details to follow:
package MyApp::Web;
-
+
use Catalyst;
use Plack::Middleware::StackTrace;
-
+
my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
-
+
__PACKAGE__->config(
'psgi_middleware', [
'Debug',
},
],
);
-
+
__PACKAGE__->setup;
So the general form is:
some cases the order of middleware is important.
The two approaches are not exclusive.
-
+
=over 4
-
+
=item Middleware Object
-
+
An already initialized object that conforms to the L<Plack::Middleware>
specification:
-
+
my $stacktrace_middleware = Plack::Middleware::StackTrace->new;
-
+
__PACKAGE__->config(
'psgi_middleware', [
$stacktrace_middleware,
]);
-
-
+
+
=item coderef
-
+
A coderef that is an inlined middleware:
-
+
__PACKAGE__->config(
'psgi_middleware', [
sub {
},
},
]);
-
-
-
+
+
+
=item a scalar
-
+
We assume the scalar refers to a namespace after normalizing it using the
following rules:
'+MyApp::Custom', ## MyApp::Custom->wrap
],
);
-
+
=item a scalar followed by a hashref
-
+
Just like the previous, except the following C<HashRef> is used as arguments
to initialize the middleware object.
-
+
__PACKAGE__->config(
'psgi_middleware', [
'Session' => {store => 'File'},
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) {
} else {
return;
}
- }
+ }
}
}
-
+
my $classes = join(',', $self->class, @roles, @supers);
die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes";
}
Args => $self->normalized_arg_number,
CaptureArgs => $self->number_of_captures,
}
-}
+}
__PACKAGE__->meta->make_immutable;
around 'list_extra_info' => sub {
my ($orig, $self, @args) = @_;
return {
- %{ $self->$orig(@args) },
+ %{ $self->$orig(@args) },
CONSUMES => $self->allowed_content_types,
};
};
sub is_json : Chained('start') Consumes('application/json') { ... }
sub is_urlencoded : Chained('start') Consumes('application/x-www-form-urlencoded') { ... }
sub is_multipart : Chained('start') Consumes('multipart/form-data') { ... }
-
+
## Alternatively, for common types...
sub is_json : Chained('start') Consume(JSON) { ... }
sub is_multipart : Chained('start') Consumes(Multipart) { ... }
## Or allow more than one type
-
+
sub is_more_than_one
: Chained('start')
: Consumes('application/x-www-form-urlencoded')
: Consumes('multipart/form-data')
{
- ## ...
+ ## ...
}
1;
=head1 DESCRIPTION
This is an action role that lets your L<Catalyst::Action> match on the content
-type of the incoming request.
+type of the incoming request.
Generally when there's a PUT or POST request, there's a request content body
with a matching MIME content type. Commonly this will be one of the types
around 'list_extra_info' => sub {
my ($orig, $self, @args) = @_;
return {
- %{ $self->$orig(@args) },
+ %{ $self->$orig(@args) },
HTTP_METHODS => [sort $self->allowed_http_methods],
};
};
sub _build_query_constraints {
my $self = shift;
my ($constraint_proto, @extra) = $self->_query_attr;
-
+
die "Action ${\$self->private_path} defines more than one 'Query' attribute" if scalar @extra;
return +{} unless defined($constraint_proto);
$constraint_proto =~s/^(.+),\.\.\.$/$1/; # slurpy is handled elsewhere
-
+
# Query may be a Hash like Query(p=>Int,q=>Str) OR it may be a Ref like
# Query(Tuple[p=>Int, slurpy HashRef]). The only way to figure is to eval it
# and look at what we have.
around 'list_extra_info' => sub {
my ($orig, $self, @args) = @_;
return {
- %{ $self->$orig(@args) },
+ %{ $self->$orig(@args) },
};
};
# We FORCE the auto action user to explicitly return
# true. We need to do this since there's some auto
# users (Catalyst::Authentication::Credential::HTTP) that
- # actually do a detach instead.
+ # actually do a detach instead.
$c->state(0);
$auto->dispatch( $c );
return 0 unless $c->state;
=head2 Regexp
B<Status: Deprecated.> Use Chained methods or other techniques.
-If you really depend on this, install the standalone
+If you really depend on this, install the standalone
L<Catalyst::DispatchType::Regex> distribution.
A global way to match a give regular expression in the incoming request path.
=head2 LocalRegexp
B<Status: Deprecated.> Use Chained methods or other techniques.
-If you really depend on this, install the standalone
+If you really depend on this, install the standalone
L<Catalyst::DispatchType::Regex> distribution.
Like L</Regex> but scoped under the namespace of the containing controller
-=head2 Chained
+=head2 Chained
=head2 ChainedParent
with a fixed number. You may use reference types such as Tuple from L<Types::Standard>
that allows you to fix the number of allowed args. For example Args(Tuple[Int,Int])
would be determined to be two args (or really the same as Args(Int,Int).) You may
-find this useful for creating custom subtypes with complex matching rules that you
+find this useful for creating custom subtypes with complex matching rules that you
wish to reuse over many actions.
See L<Catalyst::RouteMatching> for more.
Please note that this feature does not let you actually assign new functions
to actions via subroutine attributes, but is really more for creating useful
-aliases to existing core and extended attributes, and transforms based on
+aliases to existing core and extended attributes, and transforms based on
existing information (like from configuration). Code for actually doing
something meaningful with the subroutine attributes will be located in the
L<Catalyst::Action> classes (or your subclasses), L<Catalyst::Dispatcher> and
Middleware when such exists and is correct to do so. For example we now use
L<Plack::Middleware::ContentLength> to determine content length of a response
when none is provided. This replaces similar code inlined with L<Catalyst>
-The main advantages to doing this is 1) more similar Catalyst core that is
+The main advantages to doing this is 1) more similar Catalyst core that is
focused on the Catalyst special sauce, 2) Middleware is more broadly shared
so we benefit from better collaboration with developers outside Catalyst, 3)
In the future you'll be able to change or trim the middleware stack to get
such an object and fallback to the previous behavior (where L<Catalyst::Engine>
itself unrolls the filehandle and performs blocking streams). However
this backwards compatibility will be removed in an upcoming release so you should either
-rewrite your custom filehandle objects to support getline or start using the
+rewrite your custom filehandle objects to support getline or start using the
middleware that adapts read for getline L<Plack::Middleware::AdaptFilehandleRead>.
=head3 Response->headers become read-only after finalizing
=head3 Restarter
The development server restarter has been improved to be compatible with
-immutable Moose classes, and also to optionally use
+immutable Moose classes, and also to optionally use
L<B::Hooks::OP::Check::StashChange> to handle more complex application layouts
correctly.
=item *
-New print method which prints @data to the output stream, separated by $,.
-This lets you pass the response object to functions that want to write to an
+New print method which prints @data to the output stream, separated by $,.
+This lets you pass the response object to functions that want to write to an
L<IO::Handle>.
=item *
=item *
-Many reusable extensions which would previously have been plugins or base
+Many reusable extensions which would previously have been plugins or base
classes are better implemented as Moose roles.
=item *
=item *
-Fix a bug in uri_for which could cause it to generate paths with multiple
+Fix a bug in uri_for which could cause it to generate paths with multiple
slashes in them.
=item *
!$best_action ||
@parts < @{$best_action->{parts}} ||
(
- !@parts &&
- defined($args_attr) &&
+ !@parts &&
+ defined($args_attr) &&
(
$args_count eq "0" &&
(
- ($c->config->{use_chained_args_0_special_case}||0) ||
+ ($c->config->{use_chained_args_0_special_case}||0) ||
(
exists($best_action->{args_count}) && defined($best_action->{args_count}) ?
($best_action->{args_count} ne 0) : 1
my $display_path = "/$path/$parts";
$display_path =~ s{/{1,}}{/}g;
- $display_path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # deconvert urlencoded for pretty view
+ $display_path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # deconvert urlencoded for pretty view
$display_path = decode_utf8 $display_path; # URI does encoding
$paths->row( $display_path, "/$action" );
}
if($res->_has_response_cb) {
## we have not called the response callback yet, so we are safe to send
## the whole body to PSGI
-
+
my @headers;
$res->headers->scan(sub { push @headers, @_ });
# In the past, Catalyst only looked for ->read not ->getline. It is very possible
# that one might have an object that respected read but did not have getline.
# As a result, we need to handle this case for backcompat.
-
+
# We will just do the old loop for now. In a future version of Catalyst this support
- # will be removed and one will have to rewrite their custom object or use
+ # will be removed and one will have to rewrite their custom object or use
# Plack::Middleware::AdaptFilehandleRead. In anycase support for this is officially
# deprecated and described as such as of 5.90060
-
+
my $got;
do {
$got = read $body, my ($buffer), $CHUNKSIZE;
} else {
# Looks like for backcompat reasons we need to be able to deal
# with stringyfiable objects.
- $body = ["$body"];
+ $body = ["$body"];
}
} elsif(ref $body) {
if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) {
## for backcompat we still need to handle a ->body. I guess I could see
## someone calling ->write to presend some stuff, and then doing the rest
## via ->body, like in a template.
-
+
## We'll just use the old, existing code for this (or most of it)
if(my $body = $res->body) {
close $body;
}
else {
-
+
# Case where body was set after calling ->write. We'd prefer not to
# support this, but I can see some use cases with the way most of the
# views work. Since body has already been encoded, we need to do
$c->res->content_type('text/html; charset=utf-8');
my $name = ref($c)->config->{name} || join(' ', split('::', ref $c));
-
+
# Prevent Catalyst::Plugin::Unicode::Encoding from running.
# This is a little nasty, but it's the best way to be clean whether or
# not the user has an encoding plugin.
=head2 autoflush
-When enabled (default), messages are written to the log immediately instead
-of queued until the end of the request.
+When enabled (default), messages are written to the log immediately instead
+of queued until the end of the request.
-This option, as well as C<abort>, is provided for modules such as
-L<Catalyst::Plugin::Static::Simple> to be able to programmatically
+This option, as well as C<abort>, is provided for modules such as
+L<Catalyst::Plugin::Static::Simple> to be able to programmatically
suppress the output of log messages. By turning off C<autoflush> (application-wide
-setting) and then setting the C<abort> flag within a given request, all log
+setting) and then setting the C<abort> flag within a given request, all log
messages for the given request will be suppressed. C<abort> can still be set
-independently of turning off C<autoflush>, however. It just means any messages
-sent to the log up until that point in the request will obviously still be emitted,
+independently of turning off C<autoflush>, however. It just means any messages
+sent to the log up until that point in the request will obviously still be emitted,
since C<autoflush> means they are written in real-time.
-If you need to turn off autoflush you should do it like this (in your main app
+If you need to turn off autoflush you should do it like this (in your main app
class):
after setup_finalize => sub {
sub call {
my ($self, $env) = @_;
- $env->{+PSGI_KEY} = $self->_create_stash
+ $env->{+PSGI_KEY} = $self->_create_stash
unless exists($env->{+PSGI_KEY});
return $self->app->($env);
}
has _use_hash_multivalue => (
- is=>'ro',
- required=>1,
+ is=>'ro',
+ required=>1,
default=> sub {0});
# Amount of data to read from input on each pass
my ( $self ) = @_;
# If previously applied middleware created the HTTP::Body object, then we
- # just use that one.
+ # just use that one.
if(my $plack_body = $self->_has_env ? $self->env->{'plack.request.http.body'} : undef) {
$self->_body($plack_body);
# Ok if we get this far, we have to read psgi.input into the new body
# object. Lets play nice with any plack app or other downstream, so
# we create a buffer unless one exists.
-
+
my $stream_buffer;
if ($self->env->{'psgix.input.buffered'}) {
# Be paranoid about previous psgi middleware or apps that read the
# If anything in @_ is undef, carp about that, and remove it from
# the list;
-
+
my @params = grep { defined($_) ? 1 : do {carp "You called ->params with an undefined value"; 0} } @_;
if ( @params == 1 ) {
=head2 $self->env
-Access to the raw PSGI env.
+Access to the raw PSGI env.
=head2 meta
=head1 SYNOPSIS
- my $data_part =
+ my $data_part =
To specify where Catalyst should put the temporary files, set the 'uploadtmp'
option in the Catalyst config. If unset, Catalyst will use the system temp dir.
has _response_cb => (
is => 'ro',
- isa => 'CodeRef',
+ isa => 'CodeRef',
writer => '_set_response_cb',
clearer => '_clear_response_cb',
predicate => '_has_response_cb',
} else {
return $self->write_fh;
}
- });
+ });
} else {
die "You can't set a Catalyst response from that, expect a valid PSGI response";
}
$c->response->body('Catalyst rocks!');
Sets or returns the output (text or binary data). If you are returning a large body,
-you might want to use a L<IO::Handle> type of object (Something that implements the getline method
+you might want to use a L<IO::Handle> type of object (Something that implements the getline method
in the same fashion), or a filehandle GLOB. These will be passed down to the PSGI
handler you are using and might be optimized using server specific abilities (for
example L<Twiggy> will attempt to server a real local file in a non blocking manner).
already set in the response headers Catalyst will make a reasonable attempt
to determine the size of the Handle. Depending on the implementation of your
handle object, setting the content length may fail. If it is at all possible
-for you to determine the content length of your handle object,
+for you to determine the content length of your handle object,
it is recommended that you set the content length in the response headers
yourself, which will be respected and sent by Catalyst in the response.
and the HEAD section of your document and then set the body from a template
driven from a database. In some cases this can seem to the client as if you had
a faster overall response (but note that unless your server support chunked
-body your content is likely to get queued anyway (L<Starman> and most other
+body your content is likely to get queued anyway (L<Starman> and most other
http 1.1 webservers support this).
If there is an encoding set, we encode each line of the response (the default
=head2 encodable_response
-Given a L<Catalyst::Response> return true if its one that can be encoded.
+Given a L<Catalyst::Response> return true if its one that can be encoded.
make sure there is an encoding set on the response
make sure the content type is encodable
=head2 write_encoded
-If the application defines a response encoding (default is UTF8) and the
+If the application defines a response encoding (default is UTF8) and the
content type is a type that needs to be encoded (text types like HTML or XML and
Javascript) we first encode the line you want to write. This is probably the
thing you want to always do. If you use the L<\write> method directly you will
use Moose;
use MooseX::MethodAttributes;
use Types::Standard qw/StrMatch Int/;
-
+
extends 'Catalyst::Controller';
sub looks_like_a_date :Path('') Args(StrMatch[qr{\d\d-\d\d-\d\d}]) {
well as Args. For Example:
use Types::Standard qw/Int Tuple/;
-
+
sub chain_base :Chained(/) CaptureArgs(1) { }
sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { }
sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { }
sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { }
-
+
sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
sub any_priority_link :Chained(link_int) PathPart('') Args(1) { }
The same rules that we find in URL paths also cover URL query parts. That is
if one types a URL like this into the browser
- http://localhost/example?♥=♥♥
+ http://localhost/example?♥=♥♥
When this goes 'over the wire' to your application server its going to be as
percent encoded bytes:
- http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5
+ http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5
When L<Catalyst> encounters this we decode the percent encoding and the utf8
so that we can properly display this information (such as in the debugging
logs or in a response.)
- [debug] Query Parameters are:
- .-------------------------------------+--------------------------------------.
- | Parameter | Value |
- +-------------------------------------+--------------------------------------+
- | ♥ | ♥♥ |
- '-------------------------------------+--------------------------------------'
+ [debug] Query Parameters are:
+ .-------------------------------------+--------------------------------------.
+ | Parameter | Value |
+ +-------------------------------------+--------------------------------------+
+ | ♥ | ♥♥ |
+ '-------------------------------------+--------------------------------------'
All the values and keys that are part of $c->req->query_parameters will be
utf8 decoded. So you should not need to do anything special to take those
Just like with arguments and captures, you can use utf8 literals (or utf8
strings) in $c->uri_for:
- use utf8;
- my $url = $c->uri_for( $c->controller('Root')->action_for('example'), {'♥' => '♥♥'});
+ use utf8;
+ my $url = $c->uri_for( $c->controller('Root')->action_for('example'), {'♥' => '♥♥'});
When you stringify this object (for use in a template, for example) it will automatically
do the right thing regarding utf8 encoding and url encoding.
- http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5
+ http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5
Since again what you want is a properly url encoded version of this. Ultimately what you want
to send over the wire via HTTP needs to be bytes (not unicode characters).
running Catalyst in developer debug, then you will see the correct unicode characters in
the debug output. For example if you generate a POST request:
- use Catalyst::Test 'MyApp';
- use utf8;
+ use Catalyst::Test 'MyApp';
+ use utf8;
- my $res = request POST "/example/posted", ['♥'=>'♥', '♥♥'=>'♥'];
+ my $res = request POST "/example/posted", ['♥'=>'♥', '♥♥'=>'♥'];
Running in CATALYST_DEBUG=1 mode you should see output like this:
And if you had a controller like this:
- package MyApp::Controller::Example;
+ package MyApp::Controller::Example;
- use base 'Catalyst::Controller';
+ use base 'Catalyst::Controller';
- sub posted :POST Local {
- my ($self, $c) = @_;
- $c->res->content_type('text/plain');
- $c->res->body("hearts => ${\$c->req->post_parameters->{♥}}");
- }
+ sub posted :POST Local {
+ my ($self, $c) = @_;
+ $c->res->content_type('text/plain');
+ $c->res->body("hearts => ${\$c->req->post_parameters->{♥}}");
+ }
The following test case would be true:
- use Encode 2.21 'decode_utf8';
- is decode_utf8($req->content), 'hearts => ♥';
+ use Encode 2.21 'decode_utf8';
+ is decode_utf8($req->content), 'hearts => ♥';
In this case we decode so that we can print and compare strings with multibyte characters.
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
+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
=head2 Summary
- use utf8;
- use warnings;
- use strict;
+ use utf8;
+ use warnings;
+ use strict;
- package MyApp::Controller::Root;
+ package MyApp::Controller::Root;
- use base 'Catalyst::Controller';
- use File::Spec;
+ use base 'Catalyst::Controller';
+ use File::Spec;
- sub scalar_body :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
- $c->response->body("<p>This is scalar_body action ♥</p>");
- }
+ sub scalar_body :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is scalar_body action ♥</p>");
+ }
- sub stream_write :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
- $c->response->write("<p>This is stream_write action ♥</p>");
- }
+ sub stream_write :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->write("<p>This is stream_write action ♥</p>");
+ }
- sub stream_write_fh :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
+ sub stream_write_fh :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
- my $writer = $c->res->write_fh;
- $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
- $writer->close;
- }
+ my $writer = $c->res->write_fh;
+ $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
+ $writer->close;
+ }
- sub stream_body_fh :Local {
- my ($self, $c) = @_;
- my $path = File::Spec->catfile('t', 'utf8.txt');
- open(my $fh, '<', $path) || die "trouble: $!";
- $c->response->content_type('text/html');
- $c->response->body($fh);
- }
+ sub stream_body_fh :Local {
+ my ($self, $c) = @_;
+ my $path = File::Spec->catfile('t', 'utf8.txt');
+ open(my $fh, '<', $path) || die "trouble: $!";
+ $c->response->content_type('text/html');
+ $c->response->body($fh);
+ }
=head2 Discussion
and currently most common is to set the L<Catalyst::Response> ->body with a scalar string (
as in the example):
- use utf8;
+ use utf8;
- sub scalar_body :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
- $c->response->body("<p>This is scalar_body action ♥</p>");
- }
+ sub scalar_body :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->body("<p>This is scalar_body action ♥</p>");
+ }
In general you should need to do nothing else since L<Catalyst> will automatically encode
this string during body finalization. The only matter to watch out for is to make sure
encoding and set the correct character set in the response:
sub override_encoding :Local {
- my ($self, $c) = @_;
- $c->res->content_type('text/plain');
- $c->encoding(Encode::find_encoding('Shift_JIS'));
- $c->response->body("テスト");
+ my ($self, $c) = @_;
+ $c->res->content_type('text/plain');
+ $c->encoding(Encode::find_encoding('Shift_JIS'));
+ $c->response->body("テスト");
}
This will use the alternative encoding for a single response.
The first streaming method is to use the C<write> method on the response object. This method
allows 'inlined' streaming and is generally used with blocking style servers.
- sub stream_write :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
- $c->response->write("<p>This is stream_write action ♥</p>");
- }
+ sub stream_write :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
+ $c->response->write("<p>This is stream_write action ♥</p>");
+ }
You may call the C<write> method as often as you need to finish streaming all your content.
L<Catalyst> will encode each line in turn as long as the content-type meets the 'encodable types'
The second way to stream a response is to get the response writer object and invoke methods
on that directly:
- sub stream_write_fh :Local {
- my ($self, $c) = @_;
- $c->response->content_type('text/html');
+ sub stream_write_fh :Local {
+ my ($self, $c) = @_;
+ $c->response->content_type('text/html');
- my $writer = $c->res->write_fh;
- $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
- $writer->close;
- }
+ my $writer = $c->res->write_fh;
+ $writer->write_encoded('<p>This is stream_write_fh action ♥</p>');
+ $writer->close;
+ }
This can be used just like the C<write> method, but typically you request this object when
you want to do a nonblocking style response since the writer object can be closed over or
like object. In this case the object is passed down to the Plack application handler directly
and currently we do nothing to set encoding.
- sub stream_body_fh :Local {
- my ($self, $c) = @_;
- my $path = File::Spec->catfile('t', 'utf8.txt');
- open(my $fh, '<', $path) || die "trouble: $!";
- $c->response->content_type('text/html');
- $c->response->body($fh);
- }
+ sub stream_body_fh :Local {
+ my ($self, $c) = @_;
+ my $path = File::Spec->catfile('t', 'utf8.txt');
+ open(my $fh, '<', $path) || die "trouble: $!";
+ $c->response->content_type('text/html');
+ $c->response->body($fh);
+ }
In this example we create a filehandle to a text file that contains UTF8 encoded characters. We
pass this down without modification, which I think is correct since we don't want to double
use utf8;
sub gzipped :Local {
- my ($self, $c) = @_;
+ my ($self, $c) = @_;
- $c->res->content_type('text/plain');
- $c->res->content_type_charset('UTF-8');
- $c->res->content_encoding('gzip');
+ $c->res->content_type('text/plain');
+ $c->res->content_type_charset('UTF-8');
+ $c->res->content_encoding('gzip');
- $c->response->body(
- Compress::Zlib::memGzip(
- Encode::encode_utf8("manual_1 ♥")));
+ $c->response->body(
+ Compress::Zlib::memGzip(
+ Encode::encode_utf8("manual_1 ♥")));
}
You may encounter issues with your legacy code running under default UTF8 body encoding. If
so you can disable this with the following configurations setting:
- MyApp->config(encoding=>undef);
+ MyApp->config(encoding=>undef);
Where C<MyApp> is your L<Catalyst> subclass.
=head1 Author
-John Napiorkowski L<jjnapiork@cpan.org|email:jjnapiork@cpan.org>
+John Napiorkowski L<jjnapiork@cpan.org|mailto:jjnapiork@cpan.org>
=cut
Also we added a new develop console mode only warning when you call a component
with arguments that don't expect or do anything meaningful with those args. Its
-possible if you are logging debug mode in production (please don't...) this
+possible if you are logging debug mode in production (please don't...) this
could add verbosity to those logs if you also happen to be calling for components
and passing pointless arguments. We added this warning to help people not make this
error and to better understand the component resolution flow.
suggest these should be UTF-* encoded, which is the default that L<Catalyst>
will use, however 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
-in Catalyst version 5.90080+ break some of your query code, you may disable
+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<default_query_encoding> and
croak "Unable to build component package for \"$component_package\": $@";
Moose::Util::apply_all_roles($component_package, @{$given{traits}}) if $given{traits};
(my $file = "$component_package.pm") =~ s{::}{/}g;
- $INC{$file} ||= 1;
+ $INC{$file} ||= 1;
}
my $_setup_component = sub {
package MyApp;
use Catalyst;
-
+
MyApp->setup;
}
plan skip_all => 'This test does not run live'
if $ENV{CATALYST_SERVER};
-{
+{
# Test for https://rt.cpan.org/Ticket/Display.html?id=53678
# Catalyst::Test::get currently returns the raw octets, but it
# would be more useful if it decoded the content based on the
{
my $expected = undef;
- ok( my $response = request('http://localhost/chained/foo/1/end'),
+ ok( my $response = request('http://localhost/chained/foo/1/end'),
'chained + local endpoint; missing last argument' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
my $expected = join( ", ", @expected );
- ok( my $response = request('http://localhost/chained/foo2/10/20/end2/15/25'),
+ ok( my $response = request('http://localhost/chained/foo2/10/20/end2/15/25'),
'chained + local (2 args each)' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
}
#
- # This is for testing if the arguments got passed to the actions
+ # This is for testing if the arguments got passed to the actions
# correctly.
#
{
# With args given, run "all"
ok( $response = request('http://localhost/argsorder/X'),
'Correct arg order ran' );
- is( $response->header('X-Catalyst-Executed'),
- join(", ",
+ is( $response->header('X-Catalyst-Executed'),
+ join(", ",
qw[
TestApp::Controller::Action::Chained->begin
TestApp::Controller::Action::Chained::ArgsOrder->base
])
);
is( $response->content, 'base; ; all; X', 'Content OK' );
-
+
}
#
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
}
-
+
#
# */search
# doc/*
- #
+ #
# request for doc/search should end up in doc/*
{
my @expected = qw[
) or fail("EXCEPTION $@ DESERIALIZING " . $response->content);
is_deeply( $creq->{arguments}, $expected, 'Arguments ok' );
}
-
-
+
+
# Test that /foo and /foo/ both do the same thing
{
my @expected = qw[
TestApp::Controller::Action->default
TestApp::Controller::Root->end
];
-
+
my $expected = join( ", ", @expected );
-
+
ok( my $response = request('http://localhost/action'), 'Request' );
is( $response->header('X-Catalyst-Executed'),
- $expected,
+ $expected,
'Executed actions for /action'
);
-
+
ok( $response = request('http://localhost/action/'), 'Request' );
is( $response->header('X-Catalyst-Executed'),
- $expected,
+ $expected,
'Executed actions for /action/'
);
- }
+ }
}
}
SKIP:
- {
+ {
if ( $ENV{CATALYST_SERVER} ) {
skip "tests for %2F on remote server", 6;
}
-
+
ok(
my $response =
request('http://localhost/action/local/one/foo%2Fbar'),
} else {
$path = uri_escape($test);
}
-
+
SKIP:
- {
+ {
# Skip %2F, ., [, (, and ) tests on real webservers
# Both Apache and lighttpd don't seem to like these
if ( $ENV{CATALYST_SERVER} && $path =~ /(?:%2F|\.|%5B|\(|\))/ ) {
if( $test =~ m{/} ) {
$test =~ s{/}{}g;
- $path = uri_escape( $test );
+ $path = uri_escape( $test );
}
ok( $response = request("http://localhost/chained/multi_cap/$path/baz"), "Requested capture for path $path");
use warnings;
use Test::More;
use HTTP::Request::Common qw/GET POST DELETE PUT/;
-
+
use FindBin;
use lib "$FindBin::Bin/../lib";
is(request(GET '/httpmethods/foo')->content, 'get');
is(request(POST '/httpmethods/foo')->content, 'post');
is(request(DELETE '/httpmethods/foo')->content, 'default');
-
+
is(request(GET '/httpmethods/bar')->content, 'get or post');
is(request(POST '/httpmethods/bar')->content, 'get or post');
is(request(DELETE '/httpmethods/bar')->content, 'default');
-
+
is(request(GET '/httpmethods/baz')->content, 'any');
is(request(POST '/httpmethods/baz')->content, 'any');
is(request(DELETE '/httpmethods/baz')->content, 'any');
}
{
- my $response = request('http://localhost/moose/methodmodifiers/get_attribute');
+ my $response = request('http://localhost/moose/methodmodifiers/get_attribute');
ok($response->is_success);
is($response->content, '42', 'parent controller method called');
is($response->header('X-Catalyst-Test-After'), 'after called', 'after works as expected');
}
isa_ok( $creq, 'Catalyst::Request' );
-
+
is( $creq->header('Authorization'), 'Basic dGVzdDoxMjM0NQ==', 'auth header ok' );
}
'Content-Type' => 'application/x-www-form-urlencoded',
'Content' => 'foo=bar&baz=quux'
);
-
+
my $expected = { foo => 'bar', baz => 'quux', wibble => 'wobble' };
ok( my $response = request($request), 'Request' );
# Test reading chunks of the request body using $c->read
{
my $creq;
-
+
my $request = POST(
'http://localhost/body/read',
'Content-Type' => 'text/plain',
'Content' => 'x' x 105_000
);
-
+
my $expected = '10000|10000|10000|10000|10000|10000|10000|10000|10000|10000|5000';
ok( my $response = request($request), 'Request' );
/;
BEGIN {
- $EXPECTED_ENV_VAR = "CATALYSTTEST$$"; # has to be uppercase otherwise fails on Win32
+ $EXPECTED_ENV_VAR = "CATALYSTTEST$$"; # has to be uppercase otherwise fails on Win32
$EXPECTED_ENV_VAL = "Test env value " . rand(100000);
}
{
my $creq;
- my $request = GET( 'http://localhost/dump/request',
+ my $request = GET( 'http://localhost/dump/request',
'User-Agent' => 'MyAgen/1.0',
'X-Whats-Cool' => 'Catalyst',
'X-Multiple' => [ 1 .. 5 ],
'X-Forwarded-For' => '192.168.1.1, 1.2.3.4',
'X-Forwarded-Port' => 443
);
-
+
ok( my $response = request($request), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
ok( $creq->secure, 'Forwarded port sets secure' );
isa_ok( $creq->headers, 'HTTP::Headers', 'Catalyst::Request->headers' );
is( $creq->header('X-Whats-Cool'), $request->header('X-Whats-Cool'), 'Catalyst::Request->header X-Whats-Cool' );
-
+
{ # Test that multiple headers are joined as per RFC 2616 4.2 and RFC 3875 4.1.18
my $excpected = '1, 2, 3, 4, 5';
if ( $ENV{CATALYST_SERVER} && $ENV{CATALYST_SERVER} !~ /127.0.0.1|localhost/ ) {
skip "Using remote server", 2;
}
-
+
is( $creq->base->host, 'frontend.server.com', 'Catalyst::Request proxied base' );
is( $creq->address, '1.2.3.4', 'Catalyst::Request proxied address' );
}
# raw query string support
{
my $creq;
-
+
my $body_parameters = {
a => 1,
blank => '',
'Content' => $body_parameters,
'Content-Type' => 'application/x-www-form-urlencoded'
);
-
+
ok( my $response = request($request), 'Request' );
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
is( $creq->uri->query, 'query+string', 'Catalyst::Request POST query_string' );
is_deeply( $creq->query_parameters, $query_parameters, 'Catalyst::Request query_parameters' );
is_deeply( $creq->body_parameters, $body_parameters, 'Catalyst::Request body_parameters' );
is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
-
+
ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' );
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
is( $creq->uri->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->content_type, 'text/plain', 'Response Content-Type' );
is( $response->content, ( $request->parts )[0]->content, 'Content' );
-
+
# XXX: no way to test that temporary file for this test was deleted
}
'Unserialize Catalyst::Request'
);
}
-
+
for my $file ( $creq->upload ) {
my $upload = $creq->upload($file);
SKIP:
is( $upload->size, length( $part->content ), 'Upload Content-Length' );
is( $upload->filename, 'catalyst_130pix.gif', 'Upload Filename' );
is( $upload->basename, 'catalyst_130pix.gif', 'Upload basename' );
-
+
SKIP:
{
if ( $ENV{CATALYST_SERVER} ) {
# JNAP, I added the following line in order to properly let
# the $env go out of scope so that the associated tempfile
# would be deleted. I think somewhere Catalyst::Test closed
- # over ENV and holds state until a new command is issues but
+ # over ENV and holds state until a new command is issues but
# I can't find it.
request GET 'http://localhost/';
if ( $ENV{CATALYST_SERVER} ) {
skip 'Not testing uploadtmp on remote server', 14;
}
-
+
my $creq;
my $dir = "$FindBin::Bin/";
if ( $ENV{CATALYST_SERVER} ) {
skip 'Using remote server', 5;
}
-
+
local $ENV{HTTPS} = 'on';
ok( my $response = request('https://localhost/engine/request/uri'), 'HTTPS Request' );
ok( $response->is_success, 'Response Successful 2xx' );
a => [ qw/1 2/ ],
b => 3,
};
-
+
ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
if ( $ENV{CATALYST_SERVER} ) {
skip 'Using remote server', 2;
}
-
+
require TestApp::RequestBaseBug;
TestApp->request_class('TestApp::RequestBaseBug');
ok( my $response = request('http://localhost/engine/request/uri'), 'Request' );
ok( my $response = request('http://localhost/engine/response/large/' . $action ),
'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
-
+
is( length( $response->content ), length( $expected->{$action} ), 'Length OK' );
}
ok( my $response = request('http://localhost/engine/response/print/' . $action ),
'Request' );
ok( $response->is_success, "Response $action successful 2xx" );
-
+
is( $response->content, $expected->{$action}, "Content $action OK" );
}
my $data = shift @tests;
# Run tests for path with trailing slash and without
- SKIP: for my $req_uri
- (
+ SKIP: for my $req_uri
+ (
join( '' => $uri_base, $data->{ path } ), # Without trailing path
join( '' => $uri_base, $data->{ path }, '/' ), # With trailing path
) {
my $end_slash = ( $req_uri =~ qr(/$) ? 1 : 0 );
- # use slash_expect argument if URI ends with slash
+ # use slash_expect argument if URI ends with slash
# and the slash_expect argument is defined
my $expect = $data->{ expect } || '';
if ( $end_slash and exists $data->{ slash_expect } ) {
# JNAP: I'm going to todo these tests, calling uri_for as a class method
# should work, but its not really useful so I think theres not much harm
# if someone needs this for a business case they are welcome to figure out
-# what is going
+# what is going
TODO: {
local $TODO = "Need to fix using uri_for and uri_for_action as a class method";
-
+
# this works, using $ctx
is($context->uri_for($context->controller('Action::Chained')->action_for('endpoint')),
'uri_for_action correct for chained with multiple capturing actions and args combined' );
my $action_needs_two = '/action/chained/endpoint2';
-
+
ok( ! defined( $context->uri_for_action($action_needs_two, [1], (2,3)) ),
'uri_for_action returns undef for not enough captures' );
-
+
is( $context->uri_for_action($action_needs_two, [1,2], (2,3)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/2/3',
'uri_for_action returns correct uri for correct captures' );
ok( ! defined( $context->uri_for_action($action_needs_two, [1,2,3], (2,3)) ),
'uri_for_action returns undef for too many captures' );
-
+
is( $context->uri_for_action($action_needs_two, [1,2], (3)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3',
'uri_for_action returns uri with lesser args than specified on action' );
use strict;
use warnings;
-
+
use Type::Utils -all;
use Types::Standard -types;
use Type::Library
-base,
-declare => qw( UserId Heart User ContextLike );
- extends "Types::Standard";
+ extends "Types::Standard";
class_type User, { class => "MyApp::Model::User::user" };
duck_type ContextLike, [qw/model/];
sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') }
sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') }
-
+
sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { }
sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') }
use Test::More;
use HTTP::Request::Common;
-# In DEBUG mode, we get not a number warnigs
+# In DEBUG mode, we get not a number warnigs
my $error;
$c->response->body("This is the body");
}
- sub infinity :Chained(root) PathPart('test') Args {
+ sub infinity :Chained(root) PathPart('test') Args {
my ($self, $c) = @_;
$c->response->body("This is the body");
Test::More::is $c->action->comparable_arg_number, ~0;
sub d { 'd' }
}
-
+
{
package TestApp;
$INC{'TestApp.pm'} = __FILE__;
-
+
use Catalyst;
__PACKAGE__->request_class_traits([qw/TestRole Foo Bar/]);
__PACKAGE__->setup;
}
-
-
+
+
foreach my $class_prefix (qw/request response stats/) {
my $method = 'composed_' .$class_prefix. '_class';
ok(
}
-
+
{
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(
# one CGI test will fail if you don't have mod_rewrite enabled
RewriteEngine on
RewriteRule /cgi$ /cgi/ [PT]
-
+
# Pass-through Authorization header for CGI/FastCGI
RewriteCond %{HTTP:Authorization} ^(.+)
RewriteRule ^(.*)$ $1 [E=HTTP_AUTHORIZATION:%1,PT]
use Moose::Role;
sub role { 'role' }
-
+
package Local::Model::Foo;
use Moose;
sub user :Local Args(1) {
my ($self, $c, $int) = @_;
-
+
Test::More::ok(my $user = $c->model("User")->find($int));
Test::More::is($c->model("User")->zoo->a, 2);
Test::More::is($c->model("Foo")->role, 'role');
Test::More::is($c->model("One")->a, 'one');
Test::More::is($c->model("Two")->a, 'two');
-
+
$c->res->body("name: $user->{name}, age: $user->{age}");
}
ok( my $response = request('http://localhost/foo'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
-is( $DeprecatedActionsInAppClassTestApp::Log::warnings, 1, 'Get the appclass action warning' );
\ No newline at end of file
+is( $DeprecatedActionsInAppClassTestApp::Log::warnings, 1, 'Get the appclass action warning' );
$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');
my $res = $cb->(HEAD "/root/test");
is $res->code, 200, 'OK';
is $res->content, '', 'correct body';
- is $res->content_length, 16, 'correct length';
+ is $res->content_length, 16, 'correct length';
};
done_testing;
use Catalyst;
use HTTP::Headers::ActionPack;
-
+
my $cn = HTTP::Headers::ActionPack->new
->get_content_negotiator;
-
+
sub Catalyst::Response::format
{
my $self = shift;
my %formats = @_;
my @formats = keys %formats;
-
+
my $accept = $self->_context->req->header('Accept') ||
$format{default} ||
$_[0];
-
+
$self->headers->header('Vary' => 'Accept');
$self->headers->header('Accepts' => (join ',', @formats));
-
+
if(my $which = $cn->choose_media_type(\@formats, $accept)) {
$self->content_type($which);
if(my $possible_body = $formats{$which}->($self)) {
}
} else {
$self->status(406);
- $self->body("Method Not Acceptable");
+ $self->body("Method Not Acceptable");
}
}
use strict;
-use warnings;
+use warnings;
use Test::More;
use FindBin;
use lib "$FindBin::Bin/lib";
{
package TestCatalyst;
$INC{'TestCatalyst.pm'} = __FILE__;
-
+
use Moose;
use Catalyst;
use Catalyst::Utils;
-
+
after 'setup_components' => sub {
my $self = shift;
Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::Banana' );
Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Test::Apple', as => 'Apple' );
Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Test::Apple', as => 'Apple2', traits => ['RoleTest1', 'RoleTest2'] );
};
-
- TestCatalyst->config( 'home' => '.' );
+
+ TestCatalyst->config( 'home' => '.' );
TestCatalyst->setup;
}
-
+
use Catalyst::Test qw/TestCatalyst/;
-
+
ok( TestCatalyst->controller( $_ ) ) for qw/ Apple Test::Apple /;
ok( TestCatalyst->model( $_ ) ) for qw/ Banana Cherry /;
is( TestCatalyst->controller('Apple2')->aaa, 'aaa');
my ( $class, $action ) = @_;
if ( Scalar::Util::blessed($action)
- and $action->name ne "foobar" ) {
- eval { $c->detach( 'foobar', [$action, 'foo'] ) };
+ and $action->name ne "foobar" ) {
+ eval { $c->detach( 'foobar', [$action, 'foo'] ) };
}
$c->next::method( @_ );
# stuff, as C::A::Plugin::Credential::Password is added to the plugin
# list, and that uses base C::A::C::P class, does the mk_accessors.
-# If a class data method called _config hasn't been created in
+# If a class data method called _config hasn't been created in
# MyApp ($app below), then our call to ->config gets our accessor
# (rather than the class data one), and we fail..
}
# However, if we are too enthusiastic about adding accessors to the
-# MyApp package, then this method isn't called (as there is a local
+# MyApp package, then this method isn't called (as there is a local
# symbol already).
-# Note - use a different package here, so that Moose's
+# Note - use a different package here, so that Moose's
# package detection code doesn't get confused..
$CDICompatTestPlugin::Data::HAS_RUN_SETUP_FINISHED = 0;
if ( $_[0] =~ /^(Unknown resource|No default action defined)/ ) {
$c->response->status(404);
}
-
+
if ( $_[0] =~ /^Couldn\'t forward/ ) {
$c->response->status(404);
- }
+ }
if ( $_[0] =~ /^Caught exception/ ) {
$c->response->status(500);
$c->response->header( 'X-Catalyst-Engine' => $c->engine );
$c->response->header( 'X-Catalyst-Debug' => $c->debug ? 1 : 0 );
-
+
{
my $components = join( ', ', sort keys %{ $c->components } );
$c->response->header( 'X-Catalyst-Components' => $components );
use strict;
use Catalyst qw/
Test::MangleDollarUnderScore
- Test::Errors
- Test::Headers
+ Test::Errors
+ Test::Headers
Test::Plugin
Test::Inline
+TestApp::Plugin::FullyQualified
our $VERSION = '0.01';
-TestApp->config(
- name => 'TestApp',
- root => '/some/dir',
- use_request_uri_for_path => 1,
+TestApp->config(
+ name => 'TestApp',
+ root => '/some/dir',
+ use_request_uri_for_path => 1,
'Controller::Action::Action' => {
action_args => {
action_action_nine => { another_extra_arg => 13 }
# useful info if something crashes during a test
sub finalize_error {
my $c = shift;
-
+
$c->next::method(@_);
-
+
$c->res->status(500);
$c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) );
}
return $c->maybe::next::method(@_);
}
-# Make sure we can load Inline plugins.
+# Make sure we can load Inline plugins.
package Catalyst::Plugin::Test::Inline;
use Moose;
}
}
-1;
\ No newline at end of file
+1;
sub mult_nopp2_view : Chained('mult_nopp2_load') PathPart('') Args(0) { }
#
-# Test Choice between branches and early return logic
+# Test Choice between branches and early return logic
# Declaration order is important for $children->{$*}, since this is first match best.
#
-sub cc_base : Chained('/') PathPart('chained/choose_capture') CaptureArgs(0) { }
-sub cc_link : Chained('cc_base') PathPart('') CaptureArgs(0) { }
-sub cc_anchor : Chained('cc_link') PathPart('anchor.html') Args(0) { }
-sub cc_all : Chained('cc_base') PathPart('') Args() { }
+sub cc_base : Chained('/') PathPart('chained/choose_capture') CaptureArgs(0) { }
+sub cc_link : Chained('cc_base') PathPart('') CaptureArgs(0) { }
+sub cc_anchor : Chained('cc_link') PathPart('anchor.html') Args(0) { }
+sub cc_all : Chained('cc_base') PathPart('') Args() { }
-sub cc_a : Chained('cc_base') PathPart('') CaptureArgs(1) { }
-sub cc_a_link : Chained('cc_a') PathPart('a') CaptureArgs(0) { }
-sub cc_a_anchor : Chained('cc_a_link') PathPart('') Args() { }
+sub cc_a : Chained('cc_base') PathPart('') CaptureArgs(1) { }
+sub cc_a_link : Chained('cc_a') PathPart('a') CaptureArgs(0) { }
+sub cc_a_anchor : Chained('cc_a_link') PathPart('') Args() { }
-sub cc_b : Chained('cc_base') PathPart('b') CaptureArgs(0) { }
-sub cc_b_link : Chained('cc_b') PathPart('') CaptureArgs(1) { }
-sub cc_b_anchor : Chained('cc_b_link') PathPart('anchor.html') Args() { }
+sub cc_b : Chained('cc_base') PathPart('b') CaptureArgs(0) { }
+sub cc_b_link : Chained('cc_b') PathPart('') CaptureArgs(1) { }
+sub cc_b_anchor : Chained('cc_b_link') PathPart('anchor.html') Args() { }
#
# Test static paths vs. captures
# /captureargs/*/edit
# /captureargs/test/*
# It will output the arguments they got passed to @_ after the
-# context object.
+# context object.
# /captureargs/one/edit should not dispatch to /captureargs/*/*
# /captureargs/test/one should not dispatch to /captureargs/*/*
sub default : Private {
my ( $self, $c ) = @_;
-
+
$c->forward('TestApp::View::Dump::Request');
}
sub change_path : Local {
my ( $self, $c ) = @_;
-
+
# change the path
$c->req->path( '/my/app/lives/here' );
-
+
$c->forward('TestApp::View::Dump::Request');
}
sub change_base : Local {
my ( $self, $c ) = @_;
-
+
# change the base and uri paths
$c->req->base->path( '/new/location' );
$c->req->uri->path( '/new/location/engine/request/uri/change_base' );
-
+
$c->forward('TestApp::View::Dump::Request');
}
# change the current uri
my $uri = $c->req->uri_with( { b => 1, c => undef } );
my %query = $uri->query_form;
-
+
$c->res->header( 'X-Catalyst-Param-a' => $query{ a } );
$c->res->header( 'X-Catalyst-Param-b' => $query{ b } );
$c->res->header( 'X-Catalyst-Param-c' => exists($query{ c }) ? $query{ c } : '--notexists--' );
$c->res->header( 'X-Catalyst-query' => $uri->query);
-
+
$c->forward('TestApp::View::Dump::Request');
}
my $uri = $c->req->uri_with( { a => $c->req->base } );
my %query = $uri->query_form;
-
+
$c->res->header( 'X-Catalyst-Param-a' => $query{ a } );
-
+
$c->forward('TestApp::View::Dump::Request');
}
# change the current uri
my $uri = $c->req->uri_with( { unicode => "\x{2620}" } );
-
+
$c->res->header( 'X-Catalyst-uri-with' => "$uri" );
-
+
$c->forward('TestApp::View::Dump::Request');
}
# change the current uri
my $uri = $c->req->uri_with( { foo => undef } );
-
+
$c->res->header( 'X-Catalyst-warnings' => $warnings );
-
+
$c->forward('TestApp::View::Dump::Request');
}
my ( $self, $c ) = @_;
my $uri = $c->req->uri_with( { a => undef } );
-
+
$c->res->header( 'X-Catalyst-uri-with' => "$uri" );
$c->forward('TestApp::View::Dump::Request');
}
my ( $self, $c ) = @_;
my $uri = $c->req->uri_with( { a => 1, b => undef } );
-
+
my %query = $uri->query_form;
$c->res->header( 'X-Catalyst-uri-with' => "$uri" );
$c->res->header( 'X-Catalyst-Param-a' => $query{ a } );
sub one : Relative {
my ( $self, $c ) = @_;
- $c->res->output( 'x' x (100 * 1024) );
+ $c->res->output( 'x' x (100 * 1024) );
}
sub two : Relative {
sub one :Relative {
my ( $self, $c ) = @_;
-
+
$c->res->print("foo");
}
-# Fork.pm
+# Fork.pm
# Copyright (c) 2006 Jonathan Rockway <jrockway@cpan.org>
package TestApp::Controller::Fork;
my ($self, $c, $ls) = @_;
my ($result, $code) = (undef, 1);
- if(!-e $ls || !-x _){
+ if(!-e $ls || !-x _){
$result = 'skip';
}
else {
$result = system($ls, $ls, $ls);
$result = $! if $result != 0;
}
-
+
$c->response->body(encode_json({result => $result}));
}
sub backticks : Local {
my ($self, $c, $ls) = @_;
my ($result, $code) = (undef, 1);
-
- if(!-e $ls || !-x _){
+
+ if(!-e $ls || !-x _){
$result = 'skip';
$code = 0;
}
$result = `$ls $ls $ls` || $!;
$code = $?;
}
-
+
$c->response->body(encode_json({result => $result, code => $code}));
}
my ($self, $c) = @_;
my $pid;
my $x = 0;
-
+
if($pid = fork()){
$x = "ok";
}
}
waitpid $pid,0 or die;
-
+
$c->response->body(encode_json({pid => $pid, result => $x}));
}
use Moose;
use MooseX::MethodAttributes;
-
+
extends 'Catalyst::Controller';
-
+
sub default : Path Args {
my ($self, $ctx) = @_;
$ctx->response->body('default');
}
-
+
sub get : Path('foo') Method('GET') {
my ($self, $ctx) = @_;
$ctx->response->body('get');
}
-
+
sub post : Path('foo') Method('POST') {
my ($self, $ctx) = @_;
$ctx->response->body('post');
}
-
+
sub get_or_post : Path('bar') Method('GET') Method('POST') {
my ($self, $ctx) = @_;
$ctx->response->body('get or post');
}
-
+
sub any_method : Path('baz') {
my ($self, $ctx) = @_;
$ctx->response->body('any');
sub get2 :Chained('get_or_put') PathPart('') Args(0) GET {
pop->res->body('get2');
}
-
+
sub put2 :Chained('get_or_put') PathPart('') Args(0) PUT {
pop->res->body('put2');
}
sub post2 :Chained('post_or_delete') PathPart('') Args(0) POST {
pop->res->body('post2');
}
-
+
sub delete2 :Chained('post_or_delete') PathPart('') Args(0) DELETE {
pop->res->body('delete2');
}
extends 'TestApp::Model';
# Note - don't call ->config in here until the constructor calls it to
-# retrieve config, so that we get the 'copy from parent' path,
+# retrieve config, so that we get the 'copy from parent' path,
# and ergo break due to the closure if dclone is used there..
__PACKAGE__->meta->make_immutable;
before 'setup_finalize' => sub { $SETUP_FINALIZE++ };
-before 'setup_dispatcher' => sub { $SETUP_DISPATCHER++ };
+before 'setup_dispatcher' => sub { $SETUP_DISPATCHER++ };
1;
use base 'Catalyst::Controller';
# your actions replace this one
-sub main :Path('') {
+sub main :Path('') {
$_[1]->res->body('<h1>It works</h1>');
$_[1]->res->content_type('text/html');
}
use strict;
use Catalyst qw/
- Test::Errors
- Test::Headers
+ Test::Errors
+ Test::Headers
/;
use Catalyst::Utils;
our $VERSION = '0.01';
TestAppChainedAbsolutePathPart
- ->config(
+ ->config(
name => 'TestAppChainedAbsolutePathPart',
root => '/some/dir'
);
use strict;
use Catalyst qw/
- Test::Errors
- Test::Headers
+ Test::Errors
+ Test::Headers
/;
use Catalyst::Utils;
my ($self, $c) = @_;
$c->res->content_type('image/gif');
$c->res->body(do {
- open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!;
- binmode($fh);
+ open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!;
+ binmode($fh);
local $/ = undef; <$fh>;
});
}
sub utf8_non_ascii_content : Local {
use utf8;
my ($self, $c) = @_;
-
+
my $str = 'ʇsʎlɐʇɐɔ'; # 'catalyst' flipped at http://www.revfad.com/flip.html
ok utf8::is_utf8($str), '$str is in UTF8 internally';
use strict;
use Catalyst qw/
- Test::Errors
- Test::Headers
+ Test::Errors
+ Test::Headers
/;
use Catalyst::Utils;
sub read : Local {
my ( $self, $c ) = @_;
-
+
# read some data
my @chunks;
-
+
while ( my $data = $c->read( 10_000 ) ) {
push @chunks, $data;
}
$c->res->content_type( 'text/plain');
-
+
$c->res->body( join ( '|', map { length $_ } @chunks ) );
}
use base 'Catalyst::Controller';
-sub main :Path('') {
+sub main :Path('') {
my ($self, $ctx, $charset) = @_;
my $content_type = 'text/html';
if ($ctx->stash->{charset}) {
sub is_json : Chained('start') PathPart('') Consumes('application/json') Args(0) { pop->res->body('is_json1') }
sub is_urlencoded : Chained('start') PathPart('') Consumes('application/x-www-form-urlencoded') Args(0) { pop->res->body('is_urlencoded1') }
sub is_multipart : Chained('start') PathPart('') Consumes('multipart/form-data') Args(0) { pop->res->body('is_multipart1') }
-
+
sub under :Chained('start') CaptureArgs(0) { }
sub is_json_under : Chained('under') PathPart('') Consumes(JSON) Args(0) { pop->res->body('is_json2') }
sub is_multipart_under : Chained('under') PathPart('') Consumes(Multipart) Args(0) { pop->res->body('is_multipart2') }
## Or allow more than one type
-
+
sub multi :Chained('start') PathPart('') CaptureArgs(0) { }
-
+
sub is_more_than_one_1
- : Chained('multi')
+ : Chained('multi')
: Consumes('application/x-www-form-urlencoded')
: Consumes('multipart/form-data')
: Args(0)
}
sub is_more_than_one_2
- : Chained('multi')
+ : Chained('multi')
: Consumes('HTMLForm')
: Args(0)
{
}
sub is_more_than_one_3
- : Chained('multi')
+ : Chained('multi')
: Consumes('application/x-www-form-urlencoded,multipart/form-data')
: Args(0)
{
sub is_json : Chained('start') PathPart('') Consumes('application/json') Args(0) { pop->res->body('is_json') }
sub is_urlencoded : Chained('start') PathPart('') Consumes('application/x-www-form-urlencoded') Args(0) { pop->res->body('is_urlencoded') }
sub is_multipart : Chained('start') PathPart('') Consumes('multipart/form-data') Args(0) { pop->res->body('is_multipart') }
-
+
sub under :Chained('start') CaptureArgs(0) { }
sub is_json_under : Chained('under') PathPart('') Consumes(JSON) Args(0) { pop->res->body('is_json') }
sub is_multipart_under : Chained('under') PathPart('') Consumes(Multipart) Args(0) { pop->res->body('is_multipart') }
## Or allow more than one type
-
+
sub multi :Chained('start') CaptureArgs(0) { }
-
+
sub is_more_than_one_1
: Chained('multi') PathPart('')
: Consumes('application/x-www-form-urlencoded')
}
{
- my $response = request( POST( '/bodyparams', { override => 'this' } ) )->content;
+ my $response = request( POST( '/bodyparams', { override => 'this' } ) )->content;
is($response, 'that', 'body param overridden');
}
{
- my $response = request( POST( '/bodyparams/no_params' ) )->content;
+ my $response = request( POST( '/bodyparams/no_params' ) )->content;
is($response, 'HASH', 'empty body param is hashref');
}
server.port = $port
# Work around inability to hit http://localhost/deep/path
-# without a trailing slash
+# without a trailing slash
url.rewrite = ( "deep/path\$" => "deep/path/" )
# catalyst app specific fcgi setup
)
END
-open(my $lightconf, '>', "$docroot/lighttpd.conf")
+open(my $lightconf, '>', "$docroot/lighttpd.conf")
or die "Can't open $docroot/lighttpd.conf: $!";
print {$lightconf} $conf or die "Write error: $!";
close $lightconf;
-my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |"
+my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |"
or die "Unable to spawn lighttpd: $!";
-
+
# wait for it to start
while ( check_port( 'localhost', $port ) != 1 ) {
diag "Waiting for server to start...";
)
END
-open(my $lightconf, '>', "$docroot/lighttpd.conf")
+open(my $lightconf, '>', "$docroot/lighttpd.conf")
or die "Can't open $docroot/lighttpd.conf: $!";
print {$lightconf} $conf or die "Write error: $!";
close $lightconf;
-my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |"
+my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |"
or die "Unable to spawn lighttpd: $!";
-
+
# wait for it to start
while ( check_port( 'localhost', $port ) != 1 ) {
diag "Waiting for server to start...";
use JSON::MaybeXS qw(decode_json);
our $t = Proc::ProcessTable->new( cache_ttys => 1 );
-our ( $initial, $final ) = ( 0, 0 );
+our ( $initial, $final ) = ( 0, 0 );
my $test_data = do {
open my $fh, '<:raw', "$FindBin::Bin/optional_stress.json" or die "$!";
local $/;
else {
map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests};
plan tests => $total_tests;
-
+
foreach my $test_group ( keys %{$tests} ) {
foreach my $test ( @{ $tests->{$test_group} } ) {
run_test( $test );
sub run_test {
my $uri = shift || die 'No URI given for test';
-
+
print "TESTING $uri\n";
-
+
# make a few requests to set initial memory size
for ( 1 .. 3 ) {
request( $uri );
}
-
+
$initial = size_of($$);
print "Initial Size: $initial\n";
-
+
for ( 1 .. 500 ) {
request( $uri );
}
-
+
$final = size_of($$);
print "Final Size: $final\n";
-
+
if ( $final > $initial ) {
print "Leaked: " . ($final - $initial) . "K\n";
}
-
+
is( $final, $initial, "'$uri' memory is not leaking" );
}
sub size_of {
my $pid = shift;
-
+
foreach my $p ( @{ $t->table } ) {
if ( $p->pid == $pid ) {
return $p->rss;
}
}
-
+
die "Pid $pid not found?";
}
plan skip_all => 'Needs a Perl with ithreads enabled';
}
}
-
+
no warnings 'redefine';
sub request {
- my $thr = threads->new(
+ my $thr = threads->new(
sub { Catalyst::Test::local_request('TestApp',@_) },
- @_
+ @_
);
$thr->join;
}
];
my $expected = join( ", ", @expected );
-
+
ok( my $response = request('http://localhost/action/default'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' );
ok( my $response = request('http://localhost/four'), 'Request' );
ok( $response->is_success, '"Path(\'\')" - Response Successful 2xx' );
is( $response->content, 'OK', '"Path() Args()" - Body okay' );
-}
\ No newline at end of file
+}
$c->res->body("$uri");
}
-
+
sub get_env {
my ($self, $c) = @_;
if($c->req->query_parameters->{path_prefix}) {
# END [/user/local_example_args1/***/]
-# BEGIN [/user/path-example]
+# BEGIN [/user/path-example]
{
my ($res, $c) = ctx_request('/user/path-example');
use strict;
use warnings;
-
+
use Type::Utils -all;
use Types::Standard -types;
use Type::Library
-base,
-declare => qw( UserId Heart );
- extends "Types::Standard";
+ extends "Types::Standard";
declare UserId,
as Int,
}
sub string_types :Local Query(q=>'Str',age=>'Int') { pop->res->body('string_type') }
-
+
sub as_ref :Local Query(Dict[age=>Int,sex=>Enum['f','m','o'], slurpy HashRef[Int]]) { pop->res->body('as_ref') }
sub utf8 :Local Query(utf8=>Heart) { pop->res->body("heart") }
sub big :Chained(chain) PathPart('') Args(0) Query(size=>Int,...) { pop->res->body('big') }
sub small :Chained(chain) PathPart('') Args(0) Query(size=>UserId,...) { pop->res->body('small') }
-
+
sub default :Default {
my ($self, $c, $int) = @_;
$c->res->body('default');
# These tests assume that the decoding that occurs for the query string follows
# the payload decoding algorithm described here:
-# https://www.w3.org/TR/html5/forms.html#url-encoded-form-data
+# https://www.w3.org/TR/html5/forms.html#url-encoded-form-data
{
ok my $req = GET 'root/bar';
TestApp::Controller::Root->config(namespace => '');
}
-
+
{
package TestApp;
$INC{'TestApp.pm'} = __FILE__;
-
+
use Catalyst;
use TestApp::Exception;
__PACKAGE__->setup;
}
-
-
+
+
use Catalyst::Test 'TestApp';
{
is ($res->status_line, "200 OK");
is ($res->content, '<h1>OK</h1>');
}
-
+
{
my $res = request('/%E2%C3%83%C6%92%C3%8');
is ($res->content, 'Bad unicode data');
{
package TestApp;
$INC{'TestApp.pm'} = __FILE__;
-
+
use Catalyst;
sub handle_unicode_encoding_exception {
__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",
undef $@;
eval { Catalyst::Utils::ensure_class_loaded("This::Module::Is::Not::In::Inc::But::Does::Exist") };
-ok( !$@, "no error when loading non existent .pm that *does* have a symbol table entry" );
+ok( !$@, "no error when loading non existent .pm that *does* have a symbol table entry" );
undef $@;
eval { Catalyst::Utils::ensure_class_loaded('Silly::File::.#Name') };
sub my_warnings { $warn[0] };
sub warn { shift; push(@warn, @_) }
-
+
package MyApp::Controller::Root;
$INC{'MyApp/Controller/Root.pm'} = __FILE__;
use Data::Dumper;
use Scalar::Util ();
-# Test cases for incoming utf8
+# Test cases for incoming utf8
{
package MyApp::Controller::Root;
# Test to make sure redirect can now take an object (sorry don't have a better place for it
# but wanted test coverage.
my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) );
- Test::More::ok !ref $location;
+ Test::More::ok !ref $location;
}
sub stream_write :Local {
# Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't
# have application/json as one of the things we match, otherwise we get double
- # encoding.
+ # encoding.
$c->response->body(JSON::MaybeXS::encode_json($post));
}