Catalyst-Runtime-5.90053/000755 000765 000024 00000000000 12255610005 015201 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/Changes000644 000765 000024 00000334466 12255600725 016524 0ustar00johnstaff000000 000000 # This file documents the revision history for Perl extension Catalyst. 5.90053 - 2013-12-21 - Reverted a change in the previous release that moved the setup_log phase to after setup_config. This change was made to allow people to use configuration that is late loaded (such as via the ConfigLoader Plugin) to setup the plugin. However it also broke the ability to use the log during plugin setup (ie, it breaks lots of plugins). Reverting the change. See Catalyst::Delta for workarounds. 5.90052 - 2013-12-18 - Fixed first block of startup debug messages missing when using a custom logger that gets set at runtime, for example by overriding finalize_config - Give a more descriptive error message when trying to load middleware that does not exist. - Change the way we initialize plugins to fix a bug where when using the populare ConfigLoader plugin, configs merged are not available for setting up middleware and data handlers (and probably other things as well). NOTE: This change might cause issues if you had code that was relying on the broken behavior. For example external configuration that was being loaded to late to have effect might now take effect. Please test you code carefully and be aware of this possible issue . - You may now also call 'setup_middleware' as a package method if you think that loading middleware via configuration is a weird or broken idea. - Various POD formating fixed. - Improved some documentation about what type of filehandles that ->body can accept and issues that might arise. 5.90051 - 2013-11-06 - Be more skeptical of the existance of $request->env to fix a regression introduced in Catalyst::Action::REST by the previous release 5.90050 - 2013-11-05 - Previously public predicates on the following attributes are now considered private and their method names have been changed to follow Perl convention for internal methods: -- Catalyst::Request->has_io_fh ==> _has_io_fh -- Catalyst::Request->has_env ==> _has_env -- Catalyst::Response->has_write_fh ==> _has_write_fh These are breaking changes but these methods were never documented and serve no use for external code. If you are using thing, you need to make the noted change (but please consider finding another way to do what you are trying to do). t0m++ for code review of Hamburg branch. 5.90049_006 - 2013-11-04 - Fixed case where test could fail when Starman was partly installed (n0body++) - Fixed missing date information in previous release 5.90049_005 - 2013-10-31 - NEW FEATURE: New Controller action attribute 'Consumes', which allows you to specify the content type of the incoming request. This makes it easier to create actions that only handle certain content type POST or PUT, such as actions that only handle JSON or actions that only understand classic HTML forms. - NEW FEATURE: Request->body_data is now also populated from classic HTML Forms using CGI::Struct to support nested data. For non nested data you should use the classic ->body_parameters method. - Removed PSGI $env keys that are added on the 'plack.request.*' namespace since after discussion it was clear those keys are not part of the public API. Keys removed: 'plack.request.query', 'plack.request.body', 'plack.request.merged' and 'plack.request.http.body'. Altered some test cases to reflect this change. 5.90049_004 - 2013-10-18 - JSON Data handler looks for both JSON::MaybeXS and JSON, and uses whichever is first (prefering to find JSON::MaybeXS). This should improve compatibility as you likely already have one installed. - Fixed a warning in the server script (bokutin++) - We now populate various Plack $env keys in order to play nice with downstream middleware or plack apps (and to reduce processing if those keys already exist). Keys added: - plack.request.query - plack.request.body - plack.request.merged - plack.request.http.body (NOTE: REMOVED IN 5.90049_005) - If incoming input (from a POST or PUT) is not buffered, create the buffer and set the correct psgi env keys to note this for downstream psgi apps / middleware. This should solve some issues where Catalyst sucks up the body input but its not buffered so downstream apps can't read it (for example FCGI does not buffer). We now also try to make sure the body content input is reset to the start of the filehandle so that we are polite to downstream middleware /apps. - NEW FEATURE: Catalyst::Response can now pull response from a PSGI specification response. This makes it easier to host external Plack applications under Catalyst. See Catalyst::Response->from_psgi_response - NEW FEATURE: New configuration option 'use_hash_multivalue_in_request' will populate $request methods 'parameters', 'body_parameters' and 'query_parameters' with an instance of Hash::MultiValue instead of a HashRef. This is used by Plack and is intended to reduce the need to write defensive logic since you are never sure if an incoming parameter is a scalar or arrayref. - NEW FEATURE: We now experimentally support Net::Async::HTTP::Server and IO-Async based event loops. Examples will follow. 5.90049_003 - 2013-09-20 - Documented the new body_data method added in the previous release - Merged from master many important bugfixes and forward compatiblity updates, including: - Use modern preferred method for Moose metaclass access and many other small changes to how we use Moose for better forward compat (ether++) - Killed some evil use of $@ (ether++) - spelling fixes and documentation updates (ether++), (gerda++) - use Test::Fatal over Test::Exception (ether++) - Misc. test case fixes to modernize code (ether++) - Added a first pass cpanfile, to try and make it easier to bootstrap a development setup (ether++) 5.90049_002 - 2013-08-20 - Fixed loading middleware from project directory - Fixed some pointless warnings when middleware class lacked VERSION - NEW FEATURE: Declare global 'data_handlers' for parsing HTTP POST/PUT alternative content, and created default JSON handler. Yes, now Catalyst handles JSON request content out of the box! More docs eventually but for now see the DATA HANDLERS section in Catalyst.pm (or review the test case t/data_handler.t 5.90049_001 - 2013-07-26 - Declare PSGI compliant Middleware as part of your Catalyst Application via a new configuration key, "psgi_middleware". - Increased lowest allowed module version for Module::Pluggable to be 4.7 (up from 3.4) to solve the fact this is no longer bundled with Perl in v5.18. 5.90042 - 2013-06-14 - Removed more places where an optional dependency shows up in the test suite. Hopefully really fixed the unicode regression introduced in 5.90040 - reverted the change we introduced in 5.90040 where a unicode conversion error warned instead of died. Now it dies again, like in the stand alone plugin - More work to make sure nothing happens with encoding unless you explicitly ask for encoding - Code to hopefully fix an issue where file uploads using the unicode plugin caused trouble. 5.90041 - 2013-06-14 - Bug fix release to fix regressions introduced in previous. I would consider this a likely upgrade and if you are having trouble with the previous I hope this fixes all of them. - Fix regression with the cored Unicode plugin that broke systems where you are setting encoding type in an external configuration file - Fixed circular dependency introduced when we cored the unicode plugin tests - Fixed a longstanding problem with stats when locale uses , instead of . for number decimals - Fixed some docs that didn't properly date the previous release. 5.90040 - 2013-06-12 ! Stricter checking of attributes in Catalyst::DispatchType::Chained: 1) Only allow one of either :CaptureArgs or :Args 2) :CaptureArgs() argument must be numeric 3) :CaptureArgs() and :Args() arguments cannot be negative - Add Devel::InnerPackage to dependencies, fixing tests on perl 5.17.11 as it's been removed from core. RT#84787 - New support for closing over the PSGI $writer object, useful for working with event loops. - lets you access a psgix.io socket, if your server supports it, for manual handling of the client - server communication, such as for websockets. - Fix waiting for the server to start in t/author/http-server.t - new config flag 'abort_chain_on_error_fix' that exits immediately when a action in an action chain throws and error (fixes issues where currently the remaining actions are processed and the error is handled at chain termination). - Cored the Encoding plugin. Now get unicode out of the box by just setting $c->config->{encoding} = 'UTF-8'. BACKCOMPAT WARNING: If you are using the Encoding plugin on CPAN, we skip it to avoid double encoding issues, so you should remove it from your plugin list, HOWEVER the 'encoding' config setting is now undef, rather than 'UTF-8' (this was done to avoid breaking people's existing applications) so you should add the encoding setting to you global config. There's some other changes between the stand alone plugin and the cored version, if you use it be sure to see Catalyst::Upgrading for more. - minor documentation typo fixes and updates 5.90030 - 2013-04-12 ! POSSIBLE BREAKING CHANGE: Removed Regexp dispatch type from core, and put it in an external package. If you need Regexp dispatch types you should add "Catalyst-DispatchType-Regex" as a distribution to your build system. - make $app->uri_for and related methods return something sane, when called as an application method, instead of a context method. Now if you call MyApp::Web->uri_for(...) you will get a generic URI object that you need to resolve manually. - documentation updates around forwarding to chained actions. - Fixed bug when a PSGI engine need to use psgix logger. - Added cpanfile as a way to notice we are a dev checkout. - Added 'x-tunneled-method' HTTP Header method override to match features in Catalyst::Action::REST and in other similar systems on CPAN. - smarter valiation around action attributes. 5.90020 - 2013-02-22 ! Catalyst::Action now defines 'match_captures' so it is no long considered an optional method. This might break you code if you have made custom action roles/classes where you define 'match_captures'. You must change your code to use a method modifier (such as 'around'). - New match method "Method($HTTP_METHOD)" where $HTTP_METHOD in (GET, POST, PUT, HEAD, DELETE, OPTION) and shortcuts in controllers called "GET, POST PUT, HEAD, DELETE, OPTION"). Tests and documentation. Please note if you are currently using Catalyst::ActionRole::MatchRequestMethods there may be compatibility issues. You should remove that actionrole since the built in behavior is compatible on its own. - Initial debug screen now shows HTTP Method Match info - security fixes in the way we handle redirects - Make Catalyst::Engine and Catalyst::Base immutable - Some test and documentation improvements 5.90019 - 2012-12-04 21:31:00 - Fix for perl 5.17.6 (commit g7dc8663). RT#81601 - Fix for perl 5.8. RT#61122 - Remove use of MooseX::Types as MooseX::Types is broken on perl5.8 RT#77100 & RT#81121 5.90018 - 2012-10-23 20:55:00 - Changed code in test suite so it no longer trips up on recent changes to HTTP::Message. 5.90017 - 2012-10-19 22:33:00 - Change Catalyst _parse_attrs so that when sub attr handlers: 1) Can return multiple pairs of new attributes. 2) Get their returned attributes passed through the correct attribute handler. e.g sub _parse_Whatever_attr { return Chained => 'foo', PathPart => 'bar' } Will now work because both new attributes are respected, and the Chained attribute is passed to _parse_Chained_attr and fixed up correctly by that. - In Catalyst::Test, don't mangle headers of non-HTML responses. RT#79043 - Refactor request and response class construction to add methods that roles can hook to feed extra parameters into the constructor of request or response classes. 5.90016 - 2012-08-16 15:35:00 - prepare_parameters is no longer an attribute builder. It is now a method that calls the correct underlying functionality (Bill Moseley++) - Updated Makefile.PL to handle MacOXS tar - Fix uri_for to handle a stringifiable object - Fix model/view/controller methods to handle stringifiable objects - Fix RT#78377 - IIS7 ignores response body for 3xx requests, which causes (a different) response to be broken when using keepalive. Fixed by applying Middleware which removes the response body and content length that Catalyst supplies with redirects. 5.90015 - 2012-06-30 16:57:00 - Fix $c->finalize_headers getting called twice. RT#78090 - Fix test fails in Catalyst-Plugin-Session-State-Cookie. RT#76179 - Fix test fails in Catalyst-Plugin-StackTrace - Fix test fails in Test-WWW-Mechanize-Catalyst 5.90014 - 2012-06-26 10:00:00 - Fix calling finalize_headers before writing body when using $c->write / $c->res->write (fixes RT#76179). 5.90013 - 2012-06-21 10:40:00 - Release previous TRIAL as stable. - We failed to note in the previous changelog that the Makefile.PL has been improved to make it easier for authors to bootstrap a developer install of Catalyst. 5.90013 - TRIAL 2012-06-07 20:21:00 New features: - Merge Catalyst::Controller::ActionRole into Catalyst::Controller. Bug fixes: - Fix warnings in some matching cases for Action methods with Args(), when using Catalyst::DispatchType::Chained - Fix request body parameters to not be undef if no parameters are supplied. - Fix action_args config so that it can be specified in the top level config. - Fix t/author/http-server.t on Win32 - Fix use of Test::Aggregate to make tests faster. 5.90012 - 2012-05-16 09:59:00 Distribution META.yml changes: - author key is now correct, rather than what Module::Install mis-parses from the documentation. - x_authority key added. Bug fixes: - Fix request body parameters being multiply rebuilt. Fixes both RT#75607 and CatalystX::DebugFilter - Make plugin de-duplication work as intended originally, as whilst duplicate plugins are totally unwise, the C3 error given to the user is less than helpful. - Remove dependence on obscure behaviour in B::Hooks::EndOfScope for backward compatibility. This fixes issues with behaviour changes in bleadperl. RT#76437 - Work around Moose bug RT#75367 which breaks Catalyst::Controller::DBIC::API. Documentation: - Fix documentation in Catalyst::Component to show attributes and calling readers, rather than accessing elements in the $self->{} hash directly. - Add note in Catalyst::Component to strongly disrecommend $self->config - Fix vague 'checkout' wording in Catalyst::Utils. RT#77000 - Fix documentation for the 'secure' method in Catalyst:Request. RT#76710 5.90011 - 2012-03-08 16:43:00 Bug fixes: - Simplification of the previous changes to Catalyst::ScriptRunner We now just push $FindBin::Bin/../lib to the @INC path again, but only if one of the dist indicator files (Makefile.PL Build.PL or dist.ini) can be found in $FindBin::Bin/../$_ This avoids heuristics when the app is unloaded and therefore works better for extensions which have entire applications in their test suites. - Bug fix to again correctly detect checkouts in dist zilla using applications. - --background option for the server script now only closes STDIN, STDOUT and STDERR. This fixes issues with Log::Dispatch and other loggers which open a file handle when - Change incorrect use of File::Spec->catdir to File::Spec->catfile so that we work on platforms which care about this (VMS?) - Make it more obvious if our PSGI server doesn't pass in a response callback. 5.90010 - 2012-02-18 00:01:00 Bug fixes: - Fix the previous fix to Catalyst::ScriptRunner which was resulting in the lib directory not being pushed onto @INC. This meant perl ./script/myapp_server.pl failed, however perl -Ilib ./script/myapp_server.pl would succeed. 5.90009 - 2012-02-16 09:06:00 Bug fixes: - Fix the debug page so that it works as expected with the latest refactoring. - The Catalyst::Utils::home function is used to find if the application is a checkout in Catalyst::ScriptRunner. This means that a non-existant lib directory that is relative to the script install location is not included when not running from a checkout. - Fix dead links to cpansearch.perl.org to point to metacpan.org. - Require the latest version of B::Hooks::EndOfScope (0.10) to avoid an issue with new versions of Module::Runtime (0.012) on perl 5.10 which stopped Catalyst::Controller from compiling. - In Catalyst::Test, don't mangle headers of non-HTML responses. RT#79043 5.90008 - TRIAL 2012-02-06 20:49:00 New features and refactoring: - Much of the Catalyst::Engine code has been moved into Catalyst::Request and Catalyst::Response, to be able to better support asynchronous web servers such as Twiggy, by making the application engine more reenterant. This change is as a prequel to full asynchronous support inside Catalyst for AnyEvent and IO::Async backends, which allow highly scaleable streaming (for applications such as multi-part XML HTTPRequests, and Websockets). Deprecations: - This means that the $c->engine->env method to access the PSGI environment is now deprecated. The accessor for the PSGI env is now on Catalyst::Request as per applications which were using Catalyst::Engine::PSGI Catalyst::Engine::PSGI is now considered fully deprecated. - The private _dump method in Catalyst::Log is now deprecated. The dumper is not pluggable and which dumper to use should be a user choice. Using an imported Dump() or Dumper() function is less typing than $c->log->_dump and as this method is unused anywhere else in Catalyst, it has been scheduled for removal as a cleanup. Calling this method will now emit a stack trace on first call (but not on subsequent calls). Back compatibility fixes: - Applications still using Catalyst::Engine::PSGI as they rely on $c->request->env - this is now the provided (and recommended) way of accessing the raw PSGI environment. Tests: - Spurious warnings have been removed from the test suite Documentation: - Fix the display of PROJECT FOUNDER and CONTRIBUTORS sections in the documentation. These were erroneously being emitted when the Pod was converted to HTML for search.cpan.org - Fix documentation for the build_psgi_app app method. Previously the documentation advised that it provided the psgi app already wrapped in default middleware. This is not the case - it is the raw app psgi 5.90007 - 2011-11-22 20:35:00 New features: - Implement a match_captures hook which, if it exists on an action, is called with the $ctx and \@captures and is expected to return true to continue the chain matching and false to stop matching. This can be used to implement action classes or roles which match conditionally (for example only matching captures which are integers). Bug fixes: - Lighttpd script name fix is only applied for lighttpd versions < 1.4.23. This should fix non-root installs of lighttpd in versions over that. - Prepare_action is now inside a try {} block, so that requests containing bad unicode can be appropriately trapped by Catalyst::Plugin::Unicode::Encoding 5.90006 - 2011-10-25 09:18:00 New features: - A new 'run_options' class data method has been added to Catalyst.pm This is used to store all the options passed by scripts, allowing application authors to add custom options to their scripts then get them passed through to the application. Doumentation: - Clarify that if you manually write your own .psgi file, then optional proxy support (via the using_frontend_proxy config value) will not be enabled unless you explicitly apply the default middlewares from Catalyst, or you apply the middleware manually. Bug fixes: - Fix issue due to perl internals bugs in 5.8 and 5.10 (not present in other perl versions) require can pass the context inappropriately, meaning that some methods of loading classes can fail due to void context being passed throuh to make_immutable, causing it to not return a value. This bug caused loading Catalyst::Script::XXX to fail and is fixed both by bumping the Class::Load dependency, and also adding an explicit '1;' to the end of the classes, avoiding the context issue. - Fix using_frontend_proxy support in mod_perl by using the psgi wrapped in default middleware in mod_perl context, rather than the raw psgi. 5.90005 - 2011-10-22 13:35:00 New features: - $c->uri_for_action can now take an array of CaptureArgs and Args If you have an action which has both, then you can now say: $c->uri_for_action('/myaction', [@captures, @args]); whereas before you had to say: $c->uri_for_action('/myaction', [@captures], @args); The previous form is still supported, however in many cases it is easier for the application code to not have to differentiate between the two. - Catalyst::ScriptRunner has been enhanced so that it will now load and apply traits, making it easier to customise. - MyApp::TraitFor::Script (if it exists) will be applied to all scripts in the application. - MyApp::TraitFor::Script::XXXX will be applied to the relevant script (for example MyApp::TraitFor::Script::Server will be applied to MyApp::Script::Server if it exists, or Catalyst::Script::Server otherwise). Documentation: - Document how to get the vhost of the request in $c->req->hostname to avoid confusion - Remove documentation showing Global / Regex / Private actionsi as whilst these still exist (and work), they are not recommended. - Remove references to the -Engine flag. - Remove references to the deprecated Catalyst->plugin method - Spelling fixed (and tested) throughout the documentation - Note that wrapping the setup method will not work with method modifiers and provide an alternative. 5.90004 - 2011-10-11 17:12:00 Bug fixes: - Don't guess engine class names when setting an engine through MyApp->engine_class. 5.90003 - 2011-10-05 08:32:00 Bug fixes: - Make default body reponses for 302s W3C compliant. RT#71237 - Fix issue where groups of attributes to override controller actions in config would be (incorrectly) overwritten, if the parser for that attribute mangled the contents of the attribute. This was found with Catalyst::Controller::ActionRole, where Does => [ '+Foo' ] would be transformed to Does => [ 'Foo' ] and written back to config, whereas Does => '+Foo' would not be changed in config. RT#65463 Enhancements: - Set a matching Content-type for the redirect if Catalyst sets the body. This is for compatibility with a WatchGuard Firewall. Backward compatibility fixes: - Restore (an almost empty) Catalyst::Engine::HTTP to the dist for old scripts which explictly require Catalyst::Engine::HTTP Documentation fixes: - Document Catalyst::Plugin::Authentication fails tests unless you use the latest version with Catalyst 5.9 - Clarify that prepare is called as a class method - Clarify use of uri_for further. RT#57011 5.90002 - 2011-08-22 21:44:00 Backward compatibility fixes: - Deploying via mod_perl in some cases is fixed by making Catalyst::EngineLoader detect mod_perl in more generic circumstances. https://github.com/miyagawa/Plack/issues/239 Documentation fixes: - Fix incorrect example in Catalyst::PSGI. - Add note that if you are using the PSGI engine, then $c->req->env needs to become $c->engine->env when you upgrade. 5.90001 - 2011-08-15 22:42 Realise that we accidentally chopped a digit off the versioning scheme without anyone noticing, which is a bad thing. Feel like a fool. Well done t0m. Cut another release. 5.9000 - 2011-08-15 22:18 See Catalyst::Delta for the major changes in this release. Changelog since the last TRIAL release: Backward compatibility fixes: - Fix calling MyApp->engine_class to set the engine class manually. - Re-add a $res->headers->{status} field to Catalyst::Test responses. This _should_ be accessed with $c->res->code instead, but is here for backward compatibility. Documentation: - Documentation which was in the now removed Catalyst::Engine::* classes has been moved to Catalyst::Manual::Deployment Changes: - nginx specific behaviour is removed as it is not needed with any web server configuration I can come up with (recommended config is documented in Catalst::Manual::Deployment::nginx::FastCGI) 5.89003 2011-07-28 20:11:50 (TRIAL release) Backward compatibility fixes: - Application scripts which have not been upgraded to newer Catalyst::Script::XXX style scripts have been fixed Bug fixes: - mod_perl handler fixed to work with application classes which have manually been made immutable. - Scripts now force the Plack engine choice manually, rather than relying on auto-detection, as the automatic mechanism gets it wrong if (for example) Coro is loaded. - Server script option for --fork --keepalive are now handled by loading the Starman server, rather than silently ignored. - Server script options for --background and --pid are now fixed by using MooseX::Deamonize - Plack middlewares to deal with issues in Lighttpd and IIS6 are now automatically applied to applications and deployments which need them (when there is not a user written .psgi script available). This fixes compatibility with previous stable releases for applications deployed in these environments. Enhancements: - Catalyst::Test's remote_request method not uses Plack::Test to perform the remote request. Documentation: - Added a Catalyst::PSGI manual page with information about writing a .psgi file for your application. - Catalyst::Uprading has been improved, and the status of old Catalyst engines clarified. Deprecations: - Catalyst::Test's local_request function is now deprecated. You should just use the normal request function against a local server instead. 5.80033 2011-07-24 16:09:00 Bug fixes: - Fix Catalyst::Request so that the hostname accessor is not incorrectly populated with 'localhost' if a reverse DNS lookup fails. - Fix Path actions debug screen to display number of arguments - Fix a regression that prevented configuring attributes for all actions using ->config(actions => { '*' => \%attrs }) from working - Append $\ in Catalyst::Response->print to more closely match IO::Handle's behaviour. - Fixed situation where a detach($action) from a forward within auto was not breaking out correctly - Fix the disable_component_resolution_regex_fallback config setting to also work in the $c->component method. - Handle users setting cookies with an undef value by not trying to output that cookie (rather than trying to do so and causing an exception as previously happened). A warning is logged if this occurs in debug mode. - Update tests to ignore $ENV{CATALYST_HOME} where required - Change repository metadata to point at git. - Clean namespaces in Catalyst::Request::Upload - Catalyst::Test: Fixes to action_ok, action_redirect and action_notfound test functions to be better documented, and have better default test names. - Update tests to ignore CATALYST_HOME env var. 5.89002 2011-03-02 11:30:00 (TRIAL release) Bug fixes: - Fix a couple of test failures caused by optional dependencies such as FCGI not being installed. Refactoring: - Simplified the API for getting a PSGI application code reference for a Catalyst application for use in, for example, .psgi files. See Catalyst::Upgrading for details. 5.89001 2011-03-01 15:27:00 (TRIAL release) Bug fixes: - Fixed command-line argument passing in Catalyst::Script::FastCGI. - Fixed Catalyst::Engine::Stomp compatibility. Applications using Catalyst::Engine::Stomp are believed to continue working without any changes with the new Catalyst major version. - Fixed issues auto-loading engine with older scripts. Known problems: - Catalyst::Engine::Wx is officially unsupported and BROKEN. If you are using this engine then please get in touch with us and we'll be happy to help with the changes it needs to be compatible with the new major version of Catalyst. Documentation: - The section of Catalyst::Upgrading describing how to upgrade to version 5.90 of Catalyst has been much improved. 5.80032 2011-02-23 01:10:00 Bug fixes: - Fix compatibility issue with code which was testing the value of $c->res->body multiple times. Previously this would cause the value to be built, and ergo cause the $c->res->has_body predicate to start returning true. Having a response body is indicated by $c->res->body being defined. - Fix bug with calling $upload->slurp multiple times in one request not working as expected as the file handle wasn't returned to the zero position. (Adam Sjøgren) - Fix some weird perl 5.8 situations where $c can get squashed unexpectedly in Catalyst::execute - Fix chained dispatch where chains were being compared for length (number of private parts in the chain) vs where they are being compared for PathPart length (i.e. number of non-capturing URI elements in your path). This bug meant that sometimes multiple Args or CaptureArgs (e.g. /*/*) type paths would be preferred to those with fixed path elements (e.g. /account/*) New features: - Add MYAPP_RESTARTER and CATALYST_RESTARTER environment variables to allow the restarter class to be chosen per application or generally. This feature was added to enable GUI restarters (such as the soon to be released CatalystX::Restarter::GTK to be enabled more easily by developers without changing their application code. 5.80031 2011-01-31 08:13:02 Bug fixes: - Update dependency on MooseX::Role::WithOverloading to ensure that a version which can deal with / depends on a new Package::Stash is installed. (As if some other dependency is pulled in during upgrading which results in new Package::Stash, then it can leave you with a broken version of MooseX::Role::WithOverloading. - Fix undef warning in Catalyst::Engine::FastCGI when writing an empty body (e.g. doing a redirect) 5.89000 2011-01-24 09:28:45 (TRIAL release) This is a development release from psgi branch of Catalyst-Runtime. Removed features: - All of the Catalyst::Engine::* namespace is now gone. Instead we only have one Catalyst::Engine class speaking the PSGI protocol natively. Everything the various Catalyst::Engine:: classes did before is now supposed to happen through PSGI handlers such as Plack::Handler::FCGI, Plack::Handler::HTTP::Server::PSGI, Plack::Handler::Apache2, and so on. However, deployment can still work the same as it did before. The catalyst scripts still exist and continue to work. If you find anything that either doesn't work anymore as it did before or anything that could be done before with the various Catalyst::Engine:: classes, but can't be done anymore with the single PSGI Catalyst::Engine class, please tell us *now*. 5.80030 2011-01-04 13:13:02 New features: - Add a --proc_title option to the FCGI script to set the process title. - Allow the response body to be set to `undef' explicitly to indicate the absence of a body. It can be used to indicate that no body should be sent at all and processing of views should be skipped. This is especially useful for things like X-Sendfile, which now no longer require providing fake response bodies to suppress view processing. In order for this to work, you will also have upgrade Catalyst::Action::RenderView to at least version 0.15. Bug fixes: - Deal correctly with GLOB file handles in the response body (setting the Content-Length header appropriately) - Chained dispatch has been fixed to always prefer paths with the minimum number of captures (rather than the maximum number of actions). This means that (for example) a URI path /foo/* made out of 2 actions will take preference to a URI path /*/* made out of 3 actions. Please check your applications if you are using chained action and please write new test to report failing case. - Stop relying on bugs in the pure-perl version of Package::Stash. New versions of Package::Stash load Package::Stash::XS if available. Package::Stash::XS fixes some of the bugs of the pure-perl version, exposing our faulty assumption and breaking things. We now work with both old and new versions of Package::Stash, both with and without Package::Stash::XS being installed. Older versions of Catalyst-Runtime also work with both old and new versions of Package::Stash, but only if Package::Stash::XS is *not* installed. Documentation: - Clarify that when forwarding or detaching, the end action associated with the original dispatched action will be run afterwards (fallen) 5.80029 2010-10-03 16:39:00 New features: - Add a warning when $c->view is called and cannot locate a default_view or current_view. This clarifies the logging when ::RenderView gets confused. Warning fixes: - Deal warning in with Moose >= 1.15 if you add a method called 'meta' to a class which already has one by using _add_meta_method. 5.80028 2010-09-28 20:49:00 Bug fixes: - use Class::MOP in Catalyst::Utils. - Do not keep a reference to a closed over context in ctx_request, allowing the caller to dispose of the request context at their leisure. - Changes to be compatible with bleadperl 5.80027 2010-09-01 22:14:00 Bug fixes: - Fix an issue with newly added test cases which depended on Catalyst::Action::RenderView 5.80026 2010-09-01 15:14:00 Bug fixes: - Fix so that CATALYST_EXCEPTION_CLASS in MyApp is always respected by not loading Catalyst::Exception in Utils.pm BEGIN, because some Scripts::* load Utils before MyApp.pm - Fix warnings with new Moose versions about "excludes" during role application - Fix warning from MooseX::Getopt regarding duplicate "help" aliases. - parse_on_demand fixed when used in conjunction with debug mode. A regression was introduced in 5.80022 which would cause the body to always be parsed for logging at the end of the request when in debug mode. This has been fixed so that if the body has not been parsed by the time the request is logged, then the body is omitted. - Fix show_internal_actions config setting producing warnings in debug mode (RT#59738) - Make Catalyst::Test::local_request() set the response base from base href in the returned document so that links can be resolved correctly by Test::WWW::Mechanize::Catalyst Refactoring: - moved component name sort that happens in setup_components to locate_components to allow methods to wrap around locate_components Documentation: - Fix some typos - Advertise Catalyst::Plugin::SmartURI 5.80025 2010-07-29 01:50:00 New features: - An 'action_class' method has been added to Catalyst::Controller to allow controller base classes, roles or traits (e.g. Catalyst::Controller::ActionRole) to more easily override the default action creation. Bug fixes: - Fix the --mech and --mechanize options to the myapp_create.pl script to operate correctly by fixing the options passed down into the script. - Fix controllers with no method attributes (where the action definitions are entirely contained in config). RT#58057 - Fix running as a CGI under IIS at non-root locations. - Fix warning about "excludes" during role application - Fix warning from MooseX::Getopt regarding duplicate "help" aliases Documentation: - Fix missing - in the docs when describing the --mechanize option at one point. - Explained the common practice how to access the component's config values. - Fixed typo in Catalyst/Script/Server.pm (RT #58474) 5.80024 2010-05-15 11:55:44 Bug fixes: - Revert the path resolution behaviour to how it used to work before Catalyst 5.80014_02, so that application paths are (by default) resolved from $ENV{PATH_INFO} and $ENV{SCRIPT_NAME}. This fixes backward compatibility breakage seen by a number of people since that release with mod_rewrite and SSI. New features: - Add a use_request_uri_for_path config setting to optionally use the (more correct) $ENV{REQUEST_URI} path resolution behaviour. Documentation: - Clarify the documentation for the Catalyst::Stats interface. - Copious documentation about the use_request_uri_for_path feature and the implications of setting this to true/false in Catalyst::Engine::CGI 5.80023 2010-05-07 23:50:27 Bug fixes: - Ensure to always cleanup temporary uploaded files in all cases, even when exceptions occur during request processing, using HTTP::Body's ->cleanup feature. (RT#41442) - Ensure that Catalyst::Engine::HTTP's options hash is defined before dereferencing it. (RT#49267) - Fix regex special characters in REDIRECT_URL variable breaking the request base. (2nd part of RT#24951) - Fix not stripping backslashes in DispatchType::Regex::uri_for_action New features: - Setting __PACKAGE__->config(enable_catalyst_header => 1); in your MyApp.pm now enables the X-Catalyst header being printed when not in debug mode. - Require CGI::Simple::Cookie version 1.109 to ensure support for the HttpOnly flag - Allow the myapp_test.pl script to be given a list of paths which it will retrieve all of. (RT#53653) - Allow parameterized roles to be applied as plugins. - Allow requiring minimum versions of plugins when loading them. Documentation: - The Catalyst::Test::get method is documented as returning the raw response bytes without any character decoding (RT#53678) Cleanups: - Removal of $Catalyst::PRETTY_VERSION. Future releases will always have the full and unmangled version number, including trailing zeroes, in $Catalyst::VERSION. 5.80022 2010-03-28 19:43:01 New features: - Log an extra line in debug mode with the response status code, the content type and content length if available. Refactoring / optimizations: - Display of the end of hit debug messages has been factored out into log_headers, log_request, log_request_headers, log_response, log_response_status_line and log_response_headers methods so that plugins which customise how much information is shown on the debug screen as easy to write. - Make all logging of request and response state get the information from $c->dump_these so that there is a unified point from which to hook in parameter filtering (for example). - $c->model/view/controller have become a lot faster for non-regexp names by using direct hash lookup instead of looping. - IP address => hostname mapping for the server is only done once and cached by Catalyst::Engine::HTTP to somewhat mitigate the problem of people developing on machines pointed at slow DNS servers. Bugs fixed: - DispatchType::Index's uri_for_action only returns for actions registered with it (prevents 'index :Path' or similar resolving to the wrong URI) - Make sure to construct Upload objects properly, even if there are multiple Content-Type headers (Closes RT#55976). 5.80021 2010-03-03 23:02:01 Bug fixed: - $c->uri_for will now escape unsafe characters in captures ($c->request->captures) and correctly encode utf8 charracters. 5.80020 2010-02-04 06:51:18 New features: - Allow components to specify additional components to be set up by overriding the expand_modules method. (Oliver Charles) 5.80019 2010-01-29 01:04:09 Bug fixed: - Calls to $c->uri_for with private paths as strings (e.g. $c->uri_for('controller/action', 'arg1', 'arg2') ) no longer have / encoded to %2F. This is due to $c->uri_for('static', 'css/foo', $bar) which should not be encoded. Calls with an action object (rather than a string), or uri_for action will still encode / in args and captures to %2F - The above noted / => %2F encoding in uri_for_action or uri_for with an action object has been fixed to not just encode the first slash in any set of args/captures. - nginx and lighttpd FCGI requests with URI encoded sections as the first path part have been fixed to operate correctly. - A source of bogus warnings in Catalyst::Component::BUILDARGS has been removed. Documentation: - Improve the documentation about -Home and how Catalyst finds the home path for applications. - Various minor typo fixes. New features: - Allow passing additional arguments to action constructors. 5.80018 2010-01-12 22:24:20 Bug fixed: - Call ->canonical on URI derived from $ENV{REQUEST_URI} to get paths correctly decoded. This bug was previously hidden by a bug in HTTP::Request::AsCGI. Documentation: - Clarify that uri_for_action works on private paths, with example. - Clarify documentation about debug Deprecations: - Saying use Catalyst::Test; (without an application name or () to stop the importer running is now deprecated and will issue a warning. You should be saying use Catalyst::Test (); 5.80017 2010-01-10 02:27:29 Documentation: - Fix docs for ->forward method when passed a class name - this should be a component name (e.g. View::HTML, not a full class name, like MyApp::View::HTML). Bug fixes: - --daemon and -d options to Catalyst::Script::FastCGI are fixed. - Fix the debug dump for applications which use Catalyst::Plugin::Session (RT#52898) - Fix regression in the case where mod_rewrite is being used to rewrite requests into a path below your application base introduced with the %2F related fixes in 5.80014_02. - Do not crash on SIGHUP if Catalyst::Engine::HTTP->run is not passed the argv key in the options hash. - Correctly pass the arguments to Catalyst::Script::Server through to Catalyst::Engine::HTTP->run so that the server can restart itself with the correct options on SIGHUP. - Require new MooseX::MethodAttributes to be compatible with Moose versions >= 0.93_01 - Require new MooseX::Role::WithOverloading to be compatible with Moose versions >= 0.93_01 Cleanups: - Stop suppressing warnings from Class::C3::Adopt::NEXT now that most plugins have been updated to not use NEXT. If you get warnings then please upgrade your components or log a bug with the component author if an upgrade is not available. The Class::C3::Adopt::NEXT documentation contains information about how to suppress the warnings in your application if you need to. 5.80016 2009-12-11 23:23:33 Bug fixes: - Fix slurping a file to work correctly with binary on Win32 in the encoding test controller. Bug fixes in the new scripts (for applications which have been upgraded): - Allow --restartdirectory as an option for the Server script, for backwards compatibility. (Dave Rolsky) - The --host option for the server script defaulted to localhost, rather than listening on all interfaces, which was the previous default. (Dave Rolsky) - Restore -p option for pid file in the FastCGI server script. - Fix the script environment variables MYAPP_PORT and MYAPP_RELOAD RT#52604 - Fix aliasing applications under non-root paths with mod_rewrite in some apache versions where %ENV{SCRIPT_NAME} is set to the real name of the script, by using $ENV{REDIRECT_URL} which contains the non-rewritten URI. - Fix usage display when myapp_create.pl is run with no arguments. RT#52630 New features: - The __MOP__ hash element is suppressed from being dumped fully (and instead stringified) when dumping the error screen to be less packed with information of no use. Documentation: - Fix Pod nits (RT#52370) 5.80015 2009-12-02 15:13:54 Bug fixes: - Fix bug in Catalyst::Engine which would cause a request parsing to end prematurely in the hypothetical case where calling $engine->read returned the single character '0'. - Fix failing tests when combined with new HTTP::Request::AsCGI Documentation: - Improved documentation on read and read_chunk methods in Catalyst::Engine. - Fix reversal of SCRIPT_NAME and PATH_INFO in previously correct nginx FastCGI documentation introduced in _02. 5.80014_02 2009-12-01 00:55:23 Bug fixes: - Fix reporting the wrong Content-Length if the response body is an upgraded string. Strings mean the same thing whether or not they are upgraded, may get upgraded even after they are encoded, and will produce the same output either way, but bytes::length returns too big values for upgraded strings containing characters >127 - Fix t/live_fork.t with bleadperl (RT#52100) - Set $ENV{PATH_INFO} from $ENV{REQUEST_URI} combined with $ENV{SCRIPT_NAME} if possible. This is many web servers always fully decode PATH_INFO including URI reserved characters. This allows us to tell foo%2cbar from foo%252cbar, and fixes issues with %2F in paths being incorrectly decoded, resulting in too many path parts (rather than 1 path part containing a /, on some web servers (at least nginx). (RT#50082) - Require new HTTP::Request::AsCGI so that it fully decodes $ENV{PATH_INFO} in non CGI contexts. (RT#50082) Refactoring / cleanups: - NoTabs and Pod tests moved to t/author so that they're not run (and then skipped) normally. Documentation: - Fix Pod nits in Catalyst::Response (RT#51818) 5.80014_01 2009-11-22 20:01:23 Bug fixes: - Filehandle now forced to binmode in CGI and FastCGI engines. This appears to correct some UTF-8 issues, but may break people's code which relies on the old behaviour. Refactoring / cleanups: - Plugins which inherit from Catalyst::Controller or Catalyst::Component are deprecated and now issue warnings. 5.80014 2009-11-21 02:51:14 Bug fixes: - Require MooseX::MethodAttributes 0.17. This in turn requires new MooseX::Types to stop warnings in Moose 0.91, and correctly supports role combination of roles containing attributed methods. - Catalyst::Dispatcher::dispatch_types no longer throws deprecated warnings as there is no recommended alternative. - Improved the suggested fix warning when component resolution uses regex fallback for fully qualified component names. - Catalyst::Test::local_request sets ->request on the response. - Log flush moved to the end of setup so that roles and plugins which hook setup_finalize can log things and have them appear in application startup, rather than with the first hit. - Require a newer version of LWP to avoid failing tests. - Stop warnings when actions are forwarded to during dispatch. - Remove warnings for using Catalyst::Dispatcher->dispatch_types as this is a valid method to publicly call on the dispatcher. - Args ($c->request->args) and CaptureArgs ($c->request->captrues) passed to $c->uri_for with an action object ($c->action) will now correctly round-trip when args or captures contain / as it is now correctly uri encoded to %2F. Documentation: - Document no-args call to $c->uri_for. - Document all top level application configuration parameters. - Clarify how to fix actions in your application class (which is deprecated and causes warnings). - Pod fixes for ContextClosure. - Fix documentation for go/visit to reference captures and arguments in the correct order. - Update $c->forward and $c->state documentation to address scalar context. - Pod fix in Catalyst::Request (RT#51490) - Pod fixes to refer to ::Controller:: rather than ::C:: as the latter is deprecated (RT#51489) New features: - Added disable_component_resolution_regex_fallback config option to switch off (deprecated) regex fallback for component resolution. - Added an nginx-specific behavior to the FastCGI engine to allow proper PATH_INFO and SCRIPT_NAME processing for non-root applications - Enable Catalyst::Utils::home() to find home within Dist::Zilla built distributions - Added the Catalyst::Exception::Interface role defining the interface exception classes need to implement. - Added Catalyst::Exception::Basic as a basic implementation of Catalyst::Exception::Interface and made the existing exception classes use it. Refactoring / cleanups: - Remove documentation for the case_sensitive setting - Warning is now emitted at application startup if the case_sensitive setting is turned on. This setting is not used by anyone, not believed to be useful and adds unnecessary complexity to controllers and the dispatcher. If you are using this setting and have good reasons why it should stay then you need to be shouting, now. - Writing to $c->req->body now fails as doing this never makes sense. 5.80013 2009-09-17 11:07:04 Bug fixes: - Preserve immutable_options when temporarily making a class mutable in Catalyst::ClassData as this is needed by new Class::MOP. This could have potentially caused issues when using the deprecated runtime plugins feature in an application with plugins which define their own new method. - Require new Moose version and new versions of various dependencies to avoid warnings from newest Moose release. - Fix go / visit expecting captures and arguments in reverse order. Documentation: - Rework the $c->go documentation to make it more clear. - Additional documentation in Catalyst::Upgrading covering more deprecation warnings. Refactoring / cleanups: - Action methods in the application class are deprecated and applications using them will now generate a warning at startup. - The -short option has been removed from catalyst.pl, stopping new applications from being generated using the ::[MVC]:: naming scheme as this is deprecated and generates warnings. RT#49771 5.80012 2009-09-09 19:09:09 Bug fixes: - Fix t/optional_http-server.t test. - Fix t/optional_http-server-restart.t test. - Fix duplicate components being loaded at setup time, each component is now loaded at most once + tests. - Fix backward compatibility - hash key configured actions are stored in is returned to 'actions'. - Fix get_action_methods returning duplicate methods when a method is both decorated with method attributes and set as an action in config. Refactoring / cleanups: - Reduce minimum supported perl version from 5.8.6 to 5.8.4 as there are many people still running/testing this version with no known issues. Tests: - Make the optional_http_server.t test an author only test which must be run by authors to stop it being broken again. - Fix recursion warnings in the test suites. 5.80011 2009-08-23 13:48:15 Bug fixes: - Remove leftovers of the restarter engine. The removed code caused test failures, which weren't apparent for anyone still having an old version installed in @INC. 5.80010 2009-08-21 23:32:15 Bug fixes: - Fix and add tests for a regression introduced by 5.80008. Catalyst::Engine is now able to send out data from filehandles larger than the default chunksize of 64k again. 5.80009 2009-08-21 22:21:08 Bug fixes: - Fix and add tests for generating inner packages inside the COMPONENT method, and those packages being correctly registered as components. This fixes Catalyst::Model::DBIC among others. 5.80008 2009-08-21 17:47:30 Bug fixes: - Fix replace_constructor warning to actually work if you make your application class immutable without that option. - Depend on Module::Pluggable 3.9 to prevent a bug wherein components in inner packages might not be registered. This especially affected tests. - Catalyst::Engine::FastCGI - relax the check for versions of Microsoft IIS. Provides compatibility with Windows 2008 R2 as well as (hopefully) future versions. - In tests which depend on the values of environment variables, localise the environment, then delete only relevant environment variables (RT#48555) - Fix issue with Engine::HTTP not sending headers properly in some cases (RT#48623) - Make Catalyst::Engine write at least once when finalizing the response body from a filehandle, even if the write is empty. This avoids fail when trying to send out an empty response body from a filehandle. - Catalyst::Engine::HTTP - Accept a fully qualified absolute URI in the Request-URI of the Request-Line Refactoring / cleanups: - Deleted the Restarter engine and its Watcher code. Use the new Catalyst::Restarter in a recent Catalyst::Devel instead. - New unit test for Catalyst::Action 'unit_core_action.t' - Bump minimum supported perl version from 5.8.1 to 5.8.6 as there are known issues with 5.8.3. - Debug output uses dynamic column sizing to create more readable output when using a larger $ENV{COLUMNS} setting. (groditi) New features: - Added private_path method for Catalyst::Action - Allow uri_for($controller_instance) which will produce a URI for the controller namespace - Break setup_components into two more parts: locate_components and expand_component_module (rjbs) - Allow Components to return anon classed from their COMPONENT method correctly, and have action registration work on Controllers returned as such by adding a catalyst_component_name accessor for all components which returns the component instance's name to be used when building actions etc. - Adding X-Forwarded-Port to allow the frontend proxy to dictate the frontend port (jshirley) - Added Catalyst::Stats->created accessor for the time at the start of the request. Documentation: - Fix POD to refer to ->config(key => $val), rather than ->config->{key} = $val, as the latter form is deprecated. - Clearer docs for the 'uri_for' method. - Fix POD refering to CGI::Cookie. We're using CGI::Simple::Cookie. (Forrest Cahoon) 5.80007 2009-06-30 23:54:34 Bug fixes: - Don't mangle query parameters passed to uri_for - Tests for this (Byron Young + Amir Sadoughi) - Inherited controller methods can now be specified in config->{action(s)} - Assigning an undef response body no longer produces warnings - Fix C3 incompatibility bug caused if you use Moose in MyApp.pm and add Catalyst to the right hand side of this in @ISA. - Make Catalyst.pm implement the Component::ApplicationAttribute interface so defining actions in MyApp.pm works again, if the actions have attributes that cause $self->_application to be used (like ActionClass). New features: - Add optional second argument to uri_with which appends to existing params rather than replacing them. (foo=1 becomes foo=1&foo=2 when uri_with({ foo => 2 }, { mode => 'append' }) is called on a foo=1 URI. 5.80006 2009-06-29 23:37:47 Bug fixes: - Revert change to URL encode things passed into $c->uri_for Args and CaptureArgs as this causes breakage to pre-existing applications. - Remove use of Test::MockObject as it doesn't install from CPAN in some environments. - Remove use of dclone to deep copy configs and replace with Catalyst::Utils::merge_hashes which has the same effect, of ensuring child classes don't inherit their parent's config, except works correctly with closures. - Add Class::C3::reinitialize into Catalyst::Test to avoid weird bugs in ctx_request (bokutin in RT#46459) - Fix issues with _parse_PathPrefix_attr method in Catalyst::Controller (jasonk in RT#42816) - Fix bugs with action sorting: - Path actions sorted so that the most specific wins. - Action methods named default and index fixed. New features: - Use ~ as prefix for plugins or action classes which are located in MyApp::Plugin / MyApp::Action (mo) - Controller methods without attributes are now considered actions if they are specified in config->{action(s)} (mo) - Add Catalyst::Component::ContextClosure as an easy way to create code references, that close over the context, without creating leaks. Refactoring / cleanups: - Clean namespaces in Catalyst::Exception*. - Turn Catalyst::Exception into an actual class and make the throw method create instances of it. They can still be used as normal strings, as before, as they are overloaded to stringify to their error message. - Add a rethrow method to Catalyst::Exception. - Add Catalyst::Exception::Detach and ::Go, and refactor detach() and go() to use them instead of magic, global strings. Fixes RT#47366 - Clean up getting metaclass instance and making app class immutable again in Catalyst::Test 5.80005 2009-06-06 14:40:00 Behaviour changes: - Arguments ($c->req->args) in Chained dispatch are now automatically URL decoded to be consistent with Local/Path dispatch Documentation: - Clarify correct techniques for Moose controllers (domm) Bug fixes: - Further change pushing 'env' attribute down into Catalyst::Engine to make $c->engine->env work in all cases (kmx) - Also fix $c->engine->env in Catalyst::Test tests (kmx) - Tests for this - Fix Catalyst failing to start if any plugin changed $_ whilst loading - Tests for this - Be stricter about arguments to Args attributes for Chained actions, so that they blow up on load instead of causing undefined behavior later on - Tests for this - Prefer Path actions with a smaller (or set) number of Args (caelum) Bug reported here: http://stackoverflow.com/questions/931653/catalyst-action-that-matches-a-single-file-in-the-root-directory/933181#933181 - Tests for this New features: - Add $c->req->remote_user to disambiguate from $c->req->user (dwc) - Require MooseX::MethodAttributes 0.12 so that action methods (with attributes) can be used in / composed from Moose roles. - Allow the generation of cookies with the HTTPOnly flag set in Catalyst::Engine (kmx) 5.80004 2009-05-18 17:03:23 - Rename the actions attribute in Catalyt::Controller to _controller_actions to avoid name clashes with application controller naming. (random) - Test for using Moose in components which have a non-Moose base class Fixed by 349cda in Moose 0.78 - Fix deprecation message for Catalyst::Dispatcher to refer to the class actually calling the deprecated method. RT#45741 - Clarify limitations of $request->base and $request->secure. (Phil Mitchell) - Add 'use Catalyst' to documentation for a Moose MyApp class as noted by dmaki. - Fix so that / (and other special characters) are URL encoded when passed into $c->uri_for as Args/CaptureArgs - Fix development server so that $c->engine->env returns the correct environment - Require Moose 0.78 to fix metaclass incompatibility issues - Require MooseX::MethodAttributes 0.10 and use Moose::Meta::Class->initialize rather than Moose->init_meta to fix bugs related to having a 'meta' method in your controller - Fix cases where your application failing to compile could cause perl to report 'Unknown Error' - Support adding Moose::Roles to the plugin list. These are applied to MyApp after plugins have been pushed onto @ISA - Fix calling $c->req->parameters as the first thing you do when parse_on_demand is on 5.80003 2009-04-29 16:23:53 - Various POD tweaks. (hdp, dandv) - Fix formatting error in the regex fallback warning. - Convert the dispatcher's and restarter engine's BUILD method to attribute builders to not override the BUILD method from MooseX::Emulate::Class::Accessor::Fast. - Fix classes without metaclasses restarting, when not using B::Hooks::OP::Check::StashChange - Fix the unattached chain debug table for endpoints with no parents at all. - Turn off test aggregation by default. Only aggregate if the AGGREGATE_TESTS environment variable is set and a recent Test::Aggregate is available. - Bump to MooseX::MethodAttributes 0.09, to gain the get_nearest_methods_with_attributes method allowing methods without attributes in a subclass to override those with attributes in a superclass. This fixes CatalystX::CRUD's method of overriding / disabling functionality from base controllers. - Bump HTTP::Request::AsCGI dependency to avoid broken version - Bump Moose dependency to latest version to fix metaclass incompatibility issues in some cases. - Additional tests for setup_stats method. - Fix log levels in Catalyst::Log to be properly additive. - Fix RT#43375 by sorting results before testing them - Fixes for uri_for_action when using Catalyst::DispatchType::Regex + tests from RT#39369 (norbi) - Partial rewrite and reoganisation of the C3 docs in Catalyst::Upgrading based on feedback from kiffin - If you make your application class immutable and turn off constructor inlining, Catalyst will die and tell you pass the (replace_constructor => 1) argument to make_immutable. (Dave Rolsky) 5.80002 2009-04-22 01:28:36 - Fix CATALYST_DEBUG and MYAPP_DEBUG environment variables turning debuging on if defined, rather than if set. They now force debugging on or off, taking precedence over configuration in your application. - Tests for this - pass replace_constructor to the immutable call to ensure applications get a Moose constructor rather than a C::A one - Fix issues with restarting the application class due to C3 failures on perl 5.10 - Work around issues in Moose with initialization order of multiple levels of non-Moose classes inheriting from a Moose class - Test for this - Add backwards compatibility method for Catalyst::Log->body, which has been made private - Fix so that calling $c->req->parameters(undef) does not flatten the request parameters with undef + test - Fix so that width of table of unattached actions for debugging ::DispatchType::Chained varies according to your terminal width (Oleg Kostyuk) - Fix warning message about linearized @ISA in Catalyst::Component (Emanuele Zeppieri) - Require MX::MethodAttributes 0.06 to avoid issues with saying use base 'Catalyst::Controller'; use Moose; losing actions - Fix all of's typos in ::Upgrading and ::Delta (hobbs) 5.80001 2009-04-18 22:18 - Don't inline the constructor for Catalyst::Log to avoid a warning on recent Moose versions. - Add delta documentation - Clean up recursion errors - Extra cross links in dispatch types POD (Ian Wells) - Test uri_with clears query params when they are set to undef (Ian Wells) - Complain about old Catalyst::Devel versions which generated ->setup(qw/-Debug... etc. as this is not recommended 5.8000_07 2009-04-12 13:37 - Add the Catalyst::Dispatcher->dispatch_type method (ash) - Throw an exception rather than loading an app if an action tries to chain to itself - Tests for this - Change the $c->visit and $c->go methods to optionally take CaptureArgs, making them useful to call ActionChains with - 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 - 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 - Move NEXT use and testing deprecated features out to its own test application so that the main TestApp isn't polluted with spurious warnings - Add a warning for the old ::[MVC]:: style naming scheme - Test for this - Kill Class::C3::Adopt::NEXT warnings for the Catalyst:: namespace in production versions - Tidy up Catalyst::ClassData to ensure that all components get the correct metaclass - Make MyApp.pm restartable by unsetting setup_finished in the restarter process - Non-naive implementation of making mutable on restart using B::Hooks::OP::Check::StashChange if installed - Tests for this - Naive implementation of making all components mutable in the forked restart watcher process so native Moose apps using immutable restart correctly. - Tests for this - Bump Moose dependency to 0.70 so that we avoid nasty surprises with is_class_loaded and perl 5.80 when you Moosify MyApp.pm - Clarify that request arguments aren't unescaped automatically (Simon Bertrang) (Closes RT#41153) - Don't require C3 for the MRO test - Bump MX::Emulate::CAF prereq to support list assignment - Remove useless column in chained action debug table. - namespace::clean related cleanups - Import related cleanups and consistency fixes - Fix test suite TestApp /dump/env action - Add $res->code as alias for $res->status - Make Catalyst::ClassData compatible with the latest Class::MOP::Class changes. Also depend on the latest Class::MOP. - Add $c->uri_for_action method. - Don't stringify the meta method. Use its name instead. - Use MooseX::MethodAttributes::Inheritable to contain action attributes. This means that attributes are now represented in the MOP, allowing method modifiers on actions to work as expected. - Provide a reasonable API in Catalyst::Controller for working with and registering actions, allowing a controller sub-class to replace subroutine attributes for action declerations with an alternate syntax. - Instantiate correct sub-class of Moose::Meta::Class for non-Moose components where Catalyst forces the creation of a metaclass instance. This is more correct, and avoids metaclass incompatibility in complex cases - Tests for this - Use of deprecated Catalyst::Base now warns. - Add uri_with tests 5.8000_06 2009-02-04 21:00 - Disallow writing to config after setup - Disallow calling setup more than once - Documentation fix regarding overloading of Engine and Dispatcher instances - Several documentation typo fixes - Stop Makefile.PL from warning about versions that fixed a conflict - Improved upgrading documentation - Seed the RNG in each FastCGI child process (Andrew Rodland) - Properly report dynamic bind port for the development server (Closes RT#38544) - Use the way documented by IO::Socket::INET to get the error message after trying to create a listening socket (Closes RT#41828) - Don't ignore SIGCHLD while handling requests with the dev server (Closes RT#42962) 5.8000_05 2008-29-01 00:00 - Text::SimpleTable's go as wide as $ENV{COLUMNS} (jhannah) Patch written by Oleg Kostyuk - Improve docs for visit (mateu) - Add docs for finalize hook (dhoss) - Added ru/ua translations to error page - Improve the clarity and verbosity of the warning when component resolution uses regex fallback. (jhannah) - Handle leading CRLF in HTTP requests sometimes sent by IE6 in keep-alive requests. - Fixes for FastCGI with IIS 6.0 (janus) - Passing request method exported by Catalyst::Test an extra parameter used to be ignored, but started breaking if the parameter was not a hash in 5.8000_04. Extra parameter is now ignored if it isn't a hashref - Fix request argumentss getting corrupted if you override the dispatcher and call an action which detaches (for Catalyst::Plugin::Authorization::ACL) - Fix calling use Catalyst::Test 'MyApp' 'foo' which used to work, but stopped as the 2nd parameter can be an options hash now - Bump Moose dependency to fix make_immutable bug - Use compile time extends in Catalyst::Controller - Make Catalyst::Request::uploads attribute non-lazy, to fix test for Catalyst-Engine-Apache - Bump version of MooseX::Emulate::Class::Accessor::Fast - Stop using MooseX::Adopt::Class::Accessor::Fast by default, to stop breaking other packages which use Class::Accessor::Fast - Remove unused action_container_class attribute from Catalyst::Dispatcher - Replace {_body} instance access with calls to _body accessors - Add backwards compatibility alias methods for private attributes on Catalyst::Dispatcher which used to be public. Needed by Catalyst::Plugin::Server and Catalyst::Plugin::Authorization::ACL - Fix return value of $c->req->body, which delegates to the body method on the requests HTTP::Body instance - Test for this - Fix calling $c->req->body from inside an overridden prepare_action method in a plugin, as used by Catalyst::Plugin::Server - Test for this - Fix assignment to Catalyst::Dispatcher's preload_dispatch_types and postload_dispatch_types attributes - assigning a list should later return a listref. Fixes Catalyst::Plugin::Server. - Tests for this - Change streaming test to serve itself rather than 01use.t, making test sync for engines easier - Refactor capturing of $app from Catalyst::Controller into Catalyst::Component::ApplicationAttribute for easier reuse in other components - Make the test suites YAML dependency optional - Make debug output show class name for the engine and dispatcher rather than the stringified ref. - Make MyApp immutable at the end of the scope after the setup method is called, fixing issues with plugins which have their own new methods by inlining a constructor on MyApp - Test for this and method modifiers in MyApp - Fix bug causing Catalyst::Request::Upload's basename method to return undef - Test for this (Carl Franks) - Fix loading of classes which do not define any symbols to not die, as it didn't in 5.70 - Test for this - Bump MooseX::Emulate::Class::Accessor::Fast dependency to force new version which fixes a lot of plugins - Make log levels additive, and add documentation and tests for the setup_log method, which previously had none. Sewn together by from two patches provided by David E. Wheeler - Switch an around 'new' in Catalyst::Controller to a BUILDARGS method as it's much neater and more obvious what is going on - Add a clearer method on request and response _context attributes, and use if from ::Engine rather than deleting the key from the instance hash - Use handles on tree attribute of Catalyst::Stats to replace trivial delegation methods - Change the following direct hash accesses into attributes: Catalyst::Engine: _prepared_write Catalyst::Engine::CGI: _header_buf Catalyst::Engine::HTTP: options, _keepalive, _write_error Catalyst::Request: _path Catalyst::Stats: tree - Fix issues in Catalyst::Controller::WrapCGI and any other components which import (or define) their own meta method by always explicitly calling Class::MOP::Object->meta inside Catalyst - Add test for this - Add test case for the bug which is causing the Catalyst::Plugin::Authentication tests to fail - Fix a bug in uri_for which could cause it to generate paths with multiple slashes in them. - Add test for this - Fix SKIP block name in t/optional_http-server-restart.t, stopping 'Label not found for "last SKIP"' error from Test::More - Workaround max_redirect 0 bug in LWP - Move live_engine_response_print into aggregate - Fix dependency bug, s/parent/base/ in new test - Fix optional tests to run the live tests in the aggregate dir - Fix Catalyst->go error in remote tests - Fix upload test to work with remote servers, don't check for deleted files - Fix engine_request_uri tests to work on remote server with different URI 5.8000_04 2008-12-05 12:15:00 - Silence Class::C3::Adopt::NEXT warnings in the test suite - Fix loads of 'used once, possible typo' warnings - Additional tests to ensure upload temp files are deleted - Remove use of NEXT from the test suite, except for one case which tests if Class::C3::Adopt::NEXT is working - Use a predicate to avoid recursion in cases where the uri method is overridden by a plugin, and calls the base method, for example Catalyst::Plugin::SmartURI - Test for this (caelum) - Compose the MooseX::Emulate::Class::Accessor::Fast role to Catalyst::Action, Catalyst::Request, and all other modules which inherit from Class::Accessor::Fast in 5.70. This fixes: - Catalyst::Controller::HTML::FormFu (zamolxes) - Catalyst::Request::REST - Test for this - Make hostname resolution lazy (Marc Mims) - Support mocking virtualhosts in test suite (Jason Gottshall) - Add README - Fix TODO list - Use Class::C3::Adopt::NEXT - Ignore C3 warnings on 5.10 when testing ensure_class_loaded - Add TODO test for chained bug (gbjk) - Fix list address in documentation (zarquon) - Fix ACCEPT_CONTEXT on MyApp, called as a class method - Test for this - Bump MooseX::Emulate::Class::Accessor::Fast version requirement to get more back compatibility - Improve documentation for $req->captures (caelum) - Fix a bug in Catalyst::Stats, stopping garbage being inserted into the stats if a user calls begin => but no end => (jhannah) - Test for this (jhannah) - Trim lines sooner in stats to avoid ugly Text::SimpleTable wrapping (jhannah) - Change Catalyst::ClassData to tweak the symbol table inline for performance after profiling - Fix POD typo in finalize_error (jhannah) - Add tests to ensure that we delete the temp files created by HTTP::Body's OctetStream parser 5.8000_03 2008-10-14 14:13:00 - Fix forwarding to Catalyst::Action objects. - Fix links to the mailing lists (RT #39754 and Florian Ragwitz). - Use Class::MOP instead of Class::Inspector. - Change Catalyst::Test to use Sub::Exporter. - Fixed typo in Engine::HTTP::Restarter::Watcher causing -r to complain. 5.8000_02 2008-10-14 07:59:00 - Fix manifest 5.8000_01 2008-10-13 22:52:00 - Port to Moose - Added test for action stringify - Added test for component instances getting $self->{value} from config. - Add Catalyst::Response->print() method - Optionally aggregate tests using Test::Aggregate. - Additional docs for uri_for to mention how to use $c->action and $c->req->captures (jhannah) - List unattached chained actions in Debug mode. - Pod formatting fix for Engine::FastCGI (Oleg Kostyuk). - Add visit, a returning ->go 5.7XXXXXX XXXX - Workaround change in LWP that broke a cookie test (RT #40037) - Back out go() since that feature's been pushed to 5.80 - Fix some Win32 test failures - Add pt translation of error message (wreis) - Make :Chained('../action') work - Add test actions - Chained doc improvements (rev 8326-8328) 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 5.7099_01 2008-06-25 22:36:00 - 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 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 - Fix regression for relative uri_for arguments after a forward() introduced in 5.7013 (Peter Karman) - Fix regression for "sub foo : Path {}" in the root controller which was introduced when attempting to allow "0" as a Path. 5.7013 2008-05-16 18:20:00 - Provide backwards compatability methods in Catalyst::Stats - Fix subdirs for scripts that run in subdirs more than one level deep. - Added test and updated docs for handling the Authorization header under mod_fastcgi/mod_cgi. - Fixed bug in HTTP engine where the connection was not closed properly if the client disconnected before sending any headers. (Ton Voon) - POD fix, IO::FileHandle => IO::Handle (RT #35690) - Fix grammar on welcome page (RT #33236) - Fix for Path('0') handling (RT #29334) - Workaround for Win32 and c3_mro.t (RT #26452, tested by Kenichi Ishigaki) - Fix for encoding query parameters - Fix Chained multiple test 5.7012 2007-12-16 23:44:00 - Fix uri_for()'s and uri_with()'s handling of multibyte chars (Daisuke Murase) - Fix __PACKAGE__->config->{foo} = 'bar' case with subclassing - Add Catalyst::Stats (Jon Schutz) - Fixed a bug where ?q=bar=baz is decoded as q=>'bar', not 'bar=baz'. (Tatsuhiko Miyagawa, Masahiro Nagano) - Fixed a bug where -rr (restart regex) command line option could cause shell errors. (Aristotle Pagaltzis, Chisel Wright) 5.7011 2007-10-18 20:40:00 - Allow multiple restart directories and added option to follow symlinks in the HTTP::Restarter engine (Sebastian Willert) - Fixed t/optional_http-server-restart.t so it actually tests if the server restarted or notified of an error (Sebastian Willert) - Return child PID from the HTTP engine when run with the 'background' option. (Emanuele Zeppieri) - Fixed bug in HTTP engine where writes could fail with 'Resource temporarily unavailable'. - Fixed bug where %2b in query parameter is doubly decoded to ' ', instead of '+' (RT #30087, Gavin Henry, Tatsuhiko Miyagawa, Oleg Pronin) - Fixed bug where req->base and req->uri would include a port number when running in SSL mode. - Removed unnecessary sprintf in debug mode that caused warnings on locales where commas are used for decimal markers. - Improved error message for case when server picks up editor save files as module names. (James Mastros) 5.7010 2007-08-22 07:41:00 - Resource forks in 5.7009 5.7009 2007-08-22 00:14:00 - Moved Manual.pod to Manual.pm and clarified status of Catalyst-Manual dist - Doc patches to Catalyst::Controller - remove ignore_loaded from plugin load, commenting why - document the ignore_loaded feature in Catalyst::Utils - Add testing of inline plugins. 5.7008 2007-08-13 08:40:00 - Added $c->request->query_keywords for getting the keywords (a query string with no parameters). - Add undef warning for uri_for. - Fix bug where a nested component would be setup twice. - Make ensure_class_loaded behave better with malformed class name. - Make _register_plugin use ensure_class_loaded. - Remove 'Argument "??" isn't numeric in sprintf' warning. (Emanuele Zeppieri) - Fixed a bug where Content-Length could be set to 0 if a filehandle object in $c->response->body did not report a size. - Fixed issue where development server running in fork mode did not properly exit after a write error. (http://rt.cpan.org/Ticket/Display.html?id=27135) - Remove warning for captures that are undef. - Fixed $c->read and parse_on_demand mode. - Fixed a bug with the HTTP engine where very large response bodies would not be sent properly. 5.7007 2007-03-13 14:18:00 - Many performance improvements by not using URI.pm: * $c->uri_for (approx. 8x faster) * $c->engine->prepare_path (approx. 27x faster) * $c->engine->prepare_query_parameters (approx. 5x faster) - Updated HTTP::Body dependency to 0.9 which fixes the following issues: * Handle when IE sometimes sends an extra CRLF after the POST body. * Empty fields in multipart/form-data POSTs are no longer ignored. * Uploaded files with the name "0" are no longer ignored. - Sending SIGHUP to the dev server will now cause it to restart. - Allow "0" for a path in uri_for. - Performance and stability improvements to the built-in HTTP server. - Don't ignore file uploads if form contains a text field with the same name. (Carl Franks) - Support restart_delay of 0 (for use in the POE engine). - Skip body processing if we don't have a Content-Length header. Results in about a 9% performance increase when handling GET/HEAD requests. - Add a default body to redirect responses. - MyApp->model/view now looks at MyApp->config->{default_view/model} (Bogdan Lucaciu) 5.7006 2006-11-15 14.18 - Updated manifest - Fix Slurp dependency - Updated HTTP::Body dependency to 0.6, 0.5 can break on large POST requests. - Skip utf8 fix for undef values in uri_with() and uri_for() 5.7005 2006-11-07 19:37:35 - Fixed lighttpd tests to be properly skipped. - Moved IE workarounds to exist only in the HTTP engine. - Added installation instructions (from Catalyst-Manual dist) 5.7004 2006-11-06 20:48:35 - Fix Engine::HTTP crash when using IE. (Jesper Krogh, Peter Edwards) - clean up Catalyst::Utils to handle some edge cases - Properly work around lighttpd PATH_INFO vs. SCRIPT_NAME bug (Mark Blythe) - add _application accessor to Catalyst::Base - Support current_view - Allow use of Catalyst::Test without app name (Ton Voon, Altinity) - Catalyst::Manual moved to its own package - Add option to FastCGI engine to send errors to stdout, not the web server - Use Module::Install's auto_install to install prerequisite modules - various documentation fixes and improvements 5.7003 2006-09-21 16:29:45 - Additions and updates to tutorial 5.7002 2006-09-17 19:35:32 - unescape captures to match args - fix for relative Chained under namespace '' (root) - fix for hashrefs in action attributes from config - fix for Chained to require correct number of CaptureArgs 5.7001 2006-07-19 23:46:54 - fix for component loading - uri_for and uri_with now behave as they used to with non- array references 5.7000 2006-07-07 08:08:08 - fix FCGI.pm warning message with FastCGI engine - bumped inc::Module::Install to 0.63 in Makefile.PL - fixes to uri_for_action for DispatchType::Chained - Further doc work. - Minor code cleanups - Changed catalyst.pl to depend on Catalyst::Devel 5.70_03 2006-06-28 16:42:00 - fixup to registered plugins debug at app startup - refactored Catalyst::Utils::home 5.70_02 2006-06-27 11:51:00 - Updated tutorial. 5.70_01 2006-06-26 10:49:00 - fixed a Catalyst::Base bug causing duplicate action registrations - modified DispatchTypes to support multiple registrations - added Catalyst::Runtime module as dist marker - added Catalyst::ActionChain and Chained DispatchType - removed retarded registration requirement in dispatcher - removed Module::Pluggable::Fast hack in favor of Module::Pluggable::Object - extended uri_for, added dispatcher->uri_for_action - added Catalyst::Base->action_for('methodname') - checked and tested :Args multimethod dispatch - added ability to set action attributes from controller config - added merge_config_hashes() as a convenience method - Swapped out CGI::Cookie in favour of CGI::Simple::Cookie - Removed test dependencies on Test::NoWarnings, Test::MockObject - Removed dependency on UNIVERSAL::require - Split out Catalyst::Helper into a new distribution - un-bundled the plugins as they are now pre-reqs for Catalyst::Helper - nuked each() out of core with prejudice (due to lurking buglets) - Added tests from phaylon for dispatcher precedence - Use Class::Inspector->loaded($class) instead of $class->can('can') - Added ActionClass attribute - Removed Test::WWW::Mechanize::Catalyst from Makefile.PL (circular dep) - Updated docs for Catalyst::Component - Separated execute and dispatch on Catalyst::Action - cleaned up logging and debug output - significant documentation revisions - Added warning for setup being called twice - Fix pod to use DBIC::Schema instead of DBIC model - Fix ->config failing to copy _config for subclassing - Updated log format - Updated debug dump 5.6902 2006-05-04 13:00:00 - Remove tarballs and OSX metadata files. 5.6901 2006-05-03 11.17:00 - Module::Install didn't overwrite META.yml. 5.6900 2006-05-03 11.17:00 - Stupid pause indexer can't count. - Better fix for Catalyst::Test - more tests. 5.682 2006-04-27 13:51:00 - Damn OSX attributes again :( 5.681 2006-04-27 08:47:00 - Updated manifest. - Add basename to core . (Deprecates Catalyst::Plugin::Basename) 5.68 2006-04-26 12:23:00 - ConfigLoader: Updated to version 0.06 - fixed undef warnings in uri_for() and uri_with() - Fixed Catalyst::Test to report errors on failed Class load 5.678 2006-04-24 12:30:00 - Re-release of 5.67 without OSX metadata files. 5.67 2006-04-23 08:50:00 - Added $c->req->uri_with() helper - ConfigLoader: Updated to version 0.05 - Fix up Engine to avoid a new 5.8.8 warning - Added app name with :: support for PAR - Added $c->models/views/controllers - Static::Simple: Unescape the URI path before looking for the file. This fixes issues with files that have spaces. - Looping and recursion tests plus a fix - Added lots of API documentation. Refactored main pod. - Changed default behaviors for $c->model/$c->controller/$c->view to more sane settings. - added the clear_errors method - an alias for error(0) - Added tmpdir option for uploads (woremacx) - Applied patch from GEOFFR to allow normal filehandles. - Refactored Dispatcher internals for better readability and speedup (stress tests run 12% faster) - Allow $c->error to run as a class method 5.66 2006-03-10 17:48:00 - Added Test::WWW::Mechanize::Catalyst support - Cleaned generated tests - Added Root controller concept - Updated ConfigLoader plugin to version 0.04 5.65 2006-02-21 10:34:00 - Added plugin introspection. - Support optional hashref as last param for parameters in uri_for. - Updated tutorial to be more complete. - Applied args patch from antirice (Fixes Ticket #67) 5.64 2006-02-07 20:29:00 - Fixed bug in FastCGI proc manager mode where pm_post_dispatch was not run. (Eric Wong) - Cleaned up generated tests - Updated YAML support to use ConfigLoader - Fixed path dispatch to canonicalise correctly (see http://dev.catalyst.perl.org/ticket/62) - Added Catalyst::Manual::About 5.63 2006-01-22 00:00:00 - Updated prereq versions 5.62 2006-01-17 16:30:00 - Large update to the tutorial (castaway) - Added YAML config support - Added COMPONENT() and ACCEPT_CONTEXT() support - Action list in debug mode is now displayed as a tree in the correct execution order. - Fixed engine detection to allow custom mod_perl engines. - Static::Simple: Fixed bug in ignore_dirs under win32. - Display version numbers of loaded plugins. (Curtis Poe) - Added class and method for caught exception messages. - Updated PAR support to use "make catalyst_par", packages are no longer written by Makefile.PL. - Automatically determine Content-Length when serving a filehandle. - Exceptions now return status 500. - Updated for Module::Install 0.44. - Fixed additional file installation for multi level app names. - Added REDIRECT_URL support for applications running behind a RewriteRule in Apache. (Carl Franks) - Fixed FastCGI engine under win32. (Carl Franks) - FastCGI doc updates (Bill Moseley) - Bugfix for $c->model and friends (defined). 5.61 2005-12-02 00:00:00 - Fixed ExtUtils::AutoInstall Bootstrap Code in Makefile.PL 5.60 2005-12-01 22:15:00 - Fixed Path and index actions in the appclass, including those that attach to / - Index is now weighted higher than Path - Fixed restarter and -d debug switch in server.pl. - Added a warning if you attempt to retrieve a parameter using $c->req->params('foo'). - Fixed the Module::Install::Catalyst @ISA bug 5.59 2005-11-30 13:25:00 - Fixed shebang line for generated scripts - Fixed forward to classes ($c->forward(qw/MyApp foo/)) - Wrap use block in begin to quelch C:C3 warnings - Removed scrollbar from debug output - Fixed catalyst_par_core() and catalyst_par_multiarch() 5.58 2005-11-24 10:51:00 - Added ExtUtils::AutoInstall support - Allow overriding path in Catalyst::Helper. - Added -makefile to catalyst.pl to generate a new Makefile.PL. - Restored Catalyst::Build with a deprecation notice. - Improved PAR support - Replaced -short with auto-detection - Fixed prereqs, added File::Copy::Recursive - Static::Simple changes: - Made prepare_action play nice with other plugins by not short- circuiting. - Added tmpl to the ignored extensions. - Fixed security problem if req->path contained '..'. 5.57 2005-11-20 22:45:00 - Updated uri_for to accept undef actions - Switched to Module::Install - Renamed tests for easier editing - Reformatted documentation - Renamed -nonew to -force - Added PAR support - Added keep-alive support and bug fixes to HTTP engine. (Sascha Kiefer) - Added daemonize option to FastCGI engine. (Sam Vilain) 5.56 2005-11-16 10:33:00 - Fixed FastCGI engine to not clobber the global %ENV on each request. (Sam Vilain) - Updated benchmarking to work with detach - Fixed dispatcher, so $c->req->action(undef) works again - Updated Catalyst::Test to use HTTP::Request::AsCGI - Added -pidfile to external FastCGI server. 5.55 2005-11-15 12:55:00 - Fixed multiple cookie handling 5.54 2005-11-14 22:55:00 - Fixed a Module::Pluggable::Fast related bug 5.53 2005-11-14 15:55:00 - Removed t/04prereq.t that was testing for non-required modules. 5.52 2005-11-14 10:57:00 - Strip '..'s in static urls to fix security issue. 5.51 2005-11-14 00:45:00 - Changed uri_for to use namespace instead of match. 5.50 2005-11-13 20:45:00 - Fixed minor bugs. - Updated docs. 5.49_05 2005-11-12 20:45:00 - Large update to the documentation. (David Kamholz) - Fixed args handling in forward() - Fixed forwarding to classes - Fixed catalyst.pl-generated Build.PL Makefile section. - Fixed relative forwarding - Fixed forward arrows in debug output 5.49_04 2005-11-09 23:00:00 - Made context, dispatcher, engine, request and response classes configurable. - Added $c->stack. - Fixed dispatcher to ignore unknown attributes. - Improved format of startup debug log. - Updated built in server to restart on win32. (Will Hawes) - Fixed streaming write from a filehandle to stop writing if the browser is closed. - Added $c->controller, $c->model and $c->view shortcuts. - Switched to Text::SimpleTable. 5.49_03 2005-11-03 12:00:00 - Fixed $c->req->{path} for backwards-compatibility. - Allow debug to be disabled via ENV as well as enabled. - Added -scripts option to catalyst.pl for script updating - Changed helpers to default to long types, Controller instead of C - Added Catalyst::Controller, Catalyst::Model and Catalyst::View base classes - Added JavaScript to debug screen to show and hide specific dumps - Added _DISPATCH, _BEGIN, _AUTO, _ACTION and _END actions - Added multi process external FastCGI support (see myapp_fastcgi.pl -help) (Sam Vilain) - Restarter process in HTTP engine now properly exits when the parent app is shut down. - Improved performance of restarter loop while watching for changed files. - Restarter will now detect new files added to an app on systems that change directory mtimes when new files are created. - Restarter now properly handles modules that are deleted from an application. - Fixed memory leak in TestApp. 5.49_02 2005-10-26 12:39:00 - Whole new dispatcher! - Added index action - Added path_to method - Added support for passing an IO::Handle object to $c->res->body. (Andrew Bramble) - Added a new welcome screen. - Included Catalyst buttons and icons in helper. - Added Static::Simple plugin to core. - Added self restarting test server - Added filename to debug output for uploaded files. - Fixed forwarding with embedded arguments. - Fixed handling of escaped query strings. - Added upload parameters back into $c->req->params. - Added multiple paths support to dispatcher - Fixed bug in req->path where changing the path added a trailing slash. - Removed req->handle and res->handle - Added prepare_body_chunk method as a hook for upload progress. - Fixed bug in uri_for method when base has no path. - Added automated tests for HTTP, CGI, and FastCGI servers. 5.49_01 2005-10-10 10:15:00 - Refactored all internals, should be 99% compatible to previous versions. - *IMPORTANT* The Apache engines have been moved to a separate package for this release. Please install Catalyst::Engine::Apache if you need Apache support. - Added support for calling forward with arguments in the path, i.e. $c->forward('/foo/bar/arg1/arg2') - Made $c->req->uri a URI object, added req->path_info for CGI compat. Raw query string is available as $c->req->uri->query. - Made $c->req->base a URI object. - Parameters with multiple values (?a=1&a=2) now display properly in the debug output. - Semi-colon separators in query strings now work properly. - Expanded documentation of catalyst.pl (Andrew Ford) - Added support for running as a backend server behind a frontend proxy so req->base and req->address are set properly. - Added an 'abort' method to the Log api, so that you can kill loggging for a whole request. - Added $c->uri_for method to simplify url handling. - Added more tests and reorganized the t directory. - Reimplemented core engines, all are now CGI based for better test coverage and maintainability. - Added fork support to built in test server. - Fixed all memory leaks. - Thread-related bug fixes and tests. We now believe the Catalyst core to be thread-safe. - Added streaming IO support through $c->req->read() and $c->res->write() - Added MyApp->config->{parse_on_demand} (streaming input) - Added $c->req->handle and $c->res->handle - Improved documentation - Fixed mkpath in Catalyst::Helper (Autrijus Tang) - Fixed bug in dispatcher where an invalid path could call a valid action. (Andy Grundman) - Fixed Helper so it works with CRLF line-endings. (Andy Grundman) 5.33 2005-08-10 15:25:00 - Now with updated manifest. 5.32 2005-08-10 15:10:00 - Dispatcher might fail if object returns false. 5.31 2005-06-04 12:35:00 (never released to CPAN) - helpers now create .new files where files already exist and differ - fixed $Data::Dumper::Terse (Robin Berjon) - added arguments for detach - new credits section in POD - fixed detach to allow relative action names (Matt and Robert) - added the ability to have whitespaces in Path( '' ) and Regex( '' ) 5.30 2005-06-04 12:35:00 - Fixed a bug where it was not possible to $c->forward to a component that was not inheriting from Catalyst::Base. - Fix for inheritance bug. - Allow forward with arguments. - Updated cookbook - Allow overriding home/root in config. - make module build cons README automatically. - prettify home path by resolving '..' (Andy Grundman) - improved helper templates a bit, new naming scheme for tests. - added support for case sensitivity, MyApp->config->{case_sensitive} - added $c->detach for non-returning forwards - added unified error handling, Catalyst::Exception - added section on param handling in Intro.pod - added $c->request->cookie - added Catalyst::Setup - refactored Catalyst::import() - improved rendering of error messages in debug mode - fixed a bug in Catalyst::Helper::mk_dir - further doc changes, esp. to Intro.pod 5.23 2005-06-03 02:30:00 - added support for non Catalyst::Base components to live in namespace - improved concurrency connections in Catalyst::Engine::HTTP::Daemon 5.22 2005-05-26 14:24:00 - improved base locating in MP engines - improved error messages in C::E::HTTP::Daemon - hostnames are now resolved on demand unless provided by engine - fixed memory leak in $c->execute (Michael Reece, Matt S Trout) 5.21 2005-05-24 14:56:00 - fixed a bug in https detection - fixed auto chain finally - added MYAPP_HOME and CATALYST_HOME environment variables 5.20 2005-05-18 19:52:00 - improved uploads and parameters - added $c->req->protocol and $c->req->secure - added $c->req->user and $c->req->uri - improved error message when forwarding to unknown module - fixed win32 installer - added deep recursion detection - fixed auto actions - fixed inheritance in dispatcher - allow whitespaces between brackets and quoted string in Path and Regex attributes - new helper templates - installer now supports install_base and destdir - allow multiple Catalyst apps to run on the same mod_perl instance (not the same app!) - fixed MP2 engines - removed apreq dependency from all MP engines - added support for MP registry scripts - added support for LocationMatch and ScriptAliasMatch in MP engines - added SpeedyCGI engine 5.10 2005-04-23 11:16:00 - updated dependencies to require latest module::pluggable::fast - new installer for templates and stuff using Module::Build - scripts are now prefixed, for being installable IMPORTANT: You have to regenerate the script directory, remove Makefile.PL and add Build.PL - Added compat to install Module::Build if required. - Improved: Params handling with MP engines - Fixed: Params handling on POST with CGI engine (Andy Grundman) - Fixed: Helper.pm on Win32 (Matt S Trout) 5.03 2005-04-19 20:35:00 (Revision 462) - fixed Test example (Torsten Seeman) - added Plugins chapter to manual - applied doc patch from Robert Boone - improved Dispatcher error messages. - refactored so we don't need to include helper from Catalyst.pm - Fixes issues with FindBin - applied HTTP.pm patch from Andy Grundman - added plugin() method for instant plugins - FCGI is no more considered experimental 5.02 2005-04-18 10:00:00 - fixed manifest 5.01 2005-04-17 23:00:00 - some documentation bugs fixed - added Catalyst::Utils - fixed regexp bug (Matt S Trout) - fixed upload bug with MP19 - added $c->req->body - aliased $c->res->output to $c->res->body - Read AUTHOR from passwd or $ENV{AUTHOR} when generating code. - extended attribute handling - added global config for components 5.00 2005-04-15 18:00:00 - new core to support inheritance trees - new syntax for action declaration - new helper system using TT2 - problems with mod_perl2 fixed - added Test::Pod support - added new server backend with HTTP/1.1 support - added option to run tests against a remote server - renamed errors() to error() - more better docs - countless minor improvements IMPORTANT: This release is very incompatible to previous ones and you have to regenerate the helper scripts again... 4.34 2005-03-23 07:00:00 2005 - added some messages to Makefile.PL - added Catalyst::Engine::Test - added Catalyst::Engine::CGI::NPH - simplified Catalyst::Log to be easier to implement/subclass - added cgi.pl - updated Catalyst::Test to use Catalyst::Engine::Test - updated helper scripts IMPORTANT: this will be the last time you'll have to regenerate the script directory. We promise! 4.33 2005-03-23 01:00:00 2005 - documented the log() accessor method in Catalyst (Andrew Ford) - added optional arguments to Catalyst::Log methods (Andrew Ford) - removed cgi-server.pl - added fcgi.pl and Catalyst::Engine::FCGI - fixed an undef durng make test (Dan Sully) - new path test (Christian Hansen) IMPORTANT: you have to regenerate the script directory again 4.32 2005-03-22 02:10:00 2005 - made a damn typo *AAAAAAAAAAAAAAHHHH!!!* 4.31 2005-03-22 02:00:00 - fixed inheritance (Christian Hansen) - previous release was borked! fixed that, but you have to regenerate the scripts again :( 4.30 2005-03-21 23:00:00 - more documentation (Andrew Ford) - added connection informations (Christian Hansen) - HTTP::Request support in Catalyst::Test (Christian Hansen) - moved cgi.pl to nph-cgi.pl - added Catalyst::Engine::Server (Christian Hansen) - removed Catalyst::Test::server - updated helper scripts IMPORTANT: note that you have to regenerate script/server.pl, script/cgi-server.pl and script/cgi.pl (now nph-cgi.pl) 4.28 2005-03-19 22:00:00 - fixed isa tree (Christian Hansen) - added script/cgi-server.pl, so no more server restarting after code changes - reworked documentation (Andrew Ford ) 4.27 2005-03-19 01:00:00 - debug message for parameters - Fix redirects (Christian Hansen ) - some random fixes - new helper api for Catalyst::Helper::* support you have to update script/create.pl to use it 4.26 2005-03-16 10:00:00 - fixed the weird bug that caused regex actions to fail on every second request - more debug messages - 100% pod coverage. 4.25 2005-03-12 18:00:00 - correct perl pathes for helper generated scripts (Tatsuhiko Miyagawa) - improved cgi engine docs (Christoper Hicks) 4.24 2005-03-12 01:00:00 - updated cookbook example - fixed base for apache and https (Andrew Ruthven) 4.23 2005-03-09 20:00:00 - no more regex actions in forward - added support for test directories t/m, t/v and t/c 4.22 2005-03-08 20:00:00 - catch errors in application class - handle die properly. 4.21 2005-03-05 17:00:00 - fixed docs 4.20 2005-03-04 22:00:00 - moved bin to script 4.13 2005-03-03 11:00:00 - improved documentation - pod coverage test for helper generated apps - new helper api 4.12 2005-03-02 11:00:00 2005 - server_base sucks, removed - added $c->log->dump() 4.11 2005-03-02 11:00:00 2005 - removed some warnings - improved docs - private prefixed actions override private non prefixed actions - added server_base - updated Catalyst::Manual::Intro 4.10 2005-03-02 10:00:00 2005 - improved documentation - fixed upload bug - fixed prefixed private actions bug - fixed more little bugs 4.01 2005-03-01 10:00:00 2005 - improved documentation - documentation fixes (Johan Lindstrom) 4.00 2005-02-27 22:00:00 - more verbose debug messages, especially for forward() - implemented prefixed prvate actions, icluding built in !?default, !?begin and !?end - new Catalyst::Manual::Intro - new helpers, bin/catalyst - helper api 3.11 2005-02-23 21:00:00 - added dependency to UNIVERSAL::require (Marcus Ramberg) - added a little workaround for a warning in Catalyst::Test (Marcus Ramberg) - improved documentation for actions 3.10 2005-02-19 20:00:00 - removed roles management from Catalyst::Engine and added it to Catalyst::Plugin::Authentication::CDBI 3.04 2005-02-17 21:00:00 - error reporting for app class - no more engine debug messages - class->method forwards get resolved now 3.03 2005-02-16 23:00:00 - friendlier statistics 3.02 2005-02-16 22:00:00 - fixed unintialized actions (Marcus Ramberg) 3.01 2005-02-16 20:30:00 - better statistics 3.00 2005-02-16 20:00:00 - real version number for CPAN.pm - fixed redirect in CGI engine - more statistics in debug logs - ? prefix for forward() 2.99_15 2005-02-02 22:00:00 - support for short namespaces, MyApp::M, MyApp::V and MyApp::C - Replaced "Catched" with "Caught" in Catalyst::Engine (Gary Ashton Jones) - replaced _ with ! for private actions - added ? for prefixed actions - misc improvememts 2.99_14 2005-01-31 22:00:00 2005 - arguments for _default - $c->entrance removed for more flexibility - added $c->req->method 2.99_13 2005-01-30 18:00:00 2005 - POD fixes and improvements 2.99_12 2005-01-28 22:00:00 2005 - first development release Catalyst-Runtime-5.90053/inc/000755 000765 000024 00000000000 12255610005 015752 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/000755 000765 000024 00000000000 12255610005 015747 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/Makefile.PL000644 000765 000024 00000020373 12255577340 017176 0ustar00johnstaff000000 000000 use strict; use warnings; use inc::Module::Install 0.91; # Ensure that these get used - yes, M::I loads them for us, but if you're # in author mode and don't have them installed, then the error is tres # cryptic. if ($Module::Install::AUTHOR) { # We could just use them, but telling my @fail; # people the set of things they need nicer foreach my $module (qw/ Module::Install::AuthorRequires Module::Install::CheckConflicts Module::Install::AuthorTests Module::Install::Authority /) { push(@fail, $module) unless eval qq{require $module; 1;}; } die("Module::Install extensions failed, not installed? \n" . join("\n", map { " $_" } @fail) . "\n") if @fail; } perl_version '5.008003'; name 'Catalyst-Runtime'; author 'Sebastian Riedel '; authority('cpan:MSTROUT'); all_from 'lib/Catalyst/Runtime.pm'; requires 'List::MoreUtils'; requires 'namespace::autoclean' => '0.09'; requires 'namespace::clean' => '0.23'; requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903'; requires 'Class::Load' => '0.12'; requires 'Data::OptList'; requires 'Moose' => '1.03'; requires 'MooseX::MethodAttributes::Role::AttrContainer::Inheritable' => '0.24'; requires 'MooseX::Role::WithOverloading' => '0.09'; requires 'Carp'; requires 'Class::C3::Adopt::NEXT' => '0.07'; requires 'CGI::Simple::Cookie' => '1.109'; requires 'Data::Dump'; requires 'Data::OptList'; requires 'HTML::Entities'; requires 'HTML::HeadParser'; requires 'HTTP::Body' => '1.06'; # ->cleanup(1) requires 'HTTP::Headers' => '1.64'; requires 'HTTP::Request' => '5.814'; requires 'HTTP::Response' => '5.813'; requires 'HTTP::Request::AsCGI' => '1.0'; requires 'Module::Pluggable' => '4.7'; requires 'Path::Class' => '0.09'; requires 'Scalar::Util'; requires 'Sub::Exporter'; requires 'Text::SimpleTable' => '0.03'; requires 'Time::HiRes'; requires 'Tree::Simple' => '1.15'; requires 'Tree::Simple::Visitor::FindByPath'; requires 'Try::Tiny' => '0.17'; requires 'Safe::Isa'; requires 'Task::Weaken'; requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness requires 'MRO::Compat'; requires 'MooseX::Getopt' => '0.48'; requires 'String::RewritePrefix' => '0.004'; # Catalyst::Utils::resolve_namespace requires 'Devel::InnerPackage'; # No longer core in blead requires 'Plack' => '0.9991'; # IIS6+7 fix middleware requires 'Plack::Middleware::ReverseProxy' => '0.04'; requires 'Plack::Test::ExternalServer'; requires 'Class::Data::Inheritable'; requires 'Encode' => '2.49'; requires 'LWP' => '5.837'; # LWP had unicode fail in 5.8.26 requires 'URI' => '1.36'; requires 'JSON::MaybeXS' => '1.000000'; requires 'Stream::Buffered'; requires 'Hash::MultiValue'; requires 'Plack::Request::Upload'; requires 'CGI::Struct'; # Install the standalone Regex dispatch modules in order to ease the # deprecation transition requires 'Catalyst::DispatchType::Regex' => '5.90021'; test_requires 'Test::Fatal'; test_requires 'Test::More' => '0.88'; test_requires 'Data::Dump'; test_requires 'HTTP::Request::Common'; test_requires 'IO::Scalar'; test_requires 'HTTP::Status'; test_requires 'JSON::MaybeXS'; # see also cpanfile for authordeps -- install via # cpanm --installdeps --with-develop . # aggregate tests if AGGREGATE_TESTS is set and a recent Test::Aggregate and a Test::Simple it works with is available my @author_requires; if ($ENV{AGGREGATE_TESTS} && can_use('Test::Simple', '0.88') && can_use('Test::Aggregate', '0.364')) { push(@author_requires, 'Test::Aggregate', '0.364'); push(@author_requires, 'Test::Simple', '0.88'); open my $fh, '>', '.aggregating'; } else { unlink '.aggregating'; tests 't/*.t t/aggregate/*.t'; } push(@author_requires, 'CatalystX::LeakChecker', '0.05'); push(@author_requires, 'Catalyst::Devel', '1.0'); # For http server test push(@author_requires, 'Test::WWW::Mechanize::Catalyst', '0.51'); push(@author_requires, 'Test::TCP', '2.00'); # ditto, ships Net::EmptyPort author_tests('t/author'); author_requires( @author_requires, map {; $_ => 0 } qw( File::Copy::Recursive Catalyst::Engine::PSGI Test::Without::Module Starman MooseX::Daemonize Test::NoTabs Test::Pod Test::Pod::Coverage Test::Spelling Pod::Coverage::TrustPod Catalyst::Plugin::Params::Nested Catalyst::Plugin::ConfigLoader )); if ($Module::Install::AUTHOR) { darwin_check_no_resource_forks(); } 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/', # r/w: catagits@git.shadowcat.co.uk:Catalyst-Runtime.git 'repository', => 'git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git', ); install_script glob('script/*.pl'); auto_install; WriteAll; print <<"EOF"; Important: This library is for running Catalyst applications. For development and use of catalyst.pl and myapp_create.pl, make sure you also install the development tools package Catalyst::Devel. perl -MCPANPLUS -e 'install Catalyst::Devel' # or perl -MCPAN -e 'install Catalyst::Devel' # or cpanm Catalyst::Devel To get some commonly used plugins, as well as the TT view and DBIC model, install Task::Catalyst in the same way. Have fun! EOF # NOTE - This is the version number of the _incompatible_ code, # not the version number of the fixed version. my %conflicts = ( 'Catalyst::Plugin::SubRequest' => '0.14', 'Catalyst::Model::Akismet' => '0.02', 'Catalyst::Component::ACCEPT_CONTEXT' => '0.06', 'Catalyst::Plugin::ENV' => '9999', # This plugin is just stupid, full stop # should have been a core fix. 'Catalyst::Plugin::Unicode::Encoding' => '0.2', 'Catalyst::Plugin::Authentication' => '0.10010', # _config accessor in ::Credential::Password 'Catalyst::Authentication::Credential::HTTP' => '1.009', 'Catalyst::Plugin::Session::Store::File' => '0.16', 'Catalyst::Plugin::Session' => '0.21', 'Catalyst::Plugin::Session::State::Cookie' => '0.10', 'Catalyst::Plugin::Session::Store::FastMmap' => '0.09', 'Catalyst::Controller::AllowDisable' => '0.03', 'Reaction' => '0.001999', 'Catalyst::Plugin::Upload::Image::Magick' => '0.03', 'Catalyst::Plugin::ConfigLoader' => '0.22', # Older versions work but # throw Data::Visitor warns 'Catalyst::Devel' => '1.19', 'Catalyst::Plugin::SmartURI' => '0.032', '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', 'Catalyst::Action::REST' => '0.67', 'CatalystX::CRUD' => '0.42', 'CatalystX::CRUD::Model::RDBO' => '0.20', 'Catalyst::View::Mason' => '0.17', # Note these are not actually needed - they fail tests against the # new version, but still work fine.. # 'Catalyst::ActionRole::ACL' => '0.05', # 'Catalyst::Plugin::Session::Store::DBIC' => '0.11', 'Test::WWW::Mechanize::Catalyst' => '0.53', # Dep warnings unless upgraded. ); 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 =~ /^10.(5|6|7|8)/ ? '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' }); } } Catalyst-Runtime-5.90053/MANIFEST000644 000765 000024 00000040647 12254600325 016350 0ustar00johnstaff000000 000000 Changes inc/Module/AutoInstall.pm inc/Module/Install.pm inc/Module/Install/Authority.pm inc/Module/Install/AuthorRequires.pm inc/Module/Install/AuthorTests.pm inc/Module/Install/AutoInstall.pm inc/Module/Install/Base.pm inc/Module/Install/Can.pm inc/Module/Install/CheckConflicts.pm inc/Module/Install/Fetch.pm inc/Module/Install/Include.pm inc/Module/Install/Makefile.pm inc/Module/Install/Metadata.pm inc/Module/Install/Scripts.pm inc/Module/Install/Win32.pm inc/Module/Install/WriteAll.pm lib/Catalyst.pm lib/Catalyst/Action.pm lib/Catalyst/ActionChain.pm lib/Catalyst/ActionContainer.pm lib/Catalyst/ActionRole/ConsumesContent.pm lib/Catalyst/ActionRole/HTTPMethods.pm lib/Catalyst/Base.pm lib/Catalyst/ClassData.pm lib/Catalyst/Component.pm lib/Catalyst/Component/ApplicationAttribute.pm lib/Catalyst/Component/ContextClosure.pm lib/Catalyst/Controller.pm lib/Catalyst/Delta.pod lib/Catalyst/Dispatcher.pm lib/Catalyst/DispatchType.pm lib/Catalyst/DispatchType/Chained.pm lib/Catalyst/DispatchType/Default.pm lib/Catalyst/DispatchType/Index.pm lib/Catalyst/DispatchType/Path.pm lib/Catalyst/Engine.pm lib/Catalyst/Engine/HTTP.pm lib/Catalyst/EngineLoader.pm lib/Catalyst/Exception.pm lib/Catalyst/Exception/Basic.pm lib/Catalyst/Exception/Detach.pm lib/Catalyst/Exception/Go.pm lib/Catalyst/Exception/Interface.pm lib/Catalyst/Log.pm lib/Catalyst/Model.pm lib/Catalyst/Plugin/Unicode/Encoding.pm lib/Catalyst/PSGI.pod lib/Catalyst/Request.pm lib/Catalyst/Request/Upload.pm lib/Catalyst/Response.pm lib/Catalyst/Runtime.pm lib/Catalyst/Script/CGI.pm lib/Catalyst/Script/Create.pm lib/Catalyst/Script/FastCGI.pm lib/Catalyst/Script/Server.pm lib/Catalyst/Script/Test.pm lib/Catalyst/ScriptRole.pm lib/Catalyst/ScriptRunner.pm lib/Catalyst/Stats.pm lib/Catalyst/Test.pm lib/Catalyst/Upgrading.pod lib/Catalyst/Utils.pm lib/Catalyst/View.pm Makefile.PL MANIFEST This list of files META.yml script/catalyst.pl t/01use.t t/aggregate.t t/aggregate/c3_appclass_bug.t t/aggregate/c3_mro.t t/aggregate/caf_backcompat.t t/aggregate/catalyst_test_utf8.t t/aggregate/custom_live_component_controller_action_auto_doublebug.t t/aggregate/custom_live_path_bug.t t/aggregate/deprecated_test_import.t t/aggregate/deprecated_test_unimported.t t/aggregate/error_page_dump.t t/aggregate/live_component_controller_action_action.t t/aggregate/live_component_controller_action_auto.t t/aggregate/live_component_controller_action_begin.t t/aggregate/live_component_controller_action_chained.t t/aggregate/live_component_controller_action_chained2.t t/aggregate/live_component_controller_action_default.t t/aggregate/live_component_controller_action_detach.t t/aggregate/live_component_controller_action_die_in_end.t t/aggregate/live_component_controller_action_end.t t/aggregate/live_component_controller_action_forward.t t/aggregate/live_component_controller_action_global.t t/aggregate/live_component_controller_action_go.t t/aggregate/live_component_controller_action_index.t t/aggregate/live_component_controller_action_index_or_default.t t/aggregate/live_component_controller_action_inheritance.t t/aggregate/live_component_controller_action_local.t t/aggregate/live_component_controller_action_multipath.t t/aggregate/live_component_controller_action_path.t t/aggregate/live_component_controller_action_path_matchsingle.t t/aggregate/live_component_controller_action_private.t t/aggregate/live_component_controller_action_streaming.t t/aggregate/live_component_controller_action_visit.t t/aggregate/live_component_controller_actionroles.t t/aggregate/live_component_controller_anon.t t/aggregate/live_component_controller_args.t t/aggregate/live_component_controller_attributes.t t/aggregate/live_component_controller_httpmethods.t t/aggregate/live_component_controller_moose.t t/aggregate/live_component_view_single.t t/aggregate/live_engine_request_auth.t t/aggregate/live_engine_request_body.t t/aggregate/live_engine_request_body_demand.t t/aggregate/live_engine_request_cookies.t t/aggregate/live_engine_request_env.t t/aggregate/live_engine_request_escaped_path.t t/aggregate/live_engine_request_headers.t t/aggregate/live_engine_request_parameters.t t/aggregate/live_engine_request_prepare_parameters.t t/aggregate/live_engine_request_remote_user.t t/aggregate/live_engine_request_uploads.t t/aggregate/live_engine_request_uri.t t/aggregate/live_engine_response_body.t t/aggregate/live_engine_response_cookies.t t/aggregate/live_engine_response_emptybody.t t/aggregate/live_engine_response_errors.t t/aggregate/live_engine_response_headers.t t/aggregate/live_engine_response_large.t t/aggregate/live_engine_response_print.t t/aggregate/live_engine_response_redirect.t t/aggregate/live_engine_response_status.t t/aggregate/live_engine_setup_basics.t t/aggregate/live_engine_setup_plugins.t t/aggregate/live_loop.t t/aggregate/live_plugin_loaded.t t/aggregate/live_priorities.t t/aggregate/live_recursion.t t/aggregate/live_view_warnings.t t/aggregate/meta_method_unneeded.t t/aggregate/psgi_file.t t/aggregate/unit_controller_actions.t t/aggregate/unit_controller_config.t t/aggregate/unit_controller_namespace.t t/aggregate/unit_core_action.t t/aggregate/unit_core_action_for.t t/aggregate/unit_core_appclass_roles_in_plugin_list.t t/aggregate/unit_core_classdata.t t/aggregate/unit_core_component.t t/aggregate/unit_core_component_generating.t t/aggregate/unit_core_component_layers.t t/aggregate/unit_core_component_loading.t t/aggregate/unit_core_component_mro.t t/aggregate/unit_core_controller_actions_config.t t/aggregate/unit_core_ctx_attr.t t/aggregate/unit_core_engine-prepare_path.t t/aggregate/unit_core_engine_fixenv-iis6.t t/aggregate/unit_core_engine_fixenv-lighttpd.t t/aggregate/unit_core_log.t t/aggregate/unit_core_merge_config_hashes.t t/aggregate/unit_core_mvc.t t/aggregate/unit_core_path_to.t t/aggregate/unit_core_plugin.t t/aggregate/unit_core_script_cgi.t t/aggregate/unit_core_script_create.t t/aggregate/unit_core_script_fastcgi.t t/aggregate/unit_core_script_help.t t/aggregate/unit_core_script_run_options.t t/aggregate/unit_core_script_server-without_modules.t t/aggregate/unit_core_script_server.t t/aggregate/unit_core_scriptrunner.t t/aggregate/unit_core_setup.t t/aggregate/unit_core_setup_log.t t/aggregate/unit_core_setup_stats.t t/aggregate/unit_core_uri_for.t t/aggregate/unit_core_uri_for_action.t t/aggregate/unit_core_uri_for_multibytechar.t t/aggregate/unit_core_uri_with.t t/aggregate/unit_dispatcher_requestargs_restore.t t/aggregate/unit_engineloader.t t/aggregate/unit_load_catalyst_test.t t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t t/aggregate/unit_metaclass_compat_non_moose.t t/aggregate/unit_metaclass_compat_non_moose_controller.t t/aggregate/unit_response.t t/aggregate/unit_utils_env_value.t t/aggregate/unit_utils_home.t t/aggregate/unit_utils_prefix.t t/aggregate/unit_utils_request.t t/aggregate/utf8_content_length.t t/author/http-server.t t/author/notabs.t t/author/pod.t t/author/podcoverage.t t/author/spelling.t t/author/unicode_plugin_nested_params.t t/bad_middleware_error.t t/catalyst_130pix.gif t/conf/extra.conf.in t/content_negotiation.t t/custom_exception_class_simple.t t/data_handler.t t/dead_load_bad_args.t t/dead_load_multiple_chained_attributes.t t/dead_no_unknown_error.t t/dead_recursive_chained_attributes.t t/deprecated.t t/deprecated_appclass_action_warnings.t t/encoding_set_in_app.t t/encoding_set_in_config.t t/lib/ACLTestApp.pm t/lib/ACLTestApp/Controller/Root.pm t/lib/Catalyst/Action/TestAfter.pm t/lib/Catalyst/Action/TestBefore.pm t/lib/Catalyst/ActionRole/Moo.pm t/lib/Catalyst/ActionRole/Zoo.pm t/lib/Catalyst/Plugin/Test/Deprecated.pm t/lib/Catalyst/Plugin/Test/Errors.pm t/lib/Catalyst/Plugin/Test/Headers.pm t/lib/Catalyst/Plugin/Test/MangleDollarUnderScore.pm t/lib/Catalyst/Plugin/Test/Plugin.pm t/lib/Catalyst/Script/Bar.pm t/lib/Catalyst/Script/Baz.pm t/lib/Catalyst/Script/CompileTest.pm t/lib/CDICompatTestPlugin.pm t/lib/ChainedActionsApp.pm t/lib/ChainedActionsApp/Controller/Root.pm t/lib/DeprecatedActionsInAppClassTestApp.pm t/lib/DeprecatedTestApp.pm t/lib/DeprecatedTestApp/C/Root.pm t/lib/Moo.pm t/lib/NullPackage.pm t/lib/PluginTestApp.pm t/lib/PluginTestApp/Controller/Root.pm t/lib/ScriptTestApp.pm t/lib/ScriptTestApp/Controller/Root.pm t/lib/ScriptTestApp/Script/Bar.pm t/lib/ScriptTestApp/Script/CompileTest.pm t/lib/ScriptTestApp/Script/Foo.pm t/lib/ScriptTestApp/TraitFor/Script.pm t/lib/ScriptTestApp/TraitFor/Script/Bar.pm t/lib/ScriptTestApp/TraitFor/Script/Foo.pm t/lib/TestApp.pm t/lib/TestApp/Action/TestActionArgsFromConstructor.pm t/lib/TestApp/Action/TestBefore.pm t/lib/TestApp/Action/TestExtraArgsAction.pm t/lib/TestApp/Action/TestMatchCaptures.pm t/lib/TestApp/Action/TestMyAction.pm t/lib/TestApp/ActionRole/Boo.pm t/lib/TestApp/ActionRole/Kooh.pm t/lib/TestApp/ActionRole/Moo.pm t/lib/TestApp/Controller/Action.pm t/lib/TestApp/Controller/Action/Action.pm t/lib/TestApp/Controller/Action/Auto.pm t/lib/TestApp/Controller/Action/Auto/Abort.pm t/lib/TestApp/Controller/Action/Auto/Deep.pm t/lib/TestApp/Controller/Action/Auto/Default.pm t/lib/TestApp/Controller/Action/Auto/Detach.pm t/lib/TestApp/Controller/Action/Begin.pm t/lib/TestApp/Controller/Action/Chained.pm t/lib/TestApp/Controller/Action/Chained/ArgsOrder.pm t/lib/TestApp/Controller/Action/Chained/Auto.pm t/lib/TestApp/Controller/Action/Chained/Auto/Bar.pm t/lib/TestApp/Controller/Action/Chained/Auto/Detach.pm t/lib/TestApp/Controller/Action/Chained/Auto/Foo.pm t/lib/TestApp/Controller/Action/Chained/Auto/Forward.pm t/lib/TestApp/Controller/Action/Chained/Bar.pm t/lib/TestApp/Controller/Action/Chained/CaptureArgs.pm t/lib/TestApp/Controller/Action/Chained/Foo.pm t/lib/TestApp/Controller/Action/Chained/ParentChain.pm t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm t/lib/TestApp/Controller/Action/Chained/PassedArgs.pm t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm t/lib/TestApp/Controller/Action/Chained/Root.pm t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm t/lib/TestApp/Controller/Action/Default.pm t/lib/TestApp/Controller/Action/Detach.pm t/lib/TestApp/Controller/Action/DieInEnd.pm t/lib/TestApp/Controller/Action/End.pm t/lib/TestApp/Controller/Action/Forward.pm t/lib/TestApp/Controller/Action/ForwardTo.pm t/lib/TestApp/Controller/Action/Global.pm t/lib/TestApp/Controller/Action/Go.pm t/lib/TestApp/Controller/Action/Index.pm t/lib/TestApp/Controller/Action/Inheritance.pm t/lib/TestApp/Controller/Action/Local.pm t/lib/TestApp/Controller/Action/Path.pm t/lib/TestApp/Controller/Action/Private.pm t/lib/TestApp/Controller/Action/Streaming.pm t/lib/TestApp/Controller/Action/TestMultipath.pm t/lib/TestApp/Controller/Action/TestRelative.pm t/lib/TestApp/Controller/Action/Visit.pm t/lib/TestApp/Controller/ActionRoles.pm t/lib/TestApp/Controller/Anon.pm t/lib/TestApp/Controller/Args.pm t/lib/TestApp/Controller/Attributes.pm t/lib/TestApp/Controller/BodyParams.pm t/lib/TestApp/Controller/ContextClosure.pm t/lib/TestApp/Controller/Dump.pm t/lib/TestApp/Controller/Engine/Request/Uploads.pm t/lib/TestApp/Controller/Engine/Request/URI.pm t/lib/TestApp/Controller/Engine/Response/Cookies.pm t/lib/TestApp/Controller/Engine/Response/Errors.pm t/lib/TestApp/Controller/Engine/Response/Headers.pm t/lib/TestApp/Controller/Engine/Response/Large.pm t/lib/TestApp/Controller/Engine/Response/Print.pm t/lib/TestApp/Controller/Engine/Response/Redirect.pm t/lib/TestApp/Controller/Engine/Response/Status.pm t/lib/TestApp/Controller/Fork.pm t/lib/TestApp/Controller/HTTPMethods.pm t/lib/TestApp/Controller/Immutable.pm t/lib/TestApp/Controller/Immutable/HardToReload.pm t/lib/TestApp/Controller/Index.pm t/lib/TestApp/Controller/Keyword.pm t/lib/TestApp/Controller/Log.pm t/lib/TestApp/Controller/Moose.pm t/lib/TestApp/Controller/Moose/MethodModifiers.pm t/lib/TestApp/Controller/Moose/NoAttributes.pm t/lib/TestApp/Controller/Priorities.pm t/lib/TestApp/Controller/Priorities/loc_vs_index.pm t/lib/TestApp/Controller/Priorities/locre_vs_index.pm t/lib/TestApp/Controller/Priorities/MultiMethod.pm t/lib/TestApp/Controller/Priorities/path_vs_index.pm t/lib/TestApp/Controller/Root.pm t/lib/TestApp/DispatchType/CustomPostLoad.pm t/lib/TestApp/DispatchType/CustomPreLoad.pm t/lib/TestApp/Model.pm t/lib/TestApp/Model/ClosuresInConfig.pm t/lib/TestApp/Model/Foo.pm t/lib/TestApp/Model/Foo/Bar.pm t/lib/TestApp/Model/Generating.pm t/lib/TestApp/Plugin/AddDispatchTypes.pm t/lib/TestApp/Plugin/FullyQualified.pm t/lib/TestApp/Plugin/ParameterizedRole.pm t/lib/TestApp/RequestBaseBug.pm t/lib/TestApp/Role.pm t/lib/TestApp/View/Dump.pm t/lib/TestApp/View/Dump/Action.pm t/lib/TestApp/View/Dump/Body.pm t/lib/TestApp/View/Dump/Env.pm t/lib/TestApp/View/Dump/Request.pm t/lib/TestApp/View/Dump/Response.pm t/lib/TestApp2.pm t/lib/TestApp2/Controller/Root.pm t/lib/TestAppBadlyImmutable.pm t/lib/TestAppChainedAbsolutePathPart.pm t/lib/TestAppChainedAbsolutePathPart/Controller/Foo.pm t/lib/TestAppChainedRecursive.pm t/lib/TestAppChainedRecursive/Controller/Foo.pm t/lib/TestAppClassExceptionSimpleTest.pm t/lib/TestAppDoubleAutoBug.pm t/lib/TestAppDoubleAutoBug/Controller/Root.pm t/lib/TestAppEncoding.pm t/lib/TestAppEncoding/Controller/Root.pm t/lib/TestAppEncodingSetInApp.pm t/lib/TestAppEncodingSetInApp/Controller/Root.pm t/lib/TestAppEncodingSetInConfig.pm t/lib/TestAppEncodingSetInConfig/Controller/Root.pm t/lib/TestAppEncodingSetInConfig/testappencodingsetinconfig.json t/lib/TestAppIndexDefault.pm t/lib/TestAppIndexDefault/Controller/Default.pm t/lib/TestAppIndexDefault/Controller/IndexChained.pm t/lib/TestAppIndexDefault/Controller/IndexPrivate.pm t/lib/TestAppIndexDefault/Controller/Root.pm t/lib/TestAppMatchSingleArg.pm t/lib/TestAppMatchSingleArg/Controller/Root.pm t/lib/TestAppMetaCompat.pm t/lib/TestAppMetaCompat/Controller/Base.pm t/lib/TestAppMetaCompat/Controller/Books.pm t/lib/TestAppNonMooseController.pm t/lib/TestAppNonMooseController/Controller/Foo.pm t/lib/TestAppNonMooseController/ControllerBase.pm t/lib/TestAppOnDemand.pm t/lib/TestAppOnDemand/Controller/Body.pm t/lib/TestAppOneView.pm t/lib/TestAppOneView/Controller/Root.pm t/lib/TestAppOneView/View/Dummy.pm t/lib/TestAppPathBug.pm t/lib/TestAppPluginWithConstructor.pm t/lib/TestAppPluginWithConstructor/Controller/Root.pm t/lib/TestAppShowInternalActions.pm t/lib/TestAppShowInternalActions/Controller/Root.pm t/lib/TestAppStats.pm t/lib/TestAppStats/Controller/Root.pm t/lib/TestAppToTestScripts.pm t/lib/TestAppUnicode.pm t/lib/TestAppUnicode/Controller/Root.pm t/lib/TestAppUnknownError.pm t/lib/TestAppViewWarnings.pm t/lib/TestAppViewWarnings/Controller/Root.pm t/lib/TestAppWithMeta.pm t/lib/TestAppWithMeta/Controller/Root.pm t/lib/TestAppWithoutUnicode.pm t/lib/TestAppWithoutUnicode/Controller/Root.pm t/lib/TestContentNegotiation.pm t/lib/TestContentNegotiation/Controller/Root.pm t/lib/TestContentNegotiation/share/file.txt t/lib/TestDataHandlers.pm t/lib/TestDataHandlers/Controller/Root.pm t/lib/TestFromPSGI.pm t/lib/TestFromPSGI/Controller/Root.pm t/lib/TestLogger.pm t/lib/TestMiddleware.pm t/lib/TestMiddleware/Controller/Root.pm t/lib/TestMiddleware/Custom.pm t/lib/TestMiddleware/share/static/forced.txt t/lib/TestMiddleware/share/static/message.txt t/lib/TestMiddleware/share/static2/message2.txt t/lib/TestMiddleware/share/static3/message3.txt t/lib/TestMiddlewareFromConfig.pm t/lib/TestMiddlewareFromConfig/Controller/Root.pm t/lib/TestMiddlewareFromConfig/Custom.pm t/lib/TestMiddlewareFromConfig/share/static/forced.txt t/lib/TestMiddlewareFromConfig/share/static/message.txt t/lib/TestMiddlewareFromConfig/share/static2/message2.txt t/lib/TestMiddlewareFromConfig/share/static3/message3.txt t/lib/TestMiddlewareFromConfig/testmiddlewarefromconfig.pl t/lib/TestPluginWithConstructor.pm t/live_catalyst_test.t t/live_component_controller_context_closure.t t/live_fork.t t/live_redirect_body.t t/live_show_internal_actions_warnings.t t/live_stats.t t/more-psgi-compat.t t/optional_apache-cgi-rewrite.pl t/optional_apache-cgi.pl t/optional_apache-fastcgi-non-root.pl t/optional_apache-fastcgi.pl t/optional_http-server-restart.t t/optional_lighttpd-fastcgi-non-root.t t/optional_lighttpd-fastcgi.t t/optional_memleak.t t/optional_stress.t t/optional_stress.yml t/optional_threads.t t/plack-middleware-config.t t/plack-middleware.t t/plugin_new_method_backcompat.t t/psgi-log.t t/psgi_file_testapp.t t/psgi_file_testapp_engine_plackup_compat.t t/psgi_file_testapp_engine_psgi_compat.t t/something/Makefile.PL t/something/script/foo/bar/for_dist t/unicode_plugin_charset_utf8.t t/unicode_plugin_config.t t/unicode_plugin_live.t t/unicode_plugin_no_encoding.t t/unicode_plugin_request_decode.t t/unit_core_methodattributes_method_metaclass_on_subclasses.t t/unit_core_script_test.t t/unit_stats.t t/unit_utils_load_class.t t/unit_utils_subdir.t TODO Catalyst-Runtime-5.90053/META.yml000644 000765 000024 00000004074 12255607775 016503 0ustar00johnstaff000000 000000 --- abstract: 'The Catalyst Framework Runtime' author: - 'Sebastian Riedel ' build_requires: Data::Dump: 0 ExtUtils::MakeMaker: 6.59 HTTP::Request::Common: 0 HTTP::Status: 0 IO::Scalar: 0 JSON::MaybeXS: 0 Test::Fatal: 0 Test::More: 0.88 configure_requires: ExtUtils::MakeMaker: 6.59 distribution_type: module dynamic_config: 1 generated_by: 'Module::Install version 1.06' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: Catalyst-Runtime no_index: directory: - inc - t requires: CGI::Simple::Cookie: 1.109 CGI::Struct: 0 Carp: 0 Catalyst::DispatchType::Regex: 5.90021 Class::C3::Adopt::NEXT: 0.07 Class::Data::Inheritable: 0 Class::Load: 0.12 Data::Dump: 0 Data::OptList: 0 Devel::InnerPackage: 0 Encode: 2.49 HTML::Entities: 0 HTML::HeadParser: 0 HTTP::Body: 1.06 HTTP::Headers: 1.64 HTTP::Request: 5.814 HTTP::Request::AsCGI: 1.0 HTTP::Response: 5.813 Hash::MultiValue: 0 JSON::MaybeXS: 1.000000 LWP: 5.837 List::MoreUtils: 0 MRO::Compat: 0 Module::Pluggable: 4.7 Moose: 1.03 MooseX::Emulate::Class::Accessor::Fast: 0.00903 MooseX::Getopt: 0.48 MooseX::MethodAttributes::Role::AttrContainer::Inheritable: 0.24 MooseX::Role::WithOverloading: 0.09 Path::Class: 0.09 Plack: 0.9991 Plack::Middleware::ReverseProxy: 0.04 Plack::Request::Upload: 0 Plack::Test::ExternalServer: 0 Safe::Isa: 0 Scalar::Util: 0 Stream::Buffered: 0 String::RewritePrefix: 0.004 Sub::Exporter: 0 Task::Weaken: 0 Text::Balanced: 0 Text::SimpleTable: 0.03 Time::HiRes: 0 Tree::Simple: 1.15 Tree::Simple::Visitor::FindByPath: 0 Try::Tiny: 0.17 URI: 1.36 namespace::autoclean: 0.09 namespace::clean: 0.23 perl: 5.8.3 resources: IRC: irc://irc.perl.org/#catalyst MailingList: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst homepage: http://dev.catalyst.perl.org/ license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git version: 5.90053 x_authority: cpan:MSTROUT Catalyst-Runtime-5.90053/script/000755 000765 000024 00000000000 12255610005 016505 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/000755 000765 000024 00000000000 12255610005 015444 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/TODO000644 000765 000024 00000004644 12106042701 015676 0ustar00johnstaff000000 000000 # Known Bugs: - Bug ->go or ->visit causes actions which have Args or CaptureArgs called twice when called via ->go or ->visit. Test app: http://github.com/bobtfish/catalyst-app-bug-go_chain/tree/master # Compatibility warnings to add: - $self->config should warn as config should only ever be called as a class method (TESTS). # Proposed functionality / feature additions: ## Log setup needs to be less lame So Catalyst::Plugin::Log::* can die in a fire. Having $c->log_class would be a good start. kane volunteered to do some of this. Simple example: Catalyst::Plugin::Log::Colorful should just be a subclass of Catalyst::Log, no ::Plugin:: needed. See also: Catalyst::Plugin::Log::Dispatch and http://github.com/willert/catalyst-plugin-log4perl-simple/tree ## throw away the restarter and allow using the restarters Plack provides ## be smarter about how we use PSGI - not every response needs to be delayed and streaming # The horrible hack for plugin setup - replacing it: * Have a look at the Devel::REPL BEFORE_PLUGIN stuff I wonder if what we need is that combined with plugins-as-roles # App / ctx split: NOTE - these are notes that t0m thought up after doing back compat for catalyst_component_class, may be inaccurate, wrong or missing things bug mst (at least) to correct before trying more than the first 2 steps. Please knock yourself out on the first two however :) - Eliminate actions in MyApp from the main test suite - Uncomment warning in C::C::register_action_methods, add tests it works by mocking out the logging.. - Remove MyApp @ISA controller (ask metaclass if it has attributes, and if so you need back compat :/) - Make Catalyst::Context, move the per request stuff in there, handles from main app class to delegate - Make an instance of the app class which is a global variable - Make new instance of the context class, not the app class per-request - Remove the components as class data, move to instance data on the app class (you probably have to do this for _all_ the class data, good luck!) - Make it possible for users to spin up different instances of the app class (with different config etc each) - Profit! (Things like changing the complete app config per vhost, i.e. writing a config loader / app class role which dispatches per vhost to differently configured apps is piss easy) Catalyst-Runtime-5.90053/t/01use.t000644 000765 000024 00000000060 12106042701 016557 0ustar00johnstaff000000 000000 use Test::More tests => 1; use_ok('Catalyst'); Catalyst-Runtime-5.90053/t/aggregate/000755 000765 000024 00000000000 12255610005 017372 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/aggregate.t000644 000765 000024 00000001277 12217110343 017564 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use File::Spec::Functions 'catfile', 'updir'; BEGIN { unless (-e catfile $FindBin::Bin, updir, '.aggregating') { require Test::More; Test::More::plan(skip_all => 'No test aggregation requested'); } } BEGIN { unless (eval { require Test::Aggregate; Test::Aggregate->VERSION('0.364'); 1 }) { require Test::More; Test::More::plan(skip_all => 'Test::Aggregate 0.364 required for test aggregation'); } } my $tests = Test::Aggregate->new({ (@ARGV ? (tests => \@ARGV) : (dirs => 't/aggregate')), verbose => 0, set_filenames => 1, findbin => 1, }); $tests->run; Catalyst-Runtime-5.90053/t/author/000755 000765 000024 00000000000 12255610005 016746 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/bad_middleware_error.t000644 000765 000024 00000000405 12254333445 021775 0ustar00johnstaff000000 000000 #!/usr/bin/env perl { package MyApp; use Catalyst; use Test::More; eval { __PACKAGE__->setup_middleware('DoesNotExist'); 1; } || do { like($@, qr/MyApp::Middleware::DoesNotExist or Plack::Middleware::DoesNotExist/); }; done_testing; } Catalyst-Runtime-5.90053/t/catalyst_130pix.gif000644 000765 000024 00000013105 12106042701 021060 0ustar00johnstaff000000 000000 PNG  IHDR-+$gAMAOX2tEXtSoftwareAdobe ImageReadyqe<IDATx[ \T;/ 6l"".g,zm*ʧ2sA@\JAQV]ٗffflof)/0s=;b}Crͅ "NJ 8qՐG HܻW+`\\0J%I–Hk5e˗>T* Ņ.?VВtqgYKN%-VykG'ڊ%x fmim1(WZ?ޠh[Z|&Nl۸ZSزPo/bۻWf>M E1B {JSi)1&2Y|AJD.iMq^!V??cW(eҤ{W4R1.C`|hX w"gϿ! 11)Y0$*|֜R2c/^y ?RstH,Y-{q3'&d?I۹}3Sg6l}0+Uի umM㝝&D" 8؁W5-%e0R={L>> &MؑoJ==}☈̖75  ˗j9Eszzzht0?P}hk;ڡRQ(0dQ܊X2,D"ɤܷuu [z̪`<?84lX*aJvVyi] ]3q#~x:DΕl6@ (T-$lp(ss^5 L {@ ikmmO͜!a`$9viR ndf';¬I`0͟~74SaF"Ϛ b׶my +^|dJ2˂h4Ff DbqWWzRit qk|\HP0jA$889'r/֌FW,jnTpF4 /NH0j.~#c0nd ?fx 4taPKe __b~~ŋhD@.rIa\E۳}jթd."0(xS8n۹{t87T*Ny8z{g_?x?{ ) &;X,a^Z܅'Myh_7˹Z^Vv׉IGGǤ$#H.5`q8S'a`q!#NY@rٔ܏g}`[,m^`0j  h/T},U_aaXXCjlme Pt /l6;|D&'G%. R{aY[k (CeP,lx%ׯAf"b6'~쬂y3l Fy/[ a]ܔ{eSf!rۗ`v_> \V;gou(pNѨZ\^^9exPk))}zrNtl6*HldxLUZ7%|FDdW* uѠLxN  6aăߴ+(j51,[\m1 {p SZ|]Q  8@>oB3[Ϗ3fk4fr9{#|5n??u ?tqcCRA&3'&jNFcKKzziAAC腅[׭C;;#:1Fpپ9AB\+GF!;\BQag_+H$.}%TR3gAQHO Uc͈MضbAGysc!xލ!g[[qQQgmۼ⢯GQ;[lhn&:95]2f 6`fAc[X@a^ h;=]'ƍv}~YwW{ Id0'N}uM }06k>_agE_Ølmo[Al`p(Hp8yH쳤[_0op0-s]BX] %Qpmht'N,iڿrgPd[>6ra/T `aq&9rlA~ƱB.K0ׯ*p@ƎiϝO7@pus_[?^FX&xP9pL`pokjF{>iRS[:K0/-?Y`?#,qu^''gX9 57ss>BE / @+ D対E`ːE z~39tl=HXtġ;Fz]$?:uLO/oj R:Xc k#=7 Cwq1M&>I'S:kgwm)+OG1w'N_nMS1~`CƎr̽}1#Pd2!C rpF E8*U3gˡKR`<HɤPli[,(K"w>VR|84ș1{.sgި(#)gxDČYs&^#"#OAhD7 ׬v 'ΝLpqw`9ӁjGw/3z= m+Kzt:l+gm׿ꥌ8,M6=zmX } ﮫ(/H<'<9ٞxHsqs[;2/#úh4:H"rd2/`HaA:9͙{oص wAy {؀PXUuh? a#CÞYbϿ8±nӦu$=sDG4([bbjnܐ8`HL^-]}Q&0P2lXd2dʔLݾ}2'68=iԨnmԨH TVV]C||2˫u Qk8Qʽ VWwW~nhb\t1pH3JhZc}Zk+tzY^TXe#Rڵ]]G<*>\]\Tݸ!wއX$$pֶ6eEBK$!~~"]9ɸǏ__~&;`CK&sr܃zk`y-_(i{ti3b 2`>Y@"PD@W7VF $OBM^\Tbs9 V^Ɇzzy0 EɔH$ *Pܹyxdf0)J ֩р҃B ttt Dhl79px":}mqqfZqN3xP2}@2L0M,6F D"Ge!X,n7PNt#]۷PHR`پ|e>R{QA[g&+BSc+Z@&j ;x+;zL ɩױcBݎ><`URTwKx0n`Cvj"96`0\ Cj<$vV* :l1Zm^ufWѿ]PR;;۷!v- m&۫TqC}CsAAPCF64)Qiix_n[ //?bB41&/ nڤ0~d^K݂cׯ(;0‚yҿ' [_O^7IENDB`Catalyst-Runtime-5.90053/t/conf/000755 000765 000024 00000000000 12255610005 016371 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/content_negotiation.t000644 000765 000024 00000004725 12236261623 021722 0ustar00johnstaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use FindBin; use Test::More; use HTTP::Request::Common; use JSON::MaybeXS; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestContentNegotiation'; { ok my $req = POST '/', Content_Type => 'application/json', Content => encode_json +{message=>'test'}; ok my $res = request $req; is $res->content, 'is_json1'; } { ok my $req = POST '/', [a=>1,b=>2]; ok my $res = request $req; is $res->content, 'is_urlencoded1'; } { ok my $path = TestContentNegotiation->path_to(qw/share file.txt/); ok my $req = POST '/', Content_Type => 'form-data', Content => [a=>1, b=>2, file=>["$path"]]; ok my $res = request $req; is $res->content, 'is_multipart1'; } { ok my $req = POST '/under', Content_Type => 'application/json', Content => encode_json +{message=>'test'}; ok my $res = request $req; is $res->content, 'is_json2'; } { ok my $req = POST '/under', [a=>1,b=>2]; ok my $res = request $req; is $res->content, 'is_urlencoded2'; } { ok my $path = TestContentNegotiation->path_to(qw/share file.txt/); ok my $req = POST '/under', Content_Type => 'form-data', Content => [a=>1, b=>2, file=>["$path"]]; ok my $res = request $req; is $res->content, 'is_multipart2'; } { ok my $req = POST '/is_more_than_one_1', Content => [a=>1, b=>2]; ok my $res = request $req; is $res->content, 'formdata1'; } { ok my $req = POST '/is_more_than_one_2', Content => [a=>1, b=>2]; ok my $res = request $req; is $res->content, 'formdata2'; } { ok my $req = POST '/is_more_than_one_3', Content => [a=>1, b=>2]; ok my $res = request $req; is $res->content, 'formdata3'; } { ok my $path = TestContentNegotiation->path_to(qw/share file.txt/); ok my $req = POST '/is_more_than_one_1', Content_Type => 'form-data', Content => [a=>1, b=>2, file=>["$path"]]; ok my $res = request $req; is $res->content, 'formdata1'; } { ok my $path = TestContentNegotiation->path_to(qw/share file.txt/); ok my $req = POST '/is_more_than_one_2', Content_Type => 'form-data', Content => [a=>1, b=>2, file=>["$path"]]; ok my $res = request $req; is $res->content, 'formdata2'; } { ok my $path = TestContentNegotiation->path_to(qw/share file.txt/); ok my $req = POST '/is_more_than_one_3', Content_Type => 'form-data', Content => [a=>1, b=>2, file=>["$path"]]; ok my $res = request $req; is $res->content, 'formdata3'; } done_testing; Catalyst-Runtime-5.90053/t/custom_exception_class_simple.t000644 000765 000024 00000000455 12217110343 023761 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More tests => 2; use Test::Fatal; is exception { require TestAppClassExceptionSimpleTest; }, undef, 'Can load application'; is exception { Catalyst::Exception->throw }, undef, 'throw is properly stubbed out'; Catalyst-Runtime-5.90053/t/data_handler.t000644 000765 000024 00000001477 12236261623 020257 0ustar00johnstaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use FindBin; use Test::More; use HTTP::Request::Common; use JSON::MaybeXS; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestDataHandlers'; ok my($res, $c) = ctx_request('/'); { ok my $message = 'helloworld'; ok my $post = encode_json +{message=>$message}; ok my $req = POST $c->uri_for_action('/test_json'), Content_Type => 'application/json', Content => $post; ok my $response = request $req, 'got a response from a catalyst controller'; is $response->content, $message, 'expected content body'; } { ok my $req = POST $c->uri_for_action('/test_nested_for'), [ 'nested.value' => 'expected' ]; ok my $response = request $req, 'got a response from a catalyst controller'; is $response->content, 'expected', 'expected content body'; } done_testing; Catalyst-Runtime-5.90053/t/dead_load_bad_args.t000644 000765 000024 00000003033 12217110343 021344 0ustar00johnstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; use Catalyst::Test 'TestApp'; for my $fail ( "(' ')", "('')", "('1.23')", "(-1)", ) { for my $type (qw(Args CaptureArgs)) { eval <<"END"; package TestApp::Controller::Action::Chained; no warnings 'redefine'; sub should_fail : Chained('/') ${type}${fail} {} END ok(!$@); eval { TestApp->setup_actions }; like($@, qr/Invalid \Q${type}${fail}\E/, "Bad ${type}${fail} attribute makes action setup fail"); } } for my $ok ( "()", "(0)", "(1)", "('0')", "", ) { for my $type (qw(Args CaptureArgs)) { eval <<"END"; package TestApp::Controller::Action::Chained; no warnings 'redefine'; sub should_fail : Chained('/') ${type}${ok} {} END ok(!$@); eval { TestApp->setup_actions }; ok(!$@, "${type}${ok} works"); } } for my $first (qw(Args CaptureArgs)) { for my $second (qw(Args CaptureArgs)) { eval <<"END"; package TestApp::Controller::Action::Chained; no warnings 'redefine'; sub should_fail :Chained('/') $first $second {} END ok(!$@); eval { TestApp->setup_actions }; my $msg = $first eq $second ? "Multiple $first" : "Combining Args and CaptureArgs"; like($@, qr/$msg attributes not supported registering/, "$first + $second attribute makes action setup fail"); } } done_testing(); Catalyst-Runtime-5.90053/t/dead_load_multiple_chained_attributes.t000644 000765 000024 00000001023 12217110344 025354 0ustar00johnstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; plan tests => 4; use Catalyst::Test 'TestApp'; eval q{ package TestApp::Controller::Action::Chained; sub should_fail : Chained('/') Chained('foo') Args(0) {} }; ok(!$@); eval { TestApp->setup_actions; }; ok($@, 'Multiple chained attributes make action setup fail'); eval q{ package TestApp::Controller::Action::Chained; no warnings 'redefine'; sub should_fail {} }; ok(!$@); eval { TestApp->setup_actions }; ok(!$@, 'And ok again') or warn $@; Catalyst-Runtime-5.90053/t/dead_no_unknown_error.t000755 000765 000024 00000000324 12217110344 022213 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More tests => 1; use Catalyst (); eval { require TestAppUnknownError; }; unlike($@, qr/Unknown error/, 'No unknown error'); 1; Catalyst-Runtime-5.90053/t/dead_recursive_chained_attributes.t000644 000765 000024 00000002030 12217110344 024530 0ustar00johnstaff000000 000000 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 $@; Catalyst-Runtime-5.90053/t/deprecated.t000644 000765 000024 00000002244 12217110344 017732 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More tests => 4; my $warnings; BEGIN { # Do this at compile time in case we generate a warning when use # DeprecatedTestApp $SIG{__WARN__} = sub { $warnings++ if $_[0] =~ /uses NEXT, which is deprecated/; $warnings++ if $_[0] =~ /trying to use NEXT, which is deprecated/; }; } use Catalyst; # Cause catalyst to be used so I can fiddle with the logging. my $mvc_warnings; BEGIN { my $logger = Class::MOP::Class->create_anon_class( methods => { debug => sub {0}, info => sub {0}, warn => sub { if ($_[1] =~ /switch your class names/) { $mvc_warnings++; return; } die "Caught unexpected warning: " . $_[1]; }, }, )->new_object; 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' ); is( $warnings, 1, 'Got one and only one Adopt::NEXT warning'); Catalyst-Runtime-5.90053/t/deprecated_appclass_action_warnings.t000644 000765 000024 00000000734 12106042701 025065 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More; use Catalyst::Test 'DeprecatedActionsInAppClassTestApp'; plan tests => 3; my $warnings; my $logger = DeprecatedActionsInAppClassTestApp::Log->new; Catalyst->log($logger); ok( my $response = request('http://localhost/foo'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $DeprecatedActionsInAppClassTestApp::Log::warnings, 1, 'Get the appclass action warning' );Catalyst-Runtime-5.90053/t/encoding_set_in_app.t000644 000765 000024 00000000471 12156703543 021634 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin '$Bin'; use lib "$Bin/lib"; use Test::More; #for this test encoding => 'UTF-8' is set in TestAppEncodingSetInApp.pm use Catalyst::Test 'TestAppEncodingSetInApp'; my ( undef, $c ) = ctx_request('/'); isa_ok( $c->encoding, 'Encode::utf8', '$c->encoding' ); done_testing; Catalyst-Runtime-5.90053/t/encoding_set_in_config.t000644 000765 000024 00000000676 12157124552 022326 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin '$Bin'; use lib "$Bin/lib"; use Test::More; BEGIN { eval { require Catalyst::Plugin::ConfigLoader; 1; } || plan skip_all => 'Need Catalyst::Plugin::ConfigLoader' } #for this test encoding => 'UTF-8' is set in testappencodingsetinconfig.json use Catalyst::Test 'TestAppEncodingSetInConfig'; my ( undef, $c ) = ctx_request('/'); isa_ok( $c->encoding, 'Encode::utf8', '$c->encoding' ); done_testing; Catalyst-Runtime-5.90053/t/lib/000755 000765 000024 00000000000 12255610005 016212 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/live_catalyst_test.t000644 000765 000024 00000003113 12121675274 021544 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp', {default_host => 'default.com'}; use Catalyst::Request; use HTTP::Request::Common; use Test::More; content_like('/',qr/root/,'content check'); action_ok('/','Action ok ok','normal action ok'); action_redirect('/engine/response/redirect/one','redirect check'); action_notfound('/engine/response/status/s404','notfound check'); # so we can see the default test name action_ok('/'); contenttype_is('/action/local/one','text/plain','Contenttype check'); ### local_request() was not setting response base from base href { my $response = request('/base_href_test'); is( $response->base, 'http://www.example.com/', 'response base set from base href'); } my $creq; my $req = '/dump/request'; { eval '$creq = ' . request($req)->content; is( $creq->uri->host, 'default.com', 'request targets default host set via import' ); } { local $Catalyst::Test::default_host = 'localized.com'; eval '$creq = ' . request($req)->content; is( $creq->uri->host, 'localized.com', 'target host is mutable via package var' ); } { my %opts = ( host => 'opthash.com' ); eval '$creq = ' . request($req, \%opts)->content; is( $creq->uri->host, $opts{host}, 'target host is mutable via options hashref' ); } { my $response = request( POST( '/bodyparams', { override => 'this' } ) )->content; is($response, 'that', 'body param overridden'); } { my $response = request( POST( '/bodyparams/no_params' ) )->content; is($response, 'HASH', 'empty body param is hashref'); } done_testing; Catalyst-Runtime-5.90053/t/live_component_controller_context_closure.t000644 000765 000024 00000001245 12144200755 026423 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { unless (eval 'use CatalystX::LeakChecker 0.05; 1') { plan skip_all => 'CatalystX::LeakChecker 0.05 required for this test'; } plan tests => 4; } use FindBin; use lib "$FindBin::Bin/lib"; BEGIN { $::setup_leakchecker = 1 } local $SIG{__WARN__} = sub { return if $_[0] =~ /Unhandled type: GLOB/; warn $_[0] }; use Catalyst::Test 'TestApp'; { my ($resp, $ctx) = ctx_request('/contextclosure/normal_closure'); ok($resp->is_success); is($ctx->count_leaks, 1); } { my ($resp, $ctx) = ctx_request('/contextclosure/context_closure'); ok($resp->is_success); is($ctx->count_leaks, 0); } Catalyst-Runtime-5.90053/t/live_fork.t000644 000765 000024 00000003205 12217110344 017610 0ustar00johnstaff000000 000000 # live_fork.t # Copyright (c) 2006 Jonathan Rockway =head1 SYNOPSIS Tests if Catalyst can fork/exec other processes successfully =cut use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test qw(TestApp); eval 'use YAML'; plan skip_all => 'YAML required' if $@; plan skip_all => 'Using remote server (and REMOTE_FORK not set)' if $ENV{CATALYST_SERVER} && !$ENV{REMOTE_FORK}; plan skip_all => 'Skipping fork tests: no /bin/ls' if !-e '/bin/ls'; # see if /bin/ls exists { ok(my $result = get('/fork/system/%2Fbin%2Fls'), 'system'); if (my $result_ref = result_ok($result)) { ok($result_ref, 'is YAML'); is($result_ref->{result}, 0, 'exited OK'); } } { ok(my $result = get('/fork/backticks/%2Fbin%2Fls'), '`backticks`'); if (my $result_ref = result_ok($result)) { ok($result_ref, 'is YAML'); is($result_ref->{code}, 0, 'exited successfully'); like($result_ref->{result}, qr{^/bin/ls[^:]}, 'contains ^/bin/ls$'); like($result_ref->{result}, qr{\n.*\n}m, 'contains two newlines'); } } { ok(my $result = get('/fork/fork'), 'fork'); if (my $result_ref = result_ok($result)) { ok($result_ref, 'is YAML'); isnt($result_ref->{pid}, 0, q{fork's "pid" wasn't 0}); isnt($result_ref->{pid}, $$, 'fork got a new pid'); is($result_ref->{result}, 'ok', 'fork was effective'); } } sub result_ok { my $result = shift; unlike( $result, qr/FATAL/, 'result is not an error' ) or return; $result =~ s/\r\n|\r/\n/g; return eval { Load($result) }; } done_testing; Catalyst-Runtime-5.90053/t/live_redirect_body.t000644 000765 000024 00000004715 12156157140 021503 0ustar00johnstaff000000 000000 use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp', {default_host => 'default.com'}; use Catalyst::Request; use Test::More; # test redirect { my $request = HTTP::Request->new( GET => 'http://localhost:3000/test_redirect' ); ok( my $response = request($request), 'Request' ); is( $response->code, 302, 'Response Code' ); # When no body and no content_type has been set, redirecting should set both. is( $response->header( 'Content-Type' ), 'text/html; charset=utf-8', 'Content Type' ); like( $response->content, qr//, 'Content contains HTML body' ); } # test redirect without a body and but with a content_type set explicitly by the developer { my $request = HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_with_contenttype' ); ok( my $response = request($request), 'Request' ); is( $response->code, 302, 'Response Code' ); # When the developer has not set content body, we set it. The content type must always match the body, so it should be overwritten. is( $response->header( 'Content-Type' ), 'text/html; charset=utf-8', 'Content Type' ); like( $response->content, qr//, 'Content contains HTML body' ); } # test redirect without a body and but with a content_type set explicitly by the developer { my $request = HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_with_content' ); ok( my $response = request($request), 'Request' ); is( $response->code, 302, 'Response Code' ); # When the developer sets both the content body and content type, the set content body and content_type should get through. like( $response->header( 'Content-Type' ), qr{text/plain}, 'Content Type' ); like( $response->content, qr/kind sir/, 'Content contains content set by the Controller' ); } # test redirect with dodgy host { local $Catalyst::Test::default_host = "-->\">'>'\""; my $request = HTTP::Request->new( GET => 'http://localhost:3000/test_redirect_uri_for'); ok( my $response = request($request), 'Request' ); is( $response->code, 302, 'Response Code' ); # When no body and no content_type has been set, redirecting should set both. is( $response->header( 'Content-Type' ), 'text/html; charset=utf-8', 'Content Type' ); like( $response->content, qr//, 'Content contains HTML body' ); like( $response->content, qr/href="[^"]+">here<\/a>/, 'link doesn\'t have xss' ); } done_testing; Catalyst-Runtime-5.90053/t/live_show_internal_actions_warnings.t000644 000765 000024 00000001146 12106042701 025153 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin '$Bin'; use lib "$Bin/lib"; use Test::More; use File::Spec; BEGIN { # Shut up debug output, app needs debug on for the issue to # appear, but we don't want the spraff to the screen my $devnull = File::Spec->devnull; open my $fh, '>', $devnull or die "Cannot write to $devnull: $!"; *STDERR = $fh; } use Catalyst::Test 'TestAppShowInternalActions'; my $last_warning; { local $SIG{__WARN__} = sub { $last_warning = shift }; my $res = get('/'); } is( $last_warning, undef, 'there should be no warnings about uninitialized value' ); done_testing; Catalyst-Runtime-5.90053/t/live_stats.t000644 000765 000024 00000001106 12217110344 020003 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More; use Catalyst::Test 'TestAppStats'; if ( $ENV{CATALYST_SERVER} ) { plan skip_all => 'Using remote server'; } else { plan tests => 5; } { ok( my $response = request('http://localhost/'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); } { ok( my $response = request('http://localhost/'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->content, qr/\/default.*?[\d.]+s.*- test.*[\d.]+s/s, 'Stats report'); } Catalyst-Runtime-5.90053/t/more-psgi-compat.t000644 000765 000024 00000002352 12236261623 021025 0ustar00johnstaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use FindBin; use Test::More; use HTTP::Request::Common; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestFromPSGI'; { ok my $response = request GET '/from_psgi_array', 'got welcome from a catalyst controller'; is $response->content, 'helloworldtoday', 'expected content body /from_psgi_array'; } { ok my $response = request GET '/from_psgi_code', 'got welcome from a catalyst controller'; is $response->content, 'helloworldtoday2', 'expected content body /from_psgi_code'; } { ok my $response = request GET '/from_psgi_code_itr', 'got welcome from a catalyst controller'; is $response->content, 'helloworldtoday3', 'expected content body /from_psgi_code_itr'; } { ok my($res, $c) = ctx_request(POST '/test_psgi_keys?a=1&b=2', [c=>3,d=>4]); ok $c->req->env->{"psgix.input.buffered"}, "input is buffered"; is $c->req->parameters->get('c'), 3; is $c->req->parameters->get('d'), 4; is $c->req->parameters->get('a'), 1; is $c->req->parameters->get('b'), 2; is $c->req->body_parameters->get('c'), 3; is $c->req->body_parameters->get('d'), 4; is $c->req->query_parameters->get('a'), 1; is $c->req->query_parameters->get('b'), 2; } done_testing; Catalyst-Runtime-5.90053/t/optional_apache-cgi-rewrite.pl000755 000765 000024 00000003006 12217110344 023347 0ustar00johnstaff000000 000000 # Run all tests against CGI mode under Apache # # Note, to get this to run properly, you may need to give it the path to your # httpd.conf: # # perl t/optional_apache-cgi.pl -httpd_conf /etc/apache/httpd.conf use strict; use warnings; use Apache::Test; use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; use IO::Socket; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests so Apache::Test doesn't try to run them rmtree 't/tmp/TestApp/t'; $ENV{CATALYST_SERVER} = 'http://localhost:8529/rewrite'; if ( !-e 't/optional_apache-cgi-rewrite.pl' ) { die "ERROR: Please run test from the Catalyst-Runtime directory\n"; } push @ARGV, glob( 't/aggregate/live_*' ); Apache::TestRun->new->run(@ARGV); # clean up if the server has shut down # this allows the test files to stay around if the user ran -start-httpd if ( !check_port( 'localhost', 8529 ) ) { rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; } sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_apache-cgi.pl000755 000765 000024 00000002772 12217110344 021701 0ustar00johnstaff000000 000000 # Run all tests against CGI mode under Apache # # Note, to get this to run properly, you may need to give it the path to your # httpd.conf: # # perl t/optional_apache-cgi.pl -httpd_conf /etc/apache/httpd.conf use strict; use warnings; use Apache::Test; use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; use IO::Socket; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests so Apache::Test doesn't try to run them rmtree 't/tmp/TestApp/t'; $ENV{CATALYST_SERVER} = 'http://localhost:8529/cgi'; if ( !-e 't/optional_apache-cgi.pl' ) { die "ERROR: Please run test from the Catalyst-Runtime directory\n"; } push @ARGV, glob( 't/aggregate/live_*' ); Apache::TestRun->new->run(@ARGV); # clean up if the server has shut down # this allows the test files to stay around if the user ran -start-httpd if ( !check_port( 'localhost', 8529 ) ) { rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; } sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_apache-fastcgi-non-root.pl000755 000765 000024 00000003035 12217110344 024321 0ustar00johnstaff000000 000000 # Run all tests against FastCGI mode under Apache # # Note, to get this to run properly, you may need to give it the path to your # httpd.conf: # # perl t/optional_apache-fastcgi-non-root.pl -httpd_conf /etc/apache/httpd.conf use strict; use warnings; use Apache::Test; use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; use IO::Socket; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests so Apache::Test doesn't try to run them rmtree 't/tmp/TestApp/t'; $ENV{CATALYST_SERVER} = 'http://localhost:8529/fastcgi/deep/path'; if ( !-e 't/optional_apache-fastcgi.pl' ) { die "ERROR: Please run test from the Catalyst-Runtime directory\n"; } push @ARGV, glob( 't/aggregate/live_*' ); Apache::TestRun->new->run(@ARGV); # clean up if the server has shut down # this allows the test files to stay around if the user ran -start-httpd if ( !check_port( 'localhost', 8529 ) ) { rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; } sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_apache-fastcgi.pl000755 000765 000024 00000003002 12217110344 022542 0ustar00johnstaff000000 000000 # Run all tests against FastCGI mode under Apache # # Note, to get this to run properly, you may need to give it the path to your # httpd.conf: # # perl t/optional_apache-fastcgi.pl -httpd_conf /etc/apache/httpd.conf use strict; use warnings; use Apache::Test; use Apache::TestRun (); use File::Path; use File::Copy::Recursive; use FindBin; use IO::Socket; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests so Apache::Test doesn't try to run them rmtree 't/tmp/TestApp/t'; $ENV{CATALYST_SERVER} = 'http://localhost:8529'; if ( !-e 't/optional_apache-fastcgi.pl' ) { die "ERROR: Please run test from the Catalyst-Runtime directory\n"; } push @ARGV, glob( 't/aggregate/live_*' ); Apache::TestRun->new->run(@ARGV); # clean up if the server has shut down # this allows the test files to stay around if the user ran -start-httpd if ( !check_port( 'localhost', 8529 ) ) { rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; } sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_http-server-restart.t000644 000765 000024 00000007336 12106042701 023511 0ustar00johnstaff000000 000000 # This test tests the standalone server's auto-restart feature. use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_HTTP to enable this test' unless $ENV{TEST_HTTP}; } use File::Path; use FindBin; use LWP::Simple; use IO::Socket; use IPC::Open3; use Time::HiRes qw/sleep/; eval {require Catalyst::Devel; Catalyst::Devel->VERSION(1.0);}; plan skip_all => 'Catalyst::Devel required' if $@; plan skip_all => 'Catalyst::Devel >= 1.04 required' if $Catalyst::Devel::VERSION <= 1.03; eval "use File::Copy::Recursive"; plan skip_all => 'File::Copy::Recursive required' if $@; my $tmpdir = "$FindBin::Bin/../t/tmp"; # clean up rmtree $tmpdir if -d $tmpdir; # create a TestApp and copy the test libs into it mkdir $tmpdir; chdir $tmpdir; system( $^X, "-I$FindBin::Bin/../lib", '-MFile::Spec', '-e', "\@ARGV=('TestApp'); my \$devnull = File::Spec->devnull; open my \$fh, '>', \$devnull or die \"Cannot write to \$devnull: \$!\"; *STDOUT = \$fh; do \"$FindBin::Bin/../script/catalyst.pl\""); chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests rmtree 't/tmp/TestApp/t'; # spawn the standalone HTTP server my $port = 30000 + int rand( 1 + 10000 ); my( $server, $pid ); my @cmd = ($^X, "-I$FindBin::Bin/../lib", "-I$FindBin::Bin/lib", "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '--port', $port, '--restart'); $pid = open3( undef, $server, undef, @cmd ) or die "Unable to spawn standalone HTTP server: $!"; # switch to non-blocking reads so we can fail # gracefully instead of just hanging forever $server->blocking( 0 ); # wait for it to start print "Waiting for server to start...\n"; while ( check_port( 'localhost', $port ) != 1 ) { sleep 1; } # change various files my @files = ( "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp.pm", "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Action/Begin.pm", "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable.pm", "$FindBin::Bin/../t/tmp/TestApp/lib/TestApp/Controller/Immutable/HardToReload.pm", ); # change some files and make sure the server restarts itself NON_ERROR_RESTART: for ( 1 .. 20 ) { my $index = rand @files; open my $pm, '>>', $files[$index] or die "Unable to open $files[$index] for writing: $!"; print $pm "\n"; close $pm; # give the server time to notice the change and restart my $count = 0; my $line; while ( ( $line || '' ) !~ /ttempting to restart the server/ ) { # wait for restart message $line = $server->getline; sleep 0.1; if ( $count++ > 100 ) { fail "Server restarted"; SKIP: { skip "Server didn't restart, no sense in checking response", 1; } next NON_ERROR_RESTART; } }; pass "Server restarted"; $count = 0; while ( check_port( 'localhost', $port ) != 1 ) { # wait for it to restart sleep 0.1; die "Server appears to have died" if $count++ > 100; } my $response = get("http://localhost:$port/action/default"); like( $response, qr/Catalyst::Request/, 'Non-error restart, request OK' ); # give the server some time to reindex its files sleep 1; } # multiple restart directories # we need different options so we have to rebuild most # of the testing environment kill 'KILL', $pid; close $server; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; done_testing; sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_lighttpd-fastcgi-non-root.t000644 000765 000024 00000006401 12217110344 024544 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_LIGHTTPD to enable this test' unless $ENV{TEST_LIGHTTPD}; } use File::Path; use FindBin; use IO::Socket; eval "use FCGI"; plan skip_all => 'FCGI required' if $@; eval "use Catalyst::Devel 1.0"; plan skip_all => 'Catalyst::Devel required' if $@; eval "use File::Copy::Recursive"; plan skip_all => 'File::Copy::Recursive required' if $@; eval "use Test::Harness"; plan skip_all => 'Test::Harness required' if $@; my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || `which lighttpd`; chomp $lighttpd_bin; plan skip_all => 'Please set LIGHTTPD_BIN to the path to lighttpd' unless $lighttpd_bin && -x $lighttpd_bin; plan tests => 1; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$^X -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests rmtree 't/tmp/TestApp/t'; # Create a temporary lighttpd config my $docroot = "$FindBin::Bin/../t/tmp"; my $port = 8529; # Clean up docroot path $docroot =~ s{/t/..}{}; my $conf = <<"END"; # basic lighttpd config file for testing fcgi+catalyst server.modules = ( "mod_access", "mod_fastcgi", "mod_rewrite", "mod_accesslog" ) server.document-root = "$docroot" server.errorlog = "$docroot/error.log" accesslog.filename = "$docroot/access.log" server.bind = "127.0.0.1" server.port = $port # Work around inability to hit http://localhost/deep/path # without a trailing slash url.rewrite = ( "deep/path\$" => "deep/path/" ) # catalyst app specific fcgi setup fastcgi.server = ( "/deep/path" => ( "FastCgiTest" => ( "socket" => "$docroot/test.socket", "check-local" => "disable", "bin-path" => "$docroot/TestApp/script/testapp_fastcgi.pl", "min-procs" => 1, "max-procs" => 1, "idle-timeout" => 20, "bin-environment" => ( "PERL5LIB" => "$docroot/../../lib" ) ) ) ) END open(my $lightconf, '>', "$docroot/lighttpd.conf") or die "Can't open $docroot/lighttpd.conf: $!"; print {$lightconf} $conf or die "Write error: $!"; close $lightconf; my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |" or die "Unable to spawn lighttpd: $!"; # wait for it to start while ( check_port( 'localhost', $port ) != 1 ) { diag "Waiting for server to start..."; sleep 1; } # run the testsuite against the server $ENV{CATALYST_SERVER} = "http://localhost:$port/deep/path"; my @tests = (shift) || glob('t/aggregate/live_*'); eval { runtests(@tests); }; ok(!$@, 'lighttpd tests ran OK'); # shut it down kill 'INT', $pid; close $lighttpd; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_lighttpd-fastcgi.t000644 000765 000024 00000006123 12217110344 022774 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_LIGHTTPD to enable this test' unless $ENV{TEST_LIGHTTPD}; } use File::Path; use FindBin; use IO::Socket; eval "use FCGI"; plan skip_all => 'FCGI required' if $@; eval "use Catalyst::Devel 1.0"; plan skip_all => 'Catalyst::Devel required' if $@; eval "use File::Copy::Recursive"; plan skip_all => 'File::Copy::Recursive required' if $@; eval "use Test::Harness"; plan skip_all => 'Test::Harness required' if $@; my $lighttpd_bin = $ENV{LIGHTTPD_BIN} || `which lighttpd`; chomp $lighttpd_bin; plan skip_all => 'Please set LIGHTTPD_BIN to the path to lighttpd' unless $lighttpd_bin && -x $lighttpd_bin; plan tests => 1; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; # create a TestApp and copy the test libs into it mkdir "$FindBin::Bin/../t/tmp"; chdir "$FindBin::Bin/../t/tmp"; system "$^X -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp"; chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' ); # remove TestApp's tests rmtree 't/tmp/TestApp/t'; # Create a temporary lighttpd config my $docroot = "$FindBin::Bin/../t/tmp"; my $port = 8529; # Clean up docroot path $docroot =~ s{/t/..}{}; my $conf = <<"END"; # basic lighttpd config file for testing fcgi+catalyst server.modules = ( "mod_access", "mod_fastcgi", "mod_accesslog" ) server.document-root = "$docroot" server.errorlog = "$docroot/error.log" accesslog.filename = "$docroot/access.log" server.bind = "127.0.0.1" server.port = $port # catalyst app specific fcgi setup fastcgi.server = ( "" => ( "FastCgiTest" => ( "socket" => "$docroot/test.socket", "check-local" => "disable", "bin-path" => "$docroot/TestApp/script/testapp_fastcgi.pl", "min-procs" => 1, "max-procs" => 1, "idle-timeout" => 20, "bin-environment" => ( "PERL5LIB" => "$docroot/../../lib" ) ) ) ) END open(my $lightconf, '>', "$docroot/lighttpd.conf") or die "Can't open $docroot/lighttpd.conf: $!"; print {$lightconf} $conf or die "Write error: $!"; close $lightconf; my $pid = open my $lighttpd, "$lighttpd_bin -D -f $docroot/lighttpd.conf 2>&1 |" or die "Unable to spawn lighttpd: $!"; # wait for it to start while ( check_port( 'localhost', $port ) != 1 ) { diag "Waiting for server to start..."; sleep 1; } # run the testsuite against the server $ENV{CATALYST_SERVER} = "http://localhost:$port"; my @tests = (shift) || glob('t/aggregate/live_*'); eval { runtests(@tests); }; ok(!$@, 'lighttpd tests ran OK'); # shut it down kill 'INT', $pid; close $lighttpd; # clean up rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp"; sub check_port { my ( $host, $port ) = @_; my $remote = IO::Socket::INET->new( Proto => "tcp", PeerAddr => $host, PeerPort => $port ); if ($remote) { close $remote; return 1; } else { return 0; } } Catalyst-Runtime-5.90053/t/optional_memleak.t000644 000765 000024 00000003527 12217110344 021157 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_MEMLEAK to enable this test' unless $ENV{TEST_MEMLEAK}; } use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp'; eval "use Proc::ProcessTable"; plan skip_all => 'Proc::ProcessTable required for this test' if $@; eval "use HTTP::Body 0.03"; plan skip_all => 'HTTP::Body >= 0.03 required for this test' if $@; eval "use YAML"; plan skip_all => 'YAML required for this test' if $@; our $t = Proc::ProcessTable->new( cache_ttys => 1 ); our ( $initial, $final ) = ( 0, 0 ); our $tests = YAML::LoadFile("$FindBin::Bin/optional_stress.yml"); my $total_tests = 0; # let the user specify a single uri to test my $user_test = shift; if ( $user_test ) { plan tests => 1; run_test( $user_test ); } # otherwise, run all tests else { map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests}; plan tests => $total_tests; foreach my $test_group ( keys %{$tests} ) { foreach my $test ( @{ $tests->{$test_group} } ) { run_test( $test ); } } } sub run_test { my $uri = shift || die 'No URI given for test'; print "TESTING $uri\n"; # make a few requests to set initial memory size for ( 1 .. 3 ) { request( $uri ); } $initial = size_of($$); print "Initial Size: $initial\n"; for ( 1 .. 500 ) { request( $uri ); } $final = size_of($$); print "Final Size: $final\n"; if ( $final > $initial ) { print "Leaked: " . ($final - $initial) . "K\n"; } is( $final, $initial, "'$uri' memory is not leaking" ); } sub size_of { my $pid = shift; foreach my $p ( @{ $t->table } ) { if ( $p->pid == $pid ) { return $p->rss; } } die "Pid $pid not found?"; } Catalyst-Runtime-5.90053/t/optional_stress.t000644 000765 000024 00000001466 12217110344 021067 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_STRESS to enable this test' unless $ENV{TEST_STRESS}; } use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp'; our ( $iters, $tests ); BEGIN { eval "use YAML"; plan skip_all => 'YAML is required for this test' if $@; $iters = $ENV{TEST_STRESS} || 10; $tests = YAML::LoadFile("$FindBin::Bin/optional_stress.yml"); my $total_tests = 0; map { $total_tests += scalar @{ $tests->{$_} } } keys %{$tests}; plan tests => $iters * $total_tests; } for ( 1 .. $iters ) { run_tests(); } sub run_tests { foreach my $test_group ( keys %{$tests} ) { foreach my $test ( @{ $tests->{$test_group} } ) { ok( request($test), $test_group . ' - ' . $test ); } } } Catalyst-Runtime-5.90053/t/optional_stress.yml000644 000765 000024 00000007770 12106042701 021427 0ustar00johnstaff000000 000000 --- component/controller/action/auto: - http://localhost/action/auto/one - http://localhost/action/auto/anything - http://localhost/action/auto/deep/one - http://localhost/action/auto/deep/anything - http://localhost/action/auto/abort/one - http://localhost/action/auto/abort/anything component/controller/action/begin: - http://localhost/action/begin component/controller/action/default: - http://localhost/action/default - http://localhost/foo/bar/action - http://localhost/action/default/arg1/arg2 component/controller/action/detach: - http://localhost/action/detach/one - http://localhost/action/detach/path - http://localhost/action/detach/with_args/old - http://localhost/action/detach/with_method_and_args/old component/controller/action/end: - http://localhost/action/end component/controller/action/forward: - http://localhost/action/forward/global - http://localhost/action/forward/one - http://localhost/action/forward/jojo - http://localhost/action/forward/with_args/old - http://localhost/action/forward/with_method_and_args/old - http://localhost/action/forward/args_embed_relative - http://localhost/action/forward/args_embed_absolute component/controller/action/global: - http://localhost/action_global_one - http://localhost/action_global_two - http://localhost/action_global_three component/controller/action/index: - http://localhost/ - http://localhost - http://localhost/index/ - http://localhost/index - http://localhost/action/index/ - http://localhost/action/index - http://localhost/action/index/foo component/controller/action/inheritance: - http://localhost/action/inheritance - http://localhost/action/inheritance/a - http://localhost/action/inheritance/a/b component/controller/action/local: - http://localhost/action/local/one - http://localhost/action/local/two - http://localhost/action/local/three - http://localhost/action/local/four/five/six component/controller/action/multipath: - http://localhost/action/multipath/multipath - http://localhost/multipath - http://localhost/multipath1 - http://localhost/action/multipath/multipath2 component/controller/action/path: - http://localhost/action/path/a path with spaces - http://localhost/action/path/åäö component/controller/action/private: - http://localhost/action/private/one - http://localhost/action/private/two - http://localhost/three - http://localhost/action/private/four - http://localhost/action/private/five component/controller/action/regexp: - http://localhost/action/regexp/10/hello - http://localhost/action/regexp/hello/10 component/controller/action/streaming: - http://localhost/streaming - http://localhost/action/streaming/body engine/request/body: [] engine/request/cookies: [] engine/request/headers: [] engine/request/parameters: [] engine/request/uploads: [] engine/request/uri: - http://localhost/engine/request/uri/change_path - http://localhost/engine/request/uri/change_base - http://localhost/engine/request/uri - http://localhost/engine/request/uri?a=1;a=2;b=3 - http://localhost/engine/request/uri?text=Catalyst%20Rocks engine/response/cookies: - http://localhost/engine/response/cookies/one - http://localhost/engine/response/cookies/two engine/response/errors: - http://localhost/engine/response/errors/one - http://localhost/engine/response/errors/two - http://localhost/engine/response/errors/three engine/response/headers: - http://localhost/engine/response/headers/one engine/response/large: - http://localhost/engine/response/large/ engine/response/redirect: - http://localhost/engine/response/redirect/one - http://localhost/engine/response/redirect/two - http://localhost/engine/response/redirect/three - http://localhost/engine/response/redirect/four engine/response/status: - http://localhost/engine/response/status/s200 - http://localhost/engine/response/status/s400 - http://localhost/engine/response/status/s403 - http://localhost/engine/response/status/s404 - http://localhost/engine/response/status/s500 Catalyst-Runtime-5.90053/t/optional_threads.t000644 000765 000024 00000002362 12217110344 021172 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { plan skip_all => 'set TEST_THREADS to enable this test' unless $ENV{TEST_THREADS}; } use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp'; use Catalyst::Request; use Config; use HTTP::Response; if ( $Config{useithreads} && !$ENV{CATALYST_SERVER} ) { require threads; plan tests => 3; } else { if ( $ENV{CATALYST_SERVER} ) { plan skip_all => 'Using remote server'; } else { plan skip_all => 'Needs a Perl with ithreads enabled'; } } no warnings 'redefine'; sub request { my $thr = threads->new( sub { Catalyst::Test::local_request('TestApp',@_) }, @_ ); $thr->join; } # test that running inside a thread works ok { my @expected = qw[ TestApp::Controller::Action::Default->begin TestApp::Controller::Action::Default->default TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/default'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); } Catalyst-Runtime-5.90053/t/plack-middleware-config.t000644 000765 000024 00000002575 12254332025 022314 0ustar00johnstaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use FindBin; use Test::More; use HTTP::Request::Common; BEGIN { eval { require Catalyst::Plugin::ConfigLoader; 1; } || plan skip_all => 'Need Catalyst::Plugin::ConfigLoader' } use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestMiddlewareFromConfig'; ok my($res, $c) = ctx_request('/'); { ok my $response = request GET $c->uri_for_action('/welcome'), 'got welcome from a catalyst controller'; is $response->content, 'Welcome to Catalyst', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static/message.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static2/message2.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static3/message3.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/forced'), 'got welcome from a catalyst controller'; like $response->content, qr'forced message', 'expected content body'; ok $response->headers->{"x-runtime"}, "Got value for expected middleware"; } done_testing; Catalyst-Runtime-5.90053/t/plack-middleware.t000644 000765 000024 00000002366 12236261623 021054 0ustar00johnstaff000000 000000 #!/usr/bin/env perl use warnings; use strict; use FindBin; use Test::More; use HTTP::Request::Common; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestMiddleware'; ok my($res, $c) = ctx_request('/'); { ok my $response = request GET $c->uri_for_action('/welcome'), 'got welcome from a catalyst controller'; is $response->content, 'Welcome to Catalyst', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static/message.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static2/message2.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/static3/message3.txt'), 'got welcome from a catalyst controller'; like $response->content, qr'static message', 'expected content body'; } { ok my $response = request GET $c->uri_for('/forced'), 'got welcome from a catalyst controller'; like $response->content, qr'forced message', 'expected content body'; ok $response->headers->{"x-runtime"}, "Got value for expected middleware"; } done_testing; Catalyst-Runtime-5.90053/t/plugin_new_method_backcompat.t000644 000765 000024 00000002404 12217110344 023523 0ustar00johnstaff000000 000000 # Test that plugins with their own new method don't break applications. # 5.70 creates all of the request/response structure itself in prepare, # and as the new method in our plugin just blesses our args, that works nicely. # In 5.80, we rely on the new method to appropriately initialise data # structures, and therefore we need to inline a new method on MyApp to ensure # that plugins don't get it wrong for us. # Also tests method modifiers and etc in MyApp.pm still work as expected. use Test::More; use Moose::Util qw/find_meta/; use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test qw/TestAppPluginWithConstructor/; TestAppPluginWithConstructor->_make_immutable_if_needed; ok find_meta('TestAppPluginWithConstructor')->is_immutable, 'Am immutable after use'; ok request('/foo')->is_success, 'Can get /foo'; is $TestAppPluginWithConstructor::MODIFIER_FIRED, 1, 'Before modifier was fired correctly.'; my $warning; eval "use TestAppBadlyImmutable"; local $SIG{__WARN__} = sub { $warning .= $_[0] }; TestAppBadlyImmutable->_make_immutable_if_needed; like $warning, qr/\QYou made your application class (TestAppBadlyImmutable) immutable/, 'An application class that is already immutable but does not inline the constructor warns at ->setup'; done_testing; Catalyst-Runtime-5.90053/t/psgi-log.t000644 000765 000024 00000004646 12132030171 017356 0ustar00johnstaff000000 000000 =head1 PROBLEM In https://github.com/plack/Plack/commit/cafa5db84921f020183a9c834fd6a4541e5a6b84 chansen made a change to the FCGI handler in Plack, in which he replaced STDERR, STDOUT and STDIN with proper IO::Handle objects. The side effect of that change is that catalyst outputing logs on STDERR will no longer end up by default in the error log of the webserver when running under FCGI. This test tries to make sure we use the propper parts of the psgi environment when we output things from Catalyst::Log. There is one more "regression", and that is warnings. By using Catalyst::Plugin::LogWarnings, you also get those in the right place if this test passes :) =cut use strict; use warnings; no warnings 'once'; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More; use File::Spec; use File::Temp qw/ tempdir /; use TestApp; use Plack::Builder; use Plack::Test; use HTTP::Request::Common; { package MockHandle; use Moose; has 'log' => (is => 'ro', isa => 'ArrayRef', traits => ['Array'], default => sub { [] }, handles => { 'logs' => 'elements', 'print' => 'push', } ); no Moose; } #subtest "psgi.errors" => sub { my $handle = MockHandle->new(); my $app = builder { enable sub { my $app = shift; sub { my $env = shift; $env->{'psgi.errors'} = $handle; my $res = $app->($env); return $res; }; }; TestApp->psgi_app; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/log/debug"); my @logs = $handle->logs; is(scalar(@logs), 1, "psgi.errors: one event output"); like($logs[0], qr/debug$/, "psgi.errors: event matches test data"); }; }; #subtest "psgix.logger" => sub { my @logs; my $logger = sub { push(@logs, @_); }; my $app = builder { enable sub { my $app = shift; sub { my $env = shift; $env->{'psgix.logger'} = $logger; $app->($env); }; }; TestApp->psgi_app; }; test_psgi $app, sub { my $cb = shift; my $res = $cb->(GET "/log/debug"); is(scalar(@logs), 1, "psgix.logger: one event logged"); is_deeply($logs[0], { level => 'debug', message => "debug" }, "psgix.logger: right stuff"); }; }; done_testing; Catalyst-Runtime-5.90053/t/psgi_file_testapp.t000644 000765 000024 00000001100 12121675274 021335 0ustar00johnstaff000000 000000 use strict; use warnings; no warnings 'once'; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More; use File::Spec; use File::Temp qw/ tempdir /; my $temp; BEGIN { $temp = tempdir( CLEANUP => 1 ); $ENV{CATALYST_HOME} = $temp; open(my $psgi, '>', File::Spec->catfile($temp, 'testapp.psgi')) or die; print $psgi q{ use strict; use TestApp; $main::have_loaded_psgi = 1; my $app = TestApp->psgi_app; }; close($psgi); } use Catalyst::Test qw/ TestApp /; ok request('/'); ok $main::have_loaded_psgi; done_testing; Catalyst-Runtime-5.90053/t/psgi_file_testapp_engine_plackup_compat.t000644 000765 000024 00000001741 12217110344 025743 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More; use Test::Fatal; use Plack::Test; use TestApp; use HTTP::Request::Common; plan skip_all => "Catalyst::Engine::PSGI required for this test" unless eval { local $SIG{__WARN__} = sub{}; require Catalyst::Engine::PSGI; 1; }; my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; TestApp->setup_engine('PSGI'); my $app = sub { TestApp->run(@_) }; like $warning, qr/You are running Catalyst\:\:Engine\:\:PSGI/, 'got deprecation alert warning'; test_psgi $app, sub { my $cb = shift; is exception { my $TIMEOUT_IN_SECONDS = 5; local $SIG{ALRM} = sub { die "alarm\n" }; alarm($TIMEOUT_IN_SECONDS); my $res = $cb->(GET "/"); is $res->content, "root index", 'got expected content'; like $warning, qr/env as a writer/, 'got deprecation alert warning'; alarm(0); 1 }, undef, q{app didn't die or timeout}; }; done_testing; Catalyst-Runtime-5.90053/t/psgi_file_testapp_engine_psgi_compat.t000644 000765 000024 00000001447 12121675274 025265 0ustar00johnstaff000000 000000 use strict; use warnings; no warnings 'once'; use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More; use File::Spec; use File::Temp qw/ tempdir /; my $temp; BEGIN { $temp = tempdir( CLEANUP => 1 ); $ENV{CATALYST_HOME} = $temp; open(my $psgi, '>', File::Spec->catfile($temp, 'testapp.psgi')) or die; print $psgi q{ use strict; use TestApp; $main::have_loaded_psgi = 1; TestApp->setup_engine('PSGI'); my $app = sub { TestApp->run(@_) }; }; close($psgi); } use Catalyst::Test qw/ TestApp /; ok !$main::have_loaded_psgi, 'legacy psgi file got ignored'; like do { my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; ok request('/'); $warning; }, qr/ignored/, 'legacy psgi files raise a warning'; done_testing; Catalyst-Runtime-5.90053/t/something/000755 000765 000024 00000000000 12255610005 017441 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/unicode_plugin_charset_utf8.t000644 000765 000024 00000001326 12156157140 023324 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/ $Bin /; use lib "$Bin/lib"; use Data::Dumper; BEGIN { $ENV{TESTAPP_ENCODING} = 'UTF-8'; $ENV{TESTAPP_DEBUG} = 0; $ENV{CATALYST_DEBUG} = 0; } use Catalyst::Test 'TestAppUnicode'; ok request('/capture_charset/utf-8'); is scalar(@TestLogger::LOGS), 0; ok request('/capture_charset/latin1'); is scalar(@TestLogger::LOGS), 1 or diag Dumper(\@TestLogger::LOGS); @TestLogger::LOGS = (); ok request('/capture_charset/iso-8859-1; header=present'); is scalar(@TestLogger::LOGS), 1 or diag Dumper(\@TestLogger::LOGS); like $TestLogger::LOGS[0], qr/content type is 'iso-8859-1'/; like $TestLogger::ELOGS[0], qr/Unicode::Encoding plugin/; done_testing; Catalyst-Runtime-5.90053/t/unicode_plugin_config.t000644 000765 000024 00000001175 12217110344 022165 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; BEGIN { $ENV{TESTAPP_ENCODING} = 'UTF-8' }; # setup library path use FindBin qw($Bin); use lib "$Bin/lib"; BEGIN { if ( !eval { require Test::WWW::Mechanize::Catalyst } || ! Test::WWW::Mechanize::Catalyst->VERSION('0.51') ) { plan skip_all => 'Need Test::WWW::Mechanize::Catalyst for this test'; } } # make sure testapp works use_ok('TestAppUnicode'); use Test::WWW::Mechanize::Catalyst 'TestAppUnicode'; my $mech = Test::WWW::Mechanize::Catalyst->new; { TestAppUnicode->encoding('UTF-8'); $mech->get_ok('http://localhost/unicode', 'encoding configured ok'); } done_testing; Catalyst-Runtime-5.90053/t/unicode_plugin_live.t000644 000765 000024 00000005151 12217110344 021655 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use IO::Scalar; # setup library path use FindBin qw($Bin); use lib "$Bin/lib"; BEGIN { if ( !eval { require Test::WWW::Mechanize::Catalyst } || ! Test::WWW::Mechanize::Catalyst->VERSION('0.51') ) { plan skip_all => 'Need Test::WWW::Mechanize::Catalyst for this test'; } } # make sure testapp works use_ok('TestAppUnicode') or BAIL_OUT($@); our $TEST_FILE = IO::Scalar->new(\"this is a test"); sub IO::Scalar::FILENO { -1 }; # needed? # a live test against TestAppUnicode, the test application use Test::WWW::Mechanize::Catalyst 'TestAppUnicode'; my $mech = Test::WWW::Mechanize::Catalyst->new; $mech->get_ok('http://localhost/', 'get main page'); $mech->content_like(qr/it works/i, 'see if it has our text'); is ($mech->response->header('Content-Type'), 'text/html; charset=UTF-8', 'Content-Type with charset' ); { $mech->get_ok('http://localhost/unicode_no_enc', 'get unicode_no_enc'); my $exp = "\xE3\x81\xBB\xE3\x81\x92"; my $got = Encode::encode_utf8($mech->content); is ($mech->response->header('Content-Type'), 'text/plain', 'Content-Type with no charset'); is($got, $exp, 'content contains hoge'); } { $mech->get_ok('http://localhost/unicode', 'get unicode'); is ($mech->response->header('Content-Type'), 'text/plain; charset=UTF-8', 'Content-Type with charset'); my $exp = "\xE3\x81\xBB\xE3\x81\x92"; my $got = Encode::encode_utf8($mech->content); is($got, $exp, 'content contains hoge'); } { $mech->get_ok('http://localhost/not_unicode', 'get bytes'); my $exp = "\xE1\x88\xB4\xE5\x99\xB8"; my $got = Encode::encode_utf8($mech->content); is($got, $exp, 'got 1234 5678'); } { $mech->get_ok('http://localhost/file', 'get file'); $mech->content_like(qr/this is a test/, 'got filehandle contents'); } { # The latin 1 case is the one everyone forgets. I want to really make sure # its right, so lets check the damn bytes. $mech->get_ok('http://localhost/latin1', 'get latin1'); is ($mech->response->header('Content-Type'), 'text/plain; charset=UTF-8', 'Content-Type with charset'); my $exp = "LATIN SMALL LETTER E WITH ACUTE: \xC3\xA9"; my $got = Encode::encode_utf8($mech->content); is ($got, $exp, 'content octets are UTF-8'); } { $mech->get_ok('http://localhost/shift_jis', 'get shift_jis'); is ($mech->response->header('Content-Type'), 'text/plain; charset=Shift_JIS', 'Content-Type with charset'); my $exp = "\xE3\x81\xBB\xE3\x81\x92"; my $got = Encode::encode_utf8($mech->content); is ($got, $exp, 'content octets are Shift_JIS'); } done_testing; Catalyst-Runtime-5.90053/t/unicode_plugin_no_encoding.t000644 000765 000024 00000002122 12217110344 023173 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use utf8; # setup library path use FindBin qw($Bin); use lib "$Bin/lib"; use Catalyst::Test 'TestAppWithoutUnicode'; use Encode; use HTTP::Request::Common; use URI::Escape qw/uri_escape_utf8/; use HTTP::Status 'is_server_error'; use Data::Dumper; my $encode_str = "\x{e3}\x{81}\x{82}"; # e38182 is japanese 'あ' my $decode_str = Encode::decode('utf-8' => $encode_str); my $escape_str = uri_escape_utf8($decode_str); check_parameter(GET "/?myparam=$escape_str"); check_parameter(POST '/', Content_Type => 'form-data', Content => [ 'myparam' => [ "$Bin/unicode_plugin_no_encoding.t", "$Bin/unicode_plugin_request_decode.t", ] ], ); sub check_parameter { my ( undef, $c ) = ctx_request(shift); my $myparam = $c->req->param('myparam'); ok !utf8::is_utf8($myparam); unless ( $c->request->method eq 'POST' ) { is $c->res->output => $encode_str; is $myparam => $encode_str; } is scalar(@TestLogger::ELOGS), 0 or diag Dumper(\@TestLogger::ELOGS); } done_testing; Catalyst-Runtime-5.90053/t/unicode_plugin_request_decode.t000644 000765 000024 00000004104 12217110344 023706 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 5 * 5; use utf8; # setup library path use FindBin qw($Bin); use lib "$Bin/lib"; use Catalyst::Test 'TestAppUnicode'; use Encode; use HTTP::Request::Common; use URI::Escape qw/uri_escape_utf8/; use HTTP::Status 'is_server_error'; my $encode_str = "\x{e3}\x{81}\x{82}"; # e38182 is japanese 'あ' my $decode_str = Encode::decode('utf-8' => $encode_str); my $escape_str = uri_escape_utf8($decode_str); check_parameter(GET "/?foo=$escape_str"); check_parameter(POST '/', ['foo' => $encode_str]); check_parameter(POST '/', Content_Type => 'form-data', Content => [ 'foo' => [ "$Bin/unicode_plugin_request_decode.t", $encode_str, ] ], ); check_argument(GET "/$escape_str"); check_capture(GET "/capture/$escape_str"); # sending non-utf8 data my $non_utf8_data = "%C3%E6%CB%AA"; check_fallback(GET "/?q=${non_utf8_data}"); check_fallback(GET "/${non_utf8_data}"); check_fallback(GET "/capture/${non_utf8_data}"); check_fallback(POST '/', ['foo' => $non_utf8_data]); sub check_parameter { my ( undef, $c ) = ctx_request(shift); is $c->res->output => '

It works

'; my $foo = $c->req->param('foo'); ok utf8::is_utf8($foo); is $foo => $decode_str; my $other_foo = $c->req->method eq 'POST' ? $c->req->upload('foo') ? $c->req->upload('foo')->filename : $c->req->body_parameters->{foo} : $c->req->query_parameters->{foo}; ok utf8::is_utf8($other_foo); is $other_foo => $decode_str; } sub check_argument { my ( undef, $c ) = ctx_request(shift); is $c->res->output => '

It works

'; my $foo = $c->req->args->[0]; ok utf8::is_utf8($foo); is $foo => $decode_str; } sub check_capture { my ( undef, $c ) = ctx_request(shift); is $c->res->output => '

It works

'; my $foo = $c->req->captures->[0]; ok utf8::is_utf8($foo); is $foo => $decode_str; } sub check_fallback { my ( $res, $c ) = ctx_request(shift); ok(!is_server_error($res->code)) or diag('Response code is: ' . $res->code); } Catalyst-Runtime-5.90053/t/unit_core_methodattributes_method_metaclass_on_subclasses.t000644 000765 000024 00000001152 12106042701 031602 0ustar00johnstaff000000 000000 use strict; use Test::More; { package NoAttributes::CT; use Moose; BEGIN { extends qw/Catalyst::Controller/; }; sub test {} } { package NoAttributes::RT; use Moose; extends qw/Catalyst::Controller/; sub test {} } my $c = 0; foreach my $class (qw/ CT RT /) { my $class_name = 'NoAttributes::' . $class; my $meta = $class_name->meta; my $meth = $meta->find_method_by_name('test'); { local $TODO = "Known MX::MethodAttributes issue" if $c++; ok $meth->can('attributes'), 'method metaclass has ->attributes method for ' . $class;; } } done_testing; Catalyst-Runtime-5.90053/t/unit_core_script_test.t000644 000765 000024 00000002363 12217110344 022246 0ustar00johnstaff000000 000000 use strict; use warnings; use Carp qw(croak); use FindBin qw/$Bin/; use lib "$Bin/lib"; use Test::More; use Test::Fatal; use Catalyst::Script::Test; use File::Temp qw/tempfile/; use IO::Handle; is run_test('/'), "root index\n", 'correct content printed'; is run_test('/moose/get_attribute'), "42\n", 'Correct content printed for non root action'; done_testing; sub run_test { my $url = shift; my ($fh, $fn) = tempfile(); binmode( $fh ); binmode( STDOUT ); { local @ARGV = ($url); my $i; is exception { $i = Catalyst::Script::Test->new_with_options(application_name => 'TestApp'); }, undef, "new_with_options"; ok $i; my $saved; open( $saved, '>&'. STDOUT->fileno ) or croak("Can't dup stdout: $!"); open( STDOUT, '>&='. $fh->fileno ) or croak("Can't open stdout: $!"); eval { $i->run }; ok !$@, 'Ran ok'; STDOUT->flush or croak("Can't flush stdout: $!"); open( STDOUT, '>&'. fileno($saved) ) or croak("Can't restore stdout: $!"); } my $data = do { my $fh; open($fh, '<', $fn) or die $!; local $/; <$fh>; }; $fh = undef; unlink $fn if -r $fn; return $data; } Catalyst-Runtime-5.90053/t/unit_stats.t000644 000765 000024 00000010273 12217110344 020030 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 13; use Time::HiRes qw/gettimeofday/; use Tree::Simple; my @fudge_t = ( 0, 0 ); BEGIN { no warnings; *Time::HiRes::gettimeofday = sub () { return @fudge_t }; } BEGIN { use_ok("Catalyst::Stats") }; { my $stats = Catalyst::Stats->new; is (ref($stats), "Catalyst::Stats", "new"); is_deeply([ $stats->created ], [0, 0], "created time"); my @expected; # level, string, time $fudge_t[0] = 1; ok($stats->profile("single comment arg"), "profile"); push(@expected, [ 0, "- single comment arg", 1, 0 ]); $fudge_t[0] = 3; $stats->profile(comment => "hash comment arg"); push(@expected, [ 0, "- hash comment arg", 2, 0 ]); $fudge_t[0] = 10; $stats->profile(begin => "block", comment => "start block"); push(@expected, [ 0, "block - start block", 4, 1 ]); $fudge_t[0] = 11; $stats->profile("inside block"); push(@expected, [ 1, "- inside block", 1, 0 ]); $fudge_t[1] = 100000; my $uid = $stats->profile(begin => "nested block", uid => "boo"); push(@expected, [ 1, "nested block", 0.7, 1 ]); is ($uid, "boo", "set UID"); $stats->enable(0); $fudge_t[1] = 150000; $stats->profile("this shouldn't appear"); $stats->enable(1); $fudge_t[1] = 200000; $stats->profile(begin => "double nested block 1"); push(@expected, [ 2, "double nested block 1", 0.2, 1 ]); $stats->profile(comment => "attach to uid", parent => $uid); $fudge_t[1] = 250000; $stats->profile(begin => "badly nested block 1"); push(@expected, [ 3, "badly nested block 1", 0.35, 1 ]); $fudge_t[1] = 300000; $stats->profile(comment => "interleave 1"); push(@expected, [ 4, "- interleave 1", 0.05, 0 ]); $fudge_t[1] = 400000; # end double nested block time $stats->profile(end => "double nested block 1"); $fudge_t[1] = 500000; $stats->profile(comment => "interleave 2"); push(@expected, [ 4, "- interleave 2", 0.2, 0 ]); $fudge_t[1] = 550000; $stats->profile(begin => "begin with no end"); push(@expected, [ 4, "begin with no end", 0.05, 1 ]); $fudge_t[1] = 600000; # end badly nested block time $stats->profile(end => "badly nested block 1"); $fudge_t[1] = 800000; # end nested block time $stats->profile(end => "nested block"); $fudge_t[0] = 14; # end block time $fudge_t[1] = 0; $stats->profile(end => "block", comment => "end block"); push(@expected, [ 2, "- attach to uid", 0.1, 0 ]); my @report = $stats->report; is_deeply(\@report, \@expected, "report"); # print scalar($stats->report); is ($stats->elapsed, 14, "elapsed"); } # COMPATABILITY METHODS # accept { my $stats = Catalyst::Stats->new; my $root = $stats->{tree}; my $uid = $root->getUID; my $visitor = Tree::Simple::Visitor::FindByUID->new; $visitor->includeTrunk(1); # needed for this test $visitor->searchForUID($uid); $stats->accept($visitor); is( $visitor->getResult, $root, '[COMPAT] accept()' ); } # addChild { my $stats = Catalyst::Stats->new; my $node = Tree::Simple->new( { action => 'test', elapsed => '10s', comment => "", } ); $stats->addChild( $node ); my $actual = $stats->{ tree }->{ _children }->[ 0 ]; is( $actual, $node, '[COMPAT] addChild()' ); is( $actual->getNodeValue->{ elapsed }, 10, '[COMPAT] addChild(), data munged' ); } # setNodeValue { my $stats = Catalyst::Stats->new; my $stat = { action => 'test', elapsed => '10s', comment => "", }; $stats->setNodeValue( $stat ); is_deeply( $stats->{tree}->getNodeValue, { action => 'test', elapsed => 10, comment => '' } , '[COMPAT] setNodeValue(), data munged' ); } # getNodeValue { my $stats = Catalyst::Stats->new; my $expected = $stats->{tree}->getNodeValue->{t}; is_deeply( $stats->getNodeValue, $expected, '[COMPAT] getNodeValue()' ); } # traverse { my $stats = Catalyst::Stats->new; $stats->{tree}->addChild( Tree::Simple->new( { foo => 'bar' } ) ); my @value; $stats->traverse( sub { push @value, shift->getNodeValue->{ foo }; } ); is_deeply( \@value, [ 'bar' ], '[COMPAT] traverse()' ); } Catalyst-Runtime-5.90053/t/unit_utils_load_class.t000644 000765 000024 00000004311 12217110344 022212 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 18; use Class::Load 'is_class_loaded'; use lib "t/lib"; BEGIN { use_ok("Catalyst::Utils") }; { package This::Module::Is::Not::In::Inc::But::Does::Exist; sub moose {}; } my $warnings = 0; $SIG{__WARN__} = sub { return if $_[0] =~ /Subroutine (?:un|re|)initialize redefined at .*C3\.pm/; $warnings++; }; ok( !is_class_loaded("TestApp::View::Dump"), "component not yet loaded" ); Catalyst::Utils::ensure_class_loaded("TestApp::View::Dump"); ok( is_class_loaded("TestApp::View::Dump"), "loaded ok" ); is( $warnings, 0, "no warnings emitted" ); $warnings = 0; Catalyst::Utils::ensure_class_loaded("TestApp::View::Dump"); is( $warnings, 0, "calling again doesn't reaload" ); ok( !is_class_loaded("TestApp::View::Dump::Request"), "component not yet loaded" ); Catalyst::Utils::ensure_class_loaded("TestApp::View::Dump::Request"); ok( is_class_loaded("TestApp::View::Dump::Request"), "loaded ok" ); is( $warnings, 0, "calling again doesn't reaload" ); undef $@; eval { Catalyst::Utils::ensure_class_loaded("This::Module::Is::Probably::Not::There") }; ok( $@, "doesn't defatalize" ); like( $@, qr/There\.pm.*\@INC/, "error looks right" ); undef $@; eval { Catalyst::Utils::ensure_class_loaded("__PACKAGE__") }; ok( $@, "doesn't defatalize" ); like( $@, qr/__PACKAGE__\.pm.*\@INC/, "errors sanely on __PACKAGE__.pm" ); $@ = "foo"; Catalyst::Utils::ensure_class_loaded("TestApp::View::Dump::Response"); is( $@, "foo", '$@ is untouched' ); undef $@; eval { Catalyst::Utils::ensure_class_loaded("This::Module::Is::Not::In::Inc::But::Does::Exist") }; ok( !$@, "no error when loading non existent .pm that *does* have a symbol table entry" ); undef $@; eval { Catalyst::Utils::ensure_class_loaded('Silly::File::.#Name') }; like($@, qr/Malformed class Name/, 'errored when attempting to load a file beginning with a .'); undef $@; eval { Catalyst::Utils::ensure_class_loaded('Silly::File::Name.pm') }; like($@, qr/Malformed class Name/, 'errored sanely when given a classname ending in .pm'); undef $@; $warnings = 0; Catalyst::Utils::ensure_class_loaded("NullPackage"); is( $warnings, 1, 'Loading a package which defines no symbols warns'); is( $@, undef, '$@ still undef' ); Catalyst-Runtime-5.90053/t/unit_utils_subdir.t000644 000765 000024 00000002567 12106042701 021407 0ustar00johnstaff000000 000000 use Test::More tests => 8; use strict; use warnings; # simulates an entire testapp rooted at t/something # except without bothering creating it since it's # only the -e check on the Makefile.PL that matters BEGIN { use_ok 'Catalyst::Utils' } use FindBin; use Path::Class::Dir; { $INC{'TestApp.pm'} = "$FindBin::Bin/something/script/foo/../../lib/TestApp.pm"; my $home = Catalyst::Utils::home('TestApp'); like($home, qr{t[\/\\]something}, "has path TestApp/t/something"); unlike($home, qr{[\/\\]script[\/\\]foo}, "doesn't have path /script/foo"); } { $INC{'TestApp.pm'} = "$FindBin::Bin/something/script/foo/bar/../../../lib/TestApp.pm"; my $home = Catalyst::Utils::home('TestApp'); like($home, qr{t[\/\\]something}, "has path TestApp/t/something"); unlike($home, qr{[\/\\]script[\/\\]foo[\/\\]bar}, "doesn't have path /script/foo/bar"); } { $INC{'TestApp.pm'} = "$FindBin::Bin/something/script/../lib/TestApp.pm"; my $home = Catalyst::Utils::home('TestApp'); like($home, qr{t[\/\\]something}, "has path TestApp/t/something"); unlike($home, qr{[\/\\]script[\/\\]foo}, "doesn't have path /script/foo"); } { $INC{'TestApp.pm'} = "TestApp.pm"; my $dir = "$FindBin::Bin/something"; chdir( $dir ); my $home = Catalyst::Utils::home('TestApp'); $dir = Path::Class::Dir->new( $dir ); is( $home, "$dir", 'same dir loading' ); } Catalyst-Runtime-5.90053/t/something/Makefile.PL000644 000765 000024 00000000000 12106042701 021376 0ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/something/script/000755 000765 000024 00000000000 12255610005 020745 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/something/script/foo/000755 000765 000024 00000000000 12255610005 021530 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/something/script/foo/bar/000755 000765 000024 00000000000 12255610005 022274 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/something/script/foo/bar/for_dist000644 000765 000024 00000000000 12106042701 024013 0ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ACLTestApp/000755 000765 000024 00000000000 12255610005 020112 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ACLTestApp.pm000644 000765 000024 00000000733 12156157140 020461 0ustar00johnstaff000000 000000 package ACLTestApp; use Test::More; use strict; use warnings; use MRO::Compat; use Scalar::Util (); use TestLogger; use base qw/Catalyst Catalyst::Controller/; use Catalyst qw//; __PACKAGE__->log(TestLogger->new); sub execute { my $c = shift; my ( $class, $action ) = @_; if ( Scalar::Util::blessed($action) and $action->name ne "foobar" ) { eval { $c->detach( 'foobar', [$action, 'foo'] ) }; } $c->next::method( @_ ); } __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/000755 000765 000024 00000000000 12255610005 017776 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/CDICompatTestPlugin.pm000644 000765 000024 00000002356 12106042701 022335 0ustar00johnstaff000000 000000 package CDICompatTestPlugin; # This plugin specificially tests an edge case of C::D::I compat, # where you load a plugin which creates an accessor with the same # name as a class data accessor (_config in this case).. # This is what happens if you use the authentication back-compat # stuff, as C::A::Plugin::Credential::Password is added to the plugin # list, and that uses base C::A::C::P class, does the mk_accessors. # If a class data method called _config hasn't been created in # MyApp ($app below), then our call to ->config gets our accessor # (rather than the class data one), and we fail.. use strict; use warnings; use base qw/Class::Accessor::Fast/; use MRO::Compat; __PACKAGE__->mk_accessors(qw/_config/); sub setup { my $app = shift; $app->config; $app->next::method(@_); } # However, if we are too enthusiastic about adding accessors to the # MyApp package, then this method isn't called (as there is a local # symbol already). # Note - use a different package here, so that Moose's # package detection code doesn't get confused.. $CDICompatTestPlugin::Data::HAS_RUN_SETUP_FINISHED = 0; sub setup_finished { my $app = shift; $CDICompatTestPlugin::Data::HAS_RUN_SETUP_FINISHED = 1; $app->next::method(@_); } 1; Catalyst-Runtime-5.90053/t/lib/ChainedActionsApp/000755 000765 000024 00000000000 12255610005 021527 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ChainedActionsApp.pm000644 000765 000024 00000000546 12156157140 022100 0ustar00johnstaff000000 000000 package ChainedActionsApp; use Moose; use namespace::autoclean; use TestLogger; use Catalyst::Runtime 5.80; use Catalyst qw//; extends 'Catalyst'; our $VERSION = "0.01"; $VERSION = eval $VERSION; __PACKAGE__->config( name => 'ChainedActionsApp', disable_component_regex_fallback => 1, ); __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/DeprecatedActionsInAppClassTestApp.pm000644 000765 000024 00000001117 12106042701 025345 0ustar00johnstaff000000 000000 package DeprecatedActionsInAppClassTestApp; use strict; use warnings; use Catalyst; our $VERSION = '0.01'; __PACKAGE__->config( name => 'DeprecatedActionsInAppClassTestApp', root => '/some/dir' ); __PACKAGE__->log(DeprecatedActionsInAppClassTestApp::Log->new); __PACKAGE__->setup; sub foo : Local { my ($self, $c) = @_; $c->res->body('OK'); } package DeprecatedActionsInAppClassTestApp::Log; use strict; use warnings; use base qw/Catalyst::Log/; our $warnings; sub warn { my ($self, $warning) = @_; $warnings++ if $warning =~ /action methods .+ found defined/i; } 1; Catalyst-Runtime-5.90053/t/lib/DeprecatedTestApp/000755 000765 000024 00000000000 12255610005 021553 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/DeprecatedTestApp.pm000644 000765 000024 00000000314 12106042701 022104 0ustar00johnstaff000000 000000 package DeprecatedTestApp; use strict; use Catalyst qw/ Test::Deprecated /; our $VERSION = '0.01'; __PACKAGE__->config( name => 'DeprecatedTestApp', root => '/some/dir' ); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/Moo.pm000644 000765 000024 00000000244 12121675274 017315 0ustar00johnstaff000000 000000 package Moo; use Moose::Role; use namespace::autoclean; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90053/t/lib/NullPackage.pm000644 000765 000024 00000000466 12106042701 020741 0ustar00johnstaff000000 000000 package NullPackage; # Do nothing class, there should be no code or symbols defined here.. # Loading this works fine in 5.70, but a die was introduced in 5.80 which caused # it to fail. This has been changed to a warning to maintain back-compat. # See Catalyst::Utils::ensure_class_loaded() for more info. 1; Catalyst-Runtime-5.90053/t/lib/PluginTestApp/000755 000765 000024 00000000000 12255610005 020751 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/PluginTestApp.pm000644 000765 000024 00000001563 12156157140 021322 0ustar00johnstaff000000 000000 package PluginTestApp; use Test::More; use Catalyst ( 'Test::Plugin', '+TestApp::Plugin::FullyQualified', (eval { require MooseX::Role::Parameterized; 1 } ? ('+TestApp::Plugin::ParameterizedRole' => { method_name => 'affe' }) : ()), ); sub _test_plugins { my $c = shift; is_deeply [ $c->registered_plugins ], [ qw/Catalyst::Plugin::Test::Plugin Catalyst::Plugin::Unicode::Encoding TestApp::Plugin::FullyQualified/ ], '... and it should report the correct plugins'; ok $c->registered_plugins('Catalyst::Plugin::Test::Plugin'), '... or if we have a particular plugin'; ok $c->registered_plugins('Test::Plugin'), '... even if it is not fully qualified'; ok !$c->registered_plugins('No::Such::Plugin'), '... and it should return false if the plugin does not exist'; } __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/000755 000765 000024 00000000000 12255610005 020757 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ScriptTestApp.pm000644 000765 000024 00000000120 12106042701 021303 0ustar00johnstaff000000 000000 package ScriptTestApp; use Moose; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/000755 000765 000024 00000000000 12255610005 017572 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp.pm000644 000765 000024 00000006723 12217110344 020137 0ustar00johnstaff000000 000000 package TestApp; use strict; use Catalyst qw/ Test::MangleDollarUnderScore Test::Errors Test::Headers Test::Plugin Test::Inline +TestApp::Plugin::FullyQualified +TestApp::Plugin::AddDispatchTypes +TestApp::Role /; use Catalyst::Utils; use Class::Load 'try_load_class'; use Moose; use namespace::autoclean; # ----------- # t/aggregate/unit_core_ctx_attr.t pukes until lazy is true package Greeting; use Moose; sub hello_notlazy { 'hello there' } sub hello_lazy { 'hello there' } package TestApp; has 'my_greeting_obj_notlazy' => ( is => 'ro', isa => 'Greeting', default => sub { Greeting->new() }, handles => [ qw( hello_notlazy ) ], lazy => 0, ); has 'my_greeting_obj_lazy' => ( is => 'ro', isa => 'Greeting', default => sub { Greeting->new() }, handles => [ qw( hello_lazy ) ], lazy => 1, ); # ----------- our $VERSION = '0.01'; TestApp->config( name => 'TestApp', root => '/some/dir', use_request_uri_for_path => 1, 'Controller::Action::Action' => { action_args => { action_action_nine => { another_extra_arg => 13 } } }, encoding => 'UTF-8', abort_chain_on_error_fix => 1, ); # Test bug found when re-adjusting the metaclass compat code in Moose # in 292360. Test added to Moose in 4b760d6, but leave this attribute # above ->setup so we have some generated methods to be double sure. has an_attribute_before_we_change_base_classes => ( is => 'ro'); if ($::setup_leakchecker && try_load_class('CatalystX::LeakChecker')) { with 'CatalystX::LeakChecker'; has leaks => ( is => 'ro', default => sub { [] }, ); } sub found_leaks { my ($ctx, @leaks) = @_; push @{ $ctx->leaks }, @leaks; } sub count_leaks { my ($ctx) = @_; return scalar @{ $ctx->leaks }; } TestApp->setup; sub execute { my $c = shift; my $class = ref( $c->component( $_[0] ) ) || $_[0]; my $action = $_[1]->reverse; my $method; if ( $action =~ /->(\w+)$/ ) { $method = $1; } elsif ( $action =~ /\/(\w+)$/ ) { $method = $1; } elsif ( $action =~ /^(\w+)$/ ) { $method = $action; } if ( $class && $method && $method !~ /^_/ ) { my $executed = sprintf( "%s->%s", $class, $method ); my @executed = $c->response->headers->header('X-Catalyst-Executed'); push @executed, $executed; $c->response->headers->header( 'X-Catalyst-Executed' => join ', ', @executed ); } no warnings 'recursion'; return $c->SUPER::execute(@_); } # Replace the very large HTML error page with # useful info if something crashes during a test sub finalize_error { my $c = shift; $c->next::method(@_); $c->res->status(500); $c->res->body( 'FATAL ERROR: ' . join( ', ', @{ $c->error } ) ); } { no warnings 'redefine'; sub Catalyst::Log::error { } } # Pretend to be Plugin::Session and hook finalize_headers to send a header sub finalize_headers { my $c = shift; $c->res->header('X-Test-Header', 'valid'); my $call_count = $c->stash->{finalize_headers_call_count} || 0; $call_count++; $c->stash(finalize_headers_call_count => $call_count); $c->res->header('X-Test-Header-Call-Count' => $call_count); return $c->maybe::next::method(@_); } # Make sure we can load Inline plugins. package Catalyst::Plugin::Test::Inline; use strict; use base qw/Class::Data::Inheritable/; 1; Catalyst-Runtime-5.90053/t/lib/TestApp2/000755 000765 000024 00000000000 12255610005 017654 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp2.pm000644 000765 000024 00000000466 12156157140 020226 0ustar00johnstaff000000 000000 package TestApp2; use strict; use warnings; use base qw/Catalyst/; use Catalyst qw/Params::Nested/; __PACKAGE__->config( 'name' => 'TestApp2', encoding => 'UTF-8', ); __PACKAGE__->setup; sub handle_unicode_encoding_exception { my ( $self, $param_value, $error_msg ) = @_; return $param_value; } 1; Catalyst-Runtime-5.90053/t/lib/TestAppBadlyImmutable.pm000644 000765 000024 00000000426 12121675274 022761 0ustar00johnstaff000000 000000 package TestAppBadlyImmutable; use Catalyst qw/+TestPluginWithConstructor/; use base qw/Class::Accessor Catalyst/; use Test::More; __PACKAGE__->setup; __PACKAGE__->meta->make_immutable( inline_constructor => 0 ); ok __PACKAGE__->meta->is_immutable, 'Am now immutable'; 1; Catalyst-Runtime-5.90053/t/lib/TestAppChainedAbsolutePathPart/000755 000765 000024 00000000000 12255610005 024211 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppChainedAbsolutePathPart.pm000644 000765 000024 00000000513 12106042701 024543 0ustar00johnstaff000000 000000 package TestAppChainedAbsolutePathPart; use strict; use Catalyst qw/ Test::Errors Test::Headers /; use Catalyst::Utils; our $VERSION = '0.01'; TestAppChainedAbsolutePathPart ->config( name => 'TestAppChainedAbsolutePathPart', root => '/some/dir' ); TestAppChainedAbsolutePathPart->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppChainedRecursive/000755 000765 000024 00000000000 12255610005 022736 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppChainedRecursive.pm000644 000765 000024 00000000435 12106042701 023273 0ustar00johnstaff000000 000000 package TestAppChainedRecursive; use strict; use Catalyst qw/ Test::Errors Test::Headers /; use Catalyst::Utils; our $VERSION = '0.01'; TestAppChainedRecursive->config( name => 'TestAppChainedRecursive', root => '/some/dir' ); TestAppChainedRecursive->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppClassExceptionSimpleTest.pm000644 000765 000024 00000000616 12106042701 025007 0ustar00johnstaff000000 000000 package TestAppClassExceptionSimpleTest::Exception; use strict; use warnings; sub throw {} ######### package TestAppClassExceptionSimpleTest; use strict; use warnings; use Catalyst::Utils; #< some of the scripts use Catalyst::Utils before MyApp.pm BEGIN { $Catalyst::Exception::CATALYST_EXCEPTION_CLASS = 'TestAppClassExceptionSimpleTest::Exception'; } use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppDoubleAutoBug/000755 000765 000024 00000000000 12255610005 022214 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppDoubleAutoBug.pm000644 000765 000024 00000002025 12156157140 022557 0ustar00johnstaff000000 000000 use strict; use warnings; package TestAppDoubleAutoBug; use TestLogger; use Catalyst qw/ Test::Errors Test::Headers Test::Plugin /; our $VERSION = '0.01'; __PACKAGE__->config( name => 'TestAppDoubleAutoBug', root => '/some/dir' ); __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; sub execute { my $c = shift; my $class = ref( $c->component( $_[0] ) ) || $_[0]; my $action = $_[1]->reverse(); my $method; if ( $action =~ /->(\w+)$/ ) { $method = $1; } elsif ( $action =~ /\/(\w+)$/ ) { $method = $1; } elsif ( $action =~ /^(\w+)$/ ) { $method = $action; } if ( $class && $method && $method !~ /^_/ ) { my $executed = sprintf( "%s->%s", $class, $method ); my @executed = $c->response->headers->header('X-Catalyst-Executed'); push @executed, $executed; $c->response->headers->header( 'X-Catalyst-Executed' => join ', ', @executed ); } return $c->SUPER::execute(@_); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncoding/000755 000765 000024 00000000000 12255610005 021241 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncoding.pm000644 000765 000024 00000000234 12106042701 021573 0ustar00johnstaff000000 000000 package TestAppEncoding; use strict; use warnings; use base qw/Catalyst/; use Catalyst; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInApp/000755 000765 000024 00000000000 12255610005 022645 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInApp.pm000644 000765 000024 00000000233 12156703543 023213 0ustar00johnstaff000000 000000 package TestAppEncodingSetInApp; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( encoding => 'UTF-8', ); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInConfig/000755 000765 000024 00000000000 12255610005 023332 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInConfig.pm000644 000765 000024 00000000175 12156703543 023705 0ustar00johnstaff000000 000000 package TestAppEncodingSetInConfig; use Moose; use Catalyst qw/ConfigLoader/; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/000755 000765 000024 00000000000 12255610005 022067 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault.pm000644 000765 000024 00000000222 12156157140 022427 0ustar00johnstaff000000 000000 package TestAppIndexDefault; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppMatchSingleArg/000755 000765 000024 00000000000 12255610005 022343 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppMatchSingleArg.pm000644 000765 000024 00000000224 12156157140 022705 0ustar00johnstaff000000 000000 package TestAppMatchSingleArg; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppMetaCompat/000755 000765 000024 00000000000 12255610005 021545 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppMetaCompat.pm000644 000765 000024 00000000166 12106042701 022103 0ustar00johnstaff000000 000000 package TestAppMetaCompat; use base qw/Catalyst/; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppNonMooseController/000755 000765 000024 00000000000 12255610005 023314 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppNonMooseController.pm000644 000765 000024 00000000142 12106042701 023644 0ustar00johnstaff000000 000000 package TestAppNonMooseController; use base qw/Catalyst/; use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppOnDemand/000755 000765 000024 00000000000 12255610005 021200 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppOnDemand.pm000644 000765 000024 00000000440 12106042701 021531 0ustar00johnstaff000000 000000 package TestAppOnDemand; use strict; use Catalyst qw/ Test::Errors Test::Headers /; use Catalyst::Utils; our $VERSION = '0.01'; __PACKAGE__->config( name => __PACKAGE__, root => '/some/dir', parse_on_demand => 1, ); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppOneView/000755 000765 000024 00000000000 12255610005 021067 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppOneView.pm000644 000765 000024 00000000215 12156157140 021431 0ustar00johnstaff000000 000000 package TestAppOneView; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppPathBug.pm000644 000765 000024 00000000677 12106042701 021412 0ustar00johnstaff000000 000000 use strict; use warnings; package TestAppPathBug; use strict; use warnings; use Catalyst; our $VERSION = '0.01'; __PACKAGE__->config( name => 'TestAppPathBug', root => '/some/dir' ); __PACKAGE__->log(TestAppPathBug::Log->new); __PACKAGE__->setup; sub foo : Path { my ( $self, $c ) = @_; $c->res->body( 'This is the foo method.' ); } package TestAppPathBug::Log; use strict; use warnings; use base qw/Catalyst::Log/; sub warn {} 1; Catalyst-Runtime-5.90053/t/lib/TestAppPluginWithConstructor/000755 000765 000024 00000000000 12255610005 024053 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppPluginWithConstructor.pm000644 000765 000024 00000000720 12217110344 024407 0ustar00johnstaff000000 000000 # See t/plugin_new_method_backcompat.t package TestAppPluginWithConstructor; use Test::More; use Test::Fatal; use Catalyst qw/+TestPluginWithConstructor/; use Moose; extends qw/Catalyst/; __PACKAGE__->setup; our $MODIFIER_FIRED = 0; is exception { before 'dispatch' => sub { $MODIFIER_FIRED = 1 } }, undef, 'Can apply method modifier'; no Moose; our $IS_IMMUTABLE_YET = __PACKAGE__->meta->is_immutable; ok !$IS_IMMUTABLE_YET, 'I am not immutable yet'; 1; Catalyst-Runtime-5.90053/t/lib/TestAppShowInternalActions/000755 000765 000024 00000000000 12255610005 023451 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppShowInternalActions.pm000644 000765 000024 00000000653 12106042701 024010 0ustar00johnstaff000000 000000 package TestAppShowInternalActions; use Moose; use namespace::autoclean; use Catalyst::Runtime 5.80; use Catalyst qw/ -Debug /; # Debug must remain on for # t/live_show_internal_actions_warnings.t extends 'Catalyst'; __PACKAGE__->config( name => 'TestAppShowInternalActions', disable_component_resolution_regex_fallback => 1, show_internal_actions => 1, ); __PACKAGE__->setup(); 1; Catalyst-Runtime-5.90053/t/lib/TestAppStats/000755 000765 000024 00000000000 12255610005 020611 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppStats.pm000644 000765 000024 00000000652 12106042701 021147 0ustar00johnstaff000000 000000 use strict; use warnings; package TestAppStats; use Catalyst qw/ -Stats=1 /; our $VERSION = '0.01'; our @log_messages; __PACKAGE__->config( name => 'TestAppStats', root => '/some/dir' ); __PACKAGE__->log(TestAppStats::Log->new); __PACKAGE__->setup; package TestAppStats::Log; use base qw/Catalyst::Log/; sub info { push(@TestAppStats::log_messages, @_); } sub debug { push(@TestAppStats::log_messages, @_); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppToTestScripts.pm000644 000765 000024 00000000221 12106042701 022633 0ustar00johnstaff000000 000000 package TestAppToTestScripts; use strict; use warnings; use Carp; our @RUN_ARGS; sub run { @RUN_ARGS = @_; 1; # Does this work? } 1; Catalyst-Runtime-5.90053/t/lib/TestAppUnicode/000755 000765 000024 00000000000 12255610005 021101 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppUnicode.pm000644 000765 000024 00000000652 12157074540 021453 0ustar00johnstaff000000 000000 package TestAppUnicode; use strict; use warnings; use TestLogger; use base qw/Catalyst/; use Catalyst qw/Unicode::Encoding/; __PACKAGE__->config( 'name' => 'TestAppUnicode', $ENV{TESTAPP_ENCODING} ? ( encoding => $ENV{TESTAPP_ENCODING} ) : (), ); __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; sub handle_unicode_encoding_exception { my ( $self, $param_value, $error_msg ) = @_; return $param_value; } 1; Catalyst-Runtime-5.90053/t/lib/TestAppUnknownError.pm000644 000765 000024 00000000357 12106042701 022524 0ustar00johnstaff000000 000000 package TestApp; use strict; use warnings; use Catalyst::Runtime 5.70; use base qw/Catalyst/; use Catalyst; __PACKAGE__->setup(); sub _test { my $self = shift; $self->_method_which_does_not_exist; } __PACKAGE__->_test; 1; Catalyst-Runtime-5.90053/t/lib/TestAppViewWarnings/000755 000765 000024 00000000000 12255610005 022136 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppViewWarnings.pm000644 000765 000024 00000000622 12106042701 022471 0ustar00johnstaff000000 000000 use strict; use warnings; package TestAppViewWarnings; use Catalyst; our @log_messages; __PACKAGE__->config( name => 'TestAppWarnings', root => '/some/dir', default_view => "DoesNotExist" ); __PACKAGE__->log(TestAppViewWarnings::Log->new); __PACKAGE__->setup; package TestAppViewWarnings::Log; use base qw/Catalyst::Log/; sub warn { push(@TestAppViewWarnings::log_messages, @_[1..$#_]); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppWithMeta/000755 000765 000024 00000000000 12255610005 021235 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppWithMeta.pm000644 000765 000024 00000000231 12106042701 021564 0ustar00johnstaff000000 000000 package TestAppWithMeta; use strict; use warnings; use Catalyst; no warnings 'redefine'; sub meta {} use warnings 'redefine'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestAppWithoutUnicode/000755 000765 000024 00000000000 12255610005 022465 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppWithoutUnicode.pm000644 000765 000024 00000000351 12157074540 023033 0ustar00johnstaff000000 000000 package TestAppWithoutUnicode; use strict; use warnings; use TestLogger; use base qw/Catalyst/; use Catalyst qw//; __PACKAGE__->config('name' => 'TestAppWithoutUnicode'); __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation/000755 000765 000024 00000000000 12255610005 022665 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation.pm000644 000765 000024 00000000251 12236261623 023230 0ustar00johnstaff000000 000000 package TestContentNegotiation; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, ); __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/TestDataHandlers/000755 000765 000024 00000000000 12255610005 021404 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestDataHandlers.pm000644 000765 000024 00000000201 12236261623 021742 0ustar00johnstaff000000 000000 package TestDataHandlers; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' } ); __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/TestFromPSGI/000755 000765 000024 00000000000 12255610005 020440 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestFromPSGI.pm000644 000765 000024 00000000261 12236261623 021004 0ustar00johnstaff000000 000000 package TestFromPSGI; use Moose; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, use_hash_multivalue_in_request => 1, ); __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/TestLogger.pm000644 000765 000024 00000000342 12156157140 020634 0ustar00johnstaff000000 000000 package TestLogger; use strict; use warnings; our @LOGS; our @ELOGS; sub new { return bless {}, __PACKAGE__; } sub debug { shift; push(@LOGS, shift()); } sub warn { shift; push(@ELOGS, shift()); } 1; Catalyst-Runtime-5.90053/t/lib/TestMiddleware/000755 000765 000024 00000000000 12255610005 021127 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware.pm000644 000765 000024 00000001577 12236261623 021506 0ustar00johnstaff000000 000000 package TestMiddleware; use Moose; use Plack::Middleware::Static; use Plack::App::File; use Catalyst; extends 'Catalyst'; my $static = Plack::Middleware::Static->new( path => qr{^/static/}, root => TestMiddleware->path_to('share')); __PACKAGE__->config( 'Controller::Root', { namespace => '' }, 'psgi_middleware', [ 'Head', $static, 'Static', { path => qr{^/static2/}, root => TestMiddleware->path_to('share') }, 'Runtime', '+TestMiddleware::Custom', { path => qr{^/static3/}, root => TestMiddleware->path_to('share') }, sub { my $app = shift; return sub { my $env = shift; if($env->{PATH_INFO} =~m/forced/) { Plack::App::File->new(file=>TestMiddleware->path_to(qw/share static forced.txt/)) ->call($env); } else { return $app->($env); } }, }, ], ); __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/000755 000765 000024 00000000000 12255610005 023101 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig.pm000644 000765 000024 00000000373 12254331452 023447 0ustar00johnstaff000000 000000 package TestMiddlewareFromConfig; use Catalyst qw/ConfigLoader/; ## Proof this is good config ##__PACKAGE__->config( do TestMiddlewareFromConfig->path_to('testmiddlewarefromconfig.pl') ); __PACKAGE__->setup_middleware('Head'); __PACKAGE__->setup; Catalyst-Runtime-5.90053/t/lib/TestPluginWithConstructor.pm000644 000765 000024 00000000413 12106042701 023743 0ustar00johnstaff000000 000000 # See t/plugin_new_method_backcompat.t package Class::Accessor::Fast; use strict; use warnings; sub new { my $class = shift; return bless $_[0], $class; } package TestPluginWithConstructor; use strict; use warnings; use base qw/Class::Accessor::Fast/; 1; Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/Controller/000755 000765 000024 00000000000 12255610005 025224 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/Custom.pm000644 000765 000024 00000000164 12254157141 024720 0ustar00johnstaff000000 000000 package TestMiddlewareFromConfig::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/000755 000765 000024 00000000000 12255610005 024203 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/testmiddlewarefromconfig.pl000644 000765 000024 00000001441 12254331423 030530 0ustar00johnstaff000000 000000 use Plack::Middleware::Static; my $static = Plack::Middleware::Static->new( path => qr{^/static/}, root => TestMiddlewareFromConfig->path_to('share')); my $conf = +{ 'Controller::Root', { namespace => '' }, 'psgi_middleware', [ $static, 'Static', { path => qr{^/static2/}, root => TestMiddlewareFromConfig->path_to('share') }, 'Runtime', '+TestMiddleware::Custom', { path => qr{^/static3/}, root => TestMiddlewareFromConfig->path_to('share') }, sub { my $app = shift; return sub { my $env = shift; if($env->{PATH_INFO} =~m/forced/) { Plack::App::File->new(file=>TestMiddlewareFromConfig->path_to(qw/share static forced.txt/)) ->call($env); } else { return $app->($env); } }, }, ], }; Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static/000755 000765 000024 00000000000 12255610005 025472 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static2/000755 000765 000024 00000000000 12255610005 025554 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static3/000755 000765 000024 00000000000 12255610005 025555 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static3/message3.txt000644 000765 000024 00000000017 12236261623 030032 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static2/message2.txt000644 000765 000024 00000000017 12236261623 030030 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static/forced.txt000644 000765 000024 00000000017 12236261623 027502 0ustar00johnstaff000000 000000 forced message Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/share/static/message.txt000644 000765 000024 00000000017 12236261623 027664 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddlewareFromConfig/Controller/Root.pm000644 000765 000024 00000000404 12254157156 026517 0ustar00johnstaff000000 000000 package TestMiddlewareFromConfig::Controller::Root; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub default : Path { } sub welcome : Path(welcome) { pop->res->body('Welcome to Catalyst'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestMiddleware/Controller/000755 000765 000024 00000000000 12255610005 023252 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware/Custom.pm000644 000765 000024 00000000152 12236261623 022744 0ustar00johnstaff000000 000000 package TestMiddleware::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/000755 000765 000024 00000000000 12255610005 022231 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static/000755 000765 000024 00000000000 12255610005 023520 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static2/000755 000765 000024 00000000000 12255610005 023602 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static3/000755 000765 000024 00000000000 12255610005 023603 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static3/message3.txt000644 000765 000024 00000000017 12236261623 026060 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static2/message2.txt000644 000765 000024 00000000017 12236261623 026056 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static/forced.txt000644 000765 000024 00000000017 12236261623 025530 0ustar00johnstaff000000 000000 forced message Catalyst-Runtime-5.90053/t/lib/TestMiddleware/share/static/message.txt000644 000765 000024 00000000017 12236261623 025712 0ustar00johnstaff000000 000000 static message Catalyst-Runtime-5.90053/t/lib/TestMiddleware/Controller/Root.pm000644 000765 000024 00000000372 12236261623 024544 0ustar00johnstaff000000 000000 package TestMiddleware::Controller::Root; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub default : Path { } sub welcome : Path(welcome) { pop->res->body('Welcome to Catalyst'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestFromPSGI/Controller/000755 000765 000024 00000000000 12255610005 022563 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestFromPSGI/Controller/Root.pm000644 000765 000024 00000002215 12236261623 024053 0ustar00johnstaff000000 000000 package TestFromPSGI::Controller::Root; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub test_psgi_keys :Local { my ($self, $c) = @_; $c->res->body('ok'); } sub from_psgi_array : Local { my ($self, $c) = @_; my $res = sub { my ($env) = @_; return [200, ['Content-Type'=>'text/plain'], [qw/hello world today/]]; }->($c->req->env); $c->res->from_psgi_response($res); } sub from_psgi_code : Local { my ($self, $c) = @_; my $res = sub { my ($env) = @_; return sub { my $responder = shift; return $responder->([200, ['Content-Type'=>'text/plain'], [qw/hello world today2/]]); }; }->($c->req->env); $c->res->from_psgi_response($res); } sub from_psgi_code_itr : Local { my ($self, $c) = @_; my $res = sub { my ($env) = @_; return sub { my $responder = shift; my $writer = $responder->([200, ['Content-Type'=>'text/plain']]); $writer->write('hello'); $writer->write('world'); $writer->write('today3'); $writer->close; }; }->($c->req->env); $c->res->from_psgi_response($res); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestDataHandlers/Controller/000755 000765 000024 00000000000 12255610005 023527 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestDataHandlers/Controller/Root.pm000644 000765 000024 00000000452 12236261623 025020 0ustar00johnstaff000000 000000 package TestDataHandlers::Controller::Root; use base 'Catalyst::Controller'; sub test_json :Local { my ($self, $c) = @_; $c->res->body($c->req->body_data->{message}); } sub test_nested_for :Local { my ($self, $c) = @_; $c->res->body($c->req->body_data->{nested}->{value}); } 1; Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation/Controller/000755 000765 000024 00000000000 12255610005 025010 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation/share/000755 000765 000024 00000000000 12255610005 023767 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation/share/file.txt000644 000765 000024 00000003270 12236261623 025460 0ustar00johnstaff000000 000000 package TestContentNegotiation::Controller::Root; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub start :Chained(/) PathPrefix CaptureArgs(0) { } sub is_json : Chained('start') PathPart('') Consumes('application/json') Args(0) { pop->res->body('is_json') } sub is_urlencoded : Chained('start') PathPart('') Consumes('application/x-www-form-urlencoded') Args(0) { pop->res->body('is_urlencoded') } sub is_multipart : Chained('start') PathPart('') Consumes('multipart/form-data') Args(0) { pop->res->body('is_multipart') } sub under :Chained('start') CaptureArgs(0) { } sub is_json_under : Chained('under') PathPart('') Consumes(JSON) Args(0) { pop->res->body('is_json') } sub is_urlencoded_under : Chained('under') PathPart('') Consumes(UrlEncoded) Args(0) { pop->res->body('is_urlencoded') } sub is_multipart_under : Chained('under') PathPart('') Consumes(Multipart) Args(0) { pop->res->body('is_multipart') } ## Or allow more than one type sub multi :Chained('start') CaptureArgs(0) { } sub is_more_than_one_1 : Chained('multi') PathPart('') : Consumes('application/x-www-form-urlencoded') : Consumes('multipart/form-data') : Args(0) { pop->res->body('formdata1'); } sub is_more_than_one_2 : Chained('multi') PathPart('') : Consumes('HTMLForm') : Args(0) { pop->res->body('formdata2'); } sub is_more_than_one_3 : Chained('multi') PathPart('') : Consumes('application/x-www-form-urlencoded,multipart/form-data') : Args(0) { pop->res->body('formdata3'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestContentNegotiation/Controller/Root.pm000644 000765 000024 00000003247 12236261623 026306 0ustar00johnstaff000000 000000 package TestContentNegotiation::Controller::Root; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub start :Chained(/) PathPrefix CaptureArgs(0) { } sub is_json : Chained('start') PathPart('') Consumes('application/json') Args(0) { pop->res->body('is_json1') } sub is_urlencoded : Chained('start') PathPart('') Consumes('application/x-www-form-urlencoded') Args(0) { pop->res->body('is_urlencoded1') } sub is_multipart : Chained('start') PathPart('') Consumes('multipart/form-data') Args(0) { pop->res->body('is_multipart1') } sub under :Chained('start') CaptureArgs(0) { } sub is_json_under : Chained('under') PathPart('') Consumes(JSON) Args(0) { pop->res->body('is_json2') } sub is_urlencoded_under : Chained('under') PathPart('') Consumes(UrlEncoded) Args(0) { pop->res->body('is_urlencoded2') } sub is_multipart_under : Chained('under') PathPart('') Consumes(Multipart) Args(0) { pop->res->body('is_multipart2') } ## Or allow more than one type sub multi :Chained('start') PathPart('') CaptureArgs(0) { } sub is_more_than_one_1 : Chained('multi') : Consumes('application/x-www-form-urlencoded') : Consumes('multipart/form-data') : Args(0) { pop->res->body('formdata1'); } sub is_more_than_one_2 : Chained('multi') : Consumes('HTMLForm') : Args(0) { pop->res->body('formdata2'); } sub is_more_than_one_3 : Chained('multi') : Consumes('application/x-www-form-urlencoded,multipart/form-data') : Args(0) { pop->res->body('formdata3'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestAppWithoutUnicode/Controller/000755 000765 000024 00000000000 12255610005 024610 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppWithoutUnicode/Controller/Root.pm000644 000765 000024 00000000610 12156157140 026074 0ustar00johnstaff000000 000000 package TestAppWithoutUnicode::Controller::Root; use Moose; BEGIN { extends 'Catalyst::Controller' } use Encode qw(encode_utf8 decode_utf8); __PACKAGE__->config( namespace => q{} ); sub default : Private { my ( $self, $c ) = @_; my $param = decode_utf8($c->request->parameters->{'myparam'}); $c->response->body( encode_utf8($param) ); } __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/TestAppWithMeta/Controller/000755 000765 000024 00000000000 12255610005 023360 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppWithMeta/Controller/Root.pm000644 000765 000024 00000000610 12106042701 024633 0ustar00johnstaff000000 000000 package TestAppWithMeta::Controller::Root; use base qw/Catalyst::Controller/; # N.B. Do not convert to Moose, so we do not # have a metaclass instance! __PACKAGE__->config( namespace => '' ); no warnings 'redefine'; sub meta { 'fnar' } use warnings 'redefine'; sub default : Private { my ($self, $c) = @_; $c->res->body($self->meta); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppViewWarnings/Controller/000755 000765 000024 00000000000 12255610005 024261 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppViewWarnings/Controller/Root.pm000644 000765 000024 00000000551 12106042701 025540 0ustar00johnstaff000000 000000 package TestAppViewWarnings::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; # Return log messages from previous request sub index :Path Args() {} sub end : Action { my ($self, $c) = @_; $c->view; # Cause view lookup and ergo warning we are testing. $c->res->body('foo'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppUnicode/Controller/000755 000765 000024 00000000000 12255610005 023224 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppUnicode/Controller/Root.pm000644 000765 000024 00000003601 12156157140 024513 0ustar00johnstaff000000 000000 package TestAppUnicode::Controller::Root; use strict; use warnings; use utf8; __PACKAGE__->config(namespace => q{}); use base 'Catalyst::Controller'; sub main :Path('') { my ($self, $ctx, $charset) = @_; my $content_type = 'text/html'; if ($ctx->stash->{charset}) { $content_type .= ";charset=" . $ctx->stash->{charset}; } $ctx->res->body('

It works

'); $ctx->res->content_type($content_type); } sub unicode_no_enc :Local { my ($self, $c) = @_; my $data = "ほげ"; # hoge! utf8::encode($data); $c->response->body($data); $c->res->content_type('text/plain'); $c->encoding(undef); } sub unicode :Local { my ($self, $c) = @_; my $data = "ほげ"; # hoge! $c->response->body($data); # should be decoded $c->res->content_type('text/plain'); } sub not_unicode :Local { my ($self, $c) = @_; my $data = "\x{1234}\x{5678}"; utf8::encode($data); # DO NOT WANT unicode $c->response->body($data); # just some octets $c->res->content_type('text/plain'); $c->encoding(undef); } sub latin1 :Local { my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->response->body('LATIN SMALL LETTER E WITH ACUTE: é'); } sub file :Local { my ($self, $c) = @_; close *STDERR; # i am evil. $c->response->body($main::TEST_FILE); # filehandle from test file } sub capture : Chained('/') CaptureArgs(1) {} sub decode_capture : Chained('capture') PathPart('') Args(0) { my ( $self, $c, $cap_arg ) = @_; $c->forward('main'); } sub capture_charset : Chained('/') Args(1) { my ( $self, $c, $cap_arg ) = @_; $c->stash(charset => $cap_arg); $c->forward('main'); } sub shift_jis :Local { my ($self, $c) = @_; my $data = "ほげ"; # hoge! $c->response->body($data); # should be decoded $c->res->content_type('text/plain; charset=Shift_JIS'); $c->encoding("Shift_JIS"); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppStats/Controller/000755 000765 000024 00000000000 12255610005 022734 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppStats/Controller/Root.pm000644 000765 000024 00000000563 12106042701 024216 0ustar00johnstaff000000 000000 package TestAppStats::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; # Return log messages from previous request sub default : Private { my ( $self, $c ) = @_; $c->stats->profile("test"); $c->res->body(join("\n", @TestAppStats::log_messages)); @TestAppStats::log_messages = (); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppShowInternalActions/Controller/000755 000765 000024 00000000000 12255610005 025574 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppShowInternalActions/Controller/Root.pm000644 000765 000024 00000000514 12106042701 027052 0ustar00johnstaff000000 000000 package TestAppShowInternalActions::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } __PACKAGE__->config(namespace => ''); sub index :Path :Args(0) { my ( $self, $c ) = @_; $c->response->body( 'hello world' ); } sub end : Action {} __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/TestAppPluginWithConstructor/Controller/000755 000765 000024 00000000000 12255610005 026176 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppPluginWithConstructor/Controller/Root.pm000644 000765 000024 00000000316 12106042701 027454 0ustar00johnstaff000000 000000 package TestAppPluginWithConstructor::Controller::Root; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub foo : Local { my ($self, $c) = @_; $c->res->body('foo'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppOneView/Controller/000755 000765 000024 00000000000 12255610005 023212 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppOneView/View/000755 000765 000024 00000000000 12255610005 022001 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppOneView/View/Dummy.pm000644 000765 000024 00000000234 12106042701 023426 0ustar00johnstaff000000 000000 package TestAppOneView::View::Dummy; use base 'Catalyst::View'; sub COMPONENT { bless {}, 'AClass' } package AClass; use base 'Catalyst::View'; 1; Catalyst-Runtime-5.90053/t/lib/TestAppOneView/Controller/Root.pm000644 000765 000024 00000001134 12106042701 024467 0ustar00johnstaff000000 000000 package TestAppOneView::Controller::Root; use base 'Catalyst::Controller'; use Scalar::Util (); __PACKAGE__->config->{namespace} = ''; sub view_no_args : Local { my ( $self, $c ) = @_; my $v = $c->view; $c->res->body(Scalar::Util::blessed($v)); } sub view_by_name : Local { my ( $self, $c ) = @_; my $v = $c->view($c->req->param('view')); $c->res->body(Scalar::Util::blessed($v)); } sub view_by_regex : Local { my ( $self, $c ) = @_; my $v_name = $c->req->param('view'); my ($v) = $c->view(qr/$v_name/); $c->res->body(Scalar::Util::blessed($v)); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppOnDemand/Controller/000755 000765 000024 00000000000 12255610005 023323 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppOnDemand/Controller/Body.pm000644 000765 000024 00000001374 12106042701 024560 0ustar00johnstaff000000 000000 package TestAppOnDemand::Controller::Body; use strict; use base 'Catalyst::Controller'; use Data::Dump (); sub body_params : Local { my ( $self, $c ) = @_; $c->res->body( Data::Dump::dump( $c->req->body_parameters ) ); } sub query_params : Local { my ( $self, $c ) = @_; $c->res->body( Data::Dump::dump( $c->req->query_parameters ) ); } sub params : Local { my ( $self, $c ) = @_; $c->res->body( Data::Dump::dump( $c->req->parameters ) ); } sub read : Local { my ( $self, $c ) = @_; # read some data my @chunks; while ( my $data = $c->read( 10_000 ) ) { push @chunks, $data; } $c->res->content_type( 'text/plain'); $c->res->body( join ( '|', map { length $_ } @chunks ) ); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppNonMooseController/Controller/000755 000765 000024 00000000000 12255610005 025437 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppNonMooseController/ControllerBase.pm000644 000765 000024 00000000133 12106042701 026562 0ustar00johnstaff000000 000000 package TestAppNonMooseController::ControllerBase; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90053/t/lib/TestAppNonMooseController/Controller/Foo.pm000644 000765 000024 00000000161 12106042701 026513 0ustar00johnstaff000000 000000 package TestAppNonMooseController::Controller::Foo; use base qw/TestAppNonMooseController::ControllerBase/; 1; Catalyst-Runtime-5.90053/t/lib/TestAppMetaCompat/Controller/000755 000765 000024 00000000000 12255610005 023670 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppMetaCompat/Controller/Base.pm000644 000765 000024 00000000141 12106042701 025071 0ustar00johnstaff000000 000000 package TestAppMetaCompat::Controller::Base; use strict; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90053/t/lib/TestAppMetaCompat/Controller/Books.pm000644 000765 000024 00000000206 12106042701 025276 0ustar00johnstaff000000 000000 package TestAppMetaCompat::Controller::Books; use strict; use base qw/TestAppMetaCompat::Controller::Base/; sub edit : Local {} 1; Catalyst-Runtime-5.90053/t/lib/TestAppMatchSingleArg/Controller/000755 000765 000024 00000000000 12255610005 024466 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppMatchSingleArg/Controller/Root.pm000644 000765 000024 00000000650 12106042701 025745 0ustar00johnstaff000000 000000 package TestAppMatchSingleArg::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub match_single : Path Args(1) { my ($self, $c) = @_; $c->res->body('Path Args(1)'); } sub match_other : Path { my ($self, $c) = @_; $c->res->body('Path'); } sub match_two : Path Args(2) { my ($self, $c) = @_; $c->res->body('Path Args(2)'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/Controller/000755 000765 000024 00000000000 12255610005 024212 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/Controller/Default.pm000644 000765 000024 00000000450 12106042701 026130 0ustar00johnstaff000000 000000 package TestAppIndexDefault::Controller::Default; use base 'Catalyst::Controller'; sub default : Private { my ($self, $c) = @_; $c->res->body('default_default'); } sub path_one_arg : Path('/default/') Args(1) { my ($self, $c) = @_; $c->res->body('default_path_one_arg'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/Controller/IndexChained.pm000644 000765 000024 00000000437 12106042701 027074 0ustar00johnstaff000000 000000 package TestAppIndexDefault::Controller::IndexChained; use base 'Catalyst::Controller'; sub index : Chained('/') PathPart('indexchained') CaptureArgs(0) {} sub index_endpoint : Chained('index') PathPart('') Args(0) { my ($self, $c) = @_; $c->res->body('index_chained'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/Controller/IndexPrivate.pm000644 000765 000024 00000000263 12106042701 027150 0ustar00johnstaff000000 000000 package TestAppIndexDefault::Controller::IndexPrivate; use base 'Catalyst::Controller'; sub index : Private { my ($self, $c) = @_; $c->res->body('index_private'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppIndexDefault/Controller/Root.pm000644 000765 000024 00000000465 12106042701 025475 0ustar00johnstaff000000 000000 package TestAppIndexDefault::Controller::Root; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub default : Private { my ($self, $c) = @_; $c->res->body('default'); } sub path_one_arg : Path('/') Args(1) { my ($self, $c) = @_; $c->res->body('path_one_arg'); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInConfig/Controller/000755 000765 000024 00000000000 12255610005 025455 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInConfig/testappencodingsetinconfig.json000644 000765 000024 00000000034 12156703543 031654 0ustar00johnstaff000000 000000 { "encoding": "UTF-8" } Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInConfig/Controller/Root.pm000644 000765 000024 00000000373 12156703543 026753 0ustar00johnstaff000000 000000 package TestAppEncodingSetInConfig::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller'; } __PACKAGE__->config(namespace => ''); sub default: Local{ my ( $self, $c ) = @_; $c->res->body(''); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInApp/Controller/000755 000765 000024 00000000000 12255610005 024770 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncodingSetInApp/Controller/Root.pm000644 000765 000024 00000000370 12156703543 026263 0ustar00johnstaff000000 000000 package TestAppEncodingSetInApp::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller'; } __PACKAGE__->config(namespace => ''); sub default: Local{ my ( $self, $c ) = @_; $c->res->body(''); } 1; Catalyst-Runtime-5.90053/t/lib/TestAppEncoding/Controller/000755 000765 000024 00000000000 12255610005 023364 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppEncoding/Controller/Root.pm000644 000765 000024 00000002316 12121675274 024662 0ustar00johnstaff000000 000000 package TestAppEncoding::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; use Test::More; __PACKAGE__->config->{namespace} = ''; sub binary : Local { my ($self, $c) = @_; $c->res->body(do { open(my $fh, '<', $c->path_to('..', '..', 'catalyst_130pix.gif')) or die $!; binmode($fh); local $/ = undef; <$fh>; }); } sub binary_utf8 : Local { my ($self, $c) = @_; $c->forward('binary'); my $str = $c->res->body; utf8::upgrade($str); ok utf8::is_utf8($str), 'Body is variable width encoded string'; $c->res->body($str); } # called by t/aggregate/catalyst_test_utf8.t sub utf8_non_ascii_content : Local { use utf8; my ($self, $c) = @_; my $str = 'ʇsʎlɐʇɐɔ'; # 'catalyst' flipped at http://www.revfad.com/flip.html ok utf8::is_utf8($str), '$str is in UTF8 internally'; # encode $str into a sequence of octets and turn off the UTF-8 flag, so that # we don't get the 'Wide character in syswrite' error in Catalyst::Engine utf8::encode($str); ok !utf8::is_utf8($str), '$str is a sequence of octets (byte string)'; $c->res->body($str); } sub end : Private { my ($self,$c) = @_; } 1; Catalyst-Runtime-5.90053/t/lib/TestAppDoubleAutoBug/Controller/000755 000765 000024 00000000000 12255610005 024337 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppDoubleAutoBug/Controller/Root.pm000644 000765 000024 00000000615 12106042701 025617 0ustar00johnstaff000000 000000 package TestAppDoubleAutoBug::Controller::Root; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub auto : Private { my ( $self, $c ) = @_; ++$c->stash->{auto_count}; return 1; } sub default : Private { my ( $self, $c ) = @_; $c->res->body( sprintf 'default, auto=%d', $c->stash->{auto_count} ); } sub end : Private { my ($self,$c) = @_; } 1; Catalyst-Runtime-5.90053/t/lib/TestAppChainedRecursive/Controller/000755 000765 000024 00000000000 12255610005 025061 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppChainedRecursive/Controller/Foo.pm000644 000765 000024 00000000316 12106042701 026137 0ustar00johnstaff000000 000000 package TestAppChainedRecursive::Controller::Foo; use strict; use warnings; use base qw/Catalyst::Controller/; sub foo : Chained('bar') CaptureArgs(1) { } sub bar : Chained('foo') CaptureArgs(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestAppChainedAbsolutePathPart/Controller/000755 000765 000024 00000000000 12255610005 026334 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestAppChainedAbsolutePathPart/Controller/Foo.pm000644 000765 000024 00000000260 12106042701 027410 0ustar00johnstaff000000 000000 package TestAppChainedAbsolutePathPart::Controller::Foo; use strict; use warnings; use base qw/Catalyst::Controller/; sub foo : Chained PathPart('/foo/bar') Args(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp2/Controller/000755 000765 000024 00000000000 12255610005 021777 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp2/Controller/Root.pm000644 000765 000024 00000000445 12156157140 023271 0ustar00johnstaff000000 000000 package TestApp2::Controller::Root; use strict; use warnings; use utf8; __PACKAGE__->config(namespace => q{}); use base 'Catalyst::Controller'; # your actions replace this one sub main :Path('') { $_[1]->res->body('

It works

'); $_[1]->res->content_type('text/html'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Action/000755 000765 000024 00000000000 12255610005 021007 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/ActionRole/000755 000765 000024 00000000000 12255610005 021631 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/000755 000765 000024 00000000000 12255610005 021715 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/DispatchType/000755 000765 000024 00000000000 12255610005 022173 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Model/000755 000765 000024 00000000000 12255610005 020632 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Model.pm000644 000765 000024 00000000531 12106042701 021164 0ustar00johnstaff000000 000000 package TestApp::Model; use Moose; use namespace::clean -except => 'meta'; extends 'Catalyst::Model'; # Test a closure here, r10394 made this blow up when we clone the config down # onto the subclass.. __PACKAGE__->config( escape_flags => { 'js' => sub { ${ $_[0] } =~ s/\'/\\\'/g; }, } ); __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Plugin/000755 000765 000024 00000000000 12255610005 021030 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/RequestBaseBug.pm000644 000765 000024 00000000277 12106042701 023014 0ustar00johnstaff000000 000000 package TestApp::RequestBaseBug; use base 'Catalyst::Request'; sub uri { my $self = shift; # this goes into infinite mutual recursion $self->base; $self->SUPER::uri(@_) } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Role.pm000644 000765 000024 00000000507 12106042701 021030 0ustar00johnstaff000000 000000 package TestApp::Role; use Moose::Role; use namespace::clean -except => 'meta'; requires 'fully_qualified'; # Comes from TestApp::Plugin::FullyQualified our $SETUP_FINALIZE = 0; our $SETUP_DISPATCHER = 0; before 'setup_finalize' => sub { $SETUP_FINALIZE++ }; before 'setup_dispatcher' => sub { $SETUP_DISPATCHER++ }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/000755 000765 000024 00000000000 12255610005 020504 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/000755 000765 000024 00000000000 12255610005 021411 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump.pm000644 000765 000024 00000003211 12236261623 021753 0ustar00johnstaff000000 000000 package TestApp::View::Dump; use strict; use base 'Catalyst::View'; use Data::Dumper (); use Scalar::Util qw(blessed weaken); sub dump { my ( $self, $reference, $purity ) = @_; return unless $reference; $purity = defined $purity ? $purity : 1; my $dumper = Data::Dumper->new( [$reference] ); $dumper->Indent(1); $dumper->Purity($purity); $dumper->Useqq(0); $dumper->Deepcopy(1); $dumper->Quotekeys(1); $dumper->Terse(1); local $SIG{ __WARN__ } = sub { warn unless $_[ 0 ] =~ m{dummy} }; return $dumper->Dump; } sub process { my ( $self, $c, $reference, $purity ) = @_; # Force processing of on-demand data $c->prepare_body; # Remove body from reference if needed $reference->{__body_type} = blessed $reference->body if (blessed $reference->{_body}); my $body = delete $reference->{_body}; # Remove context from reference if needed my $context = delete $reference->{_context}; my $env = delete $reference->{env}; if (my $log = $reference->{_log}) { $log->clear_psgi if ($log->can('psgienv')); } if ( my $output = $self->dump( $reference, $purity ) ) { $c->res->headers->content_type('text/plain'); $c->res->output($output); if ($context) { # Repair context $reference->{_context} = $context; weaken( $reference->{_context} ); } if ($body) { # Repair body delete $reference->{__body_type}; $reference->{_body} = $body; } if($env) { $reference->{env} = $env } return 1; } return 0; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/Action.pm000644 000765 000024 00000000273 12106042701 023163 0ustar00johnstaff000000 000000 package TestApp::View::Dump::Action; use strict; use base qw[TestApp::View::Dump]; sub process { my ( $self, $c ) = @_; return $self->SUPER::process( $c, $c->action, 0 ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/Body.pm000644 000765 000024 00000000340 12106042701 022636 0ustar00johnstaff000000 000000 package TestApp::View::Dump::Body; use strict; use base qw[TestApp::View::Dump]; sub process { my ( $self, $c ) = @_; return $self->SUPER::process( $c, $c->request->{_body} ); # FIXME, accessor doesn't work? } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/Env.pm000644 000765 000024 00000001012 12121675274 022504 0ustar00johnstaff000000 000000 package TestApp::View::Dump::Env; use strict; use base qw[TestApp::View::Dump]; sub process { my ( $self, $c ) = @_; my $env = $c->stash->{env}; return $self->SUPER::process($c, { map { ($_ => $env->{$_}) } grep { $_ ne 'psgi.input' } keys %{ $env }, }); } ## We override Data::Dumper here since its not reliably outputting ## something that is roundtrip-able. sub dump { my ( $self, $reference ) = @_; use Data::Dump (); return Data::Dump::dump($reference); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/Request.pm000644 000765 000024 00000000340 12236261623 023403 0ustar00johnstaff000000 000000 package TestApp::View::Dump::Request; use strict; use base qw[TestApp::View::Dump]; sub process { my ( $self, $c ) = @_; my $r = $c->request; #local $r->{env}; return $self->SUPER::process( $c, $r ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/View/Dump/Response.pm000644 000765 000024 00000000402 12121675274 023554 0ustar00johnstaff000000 000000 package TestApp::View::Dump::Response; use strict; use base qw[TestApp::View::Dump]; sub process { my ( $self, $c ) = @_; my $r = $c->response; local $r->{_writer}; local $r->{_reponse_cb}; return $self->SUPER::process( $c, $r ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Plugin/AddDispatchTypes.pm000644 000765 000024 00000001241 12106042701 024556 0ustar00johnstaff000000 000000 package TestApp::Plugin::AddDispatchTypes; use strict; use warnings; use MRO::Compat; sub setup_dispatcher { my $class = shift; ### Load custom DispatchTypes, as done by Catalyst::Plugin::Server # There should be a waaay less ugly method for doing this, # FIXME in 5.9 $class->next::method( @_ ); $class->dispatcher->preload_dispatch_types( @{$class->dispatcher->preload_dispatch_types}, qw/ +TestApp::DispatchType::CustomPreLoad / ); $class->dispatcher->postload_dispatch_types( @{$class->dispatcher->postload_dispatch_types}, qw/ +TestApp::DispatchType::CustomPostLoad / ); return $class; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Plugin/FullyQualified.pm000644 000765 000024 00000000235 12106042701 024302 0ustar00johnstaff000000 000000 package TestApp::Plugin::FullyQualified; use strict; sub fully_qualified { my $c = shift; $c->stash->{fully_qualified} = 1; return $c; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Plugin/ParameterizedRole.pm000644 000765 000024 00000000447 12106042701 025006 0ustar00johnstaff000000 000000 package TestApp::Plugin::ParameterizedRole; use MooseX::Role::Parameterized; use namespace::autoclean; parameter method_name => ( isa => 'Str', required => 1, ); role { my $p = shift; my $method_name = $p->method_name; method $method_name => sub { 'birne' }; }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Model/ClosuresInConfig.pm000644 000765 000024 00000000561 12106042701 024403 0ustar00johnstaff000000 000000 package TestApp::Model::ClosuresInConfig; use Moose; use namespace::clean -except => 'meta'; extends 'TestApp::Model'; # Note - don't call ->config in here until the constructor calls it to # retrieve config, so that we get the 'copy from parent' path, # and ergo break due to the closure if dclone is used there.. __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Model/Foo/000755 000765 000024 00000000000 12255610005 021355 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Model/Foo.pm000644 000765 000024 00000000543 12106042701 021712 0ustar00johnstaff000000 000000 package TestApp::Model::Foo; use strict; use warnings; use base qw/ Catalyst::Model /; __PACKAGE__->config( 'quux' => 'chunkybacon' ); sub model_foo_method { 1 } sub model_quux_method { shift->{quux} } package TestApp::Model::Foo::Bar; sub model_foo_bar_method_from_foo { 1 } package TestApp::Model::Foo; sub bar { "TestApp::Model::Foo::Bar" } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Model/Generating.pm000644 000765 000024 00000000562 12106042701 023253 0ustar00johnstaff000000 000000 package TestApp::Model::Generating; use Moose; extends 'Catalyst::Model'; sub BUILD { Class::MOP::Class->create( 'TestApp::Model::Generated' => ( methods => { foo => sub { 'foo' } } ) ); } sub expand_modules { return ('TestApp::Model::Generated'); } __PACKAGE__->meta->make_immutable; no Moose; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Model/Foo/Bar.pm000644 000765 000024 00000000165 12106042701 022416 0ustar00johnstaff000000 000000 package TestApp::Model::Foo::Bar; sub model_foo_bar_method_from_foo_bar { "model_foo_bar_method_from_foo_bar" } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/DispatchType/CustomPostLoad.pm000644 000765 000024 00000000241 12106042701 025443 0ustar00johnstaff000000 000000 package TestApp::DispatchType::CustomPostLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/DispatchType/CustomPreLoad.pm000644 000765 000024 00000000240 12106042701 025243 0ustar00johnstaff000000 000000 package TestApp::DispatchType::CustomPreLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/000755 000765 000024 00000000000 12255610005 023132 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action.pm000644 000765 000024 00000000613 12106042701 023465 0ustar00johnstaff000000 000000 package TestApp::Controller::Action; use strict; use base 'Catalyst::Controller'; sub begin : Private { my ( $self, $c ) = @_; $c->res->header( 'X-Test-Class' => ref($self) ); $c->response->content_type('text/plain; charset=utf-8'); } sub default : Private { my ( $self, $c ) = @_; $c->res->output("Error - TestApp::Controller::Action\n"); $c->res->status(404); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/ActionRoles.pm000644 000765 000024 00000001150 12121675274 024505 0ustar00johnstaff000000 000000 package TestApp::Controller::ActionRoles; use Moose; BEGIN { extends 'Catalyst::Controller' } __PACKAGE__->config( action_roles => ['~Kooh'], action_args => { frew => { boo => 'hello' }, }, ); sub foo : Local Does('Moo') {} sub bar : Local Does('~Moo') {} sub baz : Local Does('+Moo') {} sub quux : Local Does('Zoo') {} sub corge : Local Does('Moo') ActionClass('TestAfter') { my ($self, $ctx) = @_; $ctx->stash(after_message => 'moo'); } sub frew : Local Does('Boo') { my ($self, $ctx) = @_; my $boo = $ctx->stash->{action_boo}; $ctx->response->body($boo); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Anon.pm000644 000765 000024 00000002142 12106042701 023142 0ustar00johnstaff000000 000000 package Anon::Trait; use Moose::Role -traits => 'MethodAttributes'; # Needed for role composition to work correctly with anon classes. after test => sub { my ($self, $c) = @_; $c->res->header('X-Anon-Trait-Applied', 1); }; no Moose::Role; package TestApp::Controller::Anon; use Moose; use Moose::Util qw/find_meta/; use namespace::clean -except => 'meta'; BEGIN { extends 'Catalyst::Controller' }; sub COMPONENT { # Don't do this yourself, use CatalystX::Component::Traits! my ($class, $app, $args) = @_; my $meta = $class->meta->create_anon_class( superclasses => [ $class->meta->name ], roles => ['Anon::Trait'], cache => 1, ); # Special move as the methodattributes trait has changed our metaclass.. $meta = find_meta($meta->name); $class = $meta->name; $class->new($app, $args); } sub test : Local ActionClass('+TestApp::Action::TestMyAction') { my ($self, $c) = @_; $c->res->header('X-Component-Name-Controller', $self->catalyst_component_name); $c->res->body('It works'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Args.pm000644 000765 000024 00000000427 12106042701 023147 0ustar00johnstaff000000 000000 package TestApp::Controller::Args; use strict; use base 'Catalyst::Controller'; sub args :Local { my ( $self, $c ) = @_; $c->res->body( join('',@{$c->req->args}) ); } sub params :Local { my ( $self, $c ) = splice @_, 0, 2; $c->res->body( join('',@_) ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Attributes.pm000644 000765 000024 00000001675 12121675274 024425 0ustar00johnstaff000000 000000 use strict; use warnings; package My::AttributesBaseClass; use base qw( Catalyst::Controller ); sub fetch : Chained('/') PathPrefix CaptureArgs(0) { } sub left_alone :Chained('fetch') PathPart Args(0) { } sub view : PathPart Chained('fetch') Args(0) { } sub foo { } # no attributes package TestApp::Controller::Attributes; use base qw(My::AttributesBaseClass); sub _parse_MakeMeVisible_attr { my ($self, $c, $name, $value) = @_; if (!$value){ return Chained => 'fetch', PathPart => 'all_attrs', Args => 0; } elsif ($value eq 'some'){ return Chained => 'fetch', Args => 0; } elsif ($value eq 'one'){ return PathPart => 'one_attr'; } } sub view { } # override attributes to "hide" url sub foo : Local { } sub all_attrs_action :MakeMeVisible { } sub some_attrs_action :MakeMeVisible('some') PathPart('some_attrs') { } sub one_attr_action :MakeMeVisible('one') Chained('fetch') Args(0) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/BodyParams.pm000644 000765 000024 00000000657 12121675274 024337 0ustar00johnstaff000000 000000 package TestApp::Controller::BodyParams; use strict; use base 'Catalyst::Controller'; sub default : Private { my ( $self, $c ) = @_; $c->req->body_params({override => 'that'}); $c->res->output($c->req->body_params->{override}); $c->res->status(200); } sub no_params : Local { my ( $self, $c ) = @_; my $params = $c->req->body_parameters; $c->res->output(ref $params); $c->res->status(200); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/ContextClosure.pm000644 000765 000024 00000001230 12106042701 025225 0ustar00johnstaff000000 000000 package TestApp::Controller::ContextClosure; use Moose; BEGIN { extends 'Catalyst::Controller'; with 'Catalyst::Component::ContextClosure'; } sub normal_closure : Local { my ($self, $ctx) = @_; $ctx->stash(closure => sub { $ctx->response->body('from normal closure'); }); $ctx->response->body('stashed normal closure'); } sub context_closure : Local { my ($self, $ctx) = @_; $ctx->stash(closure => $self->make_context_closure(sub { my ($ctx) = @_; $ctx->response->body('from context closure'); }, $ctx)); $ctx->response->body('stashed context closure'); } __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Dump.pm000644 000765 000024 00000002472 12121675274 023200 0ustar00johnstaff000000 000000 package TestApp::Controller::Dump; use strict; use base 'Catalyst::Controller'; sub default : Action { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump'); } sub env : Action Relative { my ( $self, $c ) = @_; $c->stash(env => $c->req->env); $c->forward('TestApp::View::Dump::Env'); } sub env_on_engine : Action Relative { my ( $self, $c ) = @_; $c->stash(env => $c->engine->env); $c->forward('TestApp::View::Dump::Env'); } sub request : Action Relative { my ( $self, $c ) = @_; $c->req->params(undef); # Should be a no-op, and be ignored. # Back compat test for 5.7 $c->forward('TestApp::View::Dump::Request'); } sub prepare_parameters : Action Relative { my ( $self, $c ) = @_; die 'Must pass in parameters' unless keys %{$c->req->parameters}; $c->req->parameters( {} ); die 'parameters are not empty' if keys %{$c->req->parameters}; # Now reset and reload $c->prepare_parameters; die 'Parameters were not reset' unless keys %{$c->req->parameters}; $c->forward('TestApp::View::Dump::Request'); } sub response : Action Relative { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Response'); } sub body : Action Relative { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Body'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/000755 000765 000024 00000000000 12255610005 023122 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Fork.pm000644 000765 000024 00000002056 12217110344 023156 0ustar00johnstaff000000 000000 # Fork.pm # Copyright (c) 2006 Jonathan Rockway package TestApp::Controller::Fork; use strict; use warnings; use base 'Catalyst::Controller'; eval 'use YAML'; sub system : Local { my ($self, $c, $ls) = @_; my ($result, $code) = (undef, 1); if(!-e $ls || !-x _){ $result = 'skip'; } else { $result = system($ls, $ls, $ls); $result = $! if $result != 0; } $c->response->body(Dump({result => $result})); } sub backticks : Local { my ($self, $c, $ls) = @_; my ($result, $code) = (undef, 1); if(!-e $ls || !-x _){ $result = 'skip'; $code = 0; } else { $result = `$ls $ls $ls` || $!; $code = $?; } $c->response->body(Dump({result => $result, code => $code})); } sub fork : Local { my ($self, $c) = @_; my $pid; my $x = 0; if($pid = fork()){ $x = "ok"; } else { exit(0); } waitpid $pid,0 or die; $c->response->body(Dump({pid => $pid, result => $x})); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/HTTPMethods.pm000644 000765 000024 00000003762 12121675274 024401 0ustar00johnstaff000000 000000 package TestApp::Controller::HTTPMethods; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub default : Path Args { my ($self, $ctx) = @_; $ctx->response->body('default'); } sub get : Path('foo') Method('GET') { my ($self, $ctx) = @_; $ctx->response->body('get'); } sub post : Path('foo') Method('POST') { my ($self, $ctx) = @_; $ctx->response->body('post'); } sub get_or_post : Path('bar') Method('GET') Method('POST') { my ($self, $ctx) = @_; $ctx->response->body('get or post'); } sub any_method : Path('baz') { my ($self, $ctx) = @_; $ctx->response->body('any'); } sub base :Chained('/') PathPrefix CaptureArgs(0) { } sub chained_get :Chained('base') Args(0) GET { pop->res->body('chained_get'); } sub chained_post :Chained('base') Args(0) POST { pop->res->body('chained_post'); } sub chained_put :Chained('base') Args(0) PUT { pop->res->body('chained_put'); } sub chained_delete :Chained('base') Args(0) DELETE { pop->res->body('chained_delete'); } sub get_or_put :Chained('base') PathPart('get_put_post_delete') CaptureArgs(0) GET PUT { } sub get2 :Chained('get_or_put') PathPart('') Args(0) GET { pop->res->body('get2'); } sub put2 :Chained('get_or_put') PathPart('') Args(0) PUT { pop->res->body('put2'); } sub post_or_delete :Chained('base') PathPart('get_put_post_delete') CaptureArgs(0) POST DELETE { } sub post2 :Chained('post_or_delete') PathPart('') Args(0) POST { pop->res->body('post2'); } sub delete2 :Chained('post_or_delete') PathPart('') Args(0) DELETE { pop->res->body('delete2'); } sub check_default :Chained('base') CaptureArgs(0) { } sub default_get :Chained('check_default') PathPart('') Args(0) GET { pop->res->body('get3'); } sub default_post :Chained('check_default') PathPart('') Args(0) POST { pop->res->body('post3'); } sub chain_default :Chained('check_default') PathPart('') Args(0) { pop->res->body('chain_default'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Immutable/000755 000765 000024 00000000000 12255610005 023634 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Immutable.pm000644 000765 000024 00000000211 12106042701 024161 0ustar00johnstaff000000 000000 package TestApp::Controller::Immutable; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Index.pm000644 000765 000024 00000000256 12106042701 023322 0ustar00johnstaff000000 000000 package TestApp::Controller::Index; use strict; use base 'Catalyst::Controller'; sub index : Private { my ( $self, $c ) = @_; $c->res->body( 'Index index' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Keyword.pm000644 000765 000024 00000001005 12106042701 023670 0ustar00johnstaff000000 000000 package TestApp::Controller::Keyword; use strict; use base 'Catalyst::Controller'; # # Due to 'actions' being used as an attribute up to cat 5.80003 using this name # for an action causes a weird error, as this would be called during BUILD time # of the Catalyst::Controller class # sub actions : Local { my ( $self, $c ) = @_; die("Call to controller action method without context! Probably naming clash") unless $c; $c->res->output("Test case for using 'actions' as a catalyst action name\n"); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Log.pm000644 000765 000024 00000000304 12132030171 022763 0ustar00johnstaff000000 000000 package TestApp::Controller::Log; use strict; use base 'Catalyst::Controller'; sub debug :Local { my ( $self, $c ) = @_; $c->log->debug('debug'); $c->res->body( 'logged' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Moose/000755 000765 000024 00000000000 12255610005 022777 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Moose.pm000644 000765 000024 00000001510 12106042701 023327 0ustar00johnstaff000000 000000 package TestApp::Controller::Moose; use Moose; use namespace::clean -except => 'meta'; BEGIN { extends qw/Catalyst::Controller/; } use MooseX::MethodAttributes; # FIXME - You need to say this if you have # modifiers so that you get the correct # method metaclass, why does the modifier # on MODIFY_CODE_ATTRIBUTES not work. has attribute => ( is => 'ro', default => 42, ); sub get_attribute : Local { my ($self, $c) = @_; $c->response->body($self->attribute); } sub with_local_modifier : Local { my ($self, $c) = @_; $c->forward('get_attribute'); } before with_local_modifier => sub { my ($self, $c) = @_; $c->response->header( 'X-Catalyst-Test-Before' => 'before called' ); }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities/000755 000765 000024 00000000000 12255610005 024046 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities.pm000644 000765 000024 00000001324 12132030171 024376 0ustar00johnstaff000000 000000 package TestApp::Controller::Priorities; use strict; use base 'Catalyst::Controller'; # # Local vs. Path (depends on definition order) # sub loc_vs_path1_loc :Path('/priorities/loc_vs_path1') { $_[1]->res->body( 'path' ) } sub loc_vs_path1 :Local { $_[1]->res->body( 'local' ) } sub loc_vs_path2 :Local { $_[1]->res->body( 'local' ) } sub loc_vs_path2_loc :Path('/priorities/loc_vs_path2') { $_[1]->res->body( 'path' ) } # # Local vs. index (has sub controller) # sub loc_vs_index :Local { $_[1]->res->body( 'local' ) } # # Path vs. index (has sub controller) # sub path_vs_idx :Path('/priorities/path_vs_index') { $_[1]->res->body( 'path' ) } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Root.pm000644 000765 000024 00000004654 12255342172 023216 0ustar00johnstaff000000 000000 package TestApp::Controller::Root; use strict; use warnings; use base 'Catalyst::Controller'; use utf8; __PACKAGE__->config->{namespace} = ''; sub chain_root_index : Chained('/') PathPart('') Args(0) { } sub zero : Path('0') { 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'); } sub zerobody : Local { my ($self, $c) = @_; $c->res->body('0'); } sub emptybody : Local { my ($self, $c) = @_; $c->res->body(''); } sub index : Private { my ( $self, $c ) = @_; $c->res->body('root index'); } sub global_action : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub class_forward_test_method :Private { my ( $self, $c ) = @_; $c->response->headers->header( 'X-Class-Forward-Test-Method' => 1 ); } sub loop_test : Local { my ( $self, $c ) = @_; for( 1..1001 ) { $c->forward( 'class_forward_test_method' ); } } sub recursion_test : Local { my ( $self, $c ) = @_; no warnings 'recursion'; $c->forward( 'recursion_test' ); } sub base_href_test : Local { my ( $self, $c ) = @_; my $body = <<"EndOfBody"; EndOfBody $c->response->body($body); } sub body_semipredicate : Local { my ($self, $c) = @_; $c->res->body; # Old code tests length($c->res->body), which causes the value to be built (undef), which causes the predicate $c->res->status( $c->res->has_body ? 500 : 200 ); # to return the wrong thing, resulting in a 500. $c->res->body('Body'); } sub test_redirect :Global { my ($self, $c) = @_; # Don't set content_type # Don't set body $c->res->redirect('/go_here'); } sub test_redirect_uri_for :Global { my ($self, $c) = @_; # Don't set content_type # Don't set body $c->res->redirect($c->uri_for('/go_here')); } sub test_redirect_with_contenttype :Global { my ($self, $c) = @_; # set content_type but don't set body $c->res->content_type('image/jpeg'); $c->res->redirect('/go_here'); } sub test_redirect_with_content :Global { my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->res->body('Please kind sir, I beg you to go to /go_here.'); $c->res->redirect('/go_here'); } sub end : Private { my ($self,$c) = @_; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm000644 000765 000024 00000000235 12106042701 027055 0ustar00johnstaff000000 000000 package TestApp::Controller::Priorities::loc_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm000644 000765 000024 00000000237 12106042701 027406 0ustar00johnstaff000000 000000 package TestApp::Controller::Priorities::locre_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities/MultiMethod.pm000644 000765 000024 00000000545 12106042701 026640 0ustar00johnstaff000000 000000 package TestApp::Controller::Priorities::MultiMethod; use strict; use warnings; use base qw/Catalyst::Controller/; sub auto :Private { my ($self, $c) = @_; $c->res->body(join(' ', $c->action->name, @{$c->req->args})); return 1; } sub zero :Path :Args(0) { } sub one :Path :Args(1) { } sub two :Path :Args(2) { } sub not_def : Path { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Priorities/path_vs_index.pm000644 000765 000024 00000000236 12106042701 027235 0ustar00johnstaff000000 000000 package TestApp::Controller::Priorities::path_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Moose/MethodModifiers.pm000644 000765 000024 00000000367 12106042701 026422 0ustar00johnstaff000000 000000 package TestApp::Controller::Moose::MethodModifiers; use Moose; BEGIN { extends qw/TestApp::Controller::Moose/; } after get_attribute => sub { my ($self, $c) = @_; $c->response->header( 'X-Catalyst-Test-After' => 'after called' ); }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Moose/NoAttributes.pm000644 000765 000024 00000000314 12106042701 025753 0ustar00johnstaff000000 000000 package TestApp::Controller::Moose::NoAttributes; use Moose; extends qw/Catalyst::Controller/; __PACKAGE__->config( actions => { test => { Local => undef } } ); sub test { } no Moose; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Immutable/HardToReload.pm000644 000765 000024 00000001444 12106042701 026502 0ustar00johnstaff000000 000000 package TestApp::Controller::Immutable::HardToReload::Role; use Moose::Role; # Role metaclass does not have make_immutable.. no Moose::Role; package TestApp::Controller::Immutable::HardToReload; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; package # Standard PAUSE hiding technique TestApp::Controller::Immutable::HardToReload::PAUSEHide; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; # Not an inner package package TestApp::Controller::Immutable2; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; # Not even in the app namespace package Frobnitz; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Request/000755 000765 000024 00000000000 12255610005 024552 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/000755 000765 000024 00000000000 12255610005 024720 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Cookies.pm000644 000765 000024 00000002153 12106042701 026650 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Cookies; use strict; use base 'Catalyst::Controller'; sub one : Local { my ( $self, $c ) = @_; $c->res->cookies->{catalyst} = { value => 'cool', path => '/bah' }; $c->res->cookies->{cool} = { value => 'catalyst', path => '/' }; $c->forward('TestApp::View::Dump::Request'); } sub two : Local { my ( $self, $c ) = @_; $c->res->cookies->{catalyst} = { value => 'cool', path => '/bah' }; $c->res->cookies->{cool} = { value => 'catalyst', path => '/' }; $c->res->redirect('http://www.google.com/'); } sub three : Local { my ( $self, $c ) = @_; $c->res->cookies->{object} = CGI::Simple::Cookie->new( -name => "this_is_the_real_name", -value => [qw/foo bar/], ); $c->res->cookies->{hash} = { value => [qw/a b c/], }; $c->forward('TestApp::View::Dump::Request'); } sub four : Local { my ( $self, $c ) = @_; $c->res->cookies->{good} = { value => 'good_cookie', path => '/' }; $c->res->cookies->{bad} = { value => undef }; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Errors.pm000644 000765 000024 00000000576 12106042701 026537 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Errors; use strict; use base 'Catalyst::Controller'; sub one : Relative { my ( $self, $c ) = @_; my $a = 0; my $b = 0; my $t = $a / $b; } sub two : Relative { my ( $self, $c ) = @_; $c->forward('/non/existing/path'); } sub three : Relative { my ( $self, $c ) = @_; die("I'm going to die!\n"); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Headers.pm000644 000765 000024 00000000600 12106042701 026622 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Headers; use strict; use base 'Catalyst::Controller'; sub one : Relative { my ( $self, $c ) = @_; $c->res->header( 'X-Header-Catalyst' => 'Cool' ); $c->res->header( 'X-Header-Cool' => 'Catalyst' ); $c->res->header( 'X-Header-Numbers' => join ', ', 1 .. 10 ); $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Large.pm000644 000765 000024 00000000446 12106042701 026311 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Large; use strict; use base 'Catalyst::Controller'; sub one : Relative { my ( $self, $c ) = @_; $c->res->output( 'x' x (100 * 1024) ); } sub two : Relative { my ( $self, $c ) = @_; $c->res->output( 'y' x (1024 * 1024) ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Print.pm000644 000765 000024 00000000621 12106042701 026346 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Print; use strict; use base 'Catalyst::Controller'; sub one :Relative { my ( $self, $c ) = @_; $c->res->print("foo"); } sub two :Relative { my ( $self, $c ) = @_; $c->res->print(qw/foo bar/); } sub three :Relative { my ( $self, $c ) = @_; local $, = ','; local $\ = ':'; $c->res->print(qw/foo bar baz/); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Redirect.pm000644 000765 000024 00000001173 12106042701 027016 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Redirect; use strict; use base 'Catalyst::Controller'; sub one : Relative { my ( $self, $c ) = @_; $c->response->redirect('/test/writing/is/boring'); } sub two : Relative { my ( $self, $c ) = @_; $c->response->redirect('http://www.google.com/'); } sub three : Relative { my ( $self, $c ) = @_; $c->response->redirect('http://www.google.com/'); $c->response->status(301); # Moved Permanently } sub four : Relative { my ( $self, $c ) = @_; $c->response->redirect('http://www.google.com/'); $c->response->status(307); # Temporary Redirect } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Response/Status.pm000644 000765 000024 00000001456 12106042701 026544 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Response::Status; use strict; use base 'Catalyst::Controller'; sub begin : Private { my ( $self, $c ) = @_; $c->response->content_type('text/plain'); return 1; } sub s200 : Relative { my ( $self, $c ) = @_; $c->res->status(200); $c->res->output("200 OK\n"); } sub s400 : Relative { my ( $self, $c ) = @_; $c->res->status(400); $c->res->output("400 Bad Request\n"); } sub s403 : Relative { my ( $self, $c ) = @_; $c->res->status(403); $c->res->output("403 Forbidden\n"); } sub s404 : Relative { my ( $self, $c ) = @_; $c->res->status(404); $c->res->output("404 Not Found\n"); } sub s500 : Relative { my ( $self, $c ) = @_; $c->res->status(500); $c->res->output("500 Internal Server Error\n"); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Request/Uploads.pm000644 000765 000024 00000000737 12106042701 026523 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Request::Uploads; use strict; use base 'Catalyst::Controller'; sub slurp : Relative { my ( $self, $c ) = @_; $c->response->content_type('text/plain; charset=utf-8'); my $upload = $c->request->upload('slurp'); my $contents = $upload->slurp; my $contents2 = $upload->slurp; die("Slurp not callable multiple times") unless $contents eq $contents2; $c->response->output( $c->request->upload('slurp')->slurp ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Engine/Request/URI.pm000644 000765 000024 00000005237 12106042701 025553 0ustar00johnstaff000000 000000 package TestApp::Controller::Engine::Request::URI; use strict; use base 'Catalyst::Controller'; sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub change_path : Local { my ( $self, $c ) = @_; # change the path $c->req->path( '/my/app/lives/here' ); $c->forward('TestApp::View::Dump::Request'); } sub change_base : Local { my ( $self, $c ) = @_; # change the base and uri paths $c->req->base->path( '/new/location' ); $c->req->uri->path( '/new/location/engine/request/uri/change_base' ); $c->forward('TestApp::View::Dump::Request'); } sub uri_with : Local { my ( $self, $c ) = @_; # change the current uri my $uri = $c->req->uri_with( { b => 1, c => undef } ); my %query = $uri->query_form; $c->res->header( 'X-Catalyst-Param-a' => $query{ a } ); $c->res->header( 'X-Catalyst-Param-b' => $query{ b } ); $c->res->header( 'X-Catalyst-Param-c' => exists($query{ c }) ? $query{ c } : '--notexists--' ); $c->res->header( 'X-Catalyst-query' => $uri->query); $c->forward('TestApp::View::Dump::Request'); } sub uri_with_object : Local { my ( $self, $c ) = @_; my $uri = $c->req->uri_with( { a => $c->req->base } ); my %query = $uri->query_form; $c->res->header( 'X-Catalyst-Param-a' => $query{ a } ); $c->forward('TestApp::View::Dump::Request'); } sub uri_with_utf8 : Local { my ( $self, $c ) = @_; # change the current uri my $uri = $c->req->uri_with( { unicode => "\x{2620}" } ); $c->res->header( 'X-Catalyst-uri-with' => "$uri" ); $c->forward('TestApp::View::Dump::Request'); } sub uri_with_undef : Local { my ( $self, $c ) = @_; my $warnings = 0; local $SIG{__WARN__} = sub { $warnings++ }; # change the current uri my $uri = $c->req->uri_with( { foo => undef } ); $c->res->header( 'X-Catalyst-warnings' => $warnings ); $c->forward('TestApp::View::Dump::Request'); } sub uri_with_undef_only : Local { my ( $self, $c ) = @_; my $uri = $c->req->uri_with( { a => undef } ); $c->res->header( 'X-Catalyst-uri-with' => "$uri" ); $c->forward('TestApp::View::Dump::Request'); } sub uri_with_undef_ignore : Local { my ( $self, $c ) = @_; my $uri = $c->req->uri_with( { a => 1, b => undef } ); my %query = $uri->query_form; $c->res->header( 'X-Catalyst-uri-with' => "$uri" ); $c->res->header( 'X-Catalyst-Param-a' => $query{ a } ); $c->res->header( 'X-Catalyst-Param-b' => $query{ b } ); $c->res->header( 'X-Catalyst-Param-c' => $query{ c } ); $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Action.pm000644 000765 000024 00000003603 12121675274 024722 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Action; use strict; use base 'TestApp::Controller::Action'; __PACKAGE__->config( actions => { '*' => { extra_attribute => 13 }, action_action_five => { ActionClass => '+Catalyst::Action::TestBefore' }, action_action_eight => { another_extra_attribute => 'foo' }, }, action_args => { '*' => { extra_arg => 42 }, action_action_seven => { another_extra_arg => 23 }, }, ); sub action_action_one : Global : ActionClass('TestBefore') { my ( $self, $c ) = @_; $c->res->header( 'X-Action', $c->stash->{test} ); $c->forward('TestApp::View::Dump::Request'); } sub action_action_two : Global : ActionClass('TestAfter') { my ( $self, $c ) = @_; $c->stash->{after_message} = 'awesome'; $c->forward('TestApp::View::Dump::Request'); } sub action_action_three : Global : ActionClass('+TestApp::Action::TestBefore') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_action_four : Global : MyAction('TestMyAction') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_action_five : Global { my ( $self, $c ) = @_; $c->res->header( 'X-Action', $c->stash->{test} ); $c->forward('TestApp::View::Dump::Request'); } sub action_action_six : Global : ActionClass('~TestMyAction') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_action_seven : Global : ActionClass('~TestExtraArgsAction') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_action_eight : Global { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Action'); } sub action_action_nine : Global : ActionClass('~TestActionArgsFromConstructor') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto/000755 000765 000024 00000000000 12255610005 024042 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto.pm000644 000765 000024 00000000507 12106042701 024377 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Auto; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 1; } sub default : Private { my ( $self, $c ) = @_; $c->res->body( 'default' ); } sub one : Local { my ( $self, $c ) = @_; $c->res->body( 'one' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Begin.pm000644 000765 000024 00000000435 12106042701 024513 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Begin; use strict; use base 'TestApp::Controller::Action'; sub begin : Private { my ( $self, $c ) = @_; $self->SUPER::begin($c); } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/000755 000765 000024 00000000000 12255610005 024465 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained.pm000644 000765 000024 00000021534 12156157140 025036 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained; use strict; use warnings; use HTML::Entities; use base qw/Catalyst::Controller/; sub begin :Private { } # # TODO # :Chained('') means what? # # # Simple parent/child action test # sub foo :PathPart('chained/foo') :CaptureArgs(1) :Chained('/') { my ( $self, $c, @args ) = @_; die "missing argument" unless @args; die "more than 1 argument: got @args" if @args > 1; } sub endpoint :PathPart('end') :Chained('/action/chained/foo') :Args(1) { } # # Parent/child test with two args each # sub foo2 :PathPart('chained/foo2') :CaptureArgs(2) :Chained('/') { } sub endpoint2 :PathPart('end2') :Chained('/action/chained/foo2') :Args(2) { } # # Relative specification of parent action # sub bar :PathPart('chained/bar') :Chained('/') :CaptureArgs(0) { } sub finale :PathPart('') :Chained('bar') :Args { } # # three chain with concurrent endpoints # sub one :PathPart('chained/one') :Chained('/') :CaptureArgs(1) { } sub two :PathPart('two') :Chained('/action/chained/one') :CaptureArgs(2) { } sub three_end :PathPart('three') :Chained('two') :Args(3) { } sub one_end :PathPart('chained/one') :Chained('/') :Args(1) { } sub two_end :PathPart('two') :Chained('one') :Args(2) { } # # Dispatch on number of arguments # sub multi1 :PathPart('chained/multi') :Chained('/') :Args(1) { } sub multi2 :PathPart('chained/multi') :Chained('/') :Args(2) { } # # Roots in an action defined in a higher controller # sub higher_root :PathPart('bar') :Chained('/action/chained/foo/higher_root') :Args(1) { } # # Controller -> subcontroller -> controller # sub pcp1 :PathPart('chained/pcp1') :Chained('/') :CaptureArgs(1) { } sub pcp3 :Chained('/action/chained/foo/pcp2') :Args(1) { } # # Dispatch on capture number # sub multi_cap1 :PathPart('chained/multi_cap') :Chained('/') :CaptureArgs(1) { } sub multi_cap2 :PathPart('chained/multi_cap') :Chained('/') :CaptureArgs(2) { } sub multi_cap_end1 :PathPart('baz') :Chained('multi_cap1') :Args(0) { } sub multi_cap_end2 :PathPart('baz') :Chained('multi_cap2') :Args(0) { } # # Priority: Slurpy args vs. chained actions # sub priority_a1 :PathPart('chained/priority_a') :Chained('/') :Args { } sub priority_a2 :PathPart('chained/priority_a') :Chained('/') :CaptureArgs(1) { } sub priority_a2_end :PathPart('end') :Chained('priority_a2') :Args(1) { } # # Priority: Fixed args vs. chained actions # sub priority_b1 :PathPart('chained/priority_b') :Chained('/') :Args(3) { } sub priority_b2 :PathPart('chained/priority_b') :Chained('/') :CaptureArgs(1) { } sub priority_b2_end :PathPart('end') :Chained('priority_b2') :Args(1) { } # # Priority: With no Args() # sub priority_c1 :PathPart('chained/priority_c') :Chained('/') :CaptureArgs(1) { } sub priority_c2 :PathPart('') :Chained('priority_c1') { } sub priority_c2_xyz :PathPart('xyz') :Chained('priority_c1') { } # # Optional specification of :Args in endpoint # sub opt_args :PathPart('chained/opt_args') :Chained('/') { } # # Optional PathPart test -> /chained/optpp/*/opt_pathpart/* # sub opt_pp_start :Chained('/') :PathPart('chained/optpp') :CaptureArgs(1) { } sub opt_pathpart :Chained('opt_pp_start') :Args(1) { } # # Optional Args *and* PathPart -> /chained/optall/*/oa/... # sub opt_all_start :Chained('/') :PathPart('chained/optall') :CaptureArgs(1) { } sub oa :Chained('opt_all_start') { } # # :Chained is the same as :Chained('/') # sub rootdef :Chained :PathPart('chained/rootdef') :Args(1) { } # # the ParentChain controller chains to this action by # specifying :Chained('.') # sub parentchain :Chained('/') :PathPart('chained/parentchain') :CaptureArgs(1) { } # # This is just for a test that a loose end is not callable # sub loose :Chained :PathPart('chained/loose') CaptureArgs(1) { } # # Forwarding out of the middle of a chain. # sub chain_fw_a :Chained :PathPart('chained/chain_fw') :CaptureArgs(1) { $_[1]->forward( '/action/chained/fw_dt_target' ); } sub chain_fw_b :Chained('chain_fw_a') :PathPart('end') :Args(1) { } # # Detaching out of the middle of a chain. # sub chain_dt_a :Chained :PathPart('chained/chain_dt') :CaptureArgs(1) { $_[1]->detach( '/action/chained/fw_dt_target' ); } sub chain_dt_b :Chained('chain_dt_a') :PathPart('end') :Args(1) { } # # Die in the middle of a chain # sub chain_die_a :Chained :PathPart('chained/chain_die') :CaptureArgs(1) { $_[1]->error( 'break in the middle of a chain' ); } sub chain_die_b :Chained('chain_die_a') :PathPart('end') :Args(1) {} # # Target for former forward and chain tests. # sub fw_dt_target :Private { } # # Test multiple chained actions with no captures # sub empty_chain_a : Chained('/') PathPart('chained/empty') CaptureArgs(0) { } sub empty_chain_b : Chained('empty_chain_a') PathPart('') CaptureArgs(0) { } sub empty_chain_c : Chained('empty_chain_b') PathPart('') CaptureArgs(0) { } sub empty_chain_d : Chained('empty_chain_c') PathPart('') CaptureArgs(1) { } sub empty_chain_e : Chained('empty_chain_d') PathPart('') CaptureArgs(0) { } sub empty_chain_f : Chained('empty_chain_e') PathPart('') Args(1) { } sub mult_nopp_base : Chained('/') PathPart('chained/mult_nopp') CaptureArgs(0) { } sub mult_nopp_all : Chained('mult_nopp_base') PathPart('') Args(0) { } sub mult_nopp_new : Chained('mult_nopp_base') PathPart('new') Args(0) { } sub mult_nopp_id : Chained('mult_nopp_base') PathPart('') CaptureArgs(1) { } sub mult_nopp_idall : Chained('mult_nopp_id') PathPart('') Args(0) { } sub mult_nopp_idnew : Chained('mult_nopp_id') PathPart('new') Args(0) { } sub mult_nopp2_base : Chained('/') PathPart('chained/mult_nopp2') CaptureArgs(0) { } sub mult_nopp2_nocap : Chained('mult_nopp2_base') PathPart('') CaptureArgs(0) { } sub mult_nopp2_action : Chained('mult_nopp2_nocap') PathPart('action') CaptureArgs(0) { } sub mult_nopp2_action_default : Chained('mult_nopp2_action') PathPart('') Args(0) { } sub mult_nopp2_action_with_arg : Chained('mult_nopp2_action') PathPart('') Args(1) { } sub mult_nopp2_load : Chained('mult_nopp2_base') PathPart('') CaptureArgs(1) { } sub mult_nopp2_view : Chained('mult_nopp2_load') PathPart('') Args(0) { } # # Test Choice between branches and early return logic # Declaration order is important for $children->{$*}, since this is first match best. # sub cc_base : Chained('/') PathPart('chained/choose_capture') CaptureArgs(0) { } sub cc_link : Chained('cc_base') PathPart('') CaptureArgs(0) { } sub cc_anchor : Chained('cc_link') PathPart('anchor.html') Args(0) { } sub cc_all : Chained('cc_base') PathPart('') Args() { } sub cc_a : Chained('cc_base') PathPart('') CaptureArgs(1) { } sub cc_a_link : Chained('cc_a') PathPart('a') CaptureArgs(0) { } sub cc_a_anchor : Chained('cc_a_link') PathPart('') Args() { } sub cc_b : Chained('cc_base') PathPart('b') CaptureArgs(0) { } sub cc_b_link : Chained('cc_b') PathPart('') CaptureArgs(1) { } sub cc_b_anchor : Chained('cc_b_link') PathPart('anchor.html') Args() { } # # Test static paths vs. captures # sub apan : Chained('/') CaptureArgs(0) PathPrefix { } sub korv : Chained('apan') CaptureArgs(0) PathPart('') { } sub wurst : Chained('apan') CaptureArgs(1) PathPart('') { } sub static_end : Chained('korv') Args(0) { } sub capture_end : Chained('wurst') Args(0) PathPart('') { } # */search vs doc/* sub view : Chained('/') PathPart('chained') CaptureArgs(1) {} sub star_search : Chained('view') PathPart('search') Args(0) { } sub doc_star : Chained('/') PathPart('chained/doc') Args(1) {} sub return_arg : Chained('view') PathPart('return_arg') Args(1) {} sub return_arg_decoded : Chained('/') PathPart('chained/return_arg_decoded') Args(1) { my ($self, $c) = @_; $c->req->args([ map { decode_entities($_) } @{ $c->req->args }]); } sub roundtrip_urifor : Chained('/') PathPart('chained/roundtrip_urifor') CaptureArgs(1) {} sub roundtrip_urifor_end : Chained('roundtrip_urifor') PathPart('') Args(1) { my ($self, $c) = @_; # This should round-trip, always - i.e. the uri you put in should come back out. $c->res->body($c->uri_for($c->action, $c->req->captures, @{$c->req->args}, $c->req->parameters)); $c->stash->{no_end} = 1; } sub match_captures : Chained('/') PathPart('chained/match_captures') CaptureArgs(1) ActionClass('+TestApp::Action::TestMatchCaptures') { my ($self, $c) = @_; $c->res->header( 'X-TestAppActionTestMatchCapturesHasRan', 'yes'); } sub match_captures_end : Chained('match_captures') PathPart('bar') Args(0) { } sub end :Private { my ($self, $c) = @_; return if $c->stash->{no_end}; my $out = join('; ', map { join(', ', @$_) } ($c->req->captures, $c->req->args)); $c->res->body($out); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm000644 000765 000024 00000000603 12106042701 027504 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::ConfigSmashArrayRefs; use strict; use base 'Catalyst::Controller'; sub foo : Action {} # check configuration for an inherited action __PACKAGE__->config( action => { foo => { CustomAttr => [ 'Bar' ] } } ); sub _parse_CustomAttr_attr { my ($self, $app, $name, $value) = @_; return CustomAttr => "PoopInYourShoes"; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Default.pm000644 000765 000024 00000000316 12106042701 025051 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Default; use strict; use base 'TestApp::Controller::Action'; sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Detach.pm000644 000765 000024 00000001725 12106042701 024662 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Detach; use strict; use base 'TestApp::Controller::Action'; sub one : Local { my ( $self, $c ) = @_; $c->detach('two'); $c->forward('error'); } sub two : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub error : Local { my ( $self, $c ) = @_; $c->res->output('error'); } sub path : Local { my ( $self, $c ) = @_; $c->detach('/action/detach/two'); $c->forward('error'); } sub with_args : Local { my ( $self, $c, $orig ) = @_; $c->detach( 'args', [qq/new/] ); } sub with_method_and_args : Local { my ( $self, $c, $orig ) = @_; $c->detach( qw/TestApp::Controller::Action::Detach args/, [qq/new/] ); } sub args : Local { my ( $self, $c, $val ) = @_; die "Expected argument 'new', got '$val'" unless $val eq 'new'; die "passed argument does not match args" unless $val eq $c->req->args->[0]; $c->res->body( $c->req->args->[0] ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/DieInEnd.pm000644 000765 000024 00000000442 12106042701 025104 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::DieInEnd; use strict; use base 'TestApp::Controller::Action'; sub end : Private { my ( $self, $c ) = @_; die "I'm ending with death"; } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/End.pm000644 000765 000024 00000000374 12106042701 024177 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::End; use strict; use base 'TestApp::Controller::Action'; sub end : Private { my ( $self, $c ) = @_; } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Forward.pm000644 000765 000024 00000004031 12106042701 025067 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Forward; use strict; use base 'TestApp::Controller::Action'; sub one : Local { my ( $self, $c ) = @_; $c->forward('two'); } sub two : Private { my ( $self, $c ) = @_; $c->forward('three'); } sub three : Local { my ( $self, $c ) = @_; $c->forward( $self, 'four' ); } sub four : Private { my ( $self, $c ) = @_; $c->forward('/action/forward/five'); } sub five : Local { my ( $self, $c ) = @_; $c->forward('View::Dump::Request'); } sub jojo : Local { my ( $self, $c ) = @_; $c->forward('one'); $c->forward( $c->controller('Action::Forward'), 'three' ); } sub inheritance : Local { my ( $self, $c ) = @_; $c->forward('/action/inheritance/a/b/default'); $c->forward('five'); } sub global : Local { my ( $self, $c ) = @_; $c->forward('/global_action'); } sub with_args : Local { my ( $self, $c, $orig ) = @_; $c->forward( 'args', [qq/new/] ); $c->res->body( $c->req->args->[0] ); } sub with_method_and_args : Local { my ( $self, $c, $orig ) = @_; $c->forward( qw/TestApp::Controller::Action::Forward args/, [qq/new/] ); $c->res->body( $c->req->args->[0] ); } sub to_action_object : Local { my ( $self, $c ) = @_; $c->forward($self->action_for('embed'), [qw/mtfnpy/]); } sub args : Local { my ( $self, $c, $val ) = @_; die "Expected argument 'new', got '$val'" unless $val eq 'new'; die "passed argument does not match args" unless $val eq $c->req->args->[0]; } sub args_embed_relative : Local { my ( $self, $c ) = @_; $c->forward('embed/ok'); } sub args_embed_absolute : Local { my ( $self, $c ) = @_; $c->forward('/action/forward/embed/ok'); } sub embed : Local { my ( $self, $c, $ok ) = @_; $ok ||= 'not ok'; $c->res->body($ok); } sub class_forward_test_action : Local { my ( $self, $c ) = @_; $c->forward(qw/TestApp class_forward_test_method/); } sub forward_to_uri_check : Local { my ( $self, $c ) = @_; $c->forward( 'Action::ForwardTo', 'uri_check' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/ForwardTo.pm000644 000765 000024 00000000350 12106042701 025372 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::ForwardTo; use strict; use base 'TestApp::Controller::Action'; sub uri_check : Private { my ( $self, $c ) = @_; $c->res->body( $c->uri_for('foo/bar')->rel($c->req->base)->path ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Global.pm000644 000765 000024 00000000745 12106042701 024673 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Global; use strict; use base 'TestApp::Controller::Action'; sub action_global_one : Action Absolute { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_global_two : Action Global { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub action_global_three : Action Path('/action_global_three') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Go.pm000644 000765 000024 00000003750 12106042701 024037 0ustar00johnstaff000000 000000 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->forward('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 go_chained : Local { my ( $self, $c, $val ) = @_; $c->go('/action/chained/foo/spoon', ['captureme'], [qw/arg1 arg2/]); } sub view : Local { my ( $self, $c, $val ) = @_; eval { $c->go('View::Dump') }; $c->res->body( $@ ? $@ : "go() did not die" ); } sub model : Local { my ( $self, $c, $val ) = @_; eval { $c->go('Model::Foo') }; $c->res->body( $@ ? $@ : "go() did not die" ); } 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/); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Index.pm000644 000765 000024 00000000304 12106042701 024531 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Index; use strict; use base 'TestApp::Controller::Action'; sub index : Private { my ( $self, $c ) = @_; $c->res->body( 'Action-Index index' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Inheritance.pm000644 000765 000024 00000002642 12106042701 025722 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Inheritance; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 1; } sub begin : Private { my ( $self, $c ) = @_; $self->SUPER::begin($c); } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub end : Private { my ( $self, $c ) = @_; } package TestApp::Controller::Action::Inheritance::A; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 1; } sub begin : Private { my ( $self, $c ) = @_; $self->SUPER::begin($c); } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub end : Private { my ( $self, $c ) = @_; } package TestApp::Controller::Action::Inheritance::A::B; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 1; } sub begin : Private { my ( $self, $c ) = @_; $self->SUPER::begin($c); } sub default : Private { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub end : Private { my ( $self, $c ) = @_; } package TestApp::Controller::Action::Inheritance::B; use strict; use base 'TestApp::Controller::Action'; # check configuration for an inherited action __PACKAGE__->config( action => { begin => {} } ); 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Local.pm000644 000765 000024 00000001234 12106042701 024517 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Local; use strict; use base 'TestApp::Controller::Action'; sub one : Action Relative { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub two : Action Local Args(2) { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub three : Action Path('three') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub four : Action Path('four/five/six') { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub five : Action Local Args(1) { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Path.pm000644 000765 000024 00000001667 12106042701 024373 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Path; use strict; use base 'TestApp::Controller::Action'; __PACKAGE__->config( actions => { 'one' => { 'Path' => [ 'a path with spaces' ] }, 'two' => { 'Path' => "åäö" }, 'six' => { 'Local' => undef }, }, ); sub one : Action Path("this_will_be_overriden") { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub two : Action { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub three :Path { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub four : Path( 'spaces_near_parens_singleq' ) { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub five : Path( "spaces_near_parens_doubleq" ) { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } sub six { my ( $self, $c ) = @_; $c->forward('TestApp::View::Dump::Request'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Private.pm000644 000765 000024 00000001204 12106042701 025074 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Private; use strict; use base 'TestApp::Controller::Action'; sub default : Private { my ( $self, $c ) = @_; $c->res->output('access denied'); } sub one : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } sub two : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } sub three : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } sub four : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } sub five : Private { my ( $self, $c ) = @_; $c->res->output('access allowed'); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Streaming.pm000644 000765 000024 00000002114 12106042701 025414 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Streaming; use strict; use base 'TestApp::Controller::Action'; sub streaming : Global { my ( $self, $c ) = @_; for my $line ( split "\n", <<'EOF' ) { foo bar baz EOF $c->res->write("$line\n"); } } sub body : Local { my ( $self, $c ) = @_; my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm"; my $fh = IO::File->new( $file, 'r' ); if ( defined $fh ) { $c->res->body( $fh ); } else { $c->res->body( "Unable to read $file" ); } } sub body_glob : Local { my ( $self, $c ) = @_; my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm"; open my $fh, '<', $file; if ( defined $fh ) { $c->res->body( $fh ); } else { $c->res->body( "Unable to read $file" ); } } sub body_large : Local { my ($self, $c) = @_; # more than one write with the default chunksize my $size = 128 * 1024; my $data = "\0" x $size; open my $fh, '<', \$data; $c->res->content_length($size); $c->res->body($fh); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/TestMultipath.pm000644 000765 000024 00000000566 12106042701 026303 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::TestMultipath; use strict; use base 'TestApp::Controller::Action'; __PACKAGE__->config( namespace => 'action/multipath' ); sub multipath : Local : Global : Path('/multipath1') : Path('multipath2') { my ( $self, $c ) = @_; for my $line ( split "\n", <<'EOF' ) { foo bar baz EOF $c->res->write("$line\n"); } } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/TestRelative.pm000644 000765 000024 00000001437 12106042701 026105 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::TestRelative; use strict; use base 'TestApp::Controller::Action'; __PACKAGE__->config( path => 'action/relative' ); sub relative : Local { my ( $self, $c ) = @_; $c->forward('/action/forward/one'); } sub relative_two : Local { my ( $self, $c ) = @_; $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' ); } sub relative_visit : Local { my ( $self, $c ) = @_; $c->visit('/action/visit/one'); } sub relative_visit_two : Local { my ( $self, $c ) = @_; $c->visit( 'TestApp::Controller::Action::Visit', 'one' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Visit.pm000644 000765 000024 00000004512 12106042701 024565 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Visit; use strict; use base 'TestApp::Controller::Action'; sub one : Local { my ( $self, $c ) = @_; $c->visit('two'); } sub two : Private { my ( $self, $c ) = @_; $c->visit('three'); } sub three : Local { my ( $self, $c ) = @_; $c->visit( $self, 'four' ); } sub four : Private { my ( $self, $c ) = @_; $c->visit('/action/visit/five'); } sub five : Local { my ( $self, $c ) = @_; $c->forward('View::Dump::Request'); } sub inheritance : Local { my ( $self, $c ) = @_; $c->visit('/action/inheritance/a/b/default'); } sub global : Local { my ( $self, $c ) = @_; $c->visit('/global_action'); } sub with_args : Local { my ( $self, $c, $arg ) = @_; $c->visit( 'args', [$arg] ); } sub with_method_and_args : Local { my ( $self, $c, $arg ) = @_; $c->visit( qw/TestApp::Controller::Action::Visit 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 visit_die : Local { my ( $self, $c, $val ) = @_; eval { $c->visit( 'args', [qq/new/] ) }; $c->res->body( $@ ? $@ : "visit() doesn't die" ); } sub visit_chained : Local { 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 { my ( $self, $c, $val ) = @_; eval { $c->visit('View::Dump') }; $c->res->body( $@ ? $@ : "visit() did not die" ); } sub model : Local { my ( $self, $c, $val ) = @_; eval { $c->visit('Model::Foo') }; $c->res->body( $@ ? $@ : "visit() did not die" ); } sub args_embed_relative : Local { my ( $self, $c ) = @_; $c->visit('embed/ok'); } sub args_embed_absolute : Local { my ( $self, $c ) = @_; $c->visit('/action/visit/embed/ok'); } sub embed : Local { my ( $self, $c, $ok ) = @_; $ok ||= 'not ok'; $c->res->body($ok); } sub class_visit_test_action : Local { my ( $self, $c ) = @_; $c->visit(qw/TestApp/); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/ArgsOrder.pm000644 000765 000024 00000001635 12106042701 026715 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::ArgsOrder; use warnings; use strict; use base qw( Catalyst::Controller ); # # This controller builds a simple chain of three actions that # will output the arguments they got passed to @_ after the # context object. We do this to test if that passing works # as it should. # sub base :Chained('/') PathPart('argsorder') CaptureArgs(0) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'base', $arg; } sub index :Chained('base') PathPart('') Args(0) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'index', $arg; } sub all :Chained('base') PathPart('') Args() { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'all', $arg; } sub end : Private { my ( $self, $c ) = @_; no warnings 'uninitialized'; $c->response->body( join '; ', @{ $c->stash->{ passed_args } } ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto/000755 000765 000024 00000000000 12255610005 025375 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto.pm000644 000765 000024 00000001326 12106042701 025732 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Auto; use warnings; use strict; use base qw( Catalyst::Controller ); # # Provided for sub-auto tests. This just always returns true. # sub auto : Private { 1 } # # Simple chains with auto actions returning 1 and 0 # sub foo : Chained PathPart('chained/autochain1') CaptureArgs(1) { } sub bar : Chained PathPart('chained/autochain2') CaptureArgs(1) { } # # Detaching out of an auto action. # sub dt1 : Chained PathPart('chained/auto_detach') CaptureArgs(1) { } # # Forwarding out of an auto action. # sub fw1 : Chained PathPart('chained/auto_forward') CaptureArgs(1) { } # # Target for dispatch and forward tests. # sub fw3 : Private { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Bar.pm000644 000765 000024 00000000450 12106042701 025523 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Bar; use strict; use warnings; use base qw/Catalyst::Controller/; # # Redispatching between controllers that are not in a parent/child # relation. This is the root. # sub cross1 :PathPart('chained/cross') :CaptureArgs(1) :Chained('/') { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/CaptureArgs.pm000644 000765 000024 00000003620 12106042701 027241 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::CaptureArgs; use warnings; use strict; use base qw( Catalyst::Controller ); # # This controller build the following patterns of URI: # /captureargs/*/* # /captureargs/*/*/edit # /captureargs/* # /captureargs/*/edit # /captureargs/test/* # It will output the arguments they got passed to @_ after the # context object. # /captureargs/one/edit should not dispatch to /captureargs/*/* # /captureargs/test/one should not dispatch to /captureargs/*/* sub base :Chained('/') PathPart('captureargs') CaptureArgs(0) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'base'; } sub two_args :Chained('base') PathPart('') CaptureArgs(2) { my ( $self, $c, $arg1, $arg2 ) = @_; push @{ $c->stash->{ passed_args } }, 'two_args', $arg1, $arg2; } sub one_arg :Chained('base') ParthPart('') CaptureArgs(1) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'one_arg', $arg; } sub edit_two_args :Chained('two_args') PathPart('edit') Args(0) { my ( $self, $c ) = @_; push @{ $c->stash->{ passed_args } }, 'edit_two_args'; } sub edit_one_arg :Chained('one_arg') PathPart('edit') Args(0) { my ( $self, $c ) = @_; push @{ $c->stash->{ passed_args } }, 'edit_one_arg'; } sub view_two_args :Chained('two_args') PathPart('') Args(0) { my ( $self, $c ) = @_; push @{ $c->stash->{ passed_args } }, 'view_two_args'; } sub view_one_arg :Chained('one_arg') PathPart('') Args(0) { my ( $self, $c ) = @_; push @{ $c->stash->{ passed_args } }, 'view_one_arg'; } sub test_plus_arg :Chained('base') PathPart('test') Args(1) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, 'test_plus_arg', $arg; } sub end : Private { my ( $self, $c ) = @_; no warnings 'uninitialized'; $c->response->body( join '; ', @{ $c->stash->{ passed_args } } ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Foo.pm000644 000765 000024 00000001536 12106042701 025550 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Foo; use strict; use warnings; use base qw/Catalyst::Controller/; # # Child of current namespace # sub spoon :Chained('.') :Args(0) { } # # Root for a action in a "parent" controller # sub higher_root :PathPart('chained/higher_root') :Chained('/') :CaptureArgs(1) { } # # Parent controller -> this subcontroller -> parent controller test # sub pcp2 :Chained('/action/chained/pcp1') :CaptureArgs(1) { } # # Controllers not in parent/child relation. This tests the end. # sub cross2 :PathPart('end') :Chained('/action/chained/bar/cross1') :Args(1) { } # # Create a uri to the root index # sub to_root : Chained('/') PathPart('action/chained/to_root') { my ( $self, $c ) = @_; my $uri = $c->uri_for_action('/chain_root_index'); $c->res->body( "URI:$uri" ); $c->stash->{no_end}++; } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/ParentChain/000755 000765 000024 00000000000 12255610005 026661 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm000644 000765 000024 00000001075 12106042701 027217 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::ParentChain; use warnings; use strict; use base qw/ Catalyst::Controller /; # # Chains to the action /action/chained/parentchain in the # Action::Chained controller. # sub child :Chained('.') :Args(1) { } # Should be at /chained/rootdef/*/chained_rel/*/* sub chained_rel :Chained('../one') Args(2) { } # Should chain to loose in parent namespace - i.e. at /chained/loose/*/loose/*/* sub loose : ChainedParent Args(2) { } # Should be at /chained/cross/*/up_down/* sub up_down : Chained('../bar/cross1') Args(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/PassedArgs.pm000644 000765 000024 00000001577 12106042701 027066 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::PassedArgs; use warnings; use strict; use base qw( Catalyst::Controller ); # # This controller builds a simple chain of three actions that # will output the arguments they got passed to @_ after the # context object. We do this to test if that passing works # as it should. # sub first : PathPart('chained/passedargs/a') Chained('/') CaptureArgs(1) { my ( $self, $c, $arg ) = @_; $c->stash->{ passed_args } = [ $arg ]; } sub second : PathPart('b') Chained('first') CaptureArgs(1) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, $arg; } sub third : PathPart('c') Chained('second') Args(1) { my ( $self, $c, $arg ) = @_; push @{ $c->stash->{ passed_args } }, $arg; } sub end : Private { my ( $self, $c ) = @_; $c->response->body( join '; ', @{ $c->stash->{ passed_args } } ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm000644 000765 000024 00000000440 12106042701 027070 0ustar00johnstaff000000 000000 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; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Root.pm000644 000765 000024 00000000454 12106042701 025746 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Root; use strict; use warnings; use base qw( Catalyst::Controller ); __PACKAGE__->config->{namespace} = ''; sub rootsub : PathPart Chained( '/' ) CaptureArgs( 1 ) { } sub endpointsub : PathPart Chained( 'rootsub' ) Args( 1 ) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm000644 000765 000024 00000000352 12106042701 030767 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::ParentChain::Relative; use warnings; use strict; use base qw/ Catalyst::Controller /; # using ../ to go up more than one level sub chained_rel_two : Chained('../../one') Args(2) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto/Bar.pm000644 000765 000024 00000000515 12106042701 026435 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Auto::Bar; use warnings; use strict; use base qw( Catalyst::Controller ); # # Test chain reaction if auto action returns 0. # sub auto : Private { 0 } sub barend : Chained('.') Args(1) { } sub crossloose : Chained PathPart('chained/auto_cross') CaptureArgs(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto/Detach.pm000644 000765 000024 00000000571 12106042701 027123 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Auto::Detach; use warnings; use strict; use base qw( Catalyst::Controller ); # # For testing behaviour of a detaching auto action in a chain. # sub auto : Private { my ( $self, $c ) = @_; $c->detach( '/action/chained/auto/fw3' ); return 1; } sub detachend : Chained('/action/chained/auto/dt1') Args(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto/Foo.pm000644 000765 000024 00000000516 12106042701 026455 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Auto::Foo; use warnings; use strict; use base qw( Catalyst::Controller ); # # Test chain reaction if auto action returns 1. # sub auto : Private { 1 } sub fooend : Chained('.') Args(1) { } sub crossend : Chained('/action/chained/auto/bar/crossloose') Args(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Chained/Auto/Forward.pm000644 000765 000024 00000000575 12106042701 027343 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Chained::Auto::Forward; use warnings; use strict; use base qw( Catalyst::Controller ); # # For testing behaviour of a forwarding auto action in a chain. # sub auto : Private { my ( $self, $c ) = @_; $c->forward( '/action/chained/auto/fw3' ); return 1; } sub forwardend : Chained('/action/chained/auto/fw1') Args(1) { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto/Abort.pm000644 000765 000024 00000000703 12106042701 025444 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Auto::Abort; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 0; } sub default : Private { my ( $self, $c ) = @_; $c->res->body( 'abort default' ); } sub end : Private { my ( $self, $c ) = @_; $c->res->body( 'abort end' ) unless $c->res->body; } sub one : Local { my ( $self, $c ) = @_; $c->res->body( 'abort one' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto/Deep.pm000644 000765 000024 00000000527 12106042701 025256 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Auto::Deep; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; return 1; } sub default : Private { my ( $self, $c ) = @_; $c->res->body( 'deep default' ); } sub one : Local { my ( $self, $c ) = @_; $c->res->body( 'deep one' ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto/Default.pm000644 000765 000024 00000000574 12106042701 025767 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Auto::Default; use strict; use base 'TestApp::Controller::Action'; sub begin : Private { } sub auto : Private { my ( $self, $c ) = @_; $c->stash->{auto_ran}++; return 1; } sub default : Private { my ( $self, $c ) = @_; $c->res->body( sprintf 'default (auto: %d)', $c->stash->{auto_ran} ); } sub end : Private { } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Controller/Action/Auto/Detach.pm000644 000765 000024 00000001372 12106042701 025570 0ustar00johnstaff000000 000000 package TestApp::Controller::Action::Auto::Detach; use strict; use base 'TestApp::Controller::Action'; sub auto : Private { my ( $self, $c ) = @_; $c->res->body( "detach auto" ); if ($c->req->param("with_forward_detach")) { $c->forward("with_forward_detach"); } else { $c->detach; } return 1; } sub default : Path { my ( $self, $c ) = @_; $c->res->body( 'detach default' ); } sub with_forward_detach : Private { my ($self, $c) = @_; $c->res->body( "detach with_forward_detach" ); if ($c->req->param("detach_to_action")) { $c->detach("detach_action"); } else { $c->detach; } } sub detach_action : Private { my ($self, $c) = @_; $c->res->body("detach_action"); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/ActionRole/Boo.pm000644 000765 000024 00000000442 12121675274 022721 0ustar00johnstaff000000 000000 package TestApp::ActionRole::Boo; use Moose::Role; has boo => ( is => 'ro', required => 1, ); around execute => sub { my ($orig, $self, $controller, $ctx, @rest) = @_; $ctx->stash(action_boo => $self->boo); return $self->$orig($controller, $ctx, @rest); }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/ActionRole/Kooh.pm000644 000765 000024 00000000304 12121675274 023077 0ustar00johnstaff000000 000000 package TestApp::ActionRole::Kooh; use Moose::Role; use namespace::autoclean; after execute => sub { my ($self, $controller, $c) = @_; $c->response->header('X-Affe' => 'Tiger'); }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/ActionRole/Moo.pm000644 000765 000024 00000000236 12121675274 022735 0ustar00johnstaff000000 000000 package TestApp::ActionRole::Moo; use Moose::Role; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Action/TestActionArgsFromConstructor.pm000644 000765 000024 00000000621 12121675274 027343 0ustar00johnstaff000000 000000 package TestApp::Action::TestActionArgsFromConstructor; use Moose; use namespace::autoclean; extends 'Catalyst::Action'; has [qw/extra_arg another_extra_arg/] => ( is => 'ro' ); after execute => sub { my ($self, $controller, $ctx) = @_; $ctx->response->header('X-TestExtraArgsAction' => join q{,} => $self->extra_arg, $self->another_extra_arg); }; __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Action/TestBefore.pm000644 000765 000024 00000000415 12106042701 023404 0ustar00johnstaff000000 000000 package TestApp::Action::TestBefore; use strict; use warnings; use base qw/Catalyst::Action/; sub execute { my $self = shift; my ( $controller, $c, $test ) = @_; $c->res->header( 'X-TestAppActionTestBefore', $test ); $self->next::method( @_ ); } 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Action/TestExtraArgsAction.pm000644 000765 000024 00000000604 12106042701 025240 0ustar00johnstaff000000 000000 package TestApp::Action::TestExtraArgsAction; use Moose; use namespace::autoclean; extends 'Catalyst::Action'; has [qw/extra_arg another_extra_arg/] => (is => 'ro'); after execute => sub { my ($self, $controller, $ctx) = @_; $ctx->response->header('X-TestExtraArgsAction' => join q{,} => $self->extra_arg, $self->another_extra_arg); }; __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/TestApp/Action/TestMatchCaptures.pm000644 000765 000024 00000000576 12121675274 024773 0ustar00johnstaff000000 000000 package TestApp::Action::TestMatchCaptures; use Moose; extends 'Catalyst::Action'; sub match_captures { my ($self, $c, $cap) = @_; if ($cap->[0] eq 'force') { $c->res->header( 'X-TestAppActionTestMatchCaptures', 'forcing' ); return 1; } else { $c->res->header( 'X-TestAppActionTestMatchCaptures', 'fallthrough' ); return 0; } } 1;Catalyst-Runtime-5.90053/t/lib/TestApp/Action/TestMyAction.pm000644 000765 000024 00000000767 12106042701 023737 0ustar00johnstaff000000 000000 package TestApp::Action::TestMyAction; use strict; use warnings; use base qw/Catalyst::Action/; sub execute { my $self = shift; my ( $controller, $c, $test ) = @_; $c->res->header( 'X-TestAppActionTestMyAction', 'MyAction works' ); $c->res->header( 'X-Component-Name-Action', $controller->catalyst_component_name); $c->res->header( 'X-Component-Instance-Name-Action', ref($controller)); $c->res->header( 'X-Class-In-Action', $self->class); $self->next::method(@_); } 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Controller/000755 000765 000024 00000000000 12255610005 023102 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Script/000755 000765 000024 00000000000 12255610005 022223 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/TraitFor/000755 000765 000024 00000000000 12255610005 022511 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/TraitFor/Script/000755 000765 000024 00000000000 12255610005 023755 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/TraitFor/Script.pm000644 000765 000024 00000000273 12106042701 024312 0ustar00johnstaff000000 000000 package ScriptTestApp::TraitFor::Script; use Moose::Role; use namespace::autoclean; around run => sub { my ($orig, $self, @args) = @_; return 'moo' . $self->$orig(@args); }; 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/TraitFor/Script/Bar.pm000644 000765 000024 00000000277 12106042701 025022 0ustar00johnstaff000000 000000 package ScriptTestApp::TraitFor::Script::Bar; use Moose::Role; use namespace::autoclean; around run => sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . '23'; }; 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/TraitFor/Script/Foo.pm000644 000765 000024 00000000277 12106042701 025041 0ustar00johnstaff000000 000000 package ScriptTestApp::TraitFor::Script::Foo; use Moose::Role; use namespace::autoclean; around run => sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . '42'; }; 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Script/Bar.pm000644 000765 000024 00000000204 12106042701 023256 0ustar00johnstaff000000 000000 package ScriptTestApp::Script::Bar; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Script/CompileTest.pm000644 000765 000024 00000000157 12106042701 025011 0ustar00johnstaff000000 000000 package ScriptTestApp::Script::CompileTest; use Moose; use namespace::autoclean; die("Does not compile"); 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Script/Foo.pm000644 000765 000024 00000000204 12106042701 023275 0ustar00johnstaff000000 000000 package ScriptTestApp::Script::Foo; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90053/t/lib/ScriptTestApp/Controller/Root.pm000644 000765 000024 00000000260 12106042701 024356 0ustar00johnstaff000000 000000 package ScriptTestApp::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub default : Chained('/') PathPart('') Args() {} 1; Catalyst-Runtime-5.90053/t/lib/PluginTestApp/Controller/000755 000765 000024 00000000000 12255610005 023074 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/PluginTestApp/Controller/Root.pm000644 000765 000024 00000003105 12156157140 024362 0ustar00johnstaff000000 000000 package PluginTestApp::Controller::Root; use Test::More; use base 'Catalyst::Controller'; #use Catalyst qw( # Test::Plugin # +TestApp::Plugin::FullyQualified # ); __PACKAGE__->config->{namespace} = ''; sub compile_time_plugins : Local { my ( $self, $c ) = @_; isa_ok $c, 'Catalyst::Plugin::Test::Plugin'; isa_ok $c, 'TestApp::Plugin::FullyQualified'; can_ok $c, 'registered_plugins'; $c->_test_plugins; $c->res->body("ok"); } sub run_time_plugins : Local { my ( $self, $c ) = @_; $c->_test_plugins; my $faux_plugin = 'Faux::Plugin'; # Trick perl into thinking the plugin is already loaded $INC{'Faux/Plugin.pm'} = 1; ref($c)->plugin( faux => $faux_plugin ); isa_ok $c, 'Catalyst::Plugin::Test::Plugin'; # applied parameterized role if (eval { require MooseX::Role::Parameterized; 1 }) { can_ok $c, 'affe'; is $c->affe, 'birne', 'right method created by parameterized role'; } isa_ok $c, 'TestApp::Plugin::FullyQualified'; ok !$c->isa($faux_plugin), '... and it should not inherit from the instant plugin'; can_ok $c, 'faux'; is $c->faux->count, 1, '... and it should behave correctly'; is_deeply [ $c->registered_plugins ], [ qw/Catalyst::Plugin::Test::Plugin Catalyst::Plugin::Unicode::Encoding Faux::Plugin TestApp::Plugin::FullyQualified/ ], 'registered_plugins() should report all plugins'; ok $c->registered_plugins('Faux::Plugin'), '... and even the specific instant plugin'; $c->res->body("ok"); } 1; Catalyst-Runtime-5.90053/t/lib/DeprecatedTestApp/C/000755 000765 000024 00000000000 12255610005 021735 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/DeprecatedTestApp/C/Root.pm000644 000765 000024 00000000514 12106042701 023213 0ustar00johnstaff000000 000000 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'); } sub req_user : Local { my ( $self, $c ) = @_; $c->res->body('REMOTE_USER = ' . $c->req->user); } 1; Catalyst-Runtime-5.90053/t/lib/ChainedActionsApp/Controller/000755 000765 000024 00000000000 12255610005 023652 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ChainedActionsApp/Controller/Root.pm000644 000765 000024 00000004656 12106042701 025143 0ustar00johnstaff000000 000000 package ChainedActionsApp::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } # # Sets the actions in this controller to be registered with no prefix # so they function identically to actions created in MyApp.pm # __PACKAGE__->config(namespace => ''); sub setup : Chained('/') PathPart('') CaptureArgs(0) { my ( $self, $c ) = @_; # Common things here are to check for ACL and setup global contexts } sub home : Chained('setup') PathPart('') Args(0) { my($self,$c) = @_; $c->response->body( "Application Home Page" ); } sub home_base : Chained('setup') PathPart('') CaptureArgs(2) { my($self,$c,$proj_id,$title) = @_; $c->stash({project_id=>$proj_id, project_title=>$title}); } sub hpages : Chained('home_base') PathPart('') Args(0) { my($self,$c) = @_; $c->response->body( "List project " . $c->stash->{project_title} . " pages"); } sub hpage : Chained('home_base') PathPart('') Args(2) { my($self,$c,$page_id, $pagetitle) = @_; $c->response->body( "This is $pagetitle page of " . $c->stash->{project_title} . " project" ); } sub no_account : Chained('setup') PathPart('account') Args(0) { my($self,$c) = @_; $c->response->body( "New account o login" ); } sub account_base : Chained('setup') PathPart('account') CaptureArgs(1) { my($self,$c,$acc_id) = @_; $c->stash({account_id=>$acc_id}); } sub account : Chained('account_base') PathPart('') Args(0) { my($self,$c,$acc) = @_; $c->response->body( "This is account " . $c->stash->{account_id} ); } sub profile_base : Chained('setup') PathPart('account/profile') CaptureArgs(1) { my($self,$c,$acc_id) = @_; $c->stash({account_id=>$acc_id}); } sub profile : Chained('profile_base') PathPart('') Args(1) { my($self,$c,$acc) = @_; $c->response->body( "This is profile of " . $acc ); } =head2 downloads This is a different test, this function is void, just to let following in the chain to declare downloads as PathPart. =cut sub downloads : Chained('setup') PathPart('') CaptureArgs(0) { my($self,$c) = @_; } sub downloads_index : Chained('downloads') PathPart('downloads') Args(0) { my($self,$c) = @_; $c->response->body( "This is download index"); } sub default : Chained('setup') PathPart('') Args() { my ( $self, $c ) = @_; $c->response->body( 'Page not found' ); $c->response->status(404); } sub end : Action {} __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Action/000755 000765 000024 00000000000 12255610005 021213 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/Catalyst/ActionRole/000755 000765 000024 00000000000 12255610005 022035 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/000755 000765 000024 00000000000 12255610005 021234 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/Catalyst/Script/000755 000765 000024 00000000000 12255610005 021242 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/Catalyst/Script/Bar.pm000644 000765 000024 00000000177 12106042701 022306 0ustar00johnstaff000000 000000 package Catalyst::Script::Bar; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Script/Baz.pm000644 000765 000024 00000000443 12106042701 022312 0ustar00johnstaff000000 000000 package Catalyst::Script::Baz; use Moose; use namespace::autoclean; use Test::More; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } after new_with_options => sub { my ($self, %args) = @_; is_deeply \%args, { application_name => 'ScriptTestApp' }, 'App name correct'; }; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Script/CompileTest.pm000644 000765 000024 00000000453 12106042701 024027 0ustar00johnstaff000000 000000 package Catalyst::Script::CompileTest; use Moose; use namespace::autoclean; use Test::More; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } after new_with_options => sub { my ($self, %args) = @_; is_deeply \%args, { application_name => 'ScriptTestApp' }, 'App name correct'; }; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/000755 000765 000024 00000000000 12255610005 022153 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/Deprecated.pm000644 000765 000024 00000000667 12106042701 024557 0ustar00johnstaff000000 000000 package Catalyst::Plugin::Test::Deprecated; use strict; use warnings; 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; Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/Errors.pm000644 000765 000024 00000001145 12106042701 023763 0ustar00johnstaff000000 000000 package Catalyst::Plugin::Test::Errors; use strict; use MRO::Compat; sub error { my $c = shift; unless ( $_[0] ) { return $c->next::method(@_); } if ( $_[0] =~ /^(Unknown resource|No default action defined)/ ) { $c->response->status(404); } if ( $_[0] =~ /^Couldn\'t forward/ ) { $c->response->status(404); } if ( $_[0] =~ /^Caught exception/ ) { $c->response->status(500); } my $error = $_[0]; $error =~ s/\n/, /g; $c->response->headers->push_header( 'X-Catalyst-Error' => $error ); $c->next::method(@_); } 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/Headers.pm000644 000765 000024 00000001370 12106042701 024062 0ustar00johnstaff000000 000000 package Catalyst::Plugin::Test::Headers; use strict; use MRO::Compat; sub prepare { my $class = shift; my $c = $class->next::method(@_); $c->response->header( 'X-Catalyst-Engine' => $c->engine ); $c->response->header( 'X-Catalyst-Debug' => $c->debug ? 1 : 0 ); { my $components = join( ', ', sort keys %{ $c->components } ); $c->response->header( 'X-Catalyst-Components' => $components ); } { no strict 'refs'; my $plugins = join ', ', $class->registered_plugins; $c->response->header( 'X-Catalyst-Plugins' => $plugins ); } return $c; } sub prepare_action { my $c = shift; $c->next::method(@_); $c->res->header( 'X-Catalyst-Action' => $c->req->action ); } 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/MangleDollarUnderScore.pm000644 000765 000024 00000000627 12217110344 027050 0ustar00johnstaff000000 000000 package Catalyst::Plugin::Test::MangleDollarUnderScore; use strict; use warnings; # FIXME - should proably use utf8?? our $VERSION = 0.1; # Make is_class_loaded happy # Class::Load::load_class($_) can hurt you real hard. BEGIN { $_ = q{ mst sayeth, Class::Load::load_class($_) will ruin your life rafl spokeh "i ♥ my $_"', and verrily forsooth, t0m made tests and yea, there was fail' }; } 1; __END__ Catalyst-Runtime-5.90053/t/lib/Catalyst/Plugin/Test/Plugin.pm000644 000765 000024 00000001442 12156703543 023762 0ustar00johnstaff000000 000000 package Catalyst::Plugin::Test::Plugin; use strict; use warnings; use MRO::Compat; use base qw/Class::Data::Inheritable/; __PACKAGE__->mk_classdata('ran_setup'); sub setup { my $c = shift; $c->ran_setup('1'); return $c->next::method( @_ ); } sub prepare { my $class = shift; my $c = $class->next::method(@_); $c->response->header( 'X-Catalyst-Plugin-Setup' => $c->ran_setup ); return $c; } # Note: Catalyst::Plugin::Server forces the body to # be parsed, by calling the $c->req->body method in prepare_action. # We need to test this, as this was broken by 5.80. See also # t/aggregate/live_engine_request_body.t. sub prepare_action { my $c = shift; $c->res->header('X-Have-Request-Body', 1) if $c->req->body; $c->next::method(@_); } 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/ActionRole/Moo.pm000644 000765 000024 00000000272 12121675274 023141 0ustar00johnstaff000000 000000 package Catalyst::ActionRole::Moo; use Moose::Role; use namespace::autoclean; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/ActionRole/Zoo.pm000644 000765 000024 00000000272 12121675274 023156 0ustar00johnstaff000000 000000 package Catalyst::ActionRole::Zoo; use Moose::Role; use namespace::autoclean; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Action/TestAfter.pm000644 000765 000024 00000000616 12121675274 023470 0ustar00johnstaff000000 000000 package Catalyst::Action::TestAfter; use strict; use warnings; use base qw/Catalyst::Action/; # N.B. Keep as a non-moose class, this also # tests metaclass initialization works as expected sub execute { my $self = shift; my ( $controller, $c ) = @_; $self->next::method( @_ ); $c->res->header( 'X-Action-After', $c->stash->{after_message} ); } 1; Catalyst-Runtime-5.90053/t/lib/Catalyst/Action/TestBefore.pm000644 000765 000024 00000000355 12106042701 023613 0ustar00johnstaff000000 000000 package Catalyst::Action::TestBefore; use strict; use warnings; use base qw/Catalyst::Action/; sub execute { my $self = shift; my ( $controller, $c ) = @_; $c->stash->{test} = 'works'; $self->next::method( @_ ); } 1; Catalyst-Runtime-5.90053/t/lib/ACLTestApp/Controller/000755 000765 000024 00000000000 12255610005 022235 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/t/lib/ACLTestApp/Controller/Root.pm000644 000765 000024 00000000454 12106042701 023516 0ustar00johnstaff000000 000000 package ACLTestApp::Controller::Root; use Test::More; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub foobar : Private { die $Catalyst::DETACH; } sub gorch : Local { my ( $self, $c, $frozjob ) = @_; is $frozjob, 'wozzle'; $c->res->body("gorch"); } 1; Catalyst-Runtime-5.90053/t/conf/extra.conf.in000644 000765 000024 00000002522 12106042701 020766 0ustar00johnstaff000000 000000 # Needed to pass some %2F tests AllowEncodedSlashes on # CGI ScriptAlias /cgi/ @ServerRoot@/tmp/TestApp/script/testapp_cgi.pl/ # REDIRECT_URL test # Fix trailing slash on /cgi # one CGI test will fail if you don't have mod_rewrite enabled RewriteEngine on RewriteRule /cgi$ /cgi/ [PT] # Pass-through Authorization header for CGI/FastCGI RewriteCond %{HTTP:Authorization} ^(.+) RewriteRule ^(.*)$ $1 [E=HTTP_AUTHORIZATION:%1,PT] RewriteEngine on RewriteRule /rewrite$ /rewrite/ [PT] RewriteRule /rewrite/(.*) /cgi/$1 # FastCGI FastCgiIpcDir @ServerRoot@/tmp/tmp FastCgiServer @ServerRoot@/tmp/TestApp/script/testapp_fastcgi.pl -idle-timeout 300 -processes 1 # Test at a non-root location ScriptAlias /fastcgi/deep/path/ @ServerRoot@/tmp/TestApp/script/testapp_fastcgi.pl/ # Test at root ScriptAlias / @ServerRoot@/tmp/TestApp/script/testapp_fastcgi.pl/ # Fix trailing slash RewriteEngine on RewriteRule /fastcgi/deep/path$ /fastcgi/deep/path/ [PT] Catalyst-Runtime-5.90053/t/author/http-server.t000644 000765 000024 00000006016 12217110141 021413 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 1; use Test::TCP; use File::Path; use FindBin; use Net::EmptyPort qw(wait_port empty_port); use Try::Tiny; use Plack::Builder; eval { require Catalyst::Devel; Catalyst::Devel->VERSION(1.0); 1; } || do { fail("Could not load Catalyst::Devel: $@"); exit 1; }; eval { require File::Copy::Recursive; 1 } || do { fail("Could not load File::Copy::Recursive: $@"); exit 1; }; # Run a single test by providing it as the first arg my $single_test = shift; my $tmpdir = "$FindBin::Bin/../../t/tmp"; # clean up rmtree $tmpdir if -d $tmpdir; # create a TestApp and copy the test libs into it mkdir $tmpdir; chdir $tmpdir; system( $^X, "-I$FindBin::Bin/../../lib", "$FindBin::Bin/../../script/catalyst.pl", 'TestApp' ); chdir "$FindBin::Bin/.."; File::Copy::Recursive::dircopy( '../t/lib', '../t/tmp/TestApp/lib' ) or die; # remove TestApp's tests rmtree '../t/tmp/TestApp/t' or die; # spawn the standalone HTTP server my $port = empty_port; my $pid = fork; if ($pid) { # parent. print "Waiting for server to start...\n"; wait_port_timeout($port, 30); } elsif ($pid == 0) { # child process unshift @INC, "$tmpdir/TestApp/lib", "$FindBin::Bin/../../lib"; require TestApp; my $psgi_app = TestApp->apply_default_middlewares(TestApp->psgi_app); Plack::Loader->auto(port => $port)->run(builder { mount '/test_prefix' => $psgi_app; mount '/' => sub { return [501, ['Content-Type' => 'text/plain'], ['broken tests']]; }; }); exit 0; } else { die "fork failed: $!"; } # run the testsuite against the HTTP server $ENV{CATALYST_SERVER} = "http://localhost:$port/test_prefix"; chdir '..'; my $return; if ( $single_test ) { $return = system( "$^X -Ilib/ $single_test" ); } else { $return = prove(grep { $_ ne '..' } glob('t/aggregate/live_*.t')); } # shut it down kill 'INT', $pid; # clean up rmtree "$FindBin::Bin/../../t/tmp" if -d "$FindBin::Bin/../../t/tmp"; is( $return, 0, 'live tests' ); # kill 'INT' doesn't exist in Windows, so to prevent child hanging, # this process will need to commit seppuku to clean up the children. if ($^O eq 'MSWin32') { # Furthermore, it needs to do it 'politely' so that TAP doesn't # smell anything 'dubious'. require Win32::Process; # core in all versions of Win32 Perl Win32::Process::KillProcess($$, $return); } sub wait_port_timeout { my ($port, $timeout) = @_; wait_port($port, $timeout * 10) and return; die "Server did not start within $timeout seconds"; } sub prove { my (@tests) = @_; if (!(my $pid = fork)) { require TAP::Harness; my $aggr = -e '.aggregating'; my $harness = TAP::Harness->new({ ($aggr ? (test_args => \@tests) : ()), lib => ['lib'], }); my $aggregator = $aggr ? $harness->runtests('t/aggregate.t') : $harness->runtests(@tests); exit $aggregator->has_errors ? 1 : 0; } else { waitpid $pid, 0; return $?; } } Catalyst-Runtime-5.90053/t/author/notabs.t000644 000765 000024 00000000173 12106042701 020417 0ustar00johnstaff000000 000000 use strict; use warnings; use File::Spec; use FindBin (); use Test::More; use Test::NoTabs; all_perl_files_ok(qw/lib/); Catalyst-Runtime-5.90053/t/author/pod.t000644 000765 000024 00000000125 12106042701 017710 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Test::Pod 1.14; all_pod_files_ok(); Catalyst-Runtime-5.90053/t/author/podcoverage.t000644 000765 000024 00000001316 12156157140 021440 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Pod::Coverage 0.19; use Test::Pod::Coverage 1.04; my @modules = all_modules; our @private = ( 'BUILD' ); foreach my $module (@modules) { next if $module =~ /Unicode::Encoding/; local @private = (@private, 'run', 'dont_close_all_files') if $module =~ /^Catalyst::Script::/; local @private = (@private, 'plugin') if $module =~ /^Catalyst$/; local @private = (@private, 'snippets') if $module =~ /^Catalyst::Request$/; local @private = (@private, 'prepare_connection') if $module =~ /^Catalyst::Engine$/; pod_coverage_ok($module, { also_private => \@private, coverage_class => 'Pod::Coverage::TrustPod', }); } done_testing; Catalyst-Runtime-5.90053/t/author/spelling.t000644 000765 000024 00000004633 12236261623 020765 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Test::Spelling; add_stopwords(qw( API CGI MVC PSGI Plack README SSI Starman XXXX URI htaccess middleware mixins namespace psgi startup Deprecations catamoose cataplack linearize subclasses subdirectories refactoring adaptors undef env regex unary rethrow rethrows stringifies CPAN STDERR SIGCHLD baz roadmap wishlist refactor refactored Runtime pluggable pluggability hoc apis fastcgi nginx Lighttpd IIS middlewares backend IRC ctx _application MyApp restarter httponly Utils stash's unescapes dispatchtype dispatchtypes redispatch redispatching CaptureArgs ChainedParent PathPart PathPrefix BUILDARGS metaclass namespaces pre ARGV ReverseProxy filename tempname request's subdirectory ini uninstalled uppercased wiki bitmask uri url urls dir hostname proxied http https IP SSL inline INLINE plugins cpanfile FastCGI Stringifies Rethrows DispatchType Wishlist Refactor ROADMAP HTTPS Unescapes Restarter Nginx Refactored ActionClass LocalRegex LocalRegexp MyAction metadata cometd io psgix websockets UTF async codebase dev filenames params MyMiddleware JSON POSTed RESTful configuation performant subref actionrole Andreas Ashton Axel Balint Belka Brocard Caelum Cassidy Dagfinn Danijel Dhanani Dhaval Diment Doran Edvinsson Florian Geoff Grundman Hartmaier Hawes Ilmari Johan Kamholz Kiefer Kieren Kitover Kogman Kostyuk Kubb Lammel Lindstrom Mannsåker Marienborg Marrandi McWhirter Milicevic Miyagawa Montes Naughton Oleg Ragwitz Ramberg Rasnita Reis Riedel Rockway Roditi Rodland Ruthven Sascha Schutz Sedlacek Sheidlower SpiceMan Szilakszi Tatsuhiko Ulf Vilain Viljo Wardley Westermann Willert Yuval abraxxa abw andyg audreyt bricas chansen dhoss dkubb dwc esskar fREW fireartist frew gabb groditi hobbs ilmari jcamacho jhannah jon konobi marcus mgrimes miyagawa mst naughton ningu nothingmuch numa obra phaylon rafl rainboxx sri szbalint willert wreis )); set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok(); done_testing(); Catalyst-Runtime-5.90053/t/author/unicode_plugin_nested_params.t000644 000765 000024 00000004372 12217110343 025050 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use utf8; # setup library path use FindBin qw($Bin); use lib "$Bin/../lib"; BEGIN { eval { require Catalyst::Plugin::Params::Nested; 1; } || plan skip_all => 'Need Catalyst::Plugin::Params::Nested' } use Catalyst::Test 'TestApp2'; use Encode; use HTTP::Request::Common; use URI::Escape qw/uri_escape_utf8/; use HTTP::Status 'is_server_error'; my $encode_str = "\x{e3}\x{81}\x{82}"; # e38182 is japanese 'あ' my $decode_str = Encode::decode('utf-8' => $encode_str); my $escape_str = uri_escape_utf8($decode_str); BEGIN { eval 'require Catalyst::Plugin::Params::Nested'; plan skip_all => 'Catalyst::Plugin::Params::Nested is required' if $@; } { my ($res, $c) = ctx_request("/?foo.1=bar&foo.2=$escape_str"); is( $c->res->output, '

It works

', 'Content displayed' ); my $got = $c->request->parameters; my $expected = { 'foo.1' => 'bar', 'foo.2' => $decode_str, 'foo' => [undef, 'bar', $decode_str], }; is( $got->{foo}->[0], undef, '{foo}->[0] is undef' ); is( $got->{foo}->[1], 'bar', '{foo}->[1] is bar' ); ok( utf8::is_utf8( $got->{'foo.2'} ), '{foo.2} is utf8' ); ok( utf8::is_utf8( $got->{foo}->[2] ), '{foo}->[2] is utf8' ); is_deeply($got, $expected, 'nested params' ); } { my ($res, $c) = ctx_request("/?foo.1=bar&foo.2=$escape_str&bar.baz=$escape_str&baz.bar.foo=$escape_str&&arr.0.1=$escape_str"); my $got = $c->request->parameters; my $expected = { 'foo.1' => 'bar', 'foo.2' => $decode_str, 'bar.baz' => $decode_str, 'baz.bar.foo' => $decode_str, 'arr.0.1' => $decode_str, 'arr' => [ [undef, $decode_str] ], 'foo' => [undef, 'bar', $decode_str], 'bar' => { baz => $decode_str }, 'baz' => { bar => { foo => $decode_str } }, }; is( ref $got->{arr}->[0], 'ARRAY', '{arr}->[0] is ARRAY' ); ok( utf8::is_utf8( $got->{arr}->[0]->[1] ), '{arr}->[0]->[1] is utf8' ); ok( utf8::is_utf8( $got->{bar}{baz} ), '{bar}{baz} is utf8' ); ok( utf8::is_utf8( $got->{baz}{bar}{foo} ), '{baz}{bar}{foo} is utf8' ); is_deeply($got, $expected, 'nested params' ); } done_testing(); Catalyst-Runtime-5.90053/t/aggregate/c3_appclass_bug.t000644 000765 000024 00000000633 12217110343 022607 0ustar00johnstaff000000 000000 use strict; use Test::More tests => 1; { package TestPlugin; use strict; sub setup { shift->maybe::next::method(@_); } } { package TestAppC3ErrorUseMoose; use Moose; use Catalyst::Runtime 5.80; use base qw/Catalyst/; use Catalyst qw/ +TestPlugin /; } use Test::Fatal; is exception { TestAppC3ErrorUseMoose->setup(); }, undef, 'No C3 error'; 1; Catalyst-Runtime-5.90053/t/aggregate/c3_mro.t000644 000765 000024 00000001677 12106042701 020751 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; require Catalyst; require Module::Pluggable::Object; use MRO::Compat; # Get a list of all Catalyst:: packages in blib via M::P::O my @cat_mods; { # problem with @INC on win32, see: # http://rt.cpan.org/Ticket/Display.html?id=26452 if ($^O eq 'MSWin32') { require Win32; Win32::GetCwd(); } local @INC = grep {/blib/} @INC; @cat_mods = ( 'Catalyst', Module::Pluggable::Object->new(search_path => ['Catalyst'])->plugins, ); } # plan one test per found package name plan tests => scalar @cat_mods; # Try to calculate the C3 MRO for each package # # In the case that the initial require fails (as in # Catalyst::Engine::FastCGI when FCGI is not installed), # the calculateMRO eval will not error out, which is # effectively a test skip. # foreach my $cat_mod (@cat_mods) { eval " require $cat_mod "; eval { mro::get_linear_isa($cat_mod, 'c3') }; ok(!$@, "calculateMRO for $cat_mod: $@"); } Catalyst-Runtime-5.90053/t/aggregate/caf_backcompat.t000644 000765 000024 00000001213 12217110343 022467 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Class::Load 'load_class'; use Moose::Util (); # List of everything which used Class::Accessor::Fast in 5.70. my @modules = qw/ Catalyst::Action Catalyst::ActionContainer Catalyst::Component Catalyst::Dispatcher Catalyst::DispatchType Catalyst::Engine Catalyst::Log Catalyst::Request::Upload Catalyst::Request Catalyst::Response /; plan tests => scalar @modules; foreach my $module (@modules) { load_class($module); ok Moose::Util::does_role($module => 'MooseX::Emulate::Class::Accessor::Fast'), "$module has Class::Accessor::Fast back-compat"; } Catalyst-Runtime-5.90053/t/aggregate/catalyst_test_utf8.t000644 000765 000024 00000001561 12106042701 023410 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Test::More; # "binmode STDOUT, ':utf8'" is insufficient, see http://code.google.com/p/test-more/issues/detail?id=46#c1 binmode Test::More->builder->output, ":utf8"; binmode Test::More->builder->failure_output, ":utf8"; use Catalyst::Test 'TestAppEncoding'; plan skip_all => 'This test does not run live' if $ENV{CATALYST_SERVER}; { # Test for https://rt.cpan.org/Ticket/Display.html?id=53678 # Catalyst::Test::get currently returns the raw octets, but it # would be more useful if it decoded the content based on the # Content-Type charset, as Test::WWW::Mechanize::Catalyst does use utf8; my $body = get('/utf8_non_ascii_content'); utf8::decode($body); is $body, 'ʇsʎlɐʇɐɔ', 'Catalyst::Test::get returned content correctly UTF-8 encoded'; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/custom_live_component_controller_action_auto_doublebug.t000644 000765 000024 00000002077 12217110343 033056 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 3*$iters; use Catalyst::Test 'TestAppDoubleAutoBug'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 3; } { my @expected = qw[ TestAppDoubleAutoBug::Controller::Root->auto TestAppDoubleAutoBug::Controller::Root->default TestAppDoubleAutoBug::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/one'), 'auto + local' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'default, auto=1', 'Content OK' ); } } } Catalyst-Runtime-5.90053/t/aggregate/custom_live_path_bug.t000644 000765 000024 00000001317 12217110343 023761 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 2*$iters; use Catalyst::Test 'TestAppPathBug'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 2; } { my $expected = 'This is the foo method.'; ok( my $response = request('http://localhost/'), 'response ok' ); is( $response->content, $expected, 'Content OK' ); } } } Catalyst-Runtime-5.90053/t/aggregate/deprecated_test_import.t000644 000765 000024 00000000330 12106042701 024301 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Catalyst::Test (); my $warn; { local $SIG{__WARN__} = sub { $warn = shift; }; Catalyst::Test->import(); } ok $warn; like $warn, qr/deprecated/; done_testing; Catalyst-Runtime-5.90053/t/aggregate/deprecated_test_unimported.t000644 000765 000024 00000000603 12106042701 025160 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/../lib"; use TestApp; use Catalyst::Test (); { like do { my $warning; local $SIG{__WARN__} = sub { $warning = $_[0] }; isa_ok Catalyst::Test::local_request('TestApp', '/'), 'HTTP::Response'; $warning; }, qr/deprecated/, 'local_request is deprecated'; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/error_page_dump.t000644 000765 000024 00000000517 12217110343 022732 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use Catalyst::Engine; my $m = sub { Catalyst::Engine->_dump_error_page_element(@_) }; is exception { $m->('Scalar' => ['foo' => 'bar']) }, undef; is exception { $m->('Array' => ['foo' => []]) }, undef; is exception { $m->('Hash' => ['foo' => {}]) }, undef; done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_action.t000644 000765 000024 00000016602 12217110343 027740 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { { ok( my $response = request('http://localhost/action_action_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_action_one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-Action'), 'works' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_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_action_two', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-Action-After'), 'awesome' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_three/one/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_action_three', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-TestAppActionTestBefore'), 'one' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_four'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_four', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-TestAppActionTestMyAction'), 'MyAction works' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_five'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_five', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-Action'), 'works' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_six'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_six', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-TestAppActionTestMyAction'), 'MyAction works' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_seven'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_seven', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-TestExtraArgsAction'), '42,23', 'Extra args get passed to action contstructor' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_action_eight'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_eight', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Action' \)$/s, 'Content is a serialized Catalyst::Action' ); require Catalyst::Action; # when running against a remote server, we # need to load the class in the test process # to be able to introspect the action instance # later. my $action = eval $response->content; is_deeply $action->attributes->{extra_attribute}, [13]; is_deeply $action->attributes->{another_extra_attribute}, ['foo']; } { ok( my $response = request('http://localhost/action_action_nine'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_action_nine', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Action', 'Test Class' ); is( $response->header('X-TestExtraArgsAction'), '42,13', 'Extra args get passed to action constructor' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_auto.t000644 000765 000024 00000014630 12217110343 027432 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); # new dispatcher: # 11 wallclock secs (10.14 usr + 0.20 sys = 10.34 CPU) @ 15.18/s (n=157) # old dispatcher (r1486): # 11 wallclock secs (10.34 usr + 0.20 sys = 10.54 CPU) @ 13.76/s (n=145) } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { # test auto + local method { my @expected = qw[ TestApp::Controller::Action::Auto->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto->one TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/one'), 'auto + local' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'one', 'Content OK' ); } # test auto + default { my @expected = qw[ TestApp::Controller::Action::Auto->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto->default TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/anything'), 'auto + default' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'default', 'Content OK' ); } # test auto + auto + local { my @expected = qw[ TestApp::Controller::Action::Auto::Deep->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Deep->auto TestApp::Controller::Action::Auto::Deep->one TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/deep/one'), 'auto + auto + local' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'deep one', 'Content OK' ); } # test auto + auto + default { my @expected = qw[ TestApp::Controller::Action::Auto::Deep->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Deep->auto TestApp::Controller::Action::Auto::Deep->default TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/deep/anything'), 'auto + auto + default' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'deep default', 'Content OK' ); } # test auto + failing auto + local + end { my @expected = qw[ TestApp::Controller::Action::Auto::Abort->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Abort->auto TestApp::Controller::Action::Auto::Abort->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/abort/one'), 'auto + failing auto + local' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'abort end', 'Content OK' ); } # test auto + default (bug on invocation of default twice) { my @expected = qw[ TestApp::Controller::Action::Auto::Default->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Default->auto TestApp::Controller::Action::Auto::Default->default TestApp::Controller::Action::Auto::Default->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/default/moose'), 'auto + default' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'default (auto: 1)', 'Content OK' ); } # test detach in auto { my @expected = qw[ TestApp::Controller::Action::Auto::Detach->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Detach->auto TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/detach'), 'auto with detach' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'detach auto', 'Content OK' ); } # test detach in auto forward { my @expected = qw[ TestApp::Controller::Action::Auto::Detach->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Detach->auto TestApp::Controller::Action::Auto::Detach->with_forward_detach TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/detach?with_forward_detach=1'), 'auto with_forward_detach' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'detach with_forward_detach', 'Content OK' ); } # test detach in auto forward detach action { my @expected = qw[ TestApp::Controller::Action::Auto::Detach->begin TestApp::Controller::Action::Auto->auto TestApp::Controller::Action::Auto::Detach->auto TestApp::Controller::Action::Auto::Detach->with_forward_detach TestApp::Controller::Action::Auto::Detach->detach_action TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/auto/detach?with_forward_detach=1&detach_to_action=1'), 'auto with_forward_detach to detach_action' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'detach_action', 'Content OK' ); } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_begin.t000644 000765 000024 00000002514 12217110343 027544 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 7*$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::Begin->begin TestApp::Controller::Action::Begin->default TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/begin'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Begin', 'Test Class' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); like( $response->content, qr/'Catalyst::Request'/, 'Content is a serialized Catalyst::Request' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_chained.t000644 000765 000024 00000120222 12255332157 030063 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use URI; use URI::QueryParam; 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 ($run_number) = @_; # # This is a simple test where the parent and child actions are # within the same controller. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->foo TestApp::Controller::Action::Chained->endpoint TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/foo/1/end/2'), 'chained + local endpoint' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # This makes sure the above isn't found if the argument for the # end action isn't supplied. # { my $expected = undef; ok( my $response = request('http://localhost/chained/foo/1/end'), 'chained + local endpoint; missing last argument' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->code, 500, 'Status OK' ); } # # Tests the case when the child action is placed in a subcontroller. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->foo TestApp::Controller::Action::Chained::Foo->spoon TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/foo/1/spoon'), 'chained + subcontroller endpoint' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; ', 'Content OK' ); } # # Tests if the relative specification (e.g.: Chained('bar') ) works # as expected. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->bar TestApp::Controller::Action::Chained->finale TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/bar/1/spoon'), 'chained + relative endpoint' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 1, spoon', 'Content OK' ); } # # Just a test for multiple arguments. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->foo2 TestApp::Controller::Action::Chained->endpoint2 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/foo2/10/20/end2/15/25'), 'chained + local (2 args each)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '10, 20; 15, 25', 'Content OK' ); } # # The first three-chain test tries to call the action with :Args(1) # specification. There's also a one action with a :CaptureArgs(1) # attribute, that should not be dispatched to. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->one_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/one/23'), 'three-chain (only first)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 23', 'Content OK' ); } # # This is the second three-chain test, it goes for the action that # handles "/one/$cap/two/$arg1/$arg2" paths. Should be the two action # having :Args(2), not the one having :CaptureArgs(2). # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->one TestApp::Controller::Action::Chained->two_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/one/23/two/23/46'), 'three-chain (up to second)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '23; 23, 46', 'Content OK' ); } # # Last of the three-chain tests. Has no concurrent action with :CaptureArgs # and is more thought to simply test the chain as a whole and the 'two' # action specifying :CaptureArgs. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->one TestApp::Controller::Action::Chained->two TestApp::Controller::Action::Chained->three_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/one/23/two/23/46/three/1/2/3'), 'three-chain (all three)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '23, 23, 46; 1, 2, 3', 'Content OK' ); } # # Tests dispatching on number of arguments for :Args. This should be # dispatched to the action expecting one argument. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->multi1 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/multi/23'), 'multi-action (one arg)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 23', 'Content OK' ); } # # Belongs to the former test and goes for the action expecting two arguments. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->multi2 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/multi/23/46'), 'multi-action (two args)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 23, 46', 'Content OK' ); } # # Dispatching on argument count again, this time we provide too many # arguments, so dispatching should fail. # { my $expected = undef; ok( my $response = request('http://localhost/chained/multi/23/46/67'), 'multi-action (three args, should lead to error)' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->code, 500, 'Status OK' ); } # # This tests the case when an action says it's the child of an action in # a subcontroller. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Foo->higher_root TestApp::Controller::Action::Chained->higher_root TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/higher_root/23/bar/11'), 'root higher than child' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '23; 11', 'Content OK' ); } # # Just a more complex version of the former test. It tests if a controller -> # subcontroller -> controller dispatch works. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->pcp1 TestApp::Controller::Action::Chained::Foo->pcp2 TestApp::Controller::Action::Chained->pcp3 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/pcp1/1/pcp2/2/pcp3/3'), 'parent -> child -> parent' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1, 2; 3', 'Content OK' ); } # # Tests dispatch on capture number. This test is for a one capture action. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->multi_cap1 TestApp::Controller::Action::Chained->multi_cap_end1 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/multi_cap/1/baz'), 'dispatch on capture num 1' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; ', 'Content OK' ); } # # Belongs to the former test. This one goes for the action expecting two # captures. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->multi_cap2 TestApp::Controller::Action::Chained->multi_cap_end2 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/multi_cap/1/2/baz'), 'dispatch on capture num 2' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1, 2; ', 'Content OK' ); } # # Tests the priority of a slurpy arguments action (with :Args) against # two actions chained together. The two actions should win. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->priority_a2 TestApp::Controller::Action::Chained->priority_a2_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/priority_a/1/end/2'), 'priority - slurpy args vs. parent/child' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # This belongs to the former test but tests if two chained actions have # priority over an action with the exact arguments. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->priority_b2 TestApp::Controller::Action::Chained->priority_b2_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/priority_b/1/end/2'), 'priority - fixed args vs. parent/child' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # This belongs to the former test but tests if two chained actions have # priority over an action with one child action not having the Args() attr set. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->priority_c1 TestApp::Controller::Action::Chained->priority_c2_xyz TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/priority_c/1/xyz/'), 'priority - no Args() order mismatch' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; ', 'Content OK' ); } # # Test dispatching between two controllers that are on the same level and # therefor have no parent/child relationship. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Bar->cross1 TestApp::Controller::Action::Chained::Foo->cross2 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/cross/1/end/2'), 'cross controller w/o par/child relation' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # This is for testing if the arguments got passed to the actions # correctly. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::PassedArgs->first TestApp::Controller::Action::Chained::PassedArgs->second TestApp::Controller::Action::Chained::PassedArgs->third TestApp::Controller::Action::Chained::PassedArgs->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/passedargs/a/1/b/2/c/3'), 'Correct arguments passed to actions' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2; 3', 'Content OK' ); } # # The :Args attribute is optional, we check the action not specifying # it with these tests. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->opt_args TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/opt_args/1/2/3'), 'Optional :Args attribute working' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 1, 2, 3', 'Content OK' ); } # # Tests for optional PathPart attribute. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->opt_pp_start TestApp::Controller::Action::Chained->opt_pathpart TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/optpp/1/opt_pathpart/2'), 'Optional :PathName attribute working' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Tests for optional PathPart *and* Args attributes. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->opt_all_start TestApp::Controller::Action::Chained->oa TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/optall/1/oa/2/3'), 'Optional :PathName *and* :Args attributes working' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2, 3', 'Content OK' ); } # # Test if :Chained is the same as :Chained('/') # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->rootdef TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/rootdef/23'), ":Chained is the same as :Chained('/')" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; 23', 'Content OK' ); } # # Test if :Chained('.') is working # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->parentchain TestApp::Controller::Action::Chained::ParentChain->child TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/parentchain/1/child/2'), ":Chained('.') chains to parent controller action" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test if :Chained('../act') is working # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->one TestApp::Controller::Action::Chained::ParentChain->chained_rel TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/one/1/chained_rel/3/2'), ":Chained('../action') chains to correct action" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 3, 2', 'Content OK' ); } # # Test if ../ works to go up more than one level # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->one TestApp::Controller::Action::Chained::ParentChain::Relative->chained_rel_two TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/one/1/chained_rel_two/42/23'), "../ works to go up more than one level" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 42, 23', 'Content OK' ); } # # Test if :ChainedParent is working # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->loose TestApp::Controller::Action::Chained::ParentChain->loose TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/loose/4/loose/a/b'), ":Chained('../action') chains to correct action" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '4; a, b', 'Content OK' ); } # # Test if :Chained('../name/act') is working # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Bar->cross1 TestApp::Controller::Action::Chained::ParentChain->up_down TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/cross/4/up_down/5'), ":Chained('../action') chains to correct action" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '4; 5', 'Content OK' ); } # # Test behaviour of auto actions returning '1' for the chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Auto->auto TestApp::Controller::Action::Chained::Auto::Foo->auto TestApp::Controller::Action::Chained::Auto->foo TestApp::Controller::Action::Chained::Auto::Foo->fooend TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/autochain1/1/fooend/2'), "Behaviour when auto returns 1 correct" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test behaviour of auto actions returning '0' for the chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Auto->auto TestApp::Controller::Action::Chained::Auto::Bar->auto TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/autochain2/1/barend/2'), "Behaviour when auto returns 0 correct" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test what auto actions are run when namespaces are changed # horizontally. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Auto->auto TestApp::Controller::Action::Chained::Auto::Foo->auto TestApp::Controller::Action::Chained::Auto::Bar->crossloose TestApp::Controller::Action::Chained::Auto::Foo->crossend TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/auto_cross/1/crossend/2'), "Correct auto actions are run on cross controller dispatch" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test forwarding from auto action in chain dispatch. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Auto->auto TestApp::Controller::Action::Chained::Auto::Forward->auto TestApp::Controller::Action::Chained::Auto->fw3 TestApp::Controller::Action::Chained::Auto->fw1 TestApp::Controller::Action::Chained::Auto::Forward->forwardend TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/auto_forward/1/forwardend/2'), "Forwarding out of auto in chain" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Detaching out of the auto action of a chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::Auto->auto TestApp::Controller::Action::Chained::Auto::Detach->auto TestApp::Controller::Action::Chained::Auto->fw3 TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/auto_detach/1/detachend/2'), "Detaching out of auto in chain" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test forwarding from auto action in chain dispatch. # { my $expected = undef; ok( my $response = request('http://localhost/chained/loose/23'), "Loose end is not callable" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->code, 500, 'Status OK' ); } # # Test forwarding out of a chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->chain_fw_a TestApp::Controller::Action::Chained->fw_dt_target TestApp::Controller::Action::Chained->chain_fw_b TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/chain_fw/1/end/2'), "Forwarding out a chain" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test detaching out of a chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->chain_dt_a TestApp::Controller::Action::Chained->fw_dt_target TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/chain_dt/1/end/2'), "Forwarding out a chain" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '1; 2', 'Content OK' ); } # # Test throwing an error in the middle of a chain. # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->chain_die_a TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/chain_die/1/end/2'), "Break a chain in the middle" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'FATAL ERROR: break in the middle of a chain', 'Content OK' ); } # # Tests that an uri_for to a chained root index action # returns the right value. # { ok( my $response = request( 'http://localhost/action/chained/to_root' ), 'uri_for with chained root action as arg' ); like( $response->content, qr(URI:https?://[^/]+/), 'Correct URI generated' ); } # # Test interception of recursive chains. This test was added because at # one point during the :Chained development, Catalyst used to hang on # recursive chains. # { eval { require 'TestAppChainedRecursive.pm' }; if ($run_number == 1) { ok( ! $@, "Interception of recursive chains" ); } else { pass( "Interception of recursive chains already tested" ) } } # # Test failure of absolute path part arguments. # { eval { require 'TestAppChainedAbsolutePathPart.pm' }; if ($run_number == 1) { like( $@, qr(foo/foo), "Usage of absolute path part argument emits error" ); } else { pass( "Error on absolute path part arguments already tested" ) } } # # Test chained actions in the root controller # { my @expected = qw[ TestApp::Controller::Action::Chained::Root->rootsub TestApp::Controller::Action::Chained::Root->endpointsub TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/rootsub/1/endpointsub/2'), 'chained in root namespace' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '', 'Content OK' ); } # # Complex path with multiple empty pathparts # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->mult_nopp_base TestApp::Controller::Action::Chained->mult_nopp_all TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/mult_nopp'), "Complex path with multiple empty pathparts" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; ', 'Content OK' ); } # # Complex path with multiple non-capturing pathparts # PathPart('') CaptureArgs(0), PathPart('foo') CaptureArgs(0), PathPart('') Args(0) # should win over PathPart('') CaptureArgs(1), PathPart('') Args(0) # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->mult_nopp2_base TestApp::Controller::Action::Chained->mult_nopp2_nocap TestApp::Controller::Action::Chained->mult_nopp2_action TestApp::Controller::Action::Chained->mult_nopp2_action_default TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/mult_nopp2/action'), "Complex path with multiple non-capturing pathparts" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, '; ', 'Content OK' ); } # # Higher Args() hiding more specific CaptureArgs chains sections # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->cc_base TestApp::Controller::Action::Chained->cc_link TestApp::Controller::Action::Chained->cc_anchor TestApp::Controller::Action::Chained->end ]; my $expected = join ', ', @expected; ok( my $response = request('http://localhost/chained/choose_capture/anchor.html'), 'Choose between an early Args() and a later more ideal chain' ); is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions'); is( $response->content => '; ', 'Content OK' ); } # # Less specific chain not being seen correctly due to earlier looser capture # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->cc_base TestApp::Controller::Action::Chained->cc_b TestApp::Controller::Action::Chained->cc_b_link TestApp::Controller::Action::Chained->cc_b_anchor TestApp::Controller::Action::Chained->end ]; my $expected = join ', ', @expected; ok( my $response = request('http://localhost/chained/choose_capture/b/a/anchor.html'), 'Choose between a more specific chain and an earlier looser one' ); is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions'); is( $response->content => 'a; ', 'Content OK' ); } # # Check we get the looser one when it's the correct match # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->cc_base TestApp::Controller::Action::Chained->cc_a TestApp::Controller::Action::Chained->cc_a_link TestApp::Controller::Action::Chained->cc_a_anchor TestApp::Controller::Action::Chained->end ]; my $expected = join ', ', @expected; ok( my $response = request('http://localhost/chained/choose_capture/a/a/anchor.html'), 'Choose between a more specific chain and an earlier looser one' ); is( $response->header('X-Catalyst-Executed') => $expected, 'Executed actions'); is( $response->content => 'a; anchor.html', 'Content OK' ); } # CaptureArgs(1) PathPart('...') should win over CaptureArgs(2) PathPart('') { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::CaptureArgs->base TestApp::Controller::Action::Chained::CaptureArgs->one_arg TestApp::Controller::Action::Chained::CaptureArgs->edit_one_arg TestApp::Controller::Action::Chained::CaptureArgs->end ]; my $expected = join( ", ", @expected ); # should dispatch to /base/one_args/edit_one_arg ok( my $response = request('http://localhost/captureargs/one/edit'), 'Correct arg order ran' ); TODO: { local $TODO = 'Known bug'; is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'base; one_arg; edit_one_arg', 'Content OK' ); } } # PathPart('...') Args(1) should win over CaptureArgs(2) PathPart('') { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::CaptureArgs->base TestApp::Controller::Action::Chained::CaptureArgs->test_one_arg TestApp::Controller::Action::Chained::CaptureArgs->end ]; my $expected = join( ", ", @expected ); # should dispatch to /base/test_one_arg ok( my $response = request('http://localhost/captureargs/test/one'), 'Correct pathpart/arg ran' ); TODO: { local $TODO = 'Known bug'; is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'base; test_plus_arg; one;', 'Content OK' ); } } # # Args(0) should win over Args() if we actually have no arguments. { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::ArgsOrder->base TestApp::Controller::Action::Chained::ArgsOrder->index TestApp::Controller::Action::Chained::ArgsOrder->end ]; my $expected = join( ", ", @expected ); # With no args, we should run "index" ok( my $response = request('http://localhost/argsorder/'), 'Correct arg order ran' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'base; ; index; ', 'Content OK' ); # With args given, run "all" ok( $response = request('http://localhost/argsorder/X'), 'Correct arg order ran' ); is( $response->header('X-Catalyst-Executed'), join(", ", qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained::ArgsOrder->base TestApp::Controller::Action::Chained::ArgsOrder->all TestApp::Controller::Action::Chained::ArgsOrder->end ]) ); is( $response->content, 'base; ; all; X', 'Content OK' ); } # # 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' ); } # # static paths vs. captures # { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->apan TestApp::Controller::Action::Chained->korv TestApp::Controller::Action::Chained->static_end TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/chained/static_end'), "static paths are prefered over captures" ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); } # # */search # doc/* # # request for doc/search should end up in doc/* { my @expected = qw[ TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->doc_star TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/doc/search'), "we prefer static path parts earlier in the chain" ); TODO: { local $TODO = 'gbjk never got off his ass and fixed this'; is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); } } { ok( my $content = get('http://localhost/chained/capture%2Farg%3B/return_arg/foo%2Fbar%3B'), 'request with URI-encoded arg' ); like( $content, qr{foo/bar;\z}, 'args decoded' ); like( $content, qr{capture/arg;}, 'captureargs decoded' ); } { ok( my $content = get('http://localhost/chained/return_arg_decoded/foo%2Fbar%3B'), 'request with URI-encoded arg' ); like( $content, qr{foo/bar;\z}, 'args decoded' ); } # Test round tripping, specifically the / character %2F in uri_for: # not being able to feed it back action + captureargs and args into uri for # and result in the original request uri is a major piece of suck ;) foreach my $thing ( ['foo', 'bar'], ['foo%2Fbar', 'baz'], ['foo', 'bar%2Fbaz'], ['foo%2Fbar', 'baz%2Fquux'], ['foo%2Fbar', 'baz%2Fquux', { foo => 'bar', 'baz' => 'quux%2Ffrood'}], ['foo%2Fbar', 'baz%2Fquux', { foo => 'bar', 'baz%2Ffnoo' => 'quux%2Ffrood'}], ['h%C3%BCtte', 'h%C3%BCtte', { test => 'h%C3%BCtte' } ], ) { my $path = '/chained/roundtrip_urifor/' . $thing->[0] . '/' . $thing->[1]; $path .= '?' . join('&', map { $_ .'='. $thing->[2]->{$_}} sort keys %{$thing->[2]}) if $thing->[2]; ok( my $content = get('http://localhost/' . $path), 'request ' . $path . ' ok'); my $exp = URI->new('http://localhost:3000' . $path); my ($want) = $content =~ m{/chained/(.*)}; my $got = URI->new('http://localhost:3000/chained/' . $want); # Just check that the path matches, as who the hell knows or cares # where the app is based (live tests etc) is $got->path, $exp->path, "uri $path can round trip through uri_for (path)" or diag("Expected $path, got $content"); is_deeply $got->query_form_hash, $exp->query_form_hash, "uri $path can round trip through uri_for (query)" or diag("Expected $path, got $content"); } # # match_captures # { ok( my $response = request('http://localhost/chained/match_captures/foo/bar'), 'match_captures: falling through' ); is($response->header('X-TestAppActionTestMatchCaptures'), 'fallthrough', 'match_captures: fell through'); ok($response = request('http://localhost/chained/match_captures/force/bar'), 'match_captures: *not* falling through' ); is($response->header('X-TestAppActionTestMatchCaptures'), 'forcing', 'match_captures: forced'); is($response->header('X-TestAppActionTestMatchCapturesHasRan'), 'yes', 'match_captures: actually ran'); } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_chained2.t000644 000765 000024 00000001567 12121675274 030161 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Catalyst::Test 'ChainedActionsApp'; use Test::More; plan 'skip_all' if $ENV{CATALYST_SERVER}; # This is not TestApp content_like('/', qr/Application Home Page/, 'Application home'); content_like('/15/GoldFinger', qr/List project GoldFinger pages/, 'GoldFinger Project Index'); content_like('/15/GoldFinger/4/007', qr/This is 007 page of GoldFinger project/, '007 page in GoldFinger Project'); content_like('/account', qr/New account o login/, 'no account'); content_like('/account/ferz', qr/This is account ferz/, '/account/ferz'); content_like('/account/123', qr/This is account 123/, '/account/123'); content_like('/account/profile/007/James Bond', qr/This is profile of James Bond/, 'account'); content_like('/downloads/', qr/This is download index/, 'downloads'); action_notfound('/c'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_default.t000644 000765 000024 00000005347 12217110343 030113 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 16 * $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::Default->begin TestApp::Controller::Action::Default->default TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/default'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Default', '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' ); ok( $response = request('http://localhost/foo/bar/action'), 'Request' ); is( $response->code, 500, 'Invalid URI returned 500' ); } # test that args are passed properly to default { my $creq; my $expected = [qw/action default arg1 arg2/]; ok( my $response = request('http://localhost/action/default/arg1/arg2'), 'Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ) or fail("EXCEPTION $@ DESERIALIZING " . $response->content); is_deeply( $creq->{arguments}, $expected, 'Arguments ok' ); } # Test that /foo and /foo/ both do the same thing { my @expected = qw[ TestApp::Controller::Action->begin TestApp::Controller::Action->default TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action'), 'Request' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions for /action' ); ok( $response = request('http://localhost/action/'), 'Request' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions for /action/' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_detach.t000644 000765 000024 00000005530 12217110343 027711 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 18*$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::Detach->begin TestApp::Controller::Action::Detach->one TestApp::Controller::Action::Detach->two TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); # Test detach to chain of actions. ok( my $response = request('http://localhost/action/detach/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/detach/one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Detach', 'Test Class' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); } { my @expected = qw[ TestApp::Controller::Action::Detach->begin TestApp::Controller::Action::Detach->path TestApp::Controller::Action::Detach->two TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); # Test detach to chain of actions. ok( my $response = request('http://localhost/action/detach/path'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/detach/path', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Detach', 'Test Class' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); } { ok( my $response = request('http://localhost/action/detach/with_args/old'), 'Request with args' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'new' ); } { ok( my $response = request( 'http://localhost/action/detach/with_method_and_args/old'), 'Request with args and method' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'new' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_die_in_end.t000644 000765 000024 00000001014 12217110343 030527 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 2*$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 { ok( my $response = request('http://localhost/action/die_in_end'), 'Request' ); ok( !$response->is_success, 'generates a 500 error' ); } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_end.t000644 000765 000024 00000002557 12217110343 027235 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 7*$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::End->begin TestApp::Controller::Action::End->default TestApp::View::Dump::Request->process TestApp::Controller::Action::End->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/end'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::End', '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' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_forward.t000644 000765 000024 00000021064 12227005123 030125 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 53 * $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::Forward->begin TestApp::Controller::Action::Forward->one TestApp::Controller::Action::Forward->two TestApp::Controller::Action::Forward->three TestApp::Controller::Action::Forward->four TestApp::Controller::Action::Forward->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); # Test forward to global private action ok( my $response = request('http://localhost/action/forward/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/forward/global', 'Main Class Action' ); # Test forward to chain of actions. ok( $response = request('http://localhost/action/forward/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/forward/one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Forward', '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::Forward->begin TestApp::Controller::Action::Forward->jojo TestApp::Controller::Action::Forward->one TestApp::Controller::Action::Forward->two TestApp::Controller::Action::Forward->three TestApp::Controller::Action::Forward->four TestApp::Controller::Action::Forward->five TestApp::View::Dump::Request->process TestApp::Controller::Action::Forward->three TestApp::Controller::Action::Forward->four TestApp::Controller::Action::Forward->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/forward/jojo'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/forward/jojo', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Forward', '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' ); } { ok( my $response = request('http://localhost/action/forward/with_args/old'), 'Request with args' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'old' ); } { ok( my $response = request( 'http://localhost/action/forward/with_method_and_args/old'), 'Request with args and method' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'old' ); } # test forward with embedded args { ok( my $response = request('http://localhost/action/forward/args_embed_relative'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'ok' ); } { ok( my $response = request('http://localhost/action/forward/args_embed_absolute'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'ok' ); } { my @expected = qw[ TestApp::Controller::Action::TestRelative->begin TestApp::Controller::Action::TestRelative->relative TestApp::Controller::Action::Forward->one TestApp::Controller::Action::Forward->two TestApp::Controller::Action::Forward->three TestApp::Controller::Action::Forward->four TestApp::Controller::Action::Forward->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); # Test forward to chain of actions. ok( my $response = request('http://localhost/action/relative/relative'), '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', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::TestRelative', '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->begin TestApp::Controller::Action::TestRelative->relative_two TestApp::Controller::Action::Forward->one TestApp::Controller::Action::Forward->two TestApp::Controller::Action::Forward->three TestApp::Controller::Action::Forward->four TestApp::Controller::Action::Forward->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); # Test forward to chain of actions. ok( my $response = request('http://localhost/action/relative/relative_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_two', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::TestRelative', '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 forwards { ok( my $response = request( 'http://localhost/action/forward/class_forward_test_action'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header('X-Class-Forward-Test-Method'), 1, 'Test Method' ); } # test uri_for re r7385 { ok( my $response = request( 'http://localhost/action/forward/forward_to_uri_check'), 'forward_to_uri_check request'); ok( $response->is_success, 'forward_to_uri_check successful'); is( $response->content, 'action/forward/foo/bar', 'forward_to_uri_check correct namespace'); } # test forwarding to Catalyst::Action objects { ok( my $response = request( 'http://localhost/action/forward/to_action_object'), 'forward/to_action_object request'); ok( $response->is_success, 'forward/to_action_object successful'); is( $response->content, 'mtfnpy', 'forward/to_action_object forwards correctly'); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_global.t000644 000765 000024 00000004531 12217110343 027721 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 18*$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 { { ok( my $response = request('http://localhost/action_global_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_global_one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Global', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_global_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_global_two', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Global', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action_global_three'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action_global_three', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Global', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_go.t000644 000765 000024 00000021574 12217110343 027074 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 54 * $iters; use Catalyst; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { { # 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' ); } { 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::Controller::Root->end ]; @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected; my $expected = join( ", ", @expected ); # Test go to chain of actions. ok( my $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::Controller::Root->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/model'), 'Request with args' ); is( $response->content, q[FATAL ERROR: Couldn't go("Model::Foo"): Action cannot _DISPATCH. Did you try to go() a non-controller action?], q[go('Model::...') test] ); } { ok( my $response = request('http://localhost/action/go/view'), 'Request with args' ); is( $response->content, q[FATAL ERROR: Couldn't go("View::Dump"): Action cannot _DISPATCH. Did you try to go() a non-controller action?], q[go('View::...') test] ); } { 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', 'go() with args (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', 'go() with args (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', 'go() with args_embed_relative' ); } { ok( my $response = request('http://localhost/action/go/args_embed_absolute'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'ok', 'go() with args_embed_absolute' ); } { 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::Controller::Root->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::Controller::Root->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 -- MUST FAIL! { ok( my $response = request( 'http://localhost/action/go/class_go_test_action'), 'Request' ); 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 an :Action of some sort.), 'Error message' ); } { my @expected = qw[ TestApp::Controller::Action::Go->begin TestApp::Controller::Action::Go->go_chained TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->foo TestApp::Controller::Action::Chained::Foo->spoon TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); 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, 'captureme; arg1, arg2', 'Content OK' ); } } sub _begin { local $_ = shift; s/->(.*)$/->begin/; return $_; } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_index.t000644 000765 000024 00000006305 12217110343 027571 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 20*$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 { # test root index { my @expected = qw[ TestApp::Controller::Root->index TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/'), 'root index' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'root index', 'root index ok' ); ok( $response = request('http://localhost'), 'root index no slash' ); is( $response->content, 'root index', 'root index no slash ok' ); } # test first-level controller index { my @expected = qw[ TestApp::Controller::Index->index TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/index/'), 'first-level controller index' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'Index index', 'first-level controller index ok' ); ok( $response = request('http://localhost/index'), 'first-level controller index no slash' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'Index index', 'first-level controller index no slash ok' ); } # test second-level controller index { my @expected = qw[ TestApp::Controller::Action::Index->begin TestApp::Controller::Action::Index->index TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/index/'), 'second-level controller index' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'Action-Index index', 'second-level controller index ok' ); ok( $response = request('http://localhost/action/index'), 'second-level controller index no slash' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, 'Action-Index index', 'second-level controller index no slash ok' ); } # test controller default when index is present { my @expected = qw[ TestApp::Controller::Action::Index->begin TestApp::Controller::Action::Index->default TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/index/foo'), 'default with index' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, "Error - TestApp::Controller::Action\n", 'default with index ok' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_index_or_default.t000644 000765 000024 00000001776 12217110343 032004 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestAppIndexDefault'; plan 'skip_all' if ( $ENV{CATALYST_SERVER} ); plan tests => 6*$iters; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { is(get('/indexchained'), 'index_chained', ':Chained overrides index'); is(get('/indexprivate'), 'index_private', 'index : Private still works'); # test :Path overriding default is(get('/one_arg'), 'path_one_arg', ':Path overrides default'); is(get('/one_arg/foo/bar'), 'default', 'default still works'); # now the same thing with a namespace, and a trailing / on the :Path is(get('/default/one_arg'), 'default_path_one_arg', ':Path overrides default'); is(get('/default/one_arg/foo/bar'), 'default_default', 'default still works'); } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_inheritance.t000644 000765 000024 00000007574 12217110343 030764 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 21*$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::Inheritance->begin TestApp::Controller::Action::Inheritance->auto TestApp::Controller::Action::Inheritance->default TestApp::View::Dump::Request->process TestApp::Controller::Action::Inheritance->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/inheritance'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance', '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::Inheritance::A->begin TestApp::Controller::Action::Inheritance->auto TestApp::Controller::Action::Inheritance::A->auto TestApp::Controller::Action::Inheritance::A->default TestApp::View::Dump::Request->process TestApp::Controller::Action::Inheritance::A->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/inheritance/a'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance::A', '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::Inheritance::A::B->begin TestApp::Controller::Action::Inheritance->auto TestApp::Controller::Action::Inheritance::A->auto TestApp::Controller::Action::Inheritance::A::B->auto TestApp::Controller::Action::Inheritance::A::B->default TestApp::View::Dump::Request->process TestApp::Controller::Action::Inheritance::A::B->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/inheritance/a/b'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'default', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Inheritance::A::B', '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' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_local.t000644 000765 000024 00000010752 12217110343 027555 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 34*$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 { { ok( my $response = request('http://localhost/action/local/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/local/one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Local', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/local/two/1/2'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/local/two', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Local', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/local/two'), 'Request' ); ok( !$response->is_success, 'Request with wrong number of args failed' ); } { ok( my $response = request('http://localhost/action/local/three'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/local/three', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Local', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/local/four/five/six'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/local/four/five/six', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Local', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "tests for %2F on remote server", 6; } ok( my $response = request('http://localhost/action/local/one/foo%2Fbar'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/local/one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Local', 'Test Class' ); my $content = $response->content; { local $@; my $request = eval $content; if ($@) { fail("Content cannot be unserialized: $@ $content"); } else { is_deeply $request->arguments, ['foo/bar'], "Parameters don't split on %2F"; } } } { ok( my $content = get('http://locahost/action/local/five/foo%2Fbar%3B'), 'request with URI-encoded arg'); # this is the CURRENT behavior like( $content, qr{'foo/bar;'}, 'args for Local actions URI-decoded' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_multipath.t000644 000765 000024 00000003477 12217110343 030500 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; my $content = q/foo bar baz /; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 16*$iters; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests($content); } } sub run_tests { my ($content) = @_; # Local { ok( my $response = request('http://localhost/action/multipath/multipath'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content, $content, 'Content is a stream' ); } # Global { ok( my $response = request('http://localhost/multipath'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content, $content, 'Content is a stream' ); } # Path('/multipath1') { ok( my $response = request('http://localhost/multipath1'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content, $content, 'Content is a stream' ); } # Path('multipath2') { ok( my $response = request('http://localhost/action/multipath/multipath2'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content, $content, 'Content is a stream' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_path.t000644 000765 000024 00000012066 12217110343 027417 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 42*$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 { { ok( my $response = request('http://localhost/action/path/a%20path%20with%20spaces'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path/a%20path%20with%20spaces', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/path/åäö'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path/%C3%A5%C3%A4%C3%B6', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/path/'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/path/spaces_near_parens_singleq'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path/spaces_near_parens_singleq', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/path/spaces_near_parens_doubleq'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path/spaces_near_parens_doubleq', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/0'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), '0', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Root', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } { ok( my $response = request('http://localhost/action/path/six'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'action/path/six', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Path', 'Test Class' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_path_matchsingle.t000644 000765 000024 00000001262 12217110343 031771 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestAppMatchSingleArg'; plan 'skip_all' if ( $ENV{CATALYST_SERVER} ); plan tests => 3*$iters; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { { is(get('/foo/bar/baz'), 'Path', 'multiple args matched :Path'); is(get('/foo'), 'Path Args(1)', 'single arg matched :Path Args(1)'); is(get('/foo/bar'), 'Path Args(2)', 'two args matched :Path Args(2)'); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_private.t000644 000765 000024 00000005065 12217110343 030136 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 24*$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 { { ok( my $response = request('http://localhost/action/private/one'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' ); is( $response->content, 'access denied', 'Access' ); } { ok( my $response = request('http://localhost/action/private/two'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' ); is( $response->content, 'access denied', 'Access' ); } { ok( my $response = request('http://localhost/three'), 'Request' ); ok( $response->is_error, 'Response Server Error 5xx' ); is( $response->content_type, 'text/html', 'Response Content-Type' ); like( $response->header('X-Catalyst-Error'), qr/^Unknown resource "three"/, 'Catalyst Error' ); } { ok( my $response = request('http://localhost/action/private/four'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' ); is( $response->content, 'access denied', 'Access' ); } { ok( my $response = request('http://localhost/action/private/five'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Private', 'Test Class' ); is( $response->content, 'access denied', 'Access' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_streaming.t000644 000765 000024 00000006411 12217110343 030451 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { # test direct streaming { ok( my $response = request('http://localhost/streaming'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' ); is( $response->header('X-Test-Header-Call-Count'), 1); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 1; } ok(!defined $response->content_length, 'No Content-Length for streaming responses'); is(length $response->content, 12, 'Response content' ); } is( $response->content,, <<'EOF', 'Content is a stream' ); foo bar baz EOF } # test streaming by passing a handle to $c->res->body SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 10; } my $file = "$FindBin::Bin/../lib/TestApp/Controller/Action/Streaming.pm"; my $fh = IO::File->new( $file, 'r' ); my $buffer; if ( defined $fh ) { $fh->read( $buffer, 2048 ); $fh->close; } ok( my $response = request('http://localhost/action/streaming/body'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content_length, -s $file, 'Response Content-Length' ); is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' ); is( $response->header('X-Test-Header-Call-Count'), 1); is( $response->content, $buffer, 'Content is read from filehandle' ); ok( $response = request('http://localhost/action/streaming/body_glob'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content_length, -s $file, 'Response Content-Length' ); is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' ); is( $response->header('X-Test-Header-Call-Count'), 1); is( $response->content, $buffer, 'Content is read from filehandle' ); } { my $size = 128 * 1024; # more than one read with the default chunksize ok( my $response = request('http://localhost/action/streaming/body_large'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Test-Header'), 'valid', 'Headers sent properly' ); is( $response->header('X-Test-Header-Call-Count'), 1); is( $response->content_length, $size, 'Response Content-Length' ); is( $response->content, "\0" x $size, 'Content is read from filehandle' ); } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_action_visit.t000644 000765 000024 00000023431 12217110343 027617 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More tests => 60 * $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 { { # Test visit to global private action ok( my $response = request('http://localhost/action/visit/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/visit/global', 'Main Class Action' ); } { my @expected = qw[ TestApp::Controller::Action::Visit->one TestApp::Controller::Action::Visit->two TestApp::Controller::Action::Visit->three TestApp::Controller::Action::Visit->four TestApp::Controller::Action::Visit->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end ]; @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected; my $expected = join( ", ", @expected ); # Test visit to chain of actions. ok( my $response = request('http://localhost/action/visit/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/visit/one', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Visit', '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::Visit->visit_die TestApp::Controller::Action::Visit->args TestApp::Controller::Root->end TestApp::Controller::Root->end ]; @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/action/visit/visit_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/visit/visit_die', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Visit', 'Test Class' ); is( $response->header('X-Catalyst-Executed'), $expected, 'Executed actions' ); is( $response->content, "visit() doesn't die", "Visit does not die" ); } { ok( my $response = request('http://localhost/action/visit/model'), 'Request with args' ); is( $response->content, q[FATAL ERROR: Couldn't visit("Model::Foo"): Action cannot _DISPATCH. Did you try to visit() a non-controller action?] ); } { ok( my $response = request('http://localhost/action/visit/view'), 'Request with args' ); is( $response->content, q[FATAL ERROR: Couldn't visit("View::Dump"): Action cannot _DISPATCH. Did you try to visit() a non-controller action?] ); } { ok( my $response = request('http://localhost/action/visit/with_args/old'), 'Request with args' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'old', 'visit() with args (old)' ); } { ok( my $response = request( 'http://localhost/action/visit/with_method_and_args/new'), 'Request with args and method' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'new', 'visit() with args (new)' ); } # test visit with embedded args { ok( my $response = request('http://localhost/action/visit/args_embed_relative'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'ok', 'visit() with args_embed_relative' ); } { ok( my $response = request('http://localhost/action/visit/args_embed_absolute'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'ok', 'visit() with args_embed_absolute' ); } { my @expected = qw[ TestApp::Controller::Action::TestRelative->relative_visit TestApp::Controller::Action::Visit->one TestApp::Controller::Action::Visit->two TestApp::Controller::Action::Visit->three TestApp::Controller::Action::Visit->four TestApp::Controller::Action::Visit->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end ]; @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected; my $expected = join( ", ", @expected ); # Test visit to chain of actions. ok( my $response = request('http://localhost/action/relative/relative_visit'), '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_visit', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Visit', '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_visit_two TestApp::Controller::Action::Visit->one TestApp::Controller::Action::Visit->two TestApp::Controller::Action::Visit->three TestApp::Controller::Action::Visit->four TestApp::Controller::Action::Visit->five TestApp::View::Dump::Request->process TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end TestApp::Controller::Root->end ]; @expected = map { /Action/ ? (_begin($_), $_) : ($_) } @expected; my $expected = join( ", ", @expected ); # Test visit to chain of actions. ok( my $response = request('http://localhost/action/relative/relative_visit_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_visit_two', 'Test Action' ); is( $response->header('X-Test-Class'), 'TestApp::Controller::Action::Visit', '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 visit -- MUST FAIL! { ok( my $response = request( 'http://localhost/action/visit/class_visit_test_action'), 'Request' ); 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 an :Action of some sort.}, "Cannot visit app namespace" ); } { my @expected = qw[ TestApp::Controller::Action::Visit->begin TestApp::Controller::Action::Visit->visit_chained TestApp::Controller::Action::Chained->begin TestApp::Controller::Action::Chained->foo TestApp::Controller::Action::Chained::Foo->spoon TestApp::Controller::Action::Chained->end TestApp::Controller::Root->end ]; my $expected = join( ", ", @expected ); 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, "becomescapture; arg1, arg2", "Content OK for $i" ); } } } sub _begin { local $_ = shift; s/->(.*)$/->begin/; return $_; } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_actionroles.t000644 000765 000024 00000001531 12121675274 027460 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/../lib"; use Catalyst::Test 'TestApp'; my %roles = ( foo => 'TestApp::ActionRole::Moo', bar => 'TestApp::ActionRole::Moo', baz => 'Moo', quux => 'Catalyst::ActionRole::Zoo', ); while (my ($path, $role) = each %roles) { my $resp = request("/actionroles/${path}"); ok($resp->is_success); is($resp->content, $role); is($resp->header('X-Affe'), 'Tiger'); } { my $resp = request("/actionroles/corge"); ok($resp->is_success); is($resp->content, 'TestApp::ActionRole::Moo'); is($resp->header('X-Affe'), 'Tiger'); is($resp->header('X-Action-After'), 'moo'); } { my $resp = request("/actionroles/frew"); ok($resp->is_success); is($resp->content, 'hello', 'action_args are honored with ActionRoles'); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_anon.t000644 000765 000024 00000001617 12106042701 026060 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 6; use Catalyst::Test 'TestApp'; { my $response = request('http://localhost/anon/test'); ok($response->is_success); is($response->header('X-Component-Name-Action'), 'TestApp::Controller::Anon', 'Action can see correct catalyst_component_name'); isnt($response->header('X-Component-Instance-Name-Action'), 'TestApp::Controller::Anon', 'ref($controller) ne catalyst_component_name'); is($response->header('X-Component-Name-Controller'), 'TestApp::Controller::Anon', 'Controller can see correct catalyst_component_name'); is($response->header('X-Class-In-Action'), 'TestApp::Controller::Anon', '$action->class is catalyst_component_name'); is($response->header('X-Anon-Trait-Applied'), '1', 'Anon controller class has trait applied correctly'); } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_args.t000644 000765 000024 00000004323 12217110343 026057 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use URI::Escape; our @paths; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; # add special paths to test here @paths = ( # all reserved in uri's qw~ : / ? [ ] @ ! $ & ' ( ) * + ; = ~, ',' , '#', # unreserved 'a'..'z','A'..'Z',0..9,qw( - . _ ~ ), " ", # just to test %2F/% [ qw~ / / ~ ], # testing %25/%25 [ qw~ % % ~ ], ); } use Test::More tests => 6*@paths * $iters; use Catalyst::Test 'TestApp'; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); # new dispatcher: # 11 wallclock secs (10.14 usr + 0.20 sys = 10.34 CPU) @ 15.18/s (n=157) # old dispatcher (r1486): # 11 wallclock secs (10.34 usr + 0.20 sys = 10.54 CPU) @ 13.76/s (n=145) } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { run_test_for($_) for @paths; } sub run_test_for { my $test = shift; my $path; if (ref $test) { $path = join "/", map uri_escape($_), @$test; $test = join '', @$test; } else { $path = uri_escape($test); } SKIP: { # Skip %2F, ., [, (, and ) tests on real webservers # Both Apache and lighttpd don't seem to like these if ( $ENV{CATALYST_SERVER} && $path =~ /(?:%2F|\.|%5B|\(|\))/ ) { skip "Skipping $path tests on remote server", 6; } my $response; ok( $response = request("http://localhost/args/args/$path"), "Requested /args/args/$path"); is( $response->content, $test, "$test as args" ); undef $response; ok( $response = request("http://localhost/args/params/$path"), "Requested /args/params/$path"); is( $response->content, $test, "response content $test as params" ); undef $response; if( $test =~ m{/} ) { $test =~ s{/}{}g; $path = uri_escape( $test ); } ok( $response = request("http://localhost/chained/multi_cap/$path/baz"), "Requested capture for path $path"); is( $response->content, join( ', ', split( //, $test ) ) ."; ", "$test as capture" ); } } Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_attributes.t000644 000765 000024 00000002527 12217110343 027315 0ustar00johnstaff000000 000000 use strict; use warnings; use Data::Dumper; $Data::Dumper::Maxdepth=1; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 13; use Catalyst::Test 'TestApp'; sub ok_actions { my ($response, $actions, $msg) = @_; my $expected = join ", ", (map { "TestApp::Controller::Attributes->$_" } @$actions), 'TestApp::Controller::Root->end'; is( $response->header('x-catalyst-executed') => $expected, $msg || 'Executed correct acitons'); } ok( my $response = request('http://localhost/attributes/view'), 'get /attributes/view' ); ok( !$response->is_success, 'Response Unsuccessful' ); ok( $response = request('http://localhost/attributes/foo'), "get /attributes/foo" ); ok_actions($response => ['foo']); ok( $response = request('http://localhost/attributes/all_attrs'), "get /attributes/all_attrs" ); ok( $response->is_success, "Response OK" ); ok_actions($response => [qw/fetch all_attrs_action/]); ok( $response = request('http://localhost/attributes/some_attrs'), "get /attributes/some_attrs" ); ok( $response->is_success, "Response OK" ); ok_actions($response => [qw/fetch some_attrs_action/]); ok( $response = request('http://localhost/attributes/one_attr'), "get /attributes/one_attr" ); ok( $response->is_success, "Response OK" ); ok_actions($response => [qw/fetch one_attr_action/]); Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_httpmethods.t000644 000765 000024 00000003000 12121675274 027472 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common qw/GET POST DELETE PUT /; use FindBin; use lib "$FindBin::Bin/../lib"; use Catalyst::Test 'TestApp'; is(request(GET '/httpmethods/foo')->content, 'get'); is(request(POST '/httpmethods/foo')->content, 'post'); is(request(DELETE '/httpmethods/foo')->content, 'default'); is(request(GET '/httpmethods/bar')->content, 'get or post'); is(request(POST '/httpmethods/bar')->content, 'get or post'); is(request(DELETE '/httpmethods/bar')->content, 'default'); is(request(GET '/httpmethods/baz')->content, 'any'); is(request(POST '/httpmethods/baz')->content, 'any'); is(request(DELETE '/httpmethods/baz')->content, 'any'); is(request(GET '/httpmethods/chained_get')->content, 'chained_get'); is(request(POST '/httpmethods/chained_post')->content, 'chained_post'); is(request(PUT '/httpmethods/chained_put')->content, 'chained_put'); is(request(DELETE '/httpmethods/chained_delete')->content, 'chained_delete'); is(request(GET '/httpmethods/get_put_post_delete')->content, 'get2'); is(request(POST '/httpmethods/get_put_post_delete')->content, 'post2'); is(request(PUT '/httpmethods/get_put_post_delete')->content, 'put2'); is(request(DELETE '/httpmethods/get_put_post_delete')->content, 'delete2'); is(request(GET '/httpmethods/check_default')->content, 'get3'); is(request(POST '/httpmethods/check_default')->content, 'post3'); is(request(PUT '/httpmethods/check_default')->content, 'chain_default'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_component_controller_moose.t000644 000765 000024 00000002415 12106042701 026244 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 12; use Catalyst::Test 'TestApp'; { my $response = request('http://localhost/moose/get_attribute'); ok($response->is_success); is($response->content, '42', 'attribute default values get set correctly'); } { my $response = request('http://localhost/moose/methodmodifiers/get_attribute'); ok($response->is_success); is($response->content, '42', 'parent controller method called'); is($response->header('X-Catalyst-Test-After'), 'after called', 'after works as expected'); } { my $response = request('http://localhost/moose/with_local_modifier'); ok($response->is_success); is($response->content, '42', 'attribute default values get set correctly'); is($response->header('X-Catalyst-Test-Before'), 'before called', 'before works as expected'); } { my $response = request('http://localhost/moose/methodmodifiers/with_local_modifier'); ok($response->is_success); is($response->content, '42', 'attribute default values get set correctly'); is($response->header('X-Catalyst-Test-After'), 'after called', 'after works as expected'); is($response->header('X-Catalyst-Test-Before'), 'before called', 'before works as expected'); } Catalyst-Runtime-5.90053/t/aggregate/live_component_view_single.t000644 000765 000024 00000001411 12217110343 025166 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; our $iters; BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; } use Test::More; use Catalyst::Test 'TestAppOneView'; plan 'skip_all' if ( $ENV{CATALYST_SERVER} ); plan tests => 3*$iters; if ( $ENV{CAT_BENCHMARK} ) { require Benchmark; Benchmark::timethis( $iters, \&run_tests ); } else { for ( 1 .. $iters ) { run_tests(); } } sub run_tests { { is(get('/view_by_name?view=Dummy'), 'AClass', '$c->view("name") returns blessed instance'); is(get('/view_by_regex?view=Dummy'), 'AClass', '$c->view(qr/name/) returns blessed instance'); is(get('/view_no_args'), 'AClass', '$c->view() returns blessed instance'); } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_auth.t000644 000765 000024 00000001773 12217110343 024642 0ustar00johnstaff000000 000000 # This tests to make sure the Authorization header is passed through by the engine. use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 7; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; { my $creq; my $request = GET( 'http://localhost/dump/request', 'Authorization' => 'Basic dGVzdDoxMjM0NQ==', ); 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/'Catalyst::Request'/, 'Content is a serialized Catalyst::Request' ); { no strict 'refs'; ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); } isa_ok( $creq, 'Catalyst::Request' ); is( $creq->header('Authorization'), 'Basic dGVzdDoxMjM0NQ==', 'auth header ok' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_body.t000644 000765 000024 00000005052 12217110343 024630 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 23; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; { my $creq; my $request = POST( 'http://localhost/dump/request/', 'Content-Type' => 'text/plain', 'Content' => 'Hello Catalyst' ); 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/'Catalyst::Request'/, '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, 'text/plain', 'Catalyst::Request Content-Type' ); is( $creq->{__body_type}, 'File::Temp' ); is( $creq->content_length, $request->content_length, 'Catalyst::Request Content-Length' ); } { my $creq; my $request = POST( 'http://localhost/dump/request/', 'Content-Type' => 'text/plain', 'Content' => 'x' x 100_000 ); 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, 'text/plain', 'Catalyst::Request Content-Type' ); is( $creq->{__body_type}, 'File::Temp' ); is( $creq->content_length, $request->content_length, 'Catalyst::Request Content-Length' ); } # 5.80 regression, see note in Catalyst::Plugin::Test::Plugin { my $request = GET( 'http://localhost/dump/response', 'Content-Type' => 'text/plain', 'Content' => 'x' x 100_000 ); ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( $response->header('X-Have-Request-Body'), 'X-Have-Request-Body set' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_body_demand.t000644 000765 000024 00000004547 12217110343 026150 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 12; use Catalyst::Test 'TestAppOnDemand'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; # Test a simple POST request to make sure body parsing # works in on-demand mode. SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 12; } { my $params; my $request = POST( 'http://localhost/body/query_params?wibble=wobble', 'Content-Type' => 'application/x-www-form-urlencoded', 'Content' => 'foo=bar&baz=quux' ); my $expected = { wibble => 'wobble' }; ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); { no strict 'refs'; ok( eval '$params = ' . $response->content, 'Unserialize params' ); } is_deeply( $params, $expected, 'Catalyst::Request query parameters' ); } { my $params; my $request = POST( 'http://localhost/body/params?wibble=wobble', 'Content-Type' => 'application/x-www-form-urlencoded', 'Content' => 'foo=bar&baz=quux' ); my $expected = { foo => 'bar', baz => 'quux', wibble => 'wobble' }; ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); { no strict 'refs'; ok( eval '$params = ' . $response->content, 'Unserialize params' ); } is_deeply( $params, $expected, 'Catalyst::Request body and query parameters' ); } # Test reading chunks of the request body using $c->read { my $creq; my $request = POST( 'http://localhost/body/read', 'Content-Type' => 'text/plain', 'Content' => 'x' x 105_000 ); my $expected = '10000|10000|10000|10000|10000|10000|10000|10000|10000|10000|5000'; ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->content, $expected, 'Response Content' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_cookies.t000644 000765 000024 00000002640 12217110343 025327 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 13; use Catalyst::Test 'TestApp'; use Catalyst::Request; use CGI::Simple::Cookie; use HTTP::Headers; use HTTP::Request::Common; use URI; { my $creq; my $request = GET( 'http://localhost/dump/request', 'Cookie' => 'Catalyst=Cool; Cool=Catalyst', ); 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/'Catalyst::Request'/, 'Content is a serialized Catalyst::Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); isa_ok( $creq, 'Catalyst::Request' ); isa_ok( $creq->cookies->{Catalyst}, 'CGI::Simple::Cookie', 'Cookie Catalyst' ); is( $creq->cookies->{Catalyst}->name, 'Catalyst', 'Cookie Catalyst name' ); is( $creq->cookies->{Catalyst}->value, 'Cool', 'Cookie Catalyst value' ); isa_ok( $creq->cookies->{Cool}, 'CGI::Simple::Cookie', 'Cookie Cool' ); is( $creq->cookies->{Cool}->name, 'Cool', 'Cookie Cool name' ); is( $creq->cookies->{Cool}->value, 'Catalyst', 'Cookie Cool value' ); my $cookies = { Catalyst => $creq->cookies->{Catalyst}, Cool => $creq->cookies->{Cool} }; is_deeply( $creq->cookies, $cookies, 'Cookies' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_env.t000644 000765 000024 00000002253 12217110343 024463 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use vars qw/ $EXPECTED_ENV_VAR $EXPECTED_ENV_VAL /; BEGIN { $EXPECTED_ENV_VAR = "CATALYSTTEST$$"; # has to be uppercase otherwise fails on Win32 $EXPECTED_ENV_VAL = "Test env value " . rand(100000); } use Test::More; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; foreach my $path (qw/ env env_on_engine /) { my $response = request("http://localhost/dump/${path}", { extra_env => { $EXPECTED_ENV_VAR => $EXPECTED_ENV_VAL }, }); ok( $response, 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); my $env; ok( eval '$env = ' . $response->content, 'Unserialize Catalyst::Request' ); is ref($env), 'HASH'; ok exists($env->{PATH_INFO}), 'Have a PATH_INFO env var for ' . $path; SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 1; } is $env->{$EXPECTED_ENV_VAR}, $EXPECTED_ENV_VAL, 'Value we set as expected for ' . $path; } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_escaped_path.t000644 000765 000024 00000001105 12217110343 026306 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 6; use Catalyst::Test 'TestApp'; # test that un-escaped can be feteched. { ok( my $response = request('http://localhost/args/params/one/two') ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'onetwo' ); } # test that request with URL-escaped code works. { ok( my $response = request('http://localhost/args/param%73/one/two') ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content, 'onetwo' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_headers.t000644 000765 000024 00000005413 12217110343 025307 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 18; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; { my $creq; my $request = GET( 'http://localhost/dump/request', 'User-Agent' => 'MyAgen/1.0', 'X-Whats-Cool' => 'Catalyst', 'X-Multiple' => [ 1 .. 5 ], 'X-Forwarded-Host' => 'frontend.server.com', 'X-Forwarded-For' => '192.168.1.1, 1.2.3.4', 'X-Forwarded-Port' => 443 ); ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); like( $response->content, qr/^bless\( .* 'Catalyst::Request' \)$/s, 'Content is a serialized Catalyst::Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ) or fail("Exception deseializing $@ from content " . $response->content); isa_ok( $creq, 'Catalyst::Request' ); ok( $creq->secure, 'Forwarded port sets secure' ); isa_ok( $creq->headers, 'HTTP::Headers', 'Catalyst::Request->headers' ); is( $creq->header('X-Whats-Cool'), $request->header('X-Whats-Cool'), 'Catalyst::Request->header X-Whats-Cool' ); { # Test that multiple headers are joined as per RFC 2616 4.2 and RFC 3875 4.1.18 my $excpected = '1, 2, 3, 4, 5'; my $got = $creq->header('X-Multiple'); # HTTP::Headers is context sensitive, "force" scalar context is( $got, $excpected, 'Multiple message-headers are joined as a comma-separated list' ); } is( $creq->header('User-Agent'), $request->header('User-Agent'), 'Catalyst::Request->header User-Agent' ); my $host = sprintf( '%s:%d', $request->header('X-Forwarded-Host'), $request->header('X-Forwarded-Port') ); is( $creq->header('Host'), $host, 'Catalyst::Request->header Host' ); SKIP: { if ( $ENV{CATALYST_SERVER} && $ENV{CATALYST_SERVER} !~ /127.0.0.1|localhost/ ) { skip "Using remote server", 2; } is( $creq->base->host, 'frontend.server.com', 'Catalyst::Request proxied base' ); is( $creq->address, '1.2.3.4', 'Catalyst::Request proxied address' ); } SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 4; } # test that we can ignore the proxy support TestApp->config->{ignore_frontend_proxy} = 1; ok( $response = request($request), 'Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->base, 'http://localhost/', 'Catalyst::Request non-proxied base' ); is( $creq->address, '127.0.0.1', 'Catalyst::Request non-proxied address' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_parameters.t000644 000765 000024 00000012720 12217110343 026036 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 54; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; { my $creq; my $parameters = { 'a' => [qw(A b C d E f G)], }; my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } ); ok( my $response = request("http://localhost/dump/request?$query"), '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' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); isa_ok( $creq, 'Catalyst::Request' ) or fail("EXCEPTION: $@"); is( $creq->method, 'GET', 'Catalyst::Request method' ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); } { my $creq; ok( my $response = request("http://localhost/dump/request?q=foo%2bbar"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); ok( eval '$creq = ' . $response->content ); is $creq->parameters->{q}, 'foo+bar', '%2b not double decoded'; } { my $creq; ok( my $response = request("http://localhost/dump/request?q=foo=bar"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); ok( eval '$creq = ' . $response->content ); is $creq->parameters->{q}, 'foo=bar', '= not ignored'; } { my $creq; my $parameters = { 'a' => [qw(A b C d E f G)], '%' => [ '%', '"', '& - &' ], 'blank' => '', }; my $request = POST( 'http://localhost/dump/request/a/b?a=1&a=2&a=3', 'Content' => $parameters, 'Content-Type' => 'application/x-www-form-urlencoded' ); 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' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); isa_ok( $creq, 'Catalyst::Request' ); is( $creq->method, 'POST', 'Catalyst::Request method' ); is_deeply( $creq->body_parameters, $parameters, 'Catalyst::Request body_parameters' ); unshift( @{ $parameters->{a} }, 1, 2, 3 ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); is_deeply( $creq->arguments, [qw(a b)], 'Catalyst::Request arguments' ); is_deeply( $creq->uploads, {}, 'Catalyst::Request uploads' ); is_deeply( $creq->cookies, {}, 'Catalyst::Request cookie' ); } # http://dev.catalyst.perl.org/ticket/37 # multipart/form-data parameters that contain 'http://' # was an HTTP::Message bug, but HTTP::Body handles it properly now { my $creq; my $parameters = { 'url' => 'http://www.google.com', 'blank' => '', }; my $request = POST( 'http://localhost/dump/request', 'Content-Type' => 'multipart/form-data', 'Content' => $parameters, ); ok( my $response = request($request), 'Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); } # raw query string support { my $creq; my $parameters = { a => 1, blank => '', }; my $request = POST( 'http://localhost/dump/request/a/b?query+string', 'Content' => $parameters, 'Content-Type' => 'application/x-www-form-urlencoded' ); ok( my $response = request($request), 'Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->uri->query, 'query+string', 'Catalyst::Request POST query_string' ); is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); ok( $response = request('http://localhost/dump/request/a/b?x=1&y=1&z=1'), 'Request' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->uri->query, 'x=1&y=1&z=1', 'Catalyst::Request GET query_string' ); } { 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' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_prepare_parameters.t000755 000765 000024 00000001755 12217110343 027565 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 8; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Headers; use HTTP::Request::Common; { my $creq; my $parameters = { 'a' => [qw(A b C d E f G)], }; my $query = join( '&', map { 'a=' . $_ } @{ $parameters->{a} } ); ok( my $response = request("http://localhost/dump/prepare_parameters?$query"), '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' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); isa_ok( $creq, 'Catalyst::Request' ); is( $creq->method, 'GET', 'Catalyst::Request method' ); is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_remote_user.t000644 000765 000024 00000002225 12217110343 026223 0ustar00johnstaff000000 000000 # This tests to make sure the REMOTE_USER environment variable is properly passed through by the engine. use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 7; use Catalyst::Test 'TestApp'; use Catalyst::Request; use HTTP::Request::Common; { my $creq; my $request = GET( 'http://localhost/dump/request', ); ok( my $response = request($request, { extra_env => { REMOTE_USER => 'dwc' } }), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); like( $response->content, qr/'Catalyst::Request'/, 'Content is a serialized Catalyst::Request' ); { no strict 'refs'; ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ) or fail("Failed to deserialize $@ from " . $response->content); } isa_ok( $creq, 'Catalyst::Request' ); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 1; } is( $creq->remote_user, 'dwc', '$c->req->remote_user ok' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_uploads.t000644 000765 000024 00000031171 12236261623 025354 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 105; use Catalyst::Test 'TestApp'; use Scalar::Util qw/ blessed /; use Catalyst::Request; use Catalyst::Request::Upload; use HTTP::Body::OctetStream; use HTTP::Headers; use HTTP::Headers::Util 'split_header_words'; use HTTP::Request::Common; use Path::Class::Dir; { my $creq; my $request = POST( 'http://localhost/dump/request/', 'Content-Type' => 'form-data', 'Content' => [ 'live_engine_request_cookies.t' => ["$FindBin::Bin/live_engine_request_cookies.t"], 'live_engine_request_headers.t' => ["$FindBin::Bin/live_engine_request_headers.t"], 'live_engine_request_uploads.t' => ["$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] }; my $upload = $creq->uploads->{ $parameters{filename} }; isa_ok( $upload, 'Catalyst::Request::Upload' ); is( $upload->type, $part->content_type, 'Upload Content-Type' ); is( $upload->size, length( $part->content ), 'Upload Content-Length' ); # make sure upload is accessible via legacy params->{$file} is( $creq->parameters->{ $upload->filename }, $upload->filename, 'legacy param method ok' ); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing for deleted file on remote server', 1; } ok( !-e $upload->tempname, 'Upload temp file was deleted' ); } } } { my $creq; my $request = POST( 'http://localhost/dump/request/', 'Content-Type' => 'multipart/form-data', 'Content' => [ 'testfile' => ["$FindBin::Bin/live_engine_request_cookies.t"], 'testfile' => ["$FindBin::Bin/live_engine_request_headers.t"], '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' ); my @parts = $request->parts; for ( my $i = 0 ; $i < @parts ; $i++ ) { my $part = $parts[$i]; my $disposition = $part->header('Content-Disposition'); my %parameters = @{ ( split_header_words($disposition) )[0] }; my $upload = $creq->uploads->{ $parameters{name} }->[$i]; isa_ok( $upload, 'Catalyst::Request::Upload' ); is( $upload->type, $part->content_type, 'Upload Content-Type' ); is( $upload->filename, $parameters{filename}, 'Upload filename' ); is( $upload->size, length( $part->content ), 'Upload Content-Length' ); is( $upload->basename, $parameters{filename}, 'Upload basename' ); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing for deleted file on remote server', 1; } ok( !-e $upload->tempname, 'Upload temp file was deleted' ); } } } { my $creq; my $request = POST( 'http://localhost/engine/request/uploads/slurp', 'Content-Type' => 'multipart/form-data', 'Content' => [ 'slurp' => ["$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' ); is( $response->content, ( $request->parts )[0]->content, 'Content' ); # XXX: no way to test that temporary file for this test was deleted } { my $request = POST( 'http://localhost/dump/request', 'Content-Type' => 'multipart/form-data', 'Content' => [ 'file' => ["$FindBin::Bin/../catalyst_130pix.gif"], ] ); # LWP will auto-correct Content-Length when using a remote server SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 2; } # Sending wrong Content-Length here and see if subequent requests fail $request->header('Content-Length' => $request->header('Content-Length') + 1); ok( my $response = request($request), 'Request' ); ok( !$response->is_success, 'Response Error' ); } $request = POST( 'http://localhost/dump/request', 'Content-Type' => 'multipart/form-data', 'Content' => [ 'file1' => ["$FindBin::Bin/../catalyst_130pix.gif"], 'file2' => ["$FindBin::Bin/../catalyst_130pix.gif"], ] ); ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); { local $@; my $request = eval $response->content; if ($@) { fail("Could not inflate response: $@ " . $response->content); } else { ok blessed($request->uploads->{file1}), 'Upload with name file1'; ok blessed($request->uploads->{file2}),'Upload with name file2'; } } my $creq; { no strict 'refs'; ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); } for my $file ( $creq->upload ) { my $upload = $creq->upload($file); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing for deleted file on remote server', 1; } ok( !-e $upload->tempname, 'Upload temp file was deleted' ); } } } { my $creq; my $request = POST( 'http://localhost/dump/request/', 'Content-Type' => 'form-data', 'Content' => [ 'testfile' => 'textfield value', 'testfile' => ["$FindBin::Bin/../catalyst_130pix.gif"], ] ); 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' ); my $param = $creq->parameters->{testfile}; ok( @$param == 2, '2 values' ); is( $param->[0], 'textfield value', 'correct value' ); like( $param->[1], qr/\Qcatalyst_130pix.gif/, 'filename' ); 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' ); is( $upload->filename, 'catalyst_130pix.gif', 'Upload Filename' ); is( $upload->basename, 'catalyst_130pix.gif', 'Upload basename' ); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing for deleted file on remote server', 1; } ok( !-e $upload->tempname, 'Upload temp file was deleted' ); } } } # Test PUT request with application/octet-stream file gets deleted { my $body; my $request = PUT( 'http://localhost/dump/body/', 'Content-Type' => 'application/octet-stream', 'Content' => 'foobarbaz', 'Content-Length' => 9, ); 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\( .* 'HTTP::Body::OctetStream' \)/s, 'Content is a serialized HTTP::Body::OctetStream' ); { no strict 'refs'; ok( eval '$body = ' . substr( $response->content, 8 ), # FIXME - substr not needed in other test cases? 'Unserialize HTTP::Body::OctetStream' ) or warn $@; } isa_ok( $body, 'HTTP::Body::OctetStream' ); isa_ok($body->body, 'File::Temp'); SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing for deleted file on remote server', 1; } # JNAP, I added the following line in order to properly let # the $env go out of scope so that the associated tempfile # would be deleted. I think somewhere Catalyst::Test closed # over ENV and holds state until a new command is issues but # I can't find it. request GET 'http://localhost/'; ok( !-e $body->body->filename, 'Upload temp file was deleted' ); } } # test uploadtmp config var SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Not testing uploadtmp on remote server', 14; } my $creq; my $dir = "$FindBin::Bin/"; local TestApp->config->{ uploadtmp } = $dir; $dir = Path::Class::Dir->new( $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' ); ok( !-e $upload->tempname, 'Upload temp file was deleted' ); } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_request_uri.t000644 000765 000024 00000016610 12121675274 024511 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 74; use Catalyst::Test 'TestApp'; use Catalyst::Request; my $creq; # test that the path can be changed { ok( my $response = request('http://localhost/engine/request/uri/change_path'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ) or diag("Exception '$@', content " . $response->content); like( $creq->uri, qr{/my/app/lives/here$}, 'URI contains new path' ); } # test that path properly removes the base location { ok( my $response = request('http://localhost/engine/request/uri/change_base'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); like( $creq->base, qr{/new/location}, 'Base URI contains new location' ); is( $creq->path, 'engine/request/uri/change_base', 'URI contains correct path' ); } # test that base + path is correct { ok( my $response = request('http://localhost/engine/request/uri'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->base . $creq->path, $creq->uri, 'Base + Path ok' ); } # test base is correct for HTTPS URLs SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 5; } local $ENV{HTTPS} = 'on'; ok( my $response = request('https://localhost/engine/request/uri'), 'HTTPS Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->base, 'https://localhost/', 'HTTPS base ok' ); is( $creq->uri, 'https://localhost/engine/request/uri', 'HTTPS uri ok' ); } # test that we can use semi-colons as separators { my $parameters = { a => [ qw/1 2/ ], b => 3, }; ok( my $response = request('http://localhost/engine/request/uri?a=1;a=2;b=3'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->uri->query, 'a=1;a=2;b=3', 'Query string ok' ); is_deeply( $creq->parameters, $parameters, 'Parameters ok' ); } # test that query params are unescaped properly { ok( my $response = request('http://localhost/engine/request/uri?text=Catalyst%20Rocks'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' ); is( $creq->uri->query, 'text=Catalyst%20Rocks', 'Query string ok' ); is( $creq->parameters->{text}, 'Catalyst Rocks', 'Unescaped param ok' ); } # test that uri_with adds params { ok( my $response = request('http://localhost/engine/request/uri/uri_with'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( !defined $response->header( 'X-Catalyst-Param-a' ), 'param "a" ok' ); is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' ); is( $response->header( 'X-Catalyst-Param-c' ), '--notexists--', 'param "c" ok' ); unlike($response->header ('X-Catalyst-query'), qr/c=/, 'no c in return'); } # test that uri_with adds params (and preserves) { ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' ); is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' ); is( $response->header( 'X-Catalyst-Param-c' ), '--notexists--', 'param "c" ok' ); unlike($response->header ('X-Catalyst-query'), qr/c=/, 'no c in return'); } # test that uri_with replaces params (and preserves) { ok( my $response = request('http://localhost/engine/request/uri/uri_with?a=1&b=2&c=3'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' ); is( $response->header( 'X-Catalyst-Param-b' ), '1', 'param "b" ok' ); is( $response->header( 'X-Catalyst-Param-c' ), '--notexists--', 'param "c" deleted ok' ); unlike($response->header ('X-Catalyst-query'), qr/c=/, 'no c in return'); } # test that uri_with replaces params (and preserves) { ok( my $response = request('http://localhost/engine/request/uri/uri_with_object'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-Param-a' ), qr(https?://localhost[^/]*/), 'param "a" ok' ); } # test that uri_with is utf8 safe { ok( my $response = request("http://localhost/engine/request/uri/uri_with_utf8"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-uri-with' ), qr/%E2%98%A0$/, 'uri_with ok' ); } # test with undef -- no warnings should be thrown { ok( my $response = request("http://localhost/engine/request/uri/uri_with_undef"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header( 'X-Catalyst-warnings' ), 0, 'no warnings emitted' ); } # more tests with undef - should be ignored { my $uri = "http://localhost/engine/request/uri/uri_with_undef_only"; my ($check) = $uri =~ m{^http://localhost(.+)}; # needed to work with remote servers ok( my $response = request($uri), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-uri-with' ), qr/$check$/, 'uri_with ok' ); # try with existing param $uri = "$uri?x=1"; ($check) = $uri =~ m{^http://localhost(.+)}; # needed to work with remote servers $check =~ s/\?/\\\?/g; ok( $response = request($uri), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-uri-with' ), qr/$check$/, 'uri_with ok' ); } { my $uri = "http://localhost/engine/request/uri/uri_with_undef_ignore"; my ($check) = $uri =~ m{^http://localhost(.+)}; # needed to work with remote servers ok( my $response = request($uri), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-uri-with' ), qr/$check\?a=1/, 'uri_with ok' ); # remove an existing param ok( $response = request("${uri}?b=1"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); like( $response->header( 'X-Catalyst-uri-with' ), qr/$check\?a=1/, 'uri_with ok' ); # remove an existing param, leave one, and add a new one ok( $response = request("${uri}?b=1&c=1"), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->header( 'X-Catalyst-Param-a' ), '1', 'param "a" ok' ); ok( !defined $response->header( 'X-Catalyst-Param-b' ),'param "b" ok' ); is( $response->header( 'X-Catalyst-Param-c' ), '1', 'param "c" ok' ); } # Test an overridden uri method which calls the base method, SmartURI does this. SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 2; } require TestApp::RequestBaseBug; TestApp->request_class('TestApp::RequestBaseBug'); ok( my $response = request('http://localhost/engine/request/uri'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); TestApp->request_class('Catalyst::Request'); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_body.t000644 000765 000024 00000000271 12217110343 024774 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use Catalyst::Test 'TestApp'; ok( request('/body_semipredicate')->is_success ); done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_cookies.t000644 000765 000024 00000005510 12217110343 025474 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use Catalyst::Test 'TestApp'; use HTTP::Headers::Util 'split_header_words'; my $expected = { catalyst => [qw|catalyst cool path /bah|], cool => [qw|cool catalyst path /|] }; { ok( my $response = request('http://localhost/engine/response/cookies/one'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/one', 'Test Action' ); my $cookies = {}; for my $string ( $response->header('Set-Cookie') ) { my $cookie = [ split_header_words $string]; $cookies->{ $cookie->[0]->[0] } = $cookie->[0]; } is_deeply( $cookies, $expected, 'Response Cookies' ); } { ok( my $response = request('http://localhost/engine/response/cookies/two'), 'Request' ); ok( $response->is_redirect, 'Response Redirection 3xx' ); is( $response->code, 302, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/two', 'Test Action' ); my $cookies = {}; for my $string ( $response->header('Set-Cookie') ) { my $cookie = [ split_header_words $string]; $cookies->{ $cookie->[0]->[0] } = $cookie->[0]; } is_deeply( $cookies, $expected, 'Response Cookies' ); } { ok( my $response = request('http://localhost/engine/response/cookies/three'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/three', 'Test Action' ); my $cookies = {}; for my $string ( $response->header('Set-Cookie') ) { my $cookie = [ split_header_words $string]; $cookies->{ $cookie->[0]->[0] } = $cookie->[0]; } is_deeply( $cookies, { hash => [ qw(hash a&b&c path /) ], this_is_the_real_name => [ qw(this_is_the_real_name foo&bar path /) ], # not "object" }, 'Response Cookies' ); } { my $response; ok( $response = request('http://localhost/engine/response/cookies/four'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ) or diag explain $response; is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/cookies/four', 'Test Action' ); my $cookies = {}; for my $string ( $response->header('Set-Cookie') ) { my $cookie = [ split_header_words $string]; $cookies->{ $cookie->[0]->[0] } = $cookie->[0]; } is_deeply( $cookies, { good => [qw|good good_cookie path /|], }, 'Response Cookies' ); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_emptybody.t000644 000765 000024 00000000600 12255577340 026067 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use Catalyst::Test 'TestApp'; # body '0' { my $res = request('/zerobody'); is $res->content, '0'; is $res->header('Content-Length'), '1'; } # body '' { my $res = request('/emptybody'); is $res->content, ''; ok !defined $res->header('Content-Length'); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_errors.t000644 000765 000024 00000003353 12217110343 025357 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 18; use Catalyst::Test 'TestApp'; close STDERR; # i'm naughty :) { ok( my $response = request('http://localhost/engine/response/errors/one'), 'Request' ); ok( $response->is_error, 'Response Server Error 5xx' ); is( $response->code, 500, 'Response Code' ); is( $response->content_type, 'text/html', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/errors/one', 'Test Action' ); like( $response->header('X-Catalyst-Error'), qr/^Caught exception/, 'Catalyst Error' ); } { ok( my $response = request('http://localhost/engine/response/errors/two'), 'Request' ); ok( $response->is_error, 'Response Server Error 5xx' ); is( $response->code, 500, 'Response Code' ); is( $response->content_type, 'text/html', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/errors/two', 'Test Action' ); like( $response->header('X-Catalyst-Error'), qr/^Couldn't forward to/, 'Catalyst Error' ); } { ok( my $response = request('http://localhost/engine/response/errors/three'), 'Request' ); ok( $response->is_error, 'Response Server Error 5xx' ); is( $response->code, 500, 'Response Code' ); is( $response->content_type, 'text/html', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/errors/three', 'Test Action' ); like( $response->header('X-Catalyst-Error'), qr/I'm going to die!/, 'Catalyst Error' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_headers.t000644 000765 000024 00000003574 12255367502 025500 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 18; use Catalyst::Test 'TestApp'; use HTTP::Request::Common; my $content_length; foreach my $method (qw(HEAD GET)) { my $expected = join( ', ', 1 .. 10 ); my $request = HTTP::Request::Common->can($method) ->( 'http://localhost/engine/response/headers/one' ); ok( my $response = request($request), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->code, 200, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/headers/one', 'Test Action' ); is( $response->header('X-Header-Catalyst'), 'Cool', 'Response Header X-Header-Catalyst' ); is( $response->header('X-Header-Cool'), 'Catalyst', 'Response Header X-Header-Cool' ); is( $response->header('X-Header-Numbers'), $expected, 'Response Header X-Header-Numbers' ); use bytes; if ( $method eq 'HEAD' ) { $content_length = $response->header('Content-Length'); ok( $content_length > 0, 'Response Header Content-Length' ); is( length($response->content), 0, 'HEAD method content is empty' ); } elsif ( $method eq 'GET' ) { # method name is echo'd back in content-body, which # accounts for difference in content length. In normal # cases the Content-Length should be the same regardless # of whether it's a GET or HEAD request. SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 2; } is( $response->header('Content-Length'), $content_length - 1, 'Response Header Content-Length' ); is( length($response->content), $response->header('Content-Length'), 'GET method content' ); } } } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_large.t000644 000765 000024 00000001172 12217110343 025132 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 6; use Catalyst::Test 'TestApp'; # phaylon noticed that refactored was truncating output on large images. # This test tests 100K and 1M output content. my $expected = { one => 'x' x (100 * 1024), two => 'y' x (1024 * 1024), }; for my $action ( keys %{$expected} ) { ok( my $response = request('http://localhost/engine/response/large/' . $action ), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( length( $response->content ), length( $expected->{$action} ), 'Length OK' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_print.t000644 000765 000024 00000001005 12217110343 025167 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 9; use Catalyst::Test 'TestApp'; my $expected = { one => "foo", two => "foobar", three => "foo,bar,baz:", }; for my $action ( sort keys %{$expected} ) { ok( my $response = request('http://localhost/engine/response/print/' . $action ), 'Request' ); ok( $response->is_success, "Response $action successful 2xx" ); is( $response->content, $expected->{$action}, "Content $action OK" ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_redirect.t000644 000765 000024 00000004254 12217110343 025645 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 26; use Catalyst::Test 'TestApp'; { ok( my $response = request('http://localhost/engine/response/redirect/one'), 'Request' ); ok( $response->is_redirect, 'Response Redirection 3xx' ); is( $response->code, 302, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/one', 'Test Action' ); is( $response->header('Location'), '/test/writing/is/boring', 'Response Header Location' ); ok( $response->header('Content-Length'), '302 Redirect contains Content-Length' ); ok( $response->content, '302 Redirect contains a response body' ); } { ok( my $response = request('http://localhost/engine/response/redirect/two'), 'Request' ); ok( $response->is_redirect, 'Response Redirection 3xx' ); is( $response->code, 302, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/two', 'Test Action' ); is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' ); } { ok( my $response = request('http://localhost/engine/response/redirect/three'), 'Request' ); ok( $response->is_redirect, 'Response Redirection 3xx' ); is( $response->code, 301, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/three', 'Test Action' ); is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' ); ok( $response->header('Content-Length'), '301 Redirect contains Content-Length' ); ok( $response->content, '301 Redirect contains a response body' ); } { ok( my $response = request('http://localhost/engine/response/redirect/four'), 'Request' ); ok( $response->is_redirect, 'Response Redirection 3xx' ); is( $response->code, 307, 'Response Code' ); is( $response->header('X-Catalyst-Action'), 'engine/response/redirect/four', 'Test Action' ); is( $response->header('Location'), 'http://www.google.com/', 'Response Header Location' ); ok( $response->header('Content-Length'), '307 Redirect contains Content-Length' ); ok( $response->content, '307 Redirect contains a response body' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_response_status.t000644 000765 000024 00000004426 12217110343 025370 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 30; use Catalyst::Test 'TestApp'; { ok( my $response = request('http://localhost/engine/response/status/s200'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->code, 200, 'Response Code' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/status/s200', 'Test Action' ); like( $response->content, qr/^200/, 'Response Content' ); } { ok( my $response = request('http://localhost/engine/response/status/s400'), 'Request' ); ok( $response->is_error, 'Response Client Error 4xx' ); is( $response->code, 400, 'Response Code' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/status/s400', 'Test Action' ); like( $response->content, qr/^400/, 'Response Content' ); } { ok( my $response = request('http://localhost/engine/response/status/s403'), 'Request' ); ok( $response->is_error, 'Response Client Error 4xx' ); is( $response->code, 403, 'Response Code' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/status/s403', 'Test Action' ); like( $response->content, qr/^403/, 'Response Content' ); } { ok( my $response = request('http://localhost/engine/response/status/s404'), 'Request' ); ok( $response->is_error, 'Response Client Error 4xx' ); is( $response->code, 404, 'Response Code' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/status/s404', 'Test Action' ); like( $response->content, qr/^404/, 'Response Content' ); } { ok( my $response = request('http://localhost/engine/response/status/s500'), 'Request' ); ok( $response->is_error, 'Response Server Error 5xx' ); is( $response->code, 500, 'Response Code' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); is( $response->header('X-Catalyst-Action'), 'engine/response/status/s500', 'Test Action' ); like( $response->content, qr/^500/, 'Response Content' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_setup_basics.t000644 000765 000024 00000000464 12217110343 024611 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 1; use Catalyst::Test 'TestApp'; SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip "Using remote server", 1; } # Allow overriding automatic root. is( TestApp->config->{root}, '/some/dir' ); } Catalyst-Runtime-5.90053/t/aggregate/live_engine_setup_plugins.t000644 000765 000024 00000000506 12217110343 025023 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 2; use Catalyst::Test 'TestApp'; { # Allow overriding automatic root. ok( my $response = request('http://localhost/engine/response/headers/one'), 'Request' ); is( $response->header('X-Catalyst-Plugin-Setup'), '1' ); } Catalyst-Runtime-5.90053/t/aggregate/live_loop.t000644 000765 000024 00000001057 12217110343 021550 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 3; use Catalyst::Test 'TestApp'; SKIP: { # Net::HTTP::Methods crashes when talking to a remote server because this # test causes a very long header line to be sent if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 3; } ok( my $response = request('http://localhost/loop_test'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); ok( $response->header('X-Class-Forward-Test-Method'), 'Loop OK' ); } Catalyst-Runtime-5.90053/t/aggregate/live_plugin_loaded.t000644 000765 000024 00000001537 12217110343 023410 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 5; use Catalyst::Test 'TestApp'; my @expected = qw[ Catalyst::Plugin::Test::Errors Catalyst::Plugin::Test::Headers Catalyst::Plugin::Test::Inline Catalyst::Plugin::Test::MangleDollarUnderScore Catalyst::Plugin::Test::Plugin Catalyst::Plugin::Unicode::Encoding TestApp::Plugin::AddDispatchTypes TestApp::Plugin::FullyQualified ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/dump/request'), 'Request' ); ok( $response->is_success, 'Response Successful 2xx' ); is( $response->content_type, 'text/plain', 'Response Content-Type' ); like( $response->content, qr/'Catalyst::Request'/, 'Content is a serialized Catalyst::Request' ); is( $response->header('X-Catalyst-Plugins'), $expected, 'Loaded plugins' ); Catalyst-Runtime-5.90053/t/aggregate/live_priorities.t000644 000765 000024 00000004373 12217110343 022774 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 14; use Catalyst::Test 'TestApp'; local $^W = 0; my $uri_base = 'http://localhost/priorities'; my @tests = ( # Simple 'Local vs. Path 1', { path => '/loc_vs_path1', expect => 'local' }, 'Local vs. Path 2', { path => '/loc_vs_path2', expect => 'path' }, # index 'index vs. Local', { path => '/loc_vs_index', expect => 'index' }, 'index vs. Path', { path => '/path_vs_index', expect => 'index' }, 'multimethod zero', { path => '/multimethod', expect => 'zero' }, 'multimethod one', { path => '/multimethod/1', expect => 'one 1' }, 'multimethod two', { path => '/multimethod/1/2', expect => 'two 1 2' }, ); while ( @tests ) { my $name = shift @tests; my $data = shift @tests; # Run tests for path with trailing slash and without SKIP: for my $req_uri ( join( '' => $uri_base, $data->{ path } ), # Without trailing path join( '' => $uri_base, $data->{ path }, '/' ), # With trailing path ) { my $end_slash = ( $req_uri =~ qr(/$) ? 1 : 0 ); # use slash_expect argument if URI ends with slash # and the slash_expect argument is defined my $expect = $data->{ expect } || ''; if ( $end_slash and exists $data->{ slash_expect } ) { $expect = $data->{ slash_expect }; } # Call the URI on the TestApp my $response = request( $req_uri ); # Leave expect out to see the result unless ( $expect ) { skip 'Nothing expected, winner is ' . $response->content, 1; } # Show error if response was no success if ( not $response->is_success ) { diag 'Error: ' . $response->headers->{ 'x-catalyst-error' }; } # Test if content matches expectations. # TODO This might flood the screen with the catalyst please-come-later # page. So I don't know it is a good idea. is( $response->content, $expect, "$name: @{[ $data->{ expect } ]} wins" . ( $end_slash ? ' (trailing slash)' : '' ) ); } } Catalyst-Runtime-5.90053/t/aggregate/live_recursion.t000644 000765 000024 00000001210 12106042701 022576 0ustar00johnstaff000000 000000 #!perl use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 3; use Catalyst::Test 'TestApp'; local $^W = 0; SKIP: { # Net::HTTP::Methods crashes when talking to a remote server because this # test causes a very long header line to be sent if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 3; } ok( my $response = request('http://localhost/recursion_test'), 'Request' ); ok( !$response->is_success, 'Response Not Successful' ); is( $response->header('X-Catalyst-Error'), 'Deep recursion detected calling "/recursion_test"', 'Deep Recursion Detected' ); } Catalyst-Runtime-5.90053/t/aggregate/live_view_warnings.t000644 000765 000024 00000000663 12106042701 023462 0ustar00johnstaff000000 000000 #!perl use strict; use warnings; no warnings 'once'; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use Catalyst::Test 'TestAppViewWarnings'; if ( $ENV{CATALYST_SERVER} ) { plan skip_all => 'Using remote server'; } { ok( my $response = request('http://localhost/'), 'Request' ); like($TestAppViewWarnings::log_messages[0], qr/Attempted to use view/s, 'View failure warning received'); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/meta_method_unneeded.t000644 000765 000024 00000000737 12217110343 023721 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Test::More tests => 1; use Carp (); # Doing various silly things, like for example # use CGI qw/:standard/ in your conrtoller / app # will overwrite your meta method, therefore Catalyst # can't depend on it being there correctly. # This is/was demonstrated by Catalyst::Controller::WrapCGI # and Catalyst::Plugin::Cache::Curried use Catalyst::Test 'TestAppWithMeta'; ok( request('/')->is_success ); Catalyst-Runtime-5.90053/t/aggregate/psgi_file.t000644 000765 000024 00000003214 12121675274 021533 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/../lib"; use File::Temp qw/ tempdir /; use TestApp; use File::Spec; use Carp qw/croak/; my $home = tempdir( CLEANUP => 1 ); my $path = File::Spec->catfile($home, 'testapp.psgi'); open(my $psgi, '>', $path) or die; print $psgi q{ use strict; use warnings; use TestApp; TestApp->psgi_app; }; close($psgi); my ($saved_stdout, $saved_stderr); my $stdout = !open( $saved_stdout, '>&'. STDOUT->fileno ); my $stderr = !open( $saved_stderr, '>&'. STDERR->fileno ); open( STDOUT, '+>', undef ) or croak("Can't reopen stdout to /dev/null"); open( STDERR, '+>', undef ) or croak("Can't reopen stdout to /dev/null"); # Check we wrote out something that compiles system($^X, '-I', "$FindBin::Bin/../lib", '-c', $path) ? fail('.psgi does not compile') : pass('.psgi compiles'); if ($stdout) { open( STDOUT, '>&'. fileno($saved_stdout) ); } if ($stderr) { open( STDERR, '>&'. fileno($saved_stderr) ); } # NOTE - YOU *CANNOT* do something like: #my $psgi_ref = require $path; # otherwise this test passes! # I don't exactly know why that is yet, however, to be safe for future, that # is why this test writes out its own .psgi file in a temp directory - so that that # path has never been require'd before, and will never be require'd again.. local TestApp->config->{home} = $home; my $failed = 0; eval { # Catch infinite recursion (or anything else) local $SIG{__WARN__} = sub { warn(@_); $failed = 1; die; }; TestApp->_finalized_psgi_app; }; ok(!$@, 'No exception') or diag $@; ok(!$failed, 'TestApp->_finalized_psgi_app works'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_controller_actions.t000644 000765 000024 00000001372 12106042701 024521 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 4; use Catalyst (); { package TestController; use Moose; BEGIN { extends 'Catalyst::Controller' } sub action : Local {} sub foo : Path {} no Moose; } my $mock_app = Class::MOP::Class->create_anon_class( superclasses => ['Catalyst'] ); my $app = $mock_app->name->new; my $controller = TestController->new($app, {actions => { foo => { Path => '/some/path' }}}); ok $controller->can('_controller_actions'); is_deeply $controller->_controller_actions => { foo => { Path => '/some/path' }}; is_deeply $controller->{actions} => { foo => { Path => '/some/path' }}; # Back compat. is_deeply [ sort grep { ! /^_/ } map { $_->name } $controller->get_action_methods ], [sort qw/action foo/]; Catalyst-Runtime-5.90053/t/aggregate/unit_controller_config.t000755 000765 000024 00000010021 12106042701 024320 0ustar00johnstaff000000 000000 ## ============================================================================ ## Test to make sure that subclassed controllers (catalyst controllers ## that inherit from a custom base catalyst controller) don't experienc ## any namespace collision in the values under config. ## ============================================================================ use Test::More tests => 9; use strict; use warnings; use_ok('Catalyst'); ## ---------------------------------------------------------------------------- ## First We define a base controller that inherits from Catalyst::Controller ## We add something to the config that we expect all children classes to ## be able to find. ## ---------------------------------------------------------------------------- { package base_controller; use base 'Catalyst::Controller'; __PACKAGE__->config( base_key => 'base_value' ); } ## ---------------------------------------------------------------------------- ## Next we instantiate two classes that inherit from the base controller. We ## Add some local config information to these. ## ---------------------------------------------------------------------------- { package controller_a; use base 'base_controller'; __PACKAGE__->config( key_a => 'value_a' ); } { package controller_b; use base 'base_controller'; __PACKAGE__->config->{key_b} = 'value_b'; } ## Okay, we expect that the base controller has a config with one key ## and that the two children controllers inherit that config key and then ## add one more. So the base controller has one config value and the two ## children each have two. ## ---------------------------------------------------------------------------- ## THE TESTS. Basically we first check to make sure that all the children of ## the base_controller properly inherit the {base_key => 'base_value'} info ## and that each of the children also has its local config data and that none ## of the classes have data that is unexpected. ## ---------------------------------------------------------------------------- # First round, does everything have what we expect to find? If these tests fail there is something # wrong with the way config is storing its information. ok( base_controller->config->{base_key} eq 'base_value', 'base_controller has expected config value for "base_key"') or diag('"base_key" defined as "'.base_controller->config->{base_key}.'" and not "base_value" in config'); ok( controller_a->config->{base_key} eq 'base_value', 'controller_a has expected config value for "base_key"') or diag('"base_key" defined as "'.controller_a->config->{base_key}.'" and not "base_value" in config'); ok( controller_a->config->{key_a} eq 'value_a', 'controller_a has expected config value for "key_a"') or diag('"key_a" defined as "'.controller_a->config->{key_a}.'" and not "value_a" in config'); ok( controller_b->config->{base_key} eq 'base_value', 'controller_b has expected config value for "base_key"') or diag('"base_key" defined as "'.controller_b->config->{base_key}.'" and not "base_value" in config'); ok( controller_b->config->{key_b} eq 'value_b', 'controller_b has expected config value for "key_b"') or diag('"key_b" defined as "'.controller_b->config->{key_b}.'" and not "value_b" in config'); # second round, does each controller have the expected number of config values? If this test fails there is # probably some data collision between the controllers. ok( scalar(keys %{base_controller->config}) == 1, 'base_controller has the expected number of config values') or diag("base_controller should have 1 config value, but it has ".scalar(keys %{base_controller->config})); ok( scalar(keys %{controller_a->config}) == 2, 'controller_a has the expected number of config values') or diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config})); ok( scalar(keys %{controller_b->config}) == 2, 'controller_b has the expected number of config values') or diag("controller_a should have 2 config value, but it has ".scalar(keys %{base_controller->config})); Catalyst-Runtime-5.90053/t/aggregate/unit_controller_namespace.t000644 000765 000024 00000000635 12106042701 025016 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 2; BEGIN { package MyApp::Controller::Foo; use base qw/Catalyst::Controller/; package MyApp::Controller::Root; use base qw/Catalyst::Controller/; __PACKAGE__->config(namespace => ''); package Stub; sub config { {} }; } is(MyApp::Controller::Foo->action_namespace('Stub'), 'foo'); is(MyApp::Controller::Root->action_namespace('Stub'), ''); Catalyst-Runtime-5.90053/t/aggregate/unit_core_action.t000644 000765 000024 00000002335 12121675274 023121 0ustar00johnstaff000000 000000 use Test::More tests => 6; use strict; use warnings; use Moose::Meta::Class; #use Moose::Meta::Attribute; use Catalyst::Request; use Catalyst::Log; use_ok('Catalyst::Action'); my $action_1 = Catalyst::Action->new( name => 'foo', code => sub { "DUMMY" }, reverse => 'bar/foo', namespace => 'bar', attributes => { Args => [ 1 ], attr2 => [ 2 ], }, ); my $action_2 = Catalyst::Action->new( name => 'foo', code => sub { "DUMMY" }, reverse => 'bar/foo', namespace => 'bar', attributes => { Args => [ 2 ], attr2 => [ 2 ], }, ); is("${action_1}", $action_1->reverse, 'overload string'); is($action_1->(), 'DUMMY', 'overload code'); my $anon_meta = Moose::Meta::Class->create_anon_class( attributes => [ Moose::Meta::Attribute->new( request => ( reader => 'request', required => 1, default => sub { Catalyst::Request->new(_log => Catalyst::Log->new, arguments => [qw/one two/]) }, ), ), ], methods => { req => sub { shift->request(@_) } } ); my $mock_c = $anon_meta->new_object(); $mock_c->request; ok(!$action_1->match($mock_c), 'bad match fails'); ok($action_2->match($mock_c), 'good match works'); ok($action_2->compare( $action_1 ), 'compare works'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_action_for.t000644 000765 000024 00000000764 12217110343 023756 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; plan tests => 4; use_ok('TestApp'); is(TestApp->action_for('global_action')->code, TestApp::Controller::Root->can('global_action'), 'action_for on appclass ok'); is(TestApp->controller('Args')->action_for('args')->code, TestApp::Controller::Args->can('args'), 'action_for on controller ok'); is(TestApp->controller('Args')->action_for('args').'', 'args/args', 'action stringifies'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_appclass_roles_in_plugin_list.t000644 000765 000024 00000000460 12106042701 027734 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Test::More tests => 2; use TestApp; use TestApp::Role; is $TestApp::Role::SETUP_FINALIZE, 1, 'TestApp->setup_finalize modifier run once'; is $TestApp::Role::SETUP_DISPATCHER, 1, 'TestApp->setup_dispacter modifier run once'; Catalyst-Runtime-5.90053/t/aggregate/unit_core_classdata.t000644 000765 000024 00000006307 12217110343 023571 0ustar00johnstaff000000 000000 use strict; use warnings; use Scalar::Util qw/refaddr blessed/; use Test::More tests => 37; { package ClassDataTest; use Moose; with 'Catalyst::ClassData'; package ClassDataTest2; use Moose; extends 'ClassDataTest'; } my $scalar = '100'; my $arrayref = []; my $hashref = {}; my $scalarref = \$scalar; my $coderef = sub { "beep" }; my $scalar2 = '200'; my $arrayref2 = []; my $hashref2 = {}; my $scalarref2 = \$scalar2; my $coderef2 = sub { "beep" }; my $scalar3 = '300'; my $arrayref3 = []; my $hashref3 = {}; my $scalarref3 = \$scalar3; my $coderef3 = sub { "beep" }; my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/; ClassDataTest->mk_classdata($_) for @accessors; can_ok('ClassDataTest', @accessors); ClassDataTest2->mk_classdata("beep", "meep"); is(ClassDataTest2->beep, "meep"); ClassDataTest->_arrayref($arrayref); ClassDataTest->_hashref($hashref); ClassDataTest->_scalarref($scalarref); ClassDataTest->_coderef($coderef); ClassDataTest->_scalar($scalar); is(ref(ClassDataTest->_arrayref), 'ARRAY'); is(ref(ClassDataTest->_hashref), 'HASH'); is(ref(ClassDataTest->_scalarref), 'SCALAR'); is(ref(ClassDataTest->_coderef), 'CODE'); ok( !ref(ClassDataTest->_scalar) ); is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref)); is(refaddr(ClassDataTest->_hashref), refaddr($hashref)); is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref)); is(refaddr(ClassDataTest->_coderef), refaddr($coderef)); is(ClassDataTest->_scalar, $scalar); is(ref(ClassDataTest2->_arrayref), 'ARRAY'); is(ref(ClassDataTest2->_hashref), 'HASH'); is(ref(ClassDataTest2->_scalarref), 'SCALAR'); is(ref(ClassDataTest2->_coderef), 'CODE'); ok( !ref(ClassDataTest2->_scalar) ); is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref)); is(refaddr(ClassDataTest2->_hashref), refaddr($hashref)); is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref)); is(refaddr(ClassDataTest2->_coderef), refaddr($coderef)); is(ClassDataTest2->_scalar, $scalar); ClassDataTest2->_arrayref($arrayref2); ClassDataTest2->_hashref($hashref2); ClassDataTest2->_scalarref($scalarref2); ClassDataTest2->_coderef($coderef2); ClassDataTest2->_scalar($scalar2); is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref2)); is(refaddr(ClassDataTest2->_hashref), refaddr($hashref2)); is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref2)); is(refaddr(ClassDataTest2->_coderef), refaddr($coderef2)); is(ClassDataTest2->_scalar, $scalar2); is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref)); is(refaddr(ClassDataTest->_hashref), refaddr($hashref)); is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref)); is(refaddr(ClassDataTest->_coderef), refaddr($coderef)); is(ClassDataTest->_scalar, $scalar); ClassDataTest->_arrayref($arrayref3); ClassDataTest->_hashref($hashref3); ClassDataTest->_scalarref($scalarref3); ClassDataTest->_coderef($coderef3); ClassDataTest->_scalar($scalar3); is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref3)); is(refaddr(ClassDataTest->_hashref), refaddr($hashref3)); is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3)); is(refaddr(ClassDataTest->_coderef), refaddr($coderef3)); is(ClassDataTest->_scalar, $scalar3); my $i = bless {}, 'ClassDataTest'; $i->_scalar('foo'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_component.t000644 000765 000024 00000005327 12106042701 023634 0ustar00johnstaff000000 000000 use Test::More tests => 22; use strict; use warnings; use_ok('Catalyst'); my @complist = map { "MyApp::$_"; } qw/C::Controller M::Model V::View/; { package MyApp; 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'); is(MyApp->comp('C::Controller'), 'MyApp::C::Controller', 'Two-part return ok'); is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok'); is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok'); # Is this desired behaviour? is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok'); # 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 { my @expected = sort qw( MyApp::C::Controller MyApp::M::Model ); my @got = sort MyApp->comp( qr{::[MC]::} ); is_deeply( \@got, \@expected, 'multiple results from regexp ok' ); } # failed search { is_deeply( scalar MyApp->comp( qr{DNE} ), 0, 'no results for failed search' ); } #checking @args passed to ACCEPT_CONTEXT { my $args; { no warnings 'once'; *MyApp::M::Model::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; } my $c = bless {}, 'MyApp'; $c->component('MyApp::M::Model', qw/foo bar/); is_deeply($args, [qw/foo bar/], 'args passed to ACCEPT_CONTEXT ok'); $c->component('M::Model', qw/foo2 bar2/); is_deeply($args, [qw/foo2 bar2/], 'args passed to ACCEPT_CONTEXT ok'); $c->component('Mode', qw/foo3 bar3/); is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); } Catalyst-Runtime-5.90053/t/aggregate/unit_core_component_generating.t000644 000765 000024 00000000452 12106042701 026031 0ustar00johnstaff000000 000000 use Test::More tests => 3; use strict; use warnings; use lib 't/lib'; use TestApp; ok(TestApp->model('Generating'), 'knows about generating model'); ok(TestApp->model('Generated'), 'knows about the generated model'); is(TestApp->model('Generated')->foo, 'foo', 'can operate on generated model'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_component_layers.t000644 000765 000024 00000001247 12106042701 025210 0ustar00johnstaff000000 000000 use Test::More tests => 6; use strict; use warnings; use lib 't/lib'; # This tests that we actually load the physical # copy of Model::Foo::Bar, in the case that Model::Foo # defines the Model::Foo::Bar namespace in memory, # but does not load the corresponding file. use_ok 'TestApp'; my $model_foo = TestApp->model('Foo'); can_ok($model_foo, 'model_foo_method'); can_ok($model_foo, 'bar'); my $model_foo_bar = $model_foo->bar; can_ok($model_foo_bar, 'model_foo_bar_method_from_foo'); can_ok($model_foo_bar, 'model_foo_bar_method_from_foo_bar'); TestApp->setup; is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_component_loading.t000644 000765 000024 00000015726 12106042701 025335 0ustar00johnstaff000000 000000 # 2 initial tests, and 6 per component in the loop below # (do not forget to update the number of components in test 3 as well) # 5 extra tests for the loading options # One test for components in inner packages use Test::More tests => 2 + 6 * 24 + 8 + 1; use strict; use warnings; use File::Spec; use File::Path; my $libdir = 'test_trash'; local @INC = @INC; unshift(@INC, $libdir); my $appclass = 'TestComponents'; my @components = ( { type => 'Controller', prefix => 'C', name => 'Bar' }, { type => 'Controller', prefix => 'C', name => 'Foo::Bar' }, { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Bar' }, { type => 'Controller', prefix => 'C', name => 'Foo::Foo::Foo::Bar' }, { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Bar::Foo' }, { type => 'Controller', prefix => 'Controller', name => 'Bar::Bar::Foo' }, { type => 'Controller', prefix => 'Controller', name => 'Bar::Foo' }, { type => 'Controller', prefix => 'Controller', name => 'Foo' }, { type => 'Model', prefix => 'M', name => 'Bar' }, { type => 'Model', prefix => 'M', name => 'Foo::Bar' }, { type => 'Model', prefix => 'M', name => 'Foo::Foo::Bar' }, { type => 'Model', prefix => 'M', name => 'Foo::Foo::Foo::Bar' }, { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Bar::Foo' }, { type => 'Model', prefix => 'Model', name => 'Bar::Bar::Foo' }, { type => 'Model', prefix => 'Model', name => 'Bar::Foo' }, { type => 'Model', prefix => 'Model', name => 'Foo' }, { type => 'View', prefix => 'V', name => 'Bar' }, { type => 'View', prefix => 'V', name => 'Foo::Bar' }, { type => 'View', prefix => 'V', name => 'Foo::Foo::Bar' }, { type => 'View', prefix => 'V', name => 'Foo::Foo::Foo::Bar' }, { type => 'View', prefix => 'View', name => 'Bar::Bar::Bar::Foo' }, { type => 'View', prefix => 'View', name => 'Bar::Bar::Foo' }, { type => 'View', prefix => 'View', name => 'Bar::Foo' }, { type => 'View', prefix => 'View', name => 'Foo' }, ); sub write_component_file { my ($dir_list, $module_name, $content) = @_; my $dir = File::Spec->catdir(@$dir_list); my $file = File::Spec->catfile($dir, $module_name . '.pm'); mkpath(join(q{/}, @$dir_list) ); open(my $fh, '>', $file) or die "Could not open file $file for writing: $!"; print $fh $content; close $fh; } sub make_component_file { my ($libdir, $appclass, $type, $prefix, $name) = @_; my $compbase = "Catalyst::${type}"; my $fullname = "${appclass}::${prefix}::${name}"; my @namedirs = split(/::/, $name); my $name_final = pop(@namedirs); my @dir_list = ($libdir, $appclass, $prefix, @namedirs); write_component_file(\@dir_list, $name_final, <next::method(\@_); no strict 'refs'; *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; }; \$self; } 1; EOF } foreach my $component (@components) { make_component_file( $libdir, $appclass, $component->{type}, $component->{prefix}, $component->{name}, ); } my $shut_up_deprecated_warnings = q{ __PACKAGE__->log(Catalyst::Log->new('fatal')); }; eval "package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->setup"; can_ok( $appclass, 'components'); my $complist = $appclass->components; # the +1 below is for the app class itself is(scalar keys %$complist, 24+1, "Correct number of components loaded"); foreach (keys %$complist) { # Skip the component which happens to be the app itself next if $_ eq $appclass; my $instance = $appclass->component($_); isa_ok($instance, $_); can_ok($instance, 'whoami'); is($instance->whoami, $_); if($_ =~ /^${appclass}::(?:V|View)::(.*)/) { my $moniker = $1; isa_ok($instance, 'Catalyst::View'); can_ok($appclass->view($moniker), 'whoami'); is($appclass->view($moniker)->whoami, $_); } elsif($_ =~ /^${appclass}::(?:M|Model)::(.*)/) { my $moniker = $1; isa_ok($instance, 'Catalyst::Model'); can_ok($appclass->model($moniker), 'whoami'); is($appclass->model($moniker)->whoami, $_); } elsif($_ =~ /^${appclass}::(?:C|Controller)::(.*)/) { my $moniker = $1; isa_ok($instance, 'Catalyst::Controller'); can_ok($appclass->controller($moniker), 'whoami'); is($appclass->controller($moniker)->whoami, $_); } else { die "Something is wrong with this test, this should" . " have been unreachable"; } } rmtree($libdir); # test extra component loading options $appclass = 'ExtraOptions'; push @components, { type => 'View', prefix => 'Extra', name => 'Foo' }; foreach my $component (@components) { make_component_file( $libdir, $appclass, $component->{type}, $component->{prefix}, $component->{name}, ); } eval qq( package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->config->{ setup_components } = { search_extra => [ '::Extra' ], except => [ "${appclass}::Controller::Foo" ] }; __PACKAGE__->setup; ); can_ok( $appclass, 'components'); $complist = $appclass->components; is(scalar keys %$complist, 24+1, "Correct number of components loaded"); ok( !exists $complist->{ "${appclass}::Controller::Foo" }, 'Controller::Foo was skipped' ); ok( exists $complist->{ "${appclass}::Extra::Foo" }, 'Extra::Foo was loaded' ); rmtree($libdir); $appclass = "ComponentOnce"; write_component_file([$libdir, $appclass, 'Model'], 'TopLevel', <next::method(\@_); no strict 'refs'; *{\__PACKAGE__ . "::whoami"} = sub { return \__PACKAGE__; }; *${appclass}::Model::TopLevel::GENERATED::ACCEPT_CONTEXT = sub { return bless {}, 'FooBarBazQuux'; }; \$self; } package ${appclass}::Model::TopLevel::Nested; sub COMPONENT { die "COMPONENT called in the wrong order!"; } 1; EOF write_component_file([$libdir, $appclass, 'Model', 'TopLevel'], 'Nested', <next::method(\@_); } sub called { return \$called }; 1; EOF eval "package $appclass; use Catalyst; __PACKAGE__->setup"; is($@, '', "Didn't load component twice"); is($appclass->model('TopLevel::Nested')->called,1, 'COMPONENT called once'); ok($appclass->model('TopLevel::Generated'), 'Have generated model'); is(ref($appclass->model('TopLevel::Generated')), 'FooBarBazQuux', 'ACCEPT_CONTEXT in generated inner package fired as expected'); $appclass = "InnerComponent"; { package InnerComponent::Controller::Test; use base 'Catalyst::Controller'; } $INC{'InnerComponent/Controller/Test.pm'} = 1; eval "package $appclass; use Catalyst; __PACKAGE__->setup"; isa_ok($appclass->controller('Test'), 'Catalyst::Controller'); rmtree($libdir); Catalyst-Runtime-5.90053/t/aggregate/unit_core_component_mro.t000644 000765 000024 00000000732 12106042701 024504 0ustar00johnstaff000000 000000 use Test::More tests => 1; use strict; use warnings; { package MyApp::Component; use Test::More; sub COMPONENT { fail 'This no longer gets dispatched to'; } package MyApp::MyComponent; use base 'Catalyst::Component', 'MyApp::Component'; } my $warn = ''; { local $SIG{__WARN__} = sub { $warn .= $_[0]; }; MyApp::MyComponent->COMPONENT('MyApp'); } like($warn, qr/after Catalyst::Component in MyApp::Component/, 'correct warning thrown'); Catalyst-Runtime-5.90053/t/aggregate/unit_core_controller_actions_config.t000644 000765 000024 00000000375 12106042701 027060 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/ $Bin /; use lib "$Bin/../lib"; use TestApp; is(TestApp->controller("Action::ConfigSmashArrayRefs")->config->{action}{foo}{CustomAttr}[0], 'Bar', 'Config un-mangled. RT#65463'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_ctx_attr.t000644 000765 000024 00000001360 12121675274 023471 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$FindBin::Bin/../lib"; use Test::More; use URI; use_ok('TestApp'); my $request = Catalyst::Request->new( { _log => Catalyst::Log->new, base => URI->new('http://127.0.0.1/foo') } ); my $dispatcher = TestApp->dispatcher; my $context = TestApp->new( { request => $request, namespace => 'yada', } ); is( $context->hello_lazy, 'hello there', '$context->hello_lazy'); eval { is( $context->hello_notlazy, 'hello there', '$context->hello_notlazy') }; TODO: { local $TODO = 'we appear to have a lazy bug'; if ($@) { fail('$context->hello_notlazy'); warn $@; } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_engine-prepare_path.t000644 000765 000024 00000010327 12121675274 025561 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use TestApp; use Catalyst::Engine; # mod_rewrite to app root for non / based app { my $r = get_req (0, REDIRECT_URL => '/comics/', SCRIPT_NAME => '/comics/dispatch.cgi', REQUEST_URI => '/comics/', ); is ''.$r->uri, 'http://www.foo.com/comics/'; is ''.$r->base, 'http://www.foo.com/comics/'; } # mod_rewrite to sub path under app root for non / based app { my $r = get_req (0, PATH_INFO => '/foo/bar.gif', REDIRECT_URL => '/comics/foo/bar.gif', SCRIPT_NAME => '/comics/dispatch.cgi', REQUEST_URI => '/comics/foo/bar.gif', ); is ''.$r->uri, 'http://www.foo.com/comics/foo/bar.gif'; is ''.$r->base, 'http://www.foo.com/comics/'; } # Standard CGI hit for non / based app { my $r = get_req (0, PATH_INFO => '/static/css/blueprint/screen.css', SCRIPT_NAME => '/~bobtfish/Gitalist/script/gitalist.cgi', REQUEST_URI => '/~bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css', ); is ''.$r->uri, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/static/css/blueprint/screen.css'; is ''.$r->base, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/'; } # / %2F %252F escaping case. { my $r = get_req (1, PATH_INFO => '/%2F/%2F', SCRIPT_NAME => '/~bobtfish/Gitalist/script/gitalist.cgi', REQUEST_URI => '/~bobtfish/Gitalist/script/gitalist.cgi/%252F/%252F', ); is ''.$r->uri, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/%252F/%252F'; is ''.$r->base, 'http://www.foo.com/~bobtfish/Gitalist/script/gitalist.cgi/'; } # Using rewrite rules to ask for a sub-path in your app. # E.g. RewriteRule ^(.*)$ /path/to/fastcgi/domainprofi.fcgi/iframeredirect$1 [L,NS] { my $r = get_req (0, PATH_INFO => '/iframeredirect/info', SCRIPT_NAME => '', REQUEST_URI => '/info', ); is ''.$r->uri, 'http://www.foo.com/iframeredirect/info'; is ''.$r->base, 'http://www.foo.com/'; } # nginx example from espent with path /"foo" { my $r = get_req (0, PATH_INFO => '"foo"', SCRIPT_NAME => '/', REQUEST_URI => '/%22foo%22', ); is ''.$r->path, '%22foo%22'; is ''.$r->uri, 'http://www.foo.com/%22foo%22'; is ''.$r->base, 'http://www.foo.com/'; } # nginx example from espent with path /"foo" and the app based at /oslobilder { my $r = get_req (1, PATH_INFO => 'oslobilder/"foo"', SCRIPT_NAME => '/oslobilder/', REQUEST_URI => '/oslobilder/%22foo%22', ); is ''.$r->path, '%22foo%22', 'path correct'; is ''.$r->uri, 'http://www.foo.com/oslobilder/%22foo%22', 'uri correct'; is ''.$r->base, 'http://www.foo.com/oslobilder/', 'base correct'; } { my $r = get_req (0, PATH_INFO => '/auth/login', SCRIPT_NAME => '/tx', REQUEST_URI => '/login', ); is ''.$r->path, 'auth/login', 'path correct'; is ''.$r->uri, 'http://www.foo.com/tx/auth/login', 'uri correct'; is ''.$r->base, 'http://www.foo.com/tx/', 'base correct'; } # test req->base and c->uri_for work correctly after an internally redirected request # (i.e. REDIRECT_URL set) when the PATH_INFO contains a regex { my $path = '/engine/request/uri/Rx(here)'; my $r = get_req (0, SCRIPT_NAME => '/', PATH_INFO => $path, REQUEST_URI => $path, REDIRECT_URL => $path, ); is $r->path, 'engine/request/uri/Rx(here)', 'URI contains correct path'; is $r->base, 'http://www.foo.com/', 'Base is correct'; } # FIXME - Test proxy logic # - Test query string # - Test non standard port numbers # - Test // in PATH_INFO # - Test scheme (secure request on port 80) sub get_req { my $use_request_uri_for_path = shift; my %template = ( HTTP_HOST => 'www.foo.com', PATH_INFO => '/', ); my $engine = Catalyst::Engine->new(); my $i = TestApp->new; $i->setup_finished(0); $i->config(use_request_uri_for_path => $use_request_uri_for_path); $i->setup_finished(1); $engine->prepare_request($i, env => { %template, @_ }, response_cb => sub {}); $engine->prepare_path($i); return $i->req; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_engine_fixenv-iis6.t000644 000765 000024 00000004202 12217110343 025316 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Catalyst; my %env = ( 'SCRIPT_NAME' => '/koo/blurb', 'PATH_INFO' => '/koo/blurb', 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'REQUEST_METHOD' => 'GET', 'SCRIPT_FILENAME' => 'C:\\Foo\\script\\blurb', 'INSTANCE_META_PATH' => '/LM/W3SVC/793536', 'SERVER_SOFTWARE' => 'Microsoft-IIS/6.0', 'AUTH_PASSWORD' => '', 'AUTH_TYPE' => '', 'HTTP_USER_AGENT' => 'Mozilla/5.0 (Windows; U; Windows NT 5.2; de; rv:1.9.0.4) Gecko/2008102920 Firefox/3.0.4 (.NET CLR 3.5.30729)', 'REMOTE_PORT' => '1281', 'QUERY_STRING' => '', 'URL' => '/koo/blurb', 'HTTP_ACCEPT_LANGUAGE' => 'de-de,de;q=0.8,en-us;q=0.5,en;q=0.3', 'FCGI_ROLE' => 'RESPONDER', 'HTTP_KEEP_ALIVE' => '300', 'CONTENT_TYPE' => '', 'LOCAL_ADDR' => '127.0.0.1', 'GATEWAY_INTERFACE' => 'CGI/1.1', 'HTTPS' => 'off', 'DOCUMENT_ROOT' => 'C:\\Foo\\script', 'REMOTE_HOST' => '127.0.0.1', 'PATH_TRANSLATED' => 'C:\\Foo\\script\\blurb', 'APPL_PHYSICAL_PATH' => 'C:\\Foo\\script\\', 'SERVER_NAME' => '127.0.0.1', 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate', 'HTTP_CONNECTION' => 'keep-alive', 'INSTANCE_ID' => '793536', 'CONTENT_LENGTH' => '0', 'AUTH_USER' => '', 'APPL_MD_PATH' => '/LM/W3SVC/793536/Root/koo', 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7', 'REMOTE_USER' => '', 'SERVER_PORT_SECURE' => '0', 'SERVER_PORT' => 83, 'REMOTE_ADDR' => '127.0.0.1', 'SERVER_PROTOCOL' => 'HTTP/1.1', 'REQUEST_URI' => '/koo/blurb', 'APP_POOL_ID' => 'DefaultAppPool', 'HTTP_HOST' => '127.0.0.1:83' ); sub fix_env { my (%input_env) = @_; my $mangled_env; my $app = Catalyst->apply_default_middlewares(sub { my ($env) = @_; $mangled_env = $env; return [ 200, ['Content-Type' => 'text/plain'], [''] ]; }); $app->({ %input_env, 'psgi.url_scheme' => 'http' }); return %{ $mangled_env }; } my %fixed_env = fix_env(%env); is($fixed_env{PATH_INFO}, '//blurb', 'check PATH_INFO'); is($fixed_env{SCRIPT_NAME}, '/koo', 'check SCRIPT_NAME'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_engine_fixenv-lighttpd.t000644 000765 000024 00000003240 12217110343 026264 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Catalyst (); my %env = ( 'SCRIPT_NAME' => '/bar', 'SERVER_NAME' => 'localhost:8000', 'HTTP_ACCEPT_ENCODING' => 'gzip,deflate', 'HTTP_CONNECTION' => 'keep-alive', 'PATH_INFO' => '', 'HTTP_ACCEPT' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8', 'REQUEST_METHOD' => 'GET', 'SCRIPT_FILENAME' => '/tmp/Foo/root/bar', 'HTTP_ACCEPT_CHARSET' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7', 'SERVER_SOFTWARE' => 'lighttpd/1.4.15', 'QUERY_STRING' => '', 'REMOTE_PORT' => '22207', 'SERVER_PORT' => 8000, 'REDIRECT_STATUS' => '200', 'HTTP_ACCEPT_LANGUAGE' => 'en-us,en;q=0.5', 'REMOTE_ADDR' => '127.0.0.1', 'FCGI_ROLE' => 'RESPONDER', 'HTTP_KEEP_ALIVE' => '300', 'SERVER_PROTOCOL' => 'HTTP/1.1', 'REQUEST_URI' => '/bar', 'GATEWAY_INTERFACE' => 'CGI/1.1', 'SERVER_ADDR' => '127.0.0.1', 'DOCUMENT_ROOT' => '/tmp/Foo/root', 'HTTP_HOST' => 'localhost:8000', ); sub fix_env { my (%input_env) = @_; my $mangled_env; my $app = Catalyst->apply_default_middlewares(sub { my ($env) = @_; $mangled_env = $env; return [ 200, ['Content-Type' => 'text/plain'], [''] ]; }); $app->({ %input_env, 'psgi.url_scheme' => 'http' }); return %{ $mangled_env }; } my %fixed_env = fix_env(%env); is($fixed_env{PATH_INFO}, '/bar', 'check PATH_INFO'); ok(!exists($fixed_env{SCRIPT_NAME}) || !length($fixed_env{SCRIPT_NAME}), 'check SCRIPT_NAME'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_log.t000644 000765 000024 00000003437 12106042701 022413 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 22; use Catalyst::Log; local *Catalyst::Log::_send_to_log; local our @MESSAGES; { no warnings 'redefine'; *Catalyst::Log::_send_to_log = sub { my $self = shift; push @MESSAGES, @_; }; } my $LOG = 'Catalyst::Log'; can_ok $LOG, 'new'; ok my $log = $LOG->new, '... and creating a new log object should succeed'; isa_ok $log, $LOG, '... and the object it returns'; can_ok $log, 'is_info'; ok $log->is_info, '... and the default behavior is to allow info messages'; can_ok $log, 'info'; ok $log->info('hello there!'), '... passing it an info message should succeed'; can_ok $log, "_flush"; $log->_flush; ok @MESSAGES, '... and flushing the log should succeed'; is scalar @MESSAGES, 1, '... with one log message'; like $MESSAGES[0], qr/^\[info\] hello there!$/, '... which should match the format we expect'; { package Catalyst::Log::Subclass; use base qw/Catalyst::Log/; sub _send_to_log { my $self = shift; push @MESSAGES, '---'; push @MESSAGES, @_; } } my $SUBCLASS = 'Catalyst::Log::Subclass'; can_ok $SUBCLASS, 'new'; ok $log = Catalyst::Log::Subclass->new, '... and the log subclass constructor shoudl return a new object'; isa_ok $log, $SUBCLASS, '... and the object it returns'; isa_ok $log, $LOG, '... and it also'; can_ok $log, 'info'; ok $log->info('hi there!'), '... passing it an info message should succeed'; can_ok $log, "_flush"; @MESSAGES = (); # clear the message log $log->_flush; ok @MESSAGES, '... and flushing the log should succeed'; is scalar @MESSAGES, 2, '... with two log messages'; is $MESSAGES[0], '---', '... with the first one being our new data'; like $MESSAGES[1], qr/^\[info\] hi there!$/, '... which should match the format we expect'; Catalyst-Runtime-5.90053/t/aggregate/unit_core_merge_config_hashes.t000644 000765 000024 00000001736 12106042701 025611 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; my @tests = ( { given => [ { a => 1 }, { b => 1 } ], expects => { a => 1, b => 1 } }, { given => [ { a => 1 }, { a => { b => 1 } } ], expects => { a => { b => 1 } } }, { given => [ { a => { b => 1 } }, { a => 1 } ], expects => { a => 1 } }, { given => [ { a => 1 }, { a => [ 1 ] } ], expects => { a => [ 1 ] } }, { given => [ { a => [ 1 ] }, { a => 1 } ], expects => { a => 1 } }, { given => [ { a => { b => 1 } }, { a => { b => 2 } } ], expects => { a => { b => 2 } } }, { given => [ { a => { b => 1 } }, { a => { c => 1 } } ], expects => { a => { b => 1, c => 1 } } }, ); plan tests => scalar @tests; use Catalyst::Component; for my $test ( @ tests ) { is_deeply( Catalyst::Component->merge_config_hashes( @{ $test->{ given } } ), $test->{ expects } ); } Catalyst-Runtime-5.90053/t/aggregate/unit_core_mvc.t000644 000765 000024 00000021634 12121675274 022434 0ustar00johnstaff000000 000000 use Test::More; use strict; use warnings; use_ok('Catalyst'); my @complist = map { "MyMVCTestApp::$_"; } qw/C::Controller M::Model V::View Controller::C Model::M View::V Controller::Model::Dummy::Model Model::Dummy::Model/; { package MyMVCTestApp; use base qw/Catalyst/; __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } ); my $thingie={}; bless $thingie, 'Some::Test::Object'; __PACKAGE__->components->{'MyMVCTestApp::Model::Test::Object'} = $thingie; # allow $c->log->warn to work __PACKAGE__->setup_log; } { package MyStringThing; use overload '""' => sub { $_[0]->{string} }, fallback => 1; } is( MyMVCTestApp->view('View'), 'MyMVCTestApp::V::View', 'V::View ok' ); is( MyMVCTestApp->controller('Controller'), 'MyMVCTestApp::C::Controller', 'C::Controller ok' ); is( MyMVCTestApp->model('Model'), 'MyMVCTestApp::M::Model', 'M::Model ok' ); is( MyMVCTestApp->model('Dummy::Model'), 'MyMVCTestApp::Model::Dummy::Model', 'Model::Dummy::Model ok' ); isa_ok( MyMVCTestApp->model('Test::Object'), 'Some::Test::Object', 'Test::Object ok' ); is( MyMVCTestApp->controller('Model::Dummy::Model'), 'MyMVCTestApp::Controller::Model::Dummy::Model', 'Controller::Model::Dummy::Model ok' ); is( MyMVCTestApp->view('V'), 'MyMVCTestApp::View::V', 'View::V ok' ); is( MyMVCTestApp->controller('C'), 'MyMVCTestApp::Controller::C', 'Controller::C ok' ); is( MyMVCTestApp->model('M'), 'MyMVCTestApp::Model::M', 'Model::M ok' ); # failed search { is( MyMVCTestApp->model('DNE'), undef, 'undef for invalid search' ); } is_deeply( [ sort MyMVCTestApp->views ], [ qw/V View/ ], 'views ok' ); is_deeply( [ sort MyMVCTestApp->controllers ], [ qw/C Controller Model::Dummy::Model/ ], 'controllers ok'); is_deeply( [ sort MyMVCTestApp->models ], [ qw/Dummy::Model M Model Test::Object/ ], 'models ok'); { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; like (MyMVCTestApp->view , qr/^MyMVCTestApp\::(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'}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'current_view ok'); my $view = bless {} , 'MyMVCTestApp::View::V'; is ( bless ({stash=>{current_view_instance=> $view }}, 'MyMVCTestApp')->view , $view, 'current_view_instance ok'); is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyMVCTestApp::V::View' }}, 'MyMVCTestApp')->view , $view, 'current_view_instance precedes current_view ok'); { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; ok( my $model = MyMVCTestApp->model ); ok( (($model =~ /^MyMVCTestApp\::(M|Model)\::/) || $model->isa('Some::Test::Object')), 'model() with no defaults returns *something*' ); ok( $warnings, 'model() w/o a default is random, warnings thrown' ); } is ( bless ({stash=>{current_model=>'M'}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'current_model ok'); my $model = bless {} , 'MyMVCTestApp::Model::M'; is ( bless ({stash=>{current_model_instance=> $model }}, 'MyMVCTestApp')->model , $model, 'current_model_instance ok'); is ( bless ({stash=>{current_model_instance=> $model, current_model=>'MyMVCTestApp::M::Model' }}, 'MyMVCTestApp')->model , $model, 'current_model_instance precedes current_model ok'); MyMVCTestApp->config->{default_view} = 'V'; is ( bless ({stash=>{}}, 'MyMVCTestApp')->view , 'MyMVCTestApp::View::V', 'default_view ok'); is ( MyMVCTestApp->view , 'MyMVCTestApp::View::V', 'default_view in class method ok'); MyMVCTestApp->config->{default_model} = 'M'; is ( bless ({stash=>{}}, 'MyMVCTestApp')->model , 'MyMVCTestApp::Model::M', 'default_model ok'); is ( MyMVCTestApp->model , 'MyMVCTestApp::Model::M', 'default_model in class method ok'); # regexp behavior tests { # is_deeply is used because regexp behavior means list context is_deeply( [ MyMVCTestApp->view( qr{^V[ie]+w$} ) ], [ 'MyMVCTestApp::V::View' ], 'regexp view ok' ); is_deeply( [ MyMVCTestApp->controller( qr{Dummy\::Model$} ) ], [ 'MyMVCTestApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' ); is_deeply( [ MyMVCTestApp->model( qr{Dum{2}y} ) ], [ 'MyMVCTestApp::Model::Dummy::Model' ], 'regexp model ok' ); # object w/ qr{} is_deeply( [ MyMVCTestApp->model( qr{Test} ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); is_deeply([ MyMVCTestApp->model( bless({ string => 'Model' }, 'MyStringThing') ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::M::Model'} ], 'Explicit model search with overloaded object'); { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; # object w/ regexp fallback is_deeply( [ MyMVCTestApp->model( bless({ string => 'Test' }, 'MyStringThing') ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); ok( $warnings, 'regexp fallback warnings' ); } { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; # object w/ regexp fallback is_deeply( [ MyMVCTestApp->model( 'Test' ) ], [ MyMVCTestApp->components->{'MyMVCTestApp::Model::Test::Object'} ], 'Object returned' ); ok( $warnings, 'regexp fallback warnings' ); } is_deeply( [ MyMVCTestApp->view('MyMVCTestApp::V::View$') ], [ 'MyMVCTestApp::V::View' ], 'Explicit return ok'); is_deeply( [ MyMVCTestApp->controller('MyMVCTestApp::C::Controller$') ], [ 'MyMVCTestApp::C::Controller' ], 'Explicit return ok'); is_deeply( [ MyMVCTestApp->model('MyMVCTestApp::M::Model$') ], [ 'MyMVCTestApp::M::Model' ], 'Explicit return ok'); } { my @expected = qw( MyMVCTestApp::C::Controller MyMVCTestApp::Controller::C ); is_deeply( [ sort MyMVCTestApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' ); } { my @expected = qw( MyMVCTestApp::V::View MyMVCTestApp::View::V ); is_deeply( [ sort MyMVCTestApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' ); } { my @expected = qw( MyMVCTestApp::M::Model MyMVCTestApp::Model::M ); is_deeply( [ sort MyMVCTestApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' ); } # failed search { is( scalar MyMVCTestApp->controller( qr{DNE} ), 0, '0 results for failed search' ); } #checking @args passed to ACCEPT_CONTEXT { my $args; { no warnings 'once'; *MyMVCTestApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; *MyMVCTestApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args}; } my $c = bless {}, 'MyMVCTestApp'; # test accept-context with class rather than instance MyMVCTestApp->model('M', qw/foo bar/); is_deeply($args, [qw/foo bar/], 'MyMVCTestApp->model args passed to ACCEPT_CONTEXT ok'); $c->model('M', qw/foo bar/); is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok'); my $x = $c->view('V', qw/foo2 bar2/); is_deeply($args, [qw/foo2 bar2/], '$c->view args passed to ACCEPT_CONTEXT ok'); # regexp fallback $c->view('::View::V', qw/foo3 bar3/); is_deeply($args, [qw/foo3 bar3/], 'args passed to ACCEPT_CONTEXT ok'); } { my $warn = ''; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warn .= $_[1] }; is_deeply (MyMVCTestApp->controller('MyMVCTestApp::Controller::C'), MyMVCTestApp->components->{'MyMVCTestApp::Controller::C'}, 'controller by fully qualified name ok'); # You probably meant $c->controller('C') instead of $c->controller({'MyMVCTestApp::Controller::C'}) my ($suggested_comp_name, $orig_comp_name) = $warn =~ /You probably meant (.*) instead of (.*) /; isnt($suggested_comp_name, $orig_comp_name, 'suggested fix in warning for fully qualified component names makes sense' ); } { package MyApp::WithoutRegexFallback; use base qw/Catalyst/; __PACKAGE__->config( { disable_component_resolution_regex_fallback => 1 } ); __PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } qw/MyApp::WithoutRegexFallback::Controller::Another::Foo/ } ); # allow $c->log->warn to work __PACKAGE__->setup_log; } { # test if non-regex component retrieval still works is( MyApp::WithoutRegexFallback->controller('Another::Foo'), 'MyApp::WithoutRegexFallback::Controller::Another::Foo', 'controller Another::Foo found'); } { my $warnings = 0; no warnings 'redefine'; local *Catalyst::Log::warn = sub { $warnings++ }; # try to get nonexisting object w/o regexp fallback is( MyApp::WithoutRegexFallback->controller('Foo'), undef, 'no controller Foo found'); ok( !$warnings, 'no regexp fallback warnings' ); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_path_to.t000644 000765 000024 00000001515 12121675274 023301 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use Path::Class; use File::Basename; BEGIN { delete $ENV{CATALYST_HOME}; # otherwise it'll set itself up to the wrong place } use lib "$FindBin::Bin/../lib"; use TestApp; my %non_unix = ( MacOS => 1, MSWin32 => 1, os2 => 1, VMS => 1, epoc => 1, NetWare => 1, dos => 1, cygwin => 1 ); my $os = $non_unix{$^O} ? $^O : 'Unix'; if ( $os ne 'Unix' ) { plan skip_all => 'tests require Unix'; } use_ok('Catalyst'); my $context = 'TestApp'; my $base; isa_ok( $base = Catalyst::path_to( $context, '' ), 'Path::Class::Dir' ); my $config = Catalyst->config; is( Catalyst::path_to( $context, 'foo' ), "$base/foo", 'Unix path' ); is( Catalyst::path_to( $context, 'foo', 'bar' ), "$base/foo/bar", 'deep Unix path' ); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_plugin.t000644 000765 000024 00000002672 12217110343 023131 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use lib 't/lib'; { package Faux::Plugin; sub new { bless { count => 1 }, shift } sub count { shift->{count}++ } } my $warnings = 0; use PluginTestApp; my $logger = Class::MOP::Class->create_anon_class( methods => { error => sub {0}, debug => sub {0}, info => sub {0}, warn => sub { if ($_[1] =~ /plugin method is deprecated/) { $warnings++; return; } die "Caught unexpected warning: " . $_[1]; }, }, )->new_object; PluginTestApp->log($logger); use Catalyst::Test qw/PluginTestApp/; 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" ); local $ENV{CATALYST_DEBUG} = 0; is( $warnings, 1, '1 warning' ); use_ok 'TestApp'; my @expected = qw( Catalyst::Plugin::Test::Errors Catalyst::Plugin::Test::Headers Catalyst::Plugin::Test::Inline Catalyst::Plugin::Test::MangleDollarUnderScore Catalyst::Plugin::Test::Plugin Catalyst::Plugin::Unicode::Encoding TestApp::Plugin::AddDispatchTypes TestApp::Plugin::FullyQualified ); # Faux::Plugin is no longer reported is_deeply [ TestApp->registered_plugins ], \@expected, 'registered_plugins() should only report the plugins for the current class'; done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_cgi.t000644 000765 000024 00000001223 12217110343 023750 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Test::More; use Test::Fatal; use Catalyst::Script::CGI; local @ARGV; is exception { Catalyst::Script::CGI->new_with_options(application_name => 'TestAppToTestScripts')->run; }, undef, "new_with_options"; shift @TestAppToTestScripts::RUN_ARGS; my $server = pop @TestAppToTestScripts::RUN_ARGS; like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler'; is ref(delete($TestAppToTestScripts::RUN_ARGS[0]->{argv})), 'ARRAY'; is ref(delete($TestAppToTestScripts::RUN_ARGS[0]->{extra_argv})), 'ARRAY'; is_deeply \@TestAppToTestScripts::RUN_ARGS, [{}], "no args"; done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_create.t000644 000765 000024 00000004223 12217110343 024454 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use FindBin qw/$Bin/; use lib "$Bin/../lib"; { package TestCreateScript; use Moose; extends 'Catalyst::Script::Create'; our $help; sub print_usage_text { $help++ } } { package TestHelperClass; use Moose; has 'newfiles' => ( is => 'ro', init_arg => '.newfiles' ); has 'mech' => ( is => 'ro' ); our @ARGS; our %p; sub mk_component { my $self = shift; @ARGS = @_; %p = ( '.newfiles' => $self->newfiles, mech => $self->mech); return $self->_mk_component_return; } sub _mk_component_return { 1 } } { package TestHelperClass::False; use Moose; extends 'TestHelperClass'; sub _mk_component_return { 0 } } { local $TestCreateScript::help; local @ARGV; is exception { TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass')->run; }, undef, "no argv"; ok $TestCreateScript::help, 'Exited with usage info'; } { local $TestCreateScript::help; local @ARGV = 'foo'; local @TestHelperClass::ARGS; local %TestHelperClass::p; is exception { TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass')->run; }, undef, "with argv"; ok !$TestCreateScript::help, 'Did not exit with usage into'; is_deeply \@TestHelperClass::ARGS, ['TestAppToTestScripts', 'foo'], 'Args correct'; is_deeply \%TestHelperClass::p, { '.newfiles' => 1, mech => undef }, 'Params correct'; } { local $TestCreateScript::help; local @ARGV = 'foo'; local @TestHelperClass::ARGS; local %TestHelperClass::p; is exception { TestCreateScript->new_with_options(application_name => 'TestAppToTestScripts', helper_class => 'TestHelperClass::False')->run; }, undef, "with argv"; ok $TestCreateScript::help, 'Did exit with usage into as mk_component returned false'; is_deeply \@TestHelperClass::ARGS, ['TestAppToTestScripts', 'foo'], 'Args correct'; is_deeply \%TestHelperClass::p, { '.newfiles' => 1, mech => undef }, 'Params correct'; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_fastcgi.t000644 000765 000024 00000005733 12217110343 024640 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Test::More; use Test::Fatal; use Catalyst::Script::FastCGI; local our $fake_handler = \42; { package TestFastCGIScript; use Moose; use namespace::autoclean; extends 'Catalyst::Script::FastCGI'; # Avoid loading the real plack engine, as that will load FCGI and fail if # it's not there. We don't really need a full engine anyway as the overriden # MyApp->run will just capture its arguments and return without delegating # to the engine to run things. override load_engine => sub { $fake_handler }; __PACKAGE__->meta->make_immutable; } sub testOption { my ($argstring, $resultarray) = @_; local @ARGV = @$argstring; local @TestAppToTestScripts::RUN_ARGS; is exception { TestFastCGIScript->new_with_options(application_name => 'TestAppToTestScripts')->run; }, undef, "new_with_options"; # First element of RUN_ARGS will be the script name, which we don't care about shift @TestAppToTestScripts::RUN_ARGS; my $server = pop @TestAppToTestScripts::RUN_ARGS; is $server, $fake_handler, 'Loaded Plack handler gets passed to the app'; if (scalar(@TestAppToTestScripts::RUN_ARGS) && ref($TestAppToTestScripts::RUN_ARGS[-1]) eq "HASH") { is ref(delete($TestAppToTestScripts::RUN_ARGS[-1]->{argv})), 'ARRAY'; is ref(delete($TestAppToTestScripts::RUN_ARGS[-1]->{extra_argv})), 'ARRAY'; } is_deeply \@TestAppToTestScripts::RUN_ARGS, $resultarray, "is_deeply comparison"; } # Returns the hash expected when no flags are passed sub opthash { return { (map { ($_ => undef) } qw(pidfile keep_stderr detach nproc manager)), proc_title => 'perl-fcgi-pm [TestAppToTestScripts]', @_, }; } # Test default (no opts/args behaviour) testOption( [ qw// ], [undef, opthash()] ); # listen socket testOption( [ qw|-l /tmp/foo| ], ['/tmp/foo', opthash()] ); testOption( [ qw/-l 127.0.0.1:3000/ ], ['127.0.0.1:3000', opthash()] ); #daemonize -d --daemon testOption( [ qw/-d/ ], [undef, opthash(detach => 1)] ); testOption( [ qw/--daemon/ ], [undef, opthash(detach => 1)] ); # pidfile -pidfile -p --pid --pidfile testOption( [ qw/--pidfile cat.pid/ ], [undef, opthash(pidfile => 'cat.pid')] ); testOption( [ qw/--pid cat.pid/ ], [undef, opthash(pidfile => 'cat.pid')] ); testOption( [ qw/-p cat.pid/ ], [undef, opthash(pidfile => 'cat.pid')] ); # manager testOption( [ qw/--manager foo::bar/ ], [undef, opthash(manager => 'foo::bar')] ); testOption( [ qw/-M foo::bar/ ], [undef, opthash(manager => 'foo::bar')] ); # keeperr testOption( [ qw/--keeperr/ ], [undef, opthash(keep_stderr => 1)] ); testOption( [ qw/-e/ ], [undef, opthash(keep_stderr => 1)] ); # nproc testOption( [ qw/--nproc 6/ ], [undef, opthash(nproc => 6)] ); testOption( [ qw/--n 6/ ], [undef, opthash(nproc => 6)] ); # proc_title testOption( [ qw/--proc_title foo/ ], [undef, opthash(proc_title => 'foo')] ); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_help.t000644 000765 000024 00000001020 12217110343 024131 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Test::Fatal; use FindBin qw/$Bin/; use lib "$Bin/../lib"; { package TestHelpScript; use Moose; with 'Catalyst::ScriptRole'; our $help; sub print_usage_text { $help++ } } test('--help'); test('-?'); sub test { local $TestHelpScript::help; local @ARGV = (@_); is exception { TestHelpScript->new_with_options(application_name => 'TestAppToTestScripts')->run; }, undef, 'Lives'; ok $TestHelpScript::help, 'Got help'; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_run_options.t000644 000765 000024 00000001574 12106042701 025575 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/$Bin/; use IO::Handle; use Try::Tiny; use File::Temp qw/ tempfile /; use lib "$Bin/../lib"; use_ok('Catalyst::ScriptRunner'); use_ok('ScriptTestApp'); is ScriptTestApp->run_options, undef; my ($fh, $fn) = tempfile(); binmode( $fh ); binmode( STDOUT ); local @ARGV = (); local %ENV; my $saved; open( $saved, '>&'. STDOUT->fileno ) or croak("Can't dup stdout: $!"); open( STDOUT, '>&='. $fh->fileno ) or croak("Can't open stdout: $!"); local $SIG{__WARN__} = sub {}; # Shut up warnings... try { Catalyst::ScriptRunner->run('ScriptTestApp', 'CGI'); pass("Ran ok") } catch { fail "Failed to run $_" }; STDOUT->flush or croak("Can't flush stdout: $!"); open( STDOUT, '>&'. fileno($saved) ) or croak("Can't restore stdout: $!"); is_deeply ScriptTestApp->run_options, { argv => [], extra_argv => [] }; done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_server-without_modules.t000644 000765 000024 00000001556 12236261623 027767 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; # Package::Stash::XS has a weird =~ XS invocation during its compilation # This interferes with @INC hooks that do rematcuing on their own on # perls before 5.8.7. Just use the PP version to work around this. BEGIN { $ENV{PACKAGE_STASH_IMPLEMENTATION} = 'PP' if $] < '5.008007' } use Test::More; use Try::Tiny; plan skip_all => "Need Test::Without::Module for this test" unless try { require Test::Without::Module; 1 }; Test::Without::Module->import(qw( Starman::Server Plack::Handler::Starman MooseX::Daemonize MooseX::Daemonize::Pid::File MooseX::Daemonize::Core )); require "$Bin/../aggregate/unit_core_script_server.t"; Test::Without::Module->unimport(qw( Starman::Server Plack::Handler::Starman MooseX::Daemonize MooseX::Daemonize::Pid::File MooseX::Daemonize::Core )); 1; Catalyst-Runtime-5.90053/t/aggregate/unit_core_script_server.t000644 000765 000024 00000015553 12236261623 024540 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use File::Temp qw/ tempdir /; use Cwd; use Test::More; use Try::Tiny; use Catalyst::Script::Server; my $cwd = getcwd; chdir(tempdir(CLEANUP => 1)); my $testopts; # Test default (no opts/args behaviour) # Note undef for host means we bind to all interfaces. testOption( [ qw// ], ['3000', undef, opthash()] ); # Old version supports long format opts with either one or two dashes. New version only supports two. # Old New # help -? -help --help -? --help # debug -d -debug --debug -d --debug # host -host --host --host testOption( [ qw/--host testhost/ ], ['3000', 'testhost', opthash(host => 'testhost')] ); testOption( [ qw/-h testhost/ ], ['3000', 'testhost', opthash(host => 'testhost')] ); # port -p -port --port -l --listen testOption( [ qw/-p 3001/ ], ['3001', undef, opthash(port => 3001)] ); testOption( [ qw/--port 3001/ ], ['3001', undef, opthash(port => 3001)] ); { local $ENV{TESTAPPTOTESTSCRIPTS_PORT} = 5000; testOption( [ qw// ], [5000, undef, opthash(port => 5000)] ); } { local $ENV{CATALYST_PORT} = 5000; testOption( [ qw// ], [5000, undef, opthash(port => 5000)] ); } if (try { require Plack::Handler::Starman; 1; }) { # fork -f -fork --fork -f --fork testOption( [ qw/--fork/ ], ['3000', undef, opthash(fork => 1)] ); testOption( [ qw/-f/ ], ['3000', undef, opthash(fork => 1)] ); } if (try { require MooseX::Daemonize; 1; }) { # pidfile -pidfile --pid --pidfile testOption( [ qw/--pidfile cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] ); testOption( [ qw/--pid cat.pid/ ], ['3000', undef, opthash(pidfile => "cat.pid")] ); } if (try { require Plack::Handler::Starman; 1; }) { # keepalive -k -keepalive --keepalive -k --keepalive testOption( [ qw/-k/ ], ['3000', undef, opthash(keepalive => 1)] ); testOption( [ qw/--keepalive/ ], ['3000', undef, opthash(keepalive => 1)] ); } # symlinks -follow_symlinks --sym --follow_symlinks # testOption( [ qw/--sym/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); testOption( [ qw/--follow_symlinks/ ], ['3000', undef, opthash(follow_symlinks => 1)] ); if (try { require MooseX::Daemonize; 1; }) { # background -background --bg --background testBackgroundOptionWithFork( [ qw/--background/ ]); testBackgroundOptionWithFork( [ qw/--bg/ ]); } # restart -r -restart --restart -R --restart testRestart( ['-r'], restartopthash() ); { local $ENV{TESTAPPTOTESTSCRIPTS_RELOAD} = 1; testRestart( [], restartopthash() ); } { local $ENV{CATALYST_RELOAD} = 1; testRestart( [], restartopthash() ); } # restart dly -rd -restartdelay --rd --restart_delay testRestart( ['-r', '--rd', 30], restartopthash(sleep_interval => 30) ); testRestart( ['-r', '--restart_delay', 30], restartopthash(sleep_interval => 30) ); # restart dir -restartdirectory --rdir --restart_directory testRestart( ['-r', '--rdir', 'root'], restartopthash(directories => ['root']) ); testRestart( ['-r', '--rdir', 'root', '--rdir', 'lib'], restartopthash(directories => ['root', 'lib']) ); testRestart( ['-r', '--restart_directory', 'root'], restartopthash(directories => ['root']) ); # restart regex -rr -restartregex --rr --restart_regex testRestart( ['-r', '--rr', 'foo'], restartopthash(filter => qr/foo/) ); testRestart( ['-r', '--restart_regex', 'foo'], restartopthash(filter => qr/foo/) ); local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}; local $ENV{CATALYST_RESTARTER}; { is _build_testapp([])->restarter_class, 'Catalyst::Restarter', 'default restarter with no $ENV{CATALYST_RESTARTER}'; } { local $ENV{CATALYST_RESTARTER} = "CatalystX::Restarter::Other"; is _build_testapp([])->restarter_class, $ENV{CATALYST_RESTARTER}, 'override restarter with $ENV{CATALYST_RESTARTER}'; } { local $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER} = "CatalystX::Restarter::Other2"; is _build_testapp([])->restarter_class, $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}, 'override restarter with $ENV{TESTAPPTOTESTSCRIPTS_RESTARTER}'; } done_testing; sub testOption { my ($argstring, $resultarray) = @_; my $app = _build_testapp($argstring); try { $app->run; } catch { fail $_; }; # First element of RUN_ARGS will be the script name, which we don't care about shift @TestAppToTestScripts::RUN_ARGS; my $server = pop @TestAppToTestScripts::RUN_ARGS; like ref($server), qr/^Plack::Handler/, 'Is a Plack::Handler'; my @run_args = @TestAppToTestScripts::RUN_ARGS; $run_args[-1]->{pidfile} = $run_args[-1]->{pidfile}->file->stringify if scalar(@run_args) && $run_args[-1]->{pidfile}; # Mangle argv into the options.. $resultarray->[-1]->{argv} = $argstring; $resultarray->[-1]->{extra_argv} = []; is_deeply \@run_args, $resultarray, "is_deeply comparison " . join(' ', @$argstring); } sub testBackgroundOptionWithFork { my ($argstring) = @_; ## First, make sure we can get an app my $app = _build_testapp($argstring); ## Sorry, don't really fork since this cause trouble in Test::Aggregate $app->meta->add_around_method_modifier('daemon_fork', sub { return; }); try { $app->run; } catch { fail $_; }; ## Check a few args is_deeply $app->{ARGV}, $argstring; is $app->{port}, '3000'; is($app->{background}, 1); } sub testRestart { my ($argstring, $resultarray) = @_; my $app = _build_testapp($argstring); ok $app->restart, 'App is in restart mode'; my $args = {$app->_restarter_args}; is_deeply delete $args->{argv}, $argstring, 'argv is arg string'; is ref(delete $args->{start_sub}), 'CODE', 'Closure to start app present'; is_deeply $args, $resultarray, "is_deeply comparison of restarter args " . join(' ', @$argstring); } sub _build_testapp { my ($argstring, $resultarray) = @_; local @ARGV = @$argstring; local @TestAppToTestScripts::RUN_ARGS; my $i; try { $i = Catalyst::Script::Server->new_with_options(application_name => 'TestAppToTestScripts'); pass "new_with_options " . join(' ', @$argstring); } catch { fail "new_with_options " . join(' ', @$argstring) . " " . $_; }; ok $i; return $i; } # Returns the hash expected when no flags are passed sub opthash { return { 'pidfile' => undef, 'fork' => 0, 'follow_symlinks' => 0, 'background' => 0, 'keepalive' => 0, port => 3000, host => undef, @_, }; } sub restartopthash { my $opthash = opthash(@_); my $val = { application_name => 'TestAppToTestScripts', port => '3000', debug => undef, host => undef, %$opthash, }; return $val; } chdir($cwd); 1; Catalyst-Runtime-5.90053/t/aggregate/unit_core_scriptrunner.t000644 000765 000024 00000001403 12217110343 024360 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use FindBin qw/$Bin/; use Test::Fatal; use lib "$Bin/../lib"; use_ok('Catalyst::ScriptRunner'); is Catalyst::ScriptRunner->run('ScriptTestApp', 'Foo'), 'mooScriptTestApp::Script::Foo42', 'Script existing only in app got trait applied'; is Catalyst::ScriptRunner->run('ScriptTestApp', 'Bar'), 'mooScriptTestApp::Script::Bar23', 'Script existing in both app and Catalyst - prefers app'; is Catalyst::ScriptRunner->run('ScriptTestApp', 'Baz'), 'mooCatalyst::Script::Baz', 'Script existing only in Catalyst'; # +1 test for the params passed to new_with_options in t/lib/Catalyst/Script/Baz.pm like exception { Catalyst::ScriptRunner->run('ScriptTestApp', 'CompileTest'); }, qr/Couldn't load class/; done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_setup.t000644 000765 000024 00000005374 12106042701 022774 0ustar00johnstaff000000 000000 use strict; use warnings; use Class::MOP; use Catalyst::Runtime; use Test::More tests => 29; { # Silence the log. my $meta = Catalyst::Log->meta; $meta->make_mutable; $meta->remove_method('_send_to_log'); $meta->add_method('_send_to_log', sub {}); } sub build_test_app_with_setup { my ($name, @flags) = @_; my $flags = '(' . join(', ', map { "'".$_."'" } @flags) . ')'; $flags = '' if $flags eq '()'; eval qq{ package $name; use Catalyst $flags; $name->setup; }; die $@ if $@; return $name; } local %ENV = %ENV; # Remove all relevant env variables to avoid accidental fail foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) { delete $ENV{$name}; } { my $app = build_test_app_with_setup('TestAppMyTestDebug', '-Debug'); ok my $c = $app->new, 'Get debug app object'; ok my $log = $c->log, 'Get log object'; isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object'; ok $log->is_warn, 'Warnings should be enabled'; ok $log->is_error, 'Errors should be enabled'; ok $log->is_fatal, 'Fatal errors should be enabled'; ok $log->is_info, 'Info should be enabled'; ok $log->is_debug, 'Debugging should be enabled'; ok $app->debug, 'debug method should return true'; } { my $app = build_test_app_with_setup('TestAppMyTestLogParam', '-Log=warn,error,fatal'); ok my $c = $app->new, 'Get log app object'; ok my $log = $c->log, 'Get log object'; isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object'; ok $log->is_warn, 'Warnings should be enabled'; ok $log->is_error, 'Errors should be enabled'; ok $log->is_fatal, 'Fatal errors should be enabled'; ok !$log->is_info, 'Info should be disabled'; ok !$log->is_debug, 'Debugging should be disabled'; ok !$c->debug, 'Catalyst debugging is off'; } { my $app = build_test_app_with_setup('TestAppMyTestNoParams'); ok my $c = $app->new, 'Get log app object'; ok my $log = $c->log, 'Get log object'; isa_ok $log, 'Catalyst::Log', 'It should be a Catalyst::Log object'; ok $log->is_warn, 'Warnings should be enabled'; ok $log->is_error, 'Errors should be enabled'; ok $log->is_fatal, 'Fatal errors should be enabled'; ok $log->is_info, 'Info should be enabled'; ok $log->is_debug, 'Debugging should be enabled'; ok !$c->debug, 'Catalyst debugging turned off'; } my $log_meta = Class::MOP::Class->create_anon_class( methods => { map { $_ => sub { 0 } } qw/debug error fatal info warn/ }, ); { package TestAppWithOwnLogger; use base qw/Catalyst/; __PACKAGE__->log($log_meta->new_object); __PACKAGE__->setup('-Debug'); } ok my $c = TestAppWithOwnLogger->new, 'Get with own logger app object'; ok $c->debug, '$c->debug is true'; Catalyst-Runtime-5.90053/t/aggregate/unit_core_setup_log.t000644 000765 000024 00000004220 12217110343 023623 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 30; use Catalyst (); sub mock_app { my $name = shift; my $meta = Moose->init_meta( for_class => $name ); $meta->superclasses('Catalyst'); return $meta->name; } sub test_log_object { my ($log, %expected) = @_; foreach my $level (keys %expected) { my $method_name = "is_$level"; if ($expected{$level}) { ok( $log->$method_name(), "Level $level on" ); } else { ok( !$log->$method_name(), "Level $level off" ); } } } local %ENV = %ENV; # Remove all relevant env variables to avoid accidental fail foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) { delete $ENV{$name}; } { my $app = mock_app('TestAppParseLogLevels'); $app->setup_log('error,warn'); ok !$app->debug, 'Not in debug mode'; test_log_object($app->log, fatal => 1, error => 1, warn => 1, info => 0, debug => 0, ); } { local %ENV = %ENV; $ENV{CATALYST_DEBUG} = 1; my $app = mock_app('TestAppLogDebugEnvSet'); $app->setup_log(''); ok $app->debug, 'In debug mode'; test_log_object($app->log, fatal => 1, error => 1, warn => 1, info => 1, debug => 1, ); } { local %ENV = %ENV; $ENV{CATALYST_DEBUG} = 0; my $app = mock_app('TestAppLogDebugEnvUnset'); $app->setup_log('warn'); ok !$app->debug, 'Not In debug mode'; test_log_object($app->log, fatal => 1, error => 1, warn => 1, info => 0, debug => 0, ); } { my $app = mock_app('TestAppLogEmptyString'); $app->setup_log(''); ok !$app->debug, 'Not In debug mode'; # Note that by default, you get _all_ the log levels turned on test_log_object($app->log, fatal => 1, error => 1, warn => 1, info => 1, debug => 1, ); } { my $app = mock_app('TestAppLogDebugOnly'); $app->setup_log('debug'); ok $app->debug, 'In debug mode'; test_log_object($app->log, fatal => 1, error => 1, warn => 1, info => 1, debug => 1, ); } Catalyst-Runtime-5.90053/t/aggregate/unit_core_setup_stats.t000644 000765 000024 00000003507 12106042701 024206 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 5; use Class::MOP; use Catalyst (); local our %log_messages; # TODO - Test log messages as expected. my $mock_log = Class::MOP::Class->create_anon_class( methods => { map { my $level = $_; $level => sub { $log_messages{$level} ||= []; push(@{ $log_messages{$level} }, $_[1]); }, } qw/debug info warn error fatal/, }, )->new_object; sub mock_app { my $name = shift; my $mock_log = shift; %log_messages = (); # Flatten log messages. my $meta = Moose->init_meta( for_class => $name ); $meta->superclasses('Catalyst'); $meta->add_method('log', sub { $mock_log }); return $meta->name; } local %ENV = %ENV; # Remove all relevant env variables to avoid accidental fail foreach my $name (grep { /^(CATALYST|TESTAPP)/ } keys %ENV) { delete $ENV{$name}; } { my $app = mock_app('TestAppNoStats', $mock_log); $app->setup_stats(); ok !$app->use_stats, 'stats off by default'; } { my $app = mock_app('TestAppStats', $mock_log); $app->setup_stats(1); ok $app->use_stats, 'stats on if you say >setup_stats(1)'; } { my $app = mock_app('TestAppStatsDebugTurnsStatsOn', $mock_log); $app->meta->add_method('debug' => sub { 1 }); $app->setup_stats(); ok $app->use_stats, 'debug on turns stats on'; } { local %ENV = %ENV; $ENV{CATALYST_STATS} = 1; my $app = mock_app('TestAppStatsEnvSet', $mock_log); $app->setup_stats(); ok $app->use_stats, 'ENV turns stats on'; } { local %ENV = %ENV; $ENV{CATALYST_STATS} = 0; my $app = mock_app('TestAppStatsEnvUnset', $mock_log); $app->meta->add_method('debug' => sub { 1 }); $app->setup_stats(1); ok !$app->use_stats, 'ENV turns stats off, even when debug on and ->setup_stats(1)'; } Catalyst-Runtime-5.90053/t/aggregate/unit_core_uri_for.t000644 000765 000024 00000013515 12121675274 023313 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$FindBin::Bin/../lib"; use Test::More; use URI; use_ok('TestApp'); my $request = Catalyst::Request->new( { _log => Catalyst::Log->new, base => URI->new('http://127.0.0.1/foo') } ); my $dispatcher = TestApp->dispatcher; my $context = TestApp->new( { request => $request, namespace => 'yada', } ); is( Catalyst::uri_for( $context, '/bar/baz' )->as_string, 'http://127.0.0.1/foo/bar/baz', 'URI for absolute path' ); is( Catalyst::uri_for( $context, 'bar/baz' )->as_string, 'http://127.0.0.1/foo/yada/bar/baz', 'URI for relative path' ); is( Catalyst::uri_for( $context, '', 'arg1', 'arg2' )->as_string, 'http://127.0.0.1/foo/yada/arg1/arg2', 'URI for undef action with args' ); is( Catalyst::uri_for( $context, '../quux' )->as_string, 'http://127.0.0.1/foo/quux', 'URI for relative dot path' ); is( Catalyst::uri_for( $context, 'quux', { param1 => 'value1' } )->as_string, 'http://127.0.0.1/foo/yada/quux?param1=value1', 'URI for undef action with query params' ); is (Catalyst::uri_for( $context, '/bar/wibble?' )->as_string, 'http://127.0.0.1/foo/bar/wibble%3F', 'Question Mark gets encoded' ); is( Catalyst::uri_for( $context, qw/bar wibble?/, 'with space' )->as_string, 'http://127.0.0.1/foo/yada/bar/wibble%3F/with%20space', 'Space gets encoded' ); is( Catalyst::uri_for( $context, '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string, 'http://127.0.0.1/foo/bar/with+plus?also=with%2Bplus', 'Plus is not encoded' ); TODO: { local $TODO = 'broken by 5.7008'; is( Catalyst::uri_for( $context, '/bar#fragment', { param1 => 'value1' } )->as_string, 'http://127.0.0.1/foo/bar?param1=value1#fragment', 'URI for path with fragment and query params' ); } # test with utf-8 is( Catalyst::uri_for( $context, 'quux', { param1 => "\x{2620}" } )->as_string, 'http://127.0.0.1/foo/yada/quux?param1=%E2%98%A0', 'URI for undef action with query params in unicode' ); is( Catalyst::uri_for( $context, 'quux', { 'param:1' => "foo" } )->as_string, 'http://127.0.0.1/foo/yada/quux?param%3A1=foo', 'URI for undef action with query params in unicode' ); # test with object is( Catalyst::uri_for( $context, 'quux', { param1 => $request->base } )->as_string, 'http://127.0.0.1/foo/yada/quux?param1=http%3A%2F%2F127.0.0.1%2Ffoo', 'URI for undef action with query param as object' ); $request->base( URI->new('http://localhost:3000/') ); $request->match( 'orderentry/contract' ); is( Catalyst::uri_for( $context, '/Orderentry/saveContract' )->as_string, 'http://localhost:3000/Orderentry/saveContract', 'URI for absolute path' ); { $request->base( URI->new('http://127.0.0.1/') ); $context->namespace(''); is( Catalyst::uri_for( $context, '/bar/baz' )->as_string, 'http://127.0.0.1/bar/baz', 'URI with no base or match' ); # test "0" as the path is( Catalyst::uri_for( $context, qw/0 foo/ )->as_string, 'http://127.0.0.1/0/foo', '0 as path is ok' ); } # test with undef -- no warnings should be thrown { my $warnings = 0; local $SIG{__WARN__} = sub { $warnings++ }; Catalyst::uri_for( $context, '/bar/baz', { foo => undef } )->as_string, is( $warnings, 0, "no warnings emitted" ); } # Test with parameters '/', 'foo', 'bar' - should not generate a // is( Catalyst::uri_for( $context, qw| / foo bar | )->as_string, 'http://127.0.0.1/foo/bar', 'uri is /foo/bar, not //foo/bar' ); TODO: { local $TODO = 'RFCs are for people who, erm - fix this test..'; # Test rfc3986 reserved characters. These characters should all be escaped # according to the RFC, but it is a very big feature change so I've removed it no warnings; # Yes, everything in qw is sane is( Catalyst::uri_for( $context, qw|! * ' ( ) ; : @ & = $ / ? % # [ ] ,|, )->as_string, 'http://127.0.0.1/%21/%2A/%27/%2B/%29/%3B/%3A/%40/%26/%3D/%24/%2C/%2F/%3F/%25/%23/%5B/%5D', 'rfc 3986 reserved characters' ); # jshirley bug - why the hell does only one of these get encoded # has been like this forever however. is( Catalyst::uri_for( $context, qw|{1} {2}| )->as_string, 'http://127.0.0.1/{1}/{2}', 'not-escaping unreserved characters' ); } # make sure caller's query parameter hash isn't messed up { my $query_params_base = {test => "one two", bar => ["foo baz", "bar"]}; my $query_params_test = {test => "one two", bar => ["foo baz", "bar"]}; Catalyst::uri_for($context, '/bar/baz', $query_params_test); is_deeply($query_params_base, $query_params_test, "uri_for() doesn't mess up query parameter hash in the caller"); } { my $path_action = $dispatcher->get_action_by_path( '/action/path/six' ); # 5.80018 is only encoding the first of the / in the arg. is( Catalyst::uri_for( $context, $path_action, 'foo/bar/baz' )->as_string, 'http://127.0.0.1/action/path/six/foo%2Fbar%2Fbaz', 'Escape all forward slashes in args as %2F' ); } { my $index_not_private = $dispatcher->get_action_by_path( '/action/chained/argsorder/index' ); is( Catalyst::uri_for( $context, $index_not_private )->as_string, 'http://127.0.0.1/argsorder', 'Return non-DispatchType::Index path for index action with args' ); } { package MyStringThing; use overload '""' => sub { $_[0]->{string} }, fallback => 1; } is( Catalyst::uri_for( $context, bless( { string => 'test' }, 'MyStringThing' ) ), 'http://127.0.0.1/test', 'overloaded object handled correctly' ); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_uri_for_action.t000644 000765 000024 00000016371 12217110343 024636 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use_ok('TestApp'); my $dispatcher = TestApp->dispatcher; # # Private Action # my $private_action = $dispatcher->get_action_by_path( '/class_forward_test_method' ); ok(!defined($dispatcher->uri_for_action($private_action)), "Private action returns undef for URI"); # # Path Action # my $path_action = $dispatcher->get_action_by_path( '/action/testrelative/relative' ); is($dispatcher->uri_for_action($path_action), "/action/relative/relative", "Public path action returns correct URI"); ok(!defined($dispatcher->uri_for_action($path_action, [ 'foo' ])), "no URI returned for Path action when snippets are given"); # # Index Action # my $index_action = $dispatcher->get_action_by_path( '/action/index/index' ); ok(!defined($dispatcher->uri_for_action($index_action, [ 'foo' ])), "no URI returned for index action when snippets are given"); is($dispatcher->uri_for_action($index_action), "/action/index", "index action returns correct path"); # # Chained Action # my $chained_action = $dispatcher->get_action_by_path( '/action/chained/endpoint', ); ok(!defined($dispatcher->uri_for_action($chained_action)), "Chained action without captures returns undef"); ok(!defined($dispatcher->uri_for_action($chained_action, [ 1, 2 ])), "Chained action with too many captures returns undef"); is($dispatcher->uri_for_action($chained_action, [ 1 ]), "/chained/foo/1/end", "Chained action with correct captures returns correct path"); # # Tests with Context # my $request = Catalyst::Request->new( { _log => Catalyst::Log->new, base => URI->new('http://127.0.0.1/foo') } ); my $context = TestApp->new( { request => $request, namespace => 'yada', } ); is($context->uri_for($context->controller('Action')), "http://127.0.0.1/foo/yada/action/", "uri_for a controller"); is($context->uri_for($path_action), "http://127.0.0.1/foo/action/relative/relative", "uri_for correct for path action"); is($context->uri_for($path_action, qw/one two/, { q => 1 }), "http://127.0.0.1/foo/action/relative/relative/one/two?q=1", "uri_for correct for path action with args and query"); ok(!defined($context->uri_for($path_action, [ 'blah' ])), "no URI returned by uri_for for Path action with snippets"); is($context->uri_for($chained_action, [ 1 ], 2, { q => 1 }), "http://127.0.0.1/foo/chained/foo/1/end/2?q=1", "uri_for correct for chained with captures, args and query"); # # More Chained with Context Tests # { 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_action correct for chained with multiple captures and args' ); 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_action correct for chained with multiple captures and args combined' ); 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_action correct for chained with multiple capturing actions' ); 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_action correct for chained with multiple capturing actions and args combined' ); my $action_needs_two = '/action/chained/endpoint2'; ok( ! defined( $context->uri_for_action($action_needs_two, [1], (2,3)) ), 'uri_for_action returns undef for not enough captures' ); is( $context->uri_for_action($action_needs_two, [1,2], (2,3)), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/2/3', 'uri_for_action returns correct uri for correct captures' ); is( $context->uri_for_action($action_needs_two, [1,2,2,3]), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/2/3', 'uri_for_action returns correct uri for correct captures and args combined' ); ok( ! defined( $context->uri_for_action($action_needs_two, [1,2,3], (2,3)) ), 'uri_for_action returns undef for too many captures' ); is( $context->uri_for_action($action_needs_two, [1,2], (3)), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3', 'uri_for_action returns uri with lesser args than specified on action' ); is( $context->uri_for_action($action_needs_two, [1,2,3]), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3', 'uri_for_action returns uri with lesser args than specified on action with captures combined' ); 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_action returns uri with more args than specified on action' ); 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_action returns uri with more args than specified on action with captures combined' ); 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_action returns uri with empty capture on undef capture' ); 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_action returns uri with empty capture on undef capture and args combined' ); is( $context->uri_for_action($action_needs_two, [1,2], ('',3)), 'http://127.0.0.1/foo/chained/foo2/1/2/end2//3', 'uri_for_action returns uri with empty arg on undef argument' ); is( $context->uri_for_action($action_needs_two, [1,2,'',3]), 'http://127.0.0.1/foo/chained/foo2/1/2/end2//3', 'uri_for_action returns uri with empty arg on undef argument and args combined' ); is( $context->uri_for_action($action_needs_two, [1,2], (3,'')), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/', 'uri_for_action returns uri with empty arg on undef last argument' ); is( $context->uri_for_action($action_needs_two, [1,2,3,'']), 'http://127.0.0.1/foo/chained/foo2/1/2/end2/3/', 'uri_for_action returns uri with empty arg on undef last argument with captures combined' ); 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_action returns correct uri for chain with many empty path parts' ); 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_action returns correct uri for chain with many empty path parts with captures and args combined' ); 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'; } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_uri_for_multibytechar.t000644 000765 000024 00000002544 12121675274 026247 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More; use_ok('TestApp'); my $base = 'http://127.0.0.1'; my $request = Catalyst::Request->new({ _log => Catalyst::Log->new, base => URI->new($base), uri => URI->new("$base/"), }); my $context = TestApp->new({ request => $request, }); my $uri_with_multibyte = URI->new($base); $uri_with_multibyte->path('/'); $uri_with_multibyte->query_form( name => '村瀬大輔', ); # multibyte with utf8 bytes is($context->uri_for('/', { name => '村瀬大輔' }), $uri_with_multibyte, 'uri_for with utf8 bytes query'); is($context->req->uri_with({ name => '村瀬大輔' }), $uri_with_multibyte, 'uri_with with utf8 bytes query'); # multibyte with utf8 string is($context->uri_for('/', { name => "\x{6751}\x{702c}\x{5927}\x{8f14}" }), $uri_with_multibyte, 'uri_for with utf8 string query'); is($context->req->uri_with({ name => "\x{6751}\x{702c}\x{5927}\x{8f14}" }), $uri_with_multibyte, 'uri_with with utf8 string query'); # multibyte captures and args my $action = $context->controller('Action::Chained') ->action_for('roundtrip_urifor_end'); { use utf8; is($context->uri_for($action, ['hütte'], 'hütte', { test => 'hütte' }), 'http://127.0.0.1/chained/roundtrip_urifor/h%C3%BCtte/h%C3%BCtte?test=h%C3%BCtte', 'uri_for with utf8 captures and args'); } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_core_uri_with.t000644 000765 000024 00000004053 12121675274 023475 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use URI; use URI::QueryParam; use Catalyst::Log; use_ok('Catalyst::Request'); sub cmp_uri { my ($got, $exp_txt, $comment) = @_; $comment ||= ''; my $exp = URI->new($exp_txt); foreach my $thing (qw/ scheme host path /) { is $exp->$thing, $got->$thing, "$comment: $thing"; } is_deeply $got->query_form_hash, $exp->query_form_hash, "$comment: query"; } my $request = Catalyst::Request->new( { _log => Catalyst::Log->new, uri => URI->new('http://127.0.0.1/foo/bar/baz') } ); cmp_uri( $request->uri_with({}), 'http://127.0.0.1/foo/bar/baz', 'URI for absolute path' ); cmp_uri( $request->uri_with({ foo => 'bar' }), 'http://127.0.0.1/foo/bar/baz?foo=bar', 'URI adds param' ); my $request2 = Catalyst::Request->new( { _log => Catalyst::Log->new, uri => URI->new('http://127.0.0.1/foo/bar/baz?bar=gorch') } ); cmp_uri( $request2->uri_with({}), 'http://127.0.0.1/foo/bar/baz?bar=gorch', 'URI retains param' ); cmp_uri( $request2->uri_with({ me => 'awesome' }), 'http://127.0.0.1/foo/bar/baz?bar=gorch&me=awesome', 'URI retains param and adds new' ); cmp_uri( $request2->uri_with({ bar => undef }), 'http://127.0.0.1/foo/bar/baz', 'URI loses param when explicitly undef' ); cmp_uri( $request2->uri_with({ bar => 'snort' }), 'http://127.0.0.1/foo/bar/baz?bar=snort', 'URI changes param' ); cmp_uri( $request2->uri_with({ bar => [ 'snort', 'ewok' ] }), 'http://127.0.0.1/foo/bar/baz?bar=snort&bar=ewok', 'overwrite mode URI appends arrayref param' ); cmp_uri( $request2->uri_with({ bar => 'snort' }, { mode => 'append' }), 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort', 'append mode URI appends param' ); cmp_uri( $request2->uri_with({ bar => [ 'snort', 'ewok' ] }, { mode => 'append' }), 'http://127.0.0.1/foo/bar/baz?bar=gorch&bar=snort&bar=ewok', 'append mode URI appends arrayref param' ); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_dispatcher_requestargs_restore.t000644 000765 000024 00000001470 12106042701 027133 0ustar00johnstaff000000 000000 # Insane test case for the behavior needed by Plugin::Auhorization::ACL # We have to localise $c->request->{arguments} in # Catalyst::Dispatcher::_do_forward, rather than using save and restore, # as otherwise, the calling $c->detach on an action which says # die $Catalyst:DETACH causes the request arguments to not get restored, # and therefore sub gorch gets the wrong string $frozjob parameter. # Please feel free to break this behavior once a sane hook for safely # executing another action from the dispatcher (i.e. wrapping actions) # is present, so that the Authorization::ACL plugin can be re-written # to not be full of such crazy shit. use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Catalyst::Test 'ACLTestApp'; use Test::More tests => 1; request('http://localhost/gorch/wozzle'); Catalyst-Runtime-5.90053/t/aggregate/unit_engineloader.t000644 000765 000024 00000001476 12106042701 023257 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use Catalyst::EngineLoader; my $cases = { FastCGI => { expected_catalyst_engine_class => 'Catalyst::Engine', ENV => { CATALYST_ENGINE => 'FastCGI' }, }, CGI => { expected_catalyst_engine_class => 'Catalyst::Engine', ENV => { CATALYST_ENGINE => 'CGI' }, }, Apache1 => { expected_catalyst_engine_class => 'Catalyst::Engine', ENV => { CATALYST_ENGINE => 'Apache1' }, }, }; foreach my $name (keys %$cases) { local %ENV = %{ $cases->{$name}->{ENV} }; my $loader = Catalyst::EngineLoader->new(application_name => "TestApp"); if (my $expected = $cases->{$name}->{expected_catalyst_engine_class}) { is $loader->catalyst_engine_class, $expected, $name . " catalyst_engine_class"; } } done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_load_catalyst_test.t000644 000765 000024 00000013357 12217110343 024507 0ustar00johnstaff000000 000000 #!perl use strict; use warnings; use Test::More; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use Catalyst::Utils; use HTTP::Request::Common; use Test::Fatal; my $Class = 'Catalyst::Test'; my $App = 'TestApp'; my $Pkg = __PACKAGE__; my $Url = 'http://localhost/'; my $Content = "root index"; my %Meth = ( $Pkg => [qw|get request ctx_request|], # exported $Class => [qw|local_request remote_request|], # not exported ); ### make sure we're not trying to connect to a remote host -- these are local tests local $ENV{CATALYST_SERVER}; use Catalyst::Test (); ### 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" ); ok( $res->request, " Response has request object" ); is exception { is( $res->request->uri, $Url) }, undef, " Request object has correct url"; } } } ### perl5.8.8 + cat 5.80's Cat::Test->ctx_request didn't return $c the 2nd ### time it was invoked. Without tracking the bug down all the way, it was ### clearly related to the Moose'ification of Cat::Test and a scoping issue ### with a 'my'd variable. Since the same code works fine in 5.10, a bug in ### either Moose or perl 5.8 is suspected. { ok( 1, "Testing consistency of ctx_request()" ); for( 1..2 ) { my($res, $c) = ctx_request( $Url ); ok( $c, " Call $_: Context object returned" ); } } # FIXME - These vhosts in tests tests should be somewhere else... sub customize { Catalyst::Test::_customize_request($_[0], {}, @_[1 .. $#_]) } { my $req = Catalyst::Utils::request('/dummy'); customize( $req ); is( $req->header('Host'), undef, 'normal request is unmodified' ); } { my $req = Catalyst::Utils::request('/dummy'); customize( $req, { host => 'customized.com' } ); like( $req->header('Host'), qr/customized.com/, 'request is customizable via opts hash' ); } { my $req = Catalyst::Utils::request('/dummy'); local $Catalyst::Test::default_host = 'localized.com'; customize( $req ); like( $req->header('Host'), qr/localized.com/, 'request is customizable via package var' ); } { my $req = Catalyst::Utils::request('/dummy'); local $Catalyst::Test::default_host = 'localized.com'; customize( $req, { host => 'customized.com' } ); like( $req->header('Host'), qr/customized.com/, 'opts hash takes precedence over package var' ); } { my $req = Catalyst::Utils::request('/dummy'); local $Catalyst::Test::default_host = 'localized.com'; customize( $req, { host => '' } ); is( $req->header('Host'), undef, 'default value can be temporarily cleared via opts hash' ); } # Back compat test, extra args used to be ignored, now a hashref of options. use_ok('Catalyst::Test', 'TestApp', 'foobar'); # Back compat test, ensure that request ignores anything which isn't a hash. is exception { request(GET('/dummy'), 'foo'); }, undef, 'scalar additional param to request method ignored'; is exception { request(GET('/dummy'), []); }, undef, 'array additional param to request method ignored'; my $res = request(GET('/')); is $res->code, 200, 'Response code 200'; is $res->headers->{status}, 200, 'Back compat "status" header present'; done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t000644 000765 000024 00000000526 12217110343 032024 0ustar00johnstaff000000 000000 use Catalyst (); { package TestApp; use base qw/Catalyst/; } { package TestApp::Controller::Base; use base qw/Catalyst::Controller/; } { package TestApp::Controller::Other; use Moose; use Test::More tests => 1; use Test::Fatal; is exception { extends 'TestApp::Controller::Base'; }, undef; } Catalyst-Runtime-5.90053/t/aggregate/unit_metaclass_compat_non_moose.t000644 000765 000024 00000000144 12217110343 026206 0ustar00johnstaff000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More tests => 1; use_ok('TestAppMetaCompat'); Catalyst-Runtime-5.90053/t/aggregate/unit_metaclass_compat_non_moose_controller.t000644 000765 000024 00000000756 12217110343 030462 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 1; use Test::Fatal; use TestAppNonMooseController; # Metaclass init order causes fail. # There are TODO tests in Moose for this, see # f2391d17574eff81d911b97be15ea51080500003 # after which the evil kludge in core can die in a fire. is exception { TestAppNonMooseController::ControllerBase->get_action_methods }, undef, 'Base class->get_action_methods ok when sub class initialized first'; Catalyst-Runtime-5.90053/t/aggregate/unit_response.t000644 000765 000024 00000000547 12106042701 022457 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use_ok('Catalyst::Response'); use_ok('Catalyst::Engine'); 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'); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_utils_env_value.t000644 000765 000024 00000002745 12106042701 024027 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 4; use Catalyst::Utils; ############################################################################## ### No env vars defined ############################################################################## { ok( !Catalyst::Utils::env_value( 'MyApp', 'Key' ), 'No env values defined returns false' ); } ############################################################################## ### App env var defined ############################################################################## { $ENV{'MYAPP2_KEY'} = 'Env value 2'; is( Catalyst::Utils::env_value( 'MyApp2', 'Key' ), 'Env value 2', 'Got the right value from the application var' ); } ############################################################################## ### Catalyst env var defined ############################################################################## { $ENV{'CATALYST_KEY'} = 'Env value 3'; is( Catalyst::Utils::env_value( 'MyApp3', 'Key' ), 'Env value 3', 'Got the right value from the catalyst var' ); } ############################################################################## ### Catalyst and Application env vars defined ############################################################################## { $ENV{'CATALYST_KEY'} = 'Env value bad'; $ENV{'MYAPP4_KEY'} = 'Env value 4'; is( Catalyst::Utils::env_value( 'MyApp4', 'Key' ), 'Env value 4', 'Got the right value from the application var' ); } Catalyst-Runtime-5.90053/t/aggregate/unit_utils_home.t000644 000765 000024 00000001726 12132030171 022766 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More; use File::Temp qw/ tempdir /; use Catalyst::Utils; use File::Spec; use Path::Class qw/ dir /; use Cwd qw/ cwd /; my @dists = Catalyst::Utils::dist_indicator_file_list(); is(scalar(@dists), 4, 'Makefile.PL Build.PL dist.ini cpanfile'); my $cwd = cwd(); foreach my $inc ('', 'lib', 'blib'){ my $d = tempdir(CLEANUP => 1); chdir($d); local $INC{'MyApp.pm'} = File::Spec->catfile($d, $inc, 'MyApp.pm'); ok !Catalyst::Utils::home('MyApp'), "No files found inc $inc"; open(my $fh, '>', "Makefile.PL"); close($fh); is Catalyst::Utils::home('MyApp'), dir($d)->absolute->cleanup, "Did find inc '$inc'"; } { my $d = tempdir(CLEANUP => 1); local $INC{'MyApp.pm'} = File::Spec->catfile($d, 'MyApp.pm'); ok !Catalyst::Utils::home('MyApp'), 'No files found'; mkdir File::Spec->catdir($d, 'MyApp'); is Catalyst::Utils::home('MyApp'), dir($d, 'MyApp')->absolute->cleanup; } chdir($cwd); done_testing; Catalyst-Runtime-5.90053/t/aggregate/unit_utils_prefix.t000644 000765 000024 00000002001 12217110343 023322 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 8; use lib "t/lib"; use Catalyst::Utils; is( Catalyst::Utils::class2prefix('MyApp::V::Foo::Bar'), 'foo/bar', 'class2prefix works with M/V/C' ); is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::Bar'), 'foo/bar', 'class2prefix works with Model/View/Controller' ); is( Catalyst::Utils::class2prefix('MyApp::Controller::Foo::View::Bar'), 'foo/view/bar', 'class2prefix works with tricky components' ); is( Catalyst::Utils::appprefix('MyApp::Foo'), 'myapp_foo', 'appprefix works' ); is( Catalyst::Utils::class2appclass('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo', 'class2appclass works' ); is( Catalyst::Utils::class2classprefix('MyApp::Foo::Controller::Bar::View::Baz'), 'MyApp::Foo::Controller', 'class2classprefix works' ); is( Catalyst::Utils::class2classsuffix('MyApp::Foo::Controller::Bar::View::Baz'), 'Controller::Bar::View::Baz', 'class2classsuffix works' ); is( Catalyst::Utils::class2env('MyApp::Foo'), 'MYAPP_FOO', 'class2env works' ); Catalyst-Runtime-5.90053/t/aggregate/unit_utils_request.t000644 000765 000024 00000001112 12106042701 023516 0ustar00johnstaff000000 000000 use strict; use warnings; use Test::More tests => 4; use Catalyst::Utils; { my $url = "/dump"; ok( my $request = Catalyst::Utils::request($url), "Request: simple get without protocol nor host" ); like( $request->uri, qr|^http://localhost/|, " has default protocol and host" ); } { my $url = "/dump?url=http://www.somewhere.com/"; ok( my $request = Catalyst::Utils::request($url), "Same with param containing a url" ); like( $request->uri, qr|^http://localhost/|, " has default protocol and host" ); } Catalyst-Runtime-5.90053/t/aggregate/utf8_content_length.t000644 000765 000024 00000001312 12106042701 023532 0ustar00johnstaff000000 000000 use strict; use warnings; use FindBin qw/$Bin/; use lib "$Bin/../lib"; use File::Spec; use Test::More; BEGIN { delete $ENV{CATALYST_HOME} } use Catalyst::Test qw/TestAppEncoding/; if ( $ENV{CATALYST_SERVER} ) { plan skip_all => 'This test does not run live'; exit 0; } my $fn = "$Bin/../catalyst_130pix.gif"; ok -r $fn, 'Can read catalyst_130pix.gif'; my $size = -s $fn; { my $r = request('/binary'); is $r->code, 200, '/binary OK'; is $r->header('Content-Length'), $size, '/binary correct content length'; } { my $r = request('/binary_utf8'); is $r->code, 200, '/binary_utf8 OK'; is $r->header('Content-Length'), $size, '/binary_utf8 correct content length'; } done_testing; Catalyst-Runtime-5.90053/script/catalyst.pl000755 000765 000024 00000010437 12106042701 020673 0ustar00johnstaff000000 000000 #!/usr/bin/perl -w use strict; use Getopt::Long; use Pod::Usage; BEGIN { eval " use Catalyst::Devel 1.0; "; if ($@) { die < \$help, 'force|nonew' => \$force, 'makefile' => \$makefile, 'scripts' => \$scripts, ); pod2usage(1) if ( $help || !$ARGV[0] ); my $helper = Catalyst::Helper->new( { '.newfiles' => !$force, 'makefile' => $makefile, 'scripts' => $scripts, name => $ARGV[0], } ); # Pass $ARGV[0] for compatibility with old ::Devel pod2usage(1) unless $helper->mk_app( $ARGV[0] ); 1; __END__ =head1 NAME catalyst - Bootstrap a Catalyst application =head1 SYNOPSIS catalyst.pl [options] application-name 'catalyst.pl' creates a skeleton for a new application, and allows you to upgrade the skeleton of your old application. Options: -force don't create a .new file where a file to be created exists -help display this help and exit -makefile only update Makefile.PL -scripts only update helper scripts application-name must be a valid Perl module name and can include "::", which will be converted to '-' in the project name. Examples: catalyst.pl My::App catalyst.pl MyApp To upgrade your app to a new version of Catalyst: catalyst.pl -force -scripts MyApp =head1 DESCRIPTION The C script bootstraps a Catalyst application, creating a directory structure populated with skeleton files. The application name must be a valid Perl module name. The name of the directory created is formed from the application name supplied, with double colons replaced with hyphens (so, for example, the directory for C is C). Using the example application name C, the application directory will contain the following items: =over 4 =item README a skeleton README file, which you are encouraged to expand on =item Changes a changes file with an initial entry for the creation of the application =item Makefile.PL Makefile.PL uses the C system for packaging and distribution of the application. =item lib contains the application module (C) and subdirectories for model, view, and controller components (C, C, and C). =item root root directory for your web document content. This is left empty. =item script a directory containing helper scripts: =over 4 =item C helper script to generate new component modules =item C runs the generated application within a Catalyst test server, which can be used for testing without resorting to a full-blown web server configuration. =item C runs the generated application as a CGI script =item C runs the generated application as a FastCGI script =item C runs an action of the generated application from the command line. =back =item t test directory =back The application module generated by the C script is functional, although it reacts to all requests by outputting a friendly welcome screen. =head1 NOTE Neither C nor the generated helper script will overwrite existing files. In fact the scripts will generate new versions of any existing files, adding the extension C<.new> to the filename. The C<.new> file is not created if would be identical to the existing file. This means you can re-run the scripts for example to see if newer versions of Catalyst or its plugins generate different code, or to see how you may have 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, L =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/000755 000765 000024 00000000000 12255610005 017533 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst.pm000644 000765 000024 00000346725 12255602510 020114 0ustar00johnstaff000000 000000 package Catalyst; use Moose; use Moose::Meta::Class (); extends 'Catalyst::Component'; use Moose::Util qw/find_meta/; use namespace::clean -except => 'meta'; use Catalyst::Exception; use Catalyst::Exception::Detach; use Catalyst::Exception::Go; use Catalyst::Log; use Catalyst::Request; use Catalyst::Request::Upload; use Catalyst::Response; use Catalyst::Utils; use Catalyst::Controller; use Data::OptList; use Devel::InnerPackage (); use Module::Pluggable::Object (); use Text::SimpleTable (); use Path::Class::Dir (); use Path::Class::File (); use URI (); use URI::http; use URI::https; use HTML::Entities; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use Class::C3::Adopt::NEXT; use List::MoreUtils qw/uniq/; use attributes; use String::RewritePrefix; use Catalyst::EngineLoader; use utf8; use Carp qw/croak carp shortmess/; use Try::Tiny; use Safe::Isa; use Moose::Util 'find_meta'; use Plack::Middleware::Conditional; use Plack::Middleware::ReverseProxy; use Plack::Middleware::IIS6ScriptNameFix; use Plack::Middleware::IIS7KeepAliveFix; use Plack::Middleware::LighttpdScriptNameFix; use Plack::Util; use Class::Load 'load_class'; BEGIN { require 5.008003; } has stack => (is => 'ro', default => sub { [] }); has stash => (is => 'rw', default => sub { {} }); has state => (is => 'rw', default => 0); has stats => (is => 'rw'); has action => (is => 'rw'); has counter => (is => 'rw', default => sub { {} }); has request => ( is => 'rw', default => sub { my $self = shift; $self->request_class->new($self->_build_request_constructor_args); }, lazy => 1, ); sub _build_request_constructor_args { my $self = shift; my %p = ( _log => $self->log ); $p{_uploadtmp} = $self->_uploadtmp if $self->_has_uploadtmp; $p{data_handlers} = {$self->registered_data_handlers}; $p{_use_hash_multivalue} = $self->config->{use_hash_multivalue_in_request} if $self->config->{use_hash_multivalue_in_request}; \%p; } has response => ( is => 'rw', default => sub { my $self = shift; $self->response_class->new($self->_build_response_constructor_args); }, lazy => 1, ); sub _build_response_constructor_args { my $self = shift; { _log => $self->log }; } has namespace => (is => 'rw'); sub depth { scalar @{ shift->stack || [] }; } sub comp { shift->component(@_) } sub req { my $self = shift; return $self->request(@_); } sub res { my $self = shift; return $self->response(@_); } # For backwards compatibility sub finalize_output { shift->finalize_body(@_) }; # For statistics our $COUNT = 1; our $START = time; our $RECURSION = 1000; our $DETACH = Catalyst::Exception::Detach->new; our $GO = Catalyst::Exception::Go->new; #I imagine that very few of these really need to be class variables. if any. #maybe we should just make them attributes with a default? __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class engine_loader context_class request_class response_class stats_class setup_finished _psgi_app loading_psgi_file run_options _psgi_middleware _data_handlers/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); # Remember to update this in Catalyst::Runtime as well! our $VERSION = '5.90053'; sub import { my ( $class, @arguments ) = @_; # We have to limit $class to Catalyst to avoid pushing Catalyst upon every # callers @ISA. return unless $class eq 'Catalyst'; my $caller = caller(); return if $caller eq 'main'; my $meta = Moose::Meta::Class->initialize($caller); unless ( $caller->isa('Catalyst') ) { my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller'); $meta->superclasses(@superclasses); } # Avoid possible C3 issues if 'Moose::Object' is already on RHS of MyApp $meta->superclasses(grep { $_ ne 'Moose::Object' } $meta->superclasses); unless( $meta->has_method('meta') ){ if ($Moose::VERSION >= 1.15) { $meta->_add_meta_method('meta'); } else { $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } ); } } $caller->arguments( [@arguments] ); $caller->setup_home; } sub _application { $_[0] } =encoding UTF-8 =head1 NAME Catalyst - The Elegant MVC Web Application Framework =head1 SYNOPSIS See the L distribution for comprehensive documentation and tutorials. # Install Catalyst::Devel for helpers and other development tools # use the helper to create a new application catalyst.pl MyApp # add models, views, controllers script/myapp_create.pl model MyDatabase DBIC::Schema create=static dbi:SQLite:/path/to/db script/myapp_create.pl view MyTemplate TT script/myapp_create.pl controller Search # built in testserver -- use -r to restart automatically on changes # --help to see all available options script/myapp_server.pl # command line testing interface script/myapp_test.pl /yada ### in lib/MyApp.pm use Catalyst qw/-Debug/; # include plugins here as well ### In lib/MyApp/Controller/Root.pm (autocreated) sub foo : Chained('/') Args() { # called for /foo, /foo/1, /foo/1/2, etc. my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2 $c->stash->{template} = 'foo.tt'; # set the template # lookup something from db -- stash vars are passed to TT $c->stash->{data} = $c->model('Database::Foo')->search( { country => $args[0] } ); if ( $c->req->params->{bar} ) { # access GET or POST parameters $c->forward( 'bar' ); # process another action # do something else after forward returns } } # The foo.tt TT template can use the stash data from the database [% WHILE (item = data.next) %] [% item.foo %] [% END %] # called for /bar/of/soap, /bar/of/soap/10, etc. sub bar : Chained('/') PathPart('/bar/of/soap') Args() { ... } # called after all actions are finished sub end : Action { my ( $self, $c ) = @_; if ( scalar @{ $c->error } ) { ... } # handle errors return if $c->res->body; # already have a response $c->forward( 'MyApp::View::TT' ); # render template } See L for additional information. =head1 DESCRIPTION Catalyst is a modern framework for making web applications without the pain usually associated with this process. This document is a reference to the main Catalyst application. If you are a new user, we suggest you start with L or L. See L for more documentation. Catalyst plugins can be loaded by naming them as arguments to the "use Catalyst" statement. Omit the C prefix from the plugin name, i.e., C becomes C. use Catalyst qw/My::Module/; If your plugin starts with a name other than C, you can fully qualify the name by using a unary plus: use Catalyst qw/ My::Module +Fully::Qualified::Plugin::Name /; Special flags like C<-Debug> can also be specified as arguments when Catalyst is loaded: use Catalyst qw/-Debug My::Module/; The position of plugins and flags in the chain is important, because they are loaded in the order in which they appear. The following flags are supported: =head2 -Debug Enables debug output. You can also force this setting from the system environment with CATALYST_DEBUG or _DEBUG. The environment settings override the application, with _DEBUG having the highest priority. This sets the log level to 'debug' and enables full debug output on the error screen. If you only want the latter, see L<< $c->debug >>. =head2 -Home Forces Catalyst to use a specific home directory, e.g.: use Catalyst qw[-Home=/usr/mst]; This can also be done in the shell environment by setting either the C environment variable or C; where C is replaced with the uppercased name of your application, any "::" in the name will be replaced with underscores, e.g. MyApp::Web should use MYAPP_WEB_HOME. If both variables are set, the MYAPP_HOME one will be used. If none of these are set, Catalyst will attempt to automatically detect the home directory. If you are working in a development environment, Catalyst will try and find the directory containing either Makefile.PL, Build.PL, dist.ini, or cpanfile. If the application has been installed into the system (i.e. you have done C), then Catalyst will use the path to your application module, without the .pm extension (e.g., /foo/MyApp if your application was installed at /foo/MyApp.pm) =head2 -Log use Catalyst '-Log=warn,fatal,error'; Specifies a comma-delimited list of log levels. =head2 -Stats Enables statistics collection and reporting. use Catalyst qw/-Stats=1/; You can also force this setting from the system environment with CATALYST_STATS or _STATS. The environment settings override the application, with _STATS having the highest priority. Stats are also enabled if L<< debugging |/"-Debug" >> is enabled. =head1 METHODS =head2 INFORMATION ABOUT THE CURRENT REQUEST =head2 $c->action Returns a L object for the current action, which stringifies to the action name. See L. =head2 $c->namespace Returns the namespace of the current action, i.e., the URI prefix corresponding to the controller of the current action. For example: # in Controller::Foo::Bar $c->namespace; # returns 'foo/bar'; =head2 $c->request =head2 $c->req Returns the current L object, giving access to information about the current client request (including parameters, cookies, HTTP headers, etc.). See L. =head2 REQUEST FLOW HANDLING =head2 $c->forward( $action [, \@arguments ] ) =head2 $c->forward( $class, $method, [, \@arguments ] ) This is one way of calling another action (method) in the same or a different controller. You can also use C<< $self->my_method($c, @args) >> in the same controller or C<< $c->controller('MyController')->my_method($c, @args) >> in a different controller. The main difference is that 'forward' uses some of the Catalyst request cycle overhead, including debugging, which may be useful to you. On the other hand, there are some complications to using 'forward', restrictions on values returned from 'forward', and it may not handle errors as you prefer. Whether you use 'forward' or not is up to you; it is not considered superior to the other ways to call a method. 'forward' calls another action, by its private name. If you give a class name but no method, C is called. You may also optionally pass arguments in an arrayref. The action will receive the arguments in C<@_> and C<< $c->req->args >>. Upon returning from the function, C<< $c->req->args >> will be restored to the previous values. Any data Ced from the action forwarded to, will be returned by the call to forward. my $foodata = $c->forward('/foo'); $c->forward('index'); $c->forward(qw/Model::DBIC::Foo do_stuff/); $c->forward('View::TT'); Note that L<< forward|/"$c->forward( $action [, \@arguments ] )" >> implies an C<< eval { } >> around the call (actually L<< execute|/"$c->execute( $class, $coderef )" >> does), thus rendering all exceptions thrown by the called action non-fatal and pushing them onto $c->error instead. If you want C to propagate you need to do something like: $c->forward('foo'); die join "\n", @{ $c->error } if @{ $c->error }; Or make sure to always return true values from your actions and write your code like this: $c->forward('foo') || return; Another note is that C<< $c->forward >> always returns a scalar because it actually returns $c->state which operates in a scalar context. Thus, something like: return @array; in an action that is forwarded to is going to return a scalar, i.e. how many items are in that array, which is probably not what you want. If you need to return an array then return a reference to it, or stash it like so: $c->stash->{array} = \@array; and access it from the stash. Keep in mind that the C method used is that of the caller action. So a C<$c-Edetach> inside a forwarded action would run the C method from the original action requested. =cut sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) } =head2 $c->detach( $action [, \@arguments ] ) =head2 $c->detach( $class, $method, [, \@arguments ] ) =head2 $c->detach() The same as L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but doesn't return to the previous action when processing is finished. When called with no arguments it escapes the processing chain entirely. =cut 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 L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, but does a full dispatch, instead of just calling the new C<$action> / C<< $class->$method >>. This means that C, C and the method you go to are called, just like a new request. In addition both C<< $c->action >> and C<< $c->namespace >> are localized. This means, for example, that C<< $c->action >> methods such as L, L and L return information for the visited action when they are invoked within the visited action. This is different from the behavior of L<< forward|/"$c->forward( $action [, \@arguments ] )" >>, which continues to use the $c->action object from the caller action even when invoked from the called action. C<< $c->stash >> is kept unchanged. In effect, L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> allows you to "wrap" another action, just as it would have been called by dispatching from a URL, while the analogous L<< go|/"$c->go( $action [, \@captures, \@arguments ] )" >> allows you to transfer control to another action as if it had been reached directly from a URL. =cut 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 ] ) The relationship between C and L<< visit|/"$c->visit( $action [, \@captures, \@arguments ] )" >> is the same as the relationship between L<< forward|/"$c->forward( $class, $method, [, \@arguments ] )" >> and L<< detach|/"$c->detach( $action [, \@arguments ] )" >>. Like C<< $c->visit >>, C<< $c->go >> will perform a full dispatch on the specified action or method, with localized C<< $c->action >> and C<< $c->namespace >>. Like C, C escapes the processing of the current request chain on completion, and does not return to its caller. @arguments are arguments to the final destination of $action. @captures are arguments to the intermediate steps, if any, on the way to the final sub of $action. =cut sub go { my $c = shift; $c->dispatcher->go( $c, @_ ) } =head2 $c->response =head2 $c->res Returns the current L object, see there for details. =head2 $c->stash Returns a hashref to the stash, which may be used to store data and pass it between components during a request. You can also set hash keys by passing arguments. The stash is automatically sent to the view. The stash is cleared at the end of a request; it cannot be used for persistent storage (for this you must use a session; see L for a complete system integrated with Catalyst). $c->stash->{foo} = $bar; $c->stash( { moose => 'majestic', qux => 0 } ); $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref # stash is automatically passed to the view for use in a template $c->forward( 'MyApp::View::TT' ); =cut around stash => sub { my $orig = shift; my $c = shift; my $stash = $orig->($c); if (@_) { my $new_stash = @_ > 1 ? {@_} : $_[0]; croak('stash takes a hash or hashref') unless ref $new_stash; foreach my $key ( keys %$new_stash ) { $stash->{$key} = $new_stash->{$key}; } } return $stash; }; =head2 $c->error =head2 $c->error($error, ...) =head2 $c->error($arrayref) Returns an arrayref containing error messages. If Catalyst encounters an error while processing a request, it stores the error in $c->error. This method should only be used to store fatal error messages. my @error = @{ $c->error }; Add a new error. $c->error('Something bad happened'); =cut sub error { my $c = shift; if ( $_[0] ) { my $error = ref $_[0] eq 'ARRAY' ? $_[0] : [@_]; croak @$error unless ref $c; push @{ $c->{error} }, @$error; } elsif ( defined $_[0] ) { $c->{error} = undef } return $c->{error} || []; } =head2 $c->state Contains the return value of the last executed action. Note that << $c->state >> operates in a scalar context which means that all values it returns are scalar. =head2 $c->clear_errors Clear errors. You probably don't want to clear the errors unless you are implementing a custom error screen. This is equivalent to running $c->error(0); =cut sub clear_errors { my $c = shift; $c->error(0); } sub _comp_search_prefixes { my $c = shift; return map $c->components->{ $_ }, $c->_comp_names_search_prefixes(@_); } # search components given a name and some prefixes sub _comp_names_search_prefixes { my ( $c, $name, @prefixes ) = @_; my $appclass = ref $c || $c; my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; $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; } grep { /$filter/ } keys %{ $c->components }; # undef for a name will return all return keys %eligible if !defined $name; my $query = $name->$_isa('Regexp') ? $name : qr/^$name$/i; my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible; return @result if @result; # if we were given a regexp to search against, we're done. return if $name->$_isa('Regexp'); # skip regexp fallback if configured return if $appclass->config->{disable_component_resolution_regex_fallback}; # regexp fallback $query = qr/$name/i; @result = grep { $eligible{ $_ } =~ m{$query} } keys %eligible; # no results? try against full names if( !@result ) { @result = grep { m{$query} } keys %eligible; } # don't warn if we didn't find any results, it just might not exist if( @result ) { # 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]; # remove the component namespace prefix $short =~ s/.*?(Model|Controller|View):://; my $shortmess = Carp::shortmess(''); if ($shortmess =~ m#Catalyst/Plugin#) { $msg .= " You probably need to set '$short' instead of '${name}' in this " . "plugin's config"; } elsif ($shortmess =~ m#Catalyst/lib/(View|Controller)#) { $msg .= " You probably need to set '$short' instead of '${name}' in this " . "component's config"; } else { $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->${warn_for}(qr/${name}/)"; } $c->log->warn( "${msg}$shortmess" ); } return @result; } # Find possible names for a prefix sub _comp_names { my ( $c, @prefixes ) = @_; my $appclass = ref $c || $c; my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::'; my @names = map { s{$filter}{}; $_; } $c->_comp_names_search_prefixes( undef, @prefixes ); return @names; } # 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 ); } return $comp; } =head2 COMPONENT ACCESSORS =head2 $c->controller($name) Gets a L instance by name. $c->controller('Foo')->do_stuff; 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 ) = @_; my $appclass = ref($c) || $c; if( $name ) { unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps my $comps = $c->components; my $check = $appclass."::Controller::".$name; return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; } 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 ); } =head2 $c->model($name) Gets a L instance by name. $c->model('Foo')->do_stuff; 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 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. 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 ) = @_; my $appclass = ref($c) || $c; if( $name ) { unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps my $comps = $c->components; my $check = $appclass."::Model::".$name; return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; } 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}; return $c->model( $c->stash->{current_model} ) if $c->stash->{current_model}; } return $c->model( $appclass->config->{default_model} ) if $appclass->config->{default_model}; my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/); if( $rest ) { $c->log->warn( Carp::shortmess('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.81, the "random" behavior will not work at all.' ); } return $c->_filter_component( $comp ); } =head2 $c->view($name) Gets a L instance by name. $c->view('Foo')->do_stuff; 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 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 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 ) = @_; my $appclass = ref($c) || $c; if( $name ) { unless ( $name->$_isa('Regexp') ) { # Direct component hash lookup to avoid costly regexps my $comps = $c->components; my $check = $appclass."::View::".$name; if( exists $comps->{$check} ) { return $c->_filter_component( $comps->{$check}, @args ); } else { $c->log->warn( "Attempted to use view '$check', but does not exist" ); } } 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}; return $c->view( $c->stash->{current_view} ) if $c->stash->{current_view}; } return $c->view( $appclass->config->{default_view} ) if $appclass->config->{default_view}; 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.81, 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 =cut sub models { my ( $c ) = @_; return $c->_comp_names(qw/Model M/); } =head2 $c->views Returns the available names which can be passed to $c->view =cut sub views { my ( $c ) = @_; return $c->_comp_names(qw/View V/); } =head2 $c->comp($name) =head2 $c->component($name) Gets a component object by name. This method is not recommended, unless you want to get a specific component by full 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. If Catalyst can't find a component by name, it will fallback to regex matching by default. To disable this behaviour set disable_component_resolution_regex_fallback to a true value. __PACKAGE__->config( disable_component_resolution_regex_fallback => 1 ); =cut sub component { my ( $c, $name, @args ) = @_; if( $name ) { my $comps = $c->components; if( !ref $name ) { # is it the exact name? return $c->_filter_component( $comps->{ $name }, @args ) 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 }; # 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; } return if $c->config->{disable_component_resolution_regex_fallback}; # This is here so $c->comp( '::M::' ) works 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; if( $result[ 0 ] ) { $c->log->warn( Carp::shortmess(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 ); } # 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 Returns or takes a hashref containing the application's configuration. __PACKAGE__->config( { db => 'dsn:SQLite:foo.db' } ); You can also use a C, C or L config file like C in your applications home directory. See L. =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 takes precedence over other configuration, followed by configuration in your top level C class. These two configurations are merged, and then configuration data whose hash key matches a component name is merged with configuration for that component. The configuration for a component is then passed to the C 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 receives the following data when constructed: MyApp::Model::Foo->new({ bar => 'baz', quux => 'frob', overrides => 'me', }); It's common practice to use a Moose attribute on the receiving component to access the config value. package MyApp::Model::Foo; use Moose; # this attr will receive 'baz' at construction time has 'bar' => ( is => 'rw', isa => 'Str', ); You can then get the value 'baz' by calling $c->model('Foo')->bar (or $self->bar inside code in the model). B you MUST NOT call C<< $self->config >> or C<< __PACKAGE__->config >> as a way of reading config within your code, as this B give you the correctly merged config back. You B take the config values supplied to the constructor and use those instead. =cut around config => sub { my $orig = shift; my $c = shift; croak('Setting config after setup has been run is not allowed.') if ( @_ and $c->setup_finished ); $c->$orig(@_); }; =head2 $c->log Returns the logging object instance. Unless it is already set, Catalyst sets this up with a L object. To use your own log class, set the logger with the C<< __PACKAGE__->log >> method prior to calling C<< __PACKAGE__->setup >>. __PACKAGE__->log( MyLogger->new ); __PACKAGE__->setup; And later: $c->log->info( 'Now logging with my own logger!' ); Your log class should implement the methods described in L. =head2 $c->debug Returns 1 if debug mode is enabled, 0 otherwise. You can enable debug mode in several ways: =over =item By calling myapp_server.pl with the -d flag =item With the environment variables MYAPP_DEBUG, or CATALYST_DEBUG =item The -Debug option in your MyApp.pm =item By declaring C in your MyApp.pm. =back The first three also set the log level to 'debug'. Calling C<< $c->debug(1) >> has no effect. =cut sub debug { 0 } =head2 $c->dispatcher Returns the dispatcher instance. See L. =head2 $c->engine Returns the engine instance. See L. =head2 UTILITY METHODS =head2 $c->path_to(@path) Merges C<@path> with C<< $c->config->{home} >> and returns a L object. Note you can usually use this object as a filename, but sometimes you will have to explicitly stringify it yourself by calling the C<< ->stringify >> method. For example: $c->path_to( 'db', 'sqlite.db' ); =cut sub path_to { my ( $c, @path ) = @_; my $path = Path::Class::Dir->new( $c->config->{home}, @path ); if ( -d $path ) { return $path } else { return Path::Class::File->new( $c->config->{home}, @path ) } } sub plugin { my ( $class, $name, $plugin, @args ) = @_; # See block comment in t/unit_core_plugin.t $class->log->warn(qq/Adding plugin using the ->plugin method is deprecated, and will be removed in a future release/); $class->_register_plugin( $plugin, 1 ); eval { $plugin->import }; $class->mk_classdata($name); my $obj; eval { $obj = $plugin->new(@args) }; if ($@) { Catalyst::Exception->throw( message => qq/Couldn't instantiate instant plugin "$plugin", "$@"/ ); } $class->$name($obj); $class->log->debug(qq/Initialized instant plugin "$plugin" as "$name"/) if $class->debug; } =head2 MyApp->setup Initializes the dispatcher and engine, loads any plugins, and loads the model, view, and controller components. You may also specify an array of plugins to load here, if you choose to not load them in the C line. MyApp->setup; MyApp->setup( qw/-Debug/ ); B You B wrap this method with method modifiers or bad things will happen - wrap the C method instead. =cut sub setup { my ( $class, @arguments ) = @_; croak('Running setup more than once') if ( $class->setup_finished ); unless ( $class->isa('Catalyst') ) { Catalyst::Exception->throw( message => qq/'$class' does not inherit from Catalyst/ ); } if ( $class->arguments ) { @arguments = ( @arguments, @{ $class->arguments } ); } # Process options my $flags = {}; foreach (@arguments) { if (/^-Debug$/) { $flags->{log} = ( $flags->{log} ) ? 'debug,' . $flags->{log} : 'debug'; } elsif (/^-(\w+)=?(.*)$/) { $flags->{ lc $1 } = $2; } else { push @{ $flags->{plugins} }, $_; } } $class->setup_home( delete $flags->{home} ); $class->setup_log( delete $flags->{log} ); $class->setup_plugins( delete $flags->{plugins} ); # Call plugins setup, this is stupid and evil. # Also screws C3 badly on 5.10, hack to avoid. { no warnings qw/redefine/; local *setup = sub { }; $class->setup unless $Catalyst::__AM_RESTARTING; } $class->setup_middleware(); $class->setup_data_handlers(); $class->setup_dispatcher( delete $flags->{dispatcher} ); if (my $engine = delete $flags->{engine}) { $class->log->warn("Specifying the engine in ->setup is no longer supported, see Catalyst::Upgrading"); } $class->setup_engine(); $class->setup_stats( delete $flags->{stats} ); for my $flag ( sort keys %{$flags} ) { if ( my $code = $class->can( 'setup_' . $flag ) ) { &$code( $class, delete $flags->{$flag} ); } else { $class->log->warn(qq/Unknown flag "$flag"/); } } eval { require Catalyst::Devel; }; if( !$@ && $ENV{CATALYST_SCRIPT_GEN} && ( $ENV{CATALYST_SCRIPT_GEN} < $Catalyst::Devel::CATALYST_SCRIPT_GEN ) ) { $class->log->warn(<<"EOF"); You are running an old script! Please update by running (this will overwrite existing files): catalyst.pl -force -scripts $class or (this will not overwrite existing files): catalyst.pl -scripts $class EOF } # Initialize our data structure $class->components( {} ); $class->setup_components; if ( $class->debug ) { my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins; if (@plugins) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @plugins; $class->log->debug( "Loaded plugins:\n" . $t->draw . "\n" ); } my @middleware = map { ref $_ eq 'CODE' ? "Inline Coderef" : (ref($_) .' '. ($_->can('VERSION') ? $_->VERSION || '' : '') || '') } $class->registered_middlewares; if (@middleware) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @middleware; $class->log->debug( "Loaded PSGI Middleware:\n" . $t->draw . "\n" ); } my %dh = $class->registered_data_handlers; if (my @data_handlers = keys %dh) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @data_handlers; $class->log->debug( "Loaded Request Data Handlers:\n" . $t->draw . "\n" ); } my $dispatcher = $class->dispatcher; my $engine = $class->engine; my $home = $class->config->{home}; $class->log->debug(sprintf(q/Loaded dispatcher "%s"/, blessed($dispatcher))); $class->log->debug(sprintf(q/Loaded engine "%s"/, blessed($engine))); $home ? ( -d $home ) ? $class->log->debug(qq/Found home "$home"/) : $class->log->debug(qq/Home "$home" doesn't exist/) : $class->log->debug(q/Couldn't find home/); my $column_width = Catalyst::Utils::term_width() - 8 - 9; my $t = Text::SimpleTable->new( [ $column_width, 'Class' ], [ 8, 'Type' ] ); for my $comp ( sort keys %{ $class->components } ) { my $type = ref $class->components->{$comp} ? 'instance' : 'class'; $t->row( $comp, $type ); } $class->log->debug( "Loaded components:\n" . $t->draw . "\n" ) if ( keys %{ $class->components } ); } # Add our self to components, since we are also a component if( $class->isa('Catalyst::Controller') ){ $class->components->{$class} = $class; } $class->setup_actions; if ( $class->debug ) { my $name = $class->config->{name} || 'Application'; $class->log->info("$name powered by Catalyst $Catalyst::VERSION"); } if ($class->config->{case_sensitive}) { $class->log->warn($class . "->config->{case_sensitive} is set."); $class->log->warn("This setting is deprecated and planned to be removed in Catalyst 5.81."); } $class->setup_finalize; # Should be the last thing we do so that user things hooking # setup_finalize can log.. $class->log->_flush() if $class->log->can('_flush'); return 1; # Explicit return true as people have __PACKAGE__->setup as the last thing in their class. HATE. } =head2 $app->setup_finalize A hook to attach modifiers to. This method does not do anything except set the C accessor. Applying method modifiers to the C method doesn't work, because of quirky things done for plugin setup. Example: after setup_finalize => sub { my $app = shift; ## do stuff here.. }; =cut sub setup_finalize { my ($class) = @_; $class->setup_finished(1); } =head2 $c->uri_for( $path?, @args?, \%query_values? ) =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values? ) Constructs an absolute L object based on the application root, the provided path, and the additional arguments and query parameters provided. When used as a string, provides a textual URI. If you need more flexibility than this (i.e. the option to provide relative URIs etc.) see L. If no arguments are provided, the URI for the current action is returned. To return the current action and also provide @args, use C<< $c->uri_for( $c->action, @args ) >>. If the first argument is a string, it is taken as a public URI path relative to C<< $c->namespace >> (if it doesn't begin with a forward slash) or relative to the application root (if it does). It is then merged with C<< $c->request->base >>; any C<@args> are appended as additional path components; and any C<%query_values> are appended as C parameters. If the first argument is a L it represents an action which will have its path resolved using C<< $c->dispatcher->uri_for_action >>. The optional C<\@captures> argument (an arrayref) allows passing the captured variables that are needed to fill in the paths of Chained and Regex actions; once the path is resolved, C continues as though a path was provided, appending any arguments or parameters and creating an absolute URI. The captures for the current request can be found in C<< $c->request->captures >>, and actions can be resolved using C<< Catalyst::Controller->action_for($name) >>. If you have a private action path, use C<< $c->uri_for_action >> instead. # Equivalent to $c->req->uri $c->uri_for($c->action, $c->req->captures, @{ $c->req->args }, $c->req->params); # For the Foo action in the Bar controller $c->uri_for($c->controller('Bar')->action_for('Foo')); # Path to a static resource $c->uri_for('/static/images/logo.png'); =cut sub uri_for { my ( $c, $path, @args ) = @_; if ( $path->$_isa('Catalyst::Controller') ) { $path = $path->path_prefix; $path =~ s{/+\z}{}; $path .= '/'; } undef($path) if (defined $path && $path eq ''); my $params = ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; foreach my $arg (@args) { utf8::encode($arg) if utf8::is_utf8($arg); $arg =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; } if ( $path->$_isa('Catalyst::Action') ) { # action object s|/|%2F|g for @args; my $captures = [ map { s|/|%2F|g; $_; } ( scalar @args && ref $args[0] eq 'ARRAY' ? @{ shift(@args) } : ()) ]; foreach my $capture (@$captures) { utf8::encode($capture) if utf8::is_utf8($capture); $capture =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; } my $action = $path; # ->uri_for( $action, \@captures_and_args, \%query_values? ) if( !@args && $action->number_of_args ) { my $expanded_action = $c->dispatcher->expand_action( $action ); my $num_captures = $expanded_action->number_of_captures; unshift @args, splice @$captures, $num_captures; } $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 ''; } unshift(@args, $path); unless (defined $path && $path =~ s!^/!!) { # in-place strip my $namespace = $c->namespace; if (defined $path) { # cheesy hack to handle path '../foo' $namespace =~ s{(?:^|/)[^/]+$}{} while $args[0] =~ s{^\.\./}{}; } unshift(@args, $namespace || ''); } # join args with '/', or a blank string my $args = join('/', grep { defined($_) } @args); $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE $args =~ s!^/+!!; my ($base, $class) = ('/', 'URI::_generic'); if(blessed($c)) { $base = $c->req->base; $class = ref($base); $base =~ s{(?{$_}; s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; s/ /+/g; my $key = $_; $val = '' unless defined $val; (map { my $param = "$_"; utf8::encode( $param ) if utf8::is_utf8($param); # using the URI::Escape pattern here so utf8 chars survive $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $param =~ s/ /+/g; "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } my $res = bless(\"${base}${args}${query}", $class); $res; } =head2 $c->uri_for_action( $path, \@captures_and_args?, @args?, \%query_values? ) =head2 $c->uri_for_action( $action, \@captures_and_args?, @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 >>. Note that although the path looks like a URI that dispatches to the wanted action, it is not a URI, but an internal path to that action. For example, if the action looks like: package MyApp::Controller::Users; sub lst : Path('the-list') {} You can use: $c->uri_for_action('/users/lst') and it will create the URI /users/the-list. =item \@captures_and_args? Optional array reference of Captures (i.e. C<req->captures>) and arguments to the request. Usually used with L to interpolate all the parameters in the URI. =item @args? Optional list of extra arguments - can be supplied in the C<< \@captures_and_args? >> array ref, or here - whichever is easier for your code. Your action can have zero, a fixed or a variable number of args (e.g. C<< Args(1) >> for a fixed number or C<< Args() >> for a variable number).. =item \%query_values? Optional array reference of query parameters to append. E.g. { foo => 'bar' } will generate /rest/of/your/uri?foo=bar =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. =cut sub welcome_message { my $c = shift; my $name = $c->config->{name}; my $logo = $c->uri_for('/static/images/catalyst_logo.png'); my $prefix = Catalyst::Utils::appprefix( ref $c ); $c->response->content_type('text/html; charset=utf-8'); return <<"EOF"; $name on Catalyst $VERSION

$name on Catalyst $VERSION

Catalyst Logo

Welcome to the world of Catalyst. This MVC framework will make web development something you had never expected it to be: Fun, rewarding, and quick.

What to do now?

That really depends on what you want to do. We do, however, provide you with a few starting points.

If you want to jump right into web development with Catalyst you might want to start with a tutorial.

perldoc Catalyst::Manual::Tutorial

Afterwards you can go on to check out a more complete look at our features.

perldoc Catalyst::Manual::Intro

What to do next?

Next it's time to write an actual application. Use the helper scripts to generate controllers, models, and views; they can save you a lot of work.

script/${prefix}_create.pl --help

Also, be sure to check out the vast and growing collection of plugins for Catalyst on CPAN; you are likely to find what you need there.

Need help?

Catalyst has a very active community. Here are the main places to get in touch with us.

In conclusion

The Catalyst team hopes you will enjoy using Catalyst as much as we enjoyed making it. Please contact us if you have ideas for improvement or other feedback.

EOF } =head2 run_options Contains a hash of options passed from the application script, including the original ARGV the script received, the processed values from that ARGV and any extra arguments to the script which were not processed. This can be used to add custom options to your application's scripts and setup your application differently depending on the values of these options. =head1 INTERNAL METHODS These methods are not meant to be used by end users. =head2 $c->components Returns a hash of components. =head2 $c->context_class Returns or sets the context class. =head2 $c->counter Returns a hashref containing coderefs and execution counts (needed for deep recursion detection). =head2 $c->depth Returns the number of actions on the current internal execution stack. =head2 $c->dispatch Dispatches a request to actions. =cut sub dispatch { my $c = shift; $c->dispatcher->dispatch( $c, @_ ) } =head2 $c->dispatcher_class Returns or sets the dispatcher class. =head2 $c->dump_these Returns a list of 2-element array references (name, structure) pairs that will be dumped on the error page in debug mode. =cut sub dump_these { my $c = shift; [ Request => $c->req ], [ Response => $c->res ], [ Stash => $c->stash ], [ Config => $c->config ]; } =head2 $c->engine_class Returns or sets the engine class. =head2 $c->execute( $class, $coderef ) Execute a coderef in given class and catch exceptions. Errors are available via $c->error. =cut sub execute { my ( $c, $class, $code ) = @_; $class = $c->component($class) || $class; $c->state(0); if ( $c->depth >= $RECURSION ) { my $action = $code->reverse(); $action = "/$action" unless $action =~ /->/; my $error = qq/Deep recursion detected calling "${action}"/; $c->log->error($error); $c->error($error); $c->state(0); return $c->state; } my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats; push( @{ $c->stack }, $code ); no warnings 'recursion'; # N.B. This used to be combined, but I have seen $c get clobbered if so, and # I have no idea how, ergo $ret (which appears to fix the issue) eval { my $ret = $code->execute( $class, $c, @{ $c->req->args } ) || 0; $c->state( $ret ) }; $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; my $last = pop( @{ $c->stack } ); if ( my $error = $@ ) { if ( blessed($error) and $error->isa('Catalyst::Exception::Detach') ) { $error->rethrow if $c->depth > 1; } elsif ( blessed($error) and $error->isa('Catalyst::Exception::Go') ) { $error->rethrow if $c->depth > 0; } else { unless ( ref $error ) { no warnings 'uninitialized'; chomp $error; my $class = $last->class; my $name = $last->name; $error = qq/Caught exception in $class->$name "$error"/; } $c->error($error); } $c->state(0); } return $c->state; } sub _stats_start_execute { my ( $c, $code ) = @_; my $appclass = ref($c) || $c; return if ( ( $code->name =~ /^_.*/ ) && ( !$appclass->config->{show_internal_actions} ) ); my $action_name = $code->reverse(); $c->counter->{$action_name}++; my $action = $action_name; $action = "/$action" unless $action =~ /->/; # determine if the call was the result of a forward # this is done by walking up the call stack and looking for a calling # sub of Catalyst::forward before the eval my $callsub = q{}; for my $index ( 2 .. 11 ) { last if ( ( caller($index) )[0] eq 'Catalyst' && ( caller($index) )[3] eq '(eval)' ); if ( ( caller($index) )[3] =~ /forward$/ ) { $callsub = ( caller($index) )[3]; $action = "-> $action"; last; } } my $uid = $action_name . $c->counter->{$action_name}; # is this a root-level call or a forwarded call? if ( $callsub =~ /forward$/ ) { my $parent = $c->stack->[-1]; # forward, locate the caller if ( defined $parent && exists $c->counter->{"$parent"} ) { $c->stats->profile( begin => $action, parent => "$parent" . $c->counter->{"$parent"}, uid => $uid, ); } else { # forward with no caller may come from a plugin $c->stats->profile( begin => $action, uid => $uid, ); } } else { # root-level call $c->stats->profile( begin => $action, uid => $uid, ); } return $action; } sub _stats_finish_execute { my ( $c, $info ) = @_; $c->stats->profile( end => $info ); } =head2 $c->finalize Finalizes the request. =cut sub finalize { my $c = shift; for my $error ( @{ $c->error } ) { $c->log->error($error); } # Support skipping finalize for psgix.io style 'jailbreak'. Used to support # stuff like cometd and websockets if($c->request->_has_io_fh) { $c->log_response; return; } # Allow engine to handle finalize flow (for POE) my $engine = $c->engine; if ( my $code = $engine->can('finalize') ) { $engine->$code($c); } else { $c->finalize_uploads; # Error if ( $#{ $c->error } >= 0 ) { $c->finalize_error; } $c->finalize_headers unless $c->response->finalized_headers; # HEAD request if ( $c->request->method eq 'HEAD' ) { $c->response->body(''); } $c->finalize_body; } $c->log_response; if ($c->use_stats) { my $elapsed = $c->stats->elapsed; my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; $c->log->info( "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); } return $c->response->status; } =head2 $c->finalize_body Finalizes body. =cut sub finalize_body { my $c = shift; $c->engine->finalize_body( $c, @_ ) } =head2 $c->finalize_cookies Finalizes cookies. =cut sub finalize_cookies { my $c = shift; $c->engine->finalize_cookies( $c, @_ ) } =head2 $c->finalize_error Finalizes error. =cut sub finalize_error { my $c = shift; $c->engine->finalize_error( $c, @_ ) } =head2 $c->finalize_headers Finalizes headers. =cut sub finalize_headers { my $c = shift; my $response = $c->response; #accessor calls can add up? # Check if we already finalized headers return if $response->finalized_headers; # Handle redirects if ( my $location = $response->redirect ) { $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; $response->header( Location => $location ); if ( !$response->has_body ) { # Add a default body if none is already present my $encoded_location = encode_entities($location); $response->body(<<"EOF"); Moved

This item has moved here.

EOF $response->content_type('text/html; charset=utf-8'); } } # Content-Length if ( defined $response->body && length $response->body && !$response->content_length ) { # get the length from a filehandle if ( blessed( $response->body ) && $response->body->can('read') || ref( $response->body ) eq 'GLOB' ) { my $size = -s $response->body; if ( $size ) { $response->content_length( $size ); } else { $c->log->warn('Serving filehandle without a content-length'); } } else { # everything should be bytes at this point, but just in case $response->content_length( length( $response->body ) ); } } # Errors if ( $response->status =~ /^(1\d\d|[23]04)$/ ) { $response->headers->remove_header("Content-Length"); $response->body(''); } $c->finalize_cookies; $c->response->finalize_headers(); # Done $response->finalized_headers(1); } =head2 $c->finalize_output An alias for finalize_body. =head2 $c->finalize_read Finalizes the input after reading is complete. =cut sub finalize_read { my $c = shift; $c->engine->finalize_read( $c, @_ ) } =head2 $c->finalize_uploads Finalizes uploads. Cleans up any temporary files. =cut sub finalize_uploads { my $c = shift; $c->engine->finalize_uploads( $c, @_ ) } =head2 $c->get_action( $action, $namespace ) Gets an action in a given namespace. =cut sub get_action { my $c = shift; $c->dispatcher->get_action(@_) } =head2 $c->get_actions( $action, $namespace ) Gets all actions of a given name in a namespace and all parent namespaces. =cut sub get_actions { my $c = shift; $c->dispatcher->get_actions( $c, @_ ) } =head2 $app->handle_request( @arguments ) Called to handle each HTTP request. =cut sub handle_request { my ( $class, @arguments ) = @_; # Always expect worst case! my $status = -1; try { if ($class->debug) { my $secs = time - $START || 1; my $av = sprintf '%.3f', $COUNT / $secs; my $time = localtime time; $class->log->info("*** Request $COUNT ($av/s) [$$] [$time] ***"); } my $c = $class->prepare(@arguments); $c->dispatch; $status = $c->finalize; } catch { chomp(my $error = $_); $class->log->error(qq/Caught exception in engine "$error"/); }; $COUNT++; if(my $coderef = $class->log->can('_flush')){ $class->log->$coderef(); } return $status; } =head2 $class->prepare( @arguments ) Creates a Catalyst context from an engine-specific request (Apache, CGI, etc.). =cut has _uploadtmp => ( is => 'ro', predicate => '_has_uploadtmp', ); sub prepare { my ( $class, @arguments ) = @_; # XXX # After the app/ctxt split, this should become an attribute based on something passed # into the application. $class->context_class( ref $class || $class ) unless $class->context_class; my $uploadtmp = $class->config->{uploadtmp}; my $c = $class->context_class->new({ $uploadtmp ? (_uploadtmp => $uploadtmp) : ()}); $c->response->_context($c); #surely this is not the most efficient way to do things... $c->stats($class->stats_class->new)->enable($c->use_stats); if ( $c->debug || $c->config->{enable_catalyst_header} ) { $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } try { # Allow engine to direct the prepare flow (for POE) if ( my $prepare = $c->engine->can('prepare') ) { $c->engine->$prepare( $c, @arguments ); } else { $c->prepare_request(@arguments); $c->prepare_connection; $c->prepare_query_parameters; $c->prepare_headers; # Just hooks, no longer needed - they just $c->prepare_cookies; # cause the lazy attribute on req to build $c->prepare_path; # Prepare the body for reading, either by prepare_body # or the user, if they are using $c->read $c->prepare_read; # Parse the body unless the user wants it on-demand unless ( ref($c)->config->{parse_on_demand} ) { $c->prepare_body; } } $c->prepare_action; } # VERY ugly and probably shouldn't rely on ->finalize actually working catch { # failed prepare is always due to an invalid request, right? $c->response->status(400); $c->response->content_type('text/plain'); $c->response->body('Bad Request'); # Note we call finalize and then die here, which escapes # finalize being called in the enclosing block.. # It in fact couldn't be called, as we don't return $c.. # This is a mess - but I'm unsure you can fix this without # breaking compat for people doing crazy things (we should set # the 400 and just return the ctx here IMO, letting finalize get called # above... $c->finalize; die $_; }; $c->log_request; return $c; } =head2 $c->prepare_action Prepares action. See L. =cut sub prepare_action { my $c = shift; $c->dispatcher->prepare_action( $c, @_ ) } =head2 $c->prepare_body Prepares message body. =cut sub prepare_body { my $c = shift; return if $c->request->_has_body; # Initialize on-demand data $c->engine->prepare_body( $c, @_ ); $c->prepare_parameters; $c->prepare_uploads; } =head2 $c->prepare_body_chunk( $chunk ) Prepares a chunk of data before sending it to L. See L. =cut sub prepare_body_chunk { my $c = shift; $c->engine->prepare_body_chunk( $c, @_ ); } =head2 $c->prepare_body_parameters Prepares body parameters. =cut sub prepare_body_parameters { my $c = shift; $c->engine->prepare_body_parameters( $c, @_ ); } =head2 $c->prepare_connection Prepares connection. =cut sub prepare_connection { my $c = shift; # XXX - This is called on the engine (not the request) to maintain # Engine::PSGI back compat. $c->engine->prepare_connection($c); } =head2 $c->prepare_cookies Prepares cookies by ensuring that the attribute on the request object has been built. =cut sub prepare_cookies { my $c = shift; $c->request->cookies } =head2 $c->prepare_headers Prepares request headers by ensuring that the attribute on the request object has been built. =cut sub prepare_headers { my $c = shift; $c->request->headers } =head2 $c->prepare_parameters Prepares parameters. =cut sub prepare_parameters { my $c = shift; $c->prepare_body_parameters; $c->engine->prepare_parameters( $c, @_ ); } =head2 $c->prepare_path Prepares path and base. =cut sub prepare_path { my $c = shift; $c->engine->prepare_path( $c, @_ ) } =head2 $c->prepare_query_parameters Prepares query parameters. =cut sub prepare_query_parameters { my $c = shift; $c->engine->prepare_query_parameters( $c, @_ ); } =head2 $c->log_request Writes information about the request to the debug logs. This includes: =over 4 =item * Request method, path, and remote IP address =item * Query keywords (see L) =item * Request parameters =item * File uploads =back =cut sub log_request { my $c = shift; return unless $c->debug; my($dump) = grep {$_->[0] eq 'Request' } $c->dump_these; my $request = $dump->[1]; my ( $method, $path, $address ) = ( $request->method, $request->path, $request->address ); $method ||= ''; $path = '/' unless length $path; $address ||= ''; $c->log->debug(qq/"$method" request for "$path" from "$address"/); $c->log_request_headers($request->headers); if ( my $keywords = $request->query_keywords ) { $c->log->debug("Query keywords are: $keywords"); } $c->log_request_parameters( query => $request->query_parameters, $request->_has_body ? (body => $request->body_parameters) : () ); $c->log_request_uploads($request); } =head2 $c->log_response Writes information about the response to the debug logs by calling C<< $c->log_response_status_line >> and C<< $c->log_response_headers >>. =cut sub log_response { my $c = shift; return unless $c->debug; my($dump) = grep {$_->[0] eq 'Response' } $c->dump_these; my $response = $dump->[1]; $c->log_response_status_line($response); $c->log_response_headers($response->headers); } =head2 $c->log_response_status_line($response) Writes one line of information about the response to the debug logs. This includes: =over 4 =item * Response status code =item * Content-Type header (if present) =item * Content-Length header (if present) =back =cut sub log_response_status_line { my ($c, $response) = @_; $c->log->debug( sprintf( 'Response Code: %s; Content-Type: %s; Content-Length: %s', $response->status || 'unknown', $response->headers->header('Content-Type') || 'unknown', $response->headers->header('Content-Length') || 'unknown' ) ); } =head2 $c->log_response_headers($headers); Hook method which can be wrapped by plugins to log the response headers. No-op in the default implementation. =cut sub log_response_headers {} =head2 $c->log_request_parameters( query => {}, body => {} ) Logs request parameters to debug logs =cut sub log_request_parameters { my $c = shift; my %all_params = @_; return unless $c->debug; my $column_width = Catalyst::Utils::term_width() - 44; foreach my $type (qw(query body)) { my $params = $all_params{$type}; next if ! keys %$params; my $t = Text::SimpleTable->new( [ 35, 'Parameter' ], [ $column_width, 'Value' ] ); for my $key ( sort keys %$params ) { my $param = $params->{$key}; my $value = defined($param) ? $param : ''; $t->row( $key, ref $value eq 'ARRAY' ? ( join ', ', @$value ) : $value ); } $c->log->debug( ucfirst($type) . " Parameters are:\n" . $t->draw ); } } =head2 $c->log_request_uploads Logs file uploads included in the request to the debug logs. The parameter name, filename, file type, and file size are all included in the debug logs. =cut sub log_request_uploads { my $c = shift; my $request = shift; return unless $c->debug; my $uploads = $request->uploads; if ( keys %$uploads ) { my $t = Text::SimpleTable->new( [ 12, 'Parameter' ], [ 26, 'Filename' ], [ 18, 'Type' ], [ 9, 'Size' ] ); for my $key ( sort keys %$uploads ) { my $upload = $uploads->{$key}; for my $u ( ref $upload eq 'ARRAY' ? @{$upload} : ($upload) ) { $t->row( $key, $u->filename, $u->type, $u->size ); } } $c->log->debug( "File Uploads are:\n" . $t->draw ); } } =head2 $c->log_request_headers($headers); Hook method which can be wrapped by plugins to log the request headers. No-op in the default implementation. =cut sub log_request_headers {} =head2 $c->log_headers($type => $headers) Logs L (either request or response) to the debug logs. =cut sub log_headers { my $c = shift; my $type = shift; my $headers = shift; # an HTTP::Headers instance return unless $c->debug; my $column_width = Catalyst::Utils::term_width() - 28; my $t = Text::SimpleTable->new( [ 15, 'Header Name' ], [ $column_width, 'Value' ] ); $headers->scan( sub { my ( $name, $value ) = @_; $t->row( $name, $value ); } ); $c->log->debug( ucfirst($type) . " Headers:\n" . $t->draw ); } =head2 $c->prepare_read Prepares the input for reading. =cut sub prepare_read { my $c = shift; $c->engine->prepare_read( $c, @_ ) } =head2 $c->prepare_request Prepares the engine request. =cut sub prepare_request { my $c = shift; $c->engine->prepare_request( $c, @_ ) } =head2 $c->prepare_uploads Prepares uploads. =cut sub prepare_uploads { my $c = shift; $c->engine->prepare_uploads( $c, @_ ); } =head2 $c->prepare_write Prepares the output for writing. =cut sub prepare_write { my $c = shift; $c->engine->prepare_write( $c, @_ ) } =head2 $c->request_class Returns or sets the request class. Defaults to L. =head2 $c->response_class Returns or sets the response class. Defaults to L. =head2 $c->read( [$maxlength] ) Reads a chunk of data from the request body. This method is designed to be used in a while loop, reading C<$maxlength> bytes on every call. C<$maxlength> defaults to the size of the request if not specified. You have to set C<< MyApp->config(parse_on_demand => 1) >> to use this directly. Warning: If you use read(), Catalyst will not process the body, so you will not be able to access POST parameters or file uploads via $c->request. You must handle all body parsing yourself. =cut sub read { my $c = shift; return $c->request->read( @_ ) } =head2 $c->run Starts the engine. =cut sub run { my $app = shift; $app->_make_immutable_if_needed; $app->engine_loader->needs_psgi_engine_compat_hack ? $app->engine->run($app, @_) : $app->engine->run( $app, $app->_finalized_psgi_app, @_ ); } sub _make_immutable_if_needed { my $class = shift; my $meta = find_meta($class); my $isa_ca = $class->isa('Class::Accessor::Fast') || $class->isa('Class::Accessor'); if ( $meta->is_immutable && ! { $meta->immutable_options }->{replace_constructor} && $isa_ca ) { warn("You made your application class ($class) immutable, " . "but did not inline the\nconstructor. " . "This will break catalyst, as your app \@ISA " . "Class::Accessor(::Fast)?\nPlease pass " . "(replace_constructor => 1)\nwhen making your class immutable.\n"); } unless ($meta->is_immutable) { # XXX - FIXME warning here as you should make your app immutable yourself. $meta->make_immutable( replace_constructor => 1, ); } } =head2 $c->set_action( $action, $code, $namespace, $attrs ) Sets an action in a given namespace. =cut sub set_action { my $c = shift; $c->dispatcher->set_action( $c, @_ ) } =head2 $c->setup_actions($component) Sets up actions for a component. =cut sub setup_actions { my $c = shift; $c->dispatcher->setup_actions( $c, @_ ) } =head2 $c->setup_components This method is called internally to set up the application's components. It finds modules by calling the L method, expands them to package names with the L method, and then installs each component into the application. The C config option is passed to both of the above methods. Installation of each component is performed by the L method, below. =cut sub setup_components { my $class = shift; my $config = $class->config->{ setup_components }; my @comps = $class->locate_components($config); my %comps = map { $_ => 1 } @comps; my $deprecatedcatalyst_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 $deprecatedcatalyst_component_names; for my $component ( @comps ) { # We pass ignore_loaded here so that overlay files for (e.g.) # Model::DBI::Schema sub-classes are loaded - if it's in @comps # we know M::P::O found a file on disk so this is safe Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } ); } for my $component (@comps) { my $instance = $class->components->{ $component } = $class->setup_component($component); my @expanded_components = $instance->can('expand_modules') ? $instance->expand_modules( $component, $config ) : $class->expand_component_module( $component, $config ); for my $component (@expanded_components) { next if $comps{$component}; $class->components->{ $component } = $class->setup_component($component); } } } =head2 $c->locate_components( $setup_component_config ) This method is meant to provide a list of component modules that should be setup for the application. By default, it will use L. Specify a C config option to pass additional options directly to L. To add additional search paths, specify a key named C as an array reference. Items in the array beginning with C<::> will have the application class name prepended to them. =cut sub locate_components { my $class = shift; my $config = shift; my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); my $extra = delete $config->{ search_extra } || []; push @paths, @$extra; my $locator = Module::Pluggable::Object->new( search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], %$config ); # XXX think about ditching this sort entirely my @comps = sort { length $a <=> length $b } $locator->plugins; return @comps; } =head2 $c->expand_component_module( $component, $setup_component_config ) Components found by C will be passed to this method, which is expected to return a list of component (package) names to be set up. =cut sub expand_component_module { my ($class, $module) = @_; return Devel::InnerPackage::list_packages( $module ); } =head2 $c->setup_component =cut sub setup_component { my( $class, $component ) = @_; unless ( $component->can( 'COMPONENT' ) ) { return $component; } my $suffix = Catalyst::Utils::class2classsuffix( $component ); my $config = $class->config->{ $suffix } || {}; # Stash catalyst_component_name in the config here, so that custom COMPONENT # methods also pass it. local to avoid pointlessly shitting in config # for the debug screen, as $component is already the key name. local $config->{catalyst_component_name} = $component; my $instance = eval { $component->COMPONENT( $class, $config ); }; if ( my $error = $@ ) { chomp $error; Catalyst::Exception->throw( message => qq/Couldn't instantiate component "$component", "$error"/ ); } unless (blessed $instance) { my $metaclass = Moose::Util::find_meta($component); my $method_meta = $metaclass->find_method_by_name('COMPONENT'); my $component_method_from = $method_meta->associated_metaclass->name; my $value = defined($instance) ? $instance : 'undef'; Catalyst::Exception->throw( message => qq/Couldn't instantiate component "$component", COMPONENT() method (from $component_method_from) didn't return an object-like value (value was $value)./ ); } return $instance; } =head2 $c->setup_dispatcher Sets up dispatcher. =cut sub setup_dispatcher { my ( $class, $dispatcher ) = @_; if ($dispatcher) { $dispatcher = 'Catalyst::Dispatcher::' . $dispatcher; } if ( my $env = Catalyst::Utils::env_value( $class, 'DISPATCHER' ) ) { $dispatcher = 'Catalyst::Dispatcher::' . $env; } unless ($dispatcher) { $dispatcher = $class->dispatcher_class; } load_class($dispatcher); # dispatcher instance $class->dispatcher( $dispatcher->new ); } =head2 $c->setup_engine Sets up engine. =cut sub engine_class { my ($class, $requested_engine) = @_; if (!$class->engine_loader || $requested_engine) { $class->engine_loader( Catalyst::EngineLoader->new({ application_name => $class, (defined $requested_engine ? (catalyst_engine_class => $requested_engine) : ()), }), ); } $class->engine_loader->catalyst_engine_class; } sub setup_engine { my ($class, $requested_engine) = @_; my $engine = do { my $loader = $class->engine_loader; if (!$loader || $requested_engine) { $loader = Catalyst::EngineLoader->new({ application_name => $class, (defined $requested_engine ? (requested_engine => $requested_engine) : ()), }), $class->engine_loader($loader); } $loader->catalyst_engine_class; }; # Don't really setup_engine -- see _setup_psgi_app for explanation. return if $class->loading_psgi_file; load_class($engine); if ($ENV{MOD_PERL}) { my $apache = $class->engine_loader->auto; my $meta = find_meta($class); my $was_immutable = $meta->is_immutable; my %immutable_options = $meta->immutable_options; $meta->make_mutable if $was_immutable; $meta->add_method(handler => sub { my $r = shift; my $psgi_app = $class->_finalized_psgi_app; $apache->call_app($r, $psgi_app); }); $meta->make_immutable(%immutable_options) if $was_immutable; } $class->engine( $engine->new ); return; } ## This exists just to supply a prebuild psgi app for mod_perl and for the ## build in server support (back compat support for pre psgi port behavior). ## This is so that we don't build a new psgi app for each request when using ## the mod_perl handler or the built in servers (http and fcgi, etc). sub _finalized_psgi_app { my ($app) = @_; unless ($app->_psgi_app) { my $psgi_app = $app->_setup_psgi_app; $app->_psgi_app($psgi_app); } return $app->_psgi_app; } ## Look for a psgi file like 'myapp_web.psgi' (if the app is MyApp::Web) in the ## home directory and load that and return it (just assume it is doing the ## right thing :) ). If that does not exist, call $app->psgi_app, wrap that ## in default_middleware and return it ( this is for backward compatibility ## with pre psgi port behavior ). sub _setup_psgi_app { my ($app) = @_; for my $home (Path::Class::Dir->new($app->config->{home})) { my $psgi_file = $home->file( Catalyst::Utils::appprefix($app) . '.psgi', ); next unless -e $psgi_file; # If $psgi_file calls ->setup_engine, it's doing so to load # Catalyst::Engine::PSGI. But if it does that, we're only going to # throw away the loaded PSGI-app and load the 5.9 Catalyst::Engine # anyway. So set a flag (ick) that tells setup_engine not to populate # $c->engine or do any other things we might regret. $app->loading_psgi_file(1); my $psgi_app = Plack::Util::load_psgi($psgi_file); $app->loading_psgi_file(0); return $psgi_app unless $app->engine_loader->needs_psgi_engine_compat_hack; warn <<"EOW"; Found a legacy Catalyst::Engine::PSGI .psgi file at ${psgi_file}. Its content has been ignored. Please consult the Catalyst::Upgrading documentation on how to upgrade from Catalyst::Engine::PSGI. EOW } return $app->apply_default_middlewares($app->psgi_app); } =head2 $c->apply_default_middlewares Adds the following L middlewares to your application, since they are useful and commonly needed: L, (conditionally added based on the status of your $ENV{REMOTE_ADDR}, and can be forced on with C or forced off with C), L (if you are using Lighttpd), L (always applied since this middleware is smart enough to conditionally apply itself). Additionally if we detect we are using Nginx, we add a bit of custom middleware to solve some problems with the way that server handles $ENV{PATH_INFO} and $ENV{SCRIPT_NAME} =cut sub apply_default_middlewares { my ($app, $psgi_app) = @_; $psgi_app = Plack::Middleware::Conditional->wrap( $psgi_app, builder => sub { Plack::Middleware::ReverseProxy->wrap($_[0]) }, condition => sub { my ($env) = @_; return if $app->config->{ignore_frontend_proxy}; return $env->{REMOTE_ADDR} eq '127.0.0.1' || $app->config->{using_frontend_proxy}; }, ); # If we're running under Lighttpd, swap PATH_INFO and SCRIPT_NAME # http://lists.scsys.co.uk/pipermail/catalyst/2006-June/008361.html $psgi_app = Plack::Middleware::Conditional->wrap( $psgi_app, builder => sub { Plack::Middleware::LighttpdScriptNameFix->wrap($_[0]) }, condition => sub { my ($env) = @_; return unless $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!lighttpd[-/]1\.(\d+\.\d+)!; return unless $1 < 4.23; 1; }, ); # we're applying this unconditionally as the middleware itself already makes # sure it doesn't fuck things up if it's not running under one of the right # IIS versions $psgi_app = Plack::Middleware::IIS6ScriptNameFix->wrap($psgi_app); # And another IIS issue, this time with IIS7. $psgi_app = Plack::Middleware::Conditional->wrap( $psgi_app, builder => sub { Plack::Middleware::IIS7KeepAliveFix->wrap($_[0]) }, condition => sub { my ($env) = @_; return $env->{SERVER_SOFTWARE} && $env->{SERVER_SOFTWARE} =~ m!IIS/7\.[0-9]!; }, ); return $psgi_app; } =head2 $c->psgi_app Returns a PSGI application code reference for the catalyst application C<$c>. This is the bare application without any middlewares applied. C<${myapp}.psgi> is not taken into account. This is what you want to be using to retrieve the PSGI application code reference of your Catalyst application for use in F<.psgi> files. =cut sub psgi_app { my ($app) = @_; my $psgi = $app->engine->build_psgi_app($app); return $app->Catalyst::Utils::apply_registered_middleware($psgi); } =head2 $c->setup_home Sets up the home directory. =cut sub setup_home { my ( $class, $home ) = @_; if ( my $env = Catalyst::Utils::env_value( $class, 'HOME' ) ) { $home = $env; } $home ||= Catalyst::Utils::home($class); if ($home) { #I remember recently being scolded for assigning config values like this $class->config->{home} ||= $home; $class->config->{root} ||= Path::Class::Dir->new($home)->subdir('root'); } } =head2 $c->setup_log Sets up log by instantiating a L object and passing it to C. Pass in a comma-delimited list of levels to set the log to. This method also installs a C method that returns a true value into the catalyst subclass if the "debug" level is passed in the comma-delimited list, or if the C<$CATALYST_DEBUG> environment variable is set to a true value. Note that if the log has already been setup, by either a previous call to C or by a call such as C<< __PACKAGE__->log( MyLogger->new ) >>, that this method won't actually set up the log object. =cut sub setup_log { my ( $class, $levels ) = @_; $levels ||= ''; $levels =~ s/^\s+//; $levels =~ s/\s+$//; my %levels = map { $_ => 1 } split /\s*,\s*/, $levels; my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' ); if ( defined $env_debug ) { $levels{debug} = 1 if $env_debug; # Ugly! delete($levels{debug}) unless $env_debug; } unless ( $class->log ) { $class->log( Catalyst::Log->new(keys %levels) ); } if ( $levels{debug} ) { Class::MOP::get_metaclass_by_name($class)->add_method('debug' => sub { 1 }); $class->log->debug('Debug messages enabled'); } } =head2 $c->setup_plugins Sets up plugins. =cut =head2 $c->setup_stats Sets up timing statistics class. =cut sub setup_stats { my ( $class, $stats ) = @_; Catalyst::Utils::ensure_class_loaded($class->stats_class); my $env = Catalyst::Utils::env_value( $class, 'STATS' ); if ( defined($env) ? $env : ($stats || $class->debug ) ) { Class::MOP::get_metaclass_by_name($class)->add_method('use_stats' => sub { 1 }); $class->log->debug('Statistics enabled'); } } =head2 $c->registered_plugins Returns a sorted list of the plugins which have either been stated in the import list. If passed a given plugin name, it will report a boolean value indicating whether or not that plugin is loaded. A fully qualified name is required if the plugin name does not begin with C. if ($c->registered_plugins('Some::Plugin')) { ... } =cut { sub registered_plugins { my $proto = shift; return sort keys %{ $proto->_plugins } unless @_; my $plugin = shift; return 1 if exists $proto->_plugins->{$plugin}; return exists $proto->_plugins->{"Catalyst::Plugin::$plugin"}; } sub _register_plugin { my ( $proto, $plugin, $instant ) = @_; my $class = ref $proto || $proto; load_class( $plugin ); $class->log->warn( "$plugin inherits from 'Catalyst::Component' - this is deprecated and will not work in 5.81" ) if $plugin->isa( 'Catalyst::Component' ); my $plugin_meta = Moose::Meta::Class->create($plugin); if (!$plugin_meta->has_method('new') && ( $plugin->isa('Class::Accessor::Fast') || $plugin->isa('Class::Accessor') ) ) { $plugin_meta->add_method('new', Moose::Object->meta->get_method('new')) } if (!$instant && !$proto->_plugins->{$plugin}) { my $meta = Class::MOP::get_metaclass_by_name($class); $meta->superclasses($plugin, $meta->superclasses); } $proto->_plugins->{$plugin} = 1; return $class; } sub _default_plugins { return qw(Unicode::Encoding) } sub setup_plugins { my ( $class, $plugins ) = @_; $class->_plugins( {} ) unless $class->_plugins; $plugins = [ grep { m/Unicode::Encoding/ ? do { $class->log->warn( 'Unicode::Encoding plugin is auto-applied,' . ' please remove this from your appclass' . ' and make sure to define "encoding" config' ); unless (exists $class->config->{'encoding'}) { $class->config->{'encoding'} = 'UTF-8'; } () } : $_ } @$plugins ]; push @$plugins, $class->_default_plugins; $plugins = Data::OptList::mkopt($plugins || []); my @plugins = map { [ Catalyst::Utils::resolve_namespace( $class . '::Plugin', 'Catalyst::Plugin', $_->[0] ), $_->[1], ] } @{ $plugins }; for my $plugin ( reverse @plugins ) { load_class($plugin->[0], $plugin->[1]); my $meta = find_meta($plugin->[0]); next if $meta && $meta->isa('Moose::Meta::Role'); $class->_register_plugin($plugin->[0]); } my @roles = map { $_->[0]->name, $_->[1] } grep { blessed($_->[0]) && $_->[0]->isa('Moose::Meta::Role') } map { [find_meta($_->[0]), $_->[1]] } @plugins; Moose::Util::apply_all_roles( $class => @roles ) if @roles; } } =head2 registered_middlewares Read only accessor that returns an array of all the middleware in the order that they were added (which is the REVERSE of the order they will be applied). The values returned will be either instances of L or of a compatible interface, or a coderef, which is assumed to be inlined middleware =head2 setup_middleware (?@middleware) Read configuration information stored in configuration key C or from passed @args. See under L information regarding C and how to use it to enable L This method is automatically called during 'setup' of your application, so you really don't need to invoke it. However you may do so if you find the idea of loading middleware via configuration weird :). For example: package MyApp; use Catalyst; __PACKAGE__->setup_middleware('Head'); __PACKAGE__->setup; When we read middleware definitions from configuration, we reverse the list which sounds odd but is likely how you expect it to work if you have prior experience with L or if you previously used the plugin L (which is now considered deprecated) =cut sub registered_middlewares { my $class = shift; if(my $middleware = $class->_psgi_middleware) { return @$middleware; } else { die "You cannot call ->registered_middlewares until middleware has been setup"; } } sub setup_middleware { my $class = shift; my @middleware_definitions = @_ ? @_ : reverse(@{$class->config->{'psgi_middleware'}||[]}); my @middleware = (); while(my $next = shift(@middleware_definitions)) { if(ref $next) { if(Scalar::Util::blessed $next && $next->can('wrap')) { push @middleware, $next; } elsif(ref $next eq 'CODE') { push @middleware, $next; } elsif(ref $next eq 'HASH') { my $namespace = shift @middleware_definitions; my $mw = $class->Catalyst::Utils::build_middleware($namespace, %$next); push @middleware, $mw; } else { die "I can't handle middleware definition ${\ref $next}"; } } else { my $mw = $class->Catalyst::Utils::build_middleware($next); push @middleware, $mw; } } my @existing = @{$class->_psgi_middleware || []}; $class->_psgi_middleware([@middleware,@existing,]); } =head2 registered_data_handlers A read only copy of registered Data Handlers returned as a Hash, where each key is a content type and each value is a subref that attempts to decode that content type. =head2 setup_data_handlers (?@data_handler) Read configuration information stored in configuration key C or from passed @args. See under L information regarding C. This method is automatically called during 'setup' of your application, so you really don't need to invoke it. =head2 default_data_handlers Default Data Handlers that come bundled with L. Currently there are only two default data handlers, for 'application/json' and an alternative to 'application/x-www-form-urlencoded' which supposed nested form parameters via L or via L IF you've installed it. The 'application/json' data handler is used to parse incoming JSON into a Perl data structure. It used either L or L, depending on which is installed. This allows you to fail back to L, which is a Pure Perl JSON decoder, and has the smallest dependency impact. Because we don't wish to add more dependencies to L, if you wish to use this new feature we recommend installing L or L in order to get the best performance. You should add either to your dependency list (Makefile.PL, dist.ini, cpanfile, etc.) =cut sub registered_data_handlers { my $class = shift; if(my $data_handlers = $class->_data_handlers) { return %$data_handlers; } else { die "You cannot call ->registered_data_handlers until data_handers has been setup"; } } sub setup_data_handlers { my ($class, %data_handler_callbacks) = @_; %data_handler_callbacks = ( %{$class->default_data_handlers}, %{$class->config->{'data_handlers'}||+{}}, %data_handler_callbacks); $class->_data_handlers(\%data_handler_callbacks); } sub default_data_handlers { my ($class) = @_; return +{ 'application/x-www-form-urlencoded' => sub { my ($fh, $req) = @_; my $params = $req->_use_hash_multivalue ? $req->body_parameters->mixed : $req->body_parameters; Class::Load::load_first_existing_class('CGI::Struct::XS', 'CGI::Struct') ->can('build_cgi_struct')->($params); }, 'application/json' => sub { Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON') ->can('decode_json')->(do { local $/; $_->getline }); }, }; } =head2 $c->stack Returns an arrayref of the internal execution stack (actions that are currently executing). =head2 $c->stats Returns the current timing statistics object. By default Catalyst uses L, but can be set otherwise with L<< stats_class|/"$c->stats_class" >>. Even if L<< -Stats|/"-Stats" >> is not enabled, the stats object is still available. By enabling it with C< $c->stats->enabled(1) >, it can be used to profile explicitly, although MyApp.pm still won't profile nor output anything by itself. =head2 $c->stats_class Returns or sets the stats (timing statistics) class. L is used by default. =head2 $c->use_stats Returns 1 when L<< stats collection|/"-Stats" >> is enabled. Note that this is a static method, not an accessor and should be overridden by declaring C in your MyApp.pm, not by calling C<< $c->use_stats(1) >>. =cut sub use_stats { 0 } =head2 $c->write( $data ) Writes $data to the output stream. When using this method directly, you will need to manually set the C header to the length of your output data, if known. =cut sub write { my $c = shift; # Finalize headers if someone manually writes output (for compat) $c->finalize_headers; return $c->response->write( @_ ); } =head2 version Returns the Catalyst version number. Mostly useful for "powered by" messages in template systems. =cut sub version { return $Catalyst::VERSION } =head1 CONFIGURATION There are a number of 'base' config variables which can be set: =over =item * C - The default model picked if you say C<< $c->model >>. See L<< /$c->model($name) >>. =item * C - The default view to be rendered or returned when C<< $c->view >> is called. See L<< /$c->view($name) >>. =item * C - Turns off the deprecated component resolution functionality so that if any of the component methods (e.g. C<< $c->controller('Foo') >>) are called then regex search will not be attempted on string values and instead C will be returned. =item * C - The application home directory. In an uninstalled application, this is the top level application directory. In an installed application, this will be the directory containing C<< MyApp.pm >>. =item * C - See L =item * C - The name of the application in debug messages and the debug and welcome screens =item * C - The request body (for example file uploads) will not be parsed until it is accessed. This allows you to (for example) check authentication (and reject the upload) before actually receiving all the data. See L =item * C - The root directory for templates. Usually this is just a subdirectory of the home directory, but you can set it to change the templates to a different directory. =item * C - Array reference passed to Module::Pluggable to for additional namespaces from which components will be loaded (and constructed and stored in C<< $c->components >>). =item * C - If true, causes internal actions such as C<< _DISPATCH >> to be shown in hit debug tables in the test server. =item * C - Controls if the C or C environment variable should be used for determining the request path. Most web server environments pass the requested path to the application using environment variables, from which Catalyst has to reconstruct the request base (i.e. the top level path to / in the application, exposed as C<< $c->request->base >>) and the request path below that base. There are two methods of doing this, both of which have advantages and disadvantages. Which method is used is determined by the C<< $c->config(use_request_uri_for_path) >> setting (which can either be true or false). =over =item use_request_uri_for_path => 0 This is the default (and the) traditional method that Catalyst has used for determining the path information. The path is generated from a combination of the C and C environment variables. The allows the application to behave correctly when C is being used to redirect requests into the application, as these variables are adjusted by mod_rewrite to take account for the redirect. However this method has the major disadvantage that it is impossible to correctly decode some elements of the path, as RFC 3875 says: "C<< Unlike a URI path, the PATH_INFO is not URL-encoded, and cannot contain path-segment parameters. >>" This means PATH_INFO is B decoded, and therefore Catalyst can't distinguish / vs %2F in paths (in addition to other encoded values). =item use_request_uri_for_path => 1 This method uses the C and C environment variables. As C is never decoded, this means that applications using this mode can correctly handle URIs including the %2F character (i.e. with C set to C in Apache). Given that this method of path resolution is provably more correct, it is recommended that you use this unless you have a specific need to deploy your application in a non-standard environment, and you are aware of the implications of not being able to handle encoded URI paths correctly. However it also means that in a number of cases when the app isn't installed directly at a path, but instead is having paths rewritten into it (e.g. as a .cgi/fcgi in a public_html directory, with mod_rewrite in a .htaccess file, or when SSI is used to rewrite pages into the app, or when sub-paths of the app are exposed at other URIs than that which the app is 'normally' based at with C), the resolution of C<< $c->request->base >> will be incorrect. =back =item * C - See L. =item * C - See L =item * C When there is an error in an action chain, the default behavior is to continue processing the remaining actions and then catch the error upon chain end. This can lead to running actions when the application is in an unexpected state. If you have this issue, setting this config value to true will promptly exit a chain when there is an error raised in any action (thus terminating the chain early.) use like: __PACKAGE__->config(abort_chain_on_error_fix => 1); In the future this might become the default behavior. =item * C In L the methods C, C and C return a hashref where values might be scalar or an arrayref depending on the incoming data. In many cases this can be undesirable as it leads one to writing defensive code like the following: my ($val) = ref($c->req->parameters->{a}) ? @{$c->req->parameters->{a}} : $c->req->parameters->{a}; Setting this configuration item to true will make L populate the attributes underlying these methods with an instance of L which is used by L and others to solve this very issue. You may prefer this behavior to the default, if so enable this option (be warned if you enable it in a legacy application we are not sure if it is completely backwardly compatible). =item * C - See L. =item * C - See L. =back =head1 INTERNAL ACTIONS Catalyst uses internal actions like C<_DISPATCH>, C<_BEGIN>, C<_AUTO>, C<_ACTION>, and C<_END>. These are by default not shown in the private action table, but you can make them visible with a config parameter. MyApp->config(show_internal_actions => 1); =head1 ON-DEMAND PARSER The request body is usually parsed at the beginning of a request, but if you want to handle input yourself, you can enable on-demand parsing with a config parameter. MyApp->config(parse_on_demand => 1); =head1 PROXY SUPPORT Many production servers operate using the common double-server approach, with a lightweight frontend web server passing requests to a larger backend server. An application running on the backend server must deal with two problems: the remote user always appears to be C<127.0.0.1> and the server's hostname will appear to be C regardless of the virtual host that the user connected through. Catalyst will automatically detect this situation when you are running the frontend and backend servers on the same machine. The following changes are made to the request. $c->req->address is set to the user's real IP address, as read from the HTTP X-Forwarded-For header. The host value for $c->req->base and $c->req->uri is set to the real host, as read from the HTTP X-Forwarded-Host header. Additionally, you may be running your backend application on an insecure connection (port 80) while your frontend proxy is running under SSL. If there is a discrepancy in the ports, use the HTTP header C to tell Catalyst what port the frontend listens on. This will allow all URIs to be created properly. In the case of passing in: X-Forwarded-Port: 443 All calls to C will result in an https link, as is expected. Obviously, your web server must support these headers for this to work. In a more complex server farm environment where you may have your frontend proxy server(s) on different machines, you will need to set a configuration option to tell Catalyst to read the proxied data from the headers. MyApp->config(using_frontend_proxy => 1); If you do not wish to use the proxy support at all, you may set: MyApp->config(ignore_frontend_proxy => 0); =head2 Note about psgi files Note that if you supply your own .psgi file, calling C<< MyApp->psgi_app(@_); >>, then B. You either need to apply L yourself in your psgi, for example: builder { enable "Plack::Middleware::ReverseProxy"; MyApp->psgi_app }; This will unconditionally add the ReverseProxy support, or you need to call C<< $app = MyApp->apply_default_middlewares($app) >> (to conditionally apply the support depending upon your config). See L for more information. =head1 THREAD SAFETY Catalyst has been tested under Apache 2's threading C, C, and the standalone forking HTTP server on Windows. We believe the Catalyst core to be thread-safe. If you plan to operate in a threaded environment, remember that all other modules you are using must also be thread-safe. Some modules, most notably L, are not thread-safe. =head1 DATA HANDLERS The L object uses L to populate 'classic' HTML form parameters and URL search query fields. However it has become common for various alternative content types to be PUT or POSTed to your controllers and actions. People working on RESTful APIs, or using AJAX often use JSON, XML and other content types when communicating with an application server. In order to better support this use case, L defines a global configuration option, C, which lets you associate a content type with a coderef that parses that content type into something Perl can readily access. package MyApp::Web; use Catalyst; use JSON::Maybe; __PACKAGE__->config( data_handlers => { 'application/json' => sub { local $/; decode_json $_->getline }, }, ## Any other configuration. ); __PACKAGE__->setup; By default L comes with a generic JSON data handler similar to the example given above, which uses L to provide either L (a pure Perl, dependency free JSON parser) or L if you have it installed (if you want the faster XS parser, add it to you project Makefile.PL or dist.ini, cpanfile, etc.) The C configuation is a hashref whose keys are HTTP Content-Types (matched against the incoming request type using a regexp such as to be case insensitive) and whose values are coderefs that receive a localized version of C<$_> which is a filehandle object pointing to received body. This feature is considered an early access release and we reserve the right to alter the interface in order to provide a performant and secure solution to alternative request body content. Your reports welcomed! =head1 PSGI MIDDLEWARE You can define middleware, defined as L or a compatible interface in configuration. Your middleware definitions are in the form of an arrayref under the configuration key C. Here's an example with details to follow: package MyApp::Web; use Catalyst; use Plack::Middleware::StackTrace; my $stacktrace_middleware = Plack::Middleware::StackTrace->new; __PACKAGE__->config( 'psgi_middleware', [ 'Debug', '+MyApp::Custom', $stacktrace_middleware, 'Session' => {store => 'File'}, sub { my $app = shift; return sub { my $env = shift; $env->{myapp.customkey} = 'helloworld'; $app->($env); }, }, ], ); __PACKAGE__->setup; So the general form is: __PACKAGE__->config(psgi_middleware => \@middleware_definitions); Where C<@middleware> is one or more of the following, applied in the REVERSE of the order listed (to make it function similarly to L: =over 4 =item Middleware Object An already initialized object that conforms to the L specification: my $stacktrace_middleware = Plack::Middleware::StackTrace->new; __PACKAGE__->config( 'psgi_middleware', [ $stacktrace_middleware, ]); =item coderef A coderef that is an inlined middleware: __PACKAGE__->config( 'psgi_middleware', [ sub { my $app = shift; return sub { my $env = shift; if($env->{PATH_INFO} =~m/forced/) { Plack::App::File ->new(file=>TestApp->path_to(qw/share static forced.txt/)) ->call($env); } else { return $app->($env); } }, }, ]); =item a scalar We assume the scalar refers to a namespace after normalizing it using the following rules: (1) If the scalar is prefixed with a "+" (as in C<+MyApp::Foo>) then the full string is assumed to be 'as is', and we just install and use the middleware. (2) If the scalar begins with "Plack::Middleware" or your application namespace (the package name of your Catalyst application subclass), we also assume then that it is a full namespace, and use it. (3) Lastly, we then assume that the scalar is a partial namespace, and attempt to resolve it first by looking for it under your application namespace (for example if you application is "MyApp::Web" and the scalar is "MyMiddleware", we'd look under "MyApp::Web::Middleware::MyMiddleware") and if we don't find it there, we will then look under the regular L namespace (i.e. for the previous we'd try "Plack::Middleware::MyMiddleware"). We look under your application namespace first to let you 'override' common L locally, should you find that a good idea. Examples: package MyApp::Web; __PACKAGE__->config( 'psgi_middleware', [ 'Debug', ## MyAppWeb::Middleware::Debug->wrap or Plack::Middleware::Debug->wrap 'Plack::Middleware::Stacktrace', ## Plack::Middleware::Stacktrace->wrap '+MyApp::Custom', ## MyApp::Custom->wrap ], ); =item a scalar followed by a hashref Just like the previous, except the following C is used as arguments to initialize the middleware object. __PACKAGE__->config( 'psgi_middleware', [ 'Session' => {store => 'File'}, ]); =back Please see L for more on middleware. =head1 ENCODING On request, decodes all params from encoding into a sequence of logical characters. On response, encodes body into encoding. =head2 Methods =over 4 =item encoding Returns an instance of an C encoding print $c->encoding->name =item handle_unicode_encoding_exception ($exception_context) Method called when decoding process for a request fails. An C<$exception_context> hashref is provided to allow you to override the behaviour of your application when given data with incorrect encodings. The default method throws exceptions in the case of invalid request parameters (resulting in a 500 error), but ignores errors in upload filenames. The keys passed in the C<$exception_context> hash are: =over =item param_value The value which was not able to be decoded. =item error_msg The exception received from L. =item encoding_step What type of data was being decoded. Valid values are (currently) C - for request parameters / arguments / captures and C - for request upload filenames. =back =back =head1 SUPPORT IRC: Join #catalyst on irc.perl.org. Mailing Lists: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst-dev Web: http://catalyst.perl.org Wiki: http://dev.catalyst.perl.org =head1 SEE ALSO =head2 L - All you need to start with Catalyst =head2 L - The Catalyst Manual =head2 L, L - Base classes for components =head2 L - Core engine =head2 L - Log class. =head2 L - Request object =head2 L - Response object =head2 L - The test suite. =head1 PROJECT FOUNDER sri: Sebastian Riedel =head1 CONTRIBUTORS abw: Andy Wardley acme: Leon Brocard abraxxa: Alexander Hartmaier Andrew Bramble Andrew Ford EA.Ford@ford-mason.co.ukE Andrew Ruthven andyg: Andy Grundman audreyt: Audrey Tang bricas: Brian Cassidy Caelum: Rafael Kitover chansen: Christian Hansen chicks: Christopher Hicks Chisel Wright C Danijel Milicevic C David Kamholz Edkamholz@cpan.orgE David Naughton, C David E. Wheeler dhoss: Devin Austin dkubb: Dan Kubb Drew Taylor dwc: Daniel Westermann-Clark esskar: Sascha Kiefer fireartist: Carl Franks frew: Arthur Axel "fREW" Schmidt gabb: Danijel Milicevic Gary Ashton Jones Gavin Henry C Geoff Richards groditi: Guillermo Roditi hobbs: Andrew Rodland ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho jester: Jesse Sheidlower C jhannah: Jay Hannah Jody Belka Johan Lindstrom jon: Jon Schutz Jonathan Rockway C<< >> Kieren Diment C konobi: Scott McWhirter marcus: Marcus Ramberg miyagawa: Tatsuhiko Miyagawa mgrimes: Mark Grimes mst: Matt S. Trout mugwump: Sam Vilain naughton: David Naughton ningu: David Kamholz nothingmuch: Yuval Kogman numa: Dan Sully obra: Jesse Vincent Octavian Rasnita omega: Andreas Marienborg Oleg Kostyuk phaylon: Robert Sedlacek rafl: Florian Ragwitz random: Roland Lammel Robert Sedlacek C<< >> SpiceMan: Marcel Montes sky: Arthur Bergman szbalint: Balint Szilakszi t0m: Tomas Doran Ulf Edvinsson Viljo Marrandi C Will Hawes C willert: Sebastian Willert wreis: Wallace Reis Yuval Kogman, C rainboxx: Matthias Dietrich, C dd070: Dhaval Dhanani =head1 COPYRIGHT Copyright (c) 2005, the above named PROJECT FOUNDER and CONTRIBUTORS. =head1 LICENSE This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut no Moose; __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Action.pm000644 000765 000024 00000011455 12156157140 021322 0ustar00johnstaff000000 000000 package Catalyst::Action; =head1 NAME Catalyst::Action - Catalyst Action =head1 SYNOPSIS
$c->forward( $action->private_path ); =head1 DESCRIPTION This class represents a Catalyst Action. You can access the object for the currently dispatched action via $c->action. See the L for more information on how actions are dispatched. Actions are defined in L subclasses. =cut use Moose; use Scalar::Util 'looks_like_number'; with 'MooseX::Emulate::Class::Accessor::Fast'; use namespace::clean -except => 'meta'; has class => (is => 'rw'); has namespace => (is => 'rw'); has 'reverse' => (is => 'rw'); has attributes => (is => 'rw'); has name => (is => 'rw'); has code => (is => 'rw'); has private_path => ( reader => 'private_path', isa => 'Str', lazy => 1, required => 1, default => sub { '/'.shift->reverse }, ); use overload ( # Stringify to reverse for debug output etc. q{""} => sub { shift->{reverse} }, # Codulate to execute to invoke the encapsulated action coderef '&{}' => sub { my $self = shift; sub { $self->execute(@_); }; }, # Make general $stuff still work fallback => 1, ); no warnings 'recursion'; sub dispatch { # Execute ourselves against a context my ( $self, $c ) = @_; return $c->execute( $self->class, $self ); } sub execute { my $self = shift; $self->code->(@_); } sub match { my ( $self, $c ) = @_; #would it be unreasonable to store the number of arguments #the action has as its own attribute? #it would basically eliminate the code below. ehhh. small fish return 1 unless exists $self->attributes->{Args}; my $args = $self->attributes->{Args}[0]; return 1 unless defined($args) && length($args); return scalar( @{ $c->req->args } ) == $args; } sub match_captures { 1 } sub compare { my ($a1, $a2) = @_; my ($a1_args) = @{ $a1->attributes->{Args} || [] }; my ($a2_args) = @{ $a2->attributes->{Args} || [] }; $_ = looks_like_number($_) ? $_ : ~0 for $a1_args, $a2_args; return $a1_args <=> $a2_args; } sub number_of_args { my ( $self ) = @_; return 0 unless exists $self->attributes->{Args}; return $self->attributes->{Args}[0]; } sub number_of_captures { my ( $self ) = @_; return 0 unless exists $self->attributes->{CaptureArgs}; return $self->attributes->{CaptureArgs}[0] || 0; } sub list_extra_info { my $self = shift; return { Args => $self->attributes->{Args}[0], CaptureArgs => $self->number_of_captures, } } __PACKAGE__->meta->make_immutable; 1; __END__ =head1 METHODS =head2 attributes The sub attributes that are set for this action, like Local, Path, Private and so on. This determines how the action is dispatched to. =head2 class Returns the name of the component where this action is defined. Derived by calling the L method on each component. =head2 code Returns a code reference to this action. =head2 dispatch( $c ) Dispatch this action against a context. =head2 execute( $controller, $c, @args ) Execute this action's coderef against a given controller with a given context and arguments =head2 match( $c ) Check Args attribute, and makes sure number of args matches the setting. Always returns true if Args is omitted. =head2 match_captures ($c, $captures) Can be implemented by action class and action role authors. If the method exists, then it will be called with the request context and an array reference of the captures for this action. Returning true from this method causes the chain match to continue, returning makes the chain not match (and alternate, less preferred chains will be attempted). =head2 compare Compares 2 actions based on the value of the C attribute, with no C having the highest precedence. =head2 namespace Returns the private namespace this action lives in. =head2 reverse Returns the private path for this action. =head2 private_path Returns absolute private path for this action. Unlike C, the C of an action is always suitable for passing to C. =head2 name Returns the sub name of this action. =head2 number_of_args Returns the number of args this action expects. This is 0 if the action doesn't take any arguments and undef if it will take any number of arguments. =head2 number_of_captures Returns the number of captures this action expects for L actions. =head2 list_extra_info A HashRef of key-values that an action can provide to a debugging screen =head2 meta Provided by Moose. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/ActionChain.pm000644 000765 000024 00000004171 12156157140 022262 0ustar00johnstaff000000 000000 package Catalyst::ActionChain; use Moose; extends qw(Catalyst::Action); has chain => (is => 'rw'); no Moose; =head1 NAME Catalyst::ActionChain - Chain of Catalyst Actions =head1 SYNOPSIS See L for more info about Chained actions. =head1 DESCRIPTION This class represents a chain of Catalyst Actions. It behaves exactly like the action at the *end* of the chain except on dispatch it will execute all the actions in the chain in order. =cut sub dispatch { my ( $self, $c ) = @_; my @captures = @{$c->req->captures||[]}; my @chain = @{ $self->chain }; my $last = pop(@chain); foreach my $action ( @chain ) { my @args; if (my $cap = $action->number_of_captures) { @args = splice(@captures, 0, $cap); } local $c->request->{arguments} = \@args; $action->dispatch( $c ); # break the chain if exception occurs in the middle of chain return if (@{$c->error} && $c->config->{abort_chain_on_error_fix}); } $last->dispatch( $c ); } sub from_chain { my ( $self, $actions ) = @_; my $final = $actions->[-1]; return $self->new({ %$final, chain => $actions }); } sub number_of_captures { my ( $self ) = @_; my $chain = $self->chain; my $captures = 0; $captures += $_->number_of_captures for @$chain; return $captures; } __PACKAGE__->meta->make_immutable; 1; __END__ =head1 METHODS =head2 chain Accessor for the action chain; will be an arrayref of the Catalyst::Action objects encapsulated by this chain. =head2 dispatch( $c ) Dispatch this action chain against a context; will dispatch the encapsulated actions in order. =head2 from_chain( \@actions ) Takes a list of Catalyst::Action objects and constructs and returns a Catalyst::ActionChain object representing a chain of these actions =head2 number_of_captures Returns the total number of captures for the entire chain of actions. =head2 meta Provided by Moose =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/ActionContainer.pm000644 000765 000024 00000003604 12106042701 023151 0ustar00johnstaff000000 000000 package Catalyst::ActionContainer; =head1 NAME Catalyst::ActionContainer - Catalyst Action Container =head1 SYNOPSIS See L. =head1 DESCRIPTION This is a container for actions. The dispatcher sets up a tree of these to represent the various dispatch points in your application. =cut use Moose; with 'MooseX::Emulate::Class::Accessor::Fast'; has part => (is => 'rw', required => 1); has actions => (is => 'rw', required => 1, lazy => 1, default => sub { {} }); around BUILDARGS => sub { my ($next, $self, @args) = @_; unshift @args, 'part' if scalar @args == 1 && !ref $args[0]; return $self->$next(@args); }; no Moose; use overload ( # Stringify to path part for tree search q{""} => sub { shift->part }, ); sub get_action { my ( $self, $name ) = @_; return $self->actions->{$name} if defined $self->actions->{$name}; return; } sub add_action { my ( $self, $action, $name ) = @_; $name ||= $action->name; $self->actions->{$name} = $action; } __PACKAGE__->meta->make_immutable; 1; __END__ =head1 METHODS =head2 new(\%data | $part) Can be called with { part => $part, actions => \%actions } for full construction or with just a part, which will result in an empty actions hashref to be populated via add_action later =head2 get_action($name) Returns an action from this container based on the action name, or undef =head2 add_action($action, [ $name ]) Adds an action, optionally providing a name to override $action->name =head2 actions Accessor to the actions hashref, containing all actions in this container. =head2 part Accessor to the path part this container resolves to. Also what the container stringifies to. =head2 meta Provided by Moose =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Catalyst-Runtime-5.90053/lib/Catalyst/ActionRole/000755 000765 000024 00000000000 12255610005 021572 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/Base.pm000644 000765 000024 00000001612 12121675274 020756 0ustar00johnstaff000000 000000 package Catalyst::Base; use Moose; BEGIN { extends 'Catalyst::Controller' } after 'BUILD' => sub { my $self = shift; warn(ref($self) . " is using the deprecated Catalyst::Base, update your application as this will be removed in the next major release"); }; no Moose; __PACKAGE__->meta->make_immutable; 1; __END__ =head1 NAME Catalyst::Base - Deprecated base class =head1 DESCRIPTION This used to be the base class for Catalyst Controllers. It remains here for compatibility reasons, but its use is highly deprecated. If your application produces a warning, then please update your application to inherit from L instead. =head1 SEE ALSO L, L. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/ClassData.pm000644 000765 000024 00000004252 12106042701 021730 0ustar00johnstaff000000 000000 package Catalyst::ClassData; use Moose::Role; use Moose::Meta::Class (); use Class::MOP; use Moose::Util (); sub mk_classdata { my ($class, $attribute, $warn_on_instance) = @_; confess("mk_classdata() is a class method, not an object method") if blessed $class; my $slot = '$'.$attribute; my $accessor = sub { my $pkg = ref $_[0] || $_[0]; my $meta = Moose::Util::find_meta($pkg) || Moose::Meta::Class->initialize( $pkg ); if (@_ > 1) { $meta->namespace->{$attribute} = \$_[1]; return $_[1]; } # tighter version of # if ( $meta->has_package_symbol($slot) ) { # return ${ $meta->get_package_symbol($slot) }; # } no strict 'refs'; my $v = *{"${pkg}::${attribute}"}{SCALAR}; if (defined ${$v}) { return ${$v}; } else { foreach my $super ( $meta->linearized_isa ) { # tighter version of same after # my $super_meta = Moose::Meta::Class->initialize($super); my $v = ${"${super}::"}{$attribute} ? *{"${super}::${attribute}"}{SCALAR} : undef; if (defined ${$v}) { return ${$v}; } } } return; }; confess("Failed to create accessor: $@ ") unless ref $accessor eq 'CODE'; my $meta = $class->Class::MOP::Object::meta(); confess "${class}'s metaclass is not a Class::MOP::Class" unless $meta->isa('Class::MOP::Class'); my $was_immutable = $meta->is_immutable; my %immutable_options = $meta->immutable_options; $meta->make_mutable if $was_immutable; my $alias = "_${attribute}_accessor"; $meta->add_method($alias, $accessor); $meta->add_method($attribute, $accessor); $meta->make_immutable(%immutable_options) if $was_immutable; $class->$attribute($_[2]) if(@_ > 2); return $accessor; } 1; __END__ =head1 NAME Catalyst::ClassData - Class data accessors =head1 METHODS =head2 mk_classdata $name, $optional_value A moose-safe clone of L that borrows some ideas from L; =head1 AUTHOR =begin stopwords Guillermo Roditi =end stopwords =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/Component/000755 000765 000024 00000000000 12255610005 021475 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/Component.pm000644 000765 000024 00000020453 12217110343 022035 0ustar00johnstaff000000 000000 package Catalyst::Component; use Moose; use Class::MOP; use Class::MOP::Object; use Catalyst::Utils; use Class::C3::Adopt::NEXT; use Devel::InnerPackage (); use MRO::Compat; use mro 'c3'; use Scalar::Util 'blessed'; use Class::Load 'is_class_loaded'; use Moose::Util 'find_meta'; use namespace::clean -except => 'meta'; with 'MooseX::Emulate::Class::Accessor::Fast'; with 'Catalyst::ClassData'; =head1 NAME Catalyst::Component - Catalyst Component Base Class =head1 SYNOPSIS # lib/MyApp/Model/Something.pm package MyApp::Model::Something; use base 'Catalyst::Component'; __PACKAGE__->config( foo => 'bar' ); has foo => ( is => 'ro', ); sub test { my $self = shift; return $self->foo; } sub forward_to_me { my ( $self, $c ) = @_; $c->response->output( $self->foo ); } 1; # Methods can be a request step $c->forward(qw/MyApp::Model::Something forward_to_me/); # Or just methods print $c->comp('MyApp::Model::Something')->test; print $c->comp('MyApp::Model::Something')->foo; =head1 DESCRIPTION This is the universal base class for Catalyst components (Model/View/Controller). It provides you with a generic new() for component construction through Catalyst's component loader with config() support and a process() method placeholder. B that calling C<< $self->config >> inside a component is strongly not recommended - the correctly merged config should have already been passed to the constructor and stored in attributes - accessing the config accessor directly from an instance is likely to get the wrong values (as it only holds the class wide config, not things loaded from the config file!) =cut __PACKAGE__->mk_classdata('_plugins'); __PACKAGE__->mk_classdata('_config'); has catalyst_component_name => ( is => 'ro' ); # Cannot be required => 1 as context # class @ISA component - HATE # Make accessor callable as a class method, as we need to call setup_actions # on the application class, which we don't have an instance of, ewwwww # Also, naughty modules like Catalyst::View::JSON try to write to _everything_, # so spit a warning, ignore that (and try to do the right thing anyway) here.. around catalyst_component_name => sub { my ($orig, $self) = (shift, shift); Carp::cluck("Tried to write to the catalyst_component_name accessor - is your component broken or just mad? (Write ignored - using default value.)") if scalar @_; blessed($self) ? $self->$orig() || blessed($self) : $self; }; sub BUILDARGS { my $class = shift; my $args = {}; if (@_ == 1) { $args = $_[0] if ref($_[0]) eq 'HASH'; } elsif (@_ == 2) { # is it ($app, $args) or foo => 'bar' ? if (blessed($_[0])) { $args = $_[1] if ref($_[1]) eq 'HASH'; } elsif (is_class_loaded($_[0]) && $_[0]->isa('Catalyst') && ref($_[1]) eq 'HASH') { $args = $_[1]; } else { $args = +{ @_ }; } } elsif (@_ % 2 == 0) { $args = +{ @_ }; } return $class->merge_config_hashes( $class->config, $args ); } sub COMPONENT { my ( $class, $c ) = @_; # Temporary fix, some components does not pass context to constructor my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {}; if ( my $next = $class->next::can ) { my ($next_package) = Class::MOP::get_code_info($next); warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}.\n"; warn "This behavior can no longer be supported, and so your application is probably broken.\n"; warn "Your linearized isa hierarchy is: " . join(', ', @{ mro::get_linear_isa($class) }) . "\n"; warn "Please see perldoc Catalyst::Upgrading for more information about this issue.\n"; } return $class->new($c, $arguments); } sub config { my $self = shift; # Uncomment once sane to do so #Carp::cluck("config method called on instance") if ref $self; my $config = $self->_config || {}; if (@_) { my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} }; $self->_config( $self->merge_config_hashes( $config, $newconfig ) ); } else { # this is a bit of a kludge, required to make # __PACKAGE__->config->{foo} = 'bar'; # work in a subclass. # TODO maybe this should be a ClassData option? my $class = blessed($self) || $self; my $meta = find_meta($class); unless (${ $meta->get_or_add_package_symbol('$_config') }) { # Call merge_hashes to ensure we deep copy the parent # config onto the subclass $self->_config( Catalyst::Utils::merge_hashes($config, {}) ); } } return $self->_config; } sub merge_config_hashes { my ( $self, $lefthash, $righthash ) = @_; return Catalyst::Utils::merge_hashes( $lefthash, $righthash ); } sub process { Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] ) . " did not override Catalyst::Component::process" ); } sub expand_modules { my ($class, $component) = @_; return Devel::InnerPackage::list_packages( $component ); } __PACKAGE__->meta->make_immutable; 1; __END__ =head1 METHODS =head2 new($app, $arguments) Called by COMPONENT to instantiate the component; should return an object to be stored in the application's component hash. =head2 COMPONENT C<< my $component_instance = $component->COMPONENT($app, $arguments); >> If this method is present (as it is on all Catalyst::Component subclasses), it is called by Catalyst during setup_components with the application class as $app and any config entry on the application for this component (for example, in the case of MyApp::Controller::Foo this would be C<< MyApp->config('Controller::Foo' => \%conf >>). The arguments are expected to be a hashref and are merged with the C<< __PACKAGE__->config >> hashref before calling C<< ->new >> to instantiate the component. You can override it in your components to do custom construction, using something like this: sub COMPONENT { my ($class, $app, $args) = @_; $args = $class->merge_config_hashes($class->config, $args); return $class->new($app, $args); } =head2 $c->config =head2 $c->config($hashref) =head2 $c->config($key, $value, ...) Accessor for this component's config hash. Config values can be set as key value pair, or you can specify a hashref. In either case the keys will be merged with any existing config settings. Each component in a Catalyst application has its own config hash. The component's config hash is merged with any config entry on the application for this component and passed to C (as mentioned above at L). The recommended practice to access the merged config is to use a Moose attribute for each config entry on the receiving component. =head2 $c->process() This is the default method called on a Catalyst component in the dispatcher. For instance, Views implement this action to render the response body when you forward to them. The default is an abstract method. =head2 $c->merge_config_hashes( $hashref, $hashref ) Merges two hashes together recursively, giving right-hand precedence. Alias for the method in L. =head2 $c->expand_modules( $setup_component_config ) Return a list of extra components that this component has created. By default, it just looks for a list of inner packages of this component =cut =head1 OPTIONAL METHODS =head2 ACCEPT_CONTEXT($c, @args) Catalyst components are normally initialized during server startup, either as a Class or a Instance. However, some components require information about the current request. To do so, they can implement an ACCEPT_CONTEXT method. If this method is present, it is called during $c->comp/controller/model/view with the current $c and any additional args (e.g. $c->model('Foo', qw/bar baz/) would cause your MyApp::Model::Foo instance's ACCEPT_CONTEXT to be called with ($c, 'bar', 'baz')) and the return value of this method is returned to the calling code in the application rather than the component itself. =head1 SEE ALSO L, L, L, L. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/Controller.pm000644 000765 000024 00000064700 12236261623 022232 0ustar00johnstaff000000 000000 package Catalyst::Controller; use Moose; use Class::MOP; use Class::Load ':all'; use String::RewritePrefix; use Moose::Util qw/find_meta/; use List::Util qw/first/; use List::MoreUtils qw/uniq/; use namespace::clean -except => 'meta'; BEGIN { extends qw/Catalyst::Component/; with qw/MooseX::MethodAttributes::Role::AttrContainer::Inheritable/; } use MooseX::MethodAttributes; use Catalyst::Exception; use Catalyst::Utils; with 'Catalyst::Component::ApplicationAttribute'; has path_prefix => ( is => 'rw', isa => 'Str', init_arg => 'path', predicate => 'has_path_prefix', ); has action_namespace => ( is => 'rw', isa => 'Str', init_arg => 'namespace', predicate => 'has_action_namespace', ); has actions => ( accessor => '_controller_actions', isa => 'HashRef', init_arg => undef, ); has _action_role_args => ( traits => [qw(Array)], isa => 'ArrayRef[Str]', init_arg => 'action_roles', default => sub { [] }, handles => { _action_role_args => 'elements', }, ); has _action_roles => ( traits => [qw(Array)], isa => 'ArrayRef[RoleName]', init_arg => undef, lazy => 1, builder => '_build__action_roles', handles => { _action_roles => 'elements', }, ); has action_args => (is => 'ro'); # ->config(actions => { '*' => ... has _all_actions_attributes => ( is => 'ro', isa => 'HashRef', init_arg => undef, lazy => 1, builder => '_build__all_actions_attributes', ); sub BUILD { my ($self, $args) = @_; my $action = delete $args->{action} || {}; my $actions = delete $args->{actions} || {}; my $attr_value = $self->merge_config_hashes($actions, $action); $self->_controller_actions($attr_value); # trigger lazy builder $self->_all_actions_attributes; $self->_action_roles; } sub _build__action_roles { my $self = shift; my @roles = $self->_expand_role_shortname($self->_action_role_args); load_class($_) for @roles; return \@roles; } sub _build__all_actions_attributes { my ($self) = @_; delete $self->_controller_actions->{'*'} || {}; } =head1 NAME Catalyst::Controller - Catalyst Controller base class =head1 SYNOPSIS package MyApp::Controller::Search use base qw/Catalyst::Controller/; sub foo : Local { my ($self,$c,@args) = @_; ... } # Dispatches to /search/foo =head1 DESCRIPTION Controllers are where the actions in the Catalyst framework reside. Each action is represented by a function with an attribute to identify what kind of action it is. See the L for more info about how Catalyst dispatches to actions. =cut #I think both of these could be attributes. doesn't really seem like they need #to be class data. i think that attributes +default would work just fine __PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class _action_role_prefix/; __PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] ); __PACKAGE__->_action_class('Catalyst::Action'); __PACKAGE__->_action_role_prefix([ 'Catalyst::ActionRole::' ]); sub _DISPATCH : Private { my ( $self, $c ) = @_; foreach my $disp ( @{ $self->_dispatch_steps } ) { last unless $c->forward($disp); } $c->forward('_END'); } sub _BEGIN : Private { my ( $self, $c ) = @_; my $begin = ( $c->get_actions( 'begin', $c->namespace ) )[-1]; return 1 unless $begin; $begin->dispatch( $c ); return !@{ $c->error }; } sub _AUTO : Private { my ( $self, $c ) = @_; my @auto = $c->get_actions( 'auto', $c->namespace ); foreach my $auto (@auto) { $auto->dispatch( $c ); return 0 unless $c->state; } return 1; } sub _ACTION : Private { my ( $self, $c ) = @_; if ( ref $c->action && $c->action->can('execute') && defined $c->req->action ) { $c->action->dispatch( $c ); } return !@{ $c->error }; } sub _END : Private { my ( $self, $c ) = @_; my $end = ( $c->get_actions( 'end', $c->namespace ) )[-1]; return 1 unless $end; $end->dispatch( $c ); return !@{ $c->error }; } sub action_for { my ( $self, $name ) = @_; my $app = ($self->isa('Catalyst') ? $self : $self->_application); return $app->dispatcher->get_action($name, $self->action_namespace); } #my opinion is that this whole sub really should be a builder method, not #something that happens on every call. Anyone else disagree?? -- groditi ## -- apparently this is all just waiting for app/ctx split around action_namespace => sub { my $orig = shift; my ( $self, $c ) = @_; my $class = ref($self) || $self; my $appclass = ref($c) || $c; if( ref($self) ){ return $self->$orig if $self->has_action_namespace; } else { return $class->config->{namespace} if exists $class->config->{namespace}; } my $case_s; if( $c ){ $case_s = $appclass->config->{case_sensitive}; } else { if ($self->isa('Catalyst')) { $case_s = $class->config->{case_sensitive}; } else { if (ref $self) { $case_s = ref($self->_application)->config->{case_sensitive}; } else { confess("Can't figure out case_sensitive setting"); } } } my $namespace = Catalyst::Utils::class2prefix($self->catalyst_component_name, $case_s) || ''; $self->$orig($namespace) if ref($self); return $namespace; }; #Once again, this is probably better written as a builder method around path_prefix => sub { my $orig = shift; my $self = shift; if( ref($self) ){ return $self->$orig if $self->has_path_prefix; } else { return $self->config->{path} if exists $self->config->{path}; } my $namespace = $self->action_namespace(@_); $self->$orig($namespace) if ref($self); return $namespace; }; sub get_action_methods { my $self = shift; my $meta = find_meta($self) || confess("No metaclass setup for $self"); confess( sprintf "Metaclass %s for %s cannot support register_actions.", ref $meta, $meta->name, ) unless $meta->can('get_nearest_methods_with_attributes'); my @methods = $meta->get_nearest_methods_with_attributes; # actions specified via config are also action_methods push( @methods, map { $meta->find_method_by_name($_) || confess( sprintf 'Action "%s" is not available from controller %s', $_, ref $self ) } keys %{ $self->_controller_actions } ) if ( ref $self ); return uniq @methods; } sub register_actions { my ( $self, $c ) = @_; $self->register_action_methods( $c, $self->get_action_methods ); } sub register_action_methods { my ( $self, $c, @methods ) = @_; my $class = $self->catalyst_component_name; #this is still not correct for some reason. my $namespace = $self->action_namespace($c); # FIXME - fugly if (!blessed($self) && $self eq $c && scalar(@methods)) { my @really_bad_methods = grep { ! /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/ } map { $_->name } @methods; if (scalar(@really_bad_methods)) { $c->log->warn("Action methods (" . join(', ', @really_bad_methods) . ") found defined in your application class, $self. This is deprecated, please move them into a Root controller."); } } foreach my $method (@methods) { my $name = $method->name; # Horrible hack! All method metaclasses should have an attributes # method, core Moose bug - see r13354. my $attributes = $method->can('attributes') ? $method->attributes : []; my $attrs = $self->_parse_attrs( $c, $name, @{ $attributes } ); if ( $attrs->{Private} && ( keys %$attrs > 1 ) ) { $c->log->warn( 'Bad action definition "' . join( ' ', @{ $attributes } ) . qq/" for "$class->$name"/ ) if $c->debug; next; } my $reverse = $namespace ? "${namespace}/${name}" : $name; my $action = $self->create_action( name => $name, code => $method->body, reverse => $reverse, namespace => $namespace, class => $class, attributes => $attrs, ); $c->dispatcher->register( $c, $action ); } } sub _apply_action_class_roles { my ($self, $class, @roles) = @_; load_class($_) for @roles; my $meta = Moose::Meta::Class->initialize($class)->create_anon_class( superclasses => [$class], roles => \@roles, cache => 1, ); $meta->add_method(meta => sub { $meta }); return $meta->name; } sub action_class { my $self = shift; my %args = @_; my $class = (exists $args{attributes}{ActionClass} ? $args{attributes}{ActionClass}[0] : $self->_action_class); load_class($class); return $class; } sub create_action { my $self = shift; my %args = @_; my $class = $self->action_class(%args); load_class($class); Moose->init_meta(for_class => $class) unless Class::MOP::does_metaclass_exist($class); unless ($args{name} =~ /^_(DISPATCH|BEGIN|AUTO|ACTION|END)$/) { my @roles = $self->gather_action_roles(%args); push @roles, $self->gather_default_action_roles(%args); $class = $self->_apply_action_class_roles($class, @roles) if @roles; } my $action_args = ( ref($self) ? $self->action_args : $self->config->{action_args} ); my %extra_args = ( %{ $action_args->{'*'} || {} }, %{ $action_args->{ $args{name} } || {} }, ); return $class->new({ %extra_args, %args }); } sub gather_action_roles { my ($self, %args) = @_; return ( (blessed $self ? $self->_action_roles : ()), @{ $args{attributes}->{Does} || [] }, ); } sub gather_default_action_roles { my ($self, %args) = @_; my @roles = (); push @roles, 'Catalyst::ActionRole::HTTPMethods' if $args{attributes}->{Method}; push @roles, 'Catalyst::ActionRole::ConsumesContent' if $args{attributes}->{Consumes}; return @roles; } sub _parse_attrs { my ( $self, $c, $name, @attrs ) = @_; my %raw_attributes; foreach my $attr (@attrs) { # Parse out :Foo(bar) into Foo => bar etc (and arrayify) if ( my ( $key, $value ) = ( $attr =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ ) ) { if ( defined $value ) { ( $value =~ s/^'(.*)'$/$1/ ) || ( $value =~ s/^"(.*)"/$1/ ); } push( @{ $raw_attributes{$key} }, $value ); } } my ($actions_config, $all_actions_config); if( ref($self) ) { $actions_config = $self->_controller_actions; # No, you're not getting actions => { '*' => ... } with actions in MyApp. $all_actions_config = $self->_all_actions_attributes; } else { my $cfg = $self->config; $actions_config = $self->merge_config_hashes($cfg->{actions}, $cfg->{action}); $all_actions_config = {}; } %raw_attributes = ( %raw_attributes, # Note we deep copy array refs here to stop crapping on config # when attributes are parsed. RT#65463 exists $actions_config->{$name} ? map { ref($_) eq 'ARRAY' ? [ @$_ ] : $_ } %{ $actions_config->{$name } } : (), ); # Private actions with additional attributes will raise a warning and then # be ignored. Adding '*' arguments to the default _DISPATCH / etc. methods, # which are Private, will prevent those from being registered. They should # probably be turned into :Actions instead, or we might want to otherwise # disambiguate between those built-in internal actions and user-level # Private ones. %raw_attributes = (%{ $all_actions_config }, %raw_attributes) unless $raw_attributes{Private}; my %final_attributes; while (my ($key, $value) = each %raw_attributes){ my $new_attrs = $self->_parse_attr($c, $name, $key => $value ); push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs; } return \%final_attributes; } sub _parse_attr { my ($self, $c, $name, $key, $values) = @_; my %final_attributes; foreach my $value (ref($values) eq 'ARRAY' ? @$values : $values) { my $meth = "_parse_${key}_attr"; if ( my $code = $self->can($meth) ) { my %new_attrs = $self->$code( $c, $name, $value ); while (my ($new_key, $value) = each %new_attrs){ my $new_attrs = $key eq $new_key ? { $new_key => [$value] } : $self->_parse_attr($c, $name, $new_key => $value ); push @{ $final_attributes{$_} }, @{ $new_attrs->{$_} } for keys %$new_attrs; } } else { push( @{ $final_attributes{$key} }, $value ); } } return \%final_attributes; } sub _parse_Global_attr { my ( $self, $c, $name, $value ) = @_; # _parse_attr will call _parse_Path_attr for us return Path => "/$name"; } sub _parse_Absolute_attr { shift->_parse_Global_attr(@_); } sub _parse_Local_attr { my ( $self, $c, $name, $value ) = @_; # _parse_attr will call _parse_Path_attr for us return Path => $name; } sub _parse_Relative_attr { shift->_parse_Local_attr(@_); } sub _parse_Path_attr { my ( $self, $c, $name, $value ) = @_; $value = '' if !defined $value; if ( $value =~ m!^/! ) { return ( 'Path', $value ); } elsif ( length $value ) { return ( 'Path', join( '/', $self->path_prefix($c), $value ) ); } else { return ( 'Path', $self->path_prefix($c) ); } } sub _parse_Chained_attr { my ($self, $c, $name, $value) = @_; if (defined($value) && length($value)) { if ($value eq '.') { $value = '/'.$self->action_namespace($c); } elsif (my ($rel, $rest) = $value =~ /^((?:\.{2}\/)+)(.*)$/) { my @parts = split '/', $self->action_namespace($c); my @levels = split '/', $rel; $value = '/'.join('/', @parts[0 .. $#parts - @levels], $rest); } elsif ($value !~ m/^\//) { my $action_ns = $self->action_namespace($c); if ($action_ns) { $value = '/'.join('/', $action_ns, $value); } else { $value = '/'.$value; # special case namespace '' (root) } } } else { $value = '/' } return Chained => $value; } sub _parse_ChainedParent_attr { my ($self, $c, $name, $value) = @_; return $self->_parse_Chained_attr($c, $name, '../'.$name); } sub _parse_PathPrefix_attr { my ( $self, $c ) = @_; return PathPart => $self->path_prefix($c); } sub _parse_ActionClass_attr { my ( $self, $c, $name, $value ) = @_; my $appname = $self->_application; $value = Catalyst::Utils::resolve_namespace($appname . '::Action', $self->_action_class, $value); return ( 'ActionClass', $value ); } sub _parse_MyAction_attr { my ( $self, $c, $name, $value ) = @_; my $appclass = Catalyst::Utils::class2appclass($self); $value = "+${appclass}::Action::${value}"; return ( 'ActionClass', $value ); } sub _parse_Does_attr { my ($self, $app, $name, $value) = @_; return Does => $self->_expand_role_shortname($value); } sub _parse_GET_attr { Method => 'GET' } sub _parse_POST_attr { Method => 'POST' } sub _parse_PUT_attr { Method => 'PUT' } sub _parse_DELETE_attr { Method => 'DELETE' } sub _parse_OPTION_attr { Method => 'OPTION' } sub _parse_HEAD_attr { Method => 'HEAD' } sub _expand_role_shortname { my ($self, @shortnames) = @_; my $app = $self->_application; my $prefix = $self->can('_action_role_prefix') ? $self->_action_role_prefix : ['Catalyst::ActionRole::']; my @prefixes = (qq{${app}::ActionRole::}, @$prefix); return String::RewritePrefix->rewrite( { '' => sub { my $loaded = load_first_existing_class( map { "$_$_[0]" } @prefixes ); return first { $loaded =~ /^$_/ } sort { length $b <=> length $a } @prefixes; }, '~' => $prefixes[0], '+' => '' }, @shortnames, ); } __PACKAGE__->meta->make_immutable; 1; __END__ =head1 CONFIGURATION Like any other L, controllers have a config hash, accessible through $self->config from the controller actions. Some settings are in use by the Catalyst framework: =head2 namespace This specifies the internal namespace the controller should be bound to. By default the controller is bound to the URI version of the controller name. For instance controller 'MyApp::Controller::Foo::Bar' will be bound to 'foo/bar'. The default Root controller is an example of setting namespace to '' (the null string). =head2 path Sets 'path_prefix', as described below. =head2 action Allows you to set the attributes that the dispatcher creates actions out of. This allows you to do 'rails style routes', or override some of the attribute definitions of actions composed from Roles. You can set arguments globally (for all actions of the controller) and specifically (for a single action). __PACKAGE__->config( action => { '*' => { Chained => 'base', Args => 0 }, base => { Chained => '/', PathPart => '', CaptureArgs => 0 }, }, ); In the case above every sub in the package would be made into a Chain endpoint with a URI the same as the sub name for each sub, chained to the sub named C. Ergo dispatch to C would call the C method, then the C method. =head2 action_args Allows you to set constructor arguments on your actions. You can set arguments globally and specifically (as above). This is particularly useful when using Cs (L) and custom Ces. __PACKAGE__->config( action_args => { '*' => { globalarg1 => 'hello', globalarg2 => 'goodbye' }, 'specific_action' => { customarg => 'arg1' }, }, ); In the case above the action class associated with C would get passed the following arguments, in addition to the normal action constructor arguments, when it is instantiated: (globalarg1 => 'hello', globalarg2 => 'goodbye', customarg => 'arg1') =head1 METHODS =head2 BUILDARGS ($app, @args) From L, stashes the application instance as $self->_application. =head2 $self->action_for('name') Returns the Catalyst::Action object (if any) for a given method name in this component. =head2 $self->action_namespace($c) Returns the private namespace for actions in this component. Defaults to a value from the controller name (for e.g. MyApp::Controller::Foo::Bar becomes "foo/bar") or can be overridden from the "namespace" config key. =head2 $self->path_prefix($c) Returns the default path prefix for :PathPrefix, :Local and relative :Path actions in this component. Defaults to the action_namespace or can be overridden from the "path" config key. =head2 $self->register_actions($c) Finds all applicable actions for this component, creates Catalyst::Action objects (using $self->create_action) for them and registers them with $c->dispatcher. =head2 $self->get_action_methods() Returns a list of L objects, doing the L role, which are the set of action methods for this package. =head2 $self->register_action_methods($c, @methods) Creates action objects for a set of action methods using C< create_action >, and registers them with the dispatcher. =head2 $self->action_class(%args) Used when a controller is creating an action to determine the correct base action class to use. =head2 $self->create_action(%args) Called with a hash of data to be use for construction of a new Catalyst::Action (or appropriate sub/alternative class) object. =head2 $self->gather_action_roles(\%action_args) Gathers the list of roles to apply to an action with the given %action_args. =head2 $self->gather_default_action_roles(\%action_args) returns a list of action roles to be applied based on core, builtin rules. Currently only the L role is applied this way. =head2 $self->_application =head2 $self->_app Returns the application instance stored by C =head1 ACTION SUBROUTINE ATTRIBUTES Please see L for more details Think of action attributes as a sort of way to record metadata about an action, similar to how annotations work in other languages you might have heard of. Generally L uses these to influence how the dispatcher sees your action and when it will run it in response to an incoming request. They can also be used for other things. Here's a summary, but you should refer to the linked manual page for additional help. =head2 Global sub homepage :Global { ... } A global action defined in any controller always runs relative to your root. So the above is the same as: sub myaction :Path("/homepage") { ... } =head2 Absolute Status: Deprecated alias to L. =head2 Local Alias to "Path("$action_name"). The following two actions are the same: sub myaction :Local { ... } sub myaction :Path('myaction') { ... } =head2 Relative Status: Deprecated alias to L =head2 Path Handle various types of paths: package MyApp::Controller::Baz { ... sub myaction1 :Path { ... } # -> /baz sub myaction2 :Path('foo') { ... } # -> /baz/foo sub myaction2 :Path('/bar') { ... } # -> /bar } This is a general toolbox for attaching your action to a given path. =head2 Regex =head2 Regexp B Use Chained methods or other techniques. If you really depend on this, install the standalone L distribution. A global way to match a give regular expression in the incoming request path. =head2 LocalRegex =head2 LocalRegexp B Use Chained methods or other techniques. If you really depend on this, install the standalone L distribution. Like L but scoped under the namespace of the containing controller =head2 Chained =head2 ChainedParent =head2 PathPrefix =head2 PathPart =head2 CaptureArgs Please see L =head2 ActionClass Set the base class for the action, defaults to L. It is now preferred to use L. =head2 MyAction Set the ActionClass using a custom Action in your project namespace. The following is exactly the same: sub foo_action1 : Local ActionClass('+MyApp::Action::Bar') { ... } sub foo_action2 : Local MyAction('Bar') { ... } =head2 Does package MyApp::Controller::Zoo; sub foo : Local Does('Moo') { ... } # Catalyst::ActionRole:: sub bar : Local Does('~Moo') { ... } # MyApp::ActionRole::Moo sub baz : Local Does('+MyApp::ActionRole::Moo') { ... } =head2 GET =head2 POST =head2 PUT =head2 DELETE =head2 OPTION =head2 HEAD =head2 PATCH =head2 Method('...') Sets the give action path to match the specified HTTP method, or via one of the broadly accepted methods of overriding the 'true' method (see L). =head2 Args When used with L indicates the number of arguments expected in the path. However if no Args value is set, assumed to 'slurp' all remaining path pars under this namespace. =head2 Consumes('...') Matches the current action against the content-type of the request. Typically this is used when the request is a POST or PUT and you want to restrict the submitted content type. For example, you might have an HTML for that either returns classic url encoded form data, or JSON when Javascript is enabled. In this case you may wish to match either incoming type to one of two different actions, for properly processing. Examples: sub is_json : Chained('start') Consumes('application/json') { ... } sub is_urlencoded : Chained('start') Consumes('application/x-www-form-urlencoded') { ... } sub is_multipart : Chained('start') Consumes('multipart/form-data') { ... } To reduce boilerplate, we include the following content type shortcuts: Examples sub is_json : Chained('start') Consume(JSON) { ... } sub is_urlencoded : Chained('start') Consumes(UrlEncoded) { ... } sub is_multipart : Chained('start') Consumes(Multipart) { ... } You may specify more than one match: sub is_more_than_one : Chained('start') : Consumes('application/x-www-form-urlencoded') : Consumes('multipart/form-data') sub is_more_than_one : Chained('start') : Consumes(UrlEncoded) : Consumes(Multipart) Since it is a common case the shortcut C matches both 'application/x-www-form-urlencoded' and 'multipart/form-data'. Here's the full list of available shortcuts: JSON => 'application/json', JS => 'application/javascript', PERL => 'application/perl', HTML => 'text/html', XML => 'text/XML', Plain => 'text/plain', UrlEncoded => 'application/x-www-form-urlencoded', Multipart => 'multipart/form-data', HTMLForm => ['application/x-www-form-urlencoded','multipart/form-data'], Please keep in mind that when dispatching, L will match the first most relevant case, so if you use the C attribute, you should place your most accurate matches early in the Chain, and your 'catchall' actions last. See L for more. =head1 OPTIONAL METHODS =head2 _parse_[$name]_attr Allows you to customize parsing of subroutine attributes. sub myaction1 :Path TwoArgs { ... } sub _parse_TwoArgs_attr { my ( $self, $c, $name, $value ) = @_; # $self -> controller instance # return(Args => 2); } Please note that this feature does not let you actually assign new functions to actions via subroutine attributes, but is really more for creating useful aliases to existing core and extended attributes, and transforms based on existing information (like from configuration). Code for actually doing something meaningful with the subroutine attributes will be located in the L classes (or your subclasses), L and in subclasses of L. Remember these methods only get called basically once when the application is starting, not per request! =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/Delta.pod000755 000765 000024 00000015661 12255607717 021324 0ustar00johnstaff000000 000000 =head1 NAME Catalyst::Delta - Overview of changes between versions of Catalyst =head1 DESCRIPTION This is an overview of the user-visible changes to Catalyst between major Catalyst releases. =head2 VERSION 5.90053 We are now clarifying the behavior of log, plugins and configuration during the setup phase. Since Plugins might require a log during setup, setup_log must run BEFORE setup_plugins. This has the unfortunate side effect that anyone using the popular ConfigLoader plugin will not be able to supply configuration to custom logs since the configuration is not yet finalized when setup_log is run (when using ConfigLoader, which is a plugin and is not loaded until later.) As a workaround, you can supply custom log configuration directly into the configuration: package MyApp; use Catalyst; __PACKAGE__->config( my_custom_log_info => { %custom_args }, ); __PACKAGE__->setup; If you wish to configure the custom logger differently based on ENV, you can try: package MyApp; use Catalyst; use Catalyst::Utils; __PACKAGE__->config( Catalyst::Utils::merge_hashes( +{ my_custom_log_info => { %base_custom_args } }, +{ do __PACKAGE__->path_to( $ENV{WHICH_CONF}."_conf.pl") }, ), ); __PACKAGE__->setup; Or create a standalone Configuration class that does the right thing. Basically if you want to configure a logger via Catalyst global configuration you can't use ConfigLoader because it will always be loaded too late to be of any use. Patches and workaround options welcomed! =head2 VERSION 5.9XXXX 'cataplack' The Catalyst::Engine sub-classes have all been removed and deprecated, to be replaced with Plack handlers. Plack is an implementation of the L specification, which is a standard interface between web servers and application frameworks. This should be no different for developers, and you should not have to migrate your applications unless you are using a custom engine already. This change benefits Catalyst significantly by reducing the amount of code inside the framework, and means that the framework gets upstream bug fixes in L, and automatically gains support for any web server which a L compliant handler is written for. It also allows you more flexibility with your application, and allows the use of cross web framework 'middleware'. Developers are recommended to read L for notes about upgrading, especially if you are using an unusual deployment method. Documentation for how to take advantage of L can be found in L, and information about deploying your application has been moved to L. =head3 Updated modules: A number of modules have been updated to pass their tests or not produce deprecation warnings with the latest version of Catalyst. It is recommended that you upgrade any of these that you are using after installing this version of Catalyst. These extensions are: =over =item L This is now deprecated, see L. =item L Has been updated to not produce deprecation warnings, upgrade recommended. =item Catalyst::ActionRole::ACL Has been updated to fix failing tests (although older versions still function perfectly with this version of Catalyst). =item Catalyst::Plugin::Session::Store::DBIC Has been updated to fix failing tests (although older versions still function perfectly with this version of Catalyst). =item Catalyst::Plugin::Authentication Has been updated to fix failing tests (although older versions still function perfectly with this version of Catalyst). =back =head1 PREVIOUS VERSIONS =head2 VERSION 5.8XXXX 'catamoose' =head3 Deprecations Please see L for a full description of how changes in the framework may affect your application. Below is a brief list of features which have been deprecated in this release: =over =item ::[MVC]:: style naming scheme has been deprecated and will warn =item NEXT is deprecated for all applications and components, use MRO::Compat =item Dispatcher methods which are an implementation detail made private, public versions now warn. =item MyApp->plugin method is deprecated, use L instead. =item __PACKAGE__->mk_accessors() is supported for backward compatibility only, use Moose attributes instead in new code. =item Use of Catalyst::Base now warns =back =head3 New features =head3 Dispatcher =over =item Fix forwarding to Catalyst::Action objects. =item Add the dispatch_type method =back =head3 Restarter The development server restarter has been improved to be compatible with immutable Moose classes, and also to optionally use L to handle more complex application layouts correctly. =head3 $c->uri_for_action method. Give a private path to the Catalyst action you want to create a URI for. =head3 Logging Log levels have been made additive. =head3 L =over =item Change to use L. =item Support mocking multiple virtual hosts =item New methods like action_ok and action_redirect to write more compact tests =back =head3 Catalyst::Response =over =item * New print method which prints @data to the output stream, separated by $,. This lets you pass the response object to functions that want to write to an L. =item * Added code method as an alias for C<< $res->status >> =back =head3 Consequences of the Moose back end =over =item * Components are fully compatible with Moose, and all Moose features, such as method modifiers, attributes, roles, BUILD and BUILDARGS methods are fully supported and may be used in components and applications. =item * Many reusable extensions which would previously have been plugins or base classes are better implemented as Moose roles. =item * L is used to contain action attributes. This means that attributes are represented in the MOP, and decouples action creation from attributes. =item * There is a reasonable API in Catalyst::Controller for working with and registering actions, allowing a controller sub-class to replace subroutine attributes for action declarations with an alternate syntax. =item * Refactored capturing of $app from L into L for easier reuse in other components. =item * Your application class is forced to become immutable at the end of compilation. =back =head3 Bug fixes =over =item * Don't ignore SIGCHLD while handling requests with the development server, so that system() and other ways of creating child processes work as expected. =item * Fixes for FastCGI when used with IIS 6.0 =item * Fix a bug in uri_for which could cause it to generate paths with multiple slashes in them. =item * Fix a bug in Catalyst::Stats, stopping garbage being inserted into the stats if a user calls begin => but no end =back Catalyst-Runtime-5.90053/lib/Catalyst/Dispatcher.pm000644 000765 000024 00000054140 12217110343 022161 0ustar00johnstaff000000 000000 package Catalyst::Dispatcher; use Moose; use Class::MOP; with 'MooseX::Emulate::Class::Accessor::Fast'; use Catalyst::Exception; use Catalyst::Utils; use Catalyst::Action; use Catalyst::ActionContainer; use Catalyst::DispatchType::Default; use Catalyst::DispatchType::Index; use Catalyst::Utils; use Text::SimpleTable; use Tree::Simple; use Tree::Simple::Visitor::FindByPath; use Class::Load qw(load_class try_load_class); use namespace::clean -except => 'meta'; # Refactoring note: # do these belong as package vars or should we build these via a builder method? # See Catalyst-Plugin-Server for them being added to, which should be much less ugly. # Preload these action types our @PRELOAD = qw/Index Path/; # Postload these action types our @POSTLOAD = qw/Default/; # Note - see back-compat methods at end of file. has _tree => (is => 'rw', builder => '_build__tree'); has dispatch_types => (is => 'rw', default => sub { [] }, required => 1, lazy => 1); has _registered_dispatch_types => (is => 'rw', default => sub { {} }, required => 1, lazy => 1); 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 { {} }); my %dispatch_types = ( pre => \@PRELOAD, post => \@POSTLOAD ); foreach my $type (keys %dispatch_types) { has $type . "load_dispatch_types" => ( is => 'rw', required => 1, lazy => 1, default => sub { $dispatch_types{$type} }, traits => ['MooseX::Emulate::Class::Accessor::Fast::Meta::Role::Attribute'], # List assignment is CAF style ); } =head1 NAME Catalyst::Dispatcher - The Catalyst Dispatcher =head1 SYNOPSIS See L. =head1 DESCRIPTION This is the class that maps public urls to actions in your Catalyst application based on the attributes you set. =head1 METHODS =head2 new Construct a new dispatcher. =cut sub _build__tree { my ($self) = @_; my $container = Catalyst::ActionContainer->new( { part => '/', actions => {} } ); return Tree::Simple->new($container, Tree::Simple->ROOT); } =head2 $self->preload_dispatch_types An arrayref of pre-loaded dispatchtype classes Entries are considered to be available as C To use a custom class outside the regular C namespace, prefix it with a C<+>, like so: +My::Dispatch::Type =head2 $self->postload_dispatch_types An arrayref of post-loaded dispatchtype classes Entries are considered to be available as C To use a custom class outside the regular C namespace, prefix it with a C<+>, like so: +My::Dispatch::Type =head2 $self->dispatch($c) Delegate the dispatch to the action that matched the url, or return a message about unknown resource =cut sub dispatch { my ( $self, $c ) = @_; if ( my $action = $c->action ) { $c->forward( join( '/', '', $action->namespace, '_DISPATCH' ) ); } else { my $path = $c->req->path; my $error = $path ? qq/Unknown resource "$path"/ : "No default action defined"; $c->log->error($error) if $c->debug; $c->error($error); } } # $self->_command2action( $c, $command [, \@arguments ] ) # $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 { my ( $self, $c, $command, @extra_params ) = @_; unless ($command) { $c->log->debug('Nothing to go to') if $c->debug; return 0; } my (@args, @captures); if ( ref( $extra_params[-2] ) eq 'ARRAY' ) { @captures = @{ splice @extra_params, -2, 1 }; } 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 @args = @{ $c->request->arguments }; } my $action; # go to a string path ("/foo/bar/gorch") # or action object if (blessed($command) && $command->isa('Catalyst::Action')) { $action = $command; } else { $action = $self->_invoke_as_path( $c, "$command", \@args ); } # go to a component ( "View::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, \@captures; } =head2 $self->visit( $c, $command [, \@arguments ] ) Documented in L =cut sub visit { my $self = shift; $self->_do_visit('visit', @_); } sub _do_visit { my $self = shift; my $opname = shift; my ( $c, $command ) = @_; my ( $action, $args, $captures ) = $self->_command2action(@_); my $error = qq/Couldn't $opname("$command"): /; if (!$action) { $error .= qq/Couldn't $opname to command "$command": / .qq/Invalid action or component./; } elsif (!defined $action->namespace) { $error .= qq/Action has no namespace: cannot $opname() to a plain / .qq/method or component, must be an :Action of some sort./ } elsif (!$action->class->can('_DISPATCH')) { $error .= qq/Action cannot _DISPATCH. / .qq/Did you try to $opname() a non-controller action?/; } else { $error = q(); } if($error) { $c->error($error); $c->log->debug($error) if $c->debug; return 0; } $action = $self->expand_action($action); local $c->request->{arguments} = $args; local $c->request->{captures} = $captures; local $c->{namespace} = $action->{'namespace'}; local $c->{action} = $action; $self->dispatch($c); } =head2 $self->go( $c, $command [, \@arguments ] ) Documented in L =cut sub go { my $self = shift; $self->_do_visit('go', @_); Catalyst::Exception::Go->throw; } =head2 $self->forward( $c, $command [, \@arguments ] ) Documented in L =cut sub forward { my $self = shift; no warnings 'recursion'; $self->_do_forward(forward => @_); } sub _do_forward { my $self = shift; my $opname = shift; my ( $c, $command ) = @_; my ( $action, $args, $captures ) = $self->_command2action(@_); if (!$action) { my $error .= qq/Couldn't $opname 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; no warnings 'recursion'; $action->dispatch( $c ); return $c->state; } =head2 $self->detach( $c, $command [, \@arguments ] ) Documented in L =cut sub detach { my ( $self, $c, $command, @args ) = @_; $self->_do_forward(detach => $c, $command, @args ) if $command; Catalyst::Exception::Detach->throw; } sub _action_rel2abs { my ( $self, $c, $path ) = @_; unless ( $path =~ m#^/# ) { my $namespace = $c->stack->[-1]->namespace; $path = "$namespace/$path"; } $path =~ s#^/##; return $path; } sub _invoke_as_path { my ( $self, $c, $rel_path, $args ) = @_; my $path = $self->_action_rel2abs( $c, $rel_path ); my ( $tail, @extra_args ); while ( ( $path, $tail ) = ( $path =~ m#^(?:(.*)/)?(\w+)?$# ) ) { # allow $path to be empty if ( my $action = $c->get_action( $tail, $path ) ) { push @$args, @extra_args; return $action; } else { return unless $path ; # if a match on the global namespace failed then the whole lookup failed } unshift @extra_args, $tail; } } sub _find_component { my ( $self, $c, $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_or_class, $method ) = @_; my $component = $self->_find_component($c, $component_or_class); my $component_class = blessed $component || return 0; 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 => "$component_class->$method", class => $component_class, namespace => Catalyst::Utils::class2prefix( $component_class, ref($c)->config->{case_sensitive} ), } ); } else { my $error = qq/Couldn't forward to "$component_class". Does not implement "$method"/; $c->error($error); $c->log->debug($error) if $c->debug; return 0; } } =head2 $self->prepare_action($c) Find an dispatch type that matches $c->req->path, and set args from it. =cut sub prepare_action { my ( $self, $c ) = @_; my $req = $c->req; my $path = $req->path; my @path = split /\//, $req->path; $req->args( \my @args ); unshift( @path, '' ); # Root action DESCEND: while (@path) { $path = join '/', @path; $path =~ s#^/+##; # Check out dispatch types to see if any will handle the path at # this level foreach my $type ( @{ $self->dispatch_types } ) { last DESCEND if $type->match( $c, $path ); } # If not, move the last part path to args my $arg = pop(@path); $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; unshift @args, $arg; } s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg for grep { defined } @{$req->captures||[]}; $c->log->debug( 'Path is "' . $req->match . '"' ) if ( $c->debug && defined $req->match && length $req->match ); $c->log->debug( 'Arguments are "' . join( '/', @args ) . '"' ) if ( $c->debug && @args ); } =head2 $self->get_action( $action, $namespace ) returns a named action from a given namespace. =cut sub get_action { my ( $self, $name, $namespace ) = @_; return unless $name; $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) ); return $self->_action_hash->{"${namespace}/${name}"}; } =head2 $self->get_action_by_path( $path ); Returns the named action by its full private path. =cut sub get_action_by_path { my ( $self, $path ) = @_; $path =~ s/^\///; $path = "/$path" unless $path =~ /\//; $self->_action_hash->{$path}; } =head2 $self->get_actions( $c, $action, $namespace ) =cut sub get_actions { my ( $self, $c, $action, $namespace ) = @_; return [] unless $action; $namespace = join( "/", grep { length } split '/', $namespace || "" ); my @match = $self->get_containers($namespace); return map { $_->get_action($action) } @match; } =head2 $self->get_containers( $namespace ) Return all the action containers for a given namespace, inclusive =cut sub get_containers { my ( $self, $namespace ) = @_; $namespace ||= ''; $namespace = '' if $namespace eq '/'; my @containers; if ( length $namespace ) { do { push @containers, $self->_container_hash->{$namespace}; } while ( $namespace =~ s#/[^/]+$## ); } return reverse grep { defined } @containers, $self->_container_hash->{''}; } =head2 $self->uri_for_action($action, \@captures) Takes a Catalyst::Action object and action parameters and returns a URI part such that if $c->req->path were this URI part, this action would be dispatched to with $c->req->captures set to the supplied arrayref. If the action object is not available for external dispatch or the dispatcher cannot determine an appropriate URI, this method will return undef. =cut sub uri_for_action { my ( $self, $action, $captures) = @_; $captures ||= []; foreach my $dispatch_type ( @{ $self->dispatch_types } ) { my $uri = $dispatch_type->uri_for_action( $action, $captures ); return( $uri eq '' ? '/' : $uri ) if defined($uri); } return undef; } =head2 expand_action expand an action into a full representation of the dispatch. mostly useful for chained, other actions will just return a single action. =cut sub expand_action { my ($self, $action) = @_; foreach my $dispatch_type (@{ $self->dispatch_types }) { my $expanded = $dispatch_type->expand_action($action); return $expanded if $expanded; } return $action; } =head2 $self->register( $c, $action ) Make sure all required dispatch types for this action are loaded, then pass the action to our dispatch types so they can register it if required. Also, set up the tree with the action containers. =cut sub register { my ( $self, $c, $action ) = @_; my $registered = $self->_registered_dispatch_types; foreach my $key ( keys %{ $action->attributes } ) { next if $key eq 'Private'; my $class = "Catalyst::DispatchType::$key"; unless ( $registered->{$class} ) { # FIXME - Some error checking and re-throwing needed here, as # we eat exceptions loading dispatch types. # see also try_load_class eval { load_class($class) }; my $load_failed = $@; $self->_check_deprecated_dispatch_type( $key, $load_failed ); push( @{ $self->dispatch_types }, $class->new ) unless $load_failed; $registered->{$class} = 1; } } my @dtypes = @{ $self->dispatch_types }; my @normal_dtypes; my @low_precedence_dtypes; for my $type ( @dtypes ) { if ($type->_is_low_precedence) { push @low_precedence_dtypes, $type; } else { push @normal_dtypes, $type; } } # Pass the action to our dispatch types so they can register it if reqd. my $was_registered = 0; foreach my $type ( @normal_dtypes ) { $was_registered = 1 if $type->register( $c, $action ); } if (not $was_registered) { foreach my $type ( @low_precedence_dtypes ) { $type->register( $c, $action ); } } my $namespace = $action->namespace; my $name = $action->name; my $container = $self->_find_or_create_action_container($namespace); # Set the method value $container->add_action($action); $self->_action_hash->{"$namespace/$name"} = $action; $self->_container_hash->{$namespace} = $container; } sub _find_or_create_action_container { my ( $self, $namespace ) = @_; my $tree ||= $self->_tree; return $tree->getNodeValue unless $namespace; my @namespace = split '/', $namespace; return $self->_find_or_create_namespace_node( $tree, @namespace ) ->getNodeValue; } sub _find_or_create_namespace_node { my ( $self, $parent, $part, @namespace ) = @_; return $parent unless $part; my $child = ( grep { $_->getNodeValue->part eq $part } $parent->getAllChildren )[0]; unless ($child) { my $container = Catalyst::ActionContainer->new($part); $parent->addChild( $child = Tree::Simple->new($container) ); } $self->_find_or_create_namespace_node( $child, @namespace ); } =head2 $self->setup_actions( $class, $context ) Loads all of the pre-load dispatch types, registers their actions and then loads all of the post-load dispatch types, and iterates over the tree of actions, displaying the debug information if appropriate. =cut sub setup_actions { my ( $self, $c ) = @_; my @classes = $self->_load_dispatch_types( @{ $self->preload_dispatch_types } ); @{ $self->_registered_dispatch_types }{@classes} = (1) x @classes; foreach my $comp ( values %{ $c->components } ) { $comp->register_actions($c) if $comp->can('register_actions'); } $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 $avail_width = Catalyst::Utils::term_width() - 12; my $col1_width = ($avail_width * .25) < 20 ? 20 : int($avail_width * .25); my $col2_width = ($avail_width * .50) < 36 ? 36 : int($avail_width * .50); my $col3_width = $avail_width - $col1_width - $col2_width; my $privates = Text::SimpleTable->new( [ $col1_width, 'Private' ], [ $col2_width, 'Class' ], [ $col3_width, 'Method' ] ); my $has_private = 0; my $walker = sub { my ( $walker, $parent, $prefix ) = @_; $prefix .= $parent->getNodeValue || ''; $prefix .= '/' unless $prefix =~ /\/$/; my $node = $parent->getNodeValue->actions; for my $action ( keys %{$node} ) { my $action_obj = $node->{$action}; next if ( ( $action =~ /^_.*/ ) && ( !$c->config->{show_internal_actions} ) ); $privates->row( "$prefix$action", $action_obj->class, $action ); $has_private = 1; } $walker->( $walker, $_, $prefix ) for $parent->getAllChildren; }; $walker->( $walker, $self->_tree, '' ); $c->log->debug( "Loaded Private actions:\n" . $privates->draw . "\n" ) if $has_private; # List all public actions $_->list($c) for @{ $self->dispatch_types }; } sub _load_dispatch_types { my ( $self, @types ) = @_; my @loaded; # Preload action types for my $type (@types) { # first param is undef because we cannot get the appclass my $class = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $type); my ($success, $error) = try_load_class($class); Catalyst::Exception->throw( message => $error ) if not $success; push @{ $self->dispatch_types }, $class->new; push @loaded, $class; } return @loaded; } =head2 $self->dispatch_type( $type ) Get the DispatchType object of the relevant type, i.e. passing C<$type> of C would return a L object (assuming of course it's being used.) =cut sub dispatch_type { my ($self, $name) = @_; # first param is undef because we cannot get the appclass $name = Catalyst::Utils::resolve_namespace(undef, 'Catalyst::DispatchType', $name); for (@{ $self->dispatch_types }) { return $_ if ref($_) eq $name; } return undef; } sub _check_deprecated_dispatch_type { my ($self, $key, $load_failed) = @_; return unless $key =~ /^(Local)?Regexp?/; # TODO: Should these throw an exception rather than just warning? if ($load_failed) { warn( "Attempt to use deprecated $key dispatch type.\n" . " Use Chained methods or install the standalone\n" . " Catalyst::DispatchType::Regex if necessary.\n" ); } elsif ( !defined $Catalyst::DispatchType::Regex::VERSION || $Catalyst::DispatchType::Regex::VERSION le '5.90020' ) { # We loaded the old core version of the Regex module this will break warn( "The $key DispatchType has been removed from Catalyst core.\n" . " An old version of the core Catalyst::DispatchType::Regex\n" . " has been loaded and will likely fail. Please remove\n" . " $INC{'Catalyst/DispatchType/Regex.pm'}\n" . " and use Chained methods or install the standalone\n" . " Catalyst::DispatchType::Regex if necessary.\n" ); } } use Moose; # 5.70 backwards compatibility hacks. # Various plugins (e.g. Plugin::Server and Plugin::Authorization::ACL) # need the methods here which *should* be private.. # You should be able to use get_actions or get_containers appropriately # instead of relying on these methods which expose implementation details # of the dispatcher.. # # IRC backlog included below, please come ask if this doesn't work for you. # # <@t0m> 5.80, the state of. There are things in the dispatcher which have # been deprecated, that we yell at anyone for using, which there isn't # a good alternative for yet.. # <@mst> er, get_actions/get_containers provides that doesn't it? # <@mst> DispatchTypes are loaded on demand anyway # <@t0m> I'm thinking of things like _tree which is aliased to 'tree' with # warnings otherwise shit breaks.. We're issuing warnings about the # correct set of things which you shouldn't be calling.. # <@mst> right # <@mst> basically, I don't see there's a need for a replacement for anything # <@mst> it was never a good idea to call ->tree # <@mst> nothingmuch was the only one who did AFAIK # <@mst> and he admitted it was a hack ;) # See also t/lib/TestApp/Plugin/AddDispatchTypes.pm # Alias _method_name to method_name, add a before modifier to warn.. foreach my $public_method_name (qw/ tree registered_dispatch_types method_action_class action_hash container_hash /) { my $private_method_name = '_' . $public_method_name; my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time. $meta->add_method($public_method_name, $meta->get_method($private_method_name)); { my %package_hash; # Only warn once per method, per package. These are infrequent enough that # I haven't provided a way to disable them, patches welcome. $meta->add_before_method_modifier($public_method_name, sub { my $class = caller(2); chomp($class); $package_hash{$class}++ || do { warn("Class $class is calling the deprecated method\n" . " Catalyst::Dispatcher::$public_method_name,\n" . " this will be removed in Catalyst 5.9\n"); }; }); } } # End 5.70 backwards compatibility hacks. __PACKAGE__->meta->make_immutable; =head2 meta Provided by Moose =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Catalyst-Runtime-5.90053/lib/Catalyst/DispatchType/000755 000765 000024 00000000000 12255610005 022134 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/DispatchType.pm000644 000765 000024 00000003630 12106042701 022471 0ustar00johnstaff000000 000000 package Catalyst::DispatchType; use Moose; with 'MooseX::Emulate::Class::Accessor::Fast'; no Moose; =head1 NAME Catalyst::DispatchType - DispatchType Base Class =head1 SYNOPSIS See L. =head1 DESCRIPTION This is an abstract base class for Dispatch Types. From a code perspective, dispatch types are used to find which actions to call for a given request URL. Website authors will typically work with them via subroutine names attributes; a description of dispatch at the attribute/URL level is given in L. =head1 METHODS =head2 $self->list($c) abstract method, to be implemented by dispatchtypes. Called to display info in debug log. =cut sub list { } =head2 $self->match( $c, $path ) abstract method, to be implemented by dispatchtypes. Returns true if the dispatch type matches the given path =cut sub match { die "Abstract method!" } =head2 $self->register( $c, $action ) abstract method, to be implemented by dispatchtypes. Takes a context object and a L object. Should return true if it registers something, or false otherwise. =cut sub register { } =head2 $self->uri_for_action( $action, \@captures ) abstract method, to be implemented by dispatchtypes. Takes a L object and an arrayref of captures, and should return either a URI part which if placed in $c->req->path would cause $self->match to match this action and set $c->req->captures to the supplied arrayref, or undef if unable to do so. =cut sub uri_for_action { } =head2 $self->expand_action Default fallback, returns nothing. See L for more info about expand_action. =cut sub expand_action { } sub _is_low_precedence { 0 } =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Engine/000755 000765 000024 00000000000 12255610005 020740 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/Engine.pm000644 000765 000024 00000047620 12255577340 021325 0ustar00johnstaff000000 000000 package Catalyst::Engine; use Moose; with 'MooseX::Emulate::Class::Accessor::Fast'; use CGI::Simple::Cookie; use Data::Dump qw/dump/; use Errno 'EWOULDBLOCK'; use HTML::Entities; use HTTP::Body; use HTTP::Headers; use URI::QueryParam; use Plack::Loader; use Catalyst::EngineLoader; use Encode (); use Plack::Request::Upload; use Hash::MultiValue; use utf8; use namespace::clean -except => 'meta'; # Amount of data to read from input on each pass our $CHUNKSIZE = 64 * 1024; # XXX - this is only here for compat, do not use! has env => ( is => 'rw', writer => '_set_env' ); my $WARN_ABOUT_ENV = 0; around env => sub { my ($orig, $self, @args) = @_; if(@args) { warn "env as a writer is deprecated, you probably need to upgrade Catalyst::Engine::PSGI" unless $WARN_ABOUT_ENV++; return $self->_set_env(@args); } return $self->$orig; }; # XXX - Only here for Engine::PSGI compat sub prepare_connection { my ($self, $ctx) = @_; $ctx->request->prepare_connection; } =head1 NAME Catalyst::Engine - The Catalyst Engine =head1 SYNOPSIS See L. =head1 DESCRIPTION =head1 METHODS =head2 $self->finalize_body($c) Finalize body. Prints the response output as blocking stream if it looks like a filehandle, otherwise write it out all in one go. If there is no body in the response, we assume you are handling it 'manually', such as for nonblocking style or asynchronous streaming responses. You do this by calling L several times (which sends HTTP headers if needed) or you close over C<< $response->write_fh >>. See L and L for more. =cut sub finalize_body { my ( $self, $c ) = @_; return if $c->response->_has_write_fh; my $body = $c->response->body; no warnings 'uninitialized'; if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) { my $got; do { $got = read $body, my ($buffer), $CHUNKSIZE; $got = 0 unless $self->write( $c, $buffer ); } while $got > 0; close $body; } else { $self->write( $c, $body ); } my $res = $c->response; $res->_writer->close; $res->_clear_writer; return; } =head2 $self->finalize_cookies($c) Create CGI::Simple::Cookie objects from $c->res->cookies, and set them as response headers. =cut sub finalize_cookies { my ( $self, $c ) = @_; my @cookies; my $response = $c->response; foreach my $name (keys %{ $response->cookies }) { my $val = $response->cookies->{$name}; my $cookie = ( blessed($val) ? $val : CGI::Simple::Cookie->new( -name => $name, -value => $val->{value}, -expires => $val->{expires}, -domain => $val->{domain}, -path => $val->{path}, -secure => $val->{secure} || 0, -httponly => $val->{httponly} || 0, ) ); if (!defined $cookie) { $c->log->warn("undef passed in '$name' cookie value - not setting cookie") if $c->debug; next; } push @cookies, $cookie->as_string; } for my $cookie (@cookies) { $response->headers->push_header( 'Set-Cookie' => $cookie ); } } =head2 $self->finalize_error($c) Output an appropriate error message. Called if there's an error in $c after the dispatch has finished. Will output debug messages if Catalyst is in debug mode, or a `please come back later` message otherwise. =cut sub _dump_error_page_element { my ($self, $i, $element) = @_; my ($name, $val) = @{ $element }; # This is fugly, but the metaclass is _HUGE_ and demands waaay too much # scrolling. Suggestions for more pleasant ways to do this welcome. local $val->{'__MOP__'} = "Stringified: " . $val->{'__MOP__'} if ref $val eq 'HASH' && exists $val->{'__MOP__'}; my $text = encode_entities( dump( $val )); sprintf <<"EOF", $name, $text;

%s

%s
EOF } sub finalize_error { my ( $self, $c ) = @_; $c->res->content_type('text/html; charset=utf-8'); my $name = ref($c)->config->{name} || join(' ', split('::', ref $c)); # Prevent Catalyst::Plugin::Unicode::Encoding from running. # This is a little nasty, but it's the best way to be clean whether or # not the user has an encoding plugin. if ($c->can('encoding')) { $c->{encoding} = ''; } my ( $title, $error, $infos ); if ( $c->debug ) { # For pretty dumps $error = join '', map { '

' . encode_entities($_) . '

' } @{ $c->error }; $error ||= 'No output'; $error = qq{
$error
}; $title = $name = "$name on Catalyst $Catalyst::VERSION"; $name = "

$name

"; # Don't show context in the dump $c->res->_clear_context; # Don't show body parser in the dump $c->req->_clear_body; my @infos; my $i = 0; for my $dump ( $c->dump_these ) { push @infos, $self->_dump_error_page_element($i, $dump); $i++; } $infos = join "\n", @infos; } else { $title = $name; $error = ''; $infos = <<""; 
(en) Please come back later
(fr) SVP veuillez revenir plus tard
(de) Bitte versuchen sie es spaeter nocheinmal
(at) Konnten's bitt'schoen spaeter nochmal reinschauen
(no) Vennligst prov igjen senere
(dk) Venligst prov igen senere
(pl) Prosze sprobowac pozniej
(pt) Por favor volte mais tarde
(ru) Попробуйте еще раз позже
(ua) Спробуйте ще раз пізніше
$name = ''; } $c->res->body( <<"" ); $title
$error
$infos
$name
# Trick IE. Old versions of IE would display their own error page instead # of ours if we'd give it less than 512 bytes. $c->res->{body} .= ( ' ' x 512 ); $c->res->{body} = Encode::encode("UTF-8", $c->res->{body}); # Return 500 $c->res->status(500); } =head2 $self->finalize_headers($c) Allows engines to write headers to response =cut sub finalize_headers { my ($self, $ctx) = @_; $ctx->finalize_headers unless $ctx->response->finalized_headers; return; } =head2 $self->finalize_uploads($c) Clean up after uploads, deleting temp files. =cut sub finalize_uploads { my ( $self, $c ) = @_; # N.B. This code is theoretically entirely unneeded due to ->cleanup(1) # on the HTTP::Body object. my $request = $c->request; foreach my $key (keys %{ $request->uploads }) { my $upload = $request->uploads->{$key}; unlink grep { -e $_ } map { $_->tempname } (ref $upload eq 'ARRAY' ? @{$upload} : ($upload)); } } =head2 $self->prepare_body($c) sets up the L object body using L =cut sub prepare_body { my ( $self, $c ) = @_; $c->request->prepare_body; } =head2 $self->prepare_body_chunk($c) Add a chunk to the request body. =cut # XXX - Can this be deleted? sub prepare_body_chunk { my ( $self, $c, $chunk ) = @_; $c->request->prepare_body_chunk($chunk); } =head2 $self->prepare_body_parameters($c) Sets up parameters from body. =cut sub prepare_body_parameters { my ( $self, $c ) = @_; $c->request->prepare_body_parameters; } =head2 $self->prepare_parameters($c) Sets up parameters from query and post parameters. If parameters have already been set up will clear existing parameters and set up again. =cut sub prepare_parameters { my ( $self, $c ) = @_; $c->request->_clear_parameters; return $c->request->parameters; } =head2 $self->prepare_path($c) abstract method, implemented by engines. =cut sub prepare_path { my ($self, $ctx) = @_; my $env = $ctx->request->env; my $scheme = $ctx->request->secure ? 'https' : 'http'; my $host = $env->{HTTP_HOST} || $env->{SERVER_NAME}; my $port = $env->{SERVER_PORT} || 80; my $base_path = $env->{SCRIPT_NAME} || "/"; # set the request URI my $path; if (!$ctx->config->{use_request_uri_for_path}) { my $path_info = $env->{PATH_INFO}; if ( exists $env->{REDIRECT_URL} ) { $base_path = $env->{REDIRECT_URL}; $base_path =~ s/\Q$path_info\E$//; } $path = $base_path . $path_info; $path =~ s{^/+}{}; $path =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; $path =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE } else { my $req_uri = $env->{REQUEST_URI}; $req_uri =~ s/\?.*$//; $path = $req_uri; $path =~ s{^/+}{}; } # Using URI directly is way too slow, so we construct the URLs manually my $uri_class = "URI::$scheme"; # HTTP_HOST will include the port even if it's 80/443 $host =~ s/:(?:80|443)$//; if ($port !~ /^(?:80|443)$/ && $host !~ /:/) { $host .= ":$port"; } my $query = $env->{QUERY_STRING} ? '?' . $env->{QUERY_STRING} : ''; my $uri = $scheme . '://' . $host . '/' . $path . $query; $ctx->request->uri( (bless \$uri, $uri_class)->canonical ); # set the base URI # base must end in a slash $base_path .= '/' unless $base_path =~ m{/$}; my $base_uri = $scheme . '://' . $host . $base_path; $ctx->request->base( bless \$base_uri, $uri_class ); return; } =head2 $self->prepare_request($c) =head2 $self->prepare_query_parameters($c) process the query string and extract query parameters. =cut sub prepare_query_parameters { my ($self, $c) = @_; my $env = $c->request->env; if(my $query_obj = $env->{'plack.request.query'}) { $c->request->query_parameters( $c->request->_use_hash_multivalue ? $query_obj->clone : $query_obj->as_hashref_mixed); return; } my $query_string = exists $env->{QUERY_STRING} ? $env->{QUERY_STRING} : ''; # Check for keywords (no = signs) # (yes, index() is faster than a regex :)) if ( index( $query_string, '=' ) < 0 ) { $c->request->query_keywords($self->unescape_uri($query_string)); return; } my %query; # replace semi-colons $query_string =~ s/;/&/g; my @params = grep { length $_ } split /&/, $query_string; for my $item ( @params ) { my ($param, $value) = map { $self->unescape_uri($_) } split( /=/, $item, 2 ); $param = $self->unescape_uri($item) unless defined $param; if ( exists $query{$param} ) { if ( ref $query{$param} ) { push @{ $query{$param} }, $value; } else { $query{$param} = [ $query{$param}, $value ]; } } else { $query{$param} = $value; } } $c->request->query_parameters( $c->request->_use_hash_multivalue ? Hash::MultiValue->from_mixed(\%query) : \%query); } =head2 $self->prepare_read($c) Prepare to read by initializing the Content-Length from headers. =cut sub prepare_read { my ( $self, $c ) = @_; # Initialize the amount of data we think we need to read $c->request->_read_length; } =head2 $self->prepare_request(@arguments) Populate the context object from the request object. =cut sub prepare_request { my ($self, $ctx, %args) = @_; $ctx->log->psgienv($args{env}) if $ctx->log->can('psgienv'); $ctx->request->_set_env($args{env}); $self->_set_env($args{env}); # Nasty back compat! $ctx->response->_set_response_cb($args{response_cb}); } =head2 $self->prepare_uploads($c) =cut sub prepare_uploads { my ( $self, $c ) = @_; my $request = $c->request; return unless $request->_body; my $uploads = $request->_body->upload; my $parameters = $request->parameters; foreach my $name (keys %$uploads) { my $files = $uploads->{$name}; my @uploads; for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) { my $headers = HTTP::Headers->new( %{ $upload->{headers} } ); my $u = Catalyst::Request::Upload->new ( size => $upload->{size}, type => scalar $headers->content_type, headers => $headers, tempname => $upload->{tempname}, filename => $upload->{filename}, ); push @uploads, $u; } $request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0]; # support access to the filename as a normal param my @filenames = map { $_->{filename} } @uploads; # append, if there's already params with this name if (exists $parameters->{$name}) { if (ref $parameters->{$name} eq 'ARRAY') { push @{ $parameters->{$name} }, @filenames; } else { $parameters->{$name} = [ $parameters->{$name}, @filenames ]; } } else { $parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0]; } } } =head2 $self->write($c, $buffer) Writes the buffer to the client. =cut sub write { my ( $self, $c, $buffer ) = @_; $c->response->write($buffer); } =head2 $self->read($c, [$maxlength]) Reads from the input stream by calling C<< $self->read_chunk >>. Maintains the read_length and read_position counters as data is read. =cut sub read { my ( $self, $c, $maxlength ) = @_; $c->request->read($maxlength); } =head2 $self->read_chunk($c, \$buffer, $length) Each engine implements read_chunk as its preferred way of reading a chunk of data. Returns the number of bytes read. A return of 0 indicates that there is no more data to be read. =cut sub read_chunk { my ($self, $ctx) = (shift, shift); return $ctx->request->read_chunk(@_); } =head2 $self->run($app, $server) Start the engine. Builds a PSGI application and calls the run method on the server passed in, which then causes the engine to loop, handling requests.. =cut sub run { my ($self, $app, $psgi, @args) = @_; # @args left here rather than just a $options, $server for back compat with the # old style scripts which send a few args, then a hashref # They should never actually be used in the normal case as the Plack engine is # passed in got all the 'standard' args via the loader in the script already. # FIXME - we should stash the options in an attribute so that custom args # like Gitalist's --git_dir are possible to get from the app without stupid tricks. my $server = pop @args if (scalar @args && blessed $args[-1]); my $options = pop @args if (scalar @args && ref($args[-1]) eq 'HASH'); # Back compat hack for applications with old (non Catalyst::Script) scripts to work in FCGI. if (scalar @args && !ref($args[0])) { if (my $listen = shift @args) { $options->{listen} ||= [$listen]; } } if (! $server ) { $server = Catalyst::EngineLoader->new(application_name => ref($self))->auto(%$options); # We're not being called from a script, so auto detect what backend to # run on. This should never happen, as mod_perl never calls ->run, # instead the $app->handle method is called per request. $app->log->warn("Not supplied a Plack engine, falling back to engine auto-loader (are your scripts ancient?)") } $app->run_options($options); $server->run($psgi, $options); } =head2 build_psgi_app ($app, @args) Builds and returns a PSGI application closure. (Raw, not wrapped in middleware) =cut sub build_psgi_app { my ($self, $app, @args) = @_; return sub { my ($env) = @_; return sub { my ($respond) = @_; confess("Did not get a response callback for writer, cannot continue") unless $respond; $app->handle_request(env => $env, response_cb => $respond); }; }; } =head2 $self->unescape_uri($uri) Unescapes a given URI using the most efficient method available. Engines such as Apache may implement this using Apache's C-based modules, for example. =cut sub unescape_uri { my ( $self, $str ) = @_; $str =~ s/(?:%([0-9A-Fa-f]{2})|\+)/defined $1 ? chr(hex($1)) : ' '/eg; return $str; } =head2 $self->finalize_output , see finalize_body =head2 $self->env Hash containing environment variables including many special variables inserted by WWW server - like SERVER_*, REMOTE_*, HTTP_* ... Before accessing environment variables consider whether the same information is not directly available via Catalyst objects $c->request, $c->engine ... BEWARE: If you really need to access some environment variable from your Catalyst application you should use $c->engine->env->{VARNAME} instead of $ENV{VARNAME}, as in some environments the %ENV hash does not contain what you would expect. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/EngineLoader.pm000644 000765 000024 00000010073 12106042701 022423 0ustar00johnstaff000000 000000 package Catalyst::EngineLoader; use Moose; use Catalyst::Exception; use Catalyst::Utils; use namespace::autoclean; extends 'Plack::Loader'; has application_name => ( isa => 'Str', is => 'ro', required => 1, ); has requested_engine => ( is => 'ro', isa => 'Str', predicate => 'has_requested_engine', ); sub needs_psgi_engine_compat_hack { my ($self) = @_; return $self->has_requested_engine && $self->requested_engine eq 'PSGI'; } has catalyst_engine_class => ( isa => 'Str', is => 'rw', lazy => 1, builder => '_guess_catalyst_engine_class', ); sub _guess_catalyst_engine_class { my $self = shift; my $old_engine = $self->has_requested_engine ? $self->requested_engine : Catalyst::Utils::env_value($self->application_name, 'ENGINE'); if (!defined $old_engine) { return 'Catalyst::Engine'; } elsif ($old_engine eq 'PSGI') { ## If we are running under plackup let the Catalyst::Engine::PSGI ## continue to run, but warn. warn <<"EOW"; You are running Catalyst::Engine::PSGI, which is considered a legacy engine for this version of Catalyst. We will continue running and use your existing psgi file, but it is recommended to perform the trivial upgrade process, which will leave you with less code and a forward path. Please review Catalyst::Upgrading EOW return 'Catalyst::Engine::' . $old_engine; } elsif ($old_engine =~ /^(CGI|FastCGI|HTTP|Apache.*)$/) { return 'Catalyst::Engine'; } else { return 'Catalyst::Engine::' . $old_engine; } } around guess => sub { my ($orig, $self) = (shift, shift); my $engine = $self->$orig(@_); if ( $ENV{MOD_PERL} ) { my ( $software, $version ) = $ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/; $version =~ s/_//g; $version =~ s/(\.[^.]+)\./$1/g; if ( $software eq 'mod_perl' ) { if ( $version >= 1.99922 ) { $engine = 'Apache2'; } elsif ( $version >= 1.9901 ) { Catalyst::Exception->throw( message => 'Plack does not have a mod_perl 1.99 handler' ); $engine = 'Apache2::MP19'; } elsif ( $version >= 1.24 ) { $engine = 'Apache1'; } else { Catalyst::Exception->throw( message => qq/Unsupported mod_perl version: $ENV{MOD_PERL}/ ); } } } my $old_engine = Catalyst::Utils::env_value($self->application_name, 'ENGINE'); if (!defined $old_engine) { # Not overridden } elsif ($old_engine =~ /^(PSGI|CGI|Apache.*)$/) { # Trust autodetect } elsif ($old_engine eq 'HTTP') { $engine = 'Standalone'; } elsif ($old_engine eq 'FastCGI') { $engine = 'FCGI'; } elsif ($old_engine eq "HTTP::Prefork") { # Too bad if you're customising, we don't handle options # write yourself a script to collect and pass in the options $engine = "Starman"; } elsif ($old_engine eq "HTTP::POE") { Catalyst::Exception->throw("HTTP::POE engine no longer works, recommend you use Twiggy instead"); } elsif ($old_engine eq "Zeus") { Catalyst::Exception->throw("Zeus engine no longer works"); } else { warn("You asked for an unrecognised engine '$old_engine' which is no longer supported, this has been ignored.\n"); } return $engine; }; # Force constructor inlining __PACKAGE__->meta->make_immutable( replace_constructor => 1 ); 1; __END__ =head1 NAME Catalyst::EngineLoader - The Catalyst Engine Loader =head1 SYNOPSIS See L. =head1 DESCRIPTION Wrapper on L which resets the ::Engine if you are using some version of mod_perl. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =begin Pod::Coverage needs_psgi_engine_compat_hack =end Pod::Coverage =cut Catalyst-Runtime-5.90053/lib/Catalyst/Exception/000755 000765 000024 00000000000 12255610005 021471 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/Exception.pm000644 000765 000024 00000002146 12106042701 022027 0ustar00johnstaff000000 000000 package Catalyst::Exception; # XXX: See bottom of file for Exception implementation =head1 NAME Catalyst::Exception - Catalyst Exception Class =head1 SYNOPSIS Catalyst::Exception->throw( qq/Fatal exception/ ); See also L. =head1 DESCRIPTION This is the Catalyst Exception class. =head1 METHODS =head2 throw( $message ) =head2 throw( message => $message ) =head2 throw( error => $error ) Throws a fatal exception. =head2 meta Provided by Moose =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut { package Catalyst::Exception::Base; use Moose; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Basic'; __PACKAGE__->meta->make_immutable; } { package Catalyst::Exception; use Moose; use namespace::clean -except => 'meta'; use vars qw[$CATALYST_EXCEPTION_CLASS]; BEGIN { extends($CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base'); } __PACKAGE__->meta->make_immutable; } 1; Catalyst-Runtime-5.90053/lib/Catalyst/Log.pm000644 000765 000024 00000015742 12217110343 020621 0ustar00johnstaff000000 000000 package Catalyst::Log; use Moose; with 'MooseX::Emulate::Class::Accessor::Fast'; use Data::Dump; use Moose::Util 'find_meta'; use Carp qw/ cluck /; our %LEVELS = (); # Levels stored as bit field, ergo debug = 1, warn = 2 etc our %LEVEL_MATCH = (); # Stored as additive, thus debug = 31, warn = 30 etc has level => (is => 'rw'); has _body => (is => 'rw'); has abort => (is => 'rw'); has _psgi_logger => (is => 'rw', predicate => '_has_psgi_logger', clearer => '_clear_psgi_logger'); has _psgi_errors => (is => 'rw', predicate => '_has_psgi_errors', clearer => '_clear_psgi_errors'); sub clear_psgi { my $self = shift; $self->_clear_psgi_logger; $self->_clear_psgi_errors; } sub psgienv { my ($self, $env) = @_; $self->_psgi_logger($env->{'psgix.logger'}) if $env->{'psgix.logger'}; $self->_psgi_errors($env->{'psgi.errors'}) if $env->{'psgi.errors'}; } { my @levels = qw[ debug info warn error fatal ]; my $meta = find_meta(__PACKAGE__); my $summed_level = 0; for ( my $i = $#levels ; $i >= 0 ; $i-- ) { my $name = $levels[$i]; my $level = 1 << $i; $summed_level |= $level; $LEVELS{$name} = $level; $LEVEL_MATCH{$name} = $summed_level; $meta->add_method($name, sub { my $self = shift; if ( $self->level & $level ) { $self->_log( $name, @_ ); } }); $meta->add_method("is_$name", sub { my $self = shift; return $self->level & $level; });; } } around new => sub { my $orig = shift; my $class = shift; my $self = $class->$orig; $self->levels( scalar(@_) ? @_ : keys %LEVELS ); return $self; }; sub levels { my ( $self, @levels ) = @_; $self->level(0); $self->enable(@levels); } sub enable { my ( $self, @levels ) = @_; my $level = $self->level; for(map { $LEVEL_MATCH{$_} } @levels){ $level |= $_; } $self->level($level); } sub disable { my ( $self, @levels ) = @_; my $level = $self->level; for(map { $LEVELS{$_} } @levels){ $level &= ~$_; } $self->level($level); } our $HAS_DUMPED; sub _dump { my $self = shift; unless ($HAS_DUMPED++) { cluck("Catalyst::Log::_dump is deprecated and will be removed. Please change to using your own Dumper.\n"); } $self->info( Data::Dump::dump(@_) ); } sub _log { my $self = shift; my $level = shift; my $message = join( "\n", @_ ); if ($self->can('_has_psgi_logger') and $self->_has_psgi_logger) { $self->_psgi_logger->({ level => $level, message => $message, }); } else { $message .= "\n" unless $message =~ /\n$/; my $body = $self->_body; $body .= sprintf( "[%s] %s", $level, $message ); $self->_body($body); } } sub _flush { my $self = shift; if ( $self->abort || !$self->_body ) { $self->abort(undef); } else { $self->_send_to_log( $self->_body ); } $self->_body(undef); } sub _send_to_log { my $self = shift; if ($self->can('_has_psgi_errors') and $self->_has_psgi_errors) { $self->_psgi_errors->print(@_); } else { print STDERR @_; } } # 5.7 compat code. # Alias _body to body, add a before modifier to warn.. my $meta = __PACKAGE__->meta; # Calling meta method here fine as we happen at compile time. $meta->add_method('body', $meta->get_method('_body')); my %package_hash; # Only warn once per method, per package. # I haven't provided a way to disable them, patches welcome. $meta->add_before_method_modifier('body', sub { my $class = blessed(shift); $package_hash{$class}++ || do { warn("Class $class is calling the deprecated method Catalyst::Log->body method,\n" . "this will be removed in Catalyst 5.81"); }; }); # End 5.70 backwards compatibility hacks. no Moose; __PACKAGE__->meta->make_immutable(inline_constructor => 0); 1; __END__ =for stopwords psgienv =head1 NAME Catalyst::Log - Catalyst Log Class =head1 SYNOPSIS $log = $c->log; $log->debug($message); $log->info($message); $log->warn($message); $log->error($message); $log->fatal($message); if ( $log->is_debug ) { # expensive debugging } See L. =head1 DESCRIPTION This module provides the default, simple logging functionality for Catalyst. If you want something different set C<< $c->log >> in your application module, e.g.: $c->log( MyLogger->new ); Your logging object is expected to provide the interface described here. Good alternatives to consider are Log::Log4Perl and Log::Dispatch. If you want to be able to log arbitrary warnings, you can do something along the lines of $SIG{__WARN__} = sub { MyApp->log->warn(@_); }; however this is (a) global, (b) hairy and (c) may have unexpected side effects. Don't say we didn't warn you. =head1 LOG LEVELS =head2 debug $log->is_debug; $log->debug($message); =head2 info $log->is_info; $log->info($message); =head2 warn $log->is_warn; $log->warn($message); =head2 error $log->is_error; $log->error($message); =head2 fatal $log->is_fatal; $log->fatal($message); =head1 METHODS =head2 new Constructor. Defaults to enable all levels unless levels are provided in arguments. $log = Catalyst::Log->new; $log = Catalyst::Log->new( 'warn', 'error' ); =head2 level Contains a bitmask of the currently set log levels. =head2 levels Set log levels $log->levels( 'warn', 'error', 'fatal' ); =head2 enable Enable log levels $log->enable( 'warn', 'error' ); =head2 disable Disable log levels $log->disable( 'warn', 'error' ); =head2 is_debug =head2 is_error =head2 is_fatal =head2 is_info =head2 is_warn Is the log level active? =head2 abort Should Catalyst emit logs for this request? Will be reset at the end of each request. *NOTE* This method is not compatible with other log apis, so if you plan to use Log4Perl or another logger, you should call it like this: $c->log->abort(1) if $c->log->can('abort'); =head2 _send_to_log $log->_send_to_log( @messages ); This protected method is what actually sends the log information to STDERR. You may subclass this module and override this method to get finer control over the log output. =head2 psgienv $env $log->psgienv($env); NOTE: This is not meant for public consumption. Set the PSGI environment for this request. This ensures logs will be sent to the right place. If the environment has a C, it will be used. If not, we will send logs to C if that exists. As a last fallback, we will send to STDERR as before. =head2 clear_psgi Clears the PSGI environment attributes set by L. =head2 meta =head1 SEE ALSO L. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Model.pm000644 000765 000024 00000001052 12106042701 021124 0ustar00johnstaff000000 000000 package Catalyst::Model; use Moose; extends qw/Catalyst::Component/; no Moose; =head1 NAME Catalyst::Model - Catalyst Model base class =head1 SYNOPSIS See L. =head1 DESCRIPTION Catalyst Model base class. =head1 METHODS Implements the same methods as other Catalyst components, see L =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Plugin/000755 000765 000024 00000000000 12255610005 020771 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/PSGI.pod000644 000765 000024 00000007022 12106042701 020777 0ustar00johnstaff000000 000000 =pod =head1 NAME Catalyst::PSGI - How Catalyst and PSGI work together =head1 SYNOPSIS The L specification defines an interface between web servers and Perl-based web applications and frameworks. It supports the writing of portable applications that can be run using various methods (as a standalone server, or using mod_perl, FastCGI, etc.). L is an implementation of the PSGI specification for running Perl applications. Catalyst used to contain an entire set of C<< Catalyst::Engine::XXXX >> classes to handle various web servers and environments (e.g. CGI, FastCGI, mod_perl) etc. This has been changed in Catalyst 5.9 so that all of that work is done by Catalyst implementing the L specification, using L's adaptors to implement that functionality. This means that we can share common code, and share fixes for specific web servers. =head1 I already have an application If you already have a Catalyst application, then you should be able to upgrade to the latest release with little or no trouble (see the notes in L for specifics about your web server deployment). =head1 Writing your own PSGI file. =head2 What is a .psgi file? A C<< .psgi >> file lets you control how your application code reference is built. Catalyst will automatically handle this for you, but it's possible to do it manually by creating a C file in the root of your application. =head2 Why would I want to write my own .psgi file? Writing your own .psgi file allows you to use the alternate L command to start your application, and allows you to add classes and extensions that implement L, such as L or L. The simplest C<.psgi> file for an application called C would be: use strict; use warnings; use TestApp; my $app = TestApp->psgi_app(@_); Note that Catalyst will apply a number of middleware components for you automatically, and these B be applied if you manually create a psgi file yourself. Details of these components can be found below. Additional information about psgi files can be found at: L =head2 What is in the .psgi file Catalyst generates by default? Catalyst generates an application which, if the C setting is on, is wrapped in L, and contains some engine-specific fixes for uniform behaviour, as contained in: =over =item L =item L =back If you override the default by providing your own C<< .psgi >> file, then none of these things will be done automatically for you by the PSGI application returned when you call C<< MyApp->psgi_app >>. Thus, if you need any of this functionality, you'll need to implement this in your C<< .psgi >> file yourself. An apply_default_middlewares method is supplied to wrap your application in the default middlewares if you want this behaviour and you are providing your own .psgi file. This means that the auto-generated (no .psgi file) code looks something like this: use strict; use warnings; use TestApp; my $app = TestApp->apply_default_middlewares(TestApp->psgi_app(@_)); =head1 SEE ALSO L, L, L, L. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/Request/000755 000765 000024 00000000000 12255610005 021163 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/Request.pm000644 000765 000024 00000064102 12236741055 021535 0ustar00johnstaff000000 000000 package Catalyst::Request; use IO::Socket qw[AF_INET inet_aton]; use Carp; use utf8; use URI::http; use URI::https; use URI::QueryParam; use HTTP::Headers; use Stream::Buffered; use Hash::MultiValue; use Scalar::Util; use Moose; use namespace::clean -except => 'meta'; with 'MooseX::Emulate::Class::Accessor::Fast'; has env => (is => 'ro', writer => '_set_env', predicate => '_has_env'); # XXX Deprecated crap here - warn? has action => (is => 'rw'); # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due # to confusion between Engines and Plugin::Authentication. Remove in 5.8100? has user => (is => 'rw'); sub snippets { shift->captures(@_) } has _read_position => ( # FIXME: work around Moose bug RT#75367 # init_arg => undef, is => 'ro', writer => '_set_read_position', default => 0, ); has _read_length => ( # FIXME: work around Moose bug RT#75367 # init_arg => undef, is => 'ro', default => sub { my $self = shift; $self->header('Content-Length') || 0; }, lazy => 1, ); has address => (is => 'rw'); has arguments => (is => 'rw', default => sub { [] }); has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1); sub prepare_cookies { my ( $self ) = @_; if ( my $header = $self->header('Cookie') ) { return { CGI::Simple::Cookie->parse($header) }; } {}; } has query_keywords => (is => 'rw'); has match => (is => 'rw'); has method => (is => 'rw'); has protocol => (is => 'rw'); has query_parameters => (is => 'rw', lazy=>1, default => sub { shift->_use_hash_multivalue ? Hash::MultiValue->new : +{} }); has secure => (is => 'rw', default => 0); has captures => (is => 'rw', default => sub { [] }); has uri => (is => 'rw', predicate => 'has_uri'); has remote_user => (is => 'rw'); has headers => ( is => 'rw', isa => 'HTTP::Headers', handles => [qw(content_encoding content_length content_type header referer user_agent)], builder => 'prepare_headers', lazy => 1, ); sub prepare_headers { my ($self) = @_; my $env = $self->env; my $headers = HTTP::Headers->new(); for my $header (keys %{ $env }) { next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i; (my $field = $header) =~ s/^HTTPS?_//; $field =~ tr/_/-/; $headers->header($field => $env->{$header}); } return $headers; } has _log => ( is => 'ro', weak_ref => 1, required => 1, ); has io_fh => ( is=>'ro', predicate=>'_has_io_fh', lazy=>1, builder=>'_build_io_fh'); sub _build_io_fh { my $self = shift; return $self->env->{'psgix.io'} || ( $self->env->{'net.async.http.server.req'} && $self->env->{'net.async.http.server.req'}->stream) ## Until I can make ioasync cabal see the value of supportin psgix.io (jnap) || die "Your Server does not support psgix.io"; }; has data_handlers => ( is=>'ro', isa=>'HashRef', default=>sub { +{} } ); has body_data => ( is=>'ro', lazy=>1, builder=>'_build_body_data'); sub _build_body_data { my ($self) = @_; my $content_type = $self->content_type; my ($match) = grep { $content_type =~/$_/i } keys(%{$self->data_handlers}); if($match) { my $fh = $self->body; local $_ = $fh; return $self->data_handlers->{$match}->($fh, $self); } else { return undef; } } has _use_hash_multivalue => ( is=>'ro', required=>1, default=> sub {0}); # Amount of data to read from input on each pass our $CHUNKSIZE = 64 * 1024; sub read { my ($self, $maxlength) = @_; my $remaining = $self->_read_length - $self->_read_position; $maxlength ||= $CHUNKSIZE; # Are we done reading? if ( $remaining <= 0 ) { return; } my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining; my $rc = $self->read_chunk( my $buffer, $readlen ); if ( defined $rc ) { if (0 == $rc) { # Nothing more to read even though Content-Length # said there should be. return; } $self->_set_read_position( $self->_read_position + $rc ); return $buffer; } else { Catalyst::Exception->throw( message => "Unknown error reading input: $!" ); } } sub read_chunk { my $self = shift; return $self->env->{'psgi.input'}->read(@_); } has body_parameters => ( is => 'rw', required => 1, lazy => 1, builder => 'prepare_body_parameters', ); has uploads => ( is => 'rw', required => 1, default => sub { {} }, ); has parameters => ( is => 'rw', lazy => 1, builder => '_build_parameters', clearer => '_clear_parameters', ); # TODO: # - Can we lose the before modifiers which just call prepare_body ? # they are wasteful, slow us down and feel cluttery. # Can we make _body an attribute, have the rest of # these lazy build from there and kill all the direct hash access # in Catalyst.pm and Engine.pm? sub prepare_parameters { my ( $self ) = @_; $self->_clear_parameters; return $self->parameters; } sub _build_parameters { my ( $self ) = @_; my $parameters = {}; my $body_parameters = $self->body_parameters; my $query_parameters = $self->query_parameters; if($self->_use_hash_multivalue) { return Hash::MultiValue->new($query_parameters->flatten, $body_parameters->flatten); } # We copy, no references foreach my $name (keys %$query_parameters) { my $param = $query_parameters->{$name}; $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param; } # Merge query and body parameters foreach my $name (keys %$body_parameters) { my $param = $body_parameters->{$name}; my @values = ref $param eq 'ARRAY' ? @$param : ($param); if ( my $existing = $parameters->{$name} ) { unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing)); } $parameters->{$name} = @values > 1 ? \@values : $values[0]; } $parameters; } has _uploadtmp => ( is => 'ro', predicate => '_has_uploadtmp', ); sub prepare_body { my ( $self ) = @_; # If previously applied middleware created the HTTP::Body object, then we # just use that one. if(my $plack_body = $self->_has_env ? $self->env->{'plack.request.http.body'} : undef) { $self->_body($plack_body); $self->_body->cleanup(1); return; } # If there is nothing to read, set body to naught and return. This # will cause all body code to be skipped return $self->_body(0) unless my $length = $self->_read_length; # Unless the body has already been set, create it. Not sure about this # code, how else might it be set, but this was existing logic. unless ($self->_body) { my $type = $self->header('Content-Type'); $self->_body(HTTP::Body->new( $type, $length )); $self->_body->cleanup(1); # JNAP: I'm not sure this is doing what we expect, but it also doesn't # seem to be hurting (seems ->_has_uploadtmp is true more than I would # expect. $self->_body->tmpdir( $self->_uploadtmp ) if $self->_has_uploadtmp; } # Ok if we get this far, we have to read psgi.input into the new body # object. Lets play nice with any plack app or other downstream, so # we create a buffer unless one exists. my $stream_buffer; if ($self->env->{'psgix.input.buffered'}) { # Be paranoid about previous psgi middleware or apps that read the # input but didn't return the buffer to the start. $self->env->{'psgi.input'}->seek(0, 0); } else { $stream_buffer = Stream::Buffered->new($length); } # Check for definedness as you could read '0' while ( defined ( my $chunk = $self->read() ) ) { $self->prepare_body_chunk($chunk); $stream_buffer->print($chunk) if $stream_buffer; } # Ok, we read the body. Lets play nice for any PSGI app down the pipe if ($stream_buffer) { $self->env->{'psgix.input.buffered'} = 1; $self->env->{'psgi.input'} = $stream_buffer->rewind; } else { $self->env->{'psgi.input'}->seek(0, 0); # Reset the buffer for downstream middleware or apps } # paranoia against wrong Content-Length header my $remaining = $length - $self->_read_position; if ( $remaining > 0 ) { Catalyst::Exception->throw("Wrong Content-Length value: $length" ); } } sub prepare_body_chunk { my ( $self, $chunk ) = @_; $self->_body->add($chunk); } sub prepare_body_parameters { my ( $self ) = @_; $self->prepare_body if ! $self->_has_body; unless($self->_body) { return $self->_use_hash_multivalue ? Hash::MultiValue->new : {}; } return $self->_use_hash_multivalue ? Hash::MultiValue->from_mixed($self->_body->param) : $self->_body->param; } sub prepare_connection { my ($self) = @_; my $env = $self->env; $self->address( $env->{REMOTE_ADDR} ); $self->hostname( $env->{REMOTE_HOST} ) if exists $env->{REMOTE_HOST}; $self->protocol( $env->{SERVER_PROTOCOL} ); $self->remote_user( $env->{REMOTE_USER} ); $self->method( $env->{REQUEST_METHOD} ); $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 ); } # XXX - FIXME - method is here now, move this crap... around parameters => sub { my ($orig, $self, $params) = @_; if ($params) { if ( !ref $params ) { $self->_log->warn( "Attempt to retrieve '$params' with req->params(), " . "you probably meant to call req->param('$params')" ); $params = undef; } return $self->$orig($params); } $self->$orig(); }; has base => ( is => 'rw', required => 1, lazy => 1, default => sub { my $self = shift; return $self->path if $self->has_uri; }, ); has _body => ( is => 'rw', clearer => '_clear_body', predicate => '_has_body', ); # Eugh, ugly. Should just be able to rename accessor methods to 'body' # and provide a custom reader.. sub body { my $self = shift; $self->prepare_body unless $self->_has_body; croak 'body is a reader' if scalar @_; return blessed $self->_body ? $self->_body->body : $self->_body; } has hostname => ( is => 'rw', required => 1, lazy => 1, default => sub { my ($self) = @_; gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address }, ); has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' ); sub args { shift->arguments(@_) } sub body_params { shift->body_parameters(@_) } sub input { shift->body(@_) } sub params { shift->parameters(@_) } sub query_params { shift->query_parameters(@_) } sub path_info { shift->path(@_) } =for stopwords param params =head1 NAME Catalyst::Request - provides information about the current client request =head1 SYNOPSIS $req = $c->request; $req->address eq "127.0.0.1"; $req->arguments; $req->args; $req->base; $req->body; $req->body_data; $req->body_parameters; $req->content_encoding; $req->content_length; $req->content_type; $req->cookie; $req->cookies; $req->header; $req->headers; $req->hostname; $req->input; $req->query_keywords; $req->match; $req->method; $req->param; $req->parameters; $req->params; $req->path; $req->protocol; $req->query_parameters; $req->read; $req->referer; $req->secure; $req->captures; $req->upload; $req->uploads; $req->uri; $req->user; $req->user_agent; See also L, L. =head1 DESCRIPTION This is the Catalyst Request class, which provides an interface to data for the current client request. The request object is prepared by L, thus hiding the details of the particular engine implementation. =head1 METHODS =head2 $req->address Returns the IP address of the client. =head2 $req->arguments Returns a reference to an array containing the arguments. print $c->request->arguments->[0]; For example, if your action was package MyApp::Controller::Foo; sub moose : Local { ... } and the URI for the request was C, the string C would be the first and only argument. Arguments get automatically URI-unescaped for you. =head2 $req->args Shortcut for L. =head2 $req->base Contains the URI base. This will always have a trailing slash. Note that the URI scheme (e.g., http vs. https) must be determined through heuristics; depending on your server configuration, it may be incorrect. See $req->secure for more info. If your application was queried with the URI C then C is C. =head2 $req->body Returns the message body of the request, as returned by L: a string, unless Content-Type is C, C, or C, in which case a L object is returned. =head2 $req->body_data Returns a Perl representation of POST/PUT body data that is not classic HTML form data, such as JSON, XML, etc. By default, Catalyst will parse incoming data of the type 'application/json' and return access to that data via this method. You may define addition data_handlers via a global configuration setting. See L for more information. =head2 $req->body_parameters Returns a reference to a hash containing body (POST) parameters. Values can be either a scalar or an arrayref containing scalars. print $c->request->body_parameters->{field}; print $c->request->body_parameters->{field}->[0]; These are the parameters from the POST part of the request, if any. =head2 $req->body_params Shortcut for body_parameters. =head2 $req->content_encoding Shortcut for $req->headers->content_encoding. =head2 $req->content_length Shortcut for $req->headers->content_length. =head2 $req->content_type Shortcut for $req->headers->content_type. =head2 $req->cookie A convenient method to access $req->cookies. $cookie = $c->request->cookie('name'); @cookies = $c->request->cookie; =cut sub cookie { my $self = shift; if ( @_ == 0 ) { return keys %{ $self->cookies }; } if ( @_ == 1 ) { my $name = shift; unless ( exists $self->cookies->{$name} ) { return undef; } return $self->cookies->{$name}; } } =head2 $req->cookies Returns a reference to a hash containing the cookies. print $c->request->cookies->{mycookie}->value; The cookies in the hash are indexed by name, and the values are L objects. =head2 $req->header Shortcut for $req->headers->header. =head2 $req->headers Returns an L object containing the headers for the current request. print $c->request->headers->header('X-Catalyst'); =head2 $req->hostname Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server. =head2 $req->input Alias for $req->body. =head2 $req->query_keywords Contains the keywords portion of a query string, when no '=' signs are present. http://localhost/path?some+keywords $c->request->query_keywords will contain 'some keywords' =head2 $req->match This contains the matching part of a Regex action. Otherwise it returns the same as 'action', except for default actions, which return an empty string. =head2 $req->method Contains the request method (C, C, C, etc). =head2 $req->param Returns GET and POST parameters with a CGI.pm-compatible param method. This is an alternative method for accessing parameters in $c->req->parameters. $value = $c->request->param( 'foo' ); @values = $c->request->param( 'foo' ); @params = $c->request->param; Like L, and B earlier versions of Catalyst, passing multiple arguments to this method, like this: $c->request->param( 'foo', 'bar', 'gorch', 'quxx' ); will set the parameter C to the multiple values C, C and C. Previously this would have added C as another value to C (creating it if it didn't exist before), and C as another value for C. B this is considered a legacy interface and care should be taken when using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first C param even if multiple are present; C<< $c->req->param( 'foo' ) >> will return a list of as many are present, which can have unexpected consequences when writing code of the form: $foo->bar( a => 'b', baz => $c->req->param( 'baz' ), ); If multiple C parameters are provided this code might corrupt data or cause a hash initialization error. For a more straightforward interface see C<< $c->req->parameters >>. =cut sub param { my $self = shift; if ( @_ == 0 ) { return keys %{ $self->parameters }; } if ( @_ == 1 ) { my $param = shift; unless ( exists $self->parameters->{$param} ) { return wantarray ? () : undef; } if ( ref $self->parameters->{$param} eq 'ARRAY' ) { return (wantarray) ? @{ $self->parameters->{$param} } : $self->parameters->{$param}->[0]; } else { return (wantarray) ? ( $self->parameters->{$param} ) : $self->parameters->{$param}; } } elsif ( @_ > 1 ) { my $field = shift; $self->parameters->{$field} = [@_]; } } =head2 $req->parameters Returns a reference to a hash containing GET and POST parameters. Values can be either a scalar or an arrayref containing scalars. print $c->request->parameters->{field}; print $c->request->parameters->{field}->[0]; This is the combination of C and C. =head2 $req->params Shortcut for $req->parameters. =head2 $req->path Returns the path, i.e. the part of the URI after $req->base, for the current request. http://localhost/path/foo $c->request->path will contain 'path/foo' =head2 $req->path_info Alias for path, added for compatibility with L. =cut sub path { my ( $self, @params ) = @_; if (@params) { $self->uri->path(@params); $self->_clear_path; } elsif ( $self->_has_path ) { return $self->_path; } else { my $path = $self->uri->path; my $location = $self->base->path; $path =~ s/^(\Q$location\E)?//; $path =~ s/^\///; $self->_path($path); return $path; } } =head2 $req->protocol Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request. =head2 $req->query_parameters =head2 $req->query_params Returns a reference to a hash containing query string (GET) parameters. Values can be either a scalar or an arrayref containing scalars. print $c->request->query_parameters->{field}; print $c->request->query_parameters->{field}->[0]; =head2 $req->read( [$maxlength] ) Reads a chunk of data from the request body. This method is intended to be used in a while loop, reading $maxlength bytes on every call. $maxlength defaults to the size of the request if not specified. =head2 $req->read_chunk(\$buff, $max) Reads a chunk. You have to set MyApp->config(parse_on_demand => 1) to use this directly. =head2 $req->referer Shortcut for $req->headers->referer. Returns the referring page. =head2 $req->secure Returns true or false, indicating whether the connection is secure (https). The reliability of $req->secure may depend on your server configuration; Catalyst relies on PSGI to determine whether or not a request is secure (Catalyst looks at psgi.url_scheme), and different PSGI servers may make this determination in different ways (as by directly passing along information from the server, interpreting any of several HTTP headers, or using heuristics of their own). =head2 $req->captures Returns a reference to an array containing captured args from chained actions or regex captures. my @captures = @{ $c->request->captures }; =head2 $req->upload A convenient method to access $req->uploads. $upload = $c->request->upload('field'); @uploads = $c->request->upload('field'); @fields = $c->request->upload; for my $upload ( $c->request->upload('field') ) { print $upload->filename; } =cut sub upload { my $self = shift; if ( @_ == 0 ) { return keys %{ $self->uploads }; } if ( @_ == 1 ) { my $upload = shift; unless ( exists $self->uploads->{$upload} ) { return wantarray ? () : undef; } if ( ref $self->uploads->{$upload} eq 'ARRAY' ) { return (wantarray) ? @{ $self->uploads->{$upload} } : $self->uploads->{$upload}->[0]; } else { return (wantarray) ? ( $self->uploads->{$upload} ) : $self->uploads->{$upload}; } } if ( @_ > 1 ) { while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) { if ( exists $self->uploads->{$field} ) { for ( $self->uploads->{$field} ) { $_ = [$_] unless ref($_) eq "ARRAY"; push( @$_, $upload ); } } else { $self->uploads->{$field} = $upload; } } } } =head2 $req->uploads Returns a reference to a hash containing uploads. Values can be either a L object, or an arrayref of L objects. my $upload = $c->request->uploads->{field}; my $upload = $c->request->uploads->{field}->[0]; =head2 $req->uri Returns a L object for the current request. Stringifies to the URI text. =head2 $req->mangle_params( { key => 'value' }, $appendmode); Returns a hashref of parameters stemming from the current request's params, plus the ones supplied. Keys for which no current param exists will be added, keys with undefined values will be removed and keys with existing params will be replaced. Note that you can supply a true value as the final argument to change behavior with regards to existing parameters, appending values rather than replacing them. A quick example: # URI query params foo=1 my $hashref = $req->mangle_params({ foo => 2 }); # Result is query params of foo=2 versus append mode: # URI query params foo=1 my $hashref = $req->mangle_params({ foo => 2 }, 1); # Result is query params of foo=1&foo=2 This is the code behind C. =cut sub mangle_params { my ($self, $args, $append) = @_; carp('No arguments passed to mangle_params()') unless $args; foreach my $value ( values %$args ) { next unless defined $value; for ( ref $value eq 'ARRAY' ? @$value : $value ) { $_ = "$_"; utf8::encode( $_ ) if utf8::is_utf8($_); } }; my %params = %{ $self->uri->query_form_hash }; foreach my $key (keys %{ $args }) { my $val = $args->{$key}; if(defined($val)) { if($append && exists($params{$key})) { # This little bit of heaven handles appending a new value onto # an existing one regardless if the existing value is an array # or not, and regardless if the new value is an array or not $params{$key} = [ ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key}, ref($val) eq 'ARRAY' ? @{ $val } : $val ]; } else { $params{$key} = $val; } } else { # If the param wasn't defined then we delete it. delete($params{$key}); } } return \%params; } =head2 $req->uri_with( { key => 'value' } ); Returns a rewritten URI object for the current request. Key/value pairs passed in will override existing parameters. You can remove an existing parameter by passing in an undef value. Unmodified pairs will be preserved. You may also pass an optional second parameter that puts C into append mode: $req->uri_with( { key => 'value' }, { mode => 'append' } ); See C for an explanation of this behavior. =cut sub uri_with { my( $self, $args, $behavior) = @_; carp( 'No arguments passed to uri_with()' ) unless $args; my $append = 0; if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) { $append = 1; } my $params = $self->mangle_params($args, $append); my $uri = $self->uri->clone; $uri->query_form($params); return $uri; } =head2 $req->remote_user Returns the value of the C environment variable. =head2 $req->user_agent Shortcut to $req->headers->user_agent. Returns the user agent (browser) version string. =head2 $req->io_fh Returns a psgix.io bidirectional socket, if your server supports one. Used for when you want to jailbreak out of PSGI and handle bidirectional client server communication manually, such as when you are using cometd or websockets. =head1 SETUP METHODS You should never need to call these yourself in application code, however they are useful if extending Catalyst by applying a request role. =head2 $self->prepare_headers() Sets up the C<< $res->headers >> accessor. =head2 $self->prepare_body() Sets up the body using L =head2 $self->prepare_body_chunk() Add a chunk to the request body. =head2 $self->prepare_body_parameters() Sets up parameters from body. =head2 $self->prepare_cookies() Parse cookies from header. Sets up a L object. =head2 $self->prepare_connection() Sets up various fields in the request like the local and remote addresses, request method, hostname requested etc. =head2 $self->prepare_parameters() Ensures that the body has been parsed, then builds the parameters, which are combined from those in the request and those in the body. If parameters have already been set will clear the parameters and build them again. =head2 meta Provided by Moose =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Response.pm000644 000765 000024 00000024461 12255577340 021714 0ustar00johnstaff000000 000000 package Catalyst::Response; use Moose; use HTTP::Headers; use Moose::Util::TypeConstraints; use namespace::autoclean; with 'MooseX::Emulate::Class::Accessor::Fast'; has _response_cb => ( is => 'ro', isa => 'CodeRef', writer => '_set_response_cb', clearer => '_clear_response_cb', predicate => '_has_response_cb', ); subtype 'Catalyst::Engine::Types::Writer', as duck_type([qw(write close)]); has _writer => ( is => 'ro', isa => 'Catalyst::Engine::Types::Writer', writer => '_set_writer', clearer => '_clear_writer', predicate => '_has_writer', ); has write_fh => ( is=>'ro', predicate=>'_has_write_fh', lazy=>1, builder=>'_build_write_fh', ); sub _build_write_fh { my $self = shift; $self->_context->finalize_headers unless $self->finalized_headers; $self->_writer; }; sub DEMOLISH { my $self = shift; return if $self->_has_write_fh; if($self->_has_writer) { $self->_writer->close } } has cookies => (is => 'rw', default => sub { {} }); has body => (is => 'rw', default => undef); sub has_body { defined($_[0]->body) } has location => (is => 'rw'); has status => (is => 'rw', default => 200); has finalized_headers => (is => 'rw', default => 0); has headers => ( is => 'rw', isa => 'HTTP::Headers', handles => [qw(content_encoding content_length content_type header)], default => sub { HTTP::Headers->new() }, required => 1, lazy => 1, ); has _context => ( is => 'rw', weak_ref => 1, clearer => '_clear_context', ); sub output { shift->body(@_) } sub code { shift->status(@_) } sub write { my ( $self, $buffer ) = @_; # Finalize headers if someone manually writes output $self->_context->finalize_headers unless $self->finalized_headers; $buffer = q[] unless defined $buffer; my $len = length($buffer); $self->_writer->write($buffer); return $len; } sub finalize_headers { my ($self) = @_; # This is a less-than-pretty hack to avoid breaking the old # Catalyst::Engine::PSGI. 5.9 Catalyst::Engine sets a response_cb and # expects us to pass headers to it here, whereas Catalyst::Enngine::PSGI # just pulls the headers out of $ctx->response in its run method and never # sets response_cb. So take the lack of a response_cb as a sign that we # don't need to set the headers. return unless $self->_has_response_cb; # If we already have a writer, we already did this, so don't do it again return if $self->_has_writer; my @headers; $self->headers->scan(sub { push @headers, @_ }); my $writer = $self->_response_cb->([ $self->status, \@headers ]); $self->_set_writer($writer); $self->_clear_response_cb; return; } sub from_psgi_response { my ($self, $psgi_res) = @_; if(ref $psgi_res eq 'ARRAY') { my ($status, $headers, $body) = @$psgi_res; $self->status($status); $self->headers(HTTP::Headers->new(@$headers)); if(ref $body eq 'ARRAY') { $self->body(join '', grep defined, @$body); } else { $self->body($body); } } elsif(ref $psgi_res eq 'CODE') { $psgi_res->(sub { my $response = shift; my ($status, $headers, $maybe_body) = @$response; $self->status($status); $self->headers(HTTP::Headers->new(@$headers)); if($maybe_body) { if(ref $maybe_body eq 'ARRAY') { $self->body(join '', grep defined, @$maybe_body); } else { $self->body($maybe_body); } } else { return $self->write_fh; } }); } else { die "You can't set a Catalyst response from that, expect a valid PSGI response"; } } =head1 NAME Catalyst::Response - stores output responding to the current client request =head1 SYNOPSIS $res = $c->response; $res->body; $res->code; $res->content_encoding; $res->content_length; $res->content_type; $res->cookies; $res->header; $res->headers; $res->output; $res->redirect; $res->status; $res->write; =head1 DESCRIPTION This is the Catalyst Response class, which provides methods for responding to the current client request. The appropriate L for your environment will turn the Catalyst::Response into a HTTP Response and return it to the client. =head1 METHODS =head2 $res->body( $text | $fh | $iohandle_object ) $c->response->body('Catalyst rocks!'); Sets or returns the output (text or binary data). If you are returning a large body, you might want to use a L type of object (Something that implements the read method in the same fashion), or a filehandle GLOB. Catalyst will write it piece by piece into the response. When using a L type of object and no content length has been already set in the response headers Catalyst will make a reasonable attempt to determine the size of the Handle. Depending on the implementation of your handle object, setting the content length may fail. If it is at all possible for you to determine the content length of your handle object, it is recommended that you set the content length in the response headers yourself, which will be respected and sent by Catalyst in the response. =head2 $res->has_body 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. =head2 $res->content_length Shortcut for $res->headers->content_length. =head2 $res->content_type Shortcut for $res->headers->content_type. This value is typically set by your view or plugin. For example, L will guess the mime type based on the file it found, while L defaults to C. =head2 $res->cookies Returns a reference to a hash containing cookies to be set. The keys of the hash are the cookies' names, and their corresponding values are hash references used to construct a L object. $c->response->cookies->{foo} = { value => '123' }; The keys of the hash reference on the right correspond to the L parameters of the same name, except they are used without a leading dash. Possible parameters are: =over =item value =item expires =item domain =item path =item secure =item httponly =back =head2 $res->header Shortcut for $res->headers->header. =head2 $res->headers Returns an L object, which can be used to set headers. $c->response->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); =head2 $res->output Alias for $res->body. =head2 $res->redirect( $url, $status ) Causes the response to redirect to the specified URL. The default status is C<302>. $c->response->redirect( 'http://slashdot.org' ); $c->response->redirect( 'http://slashdot.org', 307 ); This is a convenience method that sets the Location header to the redirect destination, and then sets the response status. You will want to C< return > or C<< $c->detach() >> to interrupt the normal processing flow if you want the redirect to occur straight away. B do not give a relative URL as $url, i.e: one that is not fully qualified (= C, etc.) or that starts with a slash (= C). While it may work, it is not guaranteed to do the right thing and is not a standard behaviour. You may opt to use uri_for() or uri_for_action() instead. =cut sub redirect { my $self = shift; if (@_) { my $location = shift; my $status = shift || 302; $self->location($location); $self->status($status); } return $self->location; } =head2 $res->location Sets or returns the HTTP 'Location'. =head2 $res->status 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 ) Writes $data to the output stream. =head2 $res->write_fh Returns a PSGI $writer object that has two methods, write and close. You can close over this object for asynchronous and nonblocking applications. For example (assuming you are using a supporting server, like L package AsyncExample::Controller::Root; use Moose; BEGIN { extends 'Catalyst::Controller' } sub prepare_cb { my $write_fh = pop; return sub { my $message = shift; $write_fh->write("Finishing: $message\n"); $write_fh->close; }; } sub anyevent :Local :Args(0) { my ($self, $c) = @_; my $cb = $self->prepare_cb($c->res->write_fh); my $watcher; $watcher = AnyEvent->timer( after => 5, cb => sub { $cb->(scalar localtime); undef $watcher; # cancel circular-ref }); } =head2 $res->print( @data ) Prints @data to the output stream, separated by $,. This lets you pass the response object to functions that want to write to an L. =head2 $self->finalize_headers($c) Writes headers to response if not already written =head2 from_psgi_response Given a PSGI response (either three element ARRAY reference OR coderef expecting a $responder) set the response from it. Properly supports streaming and delayed response and / or async IO if running under an expected event loop. Example: package MyApp::Web::Controller::Test; use base 'Catalyst::Controller'; use Plack::App::Directory; my $app = Plack::App::Directory->new({ root => "/path/to/htdocs" }) ->to_app; sub myaction :Local Args { my ($self, $c) = @_; $c->res->from_psgi_response($app->($c->req->env)); } Please note this does not attempt to map or nest your PSGI application under the Controller and Action namespace or path. =head2 DEMOLISH Ensures that the response is flushed and closed at the end of the request. =head2 meta Provided by Moose =cut sub print { my $self = shift; my $data = shift; defined $self->write($data) or return; for (@_) { defined $self->write($,) or return; defined $self->write($_) or return; } defined $self->write($\) or return; return 1; } =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Runtime.pm000644 000765 000024 00000001062 12255600035 021515 0ustar00johnstaff000000 000000 package Catalyst::Runtime; use strict; use warnings; BEGIN { require 5.008003; } # Remember to update this in Catalyst as well! our $VERSION = '5.90053'; =head1 NAME Catalyst::Runtime - The Catalyst Framework Runtime =head1 SYNOPSIS See L. =head1 DESCRIPTION This is the primary class for the Catalyst-Runtime distribution, version 5.80. =head1 AUTHORS & COPYRIGHT Catalyst Contributors, see Catalyst.pm =head1 LICENSE This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut 1; Catalyst-Runtime-5.90053/lib/Catalyst/Script/000755 000765 000024 00000000000 12255610005 020777 5ustar00johnstaff000000 000000 Catalyst-Runtime-5.90053/lib/Catalyst/ScriptRole.pm000644 000765 000024 00000005571 12217110343 022165 0ustar00johnstaff000000 000000 package Catalyst::ScriptRole; use Moose::Role; use Pod::Usage; use MooseX::Getopt; use Catalyst::EngineLoader; use Moose::Util::TypeConstraints; use Catalyst::Utils qw/ ensure_class_loaded /; use Class::Load 'load_class'; use namespace::autoclean; subtype 'Catalyst::ScriptRole::LoadableClass', as 'ClassName'; coerce 'Catalyst::ScriptRole::LoadableClass', from 'Str', via { ensure_class_loaded($_); 1 }; with 'MooseX::Getopt' => { -version => 0.48, -excludes => [qw/ _getopt_spec_warnings _getopt_spec_exception print_usage_text /], }; has application_name => ( traits => ['NoGetopt'], isa => 'Str', is => 'ro', required => 1, ); has loader_class => ( isa => 'Catalyst::ScriptRole::LoadableClass', is => 'ro', coerce => 1, default => 'Catalyst::EngineLoader', documentation => 'The class to use to detect and load the PSGI engine', ); has _loader => ( isa => 'Plack::Loader', default => sub { my $self = shift; $self->loader_class->new(application_name => $self->application_name); }, handles => { load_engine => 'load', autoload_engine => 'auto', }, lazy => 1, ); sub _getopt_spec_exception {} sub _getopt_spec_warnings { shift; warn @_; } sub print_usage_text { my $self = shift; pod2usage(); exit 0; } sub run { my $self = shift; $self->_run_application; } sub _application_args { my $self = shift; return { argv => $self->ARGV, extra_argv => $self->extra_argv, } } sub _plack_loader_args { my $self = shift; my @app_args = $self->_application_args; return (port => $app_args[0]); } sub _plack_engine_name {} sub _run_application { my $self = shift; my $app = $self->application_name; load_class($app); my $server; if (my $e = $self->_plack_engine_name ) { $server = $self->load_engine($e, $self->_plack_loader_args); } else { $server = $self->autoload_engine($self->_plack_loader_args); } $app->run($self->_application_args, $server); } 1; =head1 NAME Catalyst::ScriptRole - Common functionality for Catalyst scripts. =head1 SYNOPSIS package MyApp::Script::Foo; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub _application_args { ... } =head1 DESCRIPTION Role with the common functionality of Catalyst scripts. =head1 METHODS =head2 run The method invoked to run the application. =head2 print_usage_text Prints out the usage text for the script you tried to invoke. =head1 ATTRIBUTES =head2 application_name The name of the application class, e.g. MyApp =head1 SEE ALSO L L =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software, you can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/ScriptRunner.pm000644 000765 000024 00000006061 12121675274 022545 0ustar00johnstaff000000 000000 package Catalyst::ScriptRunner; use Moose; use FindBin; use lib; use File::Spec; use Class::Load qw/ load_first_existing_class load_optional_class /; use Catalyst::Utils; use namespace::autoclean -also => 'subclass_with_traits'; use Try::Tiny; sub find_script_class { my ($self, $app, $script) = @_; return load_first_existing_class("${app}::Script::${script}", "Catalyst::Script::$script"); } sub find_script_traits { my ($self, @try) = @_; return grep { load_optional_class($_) } @try; } sub subclass_with_traits { my ($base, @traits) = @_; my $meta = Class::MOP::class_of($base)->create_anon_class( superclasses => [ $base ], roles => [ @traits ], cache => 1, ); $meta->add_method(meta => sub { $meta }); return $meta->name; } sub run { my ($self, $appclass, $scriptclass) = @_; if (grep { -f File::Spec->catfile($FindBin::Bin, '..', $_) } Catalyst::Utils::dist_indicator_file_list()) { lib->import(File::Spec->catdir($FindBin::Bin, '..', 'lib')); } my $class = $self->find_script_class($appclass, $scriptclass); my @possible_traits = ("${appclass}::TraitFor::Script::${scriptclass}", "${appclass}::TraitFor::Script"); my @traits = $self->find_script_traits(@possible_traits); $class = subclass_with_traits($class, @traits) if @traits; $class->new_with_options( application_name => $appclass )->run; } __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::ScriptRunner - The Catalyst Framework script runner =head1 SYNOPSIS # Will run MyApp::Script::Server if it exists, otherwise # will run Catalyst::Script::Server. Catalyst::ScriptRunner->run('MyApp', 'Server'); =head1 DESCRIPTION This class is responsible for loading and running scripts, either in the application specific namespace (e.g. C), or the Catalyst namespace (e.g. C). If your application contains a custom script, then it will be used in preference to the generic script, and is expected to sub-class the standard script. =head1 TRAIT LOADING Catalyst will automatically load and apply roles to the scripts in your application. C will be loaded if present, and will be applied to B scripts. C will be loaded (if present) and for script individually. =head1 METHODS =head2 run ($application_class, $scriptclass) Called with two parameters, the application class (e.g. MyApp) and the script class, (i.e. one of Server/FastCGI/CGI/Create/Test) =head2 find_script_class ($appname, $script_name) Finds and loads the class for the script, trying the application specific script first, and falling back to the generic script. Returns the script which was loaded. =head2 find_script_traits ($appname, @try) Finds and loads a set of traits. Returns the list of traits which were loaded. =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut Catalyst-Runtime-5.90053/lib/Catalyst/Stats.pm000644 000765 000024 00000024572 12106042701 021176 0ustar00johnstaff000000 000000 package Catalyst::Stats; use Moose; use Time::HiRes qw/gettimeofday tv_interval/; use Text::SimpleTable (); use Catalyst::Utils; use Tree::Simple qw/use_weak_refs/; use Tree::Simple::Visitor::FindByUID; use namespace::clean -except => 'meta'; has enable => (is => 'rw', required => 1, default => sub{ 1 }); has tree => ( is => 'ro', required => 1, default => sub{ Tree::Simple->new({t => [gettimeofday]}) }, handles => [qw/ accept traverse /], ); has stack => ( is => 'ro', required => 1, lazy => 1, default => sub { [ shift->tree ] } ); sub profile { my $self = shift; return unless $self->enable; my %params; if (@_ <= 1) { $params{comment} = shift || ""; } elsif (@_ % 2 != 0) { die "profile() requires a single comment parameter or a list of name-value pairs; found " . (scalar @_) . " values: " . join(", ", @_); } else { (%params) = @_; $params{comment} ||= ""; } my $parent; my $prev; my $t = [ gettimeofday ]; my $stack = $self->stack; if ($params{end}) { # parent is on stack; search for matching block and splice out for (my $i = $#{$stack}; $i > 0; $i--) { if ($stack->[$i]->getNodeValue->{action} eq $params{end}) { my ($node) = splice(@{$stack}, $i, 1); # Adjust elapsed on partner node my $v = $node->getNodeValue; $v->{elapsed} = tv_interval($v->{t}, $t); return $node->getUID; } } # if partner not found, fall through to treat as non-closing call } if ($params{parent}) { # parent is explicitly defined $prev = $parent = $self->_get_uid($params{parent}); } if (!$parent) { # Find previous node, which is either previous sibling or parent, for ref time. $prev = $parent = $stack->[-1] or return undef; my $n = $parent->getChildCount; $prev = $parent->getChild($n - 1) if $n > 0; } my $node = Tree::Simple->new({ action => $params{begin} || "", t => $t, elapsed => tv_interval($prev->getNodeValue->{t}, $t), comment => $params{comment}, }); $node->setUID($params{uid}) if $params{uid}; $parent->addChild($node); push(@{$stack}, $node) if $params{begin}; return $node->getUID; } sub created { return @{ shift->{tree}->getNodeValue->{t} }; } sub elapsed { return tv_interval(shift->{tree}->getNodeValue->{t}); } sub report { my $self = shift; my $column_width = Catalyst::Utils::term_width() - 9 - 13; my $t = Text::SimpleTable->new( [ $column_width, 'Action' ], [ 9, 'Time' ] ); my @results; $self->traverse( sub { my $action = shift; my $stat = $action->getNodeValue; my @r = ( $action->getDepth, ($stat->{action} || "") . ($stat->{action} && $stat->{comment} ? " " : "") . ($stat->{comment} ? '- ' . $stat->{comment} : ""), $stat->{elapsed}, $stat->{action} ? 1 : 0, ); # Trim down any times >= 10 to avoid ugly Text::Simple line wrapping my $elapsed = substr(sprintf("%f", $stat->{elapsed}), 0, 8) . "s"; $t->row( ( q{ } x $r[0] ) . $r[1], defined $r[2] ? $elapsed : '??'); push(@results, \@r); } ); return wantarray ? @results : $t->draw; } sub _get_uid { my ($self, $uid) = @_; my $visitor = Tree::Simple::Visitor::FindByUID->new; $visitor->searchForUID($uid); $self->accept($visitor); return $visitor->getResult; } sub addChild { my $self = shift; my $node = $_[ 0 ]; my $stat = $node->getNodeValue; # do we need to fake $stat->{ t } ? if( $stat->{ elapsed } ) { # remove the "s" from elapsed time $stat->{ elapsed } =~ s{s$}{}; } $self->tree->addChild( @_ ); } sub setNodeValue { my $self = shift; my $stat = $_[ 0 ]; # do we need to fake $stat->{ t } ? if( $stat->{ elapsed } ) { # remove the "s" from elapsed time $stat->{ elapsed } =~ s{s$}{}; } $self->tree->setNodeValue( @_ ); } sub getNodeValue { my $self = shift; $self->tree->getNodeValue( @_ )->{ t }; } __PACKAGE__->meta->make_immutable(); 1; __END__ =for stopwords addChild getNodeValue mysub rollup setNodeValue =head1 NAME Catalyst::Stats - Catalyst Timing Statistics Class =head1 SYNOPSIS $stats = $c->stats; $stats->enable(1); $stats->profile($comment); $stats->profile(begin => $block_name, comment =>$comment); $stats->profile(end => $block_name); $elapsed = $stats->elapsed; $report = $stats->report; See L. =head1 DESCRIPTION This module provides the default, simple timing stats collection functionality for Catalyst. If you want something different set C<< MyApp->stats_class >> in your application module, e.g.: __PACKAGE__->stats_class( "My::Stats" ); If you write your own, your stats object is expected to provide the interface described here. Catalyst uses this class to report timings of component actions. You can add profiling points into your own code to get deeper insight. Typical usage might be like this: sub mysub { my ($c, ...) = @_; $c->stats->profile(begin => "mysub"); # code goes here ... $c->stats->profile("starting critical bit"); # code here too ... $c->stats->profile("completed first part of critical bit"); # more code ... $c->stats->profile("completed second part of critical bit"); # more code ... $c->stats->profile(end => "mysub"); } Supposing mysub was called from the action "process" inside a Catalyst Controller called "service", then the reported timings for the above example might look something like this: .----------------------------------------------------------------+-----------. | Action | Time | +----------------------------------------------------------------+-----------+ | /service/process | 1.327702s | | mysub | 0.555555s | | - starting critical bit | 0.111111s | | - completed first part of critical bit | 0.333333s | | - completed second part of critical bit | 0.111000s | | /end | 0.000160s | '----------------------------------------------------------------+-----------' which means mysub took 0.555555s overall, it took 0.111111s to reach the critical bit, the first part of the critical bit took 0.333333s, and the second part 0.111s. =head1 METHODS =head2 new Constructor. $stats = Catalyst::Stats->new; =head2 enable $stats->enable(0); $stats->enable(1); Enable or disable stats collection. By default, stats are enabled after object creation. =head2 profile $stats->profile($comment); $stats->profile(begin => $block_name, comment =>$comment); $stats->profile(end => $block_name); Marks a profiling point. These can appear in pairs, to time the block of code between the begin/end pairs, or by themselves, in which case the time of execution to the previous profiling point will be reported. The argument may be either a single comment string or a list of name-value pairs. Thus the following are equivalent: $stats->profile($comment); $stats->profile(comment => $comment); The following key names/values may be used: =over 4 =item * begin => ACTION Marks the beginning of a block. The value is used in the description in the timing report. =item * end => ACTION Marks the end of the block. The name given must match a previous 'begin'. Correct nesting is recommended, although this module is tolerant of blocks that are not correctly nested, and the reported timings should accurately reflect the time taken to execute the block whether properly nested or not. =item * comment => COMMENT Comment string; use this to describe the profiling point. It is combined with the block action (if any) in the timing report description field. =item * uid => UID Assign a predefined unique ID. This is useful if, for whatever reason, you wish to relate a profiling point to a different parent than in the natural execution sequence. =item * parent => UID Explicitly relate the profiling point back to the parent with the specified UID. The profiling point will be ignored if the UID has not been previously defined. =back Returns the UID of the current point in the profile tree. The UID is automatically assigned if not explicitly given. =head2 created ($seconds, $microseconds) = $stats->created; Returns the time the object was created, in C format, with Unix epoch seconds followed by microseconds. =head2 elapsed $elapsed = $stats->elapsed Get the total elapsed time (in seconds) since the object was created. =head2 report print $stats->report ."\n"; $report = $stats->report; @report = $stats->report; In scalar context, generates a textual report. In array context, returns the array of results where each row comprises: [ depth, description, time, rollup ] The depth is the calling stack level of the profiling point. The description is a combination of the block name and comment. The time reported for each block is the total execution time for the block, and the time associated with each intermediate profiling point is the elapsed time from the previous profiling point. The 'rollup' flag indicates whether the reported time is the rolled up time for the block, or the elapsed time from the previous profiling point. =head1 COMPATIBILITY METHODS Some components might expect the stats object to be a regular Tree::Simple object. We've added some compatibility methods to handle this scenario: =head2 accept =head2 addChild =head2 setNodeValue =head2 getNodeValue =head2 traverse =head1 SEE ALSO L =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90053/lib/Catalyst/Test.pm000644 000765 000024 00000034766 12255331631 021035 0ustar00johnstaff000000 000000 package Catalyst::Test; use strict; use warnings; use Test::More (); use Plack::Test; use Catalyst::Exception; use Catalyst::Utils; use Class::Load qw(load_class is_class_loaded); use Sub::Exporter; use Moose::Util 'find_meta'; use Carp 'croak', 'carp'; sub _build_request_export { my ($self, $args) = @_; return sub { _remote_request(@_) } if $args->{remote}; my $class = $args->{class}; # Here we should be failing right away, but for some stupid backcompat thing # I don't quite remember we fail lazily here. Needs a proper deprecation and # then removal. return sub { croak "Must specify a test app: use Catalyst::Test 'TestApp'" } unless $class; load_class($class) unless is_class_loaded($class); $class->import; return sub { _local_request( $class, @_ ) }; } sub _build_get_export { my ($self, $args) = @_; my $request = $args->{request}; return sub { $request->(@_)->content }; } sub _build_ctx_request_export { my ($self, $args) = @_; my ($class, $request) = @{ $args }{qw(class request)}; return sub { my $me = ref $self || $self; # fail 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}; # check explicitly for the class here, or the Cat->meta call will blow # up in our face Catalyst::Exception->throw("Must specify a test app: use Catalyst::Test 'TestApp'") unless $class; # place holder for $c after the request finishes; reset every time # requests are done. my $ctx_closed_over; # hook into 'dispatch' -- the function gets called after all plugins # have done their work, and it's an easy place to capture $c. my $meta = find_meta($class); $meta->make_mutable; $meta->add_after_method_modifier( "dispatch", sub { $ctx_closed_over = shift; }); $meta->make_immutable( replace_constructor => 1 ); Class::C3::reinitialize(); # Fixes RT#46459, I've failed to write a test for how/why, but it does. # 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 = $args->{request}->( @_ ); # Make sure not to leave a reference $ctx hanging around. # This means that the context will go out of scope as soon as the # caller disposes of it, rather than waiting till the next time # that ctx_request is called. This can be important if your $ctx # ends up with a reference to a shared resource or lock (for example) # which you want to clean up in test teardown - if the $ctx is still # closed over then you're stuffed... my $ctx = $ctx_closed_over; undef $ctx_closed_over; return ( $res, $ctx ); }; } my $build_exports = sub { my ($self, $meth, $args, $defaults) = @_; my $class = $args->{class}; my $request = $self->_build_request_export({ class => $class, remote => $ENV{CATALYST_SERVER}, }); my $get = $self->_build_get_export({ request => $request }); my $ctx_request = $self->_build_ctx_request_export({ class => $class, request => $request, }); return { request => $request, get => $get, ctx_request => $ctx_request, content_like => sub { my $action = shift; return Test::More->builder->like($get->($action),@_); }, action_ok => sub { my $action = shift; my $meth = $request->($action)->request->method; my @args = @_ ? @_ : ("$meth $action returns successfully"); return Test::More->builder->ok($request->($action)->is_success,@args); }, action_redirect => sub { my $action = shift; my $meth = $request->($action)->request->method; my @args = @_ ? @_ : ("$meth $action returns a redirect"); return Test::More->builder->ok($request->($action)->is_redirect,@args); }, action_notfound => sub { my $action = shift; my $meth = $request->($action)->request->method; my @args = @_ ? @_ : ("$meth $action returns a 404"); return Test::More->builder->is_eq($request->($action)->code,404,@args); }, contenttype_is => sub { my $action = shift; my $res = $request->($action); return Test::More->builder->is_eq(scalar($res->content_type),@_); }, }; }; our $default_host; { my $import = Sub::Exporter::build_exporter({ groups => [ all => $build_exports ], into_level => 1, }); sub import { my ($self, $class, $opts) = @_; Carp::carp( qq{Importing Catalyst::Test without an application name is deprecated:\n Instead of saying: use Catalyst::Test; say: use Catalyst::Test (); # If you don't want to import a test app right now. or say: use Catalyst::Test 'MyApp'; # If you do want to import a test app.\n\n}) unless $class; $import->($self, '-all' => { class => $class }); $opts = {} unless ref $opts eq 'HASH'; $default_host = $opts->{default_host} if exists $opts->{default_host}; return 1; } } =head1 NAME Catalyst::Test - Test Catalyst Applications =head1 SYNOPSIS # Helper script/test.pl # Tests use Catalyst::Test 'TestApp'; 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', [ bar => 'baz', something => 'else' ]; # Run tests against a remote server CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/ use Catalyst::Test 'TestApp'; use Test::More tests => 1; ok( get('/foo') =~ /bar/ ); # mock virtual hosts use Catalyst::Test 'MyApp', { default_host => 'myapp.com' }; like( get('/whichhost'), qr/served by myapp.com/ ); like( get( '/whichhost', { host => 'yourapp.com' } ), qr/served by yourapp.com/ ); { local $Catalyst::Test::default_host = 'otherapp.com'; like( get('/whichhost'), qr/served by otherapp.com/ ); } =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 or remotely if you define the CATALYST_SERVER environment variable. This module also adds a few Catalyst-specific testing methods as displayed in the method section. The L and L functions take either a URI or an L object. =head1 INLINE TESTS WILL NO LONGER WORK While it used to be possible to inline a whole test app into a C<.t> file for a distribution, this will no longer work. The convention is to place your L test apps into C in your distribution. E.g.: C, C, etc.. Multiple test apps can be used in this way. Then write your C<.t> files like so: use strict; use warnings; use FindBin '$Bin'; use lib "$Bin/lib"; use Test::More tests => 6; use Catalyst::Test 'TestApp'; =head1 METHODS =head2 $content = get( ... ) Returns the content. my $content = get('foo/bar?test=1'); Note that this method doesn't follow redirects, so to test for a correctly redirecting page you'll need to use a combination of this method and the L method below: my $res = request('/'); # redirects to /y warn $res->header('location'); use URI; my $uri = URI->new($res->header('location')); is ( $uri->path , '/y'); my $content = get($uri->path); Note also that the content is returned as raw bytes, without any attempt to decode it into characters. =head2 $res = request( ... ); Returns an L 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 ($res, $c) = ctx_request( ... ); Works exactly like L, except it also returns the Catalyst context object, C<$c>. Note that this only works for local requests. =cut sub _request { my $args = shift; my $request = Catalyst::Utils::request(shift); my %extra_env; _customize_request($request, \%extra_env, @_); $args->{mangle_request}->($request) if $args->{mangle_request}; my $ret; test_psgi %{ $args }, app => sub { $args->{app}->({ %{ $_[0] }, %extra_env }) }, client => sub { my ($psgi_app) = @_; my $resp = $psgi_app->($request); $args->{mangle_response}->($resp) if $args->{mangle_response}; $ret = $resp; }; return $ret; } sub _local_request { my $class = shift; return _request({ app => ref($class) eq "CODE" ? $class : $class->_finalized_psgi_app, mangle_response => sub { my ($resp) = @_; # HTML head parsing based on LWP::UserAgent # # This is because if you make a remote request with LWP, then the # from the returned HTML document will be used # to fill in $res->base, as documented in HTTP::Response. We need # to support this in local test requests so that they work 'the same'. # # This is not just horrible and possibly broken, but also really # doesn't belong here. Whoever wants this should be working on # getting it into Plack::Test, or make a middleware out of it, or # whatever. Seriously - horrible. if (!$resp->content_type || $resp->content_is_html) { require HTML::HeadParser; my $parser = HTML::HeadParser->new(); $parser->xml_mode(1) if $resp->content_is_xhtml; $parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40; $parser->parse( $resp->content ); my $h = $parser->header; for my $f ( $h->header_field_names ) { $resp->init_header( $f, [ $h->header($f) ] ); } } # Another horrible hack to make the response headers have a # 'status' field. This is for back-compat, but you should # call $resp->code instead! $resp->init_header('status', [ $resp->code ]); }, }, @_); } my $agent; sub _remote_request { require LWP::UserAgent; local $Plack::Test::Impl = 'ExternalServer'; unless ($agent) { $agent = LWP::UserAgent->new( keep_alive => 1, max_redirect => 0, timeout => 60, # work around newer LWP max_redirect 0 bug # http://rt.cpan.org/Ticket/Display.html?id=40260 requests_redirectable => [], ); $agent->env_proxy; } my $server = URI->new($ENV{CATALYST_SERVER}); if ( $server->path =~ m|^(.+)?/$| ) { my $path = $1; $server->path("$path") if $path; # need to be quoted } return _request({ ua => $agent, uri => $server, mangle_request => sub { my ($request) = @_; # the request path needs to be sanitised if $server is using a # non-root path due to potential overlap between request path and # response path. if ($server->path) { # If request path is '/', we have to add a trailing slash to the # final request URI my $add_trailing = ($request->uri->path eq '/' || $request->uri->path eq '') ? 1 : 0; my @sp = split '/', $server->path; my @rp = split '/', $request->uri->path; shift @sp; shift @rp; # leading / if (@rp) { foreach my $sp (@sp) { $sp eq $rp[0] ? shift @rp : last } } $request->uri->path(join '/', @rp); if ( $add_trailing ) { $request->uri->path( $request->uri->path . '/' ); } } }, }, @_); } for my $name (qw(local_request remote_request)) { my $fun = sub { carp <<"EOW"; Calling Catalyst::Test::${name}() directly is deprecated. Please import Catalyst::Test into your namespace and use the provided request() function instead. EOW return __PACKAGE__->can("_${name}")->(@_); }; no strict 'refs'; *$name = $fun; } sub _customize_request { my $request = shift; my $extra_env = shift; my $opts = pop(@_) || {}; $opts = {} unless ref($opts) eq 'HASH'; if ( my $host = exists $opts->{host} ? $opts->{host} : $default_host ) { $request->header( 'Host' => $host ); } if (my $extra = $opts->{extra_env}) { @{ $extra_env }{keys %{ $extra }} = values %{ $extra }; } } =head2 action_ok($url [, $test_name ]) Fetches the given URL and checks that the request was successful. An optional second argument can be given to specify the name of the test. =head2 action_redirect($url [, $test_name ]) Fetches the given URL and checks that the request was a redirect. An optional second argument can be given to specify the name of the test. =head2 action_notfound($url [, $test_name ]) Fetches the given URL and checks that the request was not found. An optional second argument can be given to specify the name of the test. =head2 content_like( $url, $regexp [, $test_name ] ) Fetches the given URL and returns whether the content matches the regexp. An optional third argument can be given to specify the name of the test. =head2 contenttype_is($url, $type [, $test_name ]) Verify the given URL has a content type of $type and optionally specify a test name. =head1 SEE ALSO L, L, L, L, L =head1 AUTHORS Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =begin Pod::Coverage local_request remote_request =end Pod::Coverage =cut 1; Catalyst-Runtime-5.90053/lib/Catalyst/Upgrading.pod000644 000765 000024 00000057667 12255577340 022222 0ustar00johnstaff000000 000000 =head1 NAME Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst =head1 Upgrading to Catalyst 5.90040 =head2 Catalyst::Plugin::Unicode::Encoding is now core The previously stand alone Unicode support module L has been brought into core as a default plugin. Going forward, all you need is to add a configuration setting for the encoding type. For example: package Myapp::Web; use Catalyst; __PACKAGE__->config( encoding => 'UTF-8' ); Please note that this is different from the old stand alone plugin which applied C encoding by default (that is, if you did not set an explicit C configuration value, it assumed you wanted UTF-8). In order to preserve backwards compatibility you will need to explicitly turn it on via the configuration setting. THIS MIGHT CHANGE IN THE FUTURE, so please consider starting to test your application with proper UTF-8 support and remove all those crappy hacks you munged into the code because you didn't know the Plugin existed :) For people that are using the Plugin, you will note a startup warning suggesting that you can remove it from the plugin list. When you do so, please remember to add the configuration setting, since you can no longer rely on the default being UTF-8. We'll add it for you if you continue to use the stand alone plugin and we detect this, but this backwards compatibility shim will likely be removed in a few releases (trying to clean up the codebase after all). If you have trouble with any of this, please bring it to the attention of the Catalyst maintainer group. =head2 basic async and event loop support This version of L offers some support for using L and L event loops in your application. These changes should work fine for most applications however if you are already trying to perform some streaming, minor changes in this area of the code might affect your functionality. Please see L for more and for a basic example. We consider this feature experimental. We will try not to break it, but we reserve the right to make necessary changes to fix major issues that people run into when the use this functionality in the wild. =head1 Upgrading to Catalyst 5.90030 =head2 Regex dispatch type is deprecated. The Regex dispatchtype (L) has been deprecated. You are encouraged to move your application to Chained dispatch (L). If you cannot do so, please add a dependency to Catalyst::DispatchType::Regex to your application's Makefile.PL =head1 Upgrading to Catalyst 5.9 The major change is that L, a toolkit for using the L specification, now replaces most of the subclasses of L. If you are using one of the standard subclasses of L this should be a straightforward upgrade for you. It was a design goal for this release to preserve as much backwards compatibility as possible. However, since L is different from L, it is possible that differences exist for edge cases. Therefore, we recommend that care be taken with this upgrade and that testing should be greater than would be the case with a minor point update. Please inform the Catalyst developers of any problems so that we can fix them and incorporate tests. It is highly recommended that you become familiar with the L ecosystem and documentation. Being able to take advantage of L development and middleware is a major bonus to this upgrade. Documentation about how to take advantage of L by writing your own C<< .psgi >> file is contained in L. If you have created a custom subclass of L, you will need to convert it to be a subclass of L. If you are using the L engine, L, this new release supersedes that code. If you are using a subclass of L that is aimed at nonstandard or internal/testing uses, such as L, you should still be able to continue using that engine. Advice for specific subclasses of L follows: =head2 Upgrading the FastCGI Engine No upgrade is needed if your myapp_fastcgi.pl script is already upgraded to use L. =head2 Upgrading the mod_perl / Apache Engines The engines that are built upon the various iterations of mod_perl, L (for mod_perl 1, and Apache 1.x) and L (for mod_perl 2, and Apache 2.x), should be seamless upgrades and will work using L or L as required. L, however, is no longer supported, as Plack does not support mod_perl version 1.99. This is unlikely to be a problem for anyone, as 1.99 was a brief beta-test release for mod_perl 2, and all users of mod_perl 1.99 are encouraged to upgrade to a supported release of Apache 2 and mod_perl 2. =head2 Upgrading the HTTP Engine The default development server that comes with the L distribution should continue to work as expected with no changes as long as your C script is upgraded to use L. =head2 Upgrading the CGI Engine If you were using L there is no upgrade needed if your myapp_cgi.pl script is already upgraded to use L. =head2 Upgrading Catalyst::Engine::HTTP::Prefork If you were using L then L is automatically loaded. You should (at least) change your C to depend on Starman. You can regenerate your C script with C and implement a C class that looks like this: package MyApp::Script::Server; use Moose; use namespace::autoclean; extends 'CatalystX::Script::Server::Starman'; 1; This takes advantage of the new script system, and will add a number of options to the standard server script as extra options are added by Starman. More information about these options can be seen at L. An alternate route to implement this functionality is to write a simple .psgi file for your application, and then use the L utility to start the server. =head2 Upgrading the PSGI Engine If you were using L, this new release supersedes this engine in supporting L. By default the Engine is now always L. As a result, you can remove the dependency on L in your C. Applications that were using L previously should entirely continue to work in this release with no changes. However, if you have an C script, then you no longer need to specify the PSGI engine. Instead, the L application class now has a new method C which returns a L compatible coderef which you can wrap in the middleware of your choice. Catalyst will use the .psgi for your application if it is located in the C directory of the application. For example, if you were using L in the past, you will have written (or generated) a C