# This file documents the revision history for Perl extension Catalyst.
+ - Add the Catalyst::Dispatcher->dispatch_type method (ash)
+ - Throw an exception rather than loading an app if an action
+ tries to chain to itself (t0m)
+ - Tests for this
+ - Change the $c->visit and $c->go methods to optionally take
+ CaptureArgs, making them useful to call ActionChains with (t0m)
+ - Tests for this (radek)
+ - Fix _invoke_as_component method to find the proper action instance
+ for dispatchable actions so that ->visit or ->going to ActionChains
+ with qw/Class::Name method_name/ works correctly (t0m)
+ - Tests for this (radek)
+ - Added Catalyst::Test::ctx_request to be able to inspect
+ the context object after a request is made (Jos Boumans)
+ - debug() POD rewrite (jhannah)
+ - Change the warning when you have conflicting components to
+ present a list (t0m)
+ - Move NEXT use and testing deprecated features out to its own
+ test application so that the main TestApp isn't polluted with
+ spurious warnings (t0m)
+ - Add a warning for the old ::[MVC]:: style naming scheme (t0m)
+ - Test for this (t0m)
+ - Kill Class::C3::Adopt::NEXT warnings for the Catalyst:: namespace
+ in production versions (t0m)
- Tidy up Catalyst::ClassData to ensure that all components get
the correct metaclass (t0m)
- Make MyApp.pm restartable by unsetting setup_finished in
- namespace::clean related cleanups (rafl)
- Import related cleanups and consistency fixes (rafl)
- Fix test suite TestApp /dump/env action (t0m)
+ - Add $res->code as alias for $res->status (hdp)
+ - Make Catalyst::ClassData compatible with the latest Class::MOP::Class
+ changes. Also depend on the latest Class::MOP. (rafl)
+ - Add $c->uri_for_action method. (hdp)
5.8000_06 2009-02-04 21:00
- Disallow writing to config after setup (rafl)
+++ /dev/null
-* improve NEXT warnings. related irc conversation from 09/01/21:
-
-04:41:15 <@mst> actually, even better, it can pass an exclude list
-04:41:22 <@mst> and an include list with versions that contain fixage
-04:41:39 <@mst> then as shit on CPAN gets fixed it can start warning that you should upgrade
-04:41:46 <@rafl> that's already implemented. someone would need to maintain that list though
-04:42:28 <@rafl> i still think that silencing the warnings will delay fixes
-04:42:33 <@mst> if one person files all the rt tickets
-04:42:45 <@mst> it's just a question of watching email
-04:44:04 <@mst> and it doesn't seem fair for a user's code to warn all over the fucking place
-04:44:10 <@mst> just because some cpan author hasn't got their ass in gear
-04:44:52 <@rafl> the user already can disable the warnings for certain classes
-04:45:44 <@mst> I think we should leave 'em on for the RCs
-04:45:57 * dhoss-laptop phrews
-04:46:02 <@mst> but I don't think 5.80 final should be that sqeually
-04:46:06 <@rafl> what we have now is basically what i thought was good enough. it can certainly be better.
-04:46:17 <@rafl> i won't work on that anytime soon though
-04:46:20 <@mst> sure
-04:46:34 <@mst> could you throw this conversation into an IDEAS file or something?
-# Avoid version control files.
-\bRCS\b
-\bCVS\b
-,v$
-\B\.svn\b
-
-# Avoid Makemaker generated and utility files.
-\bMakefile$
-\bblib
-\bMakeMaker-\d
-\bpm_to_blib$
-\bblibdirs$
-^MANIFEST\.SKIP$
-
-# Avoid Module::Build generated and utility files.
-\bBuild$
-\b_build
-
-# Avoid temp and backup files.
-~$
-\.tmp$
-\.old$
-\.bak$
-\#$
-\b\.#
-\.DS_Store$
-
-# Avoid Apache::Test files
-t/conf/apache_test_config.pm
-t/conf/extra.conf$
-t/conf/httpd.conf
-t/conf/mime.types
-t/htdocs
-t/logs
-t/var
-
-# No tarballs!
-\.gz$
-
-# Skip the roadmap
-lib/Catalyst/ROADMAP.pod
+^(?!script/\w+\.pl$|TODO$|lib/.+(?<!ROADMAP)\.p(m|od)$|inc/|t/aggregate/.*\.t$|t/.*\.(gif|yml|pl|t)$|t/lib/.*\.pm$|t/something/(Makefile.PL|script/foo/bar/for_dist)$|t/conf/extra.conf.in$|Makefile.PL$|README$|MANIFEST$|Changes$|META.yml$)
requires 'namespace::clean';
requires 'Scope::Upper' => '0.06';
+requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00801';
+requires 'Moose' => '0.73';
requires 'MooseX::MethodAttributes::Inheritable' => '0.05';
-requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00800';
-requires 'Moose' => '0.70';
requires 'Carp';
requires 'Class::C3::Adopt::NEXT' => '0.07';
-requires 'Class::MOP';
+requires 'Class::MOP' => '0.79';
requires 'CGI::Simple::Cookie';
requires 'Data::Dump';
requires 'File::Modified';
test_requires 'Class::Data::Inheritable';
test_requires 'Test::MockObject';
+# Run aggregate tests if AGGREGATE_TESTS environment = 1, but not if it = 0
+# Otherwise default to using Test::Aggregate if installed, but not requiring it.
if ( ( exists $ENV{AGGREGATE_TESTS} && !$ENV{AGGREGATE_TESTS})
|| (!exists $ENV{AGGREGATE_TESTS} && !can_use('Test::Aggregate', '0.34_01'))) {
tests join q{ },
test_requires('Test::Aggregate', '0.34_01');
}
my @force_build_requires_if_author = qw(
- Test::NoTabs
- Test::Pod
- Test::Pod::Coverage
+ Test::NoTabs
+ Test::Pod
+ Test::Pod::Coverage
Pod::Coverage
);
if ($Module::Install::AUTHOR) {
-
- foreach my $module (@force_build_requires_if_author) {
- build_requires $module;
- }
-
-
- if ($^O eq 'darwin') {
- my $osx_ver = `/usr/bin/sw_vers -productVersion`;
- chomp $osx_ver;
-
- # TAR on 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE
- # On 10.5 (Leopard) it wants COPYFILE_DISABLE
- my $attr = $osx_ver eq '10.5' ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE';
-
- makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}.
- qq{ echo "You must set the ENV variable $attr to true,"; }.
- ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
- }
+ foreach my $module (@force_build_requires_if_author) {
+ build_requires $module;
+ }
+ darwin_check_no_resource_forks();
}
install_script glob('script/*.pl');
# Strip out the author only build_requires from META.yml
# Need to do this _after_ WriteAll else it looses track of them
- Meta->{values}{build_requires} = [ grep {
- my $ok = 1;
- foreach my $module (@force_build_requires_if_author) {
- if ($_->[0] =~ /$module/) {
- $ok = 0;
- last;
- }
- }
- $ok;
- } @{Meta->{values}{build_requires}} ];
-
- Meta->{values}{resources} = [
- [ 'MailingList', 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst' ],
- [ 'IRC', 'irc://irc.perl.org/#catalyst' ],
- [ 'license', 'http://dev.perl.org/licenses/' ],
- [ 'homepage', 'http://dev.catalyst.perl.org/'],
- [ 'repository', 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/' ],
+ strip_author_only_build_requires(@force_build_requires_if_author);
+
+ Meta->{values}{resources} = [
+ [ 'MailingList' => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst' ],
+ [ 'IRC' => 'irc://irc.perl.org/#catalyst' ],
+ [ 'license', => 'http://dev.perl.org/licenses/' ],
+ [ 'homepage', => 'http://dev.catalyst.perl.org/'],
+ [ 'repository', => 'http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/' ],
];
Meta->write;
}
+
print <<"EOF";
Important:
Have fun!
EOF
-check_conflicts();
+# NOTE - This is the version number of the _incompatible_ code,
+# not the version number of the fixed version.
+my %conflicts = (
+ 'Catalyst::Plugin::SmartURI' => '0.029',
+ 'CatalystX::CRUD' => '0.37',
+ 'Catalyst::Action::RenderView' => '0.07',
+ 'Catalyst::Plugin::DebugCookie' => '0.999002',
+ 'Catalyst::Plugin::Authentication' => '0.100091',
+ 'CatalystX::Imports' => '0.03',
+ 'Catalyst::Plugin::HashedCookies' => '1.03',
+);
+check_conflicts(%conflicts);
+
+# End of script, helper functions below.
+
+sub darwin_check_no_resource_forks {
+ if ($^O eq 'darwin') {
+ my $osx_ver = `/usr/bin/sw_vers -productVersion`;
+ chomp $osx_ver;
+
+ # TAR on 10.4 wants COPY_EXTENDED_ATTRIBUTES_DISABLE
+ # On 10.5 (Leopard) it wants COPYFILE_DISABLE
+ my $attr = $osx_ver eq '10.5' ? 'COPYFILE_DISABLE' : 'COPY_EXTENDED_ATTRIBUTES_DISABLE';
+
+ makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}.
+ qq{ echo "You must set the ENV variable $attr to true,"; }.
+ ' echo "to avoid getting resource forks in your dist."; exit 255; fi' });
+ }
+}
+
+sub strip_author_only_build_requires {
+ my @build_requires_to_strip = @_;
+ Meta->{values}{build_requires} = [ grep {
+ my $ok = 1;
+ foreach my $module (@build_requires_to_strip) {
+ if ($_->[0] =~ /$module/) {
+ $ok = 0;
+ last;
+ }
+ }
+ $ok;
+ } @{Meta->{values}{build_requires}} ];
+}
-# Nicked straight from Moose!
sub check_conflicts {
- # NOTE - This is the version number of the _incompatible_ code,
- # not the version number of the fixed version.
- my %conflicts = (
- 'Catalyst::Plugin::SmartURI' => '0.029',
- 'CatalystX::CRUD' => '0.37',
- 'Catalyst::Action::RenderView' => '0.07',
- 'Catalyst::Plugin::DebugCookie' => '0.999002',
- 'Catalyst::Plugin::Authentication' => '0.100091',
- 'CatalystX::Imports' => '0.03',
- 'Catalyst::Plugin::HashedCookies' => '1.03',
- );
-
- my $found = 0;
+ my %conflicts = @_;
+
+ my %conflicts_found;
for my $mod ( sort keys %conflicts ) {
eval "require($mod)";
next if $@;
my $installed = $mod->VERSION();
- if ( $installed le $conflicts{$mod} ) {
+ $conflicts_found{$mod} = $installed if ( $installed le $conflicts{$mod} );
+ }
+
+ return unless scalar keys %conflicts_found;
+
+ print <<"EOF";
- print <<"EOF";
+ WARNING:
-***
- This version of Catalyst conflicts with the version of
- $mod ($installed) you have installed.
+ This version of Catalyst conflicts with the versions of
+ some components you have installed.
- You will need to upgrade $mod after installing
+ You will need to upgrade these modules after installing
this version of Catalyst.
-***
+
+ List of the conflicting components and their installed versions:
EOF
- $found = 1;
- }
+ foreach my $mod (keys %conflicts_found) {
+ print sprintf(" %s => %s\n", $mod, $conflicts_found{$mod});
}
+ print "\n";
- return unless $found;
-
- # More or less copied from Module::Build
+ # More or less copied from Module::Build, via Moose
return if $ENV{PERL_MM_USE_DEFAULT};
return unless -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT));
-Known issues:
+Compatibility:
-Documentation:
+ - $self->config should warn as config should only ever be called as a
+ class method.
- - Catalyst/Upgrading.pod needs brushing up
+ - Need at least good docs on how C3 fail occurs.
- - Warning when you pass $c->model("MyApp::Model::Foo") is the generic
- warning for regex fall back. Should be more specific about what you
- screwed up, and the docs for $c->model should be more explicit about
- what is expected. This probably also applies to view/controller.
+Testing:
- Run more smokes
- - Using anything ::[CMV]:: should warn (once, on boot).
-
- - TestApp should not use NEXT. There should be a TestAppNEXTCompat
- which does but is standalone..
-
Profiling:
- vs 5.70 and optimisation as needed on perl 5.8 (5.10 is already faster!).
our $VERSION = '5.8000_06';
+{
+ my $dev_version = $VERSION =~ /_\d{2}$/;
+ *_IS_DEVELOPMENT_VERSION = sub () { $dev_version };
+}
+
+$VERSION = eval $VERSION;
+
sub import {
my ( $class, @arguments ) = @_;
return if $caller eq 'main';
# Kill Adopt::NEXT warnings if we're a non-RC version
- if ($VERSION !~ /_\d{2}$/) {
+ unless (_IS_DEVELOPMENT_VERSION()) {
Class::C3::Adopt::NEXT->unimport(qr/^Catalyst::/);
}
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
-=head2 $c->visit( $action [, \@arguments ] )
+=head2 $c->visit( $action [, \@captures, \@arguments ] )
-=head2 $c->visit( $class, $method, [, \@arguments ] )
+=head2 $c->visit( $class, $method, [, \@captures, \@arguments ] )
Almost the same as C<forward>, but does a full dispatch, instead of just
calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
sub visit { my $c = shift; $c->dispatcher->visit( $c, @_ ) }
-=head2 $c->go( $action [, \@arguments ] )
+=head2 $c->go( $action [, \@captures, \@arguments ] )
-=head2 $c->go( $class, $method, [, \@arguments ] )
+=head2 $c->go( $class, $method, [, \@captures, \@arguments ] )
Almost the same as C<detach>, but does a full dispatch like C<visit>,
instead of just calling the new C<$action> /
my ( $c, $name, @prefixes ) = @_;
my $appclass = ref $c || $c;
my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
+ $filter = qr/$filter/; # Compile regex now rather than once per loop
# map the original component name to the sub part that we will search against
my %eligible = map { my $n = $_; $n =~ s{^$appclass\::[^:]+::}{}; $_ => $n; }
# don't warn if we didn't find any results, it just might not exist
if( @result ) {
- my $msg = "Used regexp fallback for \$c->model('${name}'), which found '" .
+ # Disgusting hack to work out correct method name
+ my $warn_for = lc $prefixes[0];
+ my $msg = "Used regexp fallback for \$c->{$warn_for}('${name}'), which found '" .
(join '", "', @result) . "'. Relying on regexp fallback behavior for " .
"component resolution is unreliable and unsafe.";
my $short = $result[0];
$msg .= " You probably need to set '$short' instead of '${name}' in this " .
"component's config";
} else {
- $msg .= " You probably meant \$c->model('$short') instead of \$c->model{'${name}'}, " .
+ $msg .= " You probably meant \$c->${warn_for}('$short') instead of \$c->${warn_for}({'${name}'}), " .
"but if you really wanted to search, pass in a regexp as the argument " .
- "like so: \$c->model(qr/${name}/)";
+ "like so: \$c->${warn_for}(qr/${name}/)";
}
$c->log->warn( "${msg}$shortmess" );
}
__PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } );
You can also use a C<YAML>, C<XML> or C<Config::General> config file
-like myapp.yml in your applications home directory. See
+like myapp.conf in your applications home directory. See
L<Catalyst::Plugin::ConfigLoader>.
- ---
- db: dsn:SQLite:foo.db
+=head3 Cascading configuration.
+
+The config method is present on all Catalyst components, and configuration
+will be merged when an application is started. Configuration loaded with
+L<Catalyst::Plugin::ConfigLoader> takes precedence over other configuration,
+followed by configuration in your top level C<MyApp> class. These two
+configurations are merged, and then configuration data whos hash key matches a
+component name is merged with configuration for that component.
+
+The configuration for a component is then passed to the C<new> method when a
+component is constructed.
+
+For example:
+
+ MyApp->config({ 'Model::Foo' => { bar => 'baz', overrides => 'me' } });
+ MyApp::Model::Foo->config({ quux => 'frob', 'overrides => 'this' });
+
+will mean that C<MyApp::Model::Foo> receives the following data when
+constructed:
+ MyApp::Model::Foo->new({
+ bar => 'baz',
+ quux => 'frob',
+ overrides => 'me',
+ });
=cut
=head2 $c->debug
-Overload to enable debug messages (same as -Debug option).
+Returns 1 if debug mode is enabled, 0 otherwise.
-Note that this is a static method, not an accessor and should be overloaded
-by declaring "sub debug { 1 }" in your MyApp.pm, not by calling $c->debug(1).
+You can enable debug mode in several ways:
+
+=over
+
+=item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG
+
+=item The -Debug option in your MyApp.pm
+
+=item By declaring "sub debug { 1 }" in your MyApp.pm.
+
+=back
+
+Calling $c->debug(1) has no effect.
=cut
my ( $class, $name, $plugin, @args ) = @_;
# See block comment in t/unit_core_plugin.t
- $class->log->debug(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.9/);
+ $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in Catalyst 5.81/);
$class->_register_plugin( $plugin, 1 );
=head2 $app->setup_finalize
A hook to attach modifiers to.
-Using C< after setup => sub{}; > doesn't work, because of quirky things done for plugin setup.
+Using C<< after setup => sub{}; >> doesn't work, because of quirky things done for plugin setup.
Also better than C< setup_finished(); >, as that is a getter method.
sub setup_finalize {
my $captures = ( scalar @args && ref $args[0] eq 'ARRAY'
? shift(@args)
: [] );
- $path = $c->dispatcher->uri_for_action($path, $captures);
- return undef unless defined($path);
+ my $action = $path;
+ $path = $c->dispatcher->uri_for_action($action, $captures);
+ if (not defined $path) {
+ $c->log->debug(qq/Can't find uri_for action '$action' @$captures/)
+ if $c->debug;
+ return undef;
+ }
$path = '/' if $path eq '';
}
$res;
}
+=head2 $c->uri_for_action( $path, \@captures?, @args?, \%query_values? )
+
+=head2 $c->uri_for_action( $action, \@captures?, @args?, \%query_values? )
+
+=over
+
+=item $path
+
+A private path to the Catalyst action you want to create a URI for.
+
+This is a shortcut for calling C<< $c->dispatcher->get_action_by_path($path)
+>> and passing the resulting C<$action> and the remaining arguments to C<<
+$c->uri_for >>.
+
+You can also pass in a Catalyst::Action object, in which case it is passed to
+C<< $c->uri_for >>.
+
+=back
+
+=cut
+
+sub uri_for_action {
+ my ( $c, $path, @args ) = @_;
+ my $action = blessed($path)
+ ? $path
+ : $c->dispatcher->get_action_by_path($path);
+ unless (defined $action) {
+ croak "Can't find action for path '$path'";
+ }
+ return $c->uri_for( $action, @args );
+}
+
=head2 $c->welcome_message
Returns the Catalyst welcome HTML page.
they can save you a lot of work.</p>
<pre><code>script/${prefix}_create.pl -help</code></pre>
<p>Also, be sure to check out the vast and growing
- collection of <a href="http://cpansearch.perl.org/search?query=Catalyst%3A%3APlugin%3A%3A&mode=all">plugins for Catalyst on CPAN</a>;
+ collection of <a href="http://search.cpan.org/search?query=Catalyst">plugins for Catalyst on CPAN</a>;
you are likely to find what you need there.
</p>
my $deprecated_component_names = grep { /::[CMV]::/ } @comps;
$class->log->warn(qq{Your application is using the deprecated ::[MVC]:: type naming scheme.\n}.
qq{Please switch your class names to ::Model::, ::View:: and ::Controller: as appropriate.\n}
- );
+ ) if $deprecated_component_names;
for my $component ( @comps ) {
unless ref $accessor eq 'CODE';
my $meta = $class->Class::MOP::Object::meta();
- my $immutable_options;
- if( $meta->is_immutable ){
- $immutable_options = $meta->get_immutable_options;
- $meta->make_mutable;
- }
+ confess "${class}'s metaclass is not a Class::MOP::Class"
+ unless $meta->isa('Class::MOP::Class');
+
+ my $was_immutable = $meta->is_immutable;
+ $meta->make_mutable if $was_immutable;
+
my $alias = "_${attribute}_accessor";
$meta->add_method($alias, $accessor);
$meta->add_method($attribute, $accessor);
- if(defined $immutable_options){
- $meta->make_immutable(%{ $immutable_options });
- }
+
+ $meta->make_immutable if $was_immutable;
+
$class->$attribute($_[2]) if(@_ > 2);
return $accessor;
}
"Multiple Chained attributes not supported registering ${action}"
);
}
+ my $chained_to = $chained_attr[0];
- my $children = ($self->_children_of->{ $chained_attr[0] } ||= {});
+ Catalyst::Exception->throw(
+ "Actions cannot chain to themselves registering /${action}"
+ ) if ($chained_to eq '/' . $action);
+
+ my $children = ($self->_children_of->{ $chained_to } ||= {});
my @path_part = @{ $action->attributes->{PathPart} || [] };
has _method_action_class => (is => 'rw', default => 'Catalyst::Action');
has _action_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
has _container_hash => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
-
has preload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@PRELOAD] });
+
has postload_dispatch_types => (is => 'rw', required => 1, lazy => 1, default => sub { [@POSTLOAD] });
# Wrap accessors so you can assign a list and it will capture a list ref.
}
# $self->_command2action( $c, $command [, \@arguments ] )
-# Search for an action, from the command and returns C<($action, $args)> on
+# $self->_command2action( $c, $command [, \@captures, \@arguments ] )
+# Search for an action, from the command and returns C<($action, $args, $captures)> on
# success. Returns C<(0)> on error.
sub _command2action {
return 0;
}
- my @args;
+ my (@args, @captures);
+
+ if ( ref( $extra_params[-2] ) eq 'ARRAY' ) {
+ @captures = @{ pop @extra_params };
+ }
if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
@args = @{ pop @extra_params }
$action = $self->_invoke_as_component( $c, $command, $method );
}
- return $action, \@args;
+ return $action, \@args, \@captures;
}
=head2 $self->visit( $c, $command [, \@arguments ] )
my $self = shift;
my $opname = shift;
my ( $c, $command ) = @_;
- my ( $action, $args ) = $self->_command2action(@_);
+ my ( $action, $args, $captures ) = $self->_command2action(@_);
my $error = qq/Couldn't $opname("$command"): /;
if (!$action) {
}
elsif (!defined $action->namespace) {
$error .= qq/Action has no namespace: cannot $opname() to a plain /
- .qq/method or component, must be a :Action or some sort./
+ .qq/method or component, must be an :Action of some sort./
}
elsif (!$action->class->can('_DISPATCH')) {
$error .= qq/Action cannot _DISPATCH. /
$action = $self->expand_action($action);
local $c->request->{arguments} = $args;
+ local $c->request->{captures} = $captures;
local $c->{namespace} = $action->{'namespace'};
local $c->{action} = $action;
my $self = shift;
my $opname = shift;
my ( $c, $command ) = @_;
- my ( $action, $args ) = $self->_command2action(@_);
+ my ( $action, $args, $captures ) = $self->_command2action(@_);
if (!$action) {
my $error .= qq/Couldn't $opname to command "$command": /
}
}
-sub _find_component_class {
+sub _find_component {
my ( $self, $c, $component ) = @_;
- return ref($component)
- || ref( $c->component($component) )
- || $c->component($component);
+ # fugly, why doesn't ->component('MyApp') work?
+ return $c if ($component eq blessed($c));
+
+ return blessed($component)
+ ? $component
+ : $c->component($component);
}
sub _invoke_as_component {
- my ( $self, $c, $component, $method ) = @_;
+ my ( $self, $c, $component_or_class, $method ) = @_;
- my $class = $self->_find_component_class( $c, $component ) || return 0;
+ my $component = $self->_find_component($c, $component_or_class);
+ my $component_class = blessed $component || return 0;
- if ( my $code = $class->can($method) ) {
+ if (my $code = $component_class->can('action_for')) {
+ my $possible_action = $component->$code($method);
+ return $possible_action if $possible_action;
+ }
+
+ if ( my $code = $component_class->can($method) ) {
return $self->_method_action_class->new(
{
name => $method,
code => $code,
- reverse => "$class->$method",
- class => $class,
+ reverse => "$component_class->$method",
+ class => $component_class,
namespace => Catalyst::Utils::class2prefix(
- $class, $c->config->{case_sensitive}
+ $component_class, $c->config->{case_sensitive}
),
}
);
}
else {
my $error =
- qq/Couldn't forward to "$class". Does not implement "$method"/;
+ qq/Couldn't forward to "$component_class". Does not implement "$method"/;
$c->error($error);
$c->log->debug($error)
if $c->debug;
$self->_load_dispatch_types( @{ $self->postload_dispatch_types } );
return unless $c->debug;
+ $self->_display_action_tables($c);
+}
+
+sub _display_action_tables {
+ my ($self, $c) = @_;
my $column_width = Catalyst::Utils::term_width() - 20 - 36 - 12;
my $privates = Text::SimpleTable->new(
return @loaded;
}
+=head2 $self->dispatch_type( $type )
+
+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.)
+
+=cut
+
+sub dispatch_type {
+ my ($self, $name) = @_;
+
+ unless ($name =~ s/^\+//) {
+ $name = "Catalyst::DispatchType::" . $name;
+ }
+
+ for (@{ $self->_dispatch_types }) {
+ return $_ if ref($_) eq $name;
+ }
+ return undef;
+}
+
use Moose;
# 5.70 backwards compatibility hacks.
The FastCgiExternalServer directive tells Apache that when serving
/tmp/myapp to use the FastCGI application listenting on the socket
-/tmp/mapp.socket. Note that /tmp/myapp.fcgi does not need to exist --
+/tmp/mapp.socket. Note that /tmp/myapp.fcgi B<MUST NOT> exist --
it's a virtual file name. With some versions of C<mod_fastcgi> or
-C<mod_fcgid>, you can use any name you like, but most require that the
+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
sub output { shift->body(@_) }
+sub code { shift->status(@_) }
+
no Moose;
=head1 NAME
$res = $c->response;
$res->body;
+ $res->code;
$res->content_encoding;
$res->content_length;
$res->content_type;
Predicate which returns true when a body has been set.
+=head2 $res->code
+
+Alias for $res->status.
+
=head2 $res->content_encoding
Shortcut for $res->headers->content_encoding.
Sets or returns the HTTP status.
$c->response->status(404);
+
+$res->code is an alias for this, to match HTTP::Response->code.
=head2 $res->write( $data )
our $VERSION='5.8000_06';
-$VERSION= eval $VERSION;
+$VERSION = eval $VERSION;
=head1 NAME
my $get = sub { $request->(@_)->content };
+ my $ctx_request = sub {
+ my $me = ref $self || $self;
+
+ ### throw an exception if ctx_request is being used against a remote
+ ### server
+ Catalyst::Exception->throw("$me only works with local requests, not remote")
+ if $ENV{CATALYST_SERVER};
+
+ ### place holder for $c after the request finishes; reset every time
+ ### requests are done.
+ my $c;
+
+ ### hook into 'dispatch' -- the function gets called after all plugins
+ ### have done their work, and it's an easy place to capture $c.
+ no warnings 'redefine';
+ my $dispatch = Catalyst->can('dispatch');
+ local *Catalyst::dispatch = sub {
+ $c = shift;
+ $dispatch->( $c, @_ );
+ };
+
+ ### 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->( @_ );
+
+ ### return both values
+ return ( $res, $c );
+ };
+
return {
- request => $request,
- get => $get,
+ request => $request,
+ get => $get,
+ ctx_request => $ctx_request,
content_like => sub {
my $action = shift;
return Test::More->builder->like($get->($action),@_);
$import->($self, '-all' => { class => $class });
$opts = {} unless ref $opts eq 'HASH';
$default_host = $opts->{default_host} if exists $opts->{default_host};
+ return 1;
}
}
# Tests
use Catalyst::Test 'TestApp';
- request('index.html');
- get('index.html');
+ my $content = get('index.html'); # Content as string
+ my $response = request('index.html'); # HTTP::Response object
+ my($res, $c) = ctx_request('index.html'); # HTTP::Response & context object
use HTTP::Request::Common;
my $response = request POST '/foo', [
=head2 METHODS
-=head2 get
+=head2 $content = get( ... )
Returns the content.
is ( $uri->path , '/y');
my $content = get($uri->path);
-=head2 request
+=head2 $res = request( ... );
Returns a C<HTTP::Response> object. Accepts an optional hashref for request
header configuration; currently only supports setting 'host' value.
my $res = request('foo/bar?test=1');
my $virtual_res = request('foo/bar?test=1', {host => 'virtualhost.com'});
-=head2 local_request
+=head1 FUNCTIONS
+
+=head2 ($res, $c) = ctx_request( ... );
+
+Works exactly like C<Catalyst::Test::request>, except it also returns the
+catalyst context object, C<$c>. Note that this only works for local requests.
+
+=head2 $res = Catalyst::Test::local_request( $AppClass, $url );
Simulate a request using L<HTTP::Request::AsCGI>.
my $agent;
-=head2 remote_request
+=head2 $res = Catalyst::Test::remote_request( $url );
Do an actual remote request using LWP.
Most applications and plugins should run unaltered on Catalyst 5.80.
-However as a lot of refactoring work has taken place, several changes have
-been made which could cause incompatibilities, if your application or plugin
-is using deprecated code, or relying on side-effects then there could be
-incompatibility.
+However as a lot of refactoring work has taken place, and several changes have
+been made which could cause incompatibilities. If your application or plugin
+is using deprecated code, or relying on side-effects, then you could have
+issues upgrading to this release.
Most issues found with pre-existing components have been easy to solve, and a
-complete description of behavior changes which may cause compatibility issues,
-or warnings to be emitted is included below to help if you have problems.
+complete description of behaviour changes which may cause compatibility issues,
+or warnings which are now emitted is included below to help if you have problems.
If you think you have found an upgrade related issue which is not covered in
this document, then please email the Catalyst list to discuss the problem.
use Moose;
extends qw/Moose::Object Catalyst::Component/;
-to use the constructor provided by Moose, whilst working if you do some hacks
-with the C< BUILDARGS > method, will not work with Catalyst 5.80 as
+to use the constructor provided by Moose, whilst working (if you do some hacks
+with the C< BUILDARGS > method), will not work with Catalyst 5.80 as
C<Catalyst::Component> inherits from C<Moose::Object>, and so C< @ISA > fails
to linearise.
-The fix for this, is to not inherit directly from C<Moose::Object>
+The fix for this is to not inherit directly from C<Moose::Object>
yourself. Having components which do not inherit their constructor from
C<Catalyst::Component> is B<unsupported>, and has never been recommended,
therefore you're on your own if you're using this technique. You'll need
use Moose;
BEGIN { extends 'Catalyst::Component' }; # Or ::Controller, or whatever
-Note that the C< extends > decleration needs to occur in a begin block for
-L<attributes> to operate correctly.
+Note that the C< extends > declaration needs to occur in a begin block for
+L<attributes> to operate correctly. You also don't get the L<Moose::Object>
+constructor, and therefore attribute initialization will not work as normally
+expected. If you want to use Moose attributes, then they need to be made lazy
+to correctly initialize.
=head3 use Moose in MyApp
to use L<Sub::Name> to name the subroutine. Example:
# Original code, likely to break:
- my $full_method_name = join('::',$package_name, $method_name);
+ my $full_method_name = join('::', $package_name, $method_name);
*$full_method_name = sub { ... };
# Fixed Code
... # things to do after the actual setup
}
-With Catalyst 5.80 this won't work anymore. Because instead of using NEXT.pm it
-relies on L<Class::C3::Adopt::NEXT>, which uses plain C3 method resolution.
-
-As L<NEXTs|NEXT> hacks to remember what methods have already been called, this
-causes infinite recursion between MyApp::setup and Catalyst::setup.
+With Catalyst 5.80 this won't work anymore. Due to the fact that Catalyst is
+no longer using NEXT.pm for method resolution, this no longer works. The
+functionality was only ever originally operational as L<NEXT> remembers what
+methods have already been called, and will not call them again.
-Moose method modifiers like C<< before|after|around 'setup => sub { ... }; >>
-also will not operate correctly due to backward compatibility issues with the
-way plugin setup methods.
+Using this now causes infinite recursion between MyApp::setup and
+Catalyst::setup, due to other backwards compatibility issues related to how
+plugin setup works. Moose method modifiers like C<< before|after|around 'setup
+=> sub { ... }; >> also will not operate correctly on the setup method.
The right way to do it is this:
... # things to do after the actual setup
};
+The setup_finalize hook was introduced as a way to void this issue.
+
=head2 Components with a new method which returns false
Previously, if you had a component which inherited from Catalyst::COMPONENT,
the COMPONENT method.
This behaviour makes no sense, and so has been removed. Implementing your own
-new method in components is B<highly> discouraged, instead, you should inherit
-the new method from Catalyst::Component, and use Moose's BUILD functionality
-to perform any construction work necessary for your sub-class.
+C< new > method in components is B<highly> discouraged, instead, you should
+inherit the new method from Catalyst::Component, and use Mooses BUILD
+functionality and/or Moose attributes to perform any construction work
+necessary for your class.
=head2 __PACKAGE__->mk_accessor('meta');
Previously, writing to a class data accessor would copy the accessor method
down into your package.
-This behavior has been removed. Whilst the class data is still stored
+This behaviour has been removed. Whilst the class data is still stored
per-class, it is stored on the metaclass of the class defining the accessor.
Therefore anything relying on the side-effect of the accessor being copied down
will be broken.
-The following example demonstrates the problem:
+The following test demonstrates the problem:
{
package BaseClass;
Previously, it was possible to add additional accessors to Catalyst::Request
(or other classes) by calling the mk_accessors class method.
-This is no longer supported - users should make a sub-class of the class whos
-behavior they would like to change, rather than globally polluting the
+This is no longer supported - users should make a sub-class of the class whose
+behaviour they would like to change, rather than globally polluting the
Catalyst objects.
=head2 Confused multiple inheritance with Catalyst::Component::COMPONENT
-Warning message:
+Previously, Catalyst's COMPONENT method would delegate to the method on the
+right hand side, which could then delegate back again with NEXT. This (as it
+is insane AND makes no sense with C3 method dispatch order), and is therefore
+no longer supported.
+
+If a COMPONENT method is detected in the inheritance hierarchy to the right
+hand side of Catalyst::Component::COMPONENT, then the following warning
+message will be emitted:
There is a COMPONENT method resolving after Catalyst::Component
in ${next_package}.
-This means that one of the packages on the right hand side of
-Catalyst::Component in your Class' inheritance hierarchy defines a COMPONENT
-method.
-
-Previously, Catalyst's COMPONENT method would delegate to the method on the
-right hand side, which could then delegate back again with NEXT. This (as it
-is insane), is no longer supported, as it makes no sense with C3 method
-dispatch order.
-
-Therefore the correct fix is to re-arrange your class' inheritance hierarchy
-so that the COMPONENT method you would like to inherit is the first COMPONENT
-method in your @ISA.
+The correct fix is to re-arrange your class' inheritance hierarchy so that the
+COMPONENT method you would like to inherit is the first (left-hand most)
+COMPONENT method in your @ISA.
=head1 WARNINGS
=head2 Methods in Catalyst::Dispatcher
-The following methods in Catalyst::Dispatcher are both an implementation detail,
-and also likely to change significantly in the 5.8X release series, and therefore
-their use is highly deprecated.
+The following methods in Catalyst::Dispatcher are both an implementation
+detail, which may change in the 5.8X release series, and therefore their use
+is highly deprecated.
=over
The first time one of these methods is called, a warning will be emitted:
- Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,\n"
- . "this will be removed in Catalyst 5.9X"
+ Class $class is calling the deprecated method Catalyst::Dispatcher::$public_method_name,
+ this will be removed in Catalyst 5.9X
You should B<NEVER> be calling any of these methods from application code.
-Plugins authors and maintainers whos plugins currently call these methods
+Plugins authors and maintainers whose plugins currently call these methods
should change to using the public API, or, if you do not feel the public API
-adaquately supports your use-case, please email the development list to
+adequately supports your use-case, please email the development list to
discuss what API features you need so that you can be appropriately supported.
-=head2 require $class was successful but the package is not defined.
+=head2 Class naming to packages defined does not correspond.
In this version of Catalyst, if a component is loaded from disk, but no
-symbols are defined in that component's namespace after it is loaded, this
-warning will be issued.
+symbols are defined in that component's name space after it is loaded, this
+warning will be issued:
+
+ require $class was successful but the package is not defined.
-This is to protect against confusing bugs caused by mis-typing package names.
+This is to protect against confusing bugs caused by mis-typing package names,
+and will become a fatal error in a future version.
-This will become a fatal error in a future version.
+Please note that 'inner packages' (via L<Devel::InnerPackage>) are still fully
+supported, this warning is only issued when component file naming does not map
+to B<any> of the packages defined within that component.
=head2 $c->plugin method
deprecated>.
Instead you are recommended to use L< Catalyst::Model::Adaptor > or similar to
-compose the functionality you need outside of the main application namespace.
+compose the functionality you need outside of the main application name space.
+
+Calling the plugin method at runtime will not be supported past Catalyst 5.81.
=cut
);
ok( !$response->is_success, 'Response Fails' );
is( $response->content,
- q(FATAL ERROR: Couldn't go("TestApp"): Action has no namespace: cannot go() to a plain method or component, must be a :Action or some sort.),
+ q(FATAL ERROR: Couldn't go("TestApp"): Action has no namespace: cannot go() to a plain method or component, must be an :Action of some sort.),
'Error message'
);
}
ok( my $response = request('http://localhost/action/go/go_chained'), 'go to chained + subcontroller endpoint' );
is( $response->header('X-Catalyst-Executed'),
$expected, 'Executed actions' );
- is( $response->content, '; 1', 'Content OK' );
+ is( $response->content, 'arg1, arg2; captureme', 'Content OK' );
}
}
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 54 * $iters;
+use Test::More tests => 60 * $iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
);
ok( !$response->is_success, 'Response Fails' );
is( $response->content,
- q[FATAL ERROR: Couldn't visit("TestApp"): Action has no namespace: cannot visit() to a plain method or component, must be a :Action or some sort.],
+ q{FATAL ERROR: Couldn't visit("TestApp"): Action has no namespace: cannot visit() to a plain method or component, must be an :Action of some sort.},
"Cannot visit app namespace"
);
}
my $expected = join( ", ", @expected );
- ok( my $response = request('http://localhost/action/visit/visit_chained'), 'visit to chained + subcontroller endpoint' );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- is( $response->content, '; 1', 'Content OK' );
+ for my $i ( 1..3 ) {
+ ok( my $response = request("http://localhost/action/visit/visit_chained/$i/becomescapture/arg1/arg2"),
+ "visit to chained + subcontroller endpoint for $i" );
+ is( $response->header('X-Catalyst-Executed'),
+ $expected, "Executed actions for $i" );
+ is( $response->content, "arg1, arg2; becomescapture",
+ "Content OK for $i" );
+ }
}
}
ok( !$response->is_success, 'Response Not Successful' );
is( $response->header('X-Catalyst-Error'), 'Deep recursion detected calling "/recursion_test"', 'Deep Recursion Detected' );
}
+
use Test::More;
-plan tests => 28;
+plan tests => 29;
use_ok('TestApp');
# More Chained with Context Tests
#
{
- sub __action { shift->get_action_by_path( @_ ) }
-
- is( $context->uri_for( __action( $dispatcher, '/action/chained/endpoint2' ), [1,2], (3,4), { x => 5 } ),
+ is( $context->uri_for_action( '/action/chained/endpoint2', [1,2], (3,4), { x => 5 } ),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4?x=5',
- 'uri_for correct for chained with multiple captures and args' );
+ 'uri_for_action correct for chained with multiple captures and args' );
- is( $context->uri_for( __action( $dispatcher, '/action/chained/three_end' ), [1,2,3], (4,5,6) ),
+ is( $context->uri_for_action( '/action/chained/three_end', [1,2,3], (4,5,6) ),
'http://127.0.0.1/foo/chained/one/1/two/2/3/three/4/5/6',
- 'uri_for correct for chained with multiple capturing actions' );
+ 'uri_for_action correct for chained with multiple capturing actions' );
- my $action_needs_two = __action( $dispatcher, '/action/chained/endpoint2' );
+ my $action_needs_two = '/action/chained/endpoint2';
- ok( ! defined( $context->uri_for($action_needs_two, [1], (2,3)) ),
- 'uri_for returns undef for not enough captures' );
+ 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_needs_two, [1,2], (2,3)),
+ 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 returns correct uri for correct captures' );
+ 'uri_for_action returns correct uri for correct captures' );
- ok( ! defined( $context->uri_for($action_needs_two, [1,2,3], (2,3)) ),
- 'uri_for returns undef for too many 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_needs_two, [1,2], (3)),
+ 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 returns uri with lesser args than specified on action' );
+ 'uri_for_action returns uri with lesser args than specified on action' );
- is( $context->uri_for($action_needs_two, [1,2], (3,4,5)),
+ is( $context->uri_for_action($action_needs_two, [1,2], (3,4,5)),
'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/4/5',
- 'uri_for returns uri with more args than specified on action' );
+ 'uri_for_action returns uri with more args than specified on action' );
- is( $context->uri_for($action_needs_two, [1,''], (3,4)),
+ is( $context->uri_for_action($action_needs_two, [1,''], (3,4)),
'http://127.0.0.1/foo/chained/foo2/1//end2/3/4',
- 'uri_for returns uri with empty capture on undef capture' );
+ 'uri_for_action returns uri with empty capture on undef capture' );
- is( $context->uri_for($action_needs_two, [1,2], ('',3)),
+ 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 returns uri with empty arg on undef argument' );
+ 'uri_for_action returns uri with empty arg on undef argument' );
- is( $context->uri_for($action_needs_two, [1,2], (3,'')),
+ 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 returns uri with empty arg on undef last argument' );
+ 'uri_for_action returns uri with empty arg on undef last argument' );
- my $complex_chained = __action( $dispatcher, '/action/chained/empty_chain_f' );
- is( $context->uri_for( $complex_chained, [23], (13), {q => 3} ),
+ 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',
- 'uri_for returns correct uri for chain with many empty path parts' );
-}
+ 'uri_for_action returns correct uri for chain with many empty path parts' );
+ eval { $context->uri_for_action( '/does/not/exist' ) };
+ like $@, qr{^Can't find action for path '/does/not/exist'},
+ 'uri_for_action croaks on nonexistent path';
+
+}
use Catalyst::Test 'TestApp';
-eval q{
+eval q{
package TestApp::Controller::Action::Chained;
sub should_fail : Chained('/') Chained('foo') Args(0) {}
};
ok(!$@);
-eval { TestApp->setup_actions; };
+eval { TestApp->setup_actions; };
ok($@, 'Multiple chained attributes make action setup fail');
-eval q{
+eval q{
package TestApp::Controller::Action::Chained;
no warnings 'redefine';
sub should_fail {}
--- /dev/null
+#!perl
+
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More tests => 6;
+
+use Catalyst::Test 'TestApp';
+
+eval q{
+ package TestApp::Controller::Action::Chained;
+ sub should_fail : Chained('should_fail') Args(0) {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions; };
+like($@, qr|Actions cannot chain to themselves registering /action/chained/should_fail|,
+ 'Local self referencing attributes makes action setup fail');
+
+eval q{
+ package TestApp::Controller::Action::Chained;
+ no warnings 'redefine';
+ sub should_fail {}
+ use warnings 'redefine';
+ sub should_also_fail : Chained('/action/chained/should_also_fail') Args(0) {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions };
+like($@, qr|Actions cannot chain to themselves registering /action/chained/should_also_fail|,
+ 'Full path self referencing attributes makes action setup fail');
+
+eval q{
+ package TestApp::Controller::Action::Chained;
+ no warnings 'redefine';
+ sub should_also_fail {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions };
+ok(!$@, 'And ok again') or warn $@;
+
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+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
+ # DeprecatedTestApp
+ $SIG{__WARN__} = sub { $warnings++ if $_[0] =~ /trying to use NEXT/ };
+}
+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/ });
+ Catalyst->log($logger);
+}
+
+use Catalyst::Test 'DeprecatedTestApp';
+is( $mvc_warnings, 1, 'Get the ::MVC:: warning' );
+
+ok( my $response = request('http://localhost/'), 'Request' );
+is( $response->header('X-Catalyst-Plugin-Deprecated'), '1', 'NEXT plugin ran correctly' );
+
+SKIP: {
+ skip 'non-dev release', 1 unless Catalyst::_IS_DEVELOPMENT_VERSION();
+ is( $warnings, 1, 'Got one and only one Adopt::NEXT warning');
+}
--- /dev/null
+package Catalyst::Plugin::Test::Deprecated;
+
+use strict;
+use warnings;
+use NEXT;
+
+use base qw/Catalyst::Base/;
+
+sub prepare {
+ my $class = shift;
+ # Note: This use of NEXT is deliberately left here (without a use NEXT)
+ # to ensure back compat, as NEXT always used to be loaded, but
+ # is now replaced by Class::C3::Adopt::NEXT.
+ my $c = $class->NEXT::prepare(@_);
+ $c->response->header( 'X-Catalyst-Plugin-Deprecated' => 1 );
+
+ return $c;
+}
+
+1;
$c->ran_setup('1');
}
-sub prepare {
-
+sub prepare {
my $class = shift;
-# Note: This use of NEXT is deliberately left here (without a use NEXT)
-# to ensure back compat, as NEXT always used to be loaded, but
-# is now replaced by Class::C3::Adopt::NEXT.
- my $c = $class->NEXT::prepare(@_);
+ my $c = $class->next::method(@_);
$c->response->header( 'X-Catalyst-Plugin-Setup' => $c->ran_setup );
return $c;
-
}
# Note: This is horrible, but Catalyst::Plugin::Server forces the body to
--- /dev/null
+package DeprecatedTestApp;
+
+use strict;
+use Catalyst qw/
+ Test::Deprecated
+/;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->config( name => 'DeprecatedTestApp', root => '/some/dir' );
+
+__PACKAGE__->setup;
+
+1;
--- /dev/null
+package DeprecatedTestApp::C::Root;
+use strict;
+use warnings;
+use base qw/Catalyst::Controller/;
+
+__PACKAGE__->config->{namespace} = '';
+
+sub index : Private {
+ my ( $self, $c ) = @_;
+ $c->res->body('root index');
+}
+
+1;
$c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 );
}
-sub class_go_test_method :Private {
- my ( $self, $c ) = @_;
- $c->response->headers->header( 'X-Class-Go-Test-Method' => 1 );
-}
-
-sub class_visit_test_method :Private {
- my ( $self, $c ) = @_;
- $c->response->headers->header( 'X-Class-Visit-Test-Method' => 1 );
-}
-
sub loop_test : Local {
my ( $self, $c ) = @_;
#
# Simple parent/child action test
#
-sub foo :PathPart('chained/foo') :CaptureArgs(1) :Chained('/') { }
+sub foo :PathPart('chained/foo') :CaptureArgs(1) :Chained('/') {
+ my ( $self, $c, @args ) = @_;
+ die "missing argument" unless @args;
+ die "more than 1 argument" if @args > 1;
+}
sub endpoint :PathPart('end') :Chained('/action/chained/foo') :Args(1) { }
#
#
sub to_root : Chained('/') PathPart('action/chained/to_root') {
my ( $self, $c ) = @_;
- my $uri = $c->uri_for(
- $c->controller('Root')->action_for('chain_root_index') );
+ my $uri = $c->uri_for_action('/chain_root_index');
$c->res->body( "URI:$uri" );
$c->stash->{no_end}++;
}
sub go_chained : Local {
my ( $self, $c, $val ) = @_;
- $c->go('/action/chained/foo/spoon',[1]);
+ $c->go('/action/chained/foo/spoon', ['captureme'], [qw/arg1 arg2/]);
}
sub view : Local {
sub class_go_test_action : Local {
my ( $self, $c ) = @_;
- $c->go(qw/TestApp class_go_test_method/);
+ $c->go(qw/TestApp/);
}
1;
}
sub visit_chained : Local {
- my ( $self, $c, $val ) = @_;
- $c->visit('/action/chained/foo/spoon',[1]);
+ my ( $self, $c, $val, $capture, @args ) = @_;
+ my @cap_and_args = ([$capture], [@args]);
+ $val eq 1 ? $c->visit( '/action/chained/foo/spoon', @cap_and_args)
+ : $val eq 2 ? $c->visit( qw/ Action::Chained::Foo spoon /, @cap_and_args)
+ : $c->visit( $c->controller('Action::Chained::Foo')->action_for('spoon'), @cap_and_args)
}
sub view : Local {
sub class_visit_test_action : Local {
my ( $self, $c ) = @_;
- $c->visit(qw/TestApp class_visit_test_method/);
+ $c->visit(qw/TestApp/);
}
1;
use File::Spec;
use File::Path;
+use Test::MockObject;
+
my $libdir = 'test_trash';
unshift(@INC, $libdir);
write_component_file(\@dir_list, $name_final, <<EOF);
package $fullname;
-use Class::C3;
+use MRO::Compat;
use base '$compbase';
sub COMPONENT {
my \$self = shift->next::method(\@_);
$component->{name});
}
-eval "package $appclass; use Catalyst; __PACKAGE__->setup";
+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);
+};
+
+eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup";
can_ok( $appclass, 'components');
eval qq(
package $appclass;
use Catalyst;
+$shut_up_deprecated_warnings
__PACKAGE__->config->{ setup_components } = {
search_extra => [ '::Extra' ],
except => [ "${appclass}::Controller::Foo" ]
use strict;
use warnings;
+use Test::MockObject::Extends;
-use Test::More tests => 22;
+use Test::More tests => 24;
use lib 't/lib';
sub count { $count++ }
}
+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);
+
use Catalyst::Test qw/PluginTestApp/;
ok( get("/compile_time_plugins"), "get ok" );
+is( $warnings, 0, 'no warnings' );
# FIXME - Run time plugin support is insane, and should be removed
# for Catalyst 5.9
ok( get("/run_time_plugins"), "get ok" );
+is( $warnings, 1, '1 warning' );
+
use_ok 'TestApp';
my @expected = qw(
Catalyst::Plugin::Test::Errors
use strict;
use warnings;
-use Test::More;
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Test::More tests => 56;
use FindBin qw/$Bin/;
use lib "$Bin/lib";
use Catalyst::Utils;
use HTTP::Request::Common;
use Test::Exception;
-plan tests => 11;
+my $Class = 'Catalyst::Test';
+my $App = 'TestApp';
+my $Pkg = __PACKAGE__;
+my $Url = 'http://localhost/';
+my $Content = "root index";
-use_ok('Catalyst::Test');
+my %Meth = (
+ $Pkg => [qw|get request ctx_request|], # exported
+ $Class => [qw|local_request remote_request|], # not exported
+);
-eval "get('http://localhost')";
-isnt( $@, "", "get returns an error message with no app specified");
+### make sure we're not trying to connect to a remote host -- these are local tests
+local $ENV{CATALYST_SERVER};
-eval "request('http://localhost')";
-isnt( $@, "", "request returns an error message with no app specified");
+use_ok( $Class );
+
+### check available methods
+{ ### turn of redefine warnings, we'll get new subs exported
+ ### XXX 'no warnings' and 'local $^W' wont work as warnings are turned on in
+ ### test.pm, so trap them for now --kane
+ { local $SIG{__WARN__} = sub {};
+ ok( $Class->import, "Argumentless import for methods only" );
+ }
+
+ while( my($class, $meths) = each %Meth ) {
+ for my $meth ( @$meths ) { SKIP: {
+
+ ### method available?
+ can_ok( $class, $meth );
+
+ ### only for exported methods
+ skip "Error tests only for exported methods", 2 unless $class eq $Pkg;
+
+ ### check error conditions
+ eval { $class->can($meth)->( $Url ) };
+ ok( $@, " $meth without app gives error" );
+ like( $@, qr/$Class/,
+ " Error filled with expected content for '$meth'" );
+ } }
+ }
+}
+
+### simple tests for exported methods
+{ ### turn of redefine warnings, we'll get new subs exported
+ ### XXX 'no warnings' and 'local $^W' wont work as warnings are turned on in
+ ### test.pm, so trap them for now --kane
+ { local $SIG{__WARN__} = sub {};
+ ok( $Class->import( $App ),
+ "Loading $Class for App $App" );
+ }
+
+ ### test exported methods again
+ for my $meth ( @{ $Meth{$Pkg} } ) { SKIP: {
+
+ ### do a call, we should get a result and perhaps a $c if it's 'ctx_request';
+ my ($res, $c) = eval { $Pkg->can($meth)->( $Url ) };
+
+ ok( 1, " Called $Pkg->$meth( $Url )" );
+ ok( !$@, " No critical error $@" );
+ ok( $res, " Result obtained" );
+
+ ### get the content as a string, to make sure we got what we expected
+ my $res_as_string = $meth eq 'get' ? $res : $res->content;
+ is( $res_as_string, $Content,
+ " Content as expected: $res_as_string" );
+
+ ### some tests for 'ctx_request'
+ skip "Context tests skipped for '$meth'", 6 unless $meth eq 'ctx_request';
+
+ ok( $c, " Context object returned" );
+ isa_ok( $c, $App, " Object" );
+ is( $c->request->uri, $Url,
+ " Url recorded in request" );
+ is( $c->response->body, $Content,
+ " Content recorded in response" );
+ ok( $c->stash, " Stash accessible" );
+ ok( $c->action, " Action object accessible" );
+ } }
+}
# FIXME - These vhosts in tests tests should be somewhere else...
lives_ok {
request(GET('/dummy'), []);
} 'array additional param to request method ignored';
+
--- /dev/null
+use strict;
+use warnings;
+use Test::More tests => 4;
+
+use_ok('Catalyst::Response');
+
+my $res = Catalyst::Response->new;
+
+# test aliasing of res->code for res->status
+$res->code(500);
+is($res->code, 500, 'code sets itself');
+is($res->status, 500, 'code sets status');
+$res->status(501);
+is($res->code, 501, 'status sets code');
projects / catagits/Catalyst-Runtime.git / commitdiff