# This file documents the revision history for Perl extension Catalyst.
-5.7099_03 2008-07-20 10:10:00
- - Fix regressions for regexp fallback in model(), view() and controller()
- - Added the supplied argument to the regexp fallback warning for easier
- debugging
- - Ensure ACCEPT_CONTEXT is called for results from component()
-
-5.7099_02 2008-07-16 19:10:00
- - Added PathPrefix attribute
- - Removed Catalyst::Build; we've long since moved to Module::Install
- - Updated Catalyst::Test docs to mention the use of HTTP::Request
- objects (Rafael Kitover)
-
-5.7099_01 2008-06-25 22:36:00
+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
- 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
an undef value (RT #34782)
- - Added $c->go, to do an internal redispatch to another action, while retaining the
- contents of the stash
5.7014 2008-05-25 15:26:00
- Addition of .conf in restart regex in Catalyst::Engine::HTTP::Restarter::Watcher
-use inc::Module::Install 0.64;
+use inc::Module::Install 0.87;
perl_version '5.008001';
our $START = time;
our $RECURSION = 1000;
our $DETACH = "catalyst_detach\n";
-our $GO = "catalyst_go\n";
__PACKAGE__->mk_classdata($_)
for qw/components arguments dispatcher engine log dispatcher_class
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.7099_03';
+our $VERSION = '5.7014';
sub import {
my ( $class, @arguments ) = @_;
sub detach { my $c = shift; $c->dispatcher->detach( $c, @_ ) }
-=head2 $c->go( $action [, \@arguments ] )
-
-=head2 $c->go( $class, $method, [, \@arguments ] )
-
-Almost the same as C<detach>, but does a full dispatch, instead of just
-calling the new C<$action> / C<$class-E<gt>$method>. This means that C<begin>,
-C<auto> and the method you go to is called, just like a new request.
-
-C<$c-E<gt>stash> is kept unchanged.
-
-=cut
-
-sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) }
-
=head2 $c->response
=head2 $c->res
# regexp fallback
$query = qr/$name/i;
- @result = map { $c->components->{ $_ } } 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 { $eligible{ $_ } =~ m{$query} } keys %eligible;
# don't warn if we didn't find any results, it just might not exist
if( @result ) {
- $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
$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.' );
}
Any extra arguments are directly passed to ACCEPT_CONTEXT.
If the name is omitted, it will look for
- - a model object in $c->stash->{current_model_instance}, then
+ - a model object in $c->stash{current_model_instance}, then
- a model name in $c->stash->{current_model}, then
- a config setting 'default_model', or
- check if there is only one model, and return it if that's the case.
Any extra arguments are directly passed to ACCEPT_CONTEXT.
If the name is omitted, it will look for
- - a view object in $c->stash->{current_view_instance}, then
+ - a view object in $c->stash{current_view_instance}, then
- a view name in $c->stash->{current_view}, then
- a config setting 'default_view', or
- check if there is only one view, and return it if that's the case.
if( !ref $name ) {
# is it the exact name?
- return $c->_filter_component( $comps->{ $name }, @args )
- if exists $comps->{ $name };
+ return $comps->{ $name } if exists $comps->{ $name };
# perhaps we just omitted "MyApp"?
my $composed = ( ref $c || $c ) . "::${name}";
- return $c->_filter_component( $comps->{ $composed }, @args )
- if exists $comps->{ $composed };
+ return $comps->{ $composed } if exists $comps->{ $composed };
# search all of the models, views and controllers
my( $comp ) = $c->_comp_search_prefixes( $name, qw/Model M Controller C View V/ );
my $query = ref $name ? $name : qr{$name}i;
my @result = grep { m{$query} } keys %{ $c->components };
- return map { $c->_filter_component( $_, @args ) } @result if ref $name;
+ return @result if ref $name;
if( $result[ 0 ] ) {
- $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
$c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
$c->log->warn( 'is unreliable and unsafe. You have been warned' );
- return $c->_filter_component( $result[ 0 ], @args );
+ return $result[ 0 ];
}
# I would expect to return an empty list here, but that breaks back-compat
my $last = pop( @{ $c->stack } );
if ( my $error = $@ ) {
- if ( !ref($error) and $error eq $DETACH ) {
- die $DETACH if($c->depth > 1);
- }
- elsif ( !ref($error) and $error eq $GO ) {
- die $GO if($c->depth > 0);
- }
+ if ( !ref($error) and $error eq $DETACH ) { die $DETACH if $c->depth > 1 }
else {
unless ( ref $error ) {
no warnings 'uninitialized';
reference. Items in the array beginning with C<::> will have the
application class name prepended to them.
-All components found will also have any
-L<Devel::InnerPackage|inner packages> loaded and set up as components.
-Note, that modules which are B<not> an I<inner package> of the main
-file namespace loaded will not be instantiated as components.
-
=cut
sub setup_components {
=head2 L<Catalyst::Test> - The test suite.
-=head1 PROJECT FOUNDER
-
-sri: Sebastian Riedel <sri@cpan.org>
+=head1 CREDITS
-=head1 CONTRIBUTORS
+Andy Grundman
-abw: Andy Wardley
+Andy Wardley
-acme: Leon Brocard <leon@astray.com>
+Andreas Marienborg
Andrew Bramble
Andrew Ruthven
-andyg: Andy Grundman <andy@hybridized.org>
+Arthur Bergman
-audreyt: Audrey Tang
+Autrijus Tang
-bricas: Brian Cassidy <bricas@cpan.org>
+Brian Cassidy
-chansen: Christian Hansen
+Carl Franks
-chicks: Christopher Hicks
+Christian Hansen
-dkubb: Dan Kubb <dan.kubb-cpan@onautopilot.com>
+Christopher Hicks
-Drew Taylor
+Dan Sully
-esskar: Sascha Kiefer
+Danijel Milicevic
-fireartist: Carl Franks <cfranks@cpan.org>
+David Kamholz
-gabb: Danijel Milicevic
+David Naughton
+
+Drew Taylor
Gary Ashton Jones
Geoff Richards
-jcamacho: Juan Camacho
+Jesse Sheidlower
+
+Jesse Vincent
Jody Belka
Johan Lindstrom
-jon: Jon Schutz <jjschutz@cpan.org>
+Juan Camacho
-marcus: Marcus Ramberg <mramberg@cpan.org>
+Leon Brocard
-miyagawa: Tatsuhiko Miyagawa <miyagawa@bulknews.net>
+Marcus Ramberg
-mst: Matt S. Trout <mst@shadowcatsystems.co.uk>
+Matt S Trout
-mugwump: Sam Vilain
+Robert Sedlacek
-naughton: David Naughton
+Sam Vilain
-ningu: David Kamholz <dkamholz@cpan.org>
+Sascha Kiefer
-nothingmuch: Yuval Kogman <nothingmuch@woobling.org>
+Sebastian Willert
-numa: Dan Sully <daniel@cpan.org>
+Tatsuhiko Miyagawa
-obra: Jesse Vincent
-
-omega: Andreas Marienborg
-
-phaylon: Robert Sedlacek <phaylon@dunkelheit.at>
-
-sky: Arthur Bergman
+Ulf Edvinsson
-the_jester: Jesse Sheidlower
+Yuval Kogman
-Ulf Edvinsson
+=head1 AUTHOR
-willert: Sebastian Willert <willert@cpan.org>
+Sebastian Riedel, C<sri@oook.de>
=head1 LICENSE
returns the sub name of this action.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S. Trout
=head1 COPYRIGHT
Takes a list of Catalyst::Action objects and constructs and returns a
Catalyst::ActionChain object representing a chain of these actions
-=head1 AUTHORS
+=cut
+
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S. Trout
=head1 COPYRIGHT
Accessor to the path part this container resolves to. Also what the container
stringifies to.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S. Trout
=head1 COPYRIGHT
=head1 NAME
-Catalyst::AttrContainer - Handles code attribute storage and caching
+Catalyst::AttrContainer
=head1 SYNOPSIS
L<Catalyst::Dispatcher>
L<Catalyst>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Marcus Ramberg, C<mramberg@cpan.org>
=head1 COPYRIGHT
L<Catalyst>, L<Catalyst::Controller>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Marcus Ramberg, C<mramberg@cpan.org>
+Matt S Trout, C<mst@shadowcatsystems.co.uk>
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
-=cut
+=cut
\ No newline at end of file
--- /dev/null
+package Catalyst::Build;
+
+use strict;
+use Module::Build;
+use Path::Class;
+use File::Find 'find';
+
+our @ISA;
+eval "require Module::Build";
+die "Please install Module::Build\n" if $@;
+push @ISA, 'Module::Build';
+
+our @ignore =
+ qw/Build Build.PL Changes MANIFEST META.yml Makefile.PL Makefile README
+ _build blib lib script t/;
+
+our $FAKE;
+our $ignore = '^(' . join( '|', @ignore ) . ')$';
+
+=head1 NAME
+
+Catalyst::Build - Module::Build extension for Catalyst
+
+=head1 SYNOPSIS
+
+See L<Catalyst>
+
+=head1 DESCRIPTION
+
+L<Module::Build> extension for Catalyst.
+
+=head1 DEPRECATION NOTICE
+
+This module is deprecated in favor of L<Module::Install::Catalyst>. It's
+only left here for compability with older applications.
+
+=head1 METHODS
+
+=over 4
+
+=item new
+
+=cut
+
+sub new {
+ my $class = shift;
+ my $self = $class->SUPER::new(@_);
+
+ my $app_name = $self->{properties}{module_name};
+ warn <<"EOF";
+
+ Note:
+
+ The use of Build.PL for building and distributing Catalyst
+ applications is deprecated in Catalyst 5.58.
+
+ We recommend using the new Module::Install-based Makefile
+ system. You can generate a new Makefile.PL for your application
+ by running:
+
+ catalyst.pl -force -makefile $app_name
+
+EOF
+
+ return $self;
+}
+
+=item ACTION_install
+
+=cut
+
+sub ACTION_install {
+ my $self = shift;
+ $self->SUPER::ACTION_install;
+ $self->ACTION_install_extras;
+}
+
+=item ACTION_fakeinstall
+
+=cut
+
+sub ACTION_fakeinstall {
+ my $self = shift;
+ $self->SUPER::ACTION_fakeinstall;
+ local $FAKE = 1;
+ $self->ACTION_install_extras;
+}
+
+=item ACTION_install_extras
+
+=cut
+
+sub ACTION_install_extras {
+ my $self = shift;
+ my $prefix = $self->{properties}{destdir} || undef;
+ my $sitelib = $self->install_destination('lib');
+ my @path = defined $prefix ? ( $prefix, $sitelib ) : ($sitelib);
+ my $path = dir( @path, split( '::', $self->{properties}{module_name} ) );
+ my @files = $self->_find_extras;
+ print "Installing extras to $path\n";
+ for (@files) {
+ $FAKE
+ ? print "$_ -> $path (FAKE)\n"
+ : $self->copy_if_modified( $_, $path );
+ }
+}
+
+sub _find_extras {
+ my $self = shift;
+ my @all = glob '*';
+ my @files;
+ for my $file (@all) {
+ next if $file =~ /$ignore/;
+ if ( -d $file ) {
+ find(
+ sub {
+ return if -d;
+ push @files, $File::Find::name;
+ },
+ $file
+ );
+ }
+ else { push @files, $file }
+ }
+ return @files;
+}
+
+=back
+
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>
+
+=head1 LICENSE
+
+This library is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
+
+1;
L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Marcus Ramberg, C<mramberg@cpan.org>
+Matt S Trout, C<mst@shadowcatsystems.co.uk>
=head1 COPYRIGHT
sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
-sub _parse_PathPrefix_attr {
- my $self = shift;
- return PathPart => $self->path_prefix;
-}
-
sub _parse_ActionClass_attr {
my ( $self, $c, $name, $value ) = @_;
unless ( $value =~ s/^\+// ) {
=head2 $self->path_prefix($c)
-Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
-relative :Path actions in this component. Defaults to the action_namespace or
+Returns the default path prefix for :Local, :LocalRegex and relative
+:Path actions in this component. Defaults to the action_namespace or
can be overridden from the "path" config key.
=head2 $self->create_action(%args)
Returns the application instance stored by C<new()>
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@oook.de>
+Marcus Ramberg C<mramberg@cpan.org>
=head1 COPYRIGHT
sub uri_for_action { }
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S Trout
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
you C<detach> out of a chain, the rest of the chain will not get called
after the C<detach>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S Trout <mst@shadowcatsystems.co.uk>
=head1 COPYRIGHT
return 0;
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S Trout
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
return "/".$action->namespace;
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
}
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S Trout
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
return undef;
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Matt S Trout
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
}
}
-# $self->_command2action( $c, $command [, \@arguments ] )
-# Search for an action, from the command and returns C<($action, $args)> on
-# success. Returns C<(0)> on error.
+=head2 $self->forward( $c, $command [, \@arguments ] )
+
+Documented in L<Catalyst>
+
+=cut
-sub _command2action {
+sub forward {
my ( $self, $c, $command, @extra_params ) = @_;
unless ($command) {
- $c->log->debug('Nothing to go to') if $c->debug;
+ $c->log->debug('Nothing to forward to') if $c->debug;
return 0;
}
if ( ref( $extra_params[-1] ) eq 'ARRAY' ) {
@args = @{ pop @extra_params }
} else {
- # this is a copy, it may take some abuse from
- # ->_invoke_as_path if the path had trailing parts
+ # this is a copy, it may take some abuse from ->_invoke_as_path if the path had trailing parts
@args = @{ $c->request->arguments };
}
my $action;
- # go to a string path ("/foo/bar/gorch")
- # or action object which stringifies to that
+ # forward to a string path ("/foo/bar/gorch") or action object which stringifies to that
$action = $self->_invoke_as_path( $c, "$command", \@args );
- # go to a component ( "MyApp::*::Foo" or $c->component("...")
- # - a path or an object)
+ # forward to a component ( "MyApp::*::Foo" or $c->component("...") - a path or an object)
unless ($action) {
my $method = @extra_params ? $extra_params[0] : "process";
$action = $self->_invoke_as_component( $c, $command, $method );
}
- return $action, \@args;
-}
-
-=head2 $self->go( $c, $command [, \@arguments ] )
-
-Documented in L<Catalyst>
-
-=cut
-
-sub go {
- my $self = shift;
- my ( $c, $command ) = @_;
- my ( $action, $args ) = $self->_command2action(@_);
-
- unless ($action) {
- my $error =
- qq/Couldn't go to command "$command": /
- . qq/Invalid action or component./;
- $c->error($error);
- $c->log->debug($error) if $c->debug;
- return 0;
- }
-
- local $c->request->{arguments} = $args;
- $c->namespace($action->namespace);
- $c->action($action);
- $self->dispatch($c);
-
- die $Catalyst::GO;
-}
-
-=head2 $self->forward( $c, $command [, \@arguments ] )
-
-Documented in L<Catalyst>
-
-=cut
-
-sub forward {
- my $self = shift;
- my ( $c, $command ) = @_;
- my ( $action, $args ) = $self->_command2action(@_);
unless ($action) {
my $error =
return 0;
}
- local $c->request->{arguments} = $args;
+ #push @$args, @_;
+
+ local $c->request->{arguments} = \@args;
$action->dispatch( $c );
return $c->state;
return @loaded;
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Matt S Trout, C<mst@shadowcatsystems.co.uk>
=head1 COPYRIGHT
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Andy Grundman, <andy@hybridized.org>
=head1 COPYRIGHT
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>
+L<Catalyst> L<Catalyst::Engine>.
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Christian Hansen, <ch@ngmedia.com>
+
+Andy Grundman, <andy@hybridized.org>
=head1 COPYRIGHT
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Christian Hansen, <ch@ngmedia.com>
+
+Andy Grundman, <andy@hybridized.org>
=head1 THANKS
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>
+L<Catalyst>, L<Catalyst::Engine>.
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Dan Kubb, <dan.kubb-cpan@onautopilot.com>
+
+Sascha Kiefer, <esskar@cpan.org>
+
+Andy Grundman, <andy@hybridized.org>
=head1 THANKS
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Dan Kubb, <dan.kubb-cpan@onautopilot.com>
+
+Andy Grundman, <andy@hybridized.org>
=head1 THANKS
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, <sri@cpan.org>
+
+Andy Grundman, <andy@hybridized.org>
=head1 THANKS
Carp::croak($message);
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
=head1 COPYRIGHT
L<Catalyst>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Marcus Ramberg, C<mramberg@cpan.org>
+Christian Hansen, C<ch@ngmedia.com>
=head1 COPYRIGHT
http://lists.rawmode.org/mailman/listinfo/catalyst
http://lists.rawmode.org/mailman/listinfo/catalyst-dev
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@oook.de>
+Jesse Sheidlower, C<jester@panix.com>
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it
under the same terms as Perl itself.
-
-=cut
Implements the same methods as other Catalyst components, see
L<Catalyst::Component>
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@oook.de>
=head1 COPYRIGHT
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+
+Marcus Ramberg, C<mramberg@cpan.org>
=head1 COPYRIGHT
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+
+Christian Hansen, C<ch@ngmedia.com>
=head1 COPYRIGHT
=head2 $res->redirect( $url, $status )
-Causes the response to redirect to the specified URL. The default status is
-C<302>.
+Causes the response to redirect to the specified URL.
$c->response->redirect( 'http://slashdot.org' );
$c->response->redirect( 'http://slashdot.org', 307 );
=head1 AUTHORS
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+
+Marcus Ramberg, C<mramberg@cpan.org>
=head1 COPYRIGHT
# Remember to update this in Catalyst as well!
-our $VERSION='5.7099_03';
-
-$VERSION= eval $VERSION;
+our $VERSION='5.7014';
=head1 NAME
This is the primary class for the Catalyst-Runtime distribution, version 5.70.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+The Catalyst Core Team - see http://catalyst.perl.org/
=head1 COPYRIGHT
=head1 SEE ALSO
-L<Catalyst>
+L<Catalyst>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Jon Schutz
=head1 COPYRIGHT
request('index.html');
get('index.html');
- use HTTP::Request::Common;
- my $response = request POST '/foo', [
- bar => 'baz',
- something => 'else'
- ];
-
# Run tests against a remote server
CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/
=head1 DESCRIPTION
-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.
-
-The </get> and </request> functions take either a URI or an L<HTTP::Request>
-object.
+Test Catalyst Applications.
=head2 METHODS
=head2 local_request
-Simulate a request using L<HTTP::Request::AsCGI>.
-
=cut
sub local_request {
=head1 SEE ALSO
-L<Catalyst>, L<Test::WWW::Mechanize::Catalyst>,
-L<Test::WWW::Selenium::Catalyst>, L<Test::More>, L<HTTP::Request::Common>
+L<Catalyst>.
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
=head1 COPYRIGHT
return;
}
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@cpan.org>
+Yuval Kogman, C<nothingmuch@woobling.org>
=head1 COPYRIGHT
=cut
-=head1 AUTHORS
+=head1 AUTHOR
-Catalyst Contributors, see Catalyst.pm
+Sebastian Riedel, C<sri@oook.de>
+Marcus Ramberg, C<mramberg@cpan.org>
=head1 COPYRIGHT
=back
+
The application module generated by the C<catalyst.pl> script is functional,
although it reacts to all requests by outputting a friendly welcome screen.
+
=head1 NOTE
Neither C<catalyst.pl> nor the generated helper script will overwrite existing
changed the generated code (although you do of course have all your code in a
version control system anyway, don't you ...).
+
+
=head1 SEE ALSO
L<Catalyst::Manual>, L<Catalyst::Manual::Intro>
-=head1 AUTHORS
+=head1 AUTHOR
+
+Sebastian Riedel, C<sri@oook.de>,
+Andrew Ford, C<A.Ford@ford-mason.co.uk>
-Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
+Copyright 2004-2005 Sebastian Riedel. All rights reserved.
+
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
$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 loop_test : Local {
my ( $self, $c ) = @_;
use base qw/Catalyst::Base Class::Data::Inheritable/;
-1;
+1;
\ No newline at end of file
+++ /dev/null
-package TestApp::Controller::Action::Chained::PathPrefix;
-
-use strict;
-use warnings;
-
-use base qw/Catalyst::Controller/;
-
-# this is kinda the same thing as: sub instance : Path {}
-# it should respond to: /action/chained/pathprefix/*
-sub instance : Chained('/') PathPrefix Args(1) { }
-
-1;
+++ /dev/null
-package TestApp::Controller::Action::Go;
-
-use strict;
-use base 'TestApp::Controller::Action';
-
-sub one : Local {
- my ( $self, $c ) = @_;
- $c->go('two');
-}
-
-sub two : Private {
- my ( $self, $c ) = @_;
- $c->go('three');
-}
-
-sub three : Local {
- my ( $self, $c ) = @_;
- $c->go( $self, 'four' );
-}
-
-sub four : Private {
- my ( $self, $c ) = @_;
- $c->go('/action/go/five');
-}
-
-sub five : Local {
- my ( $self, $c ) = @_;
- $c->go('View::Dump::Request');
-}
-
-sub inheritance : Local {
- my ( $self, $c ) = @_;
- $c->go('/action/inheritance/a/b/default');
-}
-
-sub global : Local {
- my ( $self, $c ) = @_;
- $c->go('/global_action');
-}
-
-sub with_args : Local {
- my ( $self, $c, $arg ) = @_;
- $c->go( 'args', [$arg] );
-}
-
-sub with_method_and_args : Local {
- my ( $self, $c, $arg ) = @_;
- $c->go( qw/TestApp::Controller::Action::Go args/, [$arg] );
-}
-
-sub args : Local {
- my ( $self, $c, $val ) = @_;
- die "passed argument does not match args" unless $val eq $c->req->args->[0];
- $c->res->body($val);
-}
-
-sub go_die : Local {
- my ( $self, $c, $val ) = @_;
- eval { $c->go( 'args', [qq/new/] ) };
- $c->res->body( $@ ? $@ : "go() did not die" );
- die $Catalyst::GO;
-}
-
-sub args_embed_relative : Local {
- my ( $self, $c ) = @_;
- $c->go('embed/ok');
-}
-
-sub args_embed_absolute : Local {
- my ( $self, $c ) = @_;
- $c->go('/action/go/embed/ok');
-}
-
-sub embed : Local {
- my ( $self, $c, $ok ) = @_;
- $ok ||= 'not ok';
- $c->res->body($ok);
-}
-
-sub class_go_test_action : Local {
- my ( $self, $c ) = @_;
- $c->go(qw/TestApp class_go_test_method/);
-}
-
-1;
$c->forward( 'TestApp::Controller::Action::Forward', 'one' );
}
-sub relative_go : Local {
- my ( $self, $c ) = @_;
- $c->go('/action/go/one');
-}
-
-sub relative_go_two : Local {
- my ( $self, $c ) = @_;
- $c->go( 'TestApp::Controller::Action::Go', 'one' );
-}
1;
use strict;
use base 'Catalyst::Base';
+use Data::Dumper;
sub args :Local {
my ( $self, $c ) = @_;
$c->res->body( join('',@_) );
}
-1;
+1;
\ No newline at end of file
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 127*$iters;
+use Test::More tests => 124*$iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
}
- #
- # PathPrefix
- #
- {
- my @expected = qw[
- TestApp::Controller::Action::Chained->begin
- TestApp::Controller::Action::Chained::PathPrefix->instance
- TestApp::Controller::Action::Chained->end
- ];
-
- my $expected = join( ", ", @expected );
-
- ok( my $response = request('http://localhost/action/chained/pathprefix/1'),
- "PathPrefix (as an endpoint)" );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- is( $response->content, '; 1', 'Content OK' );
- }
-
}
+++ /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 => 47 * $iters;
-use Catalyst::Test 'TestApp';
-
-if ( $ENV{CAT_BENCHMARK} ) {
- require Benchmark;
- Benchmark::timethis( $iters, \&run_tests );
-}
-else {
- for ( 1 .. $iters ) {
- run_tests();
- }
-}
-
-sub run_tests {
- {
- my @expected = qw[
- TestApp::Controller::Action::Go->one
- TestApp::Controller::Action::Go->two
- TestApp::Controller::Action::Go->three
- TestApp::Controller::Action::Go->four
- TestApp::Controller::Action::Go->five
- TestApp::View::Dump::Request->process
- TestApp->end
- ];
-
- @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
- my $expected = join( ", ", @expected );
-
- # Test go to global private action
- ok( my $response = request('http://localhost/action/go/global'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- 'action/go/global', 'Main Class Action' );
-
- # Test go to chain of actions.
- ok( $response = request('http://localhost/action/go/one'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- 'action/go/one', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Go',
- 'Test Class'
- );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- {
- my @expected = qw[
- TestApp::Controller::Action::Go->go_die
- TestApp::Controller::Action::Go->args
- TestApp->end
- ];
-
- @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
- my $expected = join( ", ", @expected );
-
- ok( my $response = request('http://localhost/action/go/go_die'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- 'action/go/go_die', 'Test Action'
- );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Go',
- 'Test Class'
- );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- is( $response->content, $Catalyst::GO, "Go died as expected" );
- }
-
- {
- ok(
- my $response =
- request('http://localhost/action/go/with_args/old'),
- 'Request with args'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'old' );
- }
-
- {
- ok(
- my $response = request(
- 'http://localhost/action/go/with_method_and_args/new'),
- 'Request with args and method'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'new' );
- }
-
- # test go with embedded args
- {
- ok(
- my $response =
- request('http://localhost/action/go/args_embed_relative'),
- 'Request'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'ok' );
- }
-
- {
- ok(
- my $response =
- request('http://localhost/action/go/args_embed_absolute'),
- 'Request'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'ok' );
- }
- {
- my @expected = qw[
- TestApp::Controller::Action::TestRelative->relative_go
- TestApp::Controller::Action::Go->one
- TestApp::Controller::Action::Go->two
- TestApp::Controller::Action::Go->three
- TestApp::Controller::Action::Go->four
- TestApp::Controller::Action::Go->five
- TestApp::View::Dump::Request->process
- TestApp->end
- ];
-
- @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
- my $expected = join( ", ", @expected );
-
- # Test go to chain of actions.
- ok( my $response = request('http://localhost/action/relative/relative_go'),
- 'Request' );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is( $response->header('X-Catalyst-Action'),
- 'action/relative/relative_go', 'Test Action' );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Go',
- 'Test Class'
- );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
- {
- my @expected = qw[
- TestApp::Controller::Action::TestRelative->relative_go_two
- TestApp::Controller::Action::Go->one
- TestApp::Controller::Action::Go->two
- TestApp::Controller::Action::Go->three
- TestApp::Controller::Action::Go->four
- TestApp::Controller::Action::Go->five
- TestApp::View::Dump::Request->process
- TestApp->end
- ];
-
- @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected;
- my $expected = join( ", ", @expected );
-
- # Test go to chain of actions.
- ok(
- my $response =
- request('http://localhost/action/relative/relative_go_two'),
- 'Request'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content_type, 'text/plain', 'Response Content-Type' );
- is(
- $response->header('X-Catalyst-Action'),
- 'action/relative/relative_go_two',
- 'Test Action'
- );
- is(
- $response->header('X-Test-Class'),
- 'TestApp::Controller::Action::Go',
- 'Test Class'
- );
- is( $response->header('X-Catalyst-Executed'),
- $expected, 'Executed actions' );
- like(
- $response->content,
- qr/^bless\( .* 'Catalyst::Request' \)$/s,
- 'Content is a serialized Catalyst::Request'
- );
- }
-
- # test class go
- {
- ok(
- my $response = request(
- 'http://localhost/action/go/class_go_test_action'),
- 'Request'
- );
- ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->header('X-Class-Go-Test-Method'), 1,
- 'Test Method' );
- }
-
-}
-
-sub _begin {
- local $_ = shift;
- s/->(.*)$/->begin/;
- return $_;
-}
-
use Test::More tests => 28;
use Catalyst::Test 'TestApp';
+use Data::Dumper;
local $^W = 0;
-use Test::More tests => 22;
+use Test::More tests => 11;
use strict;
use warnings;
is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part 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?
# regexp behavior
{
is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' );
- is_deeply( [ MyApp->comp('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
- is_deeply( [ MyApp->comp('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
- is_deeply( [ MyApp->comp('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
-
- # a couple other varieties for regexp fallback
- is_deeply( [ MyApp->comp('M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
-
- {
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- is_deeply( [ MyApp->comp('::M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
- ok( $warnings, 'regexp fallback warnings' );
-
- $warnings = 0;
- is_deeply( [ MyApp->comp('Mode') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
- ok( $warnings, 'regexp fallback warnings' );
-
- $warnings = 0;
- is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
- ok( $warnings, 'regexp fallback for comp() warns' );
- }
-
}
# multiple returns
is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' );
}
-
-#checking @args passed to ACCEPT_CONTEXT
-{
- my $args;
-
- no warnings;
- *MyApp::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
-
- MyApp->component('MyApp::M::Model', qw/foo bar/);
- is_deeply($args, [qw/foo bar/], 'args passed to ACCEPT_CONTEXT ok');
-
- MyApp->component('M::Model', qw/foo2 bar2/);
- is_deeply($args, [qw/foo2 bar2/], 'args passed to ACCEPT_CONTEXT ok');
-
- MyApp->component('Mode', qw/foo3 bar3/);
- is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
-}
-
-use Test::More tests => 44;
+use Test::More tests => 37;
use strict;
use warnings;
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' );
-
- # object w/ qr{}
- is_deeply( [ MyApp->model( qr{Test} ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
-
- {
- my $warnings = 0;
- no warnings 'redefine';
- local *Catalyst::Log::warn = sub { $warnings++ };
-
- # object w/ regexp fallback
- is_deeply( [ MyApp->model( 'Test' ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
- ok( $warnings, 'regexp fallback warnings' );
- }
-
- is_deeply( [ MyApp->view('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
- is_deeply( [ MyApp->controller('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
- is_deeply( [ MyApp->model('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
}
{
}
#checking @args passed to ACCEPT_CONTEXT
+my $args;
{
- my $args;
-
no warnings;
*MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
*MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+}
+MyApp->model('M', qw/foo bar/);
+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');
- MyApp->model('M', qw/foo bar/);
- is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
-
- my $x = MyApp->view('V', qw/foo2 bar2/);
- is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok');
-
- # regexp fallback
- MyApp->view('::View::V', qw/foo3 bar3/);
- is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok');
-}