[Catalyst-commits] r8001 - in
Catalyst-Runtime/5.70/branches/context_go: . lib lib/Catalyst
lib/Catalyst/Request t t/lib/TestApp/Controller
marcus at dev.catalyst.perl.org
marcus at dev.catalyst.perl.org
Wed Jun 25 21:15:23 BST 2008
Author: marcus
Date: 2008-06-25 21:15:23 +0100 (Wed, 25 Jun 2008)
New Revision: 8001
Modified:
Catalyst-Runtime/5.70/branches/context_go/
Catalyst-Runtime/5.70/branches/context_go/Changes
Catalyst-Runtime/5.70/branches/context_go/Makefile.PL
Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst.pm
Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Controller.pm
Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Engine.pm
Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Request/Upload.pm
Catalyst-Runtime/5.70/branches/context_go/t/lib/TestApp/Controller/Root.pm
Catalyst-Runtime/5.70/branches/context_go/t/live_component_controller_action_regexp.t
Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_parameters.t
Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_uploads.t
Catalyst-Runtime/5.70/branches/context_go/t/unit_core_component.t
Catalyst-Runtime/5.70/branches/context_go/t/unit_core_mvc.t
Log:
r21359 at Command-Central (orig r7936): bricas | 2008-06-20 20:14:11 +0200
remove a confusing and duplicate bit of documentation
r21361 at Command-Central (orig r7938): bricas | 2008-06-23 15:38:24 +0200
Fix for LocalRegex when used in the Root controller
r21418 at Command-Central (orig r7995): bricas | 2008-06-24 00:01:06 +0200
Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)
r21419 at Command-Central (orig r7996): bricas | 2008-06-24 02:14:21 +0200
remove 0-length query string components so warnings aren't thrown (RT #36428)
r21423 at Command-Central (orig r8000): marcus | 2008-06-25 21:08:09 +0200
merge compres branch
Property changes on: Catalyst-Runtime/5.70/branches/context_go
___________________________________________________________________
Name: svk:merge
- 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
+ 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/compres:7999
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:8000
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
Modified: Catalyst-Runtime/5.70/branches/context_go/Changes
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/Changes 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/Changes 2008-06-25 20:15:23 UTC (rev 8001)
@@ -1,6 +1,17 @@
# This file documents the revision history for Perl extension Catalyst.
5.7xxx xxx
+ - Refactored component resolution (component(), models(), model(), et al). We now
+ throw warnings for two reasons:
+ 1) model() or view() was called with no arguments, and two results are returned
+ -- set default_(model|view), current_(model|view) or current_(model|view)_instance
+ instead
+ 2) you call a component resolution method with a string, and it resorts to a regexp
+ fallback wherein a result is returned -- if you really want to search, call the
+ method with a regex as the argument
+ - remove 0-length query string components so warnings aren't thrown (RT #36428)
+ - Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)
+ - Fix for LocalRegex when used in the Root controller
- Get some of the optional_* tests working from dirs with spaces (RT #26455)
- Fix Catalyst::Utils::home() when application .pm is in the current dir (RT #34437)
- Added the ability to remove parameters in req->uri_with() by passing in
Modified: Catalyst-Runtime/5.70/branches/context_go/Makefile.PL
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/Makefile.PL 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/Makefile.PL 2008-06-25 20:15:23 UTC (rev 8001)
@@ -13,7 +13,7 @@
requires 'Data::Dump';
requires 'File::Modified';
requires 'HTML::Entities';
-requires 'HTTP::Body' => '0.9';
+requires 'HTTP::Body' => '1.04'; # makes uploadtmp work
requires 'HTTP::Headers' => '1.64';
requires 'HTTP::Request';
requires 'HTTP::Response';
Modified: Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Controller.pm 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Controller.pm 2008-06-25 20:15:23 UTC (rev 8001)
@@ -270,7 +270,11 @@
sub _parse_LocalRegex_attr {
my ( $self, $c, $name, $value ) = @_;
unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
- return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
+
+ my $prefix = $self->path_prefix( $c );
+ $prefix .= '/' if length( $prefix );
+
+ return ( 'Regex', "^${prefix}${value}" );
}
sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
Modified: Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Engine.pm 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Engine.pm 2008-06-25 20:15:23 UTC (rev 8001)
@@ -314,7 +314,7 @@
unless ( $c->request->{_body} ) {
my $type = $c->request->header('Content-Type');
$c->request->{_body} = HTTP::Body->new( $type, $length );
- $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+ $c->request->{_body}->tmpdir( $c->config->{uploadtmp} )
if exists $c->config->{uploadtmp};
}
@@ -452,7 +452,7 @@
# replace semi-colons
$query_string =~ s/;/&/g;
- my @params = split /&/, $query_string;
+ my @params = grep { length $_ } split /&/, $query_string;
for my $item ( @params ) {
Modified: Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Request/Upload.pm
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Request/Upload.pm 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst/Request/Upload.pm 2008-06-25 20:15:23 UTC (rev 8001)
@@ -34,11 +34,6 @@
__PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
-It is provided a way to have configurable temporary directory.
-If there is no config uploadtmp, system temprary directory will used.
-
- __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
-
See also L<Catalyst>.
=head1 DESCRIPTION
Modified: Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst.pm 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/lib/Catalyst.pm 2008-06-25 20:15:23 UTC (rev 8001)
@@ -429,87 +429,60 @@
$c->error(0);
}
+# search components given a name and some prefixes
+sub _comp_search_prefixes {
+ my ( $c, $name, @prefixes ) = @_;
+ my $appclass = ref $c || $c;
+ my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
-# search via regex
-sub _comp_search {
- my ( $c, @names ) = @_;
+ # map the original component name to the sub part that we will search against
+ my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
+ grep { /$filter/ } keys %{ $c->components };
- foreach my $name (@names) {
- foreach my $component ( keys %{ $c->components } ) {
- return $c->components->{$component} if $component =~ /$name/i;
- }
- }
+ # undef for a name will return all
+ return keys %eligible if !defined $name;
- return undef;
-}
+ my $query = ref $name ? $name : qr/^$name$/i;
+ my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
-# try explicit component names
-sub _comp_explicit {
- my ( $c, @names ) = @_;
+ return map { $c->components->{ $_ } } @result if @result;
- foreach my $try (@names) {
- return $c->components->{$try} if ( exists $c->components->{$try} );
- }
+ # if we were given a regexp to search against, we're done.
+ return if ref $name;
- return undef;
-}
+ # regexp fallback
+ $query = qr/$name/i;
+ @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
-# like component, but try just these prefixes before regex searching,
-# and do not try to return "sort keys %{ $c->components }"
-sub _comp_prefixes {
- my ( $c, $name, @prefixes ) = @_;
+ # don't warn if we didn't find any results, it just might not exist
+ if( @result ) {
+ $c->log->warn( 'Relying on the regexp fallback behavior for component resolution is unreliable and unsafe.' );
+ $c->log->warn( 'If you really want to search, pass in a regexp as the argument.' );
+ }
- my $appclass = ref $c || $c;
-
- my @names = map { "${appclass}::${_}::${name}" } @prefixes;
-
- my $comp = $c->_comp_explicit(@names);
- return $comp if defined($comp);
- $comp = $c->_comp_search($name);
- return $comp;
+ return @result;
}
# Find possible names for a prefix
-
sub _comp_names {
my ( $c, @prefixes ) = @_;
-
my $appclass = ref $c || $c;
- my @pre = map { "${appclass}::${_}::" } @prefixes;
+ my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
- my @names;
-
- COMPONENT: foreach my $comp ($c->component) {
- foreach my $p (@pre) {
- if ($comp =~ s/^$p//) {
- push(@names, $comp);
- next COMPONENT;
- }
- }
- }
-
+ my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
return @names;
}
-# Return a component if only one matches.
-sub _comp_singular {
- my ( $c, @prefixes ) = @_;
-
- my $appclass = ref $c || $c;
-
- my ( $comp, $rest ) =
- map { $c->_comp_search("^${appclass}::${_}::") } @prefixes;
- return $comp unless $rest;
-}
-
# Filter a component before returning by calling ACCEPT_CONTEXT if available
sub _filter_component {
my ( $c, $comp, @args ) = @_;
+
if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
return $comp->ACCEPT_CONTEXT( $c, @args );
}
- else { return $comp }
+
+ return $comp;
}
=head2 COMPONENT ACCESSORS
@@ -523,13 +496,23 @@
If the name is omitted, will return the controller for the dispatched
action.
+If you want to search for controllers, pass in a regexp as the argument.
+
+ # find all controllers that start with Foo
+ my @foo_controllers = $c->controller(qr{^Foo});
+
+
=cut
sub controller {
my ( $c, $name, @args ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/Controller C/ ),
- @args )
- if ($name);
+
+ if( $name ) {
+ my @result = $c->_comp_search_prefixes( $name, qw/Controller C/ );
+ return map { $c->_filter_component( $_, @args ) } @result if ref $name;
+ return $c->_filter_component( $result[ 0 ], @args );
+ }
+
return $c->component( $c->action->class );
}
@@ -547,13 +530,22 @@
- a config setting 'default_model', or
- check if there is only one model, and return it if that's the case.
+If you want to search for models, pass in a regexp as the argument.
+
+ # find all models that start with Foo
+ my @foo_models = $c->model(qr{^Foo});
+
=cut
sub model {
my ( $c, $name, @args ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
- @args )
- if $name;
+
+ if( $name ) {
+ my @result = $c->_comp_search_prefixes( $name, qw/Model M/ );
+ return map { $c->_filter_component( $_, @args ) } @result if ref $name;
+ return $c->_filter_component( $result[ 0 ], @args );
+ }
+
if (ref $c) {
return $c->stash->{current_model_instance}
if $c->stash->{current_model_instance};
@@ -562,19 +554,18 @@
}
return $c->model( $c->config->{default_model} )
if $c->config->{default_model};
- return $c->_filter_component( $c->_comp_singular(qw/Model M/) );
-}
+ my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
-=head2 $c->controllers
+ if( $rest ) {
+ $c->log->warn( 'Calling $c->model() will return a random model unless you specify one of:' );
+ $c->log->warn( '* $c->config->{default_model} # the name of the default model to use' );
+ $c->log->warn( '* $c->stash->{current_model} # the name of the model to use for this request' );
+ $c->log->warn( '* $c->stash->{current_model_instance} # the instance of the model to use for this request' );
+ $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
+ }
-Returns the available names which can be passed to $c->controller
-
-=cut
-
-sub controllers {
- my ( $c ) = @_;
- return $c->_comp_names(qw/Controller C/);
+ return $c->_filter_component( $comp );
}
@@ -592,13 +583,22 @@
- a config setting 'default_view', or
- check if there is only one view, and return it if that's the case.
+If you want to search for views, pass in a regexp as the argument.
+
+ # find all views that start with Foo
+ my @foo_views = $c->view(qr{^Foo});
+
=cut
sub view {
my ( $c, $name, @args ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
- @args )
- if $name;
+
+ if( $name ) {
+ my @result = $c->_comp_search_prefixes( $name, qw/View V/ );
+ return map { $c->_filter_component( $_, @args ) } @result if ref $name;
+ return $c->_filter_component( $result[ 0 ], @args );
+ }
+
if (ref $c) {
return $c->stash->{current_view_instance}
if $c->stash->{current_view_instance};
@@ -607,9 +607,31 @@
}
return $c->view( $c->config->{default_view} )
if $c->config->{default_view};
- return $c->_filter_component( $c->_comp_singular(qw/View V/) );
+
+ my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/View V/);
+
+ if( $rest ) {
+ $c->log->warn( 'Calling $c->view() will return a random view unless you specify one of:' );
+ $c->log->warn( '* $c->config->{default_view} # the name of the default view to use' );
+ $c->log->warn( '* $c->stash->{current_view} # the name of the view to use for this request' );
+ $c->log->warn( '* $c->stash->{current_view_instance} # the instance of the view to use for this request' );
+ $c->log->warn( 'NB: in version 5.80, the "random" behavior will not work at all.' );
+ }
+
+ return $c->_filter_component( $comp );
}
+=head2 $c->controllers
+
+Returns the available names which can be passed to $c->controller
+
+=cut
+
+sub controllers {
+ my ( $c ) = @_;
+ return $c->_comp_names(qw/Controller C/);
+}
+
=head2 $c->models
Returns the available names which can be passed to $c->model
@@ -642,35 +664,49 @@
class. C<< $c->controller >>, C<< $c->model >>, and C<< $c->view >>
should be used instead.
+If C<$name> is a regexp, a list of components matched against the full
+component name will be returned.
+
=cut
sub component {
- my $c = shift;
+ my ( $c, $name, @args ) = @_;
- if (@_) {
+ if( $name ) {
+ my $comps = $c->components;
- my $name = shift;
+ if( !ref $name ) {
+ # is it the exact name?
+ return $comps->{ $name } if exists $comps->{ $name };
- my $appclass = ref $c || $c;
+ # perhaps we just omitted "MyApp"?
+ my $composed = ( ref $c || $c ) . "::${name}";
+ return $comps->{ $composed } if exists $comps->{ $composed };
- my @names = (
- $name, "${appclass}::${name}",
- map { "${appclass}::${_}::${name}" }
- qw/Model M Controller C View V/
- );
+ # search all of the models, views and controllers
+ my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
+ return $c->_filter_component( $comp, @args ) if $comp;
+ }
- my $comp = $c->_comp_explicit(@names);
- return $c->_filter_component( $comp, @_ ) if defined($comp);
+ # This is here so $c->comp( '::M::' ) works
+ my $query = ref $name ? $name : qr{$name}i;
- $comp = $c->_comp_search($name);
- return $c->_filter_component( $comp, @_ ) if defined($comp);
+ my @result = grep { m{$query} } keys %{ $c->components };
+ return @result if ref $name;
+
+ if( $result[ 0 ] ) {
+ $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
+ $c->log->warn( 'is unreliable and unsafe. You have been warned' );
+ return $result[ 0 ];
+ }
+
+ # I would expect to return an empty list here, but that breaks back-compat
}
+ # fallback
return sort keys %{ $c->components };
}
-
-
=head2 CLASS DATA AND HELPER CLASSES
=head2 $c->config
Modified: Catalyst-Runtime/5.70/branches/context_go/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/lib/TestApp/Controller/Root.pm 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/lib/TestApp/Controller/Root.pm 2008-06-25 20:15:23 UTC (rev 8001)
@@ -13,4 +13,11 @@
$c->forward('TestApp::View::Dump::Request');
}
+sub localregex : LocalRegex('^localregex$') {
+ my ( $self, $c ) = @_;
+ $c->res->header( 'X-Test-Class' => ref($self) );
+ $c->response->content_type('text/plain; charset=utf-8');
+ $c->forward('TestApp::View::Dump::Request');
+}
+
1;
Modified: Catalyst-Runtime/5.70/branches/context_go/t/live_component_controller_action_regexp.t
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/live_component_controller_action_regexp.t 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/live_component_controller_action_regexp.t 2008-06-25 20:15:23 UTC (rev 8001)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 28*$iters;
+use Test::More tests => 33*$iters;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -103,4 +103,19 @@
is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
is( $req->captures->[ 1 ], '/optional', 'optional capture' );
}
+
+ # test localregex in the root controller
+ {
+ ok( my $response = request('http://localhost/localregex'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ '^localregex$', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Root',
+ 'Test Class'
+ );
+ }
}
Modified: Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_parameters.t
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_parameters.t 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_parameters.t 2008-06-25 20:15:23 UTC (rev 8001)
@@ -6,7 +6,7 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 40;
+use Test::More tests => 53;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -137,3 +137,26 @@
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
is( $creq->{uri}->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' );
}
+
+{
+ my $creq;
+ ok( my $response = request("http://localhost/dump/request?&&q="),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ ok( eval '$creq = ' . $response->content );
+ is( keys %{$creq->{parameters}}, 1, 'remove empty parameter' );
+ is( $creq->{parameters}->{q}, '', 'empty parameter' );
+}
+
+{
+ my $creq;
+ ok( my $response = request("http://localhost/dump/request?&0&q="),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ ok( eval '$creq = ' . $response->content );
+ is( keys %{$creq->{parameters}}, 2, 'remove empty parameter' );
+ is( $creq->{parameters}->{q}, '', 'empty parameter' );
+ ok( !defined $creq->{parameters}->{0}, 'empty parameter' );
+}
Modified: Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_uploads.t
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_uploads.t 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/live_engine_request_uploads.t 2008-06-25 20:15:23 UTC (rev 8001)
@@ -6,7 +6,7 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 75;
+use Test::More tests => 88;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -242,3 +242,62 @@
is( $upload->filename, 'catalyst_130pix.gif' );
}
}
+
+# test uploadtmp config var
+
+{
+ my $creq;
+
+ my $dir = "$FindBin::Bin/";
+ local TestApp->config->{ uploadtmp } = $dir;
+
+ my $request = POST(
+ 'http://localhost/dump/request/',
+ 'Content-Type' => 'multipart/form-data',
+ 'Content' => [
+ 'testfile' => ["$FindBin::Bin/live_engine_request_uploads.t"],
+ ]
+ );
+
+ ok( my $response = request($request), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ like(
+ $response->content,
+ qr/^bless\( .* 'Catalyst::Request' \)$/s,
+ 'Content is a serialized Catalyst::Request'
+ );
+
+ {
+ no strict 'refs';
+ ok(
+ eval '$creq = ' . $response->content,
+ 'Unserialize Catalyst::Request'
+ );
+ }
+
+ isa_ok( $creq, 'Catalyst::Request' );
+ is( $creq->method, 'POST', 'Catalyst::Request method' );
+ is( $creq->content_type, 'multipart/form-data',
+ 'Catalyst::Request Content-Type' );
+ is( $creq->content_length, $request->content_length,
+ 'Catalyst::Request Content-Length' );
+
+ for my $part ( $request->parts ) {
+
+ my $disposition = $part->header('Content-Disposition');
+ my %parameters = @{ ( split_header_words($disposition) )[0] };
+
+ next unless exists $parameters{filename};
+
+ my $upload = $creq->{uploads}->{ $parameters{name} };
+
+ isa_ok( $upload, 'Catalyst::Request::Upload' );
+
+ is( $upload->type, $part->content_type, 'Upload Content-Type' );
+ is( $upload->size, length( $part->content ), 'Upload Content-Length' );
+
+ like( $upload->tempname, qr{\Q$dir\E}, 'uploadtmp' );
+ }
+}
+
Modified: Catalyst-Runtime/5.70/branches/context_go/t/unit_core_component.t
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/unit_core_component.t 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/unit_core_component.t 2008-06-25 20:15:23 UTC (rev 8001)
@@ -1,4 +1,4 @@
-use Test::More tests => 7;
+use Test::More tests => 11;
use strict;
use warnings;
@@ -12,6 +12,9 @@
use base qw/Catalyst/;
__PACKAGE__->components({ map { ($_, $_) } @complist });
+
+ # this is so $c->log->warn will work
+ __PACKAGE__->setup_log;
}
is(MyApp->comp('MyApp::V::View'), 'MyApp::V::View', 'Explicit return ok');
@@ -20,9 +23,34 @@
is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok');
-is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
+# regexp fallback
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
+ ok( $warnings, 'regexp fallback for comp() warns' );
+}
+
is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok');
+# Is this desired behaviour?
is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok');
- # Is this desired behaviour?
+
+# regexp behavior
+{
+ is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' );
+}
+
+# multiple returns
+{
+ my @expected = qw( MyApp::C::Controller MyApp::M::Model );
+ is_deeply( [ MyApp->comp( qr{::[MC]::} ) ], \@expected, 'multiple results fro regexp ok' );
+}
+
+# failed search
+{
+ is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' );
+}
+
Modified: Catalyst-Runtime/5.70/branches/context_go/t/unit_core_mvc.t
===================================================================
--- Catalyst-Runtime/5.70/branches/context_go/t/unit_core_mvc.t 2008-06-25 19:08:09 UTC (rev 8000)
+++ Catalyst-Runtime/5.70/branches/context_go/t/unit_core_mvc.t 2008-06-25 20:15:23 UTC (rev 8001)
@@ -1,4 +1,4 @@
-use Test::More tests => 27;
+use Test::More tests => 37;
use strict;
use warnings;
@@ -18,6 +18,9 @@
use base qw/Catalyst/;
__PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
+
+ # allow $c->log->warn to work
+ __PACKAGE__->setup_log;
}
is( MyApp->view('View'), 'MyApp::V::View', 'V::View ok' );
@@ -39,6 +42,11 @@
is( MyApp->model('M'), 'MyApp::Model::M', 'Model::M ok' );
+# failed search
+{
+ is( MyApp->model('DNE'), undef, 'undef for invalid search' );
+}
+
is_deeply( [ sort MyApp->views ],
[ qw/V View/ ],
'views ok' );
@@ -51,8 +59,15 @@
[ qw/Dummy::Model M Model Test::Object/ ],
'models ok');
-is (MyApp->view , 'MyApp::V::View', 'view() with no defaults ok');
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ like (MyApp->view , qr/^MyApp\::(V|View)\::/ , 'view() with no defaults returns *something*');
+ ok( $warnings, 'view() w/o a default is random, warnings thrown' );
+}
+
is ( bless ({stash=>{current_view=>'V'}}, 'MyApp')->view , 'MyApp::View::V', 'current_view ok');
my $view = bless {} , 'MyApp::View::V';
@@ -61,8 +76,15 @@
is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyApp::V::View' }}, 'MyApp')->view , $view,
'current_view_instance precedes current_view ok');
-is (MyApp->model , 'MyApp::M::Model', 'model() with no defaults ok');
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ like (MyApp->model , qr/^MyApp\::(M|Model)\::/ , 'model() with no defaults returns *something*');
+ ok( $warnings, 'model() w/o a default is random, warnings thrown' );
+}
+
is ( bless ({stash=>{current_model=>'M'}}, 'MyApp')->model , 'MyApp::Model::M', 'current_model ok');
my $model = bless {} , 'MyApp::Model::M';
@@ -79,6 +101,34 @@
is ( bless ({stash=>{}}, 'MyApp')->model , 'MyApp::Model::M', 'default_model ok');
is ( MyApp->model , 'MyApp::Model::M', 'default_model in class method ok');
+# regexp behavior tests
+{
+ # is_deeply is used because regexp behavior means list context
+ is_deeply( [ MyApp->view( qr{^V[ie]+w$} ) ], [ 'MyApp::V::View' ], 'regexp view ok' );
+ is_deeply( [ MyApp->controller( qr{Dummy\::Model$} ) ], [ 'MyApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
+ is_deeply( [ MyApp->model( qr{Dum{2}y} ) ], [ 'MyApp::Model::Dummy::Model' ], 'regexp model ok' );
+}
+
+{
+ my @expected = qw( MyApp::C::Controller MyApp::Controller::C );
+ is_deeply( [ sort MyApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyApp::V::View MyApp::View::V );
+ is_deeply( [ sort MyApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyApp::M::Model MyApp::Model::M );
+ is_deeply( [ sort MyApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
+}
+
+# failed search
+{
+ is( scalar MyApp->controller( qr{DNE} ), 0, '0 results for failed search' );
+}
+
#checking @args passed to ACCEPT_CONTEXT
my $args;
{
@@ -90,3 +140,4 @@
is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
MyApp->view('V', qw/baz moo/);
is_deeply($args, [qw/baz moo/], '$c->view args passed to ACCEPT_CONTEXT ok');
+
More information about the Catalyst-commits
mailing list