# This file documents the revision history for Perl extension Catalyst.
- - Use ~ as prefix for plugins or action classes which are located in
- MyApp::Plugin / MyApp::Action (mo)
- - Controller methods without attributes are now considered actions if
- they are specified in config->{action(s)} (mo)
+ Bug fixes:
+ - Revert change to URL encode things passed into $c->uri_for
+ Args and CaptureArgs as this causes breakage to pre-existing
+ applications.
+ - Remove use of Test::MockObject as it doesn't install from CPAN
+ in some environments.
+ - Remove use of dclone to deep copy configs and replace with
+ Catalyst::Utils::merge_hashes which has the same effect, of
+ ensuring child classes don't inherit their parent's config,
+ except works correctly with closures.
+
+ New features:
+ - Use ~ as prefix for plugins or action classes which are located in
+ MyApp::Plugin / MyApp::Action (mo)
+ - Controller methods without attributes are now considered actions if
+ they are specified in config->{action(s)} (mo)
5.80005 2009-06-06 14:40:00
recommends 'B::Hooks::OP::Check::StashChange';
test_requires 'Class::Data::Inheritable';
-test_requires 'Test::MockObject' => '1.07'; # Newish (hah, 2006!) version to
- # hopefully avoid broken distro
- # packages (RT#46104)
test_requires 'Test::Exception';
# aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate is available
# NOTE - This is the version number of the _incompatible_ code,
# not the version number of the fixed version.
my %conflicts = (
+ 'Catalyst::Component::ACCEPT_CONTEXT' => '0.06',
'Catalyst::Plugin::ENV' => '9999', # This plugin is just stupid, full stop
# should have been a core fix.
'Catalyst::Plugin::Unicode::Encoding' => '0.2',
$c->error(0);
}
-# search components given a name and some prefixes
sub _comp_search_prefixes {
+ my $c = shift;
+ return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_);
+}
+
+# search components given a name and some prefixes
+sub _comp_names_search_prefixes {
my ( $c, $name, @prefixes ) = @_;
my $appclass = ref $c || $c;
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
my $query = ref $name ? $name : qr/^$name$/i;
my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
- return map { $c->components->{ $_ } } @result if @result;
+ return @result if @result;
# if we were given a regexp to search against, we're done.
return if ref $name;
# regexp fallback
$query = qr/$name/i;
- @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
+ @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
# no results? try against full names
if( !@result ) {
- @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
+ @result = grep { m{$query} } keys %eligible;
}
# don't warn if we didn't find any results, it just might not exist
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
- my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
+ my @names = map { s{$filter}{}; $_; }
+ $c->_comp_names_search_prefixes( undef, @prefixes );
+
return @names;
}
( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} );
carp "uri_for called with undef argument" if grep { ! defined $_ } @args;
- s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go for @args;
+ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go for @args;
unshift(@args, $path);
$_ = "$_";
utf8::encode( $_ ) if utf8::is_utf8($_);
# using the URI::Escape pattern here so utf8 chars survive
- s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go;
+ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go;
s/ /+/g;
"${key}=$_"; } ( ref $val eq 'ARRAY' ? @$val : $val ));
} @keys);
$plugins ||= [];
my @plugins = Catalyst::Utils::resolve_namespace($class . '::Plugin', 'Catalyst::Plugin', @$plugins);
-
+
for my $plugin ( reverse @plugins ) {
Class::MOP::load_class($plugin);
my $meta = find_meta($plugin);
grep { $_ && blessed($_) && $_->isa('Moose::Meta::Role') }
map { find_meta($_) }
@plugins;
-
+
Moose::Util::apply_all_roles(
$class => @roles
) if @roles;
=head1 LICENSE
-This library is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
my $slot = '$'.$attribute;
my $accessor = sub {
my $pkg = ref $_[0] || $_[0];
- my $meta = Moose::Util::find_meta($pkg)
+ my $meta = Moose::Util::find_meta($pkg)
|| Moose::Meta::Class->initialize( $pkg );
if (@_ > 1) {
$meta->namespace->{$attribute} = \$_[1];
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
use MRO::Compat;
use mro 'c3';
use Scalar::Util 'blessed';
-use Storable 'dclone';
use namespace::clean -except => 'meta';
with 'MooseX::Emulate::Class::Accessor::Fast';
my $class = blessed($self) || $self;
my $meta = Class::MOP::get_metaclass_by_name($class);
unless ($meta->has_package_symbol('$_config')) {
- $self->_config( dclone $config );
+ # Call merge_hashes to ensure we deep copy the parent
+ # config onto the subclass
+ $self->_config( Catalyst::Utils::merge_hashes($config, {}) );
}
}
return $self->_config;
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
use Moose;
extends 'Catalyst::Component';
with 'Catalyst::Component::ApplicationAttribute';
-
+
# Your code here
-
+
1;
=head1 DESCRIPTION
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head2 $self->register( $c, $action )
abstract method, to be implemented by dispatchtypes. Takes a
-context object and a L<Catalyst::Action> object.
+context object and a L<Catalyst::Action> object.
Should return true if it registers something, or false otherwise.
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
# No best action currently
# OR This one matches with fewer parts left than the current best action,
# And therefore is a better match
- # OR No parts and this expects 0
+ # OR No parts and this expects 0
# The current best action might also be Args(0),
# but we couldn't chose between then anyway so we'll take the last seen
if (my $cap = $curr->attributes->{CaptureArgs}) {
return undef unless @captures >= $cap->[0]; # not enough captures
if ($cap->[0]) {
- unshift(@parts,
- map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; }
- splice(@captures, -$cap->[0]));
+ unshift(@parts, splice(@captures, -$cap->[0]));
}
}
if (my $pp = $curr->attributes->{PartPath}) {
=head2 $c->expand_action($action)
-Return a list of actions that represents a chained action. See
+Return a list of actions that represents a chained action. See
L<Catalyst::Dispatcher> for more info. You probably want to
use the expand_action it provides rather than this directly.
'-----------------------+------------------------------'
...
-Here's a more detailed specification of the attributes belonging to
+Here's a more detailed specification of the attributes belonging to
C<:Chained>:
=head2 Attributes
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
sub list {
my ( $self, $c ) = @_;
my $column_width = Catalyst::Utils::term_width() - 35 - 9;
- my $paths = Text::SimpleTable->new(
+ my $paths = Text::SimpleTable->new(
[ 35, 'Path' ], [ $column_width, 'Private' ]
);
foreach my $path ( sort keys %{ $self->_paths } ) {
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
$re =~ s/^\^//;
$re =~ s/\$$//;
my $final = '/';
- my @captures = map { s/([^A-Za-z0-9\-_.!~*'()])/$URI::Escape::escapes{$1}/go; $_; } @$captures;
+ my @captures = @$captures;
while (my ($front, $rest) = split(/\(/, $re, 2)) {
last unless defined $rest;
($rest, $re) =
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 METHODS
-=head2 new
+=head2 new
Construct a new dispatcher.
return $self->_action_hash->{"${namespace}/${name}"};
}
-=head2 $self->get_action_by_path( $path );
+=head2 $self->get_action_by_path( $path );
Returns the named action by its full private path.
Get the DispatchType object of the relevant type, i.e. passing C<$type> of
C<Chained> would return a L<Catalyst::DispatchType::Chained> object (assuming
-of course it's being used.)
+of course it's being used.)
=cut
# See also t/lib/TestApp/Plugin/AddDispatchTypes.pm
# Alias _method_name to method_name, add a before modifier to warn..
-foreach my $public_method_name (qw/
- tree
- dispatch_types
- registered_dispatch_types
- method_action_class
- action_hash
+foreach my $public_method_name (qw/
+ tree
+ dispatch_types
+ registered_dispatch_types
+ method_action_class
+ action_hash
container_hash
/) {
my $private_method_name = '_' . $public_method_name;
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
}
/* from http://users.tkk.fi/~tkarvine/linux/doc/pre-wrap/pre-wrap-css3-mozilla-opera-ie.html */
/* Browser specific (not valid) styles to make preformatted text wrap */
- pre {
+ pre {
white-space: pre-wrap; /* css-3 */
white-space: -moz-pre-wrap; /* Mozilla, since 1999 */
white-space: -pre-wrap; /* Opera 4-6 */
$request->_body->tmpdir( $c->config->{uploadtmp} )
if exists $c->config->{uploadtmp};
}
-
+
while ( my $buffer = $self->read($c) ) {
$c->prepare_body_chunk($buffer);
}
=head2 $self->prepare_body_parameters($c)
-Sets up parameters from body.
+Sets up parameters from body.
=cut
sub prepare_body_parameters {
my ( $self, $c ) = @_;
-
+
return unless $c->request->_body;
-
+
$c->request->body_parameters( $c->request->_body->param );
}
sub prepare_query_parameters {
my ( $self, $c, $query_string ) = @_;
-
+
# Check for keywords (no = signs)
# (yes, index() is faster than a regex :))
if ( index( $query_string, '=' ) < 0 ) {
# replace semi-colons
$query_string =~ s/;/&/g;
-
+
my @params = grep { length $_ } split /&/, $query_string;
for my $item ( @params ) {
-
- my ($param, $value)
+
+ my ($param, $value)
= map { $self->unescape_uri($_) }
split( /=/, $item, 2 );
-
+
$param = $self->unescape_uri($item) unless defined $param;
-
+
if ( exists $query{$param} ) {
if ( ref $query{$param} ) {
push @{ $query{$param} }, $value;
# Initialize the read position
$self->read_position(0);
-
+
# Initialize the amount of data we think we need to read
$self->read_length( $c->request->header('Content-Length') || 0 );
}
$self->prepare_write($c);
$self->_prepared_write(1);
}
-
+
return 0 if !defined $buffer;
-
+
my $len = length($buffer);
my $wrote = syswrite STDOUT, $buffer;
-
+
if ( !defined $wrote && $! == EWOULDBLOCK ) {
# Unable to write on the first try, will retry in the loop below
$wrote = 0;
}
-
+
if ( defined $wrote && $wrote < $len ) {
# We didn't write the whole buffer
while (1) {
next if $! == EWOULDBLOCK;
return;
}
-
+
last if $wrote >= $len;
}
}
-
+
return $wrote;
}
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
# set the request URI
my $path = $base_path . ( $ENV{PATH_INFO} || '' );
$path =~ s{^/+}{};
-
+
# Using URI directly is way too slow, so we construct the URLs manually
my $uri_class = "URI::$scheme";
-
+
# HTTP_HOST will include the port even if it's 80/443
$host =~ s/:(?:80|443)$//;
-
+
if ( $port !~ /^(?:80|443)$/ && $host !~ /:/ ) {
$host .= ":$port";
}
-
+
# Escape the path
$path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go;
$path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE
-
+
my $query = $ENV{QUERY_STRING} ? '?' . $ENV{QUERY_STRING} : '';
my $uri = $scheme . '://' . $host . '/' . $path . $query;
# set the base URI
# base must end in a slash
$base_path .= '/' unless $base_path =~ m{/$};
-
+
my $base_uri = $scheme . '://' . $host . $base_path;
$c->request->base( bless \$base_uri, $uri_class );
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
This class overloads some methods from C<Catalyst::Engine::CGI>.
=head2 $self->run($c, $listen, { option => value, ... })
-
+
Starts the FastCGI server. If C<$listen> is set, then it specifies a
location to listen for FastCGI requests;
Specify a FCGI::ProcManager sub-class
-=item detach
+=item detach
Detach from console
$self->prepare_write($c);
$self->_prepared_write(1);
}
-
+
# XXX: We can't use Engine's write() method because syswrite
# appears to return bogus values instead of the number of bytes
# written: http://www.fastcgi.com/om_archive/mail-archive/0128.html
-
+
# Prepend the headers if they have not yet been sent
if ( $self->_has_header_buf ) {
$buffer = $self->_clear_header_buf . $buffer;
my $self = shift;
my $env = shift;
- # we are gonna add variables from current system environment %ENV to %env
+ # we are gonna add variables from current system environment %ENV to %env
# that contains at this moment just variables taken from FastCGI request
foreach my $k (keys(%ENV)) {
$env->{$k} = $ENV{$k} unless defined($env->{$k});
=head2 Standalone FastCGI Server
-In server mode the application runs as a standalone server and accepts
+In server mode the application runs as a standalone server and accepts
connections from a web server. The application can be on the same machine as
the web server, on a remote machine, or even on multiple remote machines.
Advantages of this method include running the Catalyst application as a
module and then use the included fastcgi.pl script.
$ script/myapp_fastcgi.pl -l /tmp/myapp.socket -n 5
-
+
Command line options for fastcgi.pl include:
-d -daemon Daemonize the server.
-p -pidfile Write a pidfile with the pid of the process manager.
-l -listen Listen on a socket path, hostname:port, or :port.
-n -nproc The number of processes started to handle requests.
-
+
See below for the specific web server configurations for using the external
server.
Apache requires the mod_fastcgi module. The same module supports both
Apache 1 and 2.
-There are three ways to run your application under FastCGI on Apache: server,
+There are three ways to run your application under FastCGI on Apache: server,
static, and dynamic.
=head3 Standalone server mode
FastCgiExternalServer /tmp/myapp.fcgi -socket /tmp/myapp.socket
Alias /myapp/ /tmp/myapp/myapp.fcgi/
-
+
# Or, run at the root
Alias / /tmp/myapp.fcgi/
-
+
# Optionally, rewrite the path when accessed without a trailing slash
RewriteRule ^/myapp$ myapp/ [R]
-
+
The FastCgiExternalServer directive tells Apache that when serving
/tmp/myapp to use the FastCGI application listenting on the socket
C<mod_fcgid>, you can use any name you like, but some require that the
virtual filename end in C<.fcgi>.
-It's likely that Apache is not configured to serve files in /tmp, so the
+It's likely that Apache is not configured to serve files in /tmp, so the
Alias directive maps the url path /myapp/ to the (virtual) file that runs the
FastCGI application. The trailing slashes are important as their use will
correctly set the PATH_INFO environment variable used by Catalyst to
FastCgiServer /path/to/myapp/script/myapp_fastcgi.pl -processes 3
Alias /myapp/ /path/to/myapp/script/myapp_fastcgi.pl/
-
+
FastCgiServer tells Apache to start three processes of your application at
startup. The Alias command maps a path to the FastCGI application. Again,
the trailing slashes are important.
-
+
=head3 Dynamic mode
-In FastCGI dynamic mode, Apache will run your application on demand,
+In FastCGI dynamic mode, Apache will run your application on demand,
typically by requesting a file with a specific extension (e.g. .fcgi). ISPs
often use this type of setup to provide FastCGI support to many customers.
Then a request for /script/myapp_fastcgi.pl will run the
application.
-
+
For more information on using FastCGI under Apache, visit
L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html>
=head3 Static mode
server.document-root = "/var/www/MyApp/root"
-
+
fastcgi.server = (
"" => (
"MyApp" => (
)
)
)
-
+
Note that in newer versions of lighttpd, the min-procs and idle-timeout
values are disabled. The above example would start 5 processes.
=head3 Non-root configuration
-
+
You can also run your application at any non-root location with either of the
above modes. Note the required mod_rewrite rule.
=head2 Microsoft IIS
-It is possible to run Catalyst under IIS with FastCGI, but only on IIS 6.0
+It is possible to run Catalyst under IIS with FastCGI, but only on IIS 6.0
(Microsoft Windows 2003), IIS 7.0 (Microsoft Windows 2008 and Vista) and
hopefully its successors.
-Even if it is declared that FastCGI is supported on IIS 5.1 (Windows XP) it
+Even if it is declared that FastCGI is supported on IIS 5.1 (Windows XP) it
does not support some features (specifically: wildcard mappings) that prevents
running Catalyst application.
FastCGI is not a standard part of IIS 6 - you have to install it separately. For
more info and download go to L<http://www.iis.net/extensions/FastCGI>. Choose
-approptiate version (32-bit/64-bit), installation is quite simple
+approptiate version (32-bit/64-bit), installation is quite simple
(in fact no questions, no options).
=item Create a new website
-Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager".
+Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager".
Click "Action" > "New" > "Web Site". After you finish the installation wizard
-you need to go to the new website's properties.
+you need to go to the new website's properties.
=item Set website properties
-On tab "Web site" set proper values for:
+On tab "Web site" set proper values for:
Site Description, IP Address, TCP Port, SSL Port etc.
On tab "Home Directory" set the following:
Local path permission flags: check only "Read" + "Log visits"
Execute permitions: "Scripts only"
-Click "Configuration" button (still on Home Directory tab) then click "Insert"
+Click "Configuration" button (still on Home Directory tab) then click "Insert"
the wildcard application mapping and in the next dialog set:
Executable: "c:\windows\system32\inetsrv\fcgiext.dll"
=item Edit fcgiext.ini
-Put the following lines into c:\windows\system32\inetsrv\fcgiext.ini (on 64-bit
+Put the following lines into c:\windows\system32\inetsrv\fcgiext.ini (on 64-bit
system c:\windows\syswow64\inetsrv\fcgiext.ini):
[Types]
; to list websites: "cscript adsutil.vbs ENUM /P /W3SVC"
; to get site name: "cscript adsutil.vbs GET /W3SVC/<number>/ServerComment"
; to get all details: "cscript adsutil.vbs GET /W3SVC/<number>"
- ; - or look where are the logs located:
- ; c:\WINDOWS\SYSTEM32\Logfiles\W3SVC7\whatever.log
+ ; - or look where are the logs located:
+ ; c:\WINDOWS\SYSTEM32\Logfiles\W3SVC7\whatever.log
; means that the corresponding number is "7"
- ;if you are running just one website using FastCGI you can use '*=CatalystApp'
+ ;if you are running just one website using FastCGI you can use '*=CatalystApp'
[CatalystApp]
ExePath=d:\strawberry\perl\bin\perl.exe
Arguments="d:\WWW\WebApp\script\webapp_fastcgi.pl -e"
- ;by setting this you can instruct IIS to serve Catalyst static files
+ ;by setting this you can instruct IIS to serve Catalyst static files
;directly not via FastCGI (in case of any problems try 1)
IgnoreExistingFiles=0
-
+
;do not be fooled by Microsoft doc talking about "IgnoreExistingDirectories"
;that does not work and use "IgnoreDirectories" instead
IgnoreDirectories=1
=item Necessary steps during IIS7 installation
During IIS7 installation after you have added role "Web Server (IIS)"
-you need to check to install role feature "CGI" (do not be nervous that it is
-not FastCGI). If you already have IIS7 installed you can add "CGI" role feature
-through "Control panel" > "Programs and Features".
+you need to check to install role feature "CGI" (do not be nervous that it is
+not FastCGI). If you already have IIS7 installed you can add "CGI" role feature
+through "Control panel" > "Programs and Features".
=item Create a new website
-Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager"
+Open "Control Panel" > "Administrative Tools" > "Internet Information Services Manager"
> "Add Web Site".
site name: "CatalystSite"
- content directory: "d:\WWW\WebApp\root"
+ content directory: "d:\WWW\WebApp\root"
binding: set proper IP address, port etc.
=item Configure FastCGI
-You can configure FastCGI extension using commandline utility
+You can configure FastCGI extension using commandline utility
"c:\windows\system32\inetsrv\appcmd.exe"
=over 4
appcmd.exe set config "CatalystSite" -section:system.webServer/handlers /+"[name='CatalystFastCGI',path='*',verb='GET,HEAD,POST',modules='FastCgiModule',scriptProcessor='d:\strawberry\perl\bin\perl.exe|d:\www\WebApp\script\webapp_fastcgi.pl -e',resourceType='Unspecified',requireAccess='Script']" /commit:apphost
-Note: before launching the commands above do not forget to change site
+Note: before launching the commands above do not forget to change site
name and paths to values relevant for your server setup.
=back
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
# Should we keep the connection open?
my $connection = $c->request->header('Connection');
- if ( $self->options->{keepalive}
- && $connection
+ if ( $self->options->{keepalive}
+ && $connection
&& $connection =~ /^keep-alive$/i
) {
$res_headers->header( Connection => 'keep-alive' );
sub read_chunk {
my $self = shift;
my $c = shift;
-
+
# If we have any remaining data in the input buffer, send it back first
if ( $_[0] = delete $self->{inputbuf} ) {
my $read = length( $_[0] );
my $sel = IO::Select->new;
$sel->add( \*STDIN );
-
+
REQUEST:
while (1) {
my ( $path, $query_string ) = split /\?/, $uri, 2;
-
+
# Initialize CGI environment
local %ENV = (
PATH_INFO => $path || '',
$class->handle_request( env => \%ENV );
}
-
+
DEBUG && warn "Request done\n";
-
+
# Allow keepalive requests, this is a hack but we'll support it until
# the next major release.
if ( $self->_is_keepalive ) {
$self->_clear_keepalive;
-
+
DEBUG && warn "Reusing previous connection for keep-alive request\n";
-
- if ( $sel->can_read(1) ) {
+
+ if ( $sel->can_read(1) ) {
if ( !$self->_read_headers ) {
# Error reading, give up
last REQUEST;
}
( $method, $uri, $protocol ) = $self->_parse_request_line;
-
+
DEBUG && warn "Parsed request: $method $uri $protocol\n";
-
+
# Force HTTP/1.0
$protocol = '1.0';
-
+
next REQUEST;
}
-
+
DEBUG && warn "No keep-alive request within 1 second\n";
}
-
+
last REQUEST;
}
-
+
DEBUG && warn "Closing connection\n";
close Remote;
}
}
$headers->push_header( $key, $val ) if $key;
-
+
DEBUG && warn "Parsed headers: " . dump($headers) . "\n";
# Convert headers into ENV vars
$headers->scan( sub {
my ( $key, $val ) = @_;
-
+
$key = uc $key;
$key = 'COOKIE' if $key eq 'COOKIES';
$key =~ tr/-/_/;
$key = 'HTTP_' . $key
unless $key =~ m/\A(?:CONTENT_(?:LENGTH|TYPE)|COOKIE)\z/;
-
+
if ( exists $ENV{$key} ) {
$ENV{$key} .= ", $val";
}
my ( $self, $handle ) = @_;
my $remote_sockaddr = getpeername($handle);
- my ( undef, $iaddr ) = $remote_sockaddr
- ? sockaddr_in($remote_sockaddr)
+ my ( undef, $iaddr ) = $remote_sockaddr
+ ? sockaddr_in($remote_sockaddr)
: (undef, undef);
-
+
my $local_sockaddr = getsockname($handle);
my ( undef, $localiaddr ) = sockaddr_in($local_sockaddr);
# This mess is necessary to keep IE from crashing the server
my $data = {
- peeraddr => $iaddr
+ peeraddr => $iaddr
? ( inet_ntoa($iaddr) || '127.0.0.1' )
: '127.0.0.1',
localname => gethostbyaddr( $localiaddr, AF_INET ) || 'localhost',
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
if !Catalyst::Engine::HTTP::Restarter::Watcher::DETECT_PACKAGE_COMPILATION;
my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
- directory => (
- $options->{restart_directory} ||
+ directory => (
+ $options->{restart_directory} ||
File::Spec->catdir( $FindBin::Bin, '..' )
),
follow_symlinks => $options->{follow_symlinks},
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
my @changes;
my @changed_files;
-
+
my $delay = ( defined $self->delay ) ? $self->delay : 1;
sleep $delay if $delay > 0;
regex => '\.yml$|\.yaml$|\.conf|\.pm$',
delay => 1,
);
-
+
while (1) {
my @changed_files = $watcher->watch();
}
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
is => 'rw', clearer => '_clear_body', predicate => '_has_body',
);
# Eugh, ugly. Should just be able to rename accessor methods to 'body'
-# and provide a custom reader..
+# and provide a custom reader..
sub body {
my $self = shift;
$self->_context->prepare_body();
present.
http://localhost/path?some+keywords
-
+
$c->request->query_keywords will contain 'some keywords'
=head2 $req->match
=head2 $req->param
-Returns GET and POST parameters with a CGI.pm-compatible param method. This
+Returns GET and POST parameters with a CGI.pm-compatible param method. This
is an alternative method for accessing parameters in $c->req->parameters.
$value = $c->request->param( 'foo' );
(creating it if it didn't exist before), and C<quxx> as another value for
C<gorch>.
+B<NOTE> this is considered a legacy interface and care should be taken when
+using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
+C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
+return a list of as many are present, which can have unexpected consequences
+when writing code of the form:
+
+ $foo->bar(
+ a => 'b',
+ baz => $c->req->param( 'baz' ),
+ );
+
+If multiple C<baz> parameters are provided this code might corrupt data or
+cause a hash initialization error. For a more straightforward interface see
+C<< $c->req->parameters >>.
+
=cut
sub param {
print $c->request->query_parameters->{field};
print $c->request->query_parameters->{field}->[0];
-
+
=head2 $req->read( [$maxlength] )
Reads a chunk of data from the request body. This method is intended to be
=head2 $req->uploads
Returns a reference to a hash containing uploads. Values can be either a
-L<Catalyst::Request::Upload> object, or an arrayref of
+L<Catalyst::Request::Upload> object, or an arrayref of
L<Catalyst::Request::Upload> objects.
my $upload = $c->request->uploads->{field};
sub uri_with {
my( $self, $args ) = @_;
-
+
carp( 'No arguments passed to uri_with()' ) unless $args;
foreach my $value ( values %$args ) {
utf8::encode( $_ ) if utf8::is_utf8($_);
}
};
-
+
my $uri = $self->uri->clone;
my %query = ( %{ $uri->query_form_hash }, %$args );
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head2 $upload->link_to
-Creates a hard link to the temporary file. Returns true for success,
+Creates a hard link to the temporary file. Returns true for success,
false for failure.
$upload->link_to('/path/to/target');
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
parameters of the same name, except they are used without a leading dash.
Possible parameters are:
-=over
+=over
=item value
$c->response->status(404);
$res->code is an alias for this, to match HTTP::Response->code.
-
+
=head2 $res->write( $data )
Writes $data to the output stream.
defined $self->write($,) or return;
defined $self->write($_) or return;
}
-
+
return 1;
}
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
=head1 DESCRIPTION
-This is the primary class for the Catalyst-Runtime distribution, version 5.70.
+This is the primary class for the Catalyst-Runtime distribution, version 5.80.
=head1 AUTHORS
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
$visitor->searchForUID($uid);
$self->accept($visitor);
return $visitor->getResult;
-}
+}
sub addChild {
my $self = shift;
$c->stats->profile("completed second part of critical bit");
# more code
...
- $c->stats->profile(end => "mysub");
+ $c->stats->profile(end => "mysub");
}
Supposing mysub was called from the action "process" inside a Catalyst
=head2 new
-Constructor.
+Constructor.
$stats = Catalyst::Stats->new;
Marks a profiling point. These can appear in pairs, to time the block of code
between the begin/end pairs, or by themselves, in which case the time of
-execution to the previous profiling point will be reported.
+execution to the previous profiling point will be reported.
The argument may be either a single comment string or a list of name-value
pairs. Thus the following are equivalent:
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify
+This library is free software. You can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
$c = shift;
});
$meta->make_immutable;
-
+
### do the request; C::T::request will know about the class name, and
### we've already stopped it from doing remote requests above.
my $res = $request->( @_ );
This module allows you to make requests to a Catalyst application either without
a server, by simulating the environment of an HTTP request using
L<HTTP::Request::AsCGI> or remotely if you define the CATALYST_SERVER
-environment variable. This module also adds a few catalyst
-specific testing methods as displayed in the method section.
+environment variable. This module also adds a few Catalyst-specific
+testing methods as displayed in the method section.
The L<get> and L<request> functions take either a URI or an L<HTTP::Request>
object.
=head2 $res = request( ... );
-Returns a L<HTTP::Response> object. Accepts an optional hashref for request
+Returns an L<HTTP::Response> object. Accepts an optional hashref for request
header configuration; currently only supports setting 'host' value.
my $res = request('foo/bar?test=1');
# If request path is '/', we have to add a trailing slash to the
# final request URI
my $add_trailing = $request->uri->path eq '/';
-
+
my @sp = split '/', $server->path;
my @rp = split '/', $request->uri->path;
shift @sp;shift @rp; # leading /
}
}
$request->uri->path(join '/', @rp);
-
+
if ( $add_trailing ) {
$request->uri->path( $request->uri->path . '/' );
}
keep_alive => 1,
max_redirect => 0,
timeout => 60,
-
+
# work around newer LWP max_redirect 0 bug
# http://rt.cpan.org/Ticket/Display.html?id=40260
requests_redirectable => [],
=head2 action_ok
-Fetches the given URL and check that the request was successful
+Fetches the given URL and checks that the request was successful.
=head2 action_redirect
-Fetches the given URL and check that the request was a redirect
+Fetches the given URL and checks that the request was a redirect.
=head2 action_notfound
-Fetches the given URL and check that the request was not found
+Fetches the given URL and checks that the request was not found.
+
+=head2 content_like( $url, $regexp [, $test_name] )
-=head2 content_like
+Fetches the given URL and returns whether the content matches the regexp.
-Fetches the given URL and matches the content against it.
+=head2 contenttype_is
-=head2 contenttype_is
-
-Check for given MIME type
+Check for given MIME type.
=head1 SEE ALSO
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 DESCRIPTION
-Catalyst Utilities.
+Catalyst Utilities.
=head1 METHODS
my ( $lefthash, $righthash ) = @_;
return $lefthash unless defined $righthash;
-
+
my %merged = %$lefthash;
for my $key ( keys %$righthash ) {
my $right_ref = ( ref $righthash->{ $key } || '' ) eq 'HASH';
$merged{ $key } = $righthash->{ $key };
}
}
-
+
return \%merged;
}
1) Install Term::Size::Any, or
-2) Export $COLUMNS from your shell.
+2) Export $COLUMNS from your shell.
(Warning to bash users: 'echo $COLUMNS' may be showing you the bash
-variable, not $ENV{COLUMNS}. 'export COLUMNS=$COLUMNS' and you should see
+variable, not $ENV{COLUMNS}. 'export COLUMNS=$COLUMNS' and you should see
that 'env' now lists COLUMNS.)
As last resort, default value of 80 chars will be used.
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
=head1 DESCRIPTION
-This is the Catalyst View base class. It's meant to be used as
+This is the Catalyst View base class. It's meant to be used as
a base class by Catalyst views.
-As a convention, views are expected to read template names from
+As a convention, views are expected to read template names from
$c->stash->{template}, and put the output into $c->res->body.
Some views default to render a template named after the dispatched
action's private name. (See L<Catalyst::Action>.)
-=head1 METHODS
+=head1 METHODS
Implements the same methods as other Catalyst components, see
L<Catalyst::Component>
=head1 COPYRIGHT
-This program is free software, you can redistribute it and/or modify it under
+This library is free software. You can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 3*$iters;
+use Catalyst::Test 'TestAppOneView';
+
+if ( $ENV{CAT_BENCHMARK} ) {
+ require Benchmark;
+ Benchmark::timethis( $iters, \&run_tests );
+}
+else {
+ for ( 1 .. $iters ) {
+ run_tests();
+ }
+}
+
+sub run_tests {
+ {
+ is(get('/view_by_name?view=Dummy'), 'AClass',
+ '$c->view("name") returns blessed instance');
+ is(get('/view_by_regex?view=Dummy'), 'AClass',
+ '$c->view(qr/name/) returns blessed instance');
+ is(get('/view_no_args'), 'AClass',
+ '$c->view() returns blessed instance');
+ }
+}
use Test::More;
-plan tests => 33;
+plan tests => 29;
use_ok('TestApp');
"/action/regexp/foo/123",
"Regex action interpolates captures correctly");
-is($dispatcher->uri_for_action($regex_action, [ 'foo/bar', 123 ]),
- "/action/regexp/foo%2Fbar/123",
- "Regex action interpolates captures correctly and url encodes /");
-
#
# Index Action
#
"http://127.0.0.1/foo/action/relative/relative/one/two?q=1",
"uri_for correct for path action with args and query");
-is($context->uri_for($path_action, qw|one/quux two|),
- "http://127.0.0.1/foo/action/relative/relative/one%2Fquux/two",
- "uri_for correctly url encoded for path action with args containing /");
-
ok(!defined($context->uri_for($path_action, [ 'blah' ])),
"no URI returned by uri_for for Path action with snippets");
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/',
'uri_for_action returns uri with empty arg on undef last argument' );
- is( $context->uri_for_action($action_needs_two, [ 'foo' , 'bar/baz' ], (3,4)),
- 'http://127.0.0.1/foo/chained/foo2/foo/bar%2Fbaz/end2/3/4',
- 'uri_for_action works correctly when CaptureArg contains /' );
-
- is( $context->uri_for_action($action_needs_two, [ 'foo' , 'bar' ], ('3/baz',4)),
- 'http://127.0.0.1/foo/chained/foo2/foo/bar/end2/3%2Fbaz/4',
- 'uri_for_action works correctly when Args contains /' );
-
my $complex_chained = '/action/chained/empty_chain_f';
is( $context->uri_for_action( $complex_chained, [23], (13), {q => 3} ),
'http://127.0.0.1/foo/chained/empty/23/13?q=3',
use FindBin qw/$Bin/;
use lib "$Bin/lib";
use Test::More tests => 4;
-use Test::MockObject;
my $warnings;
BEGIN { # Do this at compile time in case we generate a warning when use
use Catalyst; # Cause catalyst to be used so I can fiddle with the logging.
my $mvc_warnings;
BEGIN {
- my $logger = Test::MockObject->new;
- $logger->mock('warn', sub { $mvc_warnings++ if $_[1] =~ /switch your class names/ });
+ my $logger = Class::MOP::Class->create_anon_class(
+ methods => {
+ warn => sub {
+ if ($_[1] =~ /switch your class names/) {
+ $mvc_warnings++;
+ return;
+ }
+ die "Caught unexpected warning: " . $_[1];
+ },
+ },
+)->new_object;
Catalyst->log($logger);
}
--- /dev/null
+package TestApp::Model;
+use Moose;
+use namespace::clean -except => 'meta';
+
+extends 'Catalyst::Model';
+
+# Test a closure here, r10394 made this blow up when we clone the config down
+# onto the subclass..
+__PACKAGE__->config(
+ escape_flags => {
+ 'js' => sub { ${ $_[0] } =~ s/\'/\\\'/g; },
+ }
+);
+
+__PACKAGE__->meta->make_immutable;
+
--- /dev/null
+package TestApp::Model::ClosuresInConfig;
+use Moose;
+use namespace::clean -except => 'meta';
+
+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,
+# and ergo break due to the closure if dclone is used there..
+
+__PACKAGE__->meta->make_immutable;
+
--- /dev/null
+package TestAppOneView;
+use strict;
+use warnings;
+use Catalyst;
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package TestAppOneView::Controller::Root;
+
+use base 'Catalyst::Controller';
+use Scalar::Util ();
+
+__PACKAGE__->config->{namespace} = '';
+
+sub view_no_args : Local {
+ my ( $self, $c ) = @_;
+
+ my $v = $c->view;
+
+ $c->res->body(Scalar::Util::blessed($v));
+}
+
+sub view_by_name : Local {
+ my ( $self, $c ) = @_;
+
+ my $v = $c->view($c->req->param('view'));
+
+ $c->res->body(Scalar::Util::blessed($v));
+}
+
+sub view_by_regex : Local {
+ my ( $self, $c ) = @_;
+
+ my $v_name = $c->req->param('view');
+
+ my ($v) = $c->view(qr/$v_name/);
+
+ $c->res->body(Scalar::Util::blessed($v));
+}
+
+1;
--- /dev/null
+package TestAppOneView::View::Dummy;
+
+use base 'Catalyst::View';
+
+sub COMPONENT {
+ bless {}, 'AClass'
+}
+
+package AClass;
+
+use base 'Catalyst::View';
+
+1;
use File::Spec;
use File::Path;
-use Test::MockObject;
-
my $libdir = 'test_trash';
unshift(@INC, $libdir);
}
my $shut_up_deprecated_warnings = q{
- use Test::MockObject;
- my $old_logger = __PACKAGE__->log;
- my $logger = Test::MockObject->new;
- $logger->mock('warn', sub {
- my $self = shift;
- return if $_[0] =~ /deprecated/;
- $old_logger->warn(@_);
- });
- __PACKAGE__->log($logger);
+ __PACKAGE__->log(Catalyst::Log->new('fatal'));
};
eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
-use Test::More tests => 45;
+use Test::More tests => 46;
use strict;
use warnings;
map { "MyApp::$_"; }
qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/;
-my $thingie={};
-bless $thingie,'MyApp::Model::Test::Object';
-push @complist,$thingie;
{
package MyApp;
__PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
+ my $thingie={};
+ bless $thingie, 'Some::Test::Object';
+ __PACKAGE__->components->{'MyApp::Model::Test::Object'} = $thingie;
+
# allow $c->log->warn to work
__PACKAGE__->setup_log;
}
is( MyApp->model('Dummy::Model'), 'MyApp::Model::Dummy::Model', 'Model::Dummy::Model ok' );
-isa_ok( MyApp->model('Test::Object'), 'MyApp::Model::Test::Object', 'Test::Object ok' );
+isa_ok( MyApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' );
is( MyApp->controller('Model::Dummy::Model'), 'MyApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' );
no warnings 'redefine';
local *Catalyst::Log::warn = sub { $warnings++ };
- like (MyApp->model , qr/^MyApp\::(M|Model)\::/ , 'model() with no defaults returns *something*');
+ ok( my $model = MyApp->model );
+
+ ok( (($model =~ /^MyApp\::(M|Model)\::/) ||
+ $model->isa('Some::Test::Object')),
+ 'model() with no defaults returns *something*' );
+
ok( $warnings, 'model() w/o a default is random, warnings thrown' );
}
use strict;
use warnings;
-use Test::MockObject::Extends;
use Test::More tests => 24;
my $warnings = 0;
use PluginTestApp;
-my $logger = Test::MockObject::Extends->new(PluginTestApp->log);
-$logger->mock('warn', sub {
- if ($_[1] =~ /plugin method is deprecated/) {
- $warnings++;
- return;
- }
- die "Caught unexpected warning: " . $_[1];
-});
-#PluginTestApp->log($logger);
+my $logger = Class::MOP::Class->create_anon_class(
+ methods => {
+ warn => sub {
+ if ($_[1] =~ /plugin method is deprecated/) {
+ $warnings++;
+ return;
+ }
+ die "Caught unexpected warning: " . $_[1];
+ },
+ },
+)->new_object;
+PluginTestApp->log($logger);
use Catalyst::Test qw/PluginTestApp/;
use strict;
use warnings;
+use Class::MOP::Class;
use Catalyst::Runtime;
use Test::More tests => 29;
ok $log->is_debug, 'Debugging should be enabled';
ok !$c->debug, 'Catalyst debugging turned off';
}
+my $log_meta = Class::MOP::Class->create_anon_class(
+ methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ },
+);
{
package MyTestAppWithOwnLogger;
use base qw/Catalyst/;
- use Test::MockObject;
- my $log = Test::MockObject->new;
- $log->set_false(qw/debug error fatal info warn/);
- __PACKAGE__->log($log);
+ __PACKAGE__->log($log_meta->new_object);
__PACKAGE__->setup('-Debug');
}
use warnings;
use Test::More tests => 5;
-use Test::MockObject;
+use Class::MOP::Class;
use Catalyst ();
my %log_messages; # TODO - Test log messages as expected.
-my $mock_log = Test::MockObject->new;
-foreach my $level (qw/debug info warn error fatal/) {
- $mock_log->mock($level, sub {
- $log_messages{$level} ||= [];
- push(@{ $log_messages{$level} }, $_[1]);
- });
-}
+my $mock_log = Class::MOP::Class->create_anon_class(
+ methods => {
+ map { my $level = $_;
+ $level => sub {
+ $log_messages{$level} ||= [];
+ push(@{ $log_messages{$level} }, $_[1]);
+ },
+ }
+ qw/debug info warn error fatal/,
+ },
+)->new_object;
sub mock_app {
my $name = shift;
use strict;
use warnings;
-use Test::More tests => 16;
+use Test::More tests => 19;
use URI;
use_ok('Catalyst');
'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded'
);
+is(
+ Catalyst::uri_for( $context, '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string,
+ 'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus',
+ 'Plus is not encoded'
+);
# test with utf-8
is(
'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar'
);
+TODO: {
+ local $TODO = 'RFCs are for people who, erm - fix this test..';
+ # Test rfc3986 reserved characters. These characters should all be escaped
+ # according to the RFC, but it is a very big feature change so I've removed it
+ no warnings; # Yes, everything in qw is sane
+ is(
+ Catalyst::uri_for( $context, qw|! * ' ( ) ; : @ & = $ / ? % # [ ] ,|, )->as_string,
+ 'http://127.0.0.1/%21/%2A/%27/%2B/%29/%3B/%3A/%40/%26/%3D/%24/%2C/%2F/%3F/%25/%23/%5B/%5D',
+ 'rfc 3986 reserved characters'
+ );
+
+ # jshirley bug - why the hell does only one of these get encoded
+ # has been like this forever however.
+ is(
+ Catalyst::uri_for( $context, qw|{1} {2}| )->as_string,
+ 'http://127.0.0.1/{1}/{2}',
+ 'not-escaping unreserved characters'
+ );
+}
+