Catalyst-Runtime-5.90115/000755 000765 000024 00000000000 13101661740 017137 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/Changes000644 000765 000024 00000431440 13101653571 020443 0ustar00jnapiorkowskistaff000000 000000 # This file documents the revision history for Perl extension Catalyst. 5.90115 - 2017-05-01 - fixes for silent bad behavior in Catalyst::ScriptRole and 'ensure_class_loaded' (hobbs++) - do not require MXRWO if Moose is new enough to have cored it (ether++) - documentation improvements (ether++) - Encoding documentation improvements (colinnewell++) - Improve documentation and test cases for 'abort_chain_on_error_fix' configuration option (melmothx++) - Better debug output when using Hash::MultiValue (tremor69++) - Fixes for detecting debug terminal size (simonamor++) 5.90114 - 2016-12-19 - Fixed regression introduced in the last version (5.90113) which caused application to hang when the action private name contained a string like 'foo/bar..html'. If you are running 5.90113 you should consider this a required update. - Tweaked travis CI script. 5.90113 - 2016-12-15 - Fixed issue with $controller->action_for when targeting an action in a namespace nested inside the current controller and the current controller is a 'root' controller. - Enhanced $controller->action_for so that you can reference the 'parent' controller via relative path (eg ->action_for('../foo')). - Backcompat fix for people that made the mistake of doing $c->{stash} - Sort controllers in setup_actions so cross-controller precedence is consistent. 5.90112 - 2016-07-25 - Spelling fixes from Debian group. - Fixed regression introduced in last release that caused the code to crap out if you set the encoding to 'undef'. 5.90111 - 2016-07-20 - Improved documentation around some of the unicode changes; tests (melmothx++) 5.90110 - 2016-07-20 - Better catching of HTTP style exceptions so that you can reliable use one to override many core method. - Documention on better ways to catch and handle Unicode errors - We now check the unicode in your URL request queries and raise an error if the check fails. This was done to be consistent with what we do in other parts of the code (such as in args, or POSTed parameters). If this breaks your code in ways you don't want to fix, you may disable this using the global configuration setting, "do_not_check_query_encoding". - Removed configuration setting, "decode_query_using_global_encoding" since it no longer does anything useful. Query decoding follows from whatever you set the global encoding to, unless you specify an alternative or to not decode. 5.90106 - 2016-07-05 - Fixed regression in debug screen rendering of the private names in chained actions caused by commit 5dd46e24eedec447bdfbc4061ed683b5a17a7b0c. - Fixed incorrect date entered for the release of 5.90105 - Fixed some incorrect code in a test case that might be causing test fails in some configurations. 5.90105 - 2016-06-08 - Tweak some test cases to try and prevent them from failing in limited cases. - Changed how we compose traits onto the response, request, and stats class so that we compose just once at setup time (performance optimization). Also added a debug screen at startup to display composed classes to help with debugging. - Fixed a regressed caused by the changes we made to the way ->state works so that now when you forward to an action and that action throws an exception, $c->state is set to 0, instead of the value of the exeption (this is to be as indicated by the documentation). (cventers++ for reported bug and test case). - Changed the code that detects if you try to set HTTP headers after headers are finalized to not warn if you are just requested the response header state. Tweaked this error message a bit to help people understand it. 5.90104 - 2016-04-04 - Merged pull request #131, fix for noisy debug logs when used type constraints in your actions. Additional changes to the developer debug screen output to improve reporting details. - Merged pull request #133, fix for case when a file upload filename contains wide characters which caused the filename to not appear in the uploads hash. 5.90103 - 2015-11-12 - More documentation fixes (thanks to the debian maintainers and melmothx++) - Fixed the way we parse subroutine attribute values to fix a regression introduced in 5.90102. This is a recommended upgrade (tsibley++, mst++) - Fixed regression around auto actions that escape by throwing an exception which was introduced in the last release. - Bumped namespace::autoclean dep to latest since tests require -except 5.90102 - 2015-10-29 - Better warnings when there's an error reading the psgi.input (billmosley++) - Fixed spurious warnings in uri_for when using no arguments (melmothx++ and paultcochrane++) - Documentation improvements (paultcochrane++) - Improvements to 'search_extra' configuration and tests around using uri_for as a class method (cngarrison++) - Fix when Path() is set and not geting registered as action (grim8634++) - $c->state is now preserved over actions in a chain, and across begin, auto, ->forward and ->detach. 5.90101 - 2015-09-04 - Fixed a regression introduced in the last release which caused test case failure when using a version of Perl 5.14 or older. 5.90100 - 2015-08-24 - Document using namespace::autoclean with controllers that have actions with type constraints. - Look for type constraints in super classes and consumed roles. - Change the way the stash middleware works to no longer localize $psgi_env. - If you delegate control to a sub Catalyst application, that application may now return information to the parent application via the stash. - Fix for RT#106373 (Issue when you try to install and also have an old version of Test::Mechanize::WWW::Catalyst) 5.90097 - 2015-07-28 - $c->uri_for now defines a final argument for setting the URL fragment /URL anchor. This is now the canonical approach to setting a fragment via uri_for. - Reverted how we treat $c->uri_for($path) where $path is a string. When we introduced the UTF-8 work we started encoding stringy paths, which breaks code that did not expect that. We now consider stringy $path to be 'expert' mode and you are expected to perform all nessary encoding. 5.90096 - 2015-07-27 - Fixed regression introduced in previous release that prevented a URI fragment from getting properly encoded. Added more tests around this to define behavior better. 5.90095 - 2015-07-27 - Minor test case tweak that I hope solve some minor hiesenfails reported on CPAN testers. - (https://github.com/perl-catalyst/catalyst-runtime/pull/109) added som additional directions to how to setup a development sandbox - (https://github.com/perl-catalyst/catalyst-runtime/pull/108) fix bug in encoding where URI fragment seperator '#' in ->uri_for would get encoded. 5.90094 - 2015-07-24 - When there is a multipart POST request and the parts have extended HTTP headers, try harder to decode and squeeze a meaningful value out of it before giving up and crying. Updated docs and tests to reflect this change. This should solve problems when your clients are posting multipart form values with special character sets. - Fixed issue where last_error actually returned the first error. Took the change to add a 'pop_errors' to give the inverse of shift_errors. - Merged Pull Requests: - https://github.com/perl-catalyst/catalyst-runtime/pull/95 - https://github.com/perl-catalyst/catalyst-runtime/pull/96 - https://github.com/perl-catalyst/catalyst-runtime/pull/97 - https://github.com/perl-catalyst/catalyst-runtime/pull/98 - https://github.com/perl-catalyst/catalyst-runtime/pull/106 - https://github.com/perl-catalyst/catalyst-runtime/pull/107 5.90093 - 2015-05-29 - Fixed a bug where if you used $res->write and then $res->body, the contents of body would be double encoded (gshank++). 5.90092 - 2015-05-19 - Allows you to use a namespace suffix for request, response and stats class traits. Docs and tests for this. - Refactor the change introduced in 5.90091 to solve reported issues (for example Catalyst::Controller::DBIC::API fails its tests) and to be a more conservative refactor (new code more closely resembles the orginal code that has proven to work for years.) 5.90091 - 2015-05-08 - Fixed a bug where if an injected component expanded sub components, those sub components would not show up in the startup debug dev console ( even though they were actually created). 5.90090 - 2015-04-29 - Updated some documention in Catalyst::Request::Upload to clarify behavior that RT ticket reported as confusing or unexpected - Merged all changes from 5.90089_XXX development cycle. - removed a mistaken use of Test::Most, which is not a core Catalyst dependency. Used Test::More instead. 5.90089_004 - 2015-04-28 - Added swanky github badges. - Reverted a change to how the stats engine is setup that was incorrect. - New application setup hook 'config_for' which allows one to get the canonical application configuration for a controller, view or model, or a plugin. Can also be used to override and adapt what configuration is retrieved. 5.90089_003 - 2015-04-27 - Fixed an issue where a delayed controller that did ACCEPT_CONTEXT would raise an error when registering its actions. - Updated some documentation around route matching. - refactored the setup of injected components to allow you to hook into the injection and do custom injection types. 5.90089_002 - 2015-04-17 - Changed the way we check for presence of Type::Tiny in a test case to be more explicit in the version requirement. Hopefully a fix for reported test fail. - When declaring type constraints in Args and CaptureArgs, if you want to use a Moose builtin type (or a custom stringy type that you've already defined and associated with the Moose::TypeRegistry) you must now quote the type name. This is to clearly disambiguate between Moose stringy types and imported types. - Additional changes to type constraint detection to between determine when a type constraint for reference types have a measured number of arguments or not. clarify restriction on reference type constraints. - Several bugs with type constraints and uri_for squashed. More test cases around all the argument type constraints to tighten scope of action. - NEW FEATURE: New method in Catalyst::Utils 'inject_component', which is a core version of the previously external addon 'CatalystX::InjectComponent'. You should start to convert your existing code which uses the stand alone version, since going forward only the core version will be supported. Also the core version in Catalyst::Utils has an additional feature to compose roles into the injected component. - NEW FEATURE: Concepts from 'CatalystX::RoleApplicator' have been moved to core so we now have the follow application attributes 'request_class_traits', 'response_class_traits' and 'stats_class_traits' which allow you to compose traits for these core Catalyst classes without needing to create subclasses. So in general any request or response trait on CPAN that used 'CatalystX::RoleApplicator' should now just work with this core feature. Note that can also set thse roles via new configuration keys, 'request_class_traits', 'response_class_traits' and 'stats_class_traits'. If you use both configuration and application class methods, they are combined. - NEW FEATURE: Core concepts from 'CatalystX::ComponentsFromConfig'. You can now setup components directly from configuration. This could save you some effort and creating 'empty' base classes in your Model/View and Controller directories. This feature is currently limited in that you can only configure components that are 'true' Catalyst components (but you may use Catalyst::Model::Adaptor to proxy stand alone classes...). - Only create a stats object if you are using stats. This is a minor performance optimization, but there's a small chance it is a breaking change, so please report any stats related issues. - Added a developer mode warning if you call a component with arguments that does not expect arguments (for example calling $c->model('Foo', 1,2,3,4) where Myapp::Model::Foo does not ACCEPT_CONTEXT. Only components that ACCEPT_CONTEXT do anything with passed arguments in $c->controller/view/model. - Change the way components are setup so that you can now rely on all components when setting up a component. Previously application scoped components could not reliably use an existing application scoped component as a dependecy for initialization. 5.90089_001 - 2015-03-26 - New development branch synched with 5.90085. - NEW FEATURE: Type Constraints on Args/CaptureArgs. Allows you to declare a Moose, MooseX::Types or Type::Tiny named constraint on your Arg or CaptureArg. - When using $c->uri_for (or the derived $c->uri_for_action) and the target action has type constrainted args (or captures), verify that the proposed URL matches the defined args. In general $c->uri_for will be a bit more noisy if the supplied arguments are not correct. - New top level document on Route matching. (Catalyst::RouteMatching). This document is still in development, but is worth review and comments. 5.90085 - 2015-03-25 - Small change to Catalyst::Action to prevent autovivication of Args value (dim1++) - Minor typo fixes (Abraxxa++) - Make sure than when using chained actions and when more than one action matches the same path specification AND has Args(0), that we follow the "in a tie, the last action defined wins" rule. There is a small chance this is a breaking change for you. See Catalyst::Upgrading for more. You may use the application configuration setting "use_chained_args_0_special_case" to disable this new behavior, if you must for back-compat reasons. - Added PATCH HTTP Method action attribute shortcut. - Several new configuration options aimed to give improved backwards compatibility for when your URL query parameters or keywords have non UTF-8 encodings. See Catalyst::Upgrading. 5.90084 - 2015-02-23 - Small change to the way body parameters are created in order to prevent trying to create parameters twice. - Use new HTTP::Body and code updates to fix issue when POSTed params have non UTF-8 charset encodings or otherwise complex upload parts that are not file uploads. In these cases when Catalyst can't determine what the value of a form upload is, will return an instance of Catalyst::Request::PartData with all the information need to figure it out. Documentation about this corner case. For RT https://rt.cpan.org/Ticket/Display.html?id=101556 - Two new application configuration parameters 'skip_body_param_unicode_decoding' and 'skip_complex_post_part_handling' to assist you with any backward compatibility issues with all the new UTF8 work in the most recent stable Catalyst. You may use these settings to TEMPORARILY disable certain new features while you are seeking a long term fix. 5.90083 - 2015-02-16 - Fixed typo in support for OPTIONS method matching (andre++) - Stop using $env->{'plack.request.query'} as a query parsing optimization since 1) it doesn't belong to us and 2) there's subtle differences in the way plack parses parameters and catalyst does. This fixes a bug when you are using middleware that uses Plack::Request to do its thing. This change might have subtle impact on query parsing. Please test this change! 5.90082 - 2015-01-10 - Fixed a regression created in $response->from_psgi_response and test case to prevent it happening again. 5.90081 - 2015-01-10 - created class attribute 'finalized_default_middleware' which determines if the default middleware has been added to the stack yet or not. This removes a horrible hack that polluted the configuration hash. Added test case to prevent regressions. 5.90080 - 2015-01-09 - Minor documentation corrections - Make the '79 development series stable 5.90079_008 - 2015-01-07 - If we get a response set from $res->from_psgi_response and that response has a charset for the content type, we clear encoding for the rest of the response (avoid double encoding). Added more documentation around this. - Documentation updates and typo fixes across various UTF8 docs (Mark Ellis++) 5.90079_007 - 2015-01-07 - Merged from Stable (5.90079) - reviewed and cleaned up UTF8 related docs - replace missing utf8 pragma in Catalyst::Engine - Cleaned up spelling errors in various docs (abbraxxa++) - New document Catalyst::UTF8 which attempts to summarize UTF8 and encoding changes introduced in v5.90080. 5.90079_006 - 2015-01-02 - Removed unneeded dependency on RenderView in new test case that was causing fails on CPAN testers that did not just happen to have that dependency already installed - Updated copyright notices to 2015 - Documentation patches around the setup methods and clarification on on security note posted a few months ago. - Added my name to the contributors list 5.90079_005 - 2014-12-31 - Merged changes from 5.90078 - If configuration 'using_frontend_proxy' is set, we add the correct middleware to the default middleware list. This way you get the correct and expected behavior if you are starting your application via one of the generated scripts or if you are calling MyApp->psgi_app. Previously if you started the application with ->psgi_app (or to_app) we ignored this configuration option - New configuration option 'using_frontend_proxy_path' which enables Plack::Middleware::ReverseProxyPath on your application easily. Please note that Plack::Middleware::ReverseProxyPath is not an automatic dependency of Catalyst at this time, so if you want this feature you should add it to your project dependency list. This is done to avoid continued growth of Catalyst dependencies. - Tweaks encoding docs a bit to get closer to final. 5.90079_004 - 2014-12-26 - Starting adding some docs around the new encoding stuff - Exposed the reqexp we use to match content types that need encoding via a global variable. - Added some test cases for JSON utf8 and tested file uploads with utf8. - Fixes to decoding on file upload filenames and related methods - new methods on upload object that tries to do the right thing if we find a character set on the upload and its UTF8. - new additional helper methods on the file upload object. - new helper methods has_encoding and clear_encoding on context. - Method on Catalyst::Response to determine if the response should be encoded. - Warn if changing headers only if headers are finalized AND the response callback has already been called (and headers already sent). - Centralized rules about detecting if we need to automatically encode or not and added tests around cases when you choose to skip auto encoding. 5.90079_003 - 2014-12-03 - Make sure all tests run even if debug mode is enabled. - Fixed issue with middleware stash test case that failed on older Perls 5.90079_002 - 2014-12-02 - Fixed typo in Makefile.PL which borked the previous distribution. No other changes. 5.90079_001 - 2014-12-02 - MyApp->to_app is now an alias for MyApp->psgi_app in order to better support existing Plack conventions. - Modify Catalyst::Response->from_psgi_response to allow the first argument to be an object that does ->as_psgi. - Modified Catalyst::Middleware::Stash to be a shallow copy in $env. Added some docs. Added a test case to make sure stash keys added in a child application don't bubble back up to the main application. - We no longer use Encode::is_utf8 since it doesn't work the way we think it does... This required some UTF-8 changes. If your application is UTF-8 aware I highly suggest you test this release. - We always do utf8 decoding on incoming URLs (before we only did so if the server encoding was utf8. I believe this is correct as per the w3c spec, but please correct if incorrect :) - Debug output now shows utf8 characters if those are incoming via Args or as path or pathparts in your actions. query and body parameter keys are now also subject to utf8 decoding (or as specified via the encoding configuration value). - lots of UTF8 changes. Again we think this is now more correct but please test. - Allow $c->res->redirect($url) to accept $url as an object that does ->as_string which I think will ease a common case (and common bug) and added documentation. - !!! UTF-8 is now the default encoding (there used to be none...). You can disable this if you need to with MyApp->config(encoding => undef) if it causes you trouble. - Calling $c->res->write($data) now encodes $data based on the configured encoding (UTF-8 is default). - $c->res->writer_fh now returns Catalyst::Response::Writer which is a decorator over the PSGI writer and provides an additional method 'write_encoded' that just does the right thing for encoding your responses. This is probably the method you want to use. - New dispatch matching attribute: Scheme. This lets you match a route based on the incoming URI scheme (http, https, ws, wss). - If $c->uri_for targets an action or action chain that defines Scheme, use that scheme for the generated URI object instead of just using whatever the incoming request uses. 5.90079 - 2015-01-02 - Removed dependency from test case that we don't install for testing ( rt #101243) - updated year in copyright notices 5.90078 - 2014-12-30 - POD corrections (sergey++) - New configuration option to disable the HTTP Exception passthrough feature introduced in 5.90060. You can use this if that feature is causing you trouble. (davewood++); - Some additional helper methods for dealing with errors. - More clear exception when $request->body_data tries to parse malformed POSTed data. Added documentation and tests around this. 5.90077 - 2014-11-18 - We store the PSGI $env in Catalyst::Engine for backcompat reasons. Changed this so that the storage is a weak reference, so that it goes out of scope with the request. This solves an issue where items in the stash (now in the PSGI env) would not get closed at the end of the request. This caused some regression, primarily in custom testing classes. 5.90076 - 2014-11-13 - If throwing an exception object that does the code method, make sure that method returns an expected HTTP status code before passing it on to the HTTP Exception middleware. 5.90075 - 2014-10-06 - Documentation patch for $c->req->param to point out the recently discovered potential security issues: http://blog.gerv.net/2014/10/new-class-of-vulnerability-in-perl-web-applications/ - You don't need to install this update, but you should read about the exploit and review if your code is vulnerable. If you use the $c->req->param interface you really need to review this exploit. 5.90074 - 2014-10-01 - Specify Carp minimum version to avoid pointless test fails (valy++) 5.90073 - 2014-09-23 - Fixed a regression caused by the last release where we broke what happened when you tried to set request parameters via $c->req->param('foo', 'bar'). You shouldn't do this, but I guess I shouldn't have busted it either :) - Allow the term_width to be regenerated (see Catalyst::Utils::term_width, Frew Schmidt) - More aggressive skipping of value decoding if the value is undefined. 5.90072 - 2014-09-15 - In the case where you call $c->req->param(undef), warn with a more useful warning (now gives the line of your code that called param with the undef, so you can go to hunt it out. 5.90071 - 2014-08-10 - Travis config now performs basic reverse dependency testing. - Restored deprecated 'env' code in Engine.pm b/c it is still being used out in the wild (Catalyst-Plugin-Authentication-0.10023) - (removed in 5.90070) - Reverted changes to debug log/handling (5.90069_003) to fix rev dep Catalyst-Plugin-Static-Simple-0.32 test suite. - Added Italian translation of default error. 5.90070 - 2014-08-07 - Retagged previous release as stable; no changes 5.90069_004 - Fixed typo in middleware stash that was causing older Perls to fail certain tests. No other changes. 5.90069_003 - The default log level is now 'info', not 'debug'. - Finished merging all the encoding plugin code to core code. The encoding plugin is now just an empty package. Also tried to improve encoding docs a bit. - Some additional changes to the stash middleware that should not break anything new. - Documentation around using Sendfile type http headers with a filehandle type response. - Merged from master branch to pick up some additional fixes and documentation improvements. 5.90069_002 - Catalyst stash functionality has been moved to Middleware. It should work entirely the same when used as a context method, please report questions or problems! - Removed code related to supporting the long deprecated stand alone PSGI Engine. If you are still using this you code is now broken. Luckily you can just stop using it and likely everything will work under the new PSGI support built into Catalyst for several years. - 'abort_chain_on_error_fix' now defaults to true. If this behavior causes you issues, you can explicitly turn it off by setting it to a non true defined value (0 is a good option here). - When throwing an http style exception, make sure we properly flush the existing log and report other errors in the error stack. 5.90069_001 - Set encoding on STDERR when encoding is set in config - documentation and test fixes 5.90065 - 2014-06-04 - The Catalyst::Log object now has 'autoflush' (which defaults to true) and causes log messages to be written out in real-time. This is helpful for the test/dev server to be able to see messages during startup as well as before the end of the request when the log is flushed. - Fix spelling, grammar and structural errors in POD - Remove redundant ->setup call in t/head_middleware.t RT#95361 - Fix test failures when running under CATALYST_DEBUG. RT#95358 5.90064 - 2014-05-05 - Fix for mindless broken tests on Win32 (Haarg++). - Happy Cinco de Mayo! 5.90063 - 2014-05-01 - 'end' and other special actions won't catch HTTP style exceptions anymore. - Fix bug where Catalyst did not properly detect the terminal width when in debug mode and thus making the debug output narrow and hard to read. - Documentation corrections for Util methods around localized PSGI $env. - Improvements to auto detection of terminal width. - Updating deprecation list to include Class::Load and ensure_class_loaded - Added a few docs around middleware and corrected the order that middleware is loaded when registering it via ->setup_middleware instead of via configuration. - Added a test case to make sure default middleware order is correct. s 5.90062 - 2014-04-14 - HTTP::Exception objects were not properly bubbled up to middleware since there was some code in Catalyst that was triggering stringification. 5.90061 - 2014-03-10 - Reverted a change related to how plugins get initialized that was introduced by a change in December. 5.90060 - 2014-02-07 - Same as 5.90059_006, just marking it as stable, no functional changes. 5.90059_006 - 2014-02-06 - MyApp->setup now returns $app to allow class method chaining. - New Util helper functional localize $env to make it easier to mount PSGI applications under controllers and actions. See Catalyst::Utils/PSGI Helpers. - NOTICE: Final Development release for Runner, unless significant issues are raised. Please test. 5.90059_005 - 2014-01-28 - Specify newest versions of some middleware in attempt to solve test errors reported while installing. 5.90059_004 - 2014-01-27 - Make sure IO handle objects do 'getline' before sending them to the response callback, to properly support the PSGI specification. - Added some backcompat code when setting a response body to an object that does 'read' but not 'getline'. Added deprecation notice for this case. Added docs to Catalyst::Delta. - Catalyst::Delta contains a list of behaviors which will be considered deprecated immediately. Most items have workarounds and tweaks you can make to avoid issues. These deprecations are targeted for removal/enforcement in the Catalyst 6 release. Please review and give your feedback. - More middleware to replace inline code (upasana++) - Documentation around Exceptions and how we handle them. - update copyright notices. 5.90059_003 - 2013-12-24 - More documentation about alternative ways to setup middleware. - removed unneeded use of Devel::Dwarn in test case that was causing fails to install (sorry). - When finalizing caught errors, if the error conforms to the interface as described by Plack::Middleware::HTTPExceptions, rethrow it and let the middleware deal with it. 5.90059_002 - 2013-12-21 - We now pass a scalar or filehandle directly to you Plack handler, rather than always use the streaming interface (we are still always using a delayed response callback). This means that you can make use of Plack middleware like Plack::Middleware::XSendfile and we expect better use of server features (when they exist) like correct use of chunked encoding or properly non blocking streaming when running under a supporting server like Twiggy. See Catalyst::Delta for more. This change might cause issues if you are making heaving use of streaming (although in general we expect things to work much better. - In the case when we remove a content body from the response because you set an information status or a no content type status, warn that we are doing so when in debug mode. You might see additional debugging information to help you find and remove unneeded response bodies. - Updated the code where Catalyst tries to guess a content length when you fail to provide one. This should cause less issues when trying to guess the length of a funky filehandle. This now uses Plack::Middleware::ContentLength - Removed custom code to remove body content when the request is HEAD and swapped it for Plack::Middleware::Head - Merged fix for regressions from stable.. 5.90059_001 - 2013-12-19 - Removed deprecated Regexp dispatch type from dependency list. If you are using Regex[p] type dispatching you need to add the standalone distribution 'Catalyst::DispatchType::Regex' to you build system NOW or you application will be broken. 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 popular 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 formatting 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 existence 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 (preferring 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 compatibility 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 validation 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 Perl 5.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 MacOSX 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-existent 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. Documentation: - 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 through 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 actions 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 responses 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 explicitly 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 Catalyst::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::Upgrading 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 characters. 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->captures) 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 referring 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 Catalyst::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 reorganization 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 debugging 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 declarations 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 arguments 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 compatibility 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.90115/inc/000755 000765 000024 00000000000 13101661737 017716 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/000755 000765 000024 00000000000 13101661740 017705 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/Makefile.PL000644 000765 000024 00000021340 13101634223 021105 0ustar00jnapiorkowskistaff000000 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.28'; 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' unless can_use('Moose', '2.1300'); requires 'Carp' => '1.25'; 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.22'; 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.65'; requires 'URI::ws' => '0.03'; requires 'JSON::MaybeXS' => '1.000000'; requires 'Stream::Buffered'; requires 'Hash::MultiValue'; requires 'Plack::Request::Upload'; requires 'CGI::Struct'; requires "Plack::Middleware::Conditional"; requires "Plack::Middleware::IIS6ScriptNameFix"; requires "Plack::Middleware::IIS7KeepAliveFix"; requires "Plack::Middleware::LighttpdScriptNameFix"; requires "Plack::Middleware::ContentLength"; requires "Plack::Middleware::Head"; requires "Plack::Middleware::HTTPExceptions"; requires "Plack::Middleware::FixMissingBodyInRedirect" => '0.09'; requires "Plack::Middleware::MethodOverride" => '0.12'; requires "Plack::Middleware::RemoveRedundantBody" => '0.03'; 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 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 # web: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=summary '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.90115/MANIFEST000644 000765 000024 00000043175 13101661733 020304 0ustar00jnapiorkowskistaff000000 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/ActionRole/QueryMatching.pm lib/Catalyst/ActionRole/Scheme.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/Contributing.pod 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/Middleware/Stash.pm lib/Catalyst/Model.pm lib/Catalyst/Plugin/Unicode/Encoding.pm lib/Catalyst/PSGI.pod lib/Catalyst/Request.pm lib/Catalyst/Request/PartData.pm lib/Catalyst/Request/Upload.pm lib/Catalyst/Response.pm lib/Catalyst/Response/Writer.pm lib/Catalyst/RouteMatching.pod 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/UTF8.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/abort-chain-1.t t/abort-chain-2.t t/abort-chain-3.t t/accept_context_regression.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/to_app.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_log_autoflush.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/arg_constraints.t t/args-empty-parens-bug.t t/args0_bug.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/bad_warnings.t t/body_fh.t t/catalyst_130pix.gif t/class_traits.t t/class_traits_CAR_bug.t t/conf/extra.conf.in t/configured_comps.t t/consumes.t 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/dispatch_on_scheme.t t/encoding_set_in_app.t t/encoding_set_in_config.t t/evil_stash.t t/execute_exception.t t/head_middleware.t t/http_exceptions.t t/http_exceptions_backcompat.t t/http_method.t t/inject_component_util.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/Test/Apple.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/TestAppArgsEmptyParens.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/TestPath.pm t/lib/TestPath/Controller/Four.pm t/lib/TestPath/Controller/One.pm t/lib/TestPath/Controller/Three.pm t/lib/TestPath/Controller/Two.pm 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/middleware-stash.t t/more-psgi-compat.t t/no_test_stash_bug.t t/not_utf8_query_bug.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/path_action_empty_brackets.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_utils.t t/query_constraints.t t/relative_root_action_for_bug.t t/remove_redundant_body.t t/set_allowed_method.t t/something/Makefile.PL t/something/script/foo/bar/for_dist t/state.t t/undef-params.t t/undef_encoding_regression.t t/unicode-exception-bug.t t/unicode-exception-return-value.t 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 t/useless_set_headers.t t/utf8.txt t/utf_incoming.t Catalyst-Runtime-5.90115/META.yml000644 000765 000024 00000004736 13101661730 020421 0ustar00jnapiorkowskistaff000000 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.16' 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: '1.25' 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.22' 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' Path::Class: '0.09' Plack: '0.9991' Plack::Middleware::Conditional: 0 Plack::Middleware::ContentLength: 0 Plack::Middleware::FixMissingBodyInRedirect: '0.09' Plack::Middleware::HTTPExceptions: 0 Plack::Middleware::Head: 0 Plack::Middleware::IIS6ScriptNameFix: 0 Plack::Middleware::IIS7KeepAliveFix: 0 Plack::Middleware::LighttpdScriptNameFix: 0 Plack::Middleware::MethodOverride: '0.12' Plack::Middleware::RemoveRedundantBody: '0.03' 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.65' URI::ws: '0.03' namespace::autoclean: '0.28' 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.90115' x_authority: cpan:MSTROUT Catalyst-Runtime-5.90115/script/000755 000765 000024 00000000000 13101661740 020443 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/000755 000765 000024 00000000000 13101661740 017402 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/01use.t000644 000765 000024 00000000060 12406561462 020527 0ustar00jnapiorkowskistaff000000 000000 use Test::More tests => 1; use_ok('Catalyst'); Catalyst-Runtime-5.90115/t/abort-chain-1.t000644 000765 000024 00000002223 13101642455 022115 0ustar00jnapiorkowskistaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 1; use HTTP::Request::Common; BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); sub increment { my $self = shift; $self->counter($self->counter + 1); } sub root :Chained('/') :PathPart('') :CaptureArgs(0) { my ($self, $c, $arg) = @_; die "Died in root"; } sub main :Chained('root') :PathPart('') :Args(0) { my ($self, $c, $arg) = @_; $self->increment; die "Died in main"; } sub hits :Path('hits') :Args(0) { my ($self, $c, $arg) = @_; $c->response->body($self->counter); } __PACKAGE__->config(namespace => ''); } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; __PACKAGE__->setup; } use Catalyst::Test 'TestApp'; { my $res = request('/'); } { my $res = request('/hits'); is $res->content, 0, "main action not touched on crash with no explicit setting"; } Catalyst-Runtime-5.90115/t/abort-chain-2.t000644 000765 000024 00000002320 13101642455 022114 0ustar00jnapiorkowskistaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 1; use HTTP::Request::Common; BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); sub increment { my $self = shift; $self->counter($self->counter + 1); } sub root :Chained('/') :PathPart('') :CaptureArgs(0) { my ($self, $c, $arg) = @_; die "Died in root"; } sub main :Chained('root') :PathPart('') :Args(0) { my ($self, $c, $arg) = @_; $self->increment; die "Died in main"; } sub hits :Path('hits') :Args(0) { my ($self, $c, $arg) = @_; $c->response->body($self->counter); } __PACKAGE__->config(namespace => ''); } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; __PACKAGE__->config(abort_chain_on_error_fix => 1); __PACKAGE__->setup; } use Catalyst::Test 'TestApp'; { my $res = request('/'); } { my $res = request('/hits'); is $res->content, 0, "main action not touched on crash with explicit setting to true"; } Catalyst-Runtime-5.90115/t/abort-chain-3.t000644 000765 000024 00000002317 13101642455 022123 0ustar00jnapiorkowskistaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 1; use HTTP::Request::Common; BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; has counter => (is => 'rw', isa => 'Int', default => sub { 0 }); sub increment { my $self = shift; $self->counter($self->counter + 1); } sub root :Chained('/') :PathPart('') :CaptureArgs(0) { my ($self, $c, $arg) = @_; die "Died in root"; } sub main :Chained('root') :PathPart('') :Args(0) { my ($self, $c, $arg) = @_; $self->increment; die "Died in main"; } sub hits :Path('hits') :Args(0) { my ($self, $c, $arg) = @_; $c->response->body($self->counter); } __PACKAGE__->config(namespace => ''); } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; __PACKAGE__->config(abort_chain_on_error_fix => 0); __PACKAGE__->setup; } use Catalyst::Test 'TestApp'; { my $res = request('/'); } { my $res = request('/hits'); is $res->content, 1, "main action performed on crash with explicit setting to false"; } Catalyst-Runtime-5.90115/t/accept_context_regression.t000644 000765 000024 00000001145 12520162327 025034 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; { package MyApp::Model::AcceptContext; use base 'Catalyst::Model'; sub ACCEPT_CONTEXT { my ($self, $c, @args) = @_; Test::More::ok( ref $c); } $INC{'MyApp/Model/AcceptContext.pm'} = __FILE__; package MyApp::Controller::Root; use base 'Catalyst::Controller'; sub test_model :Local { my ($self, $c) = @_; $c->res->body('test'); } $INC{'MyApp/Controller/Root.pm'} = __FILE__; package MyApp; use Catalyst; MyApp->setup; } use Catalyst::Test 'MyApp'; my ($res, $c) = ctx_request('/test_model'); ok $res; done_testing; Catalyst-Runtime-5.90115/t/aggregate/000755 000765 000024 00000000000 13101661740 021330 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/aggregate.t000644 000765 000024 00000001277 12406561462 021533 0ustar00jnapiorkowskistaff000000 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.90115/t/arg_constraints.t000644 000765 000024 00000033563 12615726644 023017 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use HTTP::Request::Common; use utf8; BEGIN { use Test::More; eval "use Type::Tiny 1.000005; 1" || do { plan skip_all => "Trouble loading Type::Tiny and friends => $@"; }; } BEGIN { package MyApp::Types; $INC{'MyApp/Types.pm'} = __FILE__; use strict; use warnings; use Type::Utils -all; use Types::Standard -types; use Type::Library -base, -declare => qw( UserId Heart User ContextLike ); extends "Types::Standard"; class_type User, { class => "MyApp::Model::User::user" }; duck_type ContextLike, [qw/model/]; declare UserId, as Int, where { $_ < 5 }; declare Heart, as Str, where { $_ eq '♥' }; # Tests using this are skipped pending deeper thought coerce User, from ContextLike, via { $_->model('User')->find( $_->req->args->[0] ) }; } { package MyApp::Role::Controller; $INC{'MyApp/Role/Controller.pm'} = __FILE__; use Moose::Role; use MooseX::MethodAttributes::Role; use MyApp::Types qw/Int Str/; sub role_str :Path('role_test') Args(Str) { my ($self, $c, $arg) = @_; $c->res->body('role_str'.$arg); } sub role_int :Path('role_test') Args(Int) { my ($self, $c, $arg) = @_; $c->res->body('role_int'.$arg); } package MyApp::Model::User; $INC{'MyApp/Model/User.pm'} = __FILE__; use base 'Catalyst::Model'; our %users = ( 1 => { name => 'john', age => 46 }, 2 => { name => 'mary', age => 36 }, 3 => { name => 'ian', age => 25 }, 4 => { name => 'visha', age => 18 }, ); sub find { my ($self, $id) = @_; my $user = $users{$id} || return; return bless $user, "MyApp::Model::User::user"; } package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; use Types::Standard qw/slurpy/; use MyApp::Types qw/Tuple Int Str StrMatch ArrayRef UserId User Heart/; extends 'Catalyst::Controller'; with 'MyApp::Role::Controller'; sub user :Local Args(UserId) { my ($self, $c, $int) = @_; my $user = $c->model("User")->find($int); $c->res->body("name: $user->{name}, age: $user->{age}"); } # Tests using this are current skipped pending coercion rethink sub user_object :Local Args(User) Coerce(1) { my ($self, $c, $user) = @_; $c->res->body("name: $user->{name}, age: $user->{age}"); } sub stringy_enum :Local Args('Int',Int) { my ($self, $c) = @_; $c->res->body('enum'); } sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int'); } sub two_ints :Local Args(Int,Int) { my ($self, $c, $int) = @_; $c->res->body('two_ints'); } sub many_ints :Local Args(ArrayRef[Int]) { my ($self, $c, @ints) = @_; $c->res->body('many_ints'); } sub tuple :Local Args(Tuple[Str,Int]) { my ($self, $c, $str, $int) = @_; $c->res->body('tuple'); } sub slurpy_tuple :Local Args(Tuple[Str,Int, slurpy ArrayRef[Int]]) { my ($self, $c, $str, $int) = @_; $c->res->body('tuple'); } sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) { my ($self, $c, $int) = @_; $c->res->body('match'); } sub any_priority :Path('priority_test') Args(1) { $_[1]->res->body('any_priority') } sub int_priority :Path('priority_test') Args(Int) { $_[1]->res->body('int_priority') } sub chain_base :Chained(/) CaptureArgs(1) { } sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('any_priority_chain') } sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { $_[1]->res->body('int_priority_chain') } sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { } sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { $_[1]->res->body('any_priority_link_any') } sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link_any') } sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { } sub any_priority_link :Chained(link_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link') } sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link') } sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { } sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { $_[1]->res->body('any_priority_link2') } sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link2') } sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { } sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { $_[1]->res->body('any_priority_link3') } sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { $_[1]->res->body('int_priority_link3') } sub link2_int :Chained(link_tuple) PathPart('') CaptureArgs(UserId) { } sub finally2 :GET Chained(link2_int) PathPart('') Args { $_[1]->res->body('finally2') } sub finally :GET Chained(link2_int) PathPart('') Args(Int) { $_[1]->res->body('finally') } sub chain_base2 :Chained(/) CaptureArgs(1) { } sub chained_zero_again : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_again') } sub chained_zero_post2 : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero_post2') } sub chained_zero2 : Chained(chain_base2) PathPart('') Args(0) { $_[1]->res->body('chained_zero2') } sub chained_zero_post3 : Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero_post3') } sub chained_zero3 : Chained(chain_base2) PathPart('') Args(1) { $_[1]->res->body('chained_zero3') } sub heart :Local Args(Heart) { } sub utf8_base :Chained(/) CaptureArgs(Heart) { } sub utf8_end :Chained(utf8_base) PathPart('') Args(Heart) { } sub default :Default { my ($self, $c, $int) = @_; $c->res->body('default'); } MyApp::Controller::Root->config(namespace=>''); package MyApp::Controller::Autoclean; $INC{'MyApp/Controller/Autoclean.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; use namespace::autoclean -except => 'Int'; use MyApp::Types qw/Int/; extends 'Catalyst::Controller'; sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (autoclean)'); } MyApp::Controller::Autoclean->config(namespace=>'autoclean'); package MyApp::Role; $INC{'MyApp/Role.pm'} = __FILE__; use Moose::Role; use MooseX::MethodAttributes::Role; use MyApp::Types qw/Int/; sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } sub an_int_ns :Local Args(MyApp::Types::Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } package MyApp::BaseController; $INC{'MyApp/BaseController.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; use MyApp::Types qw/Int/; extends 'Catalyst::Controller'; sub from_parent :Local Args(Int) { my ($self, $c, $id) = @_; $c->res->body("from_parent $id"); } package MyApp::Controller::WithRole; $INC{'MyApp/Controller/WithRole.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'MyApp::BaseController'; with 'MyApp::Role'; MyApp::Controller::WithRole->config(namespace=>'withrole'); package MyApp; use Catalyst; MyApp->setup; } use Catalyst::Test 'MyApp'; { my $res = request '/an_int/1'; is $res->content, 'an_int'; } { my $res = request '/an_int/aa'; is $res->content, 'default'; } { my $res = request '/many_ints/1'; is $res->content, 'many_ints'; } { my $res = request '/many_ints/1/2'; is $res->content, 'many_ints'; } { my $res = request '/many_ints/1/2/3'; is $res->content, 'many_ints'; } { my $res = request '/priority_test/1'; is $res->content, 'int_priority'; } { my $res = request '/priority_test/a'; is $res->content, 'any_priority'; } { my $res = request '/match/11-22-33'; is $res->content, 'match'; } { my $res = request '/match/aaa'; is $res->content, 'default'; } { my $res = request '/user/2'; is $res->content, 'name: mary, age: 36'; } { my $res = request '/user/20'; is $res->content, 'default'; } SKIP: { skip "coercion support needs more thought", 1; my $res = request '/user_object/20'; is $res->content, 'default'; } SKIP: { skip "coercion support needs more thought", 1; my $res = request '/user_object/2'; is $res->content, 'name: mary, age: 36'; } { my $res = request '/chain_base/capture/arg'; is $res->content, 'any_priority_chain'; } { my $res = request '/chain_base/cap1/100/arg'; is $res->content, 'any_priority_link'; } { my $res = request '/chain_base/cap1/101/102'; is $res->content, 'int_priority_link'; } { my $res = request '/chain_base/capture/100'; is $res->content, 'int_priority_chain', 'got expected'; } { my $res = request '/chain_base/cap1/a/arg'; is $res->content, 'any_priority_link_any'; } { my $res = request '/chain_base/cap1/a/102'; is $res->content, 'int_priority_link_any'; } { my $res = request '/two_ints/1/2'; is $res->content, 'two_ints'; } { my $res = request '/two_ints/aa/111'; is $res->content, 'default'; } { my $res = request '/tuple/aaa/aaa'; is $res->content, 'default'; } { my $res = request '/tuple/aaa/111'; is $res->content, 'tuple'; } { my $res = request '/tuple/aaa/111/111/111'; is $res->content, 'default'; } { my $res = request '/slurpy_tuple/aaa/111/111/111'; is $res->content, 'tuple'; } { my $res = request '/many_ints/1/2/a'; is $res->content, 'default'; } { my $res = request '/chain_base/100/100/100/100'; is $res->content, 'int_priority_link2'; } { my $res = request '/chain_base/100/ss/100/100'; is $res->content, 'default'; } { my $res = request '/chain_base/100/100/100/100/100'; is $res->content, 'int_priority_link3'; } { my $res = request '/chain_base/100/ss/100/100/100'; is $res->content, 'default'; } { my $res = request '/chain_base/1/2/3/3/3/6'; is $res->content, 'finally'; } { my $res = request '/chain_base/1/2/3/3/3/a'; is $res->content, 'finally2'; } { my $res = request '/chain_base/1/2/3/3/3/6/7/8/9'; is $res->content, 'finally2'; } { my $res = request PUT '/chain_base2/capture/1'; is $res->content, 'chained_zero3', "request PUT '/chain_base2/capture/1'"; } { my $res = request '/chain_base2/capture/1'; is $res->content, 'chained_zero3', "request '/chain_base2/capture/1'"; } { my $res = request POST '/chain_base2/capture/1'; is $res->content, 'chained_zero3', "request POST '/chain_base2/capture/1'"; } { my $res = request PUT '/chain_base2/capture'; is $res->content, 'chained_zero2', "request PUT '/chain_base2/capture'"; } { my $res = request '/chain_base2/capture'; is $res->content, 'chained_zero2', "request '/chain_base2/capture'"; } { my $res = request POST '/chain_base2/capture'; is $res->content, 'chained_zero2', "request POST '/chain_base2/capture'"; } { my $res = request '/stringy_enum/1/2'; is $res->content, 'enum', "request '/stringy_enum/a'"; } { my $res = request '/stringy_enum/b/2'; is $res->content, 'default', "request '/stringy_enum/a'"; } { my $res = request '/stringy_enum/1/a'; is $res->content, 'default', "request '/stringy_enum/a'"; } =over | /chain_base/*/*/*/*/*/* | /chain_base (1) | | -> /link_tuple (Tuple[Int,Int,Int]) | | -> /link2_int (UserId) | | => GET /finally (Int) =cut { # URI testing my ($res, $c) = ctx_request '/'; { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('user'), 2) }; is $url, 'http://localhost/user/2'; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('user'), [2]) }; is $url, 'http://localhost/user/2'; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('user'), [20]) }; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,4],6) }; is $url, 'http://localhost/chain_base/1/2/3/4/4/6'; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,4,6]) }; is $url, 'http://localhost/chain_base/1/2/3/4/4/6'; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), [1,2,3,4,5,6]) }; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a',2,3,4,4,6]) }; is $url, 'http://localhost/chain_base/a/2/3/4/4/6'; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a','1',3,4,4,'a']) }; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('finally'), ['a','a',3,4,4,'6']) }; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('heart'), ['♥']) }; is $url, 'http://localhost/heart/%E2%99%A5'; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('heart'), ['1']) }; } { ok my $url = eval { $c->uri_for($c->controller('Root')->action_for('utf8_end'), ['♥','♥']) }; is $url, 'http://localhost/utf8_base/%E2%99%A5/%E2%99%A5'; } { ok my $url = ! eval { $c->uri_for($c->controller('Root')->action_for('utf8_end'), ['2','1']) }; } } # Test Roles { my $res = request '/role_test/1'; is $res->content, 'role_int1'; } { my $res = request '/role_test/a'; is $res->content, 'role_stra'; } { my $res = request '/autoclean/an_int/1'; is $res->content, 'an_int (autoclean)'; } { my $res = request '/withrole/an_int_ns/S'; is $res->content, 'default'; } { my $res = request '/withrole/an_int_ns/111'; is $res->content, 'an_int (withrole)'; } { my $res = request '/withrole/an_int/1'; is $res->content, 'an_int (withrole)'; } { my $res = request '/withrole/from_parent/1'; is $res->content, 'from_parent 1'; } done_testing; Catalyst-Runtime-5.90115/t/args-empty-parens-bug.t000644 000765 000024 00000001247 12700516273 023730 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use FindBin qw< $Bin >; use lib "$Bin/lib"; use constant App => 'TestAppArgsEmptyParens'; use Catalyst::Test App; { my $res = request('/chain_base/args/foo/bar'); is $res->content, 'Args', "request '/chain_base/args/foo/bar'"; } { my $res = request('/chain_base/args_empty/foo/bar'); is $res->content, 'Args()', "request '/chain_base/args_empty/foo/bar'"; } eval { App->dispatcher->dispatch_type('Chained')->list(App) }; ok !$@, "didn't die" or diag "Died with: $@"; like $TestLogger::LOGS[-1], qr{chain_base\/args\/\.\.\.}; like $TestLogger::LOGS[-1], qr{chain_base\/args_empty\/\.\.\.}; done_testing; __END__ Catalyst-Runtime-5.90115/t/args0_bug.t000644 000765 000024 00000005103 12520162327 021440 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub chain_base :Chained(/) CaptureArgs(1) { } sub chained_one_args_0 : Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('chained_one_args_0') } sub chained_one_args_1 : Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('chained_one_args_1') } sub chained_one_args_2 : Chained(chain_base) PathPart('') Args(1) { $_[1]->res->body('chained_one_args_2') } sub chained_zero_args_0 : Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero_args_0') } sub chained_zero_args_1 : Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero_args_1') } sub chained_zero_args_2 : Chained(chain_base) PathPart('') Args(0) { $_[1]->res->body('chained_zero_args_2') } MyApp::Controller::Root->config(namespace=>''); package MyApp; use Catalyst; #MyApp->config(use_chained_args_0_special_case=>1); MyApp->setup; } =over [debug] Loaded Chained actions: .-----------------------------------------+---------------------------------------------------. | Path Spec | Private | +-----------------------------------------+---------------------------------------------------+ | /chain_base/*/* | /chain_base (1) | | | => /chained_one_args_0 (1) | | /chain_base/*/* | /chain_base (1) | | | => /chained_one_args_1 (1) | | /chain_base/* | /chain_base (1) | | | => /chained_zero_args_0 (0) | | /chain_base/* | /chain_base (1) | | | => /chained_zero_args_1 (0) | '-----------------------------------------+---------------------------------------------------' =cut use Catalyst::Test 'MyApp'; { my $res = request '/chain_base/capturearg/arg'; is $res->content, 'chained_one_args_2', "request '/chain_base/capturearg/arg'"; } { my $res = request '/chain_base/capturearg'; is $res->content, 'chained_zero_args_2', "request '/chain_base/capturearg'"; } done_testing; __END__ Catalyst-Runtime-5.90115/t/author/000755 000765 000024 00000000000 13101661740 020704 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/bad_middleware_error.t000644 000765 000024 00000000405 12406561462 023731 0ustar00jnapiorkowskistaff000000 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.90115/t/bad_warnings.t000644 000765 000024 00000003005 12700516273 022227 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; # In DEBUG mode, we get not a number warnigs my $error; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub root :Chained(/) PathPrefix CaptureArgs(0) { } sub test :Chained(root) Args('"Int"') { my ($self, $c) = @_; $c->response->body("This is the body"); } sub infinity :Chained(root) PathPart('test') Args { my ($self, $c) = @_; $c->response->body("This is the body"); Test::More::is $c->action->comparable_arg_number, ~0; } sub midpoint :Chained(root) PathPart('') CaptureArgs('"Int"') { my ($self, $c) = @_; Test::More::is $c->action->number_of_captures, 1; #Test::More::is $c->action->number_of_captures_constraints, 1; } sub endpoint :Chained('midpoint') Args('"Int"') { my ($self, $c) = @_; Test::More::is $c->action->comparable_arg_number, 1; Test::More::is $c->action->normalized_arg_number, 1; } sub local :Local Args { my ($self, $c) = @_; $c->response->body("This is the body"); Test::More::is $c->action->comparable_arg_number, ~0; } package MyApp; use Catalyst; sub debug { 1 } $SIG{__WARN__} = sub { $error = shift }; MyApp->setup; } use Catalyst::Test 'MyApp'; request GET '/root/test/a/b/c'; request GET '/root/local/a/b/c'; request GET '/root/11/endpoint/22'; if($error) { unlike($error, qr[Argument ""Int"" isn't numeric in repeat]); } else { ok 1; } done_testing(6); Catalyst-Runtime-5.90115/t/body_fh.t000644 000765 000024 00000005303 12572364356 021220 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI; use Plack::Util; # Test case to check that we now send scalar and filehandle like # bodys directly to the PSGI engine, rather than call $writer->write # or unroll the filehandle ourselves. { package MyApp::Controller::Root; use base 'Catalyst::Controller'; sub flat_response :Local { my $response = 'Hello flat_response'; pop->res->body($response); } sub memory_stream :Local { my $response = 'Hello memory_stream'; open my $fh, '<', \$response || die "$!"; pop->res->body($fh); } sub manual_write_fh :Local { my ($self, $c) = @_; my $response = 'Hello manual_write_fh'; my $writer = $c->res->write_fh; $writer->write($response); $writer->close; } sub manual_write :Local { my ($self, $c) = @_; $c->res->write('Hello'); $c->res->body('manual_write'); } $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry... package MyApp; use Catalyst; } ok(MyApp->setup); ok(my $psgi = MyApp->psgi_app); { ok(my $env = req_to_psgi(GET '/root/flat_response')); ok(my $psgi_response = $psgi->($env)); $psgi_response->(sub { my $response_tuple = shift; my ($status, $headers, $body) = @$response_tuple; ok $status; ok $headers; is $body->[0], 'Hello flat_response'; }); } { ok(my $env = req_to_psgi(GET '/root/memory_stream')); ok(my $psgi_response = $psgi->($env)); $psgi_response->(sub { my $response_tuple = shift; my ($status, $headers, $body) = @$response_tuple; ok $status; ok $headers; is ref($body), 'GLOB'; }); } { ok(my $env = req_to_psgi(GET '/root/manual_write_fh')); ok(my $psgi_response = $psgi->($env)); $psgi_response->(sub { my $response_tuple = shift; my ($status, $headers, $body) = @$response_tuple; ok $status; ok $headers; ok !$body; return Plack::Util::inline_object( write => sub { is shift, 'Hello manual_write_fh' }, close => sub { ok 1, 'closed' }, ); }); } { ok(my $env = req_to_psgi(GET '/root/manual_write')); ok(my $psgi_response = $psgi->($env)); $psgi_response->(sub { my $response_tuple = shift; my ($status, $headers, $body) = @$response_tuple; ok $status; ok $headers; ok !$body; my @expected = (qw/Hello manual_write/); return Plack::Util::inline_object( close => sub { ok 1, 'closed'; is scalar(@expected), 0; }, write => sub { is shift, shift(@expected) }, ); }); } ## We need to specify the number of expected tests because tests that live ## in the callbacks might never get run (thus all ran tests pass but not all ## required tests run). done_testing(28); Catalyst-Runtime-5.90115/t/catalyst_130pix.gif000644 000765 000024 00000013105 12406561462 023030 0ustar00jnapiorkowskistaff000000 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.90115/t/class_traits.t000644 000765 000024 00000002660 12732015445 022272 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use Class::MOP; BEGIN { package TestRole; $INC{'TestRole'} = __FILE__; use Moose::Role; sub a { 'a' } sub b { 'b' } package Catalyst::TraitFor::Request::Foo; $INC{'Catalyst/TraitFor/Request/Foo.pm'} = __FILE__; use Moose::Role; sub c { 'c' } package TestApp::TraitFor::Request::Bar; $INC{'TestApp/TraitFor/Request/Bar.pm'} = __FILE__; use Moose::Role; sub d { 'd' } package Catalyst::TraitFor::Response::Foo; $INC{'Catalyst/TraitFor/Response/Foo.pm'} = __FILE__; use Moose::Role; sub c { 'c' } package TestApp::TraitFor::Response::Bar; $INC{'TestApp/TraitFor/Response/Bar.pm'} = __FILE__; use Moose::Role; sub d { 'd' } } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; __PACKAGE__->request_class_traits([qw/TestRole Foo Bar/]); __PACKAGE__->response_class_traits([qw/TestRole Foo Bar/]); __PACKAGE__->stats_class_traits([qw/TestRole/]); __PACKAGE__->setup; } foreach my $class_prefix (qw/request response stats/) { my $method = 'composed_' .$class_prefix. '_class'; ok( Class::MOP::class_of(TestApp->$method)->does_role('TestRole'), "$method does TestRole", ); } use Catalyst::Test 'TestApp'; my ($res, $c) = ctx_request '/'; is $c->req->a, 'a'; is $c->req->b, 'b'; is $c->req->c, 'c'; is $c->req->d, 'd'; is $c->res->a, 'a'; is $c->res->b, 'b'; is $c->res->c, 'c'; is $c->res->d, 'd'; done_testing; Catalyst-Runtime-5.90115/t/class_traits_CAR_bug.t000644 000765 000024 00000002347 12737046551 023625 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use Class::MOP; BEGIN { use Test::More; eval "use Catalyst::Action::REST; 1" || do { plan skip_all => "Trouble loading Catalyst::Action::REST => $@"; }; } BEGIN { package TestRole; $INC{'TestRole'} = __FILE__; use Moose::Role; sub a { 'a' } sub b { 'b' } package Catalyst::TraitFor::Request::Foo; $INC{'Catalyst/TraitFor/Request/Foo.pm'} = __FILE__; use Moose::Role; sub c { 'c' } package TestApp::TraitFor::Request::Bar; $INC{'TestApp/TraitFor/Request/Bar.pm'} = __FILE__; use Moose::Role; sub d { 'd' } package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; __PACKAGE__->request_class_traits([qw/TestRole Foo Bar/]); __PACKAGE__->setup; } foreach my $class_prefix (qw/request/) { my $method = 'composed_' .$class_prefix. '_class'; ok( Class::MOP::class_of(TestApp->$method)->does_role('TestRole'), "$method does TestRole", ); } use Catalyst::Test 'TestApp'; my ($res, $c) = ctx_request '/'; is $c->req->a, 'a'; is $c->req->b, 'b'; is $c->req->c, 'c'; is $c->req->d, 'd'; done_testing; Catalyst-Runtime-5.90115/t/conf/000755 000765 000024 00000000000 13101661740 020327 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/configured_comps.t000644 000765 000024 00000005402 12520162327 023117 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use HTTP::Request::Common; use Test::More; { package TestRole; use Moose::Role; sub role { 'role' } package Local::Model::Foo; use Moose; extends 'Catalyst::Model'; has a => (is=>'ro', required=>1); has b => (is=>'ro'); sub foo { shift->a . 'foo' } package Local::Controller::Errors; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; has ['a', 'b'] => (is=>'ro', required=>1); sub not_found :Local { pop->res->from_psgi_response([404, [], ['Not Found']]) } package MyApp::Model::User; $INC{'MyApp/Model/User.pm'} = __FILE__; use Moose; extends 'Catalyst::Model'; has 'zoo' => (is=>'ro', required=>1, isa=>'Object'); around 'COMPONENT', sub { my ($orig, $class, $app, $config) = @_; $config->{zoo} = $app->model('Zoo'); return $class->$orig($app, $config); }; our %users = ( 1 => { name => 'john', age => 46 }, 2 => { name => 'mary', age => 36 }, 3 => { name => 'ian', age => 25 }, 4 => { name => 'visha', age => 18 }, ); sub find { my ($self, $id) = @_; my $user = $users{$id} || return; return bless $user, "MyApp::Model::User::user"; } package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub user :Local Args(1) { my ($self, $c, $int) = @_; Test::More::ok(my $user = $c->model("User")->find($int)); Test::More::is($c->model("User")->zoo->a, 2); Test::More::is($c->model("Foo")->role, 'role'); Test::More::is($c->model("One")->a, 'one'); Test::More::is($c->model("Two")->a, 'two'); $c->res->body("name: $user->{name}, age: $user->{age}"); } sub default :Default { my ($self, $c, $int) = @_; $c->res->body('default'); } MyApp::Controller::Root->config(namespace=>''); package MyApp; use Catalyst; MyApp->inject_components( 'Model::One' => { from_component => 'Local::Model::Foo' }, 'Model::Two' => { from_component => 'Local::Model::Foo' }, ); MyApp->config({ inject_components => { 'Controller::Err' => { from_component => 'Local::Controller::Errors' }, 'Model::Zoo' => { from_component => 'Local::Model::Foo' }, 'Model::Foo' => { from_component => 'Local::Model::Foo', roles => ['TestRole'] }, }, 'Controller::Err' => { a => 100, b => 200, namespace => 'error' }, 'Model::Zoo' => { a => 2 }, 'Model::Foo' => { a => 100 }, 'Model::One' => { a => 'one' }, 'Model::Two' => { a => 'two' }, }); MyApp->setup; } use Catalyst::Test 'MyApp'; { my $res = request '/user/1'; is $res->content, 'name: john, age: 46'; } { my $res = request '/error/not_found'; is $res->content, 'Not Found'; } done_testing; Catalyst-Runtime-5.90115/t/consumes.t000644 000765 000024 00000002311 12453066027 021426 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; # Test case for reported issue when an action consumes JSON but a # POST sends nothing we get a hard error { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub bar :Local Args(0) POST Consumes(JSON) { my( $self, $c ) = @_; my $foo = $c->req->body_data; } sub end :Private { my( $self, $c ) = @_; my $body = $c->shift_errors; $c->res->body( $body || "No errors"); } package MyApp; use Catalyst; MyApp->setup; } use HTTP::Request::Common; use Catalyst::Test 'MyApp'; { # Test to send no post ok my $res = request POST 'root/bar', 'Content-Type' => 'application/json'; like $res->content, qr"Error Parsing POST 'undef'"; } { # Test to send bad (malformed JSON) post ok my $res = request POST 'root/bar', 'Content-Type' => 'application/json', 'Content' => 'i am not JSON'; like $res->content, qr/Error Parsing POST 'i am not JSON'/; } { # Test to send bad (malformed JSON) post ok my $res = request POST 'root/bar', 'Content-Type' => 'application/json', 'Content' => '{ "a":"b" }'; is $res->content, 'No errors'; } done_testing(); Catalyst-Runtime-5.90115/t/content_negotiation.t000644 000765 000024 00000004725 12406561462 023660 0ustar00jnapiorkowskistaff000000 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.90115/t/custom_exception_class_simple.t000644 000765 000024 00000000455 12406561462 025730 0ustar00jnapiorkowskistaff000000 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.90115/t/data_handler.t000644 000765 000024 00000001477 12406561462 022215 0ustar00jnapiorkowskistaff000000 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.90115/t/dead_load_bad_args.t000644 000765 000024 00000003627 12520162327 023316 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More; # This test needs to be rewritten (and the code it was using as well) since # when we added the arg and capturearg type constraint support, we now allow # non integer values. however we could probably support some additional sanity # testing on the values, so this is a nice TODO for someone -jnap plan skip_all => 'Removing this test because constraint arg types allow this'; 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.90115/t/dead_load_multiple_chained_attributes.t000644 000765 000024 00000001023 12406561462 027322 0ustar00jnapiorkowskistaff000000 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.90115/t/dead_no_unknown_error.t000755 000765 000024 00000000324 12406561462 024161 0ustar00jnapiorkowskistaff000000 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.90115/t/dead_recursive_chained_attributes.t000644 000765 000024 00000002030 12406561462 026476 0ustar00jnapiorkowskistaff000000 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.90115/t/deprecated.t000644 000765 000024 00000002244 12406561462 021700 0ustar00jnapiorkowskistaff000000 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.90115/t/deprecated_appclass_action_warnings.t000644 000765 000024 00000000734 12406561462 027035 0ustar00jnapiorkowskistaff000000 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.90115/t/dispatch_on_scheme.t000644 000765 000024 00000006162 12454003036 023411 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; # Test cases for dispatching on URI Scheme { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub is_http :Path(scheme) Scheme(http) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'http'; $c->response->body("is_http"); } sub is_https :Path(scheme) Scheme(https) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'https'; $c->response->body("is_https"); } sub base :Chained('/') CaptureArgs(0) { } sub is_http_chain :GET Chained('base') PathPart(scheme) Scheme(http) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'http'; $c->response->body("base/is_http"); } sub is_https_chain :Chained('base') PathPart(scheme) Scheme(https) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'https'; $c->response->body("base/is_https"); } sub uri_for1 :Chained('base') Scheme(https) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'https'; $c->response->body($c->uri_for($c->action)->as_string); } sub uri_for2 :Chained('base') Scheme(https) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'https'; $c->response->body($c->uri_for($self->action_for('is_http'))->as_string); } sub uri_for3 :Chained('base') Scheme(http) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'http'; $c->response->body($c->uri_for($self->action_for('endpoint'))->as_string); } sub base2 :Chained('/') CaptureArgs(0) { } sub link :Chained(base2) Scheme(https) CaptureArgs(0) { } sub endpoint :Chained(link) Args(0) { my ($self, $c) = @_; Test::More::is $c->action->scheme, 'https'; $c->response->body("end"); } package MyApp; use Catalyst; Test::More::ok(MyApp->setup, 'setup app'); } use Catalyst::Test 'MyApp'; { my $res = request "/root/scheme"; is $res->code, 200, 'OK'; is $res->content, 'is_http', 'correct body'; } { my $res = request "https://localhost/root/scheme"; is $res->code, 200, 'OK'; is $res->content, 'is_https', 'correct body'; } { my $res = request "/base/scheme"; is $res->code, 200, 'OK'; is $res->content, 'base/is_http', 'correct body'; } { my $res = request "https://localhost/base/scheme"; is $res->code, 200, 'OK'; is $res->content, 'base/is_https', 'correct body'; } { my $res = request "https://localhost/base/uri_for1"; is $res->code, 200, 'OK'; is $res->content, 'https://localhost/base/uri_for1', 'correct body'; } { my $res = request "https://localhost/base/uri_for2"; is $res->code, 200, 'OK'; is $res->content, 'http://localhost/root/scheme', 'correct body'; } { my $res = request "/base/uri_for3"; is $res->code, 200, 'OK'; is $res->content, 'https://localhost/base2/link/endpoint', 'correct body'; } { my $res = request "https://localhost/base2/link/endpoint"; is $res->code, 200, 'OK'; is $res->content, 'end', 'correct body'; } done_testing; Catalyst-Runtime-5.90115/t/encoding_set_in_app.t000644 000765 000024 00000000471 12406561462 023567 0ustar00jnapiorkowskistaff000000 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.90115/t/encoding_set_in_config.t000644 000765 000024 00000000676 12406561462 024263 0ustar00jnapiorkowskistaff000000 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.90115/t/evil_stash.t000644 000765 000024 00000001322 13024565465 021741 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub root :Path('') Args(0) { my ($self, $c) = @_; $c->{stash}->{foo} = 'bar'; $c->stash(baz=>'boor'); $c->{stash}->{baz} = $c->stash->{baz} . 2; Test::More::is($c->stash->{foo}, 'bar'); Test::More::is($c->stash->{baz}, 'boor2'); Test::More::is($c->{stash}->{foo}, 'bar'); Test::More::is($c->{stash}->{baz}, 'boor2'); $c->res->body('return'); } package MyApp; use Catalyst; MyApp->setup; } use HTTP::Request::Common; use Catalyst::Test 'MyApp'; { ok my $res = request POST 'root/'; } done_testing(); Catalyst-Runtime-5.90115/t/execute_exception.t000644 000765 000024 00000002326 12726031515 023315 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; MyApp::Controller::Root->config(namespace=>''); sub could_throw :Private { my ($self, $c) = @_; if ($c->req->args->[0] eq 'y') { die 'Bad stuff happened'; } else { return 5; } } sub do_throw :Local { my ($self, $c) = @_; my $ret = $c->forward('/could_throw/y'); Test::More::is($c->state, 0, 'Throwing: state is correct'); Test::More::is($ret, 0, 'Throwing: return is correct'); Test::More::ok($c->has_errors, 'Throwing: has errors'); } sub dont_throw :Local { my ($self, $c) = @_; my $ret = $c->forward('/could_throw/n'); Test::More::is($c->state, 5, 'Not throwing: state is correct'); Test::More::is($ret, 5, 'Not throwing: return is correct'); Test::More::ok(!$c->has_errors, 'Throwing: no errors'); } package MyApp; use Catalyst; MyApp->config(show_internal_actions=>1); MyApp->setup; } use Catalyst::Test 'MyApp'; { my ($res, $c); ctx_request("/dont_throw"); ctx_request("/do_throw"); ctx_request("/dont_throw"); } done_testing; Catalyst-Runtime-5.90115/t/head_middleware.t000644 000765 000024 00000002204 12406561462 022672 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; use Plack::Test; # Test to make sure we the order of some middleware is correct. Basically # we want to make sure that if the request is a HEAD we properly remove the # body BUT not so quickly that we fail to calculate the length. This test # exists mainly to prevent regressions. { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub test :Local { my ($self, $c) = @_; $c->response->body("This is the body"); } package MyApp; use Catalyst; Test::More::ok(MyApp->setup, 'setup app'); } ok my $psgi = MyApp->psgi_app, 'build psgi app'; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/test"); is $res->code, 200, 'OK'; is $res->content, 'This is the body', 'correct body'; is $res->content_length, 16, 'correct length'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(HEAD "/root/test"); is $res->code, 200, 'OK'; is $res->content, '', 'correct body'; is $res->content_length, 16, 'correct length'; }; done_testing; Catalyst-Runtime-5.90115/t/http_exceptions.t000644 000765 000024 00000006344 12435153520 023017 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI; use Plack::Util; use Plack::Test; # Test to make sure we let HTTP style exceptions bubble up to the middleware # rather than catching them outselves. { package MyApp::Exception; sub new { my ($class, $code, $headers, $body) = @_; return bless +{res => [$code, $headers, $body]}, $class; } sub throw { die shift->new(@_) } sub as_psgi { my ($self, $env) = @_; my ($code, $headers, $body) = @{$self->{res}}; return [$code, $headers, $body]; # for now return sub { my $responder = shift; $responder->([$code, $headers, $body]); }; } package MyApp::AnotherException; sub new { bless +{}, shift } sub code { 400 } sub as_string { 'bad stringy bad' } package MyApp::Controller::Root; use base 'Catalyst::Controller'; my $psgi_app = sub { my $env = shift; die MyApp::Exception->new( 404, ['content-type'=>'text/plain'], ['Not Found']); }; sub from_psgi_app :Local { my ($self, $c) = @_; $c->res->from_psgi_response( $psgi_app->( $c->req->env)); } sub from_catalyst :Local { my ($self, $c) = @_; MyApp::Exception->throw( 403, ['content-type'=>'text/plain'], ['Forbidden']); } sub from_code_type :Local { my $e = MyApp::AnotherException->new; die $e; } sub classic_error :Local { my ($self, $c) = @_; Catalyst::Exception->throw("Ex Parrot"); } sub just_die :Local { my ($self, $c) = @_; die "I'm not dead yet"; } sub end :Private { die "We should never hit end for HTTPExceptions" } package MyApp; use Catalyst; MyApp->config(abort_chain_on_error_fix=>1); sub debug { 1 } MyApp->setup_log('fatal'); } $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry... MyApp->setup_log('error'); Test::More::ok(MyApp->setup); ok my $psgi = MyApp->psgi_app; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_psgi_app"); is $res->code, 404; is $res->content, 'Not Found', 'NOT FOUND'; unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_catalyst"); is $res->code, 403; is $res->content, 'Forbidden', 'Forbidden'; unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_code_type"); is $res->code, 400; is $res->content, 'bad stringy bad', 'bad stringy bad'; unlike $res->content, qr'HTTPExceptions', 'HTTPExceptions'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/classic_error"); is $res->code, 500; like $res->content, qr'Ex Parrot', 'Ex Parrot'; like $res->content, qr'HTTPExceptions', 'HTTPExceptions'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/just_die"); is $res->code, 500; like $res->content, qr'not dead yet', 'not dead yet'; like $res->content, qr'HTTPExceptions', 'HTTPExceptions'; }; # We need to specify the number of expected tests because tests that live # in the callbacks might never get run (thus all ran tests pass but not all # required tests run). done_testing(17); Catalyst-Runtime-5.90115/t/http_exceptions_backcompat.t000644 000765 000024 00000005661 12451546667 025224 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI; use Plack::Util; use Plack::Test; # Test to make sure HTTP style exceptions do NOT bubble up to the middleware # if the backcompat setting 'always_catch_http_exceptions' is enabled. { package MyApp::Exception; sub new { my ($class, $code, $headers, $body) = @_; return bless +{res => [$code, $headers, $body]}, $class; } sub throw { die shift->new(@_) } sub as_psgi { my ($self, $env) = @_; my ($code, $headers, $body) = @{$self->{res}}; return [$code, $headers, $body]; # for now return sub { my $responder = shift; $responder->([$code, $headers, $body]); }; } package MyApp::AnotherException; sub new { bless +{}, shift } sub code { 400 } sub as_string { 'bad stringy bad' } package MyApp::Controller::Root; use base 'Catalyst::Controller'; my $psgi_app = sub { my $env = shift; die MyApp::Exception->new( 404, ['content-type'=>'text/plain'], ['Not Found']); }; sub from_psgi_app :Local { my ($self, $c) = @_; $c->res->from_psgi_response( $psgi_app->( $c->req->env)); } sub from_catalyst :Local { my ($self, $c) = @_; MyApp::Exception->throw( 403, ['content-type'=>'text/plain'], ['Forbidden']); } sub from_code_type :Local { my $e = MyApp::AnotherException->new; die $e; } sub classic_error :Local { my ($self, $c) = @_; Catalyst::Exception->throw("Ex Parrot"); } sub just_die :Local { my ($self, $c) = @_; die "I'm not dead yet"; } package MyApp; use Catalyst; MyApp->config( abort_chain_on_error_fix=>1, always_catch_http_exceptions=>1, ); sub debug { 1 } MyApp->setup_log('fatal'); } $INC{'MyApp/Controller/Root.pm'} = __FILE__; # sorry... MyApp->setup_log('error'); Test::More::ok(MyApp->setup); ok my $psgi = MyApp->psgi_app; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_psgi_app"); is $res->code, 500; like $res->content, qr/MyApp::Exception=HASH/; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_catalyst"); is $res->code, 500; like $res->content, qr/MyApp::Exception=HASH/; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/from_code_type"); is $res->code, 500; like $res->content, qr/MyApp::AnotherException=HASH/; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/classic_error"); is $res->code, 500; like $res->content, qr'Ex Parrot', 'Ex Parrot'; }; test_psgi $psgi, sub { my $cb = shift; my $res = $cb->(GET "/root/just_die"); is $res->code, 500; like $res->content, qr'not dead yet', 'not dead yet'; }; # We need to specify the number of expected tests because tests that live # in the callbacks might never get run (thus all ran tests pass but not all # required tests run). done_testing(12); Catalyst-Runtime-5.90115/t/http_method.t000644 000765 000024 00000004113 12406561462 022114 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; plan skip_all => "Test Cases are Sketch for next release"; __END__ # Test case to check that we now send scalar and filehandle like # bodys directly to the PSGI engine, rather than call $writer->write # or unroll the filehandle ourselves. { package MyApp::Controller::User; use base 'Catalyst::Controller'; use JSON::MaybeXS; my %user = ( name => 'John', age => 44, ); sub get_user :Chained(/) PathPrefix CaptureArgs(0) { pop->stash(user=>\%user); } sub show :GET Chained(get_user) PathPart('') Args(0) { my ($self, $c) = @_; my $user = $c->stash->{user}; $c->res->format( 'application/json' => sub { encode_json $user }, 'text/html' => sub { "

Hi I'm $user->{name} and my age is $user->{age}

" } ); } sub post_user :POST Chained(root) PathPart('') Args(0) Consumes(HTMLForm,JSON) { my ($self, $c) = @_; %user = (%user, %{$c->req->body_data}); $c->res->status(201); $c->res->location($c->uri_for( $self->action_for('show'))); } $INC{'MyApp/Controller/User.pm'} = __FILE__; package MyApp; use Catalyst; use HTTP::Headers::ActionPack; my $cn = HTTP::Headers::ActionPack->new ->get_content_negotiator; sub Catalyst::Response::format { my $self = shift; my %formats = @_; my @formats = keys %formats; my $accept = $self->_context->req->header('Accept') || $format{default} || $_[0]; $self->headers->header('Vary' => 'Accept'); $self->headers->header('Accepts' => (join ',', @formats)); if(my $which = $cn->choose_media_type(\@formats, $accept)) { $self->content_type($which); if(my $possible_body = $formats{$which}->($self)) { $self->body($possible_body) unless $self->has_body || $self->has_write_fh; } } else { $self->status(406); $self->body("Method Not Acceptable"); } } MyApp->setup; } use HTTP::Request::Common; use Catalyst::Test 'MyApp'; ok my($res, $c) = ctx_request('/'); done_testing(); Catalyst-Runtime-5.90115/t/inject_component_util.t000644 000765 000024 00000003561 12526367136 024203 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/lib"; BEGIN { package RoleTest1; use Moose::Role; sub aaa { 'aaa' } $INC{'RoleTest1.pm'} = __FILE__; package RoleTest2; use Moose::Role; sub bbb { 'bbb' } $INC{'RoleTest2.pm'} = __FILE__; package Model::Banana; use base qw/Catalyst::Model/; $INC{'Model/Banana.pm'} = __FILE__; package Model::BananaMoose; use Moose; extends 'Catalyst::Model'; Model::BananaMoose->meta->make_immutable; $INC{'Model/BananaMoose.pm'} = __FILE__; } { package TestCatalyst; $INC{'TestCatalyst.pm'} = __FILE__; use Moose; use Catalyst; use Catalyst::Utils; after 'setup_components' => sub { my $self = shift; Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::Banana' ); Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Test::Apple' ); Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::Banana', as => 'Cherry' ); Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Model::BananaMoose', as => 'CherryMoose', traits => ['RoleTest1', 'RoleTest2'] ); Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Test::Apple', as => 'Apple' ); Catalyst::Utils::inject_component( into => __PACKAGE__, component => 'Test::Apple', as => 'Apple2', traits => ['RoleTest1', 'RoleTest2'] ); }; TestCatalyst->config( 'home' => '.' ); TestCatalyst->setup; } use Catalyst::Test qw/TestCatalyst/; ok( TestCatalyst->controller( $_ ) ) for qw/ Apple Test::Apple /; ok( TestCatalyst->model( $_ ) ) for qw/ Banana Cherry /; is( TestCatalyst->controller('Apple2')->aaa, 'aaa'); is( TestCatalyst->controller('Apple2')->bbb, 'bbb'); is( TestCatalyst->model('CherryMoose')->aaa, 'aaa'); is( TestCatalyst->model('CherryMoose')->bbb, 'bbb'); done_testing; Catalyst-Runtime-5.90115/t/lib/000755 000765 000024 00000000000 13101661740 020150 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/live_catalyst_test.t000644 000765 000024 00000003113 12406561462 023476 0ustar00jnapiorkowskistaff000000 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.90115/t/live_component_controller_context_closure.t000644 000765 000024 00000002054 12435153520 030355 0ustar00jnapiorkowskistaff000000 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 => 6; } 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); # FIXME: find out why this changed from 1 to 2 after 52af51596d # ^^ probably has something to do with env being in Engine and Request - JNAP # ^^ I made the env in Engine a weak ref, should help until we can remove it is($ctx->count_leaks, 1); } { my ($resp, $ctx) = ctx_request('/contextclosure/context_closure'); ok($resp->is_success); is($ctx->count_leaks, 0); } { my ($resp, $ctx) = ctx_request('/contextclosure/non_closure'); ok($resp->is_success); is($ctx->count_leaks, 0); } Catalyst-Runtime-5.90115/t/live_fork.t000644 000765 000024 00000003205 12406561462 021556 0ustar00jnapiorkowskistaff000000 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.90115/t/live_redirect_body.t000644 000765 000024 00000004715 12406561462 023442 0ustar00jnapiorkowskistaff000000 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.90115/t/live_show_internal_actions_warnings.t000644 000765 000024 00000001146 12406561462 027123 0ustar00jnapiorkowskistaff000000 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.90115/t/live_stats.t000644 000765 000024 00000001106 12406561462 021751 0ustar00jnapiorkowskistaff000000 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.90115/t/middleware-stash.t000644 000765 000024 00000003227 12572364356 023046 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; { package MyMiddleware; $INC{'MyMiddleware'} = __FILE__; our $INNER_VAR_EXPOSED; use base 'Plack::Middleware'; sub call { my ($self, $env) = @_; my $res = $self->app->($env); return $self->response_cb($res, sub{ my $inner = shift; $INNER_VAR_EXPOSED = $env->{inner_var_from_catalyst}; return; }); } package MyAppChild::Controller::User; $INC{'MyAppChild/Controller/User.pm'} = __FILE__; use base 'Catalyst::Controller'; use Test::More; sub stash :Local { my ($self, $c) = @_; $c->stash->{inner} = "inner"; $c->res->body( "inner: ${\$c->stash->{inner}}, outer: ${\$c->stash->{outer}}"); $c->req->env->{inner_var_from_catalyst} = 'station'; is_deeply [sort {$a cmp $b} keys(%{$c->stash})], ['inner','outer'], 'both keys in stash'; } package MyAppChild; $INC{'MyAppChild.pm'} = __FILE__; use Catalyst; MyAppChild->setup; package MyAppParent::Controller::User; $INC{'MyAppParent/Controller/User.pm'} = __FILE__; use base 'Catalyst::Controller'; use Test::More; sub stash :Local { my ($self, $c) = @_; $c->stash->{outer} = "outer"; $c->res->from_psgi_response( MyAppChild->to_app->($c->req->env) ); is_deeply [sort keys(%{$c->stash})], ['inner','outer']; } package MyAppParent; use Catalyst; MyAppParent->config(psgi_middleware=>['+MyMiddleware']); MyAppParent->setup; } use Test::More; use Catalyst::Test 'MyAppParent'; my $res = request '/user/stash'; is $res->content, 'inner: inner, outer: outer', 'got expected response'; is $MyMiddleware::INNER_VAR_EXPOSED, 'station', 'env does not get trampled'; done_testing; Catalyst-Runtime-5.90115/t/more-psgi-compat.t000644 000765 000024 00000002352 12435153347 022764 0ustar00jnapiorkowskistaff000000 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.90115/t/no_test_stash_bug.t000644 000765 000024 00000001004 12504614365 023303 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; # For reported: https://rt.cpan.org/Ticket/Display.html?id=97948 { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub example :Local Args(0) { pop->stash->{testing1} = 'testing2'; } package MyApp; use Catalyst; MyApp->setup; } use Test::More; use Catalyst::Test 'MyApp'; my ($res, $c) = ctx_request('/root/example'); is $c->stash->{testing1}, 'testing2', 'got expected stash value'; done_testing; Catalyst-Runtime-5.90115/t/not_utf8_query_bug.t000644 000765 000024 00000001700 12504614365 023424 0ustar00jnapiorkowskistaff000000 000000 use utf8; use warnings; use strict; # For reported: https://rt.cpan.org/Ticket/Display.html?id=103063 { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub example :Local Args(0) { pop->stash->{testing1} = 'testing2'; } package MyApp; use Catalyst; #MyApp->config(decode_query_using_global_encoding=>1, encoding => 'SHIFT_JIS'); #MyApp->config(do_not_decode_query=>1); #MyApp->config(decode_query_using_global_encoding=>1, encoding => undef); MyApp->config(default_query_encoding=>'SHIFT_JIS'); MyApp->setup; } use Test::More; use Catalyst::Test 'MyApp'; use Encode; use HTTP::Request::Common; { my $shiftjs = 'test テスト'; my $encoded = Encode::encode('SHIFT_JIS', $shiftjs); ok my $req = GET "/root/example?a=$encoded"; my ($res, $c) = ctx_request $req; is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value'; } done_testing; Catalyst-Runtime-5.90115/t/optional_apache-cgi-rewrite.pl000755 000765 000024 00000003006 12406561462 025315 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_apache-cgi.pl000755 000765 000024 00000002772 12406561462 023647 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_apache-fastcgi-non-root.pl000755 000765 000024 00000003035 12406561462 026267 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_apache-fastcgi.pl000755 000765 000024 00000003002 12406561462 024510 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_http-server-restart.t000644 000765 000024 00000007336 12406561462 025461 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_lighttpd-fastcgi-non-root.t000644 000765 000024 00000006401 12406561462 026512 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_lighttpd-fastcgi.t000644 000765 000024 00000006123 12406561462 024742 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_memleak.t000644 000765 000024 00000003527 12406561462 023125 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_stress.t000644 000765 000024 00000001466 12406561462 023035 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_stress.yml000644 000765 000024 00000007770 12406561462 023377 0ustar00jnapiorkowskistaff000000 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.90115/t/optional_threads.t000644 000765 000024 00000002362 12406561462 023140 0ustar00jnapiorkowskistaff000000 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.90115/t/path_action_empty_brackets.t000644 000765 000024 00000001704 12614434663 025170 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/lib"; use Test::More tests => 12; use Catalyst::Test 'TestPath'; { ok( my $response = request('http://localhost/one'), 'Request' ); ok( $response->is_success, '"Path" - Response Successful 2xx' ); is( $response->content, 'OK', '"Path" - Body okay' ); } { ok( my $response = request('http://localhost/two'), 'Request' ); ok( $response->is_success, '"Path()" - Response Successful 2xx' ); is( $response->content, 'OK', '"Path()" - Body okay' ); } { ok( my $response = request('http://localhost/three'), 'Request' ); ok( $response->is_success, '"Path(\'\')" - Response Successful 2xx' ); is( $response->content, 'OK', '"Path(\'\')" - Body okay' ); } { ok( my $response = request('http://localhost/four'), 'Request' ); ok( $response->is_success, '"Path(\'\')" - Response Successful 2xx' ); is( $response->content, 'OK', '"Path() Args()" - Body okay' ); }Catalyst-Runtime-5.90115/t/plack-middleware-config.t000644 000765 000024 00000002575 12406561462 024257 0ustar00jnapiorkowskistaff000000 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.90115/t/plack-middleware.t000644 000765 000024 00000003042 12475111327 022777 0ustar00jnapiorkowskistaff000000 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"; } { my $total_mw = scalar(TestMiddleware->registered_middlewares); TestMiddleware->setup_middleware; TestMiddleware->setup_middleware; my $post_mw = scalar(TestMiddleware->registered_middlewares); is $total_mw, $post_mw, 'Calling ->setup_middleware does not re-add default middleware'; } done_testing; Catalyst-Runtime-5.90115/t/plugin_new_method_backcompat.t000644 000765 000024 00000002404 12406561462 025471 0ustar00jnapiorkowskistaff000000 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.90115/t/psgi-log.t000644 000765 000024 00000005024 12502064643 021314 0ustar00jnapiorkowskistaff000000 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; } my $cmp = TestApp->debug ? '>=' : '=='; #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/info"); my @logs = $handle->logs; cmp_ok(scalar(@logs), $cmp, 1, "psgi.errors: one event output"); like($logs[0], qr/info$/m, "psgi.errors: event matches test data") unless TestApp->debug; }; }; #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/info"); cmp_ok(scalar(@logs), $cmp, 1, "psgix.logger: one event logged"); is(scalar(grep { $_->{level} eq 'info' and $_->{message} eq 'info' } @logs), 1, "psgix.logger: right stuff"); }; }; done_testing; Catalyst-Runtime-5.90115/t/psgi_file_testapp.t000644 000765 000024 00000001100 12406561462 023267 0ustar00jnapiorkowskistaff000000 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.90115/t/psgi_utils.t000644 000765 000024 00000023577 12475111327 021773 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; # Make it easier to mount PSGI apps under catalyst my $psgi_app = sub { my $req = Plack::Request->new(shift); return [200,[],[$req->path]]; }; { package MyApp::PSGIObject; sub as_psgi { return [200, ['Content-Type' => 'text/plain'], ['as_psgi']]; }; package MyApp::Controller::Docs; $INC{'MyApp/Controller/Docs.pm'} = __FILE__; use base 'Catalyst::Controller'; use Plack::Request; use Catalyst::Utils; sub as_psgi :Local { my ($self, $c) = @_; my $as_psgi = bless +{}, 'MyApp::PSGIObject'; $c->res->from_psgi_response($as_psgi); } sub name :Local { my ($self, $c) = @_; my $env = $c->Catalyst::Utils::env_at_action; $c->res->from_psgi_response( $psgi_app->($env)); } sub name_args :Local Args(1) { my ($self, $c, $arg) = @_; my $env = $c->Catalyst::Utils::env_at_action; $c->res->from_psgi_response( $psgi_app->($env)); } sub filehandle :Local { my ($self, $c, $arg) = @_; my $path = File::Spec->catfile('t', 'utf8.txt'); open(my $fh, '<', $path) || die "trouble: $!"; $c->res->from_psgi_response([200, ['Content-Type'=>'text/html'], $fh]); } sub direct :Local { my ($self, $c, $arg) = @_; $c->res->from_psgi_response([200, ['Content-Type'=>'text/html'], ["hello","world"]]); } package MyApp::Controller::User; $INC{'MyApp/Controller/User.pm'} = __FILE__; use base 'Catalyst::Controller'; use Plack::Request; use Catalyst::Utils; sub local_example :Local { my ($self, $c) = @_; my $env = $self->get_env($c); $c->res->from_psgi_response( $psgi_app->($env)); } sub local_example_args1 :Local Args(1) { my ($self, $c) = @_; my $env = $self->get_env($c); $c->res->from_psgi_response( $psgi_app->($env)); } sub path_example :Path('path-example') { my ($self, $c) = @_; my $env = $self->get_env($c); $c->res->from_psgi_response( $psgi_app->($env)); } sub path_example_args1 :Path('path-example-args1') { my ($self, $c) = @_; my $env = $self->get_env($c); $c->res->from_psgi_response( $psgi_app->($env)); } sub chained :Chained(/) PathPrefix CaptureArgs(0) { } sub from_chain :Chained('chained') PathPart('') CaptureArgs(0) {} sub end_chain :Chained('from_chain') PathPath(abc-123) Args(1) { my ($self, $c) = @_; my $env = $self->get_env($c); $c->res->from_psgi_response( $psgi_app->($env)); } sub mounted :Local Args(1) { my ($self, $c, $arg) = @_; our $app ||= ref($c)->psgi_app; my $env = $self->get_env($c); $c->res->from_psgi_response( $app->($env)); } sub mount_arg :Path(/mounted) Arg(1) { my ($self, $c, $arg) = @_; my $uri = $c->uri_for( $self->action_for('local_example_args1'),$arg); $c->res->body("$uri"); } sub mount_noarg :Path(/mounted_no_arg) { my ($self, $c) = @_; my $uri = $c->uri_for( $self->action_for('local_example_args1'),444); $c->res->body("$uri"); } sub get_env { my ($self, $c) = @_; if($c->req->query_parameters->{path_prefix}) { return $c->Catalyst::Utils::env_at_path_prefix; } elsif($c->req->query_parameters->{env_path}) { return $c->Catalyst::Utils::env_at_action; } elsif($c->req->query_parameters->{path}) { return $c->Catalyst::Utils::env_at_request_uri; } else { return $c->req->env; } } package MyApp; use Catalyst; MyApp->setup; } use Test::More; use Catalyst::Test 'MyApp'; { my ($res, $c) = ctx_request('/docs/as_psgi'); is $res->content, 'as_psgi'; } { my ($res, $c) = ctx_request('/user/mounted/111?path_prefix=1'); is $c->action, 'user/mounted'; is $res->content, 'http://localhost/user/user/local_example_args1/111'; is_deeply $c->req->args, [111]; } { my ($res, $c) = ctx_request('/user/mounted/mounted_no_arg?env_path=1'); is $c->action, 'user/mounted'; is $res->content, 'http://localhost/user/mounted/user/local_example_args1/444'; is_deeply $c->req->args, ['mounted_no_arg']; } # BEGIN [user/local_example] { my ($res, $c) = ctx_request('/user/local_example'); is $c->action, 'user/local_example'; is $res->content, '/user/local_example'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/local_example/111/222'); is $c->action, 'user/local_example'; is $res->content, '/user/local_example/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/local_example?path_prefix=1'); is $c->action, 'user/local_example'; is $res->content, '/local_example'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/local_example/111/222?path_prefix=1'); is $c->action, 'user/local_example'; is $res->content, '/local_example/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/local_example?env_path=1'); is $c->action, 'user/local_example'; is $res->content, '/'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/local_example/111/222?env_path=1'); is $c->action, 'user/local_example'; is $res->content, '/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/local_example?path=1'); is $c->action, 'user/local_example'; is $res->content, '/'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/local_example/111/222?path=1'); is $c->action, 'user/local_example'; is $res->content, '/'; is_deeply $c->req->args, [111,222]; } # END [user/local_example] # BEGIN [/user/local_example_args1/***/] { my ($res, $c) = ctx_request('/user/local_example_args1/333'); is $c->action, 'user/local_example_args1'; is $res->content, '/user/local_example_args1/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/local_example_args1/333?path_prefix=1'); is $c->action, 'user/local_example_args1'; is $res->content, '/local_example_args1/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/local_example_args1/333?env_path=1'); is $c->action, 'user/local_example_args1'; is $res->content, '/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/local_example_args1/333?path=1'); is $c->action, 'user/local_example_args1'; is $res->content, '/'; is_deeply $c->req->args, [333]; } # END [/user/local_example_args1/***/] # BEGIN [/user/path-example] { my ($res, $c) = ctx_request('/user/path-example'); is $c->action, 'user/path_example'; is $res->content, '/user/path-example'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/path-example?path_prefix=1'); is $c->action, 'user/path_example'; is $res->content, '/path-example'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/path-example?env_path=1'); is $c->action, 'user/path_example'; is $res->content, '/'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/path-example?path=1'); is $c->action, 'user/path_example'; is $res->content, '/'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/user/path-example/111/222'); is $c->action, 'user/path_example'; is $res->content, '/user/path-example/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/path-example/111/222?path_prefix=1'); is $c->action, 'user/path_example'; is $res->content, '/path-example/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/path-example/111/222?env_path=1'); is $c->action, 'user/path_example'; is $res->content, '/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/path-example/111/222?path=1'); is $c->action, 'user/path_example'; is $res->content, '/'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/user/path-example-args1/333'); is $c->action, 'user/path_example_args1'; is $res->content, '/user/path-example-args1/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/path-example-args1/333?path_prefix=1'); is $c->action, 'user/path_example_args1'; is $res->content, '/path-example-args1/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/path-example-args1/333?env_path=1'); is $c->action, 'user/path_example_args1'; is $res->content, '/333'; is_deeply $c->req->args, [333]; } { my ($res, $c) = ctx_request('/user/path-example-args1/333?path=1'); is $c->action, 'user/path_example_args1'; is $res->content, '/'; is_deeply $c->req->args, [333]; } # Chaining test /user/end_chain/* # # { my ($res, $c) = ctx_request('/user/end_chain/444'); is $c->action, 'user/end_chain'; is $res->content, '/user/end_chain/444'; is_deeply $c->req->args, [444]; } { my ($res, $c) = ctx_request('/user/end_chain/444?path_prefix=1'); is $c->action, 'user/end_chain'; is $res->content, '/end_chain/444'; is_deeply $c->req->args, [444]; } { my ($res, $c) = ctx_request('/user/end_chain/444?env_path=1'); is $c->action, 'user/end_chain'; is $res->content, '/444'; is_deeply $c->req->args, [444]; } { my ($res, $c) = ctx_request('/user/end_chain/444?path=1'); is $c->action, 'user/end_chain'; is $res->content, '/'; is_deeply $c->req->args, [444]; } { my ($res, $c) = ctx_request('/docs/name'); is $c->action, 'docs/name'; is $res->content, '/'; is_deeply $c->req->args, []; } { my ($res, $c) = ctx_request('/docs/name/111/222'); is $c->action, 'docs/name'; is $res->content, '/111/222'; is_deeply $c->req->args, [111,222]; } { my ($res, $c) = ctx_request('/docs/name_args/111'); is $c->action, 'docs/name_args'; is $res->content, '/111'; is_deeply $c->req->args, [111]; } { use utf8; use Encode; my ($res, $c) = ctx_request('/docs/filehandle'); is Encode::decode_utf8($res->content), "

This is stream_body_fh action ♥

\n"; } { my ($res, $c) = ctx_request('/docs/direct'); is $res->content, "helloworld"; } done_testing(); Catalyst-Runtime-5.90115/t/query_constraints.t000644 000765 000024 00000007224 12520162327 023371 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use HTTP::Request::Common; use utf8; BEGIN { use Test::More; eval "use Type::Tiny 1.000005; 1" || do { plan skip_all => "Trouble loading Type::Tiny and friends => $@"; }; } BEGIN { package MyApp::Types; $INC{'MyApp/Types.pm'} = __FILE__; use strict; use warnings; use Type::Utils -all; use Types::Standard -types; use Type::Library -base, -declare => qw( UserId Heart ); extends "Types::Standard"; declare UserId, as Int, where { $_ < 5 }; declare Heart, as Str, where { $_ eq '♥' }; } { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; use Types::Standard 'slurpy'; use MyApp::Types qw/Dict Tuple Int StrMatch HashRef ArrayRef Enum UserId Heart/; extends 'Catalyst::Controller'; sub user :Local Args(1) Query(page=>Int,user=>Tuple[Enum['a','b'],Int]) { my ($self, $c, $int) = @_; $c->res->body("page ${\$c->req->query_parameters->{page}}, user ${\$c->req->query_parameters->{user}[1]}"); } sub user_slurps :Local Args(1) Query(page=>Int,user=>Tuple[Enum['a','b'],Int],...) { my ($self, $c, $int) = @_; $c->res->body("page ${\$c->req->query_parameters->{page}}, user ${\$c->req->query_parameters->{user}[1]}"); } sub string_types :Local Query(q=>'Str',age=>'Int') { pop->res->body('string_type') } sub as_ref :Local Query(Dict[age=>Int,sex=>Enum['f','m','o'], slurpy HashRef[Int]]) { pop->res->body('as_ref') } sub utf8 :Local Query(utf8=>Heart) { pop->res->body("heart") } sub chain :Chained(/) CaptureArgs(0) Query(age=>Int,...) { } sub big :Chained(chain) PathPart('') Args(0) Query(size=>Int,...) { pop->res->body('big') } sub small :Chained(chain) PathPart('') Args(0) Query(size=>UserId,...) { pop->res->body('small') } sub default :Default { my ($self, $c, $int) = @_; $c->res->body('default'); } MyApp::Controller::Root->config(namespace=>''); package MyApp; use Catalyst; MyApp->setup; } use Catalyst::Test 'MyApp'; { my $res = request '/user/1?page=10&user=a&user=100'; is $res->content, 'page 10, user 100'; } { my $res = request '/user/1?page=10&user=d&user=100'; is $res->content, 'default'; } { my $res = request '/user/1?page=string&user=a&user=100'; is $res->content, 'default'; } { my $res = request '/user/1?page=10&user=a&user=100&foo=bar'; is $res->content, 'default'; } { my $res = request '/user/1?page=10&user=a&user=100&user=bar'; is $res->content, 'default'; } { my $res = request '/user_slurps/1?page=10&user=a&user=100&foo=bar'; is $res->content, 'page 10, user 100'; } { my $res = request '/string_types?q=sssss&age=10'; is $res->content, 'string_type'; } { my $res = request '/string_types?w=sssss&age=10'; is $res->content, 'default'; } { my $res = request '/string_types?q=sssss&age=string'; is $res->content, 'default'; } { my $res = request '/as_ref?q=sssss&age=string'; is $res->content, 'default'; } { my $res = request '/as_ref?age=10&sex=o&foo=bar&baz=bot'; is $res->content, 'default'; } { my $res = request '/as_ref?age=10&sex=o&foo=122&baz=300'; is $res->content, 'as_ref'; } { my $res = request '/utf8?utf8=♥'; is $res->content, 'heart'; } { my $res = request '/chain?age=string&size=2'; is $res->content, 'default'; } { my $res = request '/chain?age=string&size=string'; is $res->content, 'default'; } { my $res = request '/chain?age=50&size=string'; is $res->content, 'default'; } { my $res = request '/chain?age=10&size=100'; is $res->content, 'big'; } { my $res = request '/chain?age=10&size=2'; is $res->content, 'small'; } done_testing; Catalyst-Runtime-5.90115/t/relative_root_action_for_bug.t000644 000765 000024 00000004040 13025775570 025517 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub root :Chained(/) PathPart('') CaptureArgs(0) { my ($self, $c) = @_; } sub top :Chained('root') Args(0) { my ($self, $c) = @_; Test::More::is $self->action_for('top'), 'top'; Test::More::is $self->action_for('story/story'), 'story/story'; } sub default : Path { my ($self, $c) = @_; $c->response->body("Ok"); } MyApp::Controller::Root->config(namespace=>''); package MyApp::Controller::Story; $INC{'MyApp/Controller/Story.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub root :Chained(/root) PathPart('') CaptureArgs(0) { my ($self, $c) = @_; } sub story :Chained(root) Args(0) { my ($self, $c) = @_; Test::More::is $self->action_for('story'), 'story/story'; Test::More::is $self->action_for('author/author'), 'story/author/author'; } __PACKAGE__->meta->make_immutable; package MyApp::Controller::Story::Author; $INC{'MyApp/Controller/Story/Author.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub root :Chained(/story/root) PathPart('') CaptureArgs(0) { my ($self, $c) = @_; } sub author :Chained(root) Args(0) { my ($self, $c, $id) = @_; Test::More::is $self->action_for('author'), 'story/author/author'; Test::More::is $self->action_for('../story'), 'story/story'; Test::More::is $self->action_for('../../top'), 'top'; } __PACKAGE__->meta->make_immutable; package MyApp; $INC{'MyApp.pm'} = __FILE__; use Catalyst; MyApp->setup; } use Catalyst::Test 'MyApp'; ok request '/top'; ok request '/story'; ok request '/author'; ok request '/double'; ok request '/double/file.ext'; ok request '/double/file..ext'; done_testing(13); Catalyst-Runtime-5.90115/t/remove_redundant_body.t000644 000765 000024 00000001610 12406561462 024152 0ustar00jnapiorkowskistaff000000 000000 use FindBin; use lib "$FindBin::Bin/lib"; use Catalyst::Test 'TestApp', {default_host => 'default.com'}; use Catalyst::Request; use Test::More; { my @routes = ( ["test_remove_body_with_304", 304 ], ["test_remove_body_with_204", 204 ], ["test_remove_body_with_100", 100 ], ["test_nobody_with_100", 100 ] ); foreach my $element (@routes ) { my $route = $element->[0]; my $expected_code = $element->[1]; my $request = HTTP::Request->new( GET => "http://localhost:3000/$route" ); ok( my $response = request($request), "Request for $route"); is( $response->code, $expected_code, "Status code for $route is $expected_code"); is( $response->content, '', "Body for $route is not present"); } } done_testing; Catalyst-Runtime-5.90115/t/set_allowed_method.t000644 000765 000024 00000001215 12520162327 023431 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; # Test case for reported issue when an action consumes JSON but a # POST sends nothing we get a hard error { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub root :Chained(/) CaptureArgs(0) { } sub get :GET Chained(root) PathPart('') Args(0) { } sub post :POST Chained(root) PathPart('') Args(0) { } sub put :PUT Chained(root) PathPart('') Args(0) { } package MyApp; use Catalyst; MyApp->setup; } use HTTP::Request::Common; use Catalyst::Test 'MyApp'; { ok my $res = request POST 'root/'; } done_testing(); Catalyst-Runtime-5.90115/t/something/000755 000765 000024 00000000000 13101661740 021377 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/state.t000644 000765 000024 00000003524 12622371265 020722 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; MyApp::Controller::Root->config(namespace=>''); sub begin :Action { my ($self, $c) = @_; Test::More::is($c->state, 0); return 'begin'; } sub auto :Action { my ($self, $c) = @_; # Even if a begin returns something, we kill it. Need to # do this since there's actually people doing detach in # auto and expect that to work the same as 0. Test::More::is($c->state, '0'); return 'auto'; } sub base :Chained('/') PathPrefix CaptureArgs(0) { my ($self, $c) = @_; Test::More::is($c->state, 'auto'); return 10; } sub one :Chained('base') PathPart('') CaptureArgs(0) { my ($self, $c) = @_; Test::More::is($c->state, 10); return 20; } sub two :Chained('one') PathPart('') Args(1) { my ($self, $c, $arg) = @_; Test::More::is($c->state, 20); my $ret = $c->forward('forward2'); Test::More::is($ret, 25); Test::More::is($c->state, 25); return 30; } sub end :Action { my ($self, $c) = @_; Test::More::is($c->state, 30); my $ret = $c->forward('forward1'); Test::More::is($ret, 100); Test::More::is($c->state, 100); $c->detach('detach1'); } sub forward1 :Action { my ($self, $c) = @_; Test::More::is($c->state, 30); return 100; } sub forward2 :Action { my ($self, $c) = @_; Test::More::is($c->state, 20); return 25; } sub detach1 :Action { my ($self, $c) = @_; Test::More::is($c->state, 100); } package MyApp; use Catalyst; MyApp->config(show_internal_actions=>1); MyApp->setup; } use Catalyst::Test 'MyApp'; { ok my $res = request "/100"; } done_testing; Catalyst-Runtime-5.90115/t/undef-params.t000644 000765 000024 00000002230 12520162327 022147 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict ; use Test::More; use HTTP::Request::Common; use Plack::Test; # If someone does $c->req->params(undef) you don't get a very good # error message. This is a test to see if the proposed change improves # that. { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub test :Local { my ($self, $c) = @_; my $value = $c->req->param(undef); $c->response->body("This is the body"); } sub set_params :Local { my ($self, $c) = @_; $c->req->param(foo => 'a', 'b', 'c'); $c->res->body(join ',', $c->req->param('foo')); } package MyApp; use Catalyst; $SIG{__WARN__} = sub { my $error = shift; Test::More::like($error, qr[You called ->params with an undefined value]) unless MyApp->debug; }; MyApp->setup; } ok my $psgi = MyApp->psgi_app, 'build psgi app'; test_psgi $psgi, sub { my $cb = shift; { my $res = $cb->(GET "/root/test"); is $res->code, 200, 'OK'; } { my $res = $cb->(GET "/root/set_params"); is $res->code, 200, 'OK'; is $res->content, 'a,b,c'; } }; done_testing; Catalyst-Runtime-5.90115/t/undef_encoding_regression.t000644 000765 000024 00000001563 12745474071 025017 0ustar00jnapiorkowskistaff000000 000000 use utf8; use warnings; use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI (); use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub heart :Local Args(1) { my ($self, $c, $arg) = @_; Test::More::is $c->req->query_parameters->{a}, 111; Test::More::is $c->req->query_parameters->{b}, 222; Test::More::is $arg, 1; $c->response->content_type('text/html'); $c->response->body("

This is path local

"); } package MyApp; use Catalyst; MyApp->config(encoding => undef); Test::More::ok(MyApp->setup, 'setup app'); } use Catalyst::Test 'MyApp'; { my $res = request "/root/heart/1?a=111&b=222"; is $res->code, 200, 'OK'; is $res->content, '

This is path local

'; } done_testing; Catalyst-Runtime-5.90115/t/unicode-exception-bug.t000644 000765 000024 00000002713 12743743417 024004 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; BEGIN { package TestApp::Exception; $INC{'TestApp/Exception.pm'} = __FILE__; sub new { my ($class, $code, $headers, $body) = @_; return bless +{res => [$code, $headers, $body]}, $class; } sub throw { die shift->new(@_) } sub as_psgi { my ($self, $env) = @_; my ($code, $headers, $body) = @{$self->{res}}; return [$code, $headers, $body]; # for now return sub { my $responder = shift; $responder->([$code, $headers, $body]); }; } package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub main :Path('') :Args(1) { my ($self, $c, $arg) = @_; $c->res->body('

OK

'); $c->res->content_type('text/html'); } TestApp::Controller::Root->config(namespace => ''); } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; use TestApp::Exception; sub handle_unicode_encoding_exception { my ( $self, $param_value, $error_msg ) = @_; TestApp::Exception->throw( 200, ['content-type'=>'text/plain'], ['Bad unicode data']); } __PACKAGE__->setup; } use Catalyst::Test 'TestApp'; { my $res = request('/ok'); is ($res->status_line, "200 OK"); is ($res->content, '

OK

'); } { my $res = request('/%E2%C3%83%C6%92%C3%8'); is ($res->content, 'Bad unicode data'); } done_testing; #TestApp->to_app; Catalyst-Runtime-5.90115/t/unicode-exception-return-value.t000644 000765 000024 00000004745 12743746770 025674 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use HTTP::Request::Common; BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub main :Path('') :Args(1) { my ($self, $c, $arg) = @_; my $body = $arg . "\n"; my $query_params = $c->request->query_params; my $body_params = $c->request->body_params; foreach my $key (sort keys %$query_params) { $body .= "Q $key => " . $query_params->{$key} . "\n"; } foreach my $key (sort keys %$body_params) { $body .= "B $key => " . $body_params->{$key} . "\n"; } $c->res->body($body); $c->res->content_type('text/plain'); } TestApp::Controller::Root->config(namespace => ''); } { package TestApp; $INC{'TestApp.pm'} = __FILE__; use Catalyst; sub handle_unicode_encoding_exception { my ( $self, $param_value, $error_msg ) = @_; # totally dummy: we return any invalid string with a fixed # value. a more clever thing would be try to decode it from # latin1 or latin2. return "INVALID-UNICODE"; } __PACKAGE__->setup; } use Catalyst::Test 'TestApp'; { my $res = request('/ok'); is ($res->content, "ok\n", "app is echoing arguments"); } { my $res = request('/%E2%C3%83%C6%92%C3%8'); is ($res->content, "INVALID-UNICODE\n", "replacement ok in arguments"); } { my $res = request('/p?valid_key=%e2'); is ($res->content, "p\nQ valid_key => INVALID-UNICODE\n", "replacement ok in query"); } { my $res = request('/p?%e2=%e2'); is ($res->content, "p\nQ INVALID-UNICODE => INVALID-UNICODE\n", "replacement ok in query"); } { my $req = POST "/p", Content => "%e2=%e2"; my $res = request($req); is ($res->content, "p\nB INVALID-UNICODE => INVALID-UNICODE\n", "replacement ok in body"); } { my $req = POST "/p", Content => "valid_key=%e2"; my $res = request($req); is ($res->content, "p\nB valid_key => INVALID-UNICODE\n", "replacement ok in body"); } { # and a superset of problems: my $req = POST "/%e5?%e3=%e3", Content => "%e4=%e4"; my $res = request($req); my $expected = <<'BODY'; INVALID-UNICODE Q INVALID-UNICODE => INVALID-UNICODE B INVALID-UNICODE => INVALID-UNICODE BODY is ($res->content, $expected, "Found the replacement strings everywhere"); } done_testing; #TestApp->to_app; Catalyst-Runtime-5.90115/t/unicode_plugin_charset_utf8.t000644 000765 000024 00000001401 12454003036 025244 0ustar00jnapiorkowskistaff000000 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'; # This is now default $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/; #no longer a plugin done_testing; Catalyst-Runtime-5.90115/t/unicode_plugin_config.t000644 000765 000024 00000001170 12572364356 024135 0ustar00jnapiorkowskistaff000000 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.90115/t/unicode_plugin_live.t000644 000765 000024 00000005151 12572364356 023632 0ustar00jnapiorkowskistaff000000 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.90115/t/unicode_plugin_no_encoding.t000644 000765 000024 00000002604 12454003036 025135 0ustar00jnapiorkowskistaff000000 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); # JNAP - I am removing this test case because I think its not correct. I think # we do not check the server encoding to determine if the parts of a request URL # both paths and query should be decoded. I think its always safe to assume utf8 # encoded urlencoded bits. That is my reading of the spec. Please correct me if # I am wrong #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'); 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.90115/t/unicode_plugin_request_decode.t000644 000765 000024 00000003715 12454003036 025652 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; 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); sub check_parameter { my ( undef, $c ) = ctx_request(shift); is $c->res->output => '

It works

'; my $foo = $c->req->param('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}; 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]; 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]; 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); } 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]); done_testing; Catalyst-Runtime-5.90115/t/unit_core_methodattributes_method_metaclass_on_subclasses.t000644 000765 000024 00000001152 12406561463 033553 0ustar00jnapiorkowskistaff000000 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.90115/t/unit_core_script_test.t000644 000765 000024 00000002363 12406561463 024215 0ustar00jnapiorkowskistaff000000 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.90115/t/unit_stats.t000644 000765 000024 00000010273 12406561463 021777 0ustar00jnapiorkowskistaff000000 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.90115/t/unit_utils_load_class.t000644 000765 000024 00000004517 12454003036 024157 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use Class::Load 'is_class_loaded'; use lib "t/lib"; BEGIN { if ($^O =~ m/^MSWin/) { plan skip_all => 'Skipping this test on Windows until someone with Windows has time to fix it'; } 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' ); done_testing; Catalyst-Runtime-5.90115/t/unit_utils_subdir.t000644 000765 000024 00000002567 12406561463 023360 0ustar00jnapiorkowskistaff000000 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.90115/t/useless_set_headers.t000644 000765 000024 00000003233 12726055355 023634 0ustar00jnapiorkowskistaff000000 000000 use warnings; use strict; use Test::More; use HTTP::Request::Common; { package TestAppStats::Log; $INC{'TestAppStats/Log.pm'} = __FILE__; use base qw/Catalyst::Log/; my @warn; sub my_warnings { $warn[0] }; sub warn { shift; push(@warn, @_) } package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub get_header_ok :Local { my ($self, $c) = @_; $c->res->body('get_header_ok'); } sub set_header_nok :Local { my ($self, $c) = @_; $c->res->body('set_header_nok'); } package MyApp; $INC{'MyApp.pm'} = __FILE__; use Catalyst; use Moose; sub debug { 1 } __PACKAGE__->log(TestAppStats::Log->new); after 'finalize' => sub { my ($c) = @_; if($c->res->body eq 'set_header_nok') { Test::More::ok 1, 'got this far'; # got this far $c->res->header('REQUEST_METHOD', 'bad idea'); } elsif($c->res->body eq 'get_header_ok') { Test::More::ok $c->res->header('x-catalyst'), 'Can query a header without causing trouble'; } }; MyApp->setup; } use Catalyst::Test 'MyApp'; ok request(GET '/root/get_header_ok'), 'got good request for get_header_ok'; ok !TestAppStats::Log::my_warnings, 'no warnings'; ok request(GET '/root/set_header_nok'), 'got good request for set_header_nok'; ok TestAppStats::Log::my_warnings, 'has a warning'; like TestAppStats::Log::my_warnings, qr'Useless setting a header value after finalize_headers', 'got expected warnings'; # We need to specify the number in order to be sure we are testing # it all correctly. If you change the number of tests please keep # this up to date. DO NOT REMOVE THIS! done_testing(7); Catalyst-Runtime-5.90115/t/utf8.txt000644 000765 000024 00000000051 12454003036 021023 0ustar00jnapiorkowskistaff000000 000000

This is stream_body_fh action ♥

Catalyst-Runtime-5.90115/t/utf_incoming.t000644 000765 000024 00000044307 12743743417 022275 0ustar00jnapiorkowskistaff000000 000000 use utf8; use warnings; use strict; use Test::More; use HTTP::Request::Common; use HTTP::Message::PSGI (); use Encode 2.21 'decode_utf8', 'encode_utf8', 'encode'; use File::Spec; use JSON::MaybeXS; use Data::Dumper; use Scalar::Util (); # Test cases for incoming utf8 { package MyApp::Controller::Root; $INC{'MyApp/Controller/Root.pm'} = __FILE__; use base 'Catalyst::Controller'; sub heart :Path('♥') { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("

This is path-heart action ♥

"); # We let the content length middleware find the length... } sub hat :Path('^') { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("

This is path-hat action ^

"); } sub uri_for :Path('uri_for') { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("${\$c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'})}"); } sub heart_with_arg :Path('a♥') Args(1) { my ($self, $c, $arg) = @_; $c->response->content_type('text/html'); $c->response->body("

This is path-heart-arg action $arg

"); Test::More::is $c->req->args->[0], '♥'; } sub base :Chained('/') CaptureArgs(0) { } sub link :Chained('base') PathPart('♥') Args(0) { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("

This is base-link action ♥

"); } sub arg :Chained('base') PathPart('♥') Args(1) { my ($self, $c, $arg) = @_; $c->response->content_type('text/html'); $c->response->body("

This is base-link action ♥ $arg

"); } sub capture :Chained('base') PathPart('♥') CaptureArgs(1) { my ($self, $c, $arg) = @_; $c->stash(capture=>$arg); } sub argend :Chained('capture') PathPart('♥') Args(1) { my ($self, $c, $arg) = @_; $c->response->content_type('text/html'); Test::More::is $c->req->args->[0], '♥'; Test::More::is $c->req->captures->[0], '♥'; Test::More::is $arg, '♥'; Test::More::is length($arg), 1, "got length of one"; $c->response->body("

This is base-link action ♥ ${\$c->req->args->[0]}

"); # Test to make sure redirect can now take an object (sorry don't have a better place for it # but wanted test coverage. my $location = $c->res->redirect( $c->uri_for($c->controller('Root')->action_for('uri_for')) ); Test::More::ok !ref $location; } sub stream_write :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->write("

This is stream_write action ♥

"); } sub stream_write_fh :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); my $writer = $c->res->write_fh; $writer->write_encoded('

This is stream_write_fh action ♥

'); $writer->close; } # Stream a file with utf8 chars directly, you don't need to decode sub stream_body_fh :Local { my ($self, $c) = @_; my $path = File::Spec->catfile('t', 'utf8.txt'); open(my $fh, '<', $path) || die "trouble: $!"; $c->response->content_type('text/html'); $c->response->body($fh); } # If you pull the file contents into a var, NOW you need to specify the # IO encoding on the FH. Ultimately Plack at the end wants bytes... sub stream_body_fh2 :Local { my ($self, $c) = @_; my $path = File::Spec->catfile('t', 'utf8.txt'); open(my $fh, '<:encoding(UTF-8)', $path) || die "trouble: $!"; my $contents = do { local $/; <$fh> }; $c->response->content_type('text/html'); $c->response->body($contents); } sub write_then_body :Local { my ($self, $c) = @_; $c->res->content_type('text/html'); $c->res->write("

This is early_write action ♥

"); $c->res->body("

This is body_write action ♥

"); } sub file_upload :POST Consumes(Multipart) Local { my ($self, $c) = @_; Test::More::is $c->req->body_parameters->{'♥'}, '♥♥'; Test::More::ok my $upload = $c->req->uploads->{file}; Test::More::is $upload->charset, 'UTF-8'; my $text = $upload->slurp; Test::More::is Encode::decode_utf8($text), "

This is stream_body_fh action ♥

\n"; my $decoded_text = $upload->decoded_slurp; Test::More::is $decoded_text, "

This is stream_body_fh action ♥

\n"; Test::More::is $upload->filename, '♥ttachment.txt'; Test::More::is $upload->raw_basename, '♥ttachment.txt'; $c->response->content_type('text/html'); $c->response->body($decoded_text); } sub file_upload_utf8_param :POST Consumes(Multipart) Local { my ($self, $c) = @_; Test::More::is $c->req->body_parameters->{'♥'}, '♥♥'; Test::More::ok my $upload = $c->req->uploads->{'♥'}; Test::More::is $upload->charset, 'UTF-8'; my $text = $upload->slurp; Test::More::is Encode::decode_utf8($text), "

This is stream_body_fh action ♥

\n"; my $decoded_text = $upload->decoded_slurp; Test::More::is $decoded_text, "

This is stream_body_fh action ♥

\n"; Test::More::is $upload->filename, '♥ttachment.txt'; Test::More::is $upload->raw_basename, '♥ttachment.txt'; $c->response->content_type('text/html'); $c->response->body($decoded_text); } sub json :POST Consumes(JSON) Local { my ($self, $c) = @_; my $post = $c->req->body_data; Test::More::is $post->{'♥'}, '♥♥'; Test::More::is length($post->{'♥'}), 2; $c->response->content_type('application/json'); # Encode JSON also encodes to a UTF-8 encoded, binary string. This is why we don't # have application/json as one of the things we match, otherwise we get double # encoding. $c->response->body(JSON::MaybeXS::encode_json($post)); } ## If someone clears encoding, they can do as they wish sub manual_1 :Local { my ($self, $c) = @_; $c->clear_encoding; $c->res->content_type('text/plain'); $c->res->content_type_charset('UTF-8'); $c->response->body( Encode::encode_utf8("manual_1 ♥")); } ## If you do like gzip, well handle that yourself! Basically if you do some sort ## of content encoding like gzip, you must do on top of the encoding. We will fix ## the encoding plugins (Catalyst::Plugin::Compress) to do this properly for you. # sub gzipped :Local { require Compress::Zlib; my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->res->content_type_charset('UTF-8'); $c->res->content_encoding('gzip'); $c->response->body(Compress::Zlib::memGzip(Encode::encode_utf8("manual_1 ♥"))); } sub override_encoding :Local { my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->encoding(Encode::find_encoding('UTF-8')); $c->encoding(Encode::find_encoding('Shift_JIS')); $c->response->body("テスト"); } sub stream_write_error :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->write("

This is stream_write action ♥

"); $c->encoding(Encode::find_encoding('Shift_JIS')); $c->response->write("

This is stream_write action ♥

"); } sub from_external_psgi :Local { my ($self, $c) = @_; my $env = HTTP::Message::PSGI::req_to_psgi( HTTP::Request::Common::GET '/root/♥'); $c->res->from_psgi_response( ref($c)->to_app->($env)); } sub echo_arg :Local { my ($self, $c) = @_; $c->response->content_type('text/plain'); $c->response->body($c->req->body_parameters->{arg}); } sub echo_param :Local { my ($self, $c) = @_; $c->response->content_type('text/plain'); $c->response->body($c->req->query_parameters->{arg}); } package MyApp; use Catalyst; Test::More::ok(MyApp->setup, 'setup app'); } ok my $psgi = MyApp->psgi_app, 'build psgi app'; use Catalyst::Test 'MyApp'; { my $res = request "/root/♥"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is path-heart action ♥

', 'correct body'; is $res->content_length, 36, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/root/a♥/♥"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is path-heart-arg action ♥

', 'correct body'; is $res->content_length, 40, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/root/^"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is path-hat action ^

', 'correct body'; is $res->content_length, 32, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/base/♥"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is base-link action ♥

', 'correct body'; is $res->content_length, 35, 'correct length'; is $res->content_charset, 'UTF-8'; } { my ($res, $c) = ctx_request POST "/base/♥?♥=♥&♥=♥♥", [a=>1, b=>'', '♥'=>'♥', '♥'=>'♥♥']; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is base-link action ♥

', 'correct body'; is $res->content_length, 35, 'correct length'; is $c->req->parameters->{'♥'}[0], '♥'; is $c->req->query_parameters->{'♥'}[0], '♥'; is $c->req->body_parameters->{'♥'}[0], '♥'; is $c->req->parameters->{'♥'}[0], '♥'; is $c->req->parameters->{a}, 1; is $c->req->body_parameters->{a}, 1; is $res->content_charset, 'UTF-8'; } { my ($res, $c) = ctx_request GET "/base/♥?♥♥♥"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is base-link action ♥

', 'correct body'; is $res->content_length, 35, 'correct length'; is $c->req->query_keywords, '♥♥♥'; is $res->content_charset, 'UTF-8'; } { my $res = request "/base/♥/♥"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is base-link action ♥ ♥

', 'correct body'; is $res->content_length, 39, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/base/♥/♥/♥/♥"; is decode_utf8($res->content), '

This is base-link action ♥ ♥

', 'correct body'; is $res->content_length, 39, 'correct length'; is $res->content_charset, 'UTF-8'; } { my ($res, $c) = ctx_request POST "/base/♥/♥/♥/♥?♥=♥♥", [a=>1, b=>'2', '♥'=>'♥♥']; ## Make sure that the urls we generate work the same my $uri_for1 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥', {'♥'=>'♥♥'}); my $uri_for2 = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥', '♥'], {'♥'=>'♥♥'}); my $uri = $c->req->uri; is "$uri_for1", "$uri_for2"; is "$uri", "$uri_for1"; { my ($res, $c) = ctx_request POST "$uri_for1", [a=>1, b=>'2', '♥'=>'♥♥']; is $c->req->query_parameters->{'♥'}, '♥♥'; is $c->req->body_parameters->{'♥'}, '♥♥'; is $c->req->parameters->{'♥'}[0], '♥♥'; #combined with query and body is $c->req->args->[0], '♥'; is length($c->req->parameters->{'♥'}[0]), 2; is length($c->req->query_parameters->{'♥'}), 2; is length($c->req->body_parameters->{'♥'}), 2; is length($c->req->args->[0]), 1; is $res->content_charset, 'UTF-8'; } } { my ($res, $c) = ctx_request "/root/uri_for"; my $url = $c->uri_for($c->controller('Root')->action_for('argend'), ['♥'], '♥#X♥X', {'♥'=>'♥♥'}); is $res->code, 200, 'OK'; is decode_utf8($res->content), "$url", 'correct body'; #should do nothing is $res->content, "$url", 'correct body'; is $res->content_length, 104, 'correct length'; is $res->content_charset, 'UTF-8'; { my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), '♥'); is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url"; } { my $url = $c->uri_for($c->controller->action_for('heart_with_arg'), ['♥']); is "$url", 'http://localhost/root/a%E2%99%A5/%E2%99%A5', "correct $url"; } } { my $res = request "/root/stream_write"; is $res->code, 200, 'OK GET /root/stream_write'; is decode_utf8($res->content), '

This is stream_write action ♥

', 'correct body'; is $res->content_charset, 'UTF-8'; } { my $res = request "/root/stream_body_fh"; is $res->code, 200, 'OK'; is decode_utf8($res->content), "

This is stream_body_fh action ♥

\n", 'correct body'; is $res->content_charset, 'UTF-8'; # Not sure why there is a trailing newline above... its not in catalyst code I can see. Not sure # if is a problem or just an artifact of the why the test stuff works - JNAP } { my $res = request "/root/stream_write_fh"; is $res->code, 200, 'OK'; is decode_utf8($res->content), '

This is stream_write_fh action ♥

', 'correct body'; #is $res->content_length, 41, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/root/stream_body_fh2"; is $res->code, 200, 'OK'; is decode_utf8($res->content), "

This is stream_body_fh action ♥

\n", 'correct body'; is $res->content_length, 41, 'correct length'; is $res->content_charset, 'UTF-8'; } { my $res = request "/root/write_then_body"; is $res->code, 200, 'OK'; is decode_utf8($res->content), "

This is early_write action ♥

This is body_write action ♥

"; is $res->content_charset, 'UTF-8'; } { ok my $path = File::Spec->catfile('t', 'utf8.txt'); ok my $req = POST '/root/file_upload', Content_Type => 'form-data', Content => [encode_utf8('♥')=>encode_utf8('♥♥'), file=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]]; ok my $res = request $req; is decode_utf8($res->content), "

This is stream_body_fh action ♥

\n"; } { ok my $path = File::Spec->catfile('t', 'utf8.txt'); ok my $req = POST '/root/file_upload_utf8_param', Content_Type => 'form-data', Content => [encode_utf8('♥')=>encode_utf8('♥♥'), encode_utf8('♥')=>["$path", encode_utf8('♥ttachment.txt'), 'Content-Type' =>'text/html; charset=UTF-8', ]]; ok my $res = request $req; is decode_utf8($res->content), "

This is stream_body_fh action ♥

\n"; } { ok my $req = POST '/root/json', Content_Type => 'application/json', Content => encode_json +{'♥'=>'♥♥'}; # Note: JSON does the UTF* encoding for us ok my $res = request $req; ## decode_json expect the binary utf8 string and does the decoded bit for us. is_deeply decode_json(($res->content)), +{'♥'=>'♥♥'}, 'JSON was decoded correctly'; } { ok my $res = request "/root/override_encoding"; ok my $enc = Encode::find_encoding('SHIFT_JIS'); is $res->code, 200, 'OK'; is $enc->decode($res->content), "テスト", 'correct body'; is $res->content_length, 6, 'correct length'; # Bytes over the wire is length($enc->decode($res->content)), 3; is $res->content_charset, 'SHIFT_JIS', 'content charset is SHIFT_JIS as expected'; } { my $res = request "/root/manual_1"; is $res->code, 200, 'OK'; is decode_utf8($res->content), "manual_1 ♥", 'correct body'; is $res->content_length, 12, 'correct length'; is $res->content_charset, 'UTF-8'; } SKIP: { eval { require Compress::Zlib; 1} || do { skip "Compress::Zlib needed to test gzip encoding", 5 }; my $res = request "/root/gzipped"; ok my $raw_content = $res->content; ok my $content = Compress::Zlib::memGunzip($raw_content), 'no gunzip error'; is $res->code, 200, 'OK'; is decode_utf8($content), "manual_1 ♥", 'correct body'; is $res->content_charset, 'UTF-8', 'zlib charset is set correctly'; } { my $res = request "/root/stream_write_error"; is $res->code, 200, 'OK'; like decode_utf8($res->content), qr[

This is stream_write action ♥

code, 200, 'OK'; is decode_utf8($res->content), '

This is path-heart action ♥

', 'correct body'; is $res->content_length, 36, 'correct length'; is $res->content_charset, 'UTF-8', 'external PSGI app has expected charset'; } { my $utf8 = 'test ♥'; my $shiftjs = 'test テスト'; ok my $req = POST '/root/echo_arg', Content_Type => 'form-data', Content => [ arg0 => 'helloworld', Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), # Long form POST simple does not auto encode... Encode::encode('UTF-8','♥♥♥') => [ undef, '', 'Content-Type' =>'text/plain; charset=SHIFT_JIS', 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], arg1 => [ undef, '', 'Content-Type' =>'text/plain; charset=UTF-8', 'Content' => Encode::encode('UTF-8', $utf8)], arg2 => [ undef, '', 'Content-Type' =>'text/plain; charset=SHIFT_JIS', 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], arg2 => [ undef, '', 'Content-Type' =>'text/plain; charset=SHIFT_JIS', 'Content' => Encode::encode('SHIFT_JIS', $shiftjs)], ]; my ($res, $c) = ctx_request $req; is $c->req->body_parameters->{'arg0'}, 'helloworld', 'got helloworld value'; is $c->req->body_parameters->{'♥'}, '♥♥'; is $c->req->body_parameters->{'arg1'}, $utf8, 'decoded utf8 param'; is $c->req->body_parameters->{'arg2'}[0], $shiftjs, 'decoded shiftjs param'; is $c->req->body_parameters->{'arg2'}[1], $shiftjs, 'decoded shiftjs param'; is $c->req->body_parameters->{'♥♥♥'}, $shiftjs, 'decoded shiftjs param'; } { my $shiftjs = 'test テスト'; my $encoded = Encode::encode('UTF-8', $shiftjs); ok my $req = GET "/root/echo_arg?a=$encoded"; my ($res, $c) = ctx_request $req; is $c->req->query_parameters->{'a'}, $shiftjs, 'got expected value'; } { my $invalid = '%e2'; # in url { my $req = GET "/$invalid"; my $res = request $req; is ($res->code, '400', "Invalid url param is 400"); } # in body { my $req = POST "/root/echo_arg", Content => "arg0=$invalid"; my $res = request $req; is ($res->code, '400', "Invalid post param is 400"); } # in query { # failing since 5.90080 my $req = GET "/root/echo_param?arg=$invalid"; my $res = request $req; is ($res->code, '400', "Invalid get param is 400") or diag Dumper($res->decoded_content); } } ## should we use binmode on filehandles to force the encoding...? ## Not sure what else to do with multipart here, if docs are enough... done_testing; Catalyst-Runtime-5.90115/t/something/Makefile.PL000644 000765 000024 00000000000 12406561462 023346 0ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/something/script/000755 000765 000024 00000000000 13101661740 022703 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/something/script/foo/000755 000765 000024 00000000000 13101661740 023466 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/something/script/foo/bar/000755 000765 000024 00000000000 13101661740 024232 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/something/script/foo/bar/for_dist000644 000765 000024 00000000000 12406561462 025763 0ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ACLTestApp/000755 000765 000024 00000000000 13101661740 022050 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ACLTestApp.pm000644 000765 000024 00000000733 12406561462 022420 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/000755 000765 000024 00000000000 13101661740 021734 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/CDICompatTestPlugin.pm000644 000765 000024 00000002356 12406561462 024305 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ChainedActionsApp/000755 000765 000024 00000000000 13101661740 023465 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ChainedActionsApp.pm000644 000765 000024 00000000546 12406561462 024037 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/DeprecatedActionsInAppClassTestApp.pm000644 000765 000024 00000001117 12406561462 027315 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/DeprecatedTestApp/000755 000765 000024 00000000000 13101661740 023511 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/DeprecatedTestApp.pm000644 000765 000024 00000000314 12406561462 024054 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Moo.pm000644 000765 000024 00000000244 12406561462 021247 0ustar00jnapiorkowskistaff000000 000000 package Moo; use Moose::Role; use namespace::autoclean; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90115/t/lib/NullPackage.pm000644 000765 000024 00000000466 12406561462 022711 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/PluginTestApp/000755 000765 000024 00000000000 13101661740 022707 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/PluginTestApp.pm000644 000765 000024 00000001507 12406561462 023257 0ustar00jnapiorkowskistaff000000 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 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.90115/t/lib/ScriptTestApp/000755 000765 000024 00000000000 13101661740 022715 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ScriptTestApp.pm000644 000765 000024 00000000120 12406561462 023253 0ustar00jnapiorkowskistaff000000 000000 package ScriptTestApp; use Moose; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/Test/000755 000765 000024 00000000000 13101661740 021067 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/000755 000765 000024 00000000000 13101661740 021530 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp.pm000644 000765 000024 00000006723 12406561462 022105 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp2/000755 000765 000024 00000000000 13101661740 021612 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp2.pm000644 000765 000024 00000000466 12406561462 022165 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppArgsEmptyParens.pm000644 000765 000024 00000001321 12726017446 025102 0ustar00jnapiorkowskistaff000000 000000 package TestAppArgsEmptyParens::Controller::Root; $INC{'TestAppArgsEmptyParens/Controller/Root.pm'} = __FILE__; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub chain_base :Chained(/) PathPart('chain_base') CaptureArgs(0) { } sub args : Chained(chain_base) PathPart('args') Args { $_[1]->res->body('Args') } sub args_empty : Chained(chain_base) PathPart('args_empty') Args() { $_[1]->res->body('Args()') } TestAppArgsEmptyParens::Controller::Root->config(namespace=>''); package TestAppArgsEmptyParens; $INC{'TestAppArgsEmptyParens.pm'} = __FILE__; use Catalyst; use TestLogger; TestAppArgsEmptyParens->setup; TestAppArgsEmptyParens->log( TestLogger->new ); 1; Catalyst-Runtime-5.90115/t/lib/TestAppBadlyImmutable.pm000644 000765 000024 00000000426 12406561462 024713 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppChainedAbsolutePathPart/000755 000765 000024 00000000000 13101661740 026147 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppChainedAbsolutePathPart.pm000644 000765 000024 00000000513 12406561462 026513 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppChainedRecursive/000755 000765 000024 00000000000 13101661740 024674 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppChainedRecursive.pm000644 000765 000024 00000000435 12406561462 025243 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppClassExceptionSimpleTest.pm000644 000765 000024 00000000616 12406561462 026757 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppDoubleAutoBug/000755 000765 000024 00000000000 13101661740 024152 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppDoubleAutoBug.pm000644 000765 000024 00000002025 12406561462 024516 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppEncoding/000755 000765 000024 00000000000 13101661740 023177 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncoding.pm000644 000765 000024 00000000234 12406561462 023543 0ustar00jnapiorkowskistaff000000 000000 package TestAppEncoding; use strict; use warnings; use base qw/Catalyst/; use Catalyst; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInApp/000755 000765 000024 00000000000 13101661740 024603 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInApp.pm000644 000765 000024 00000000233 12406561462 025146 0ustar00jnapiorkowskistaff000000 000000 package TestAppEncodingSetInApp; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( encoding => 'UTF-8', ); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInConfig/000755 000765 000024 00000000000 13101661740 025270 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInConfig.pm000644 000765 000024 00000000175 12406561462 025640 0ustar00jnapiorkowskistaff000000 000000 package TestAppEncodingSetInConfig; use Moose; use Catalyst qw/ConfigLoader/; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppIndexDefault/000755 000765 000024 00000000000 13101661740 024025 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppIndexDefault.pm000644 000765 000024 00000000222 12406561462 024366 0ustar00jnapiorkowskistaff000000 000000 package TestAppIndexDefault; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppMatchSingleArg/000755 000765 000024 00000000000 13101661740 024301 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppMatchSingleArg.pm000644 000765 000024 00000000224 12406561462 024644 0ustar00jnapiorkowskistaff000000 000000 package TestAppMatchSingleArg; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppMetaCompat/000755 000765 000024 00000000000 13101661737 023511 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppMetaCompat.pm000644 000765 000024 00000000166 12406561462 024053 0ustar00jnapiorkowskistaff000000 000000 package TestAppMetaCompat; use base qw/Catalyst/; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppNonMooseController/000755 000765 000024 00000000000 13101661740 025252 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppNonMooseController.pm000644 000765 000024 00000000142 12406561462 025614 0ustar00jnapiorkowskistaff000000 000000 package TestAppNonMooseController; use base qw/Catalyst/; use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppOnDemand/000755 000765 000024 00000000000 13101661740 023136 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppOnDemand.pm000644 000765 000024 00000000440 12406561462 023501 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppOneView/000755 000765 000024 00000000000 13101661740 023025 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppOneView.pm000644 000765 000024 00000000215 12406561462 023370 0ustar00jnapiorkowskistaff000000 000000 package TestAppOneView; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppPathBug.pm000644 000765 000024 00000000677 12406561462 023362 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppPluginWithConstructor/000755 000765 000024 00000000000 13101661740 026011 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppPluginWithConstructor.pm000644 000765 000024 00000000720 12406561462 026355 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppShowInternalActions/000755 000765 000024 00000000000 13101661740 025407 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppShowInternalActions.pm000644 000765 000024 00000000653 12406561462 025760 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppStats/000755 000765 000024 00000000000 13101661740 022547 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppStats.pm000644 000765 000024 00000000652 12406561462 023117 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppToTestScripts.pm000644 000765 000024 00000000221 12406561462 024603 0ustar00jnapiorkowskistaff000000 000000 package TestAppToTestScripts; use strict; use warnings; use Carp; our @RUN_ARGS; sub run { @RUN_ARGS = @_; 1; # Does this work? } 1; Catalyst-Runtime-5.90115/t/lib/TestAppUnicode/000755 000765 000024 00000000000 13101661740 023037 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppUnicode.pm000644 000765 000024 00000000624 12454003036 023375 0ustar00jnapiorkowskistaff000000 000000 package TestAppUnicode; use strict; use warnings; use TestLogger; use base qw/Catalyst/; use Catalyst; __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.90115/t/lib/TestAppUnknownError.pm000644 000765 000024 00000000357 12406561462 024474 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppViewWarnings/000755 000765 000024 00000000000 13101661740 024074 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppViewWarnings.pm000644 000765 000024 00000000622 12406561462 024441 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppWithMeta/000755 000765 000024 00000000000 13101661737 023201 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppWithMeta.pm000644 000765 000024 00000000231 12406561462 023534 0ustar00jnapiorkowskistaff000000 000000 package TestAppWithMeta; use strict; use warnings; use Catalyst; no warnings 'redefine'; sub meta {} use warnings 'redefine'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestAppWithoutUnicode/000755 000765 000024 00000000000 13101661740 024423 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppWithoutUnicode.pm000644 000765 000024 00000000351 12406561462 024767 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestContentNegotiation/000755 000765 000024 00000000000 13101661740 024623 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestContentNegotiation.pm000644 000765 000024 00000000251 12406561462 025166 0ustar00jnapiorkowskistaff000000 000000 package TestContentNegotiation; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, ); __PACKAGE__->setup; Catalyst-Runtime-5.90115/t/lib/TestDataHandlers/000755 000765 000024 00000000000 13101661740 023342 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestDataHandlers.pm000644 000765 000024 00000000201 12406561462 023700 0ustar00jnapiorkowskistaff000000 000000 package TestDataHandlers; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' } ); __PACKAGE__->setup; Catalyst-Runtime-5.90115/t/lib/TestFromPSGI/000755 000765 000024 00000000000 13101661740 022376 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestFromPSGI.pm000644 000765 000024 00000000261 12406561462 022742 0ustar00jnapiorkowskistaff000000 000000 package TestFromPSGI; use Moose; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, use_hash_multivalue_in_request => 1, ); __PACKAGE__->setup; Catalyst-Runtime-5.90115/t/lib/TestLogger.pm000644 000765 000024 00000000522 12622377775 022607 0ustar00jnapiorkowskistaff000000 000000 package TestLogger; use strict; use warnings; our @LOGS; our @ILOGS; our @ELOGS; sub new { return bless {}, __PACKAGE__; } sub debug { shift; push(@LOGS, shift()); } sub info { shift; push(@ILOGS, shift()); } sub warn { shift; push(@ELOGS, shift()); } sub error { die "Got unexpected error; $_[1]" } 1; Catalyst-Runtime-5.90115/t/lib/TestMiddleware/000755 000765 000024 00000000000 13101661740 023065 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware.pm000644 000765 000024 00000001577 12406561462 023444 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestMiddlewareFromConfig/000755 000765 000024 00000000000 13101661740 025037 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig.pm000644 000765 000024 00000000373 12406561462 025407 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestPath/000755 000765 000024 00000000000 13101661740 021704 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestPath.pm000644 000765 000024 00000000123 12614434663 022250 0ustar00jnapiorkowskistaff000000 000000 package TestPath; use strict; use warnings; use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90115/t/lib/TestPluginWithConstructor.pm000644 000765 000024 00000000413 12406561462 025713 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestPath/Controller/000755 000765 000024 00000000000 13101661740 024027 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestPath/Controller/Four.pm000644 000765 000024 00000000361 12614434663 025312 0ustar00jnapiorkowskistaff000000 000000 package TestPath::Controller::Four; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub four :Path('') :Args() { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable;Catalyst-Runtime-5.90115/t/lib/TestPath/Controller/One.pm000644 000765 000024 00000000343 12614434663 025120 0ustar00jnapiorkowskistaff000000 000000 package TestPath::Controller::One; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub one :Path { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable;Catalyst-Runtime-5.90115/t/lib/TestPath/Controller/Three.pm000644 000765 000024 00000000353 12614434663 025447 0ustar00jnapiorkowskistaff000000 000000 package TestPath::Controller::Three; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub three :Path('') { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable;Catalyst-Runtime-5.90115/t/lib/TestPath/Controller/Two.pm000644 000765 000024 00000000345 12614434663 025152 0ustar00jnapiorkowskistaff000000 000000 package TestPath::Controller::Two; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub two :Path() { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable;Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/Controller/000755 000765 000024 00000000000 13101661740 027162 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/Custom.pm000644 000765 000024 00000000164 12406561462 026657 0ustar00jnapiorkowskistaff000000 000000 package TestMiddlewareFromConfig::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/000755 000765 000024 00000000000 13101661740 026141 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/testmiddlewarefromconfig.pl000644 000765 000024 00000001441 12406561462 032472 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestMiddlewareFromConfig/share/static/000755 000765 000024 00000000000 13101661740 027430 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static2/000755 000765 000024 00000000000 13101661740 027512 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static3/000755 000765 000024 00000000000 13101661740 027513 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static3/message3.txt000644 000765 000024 00000000017 12406561462 031770 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static2/message2.txt000644 000765 000024 00000000017 12406561462 031766 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static/forced.txt000644 000765 000024 00000000017 12406561462 031440 0ustar00jnapiorkowskistaff000000 000000 forced message Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/share/static/message.txt000644 000765 000024 00000000017 12406561462 031622 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddlewareFromConfig/Controller/Root.pm000644 000765 000024 00000000404 12406561462 030450 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestMiddleware/Controller/000755 000765 000024 00000000000 13101661737 025216 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware/Custom.pm000644 000765 000024 00000000152 12406561462 024702 0ustar00jnapiorkowskistaff000000 000000 package TestMiddleware::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/000755 000765 000024 00000000000 13101661740 024167 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static/000755 000765 000024 00000000000 13101661740 025456 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static2/000755 000765 000024 00000000000 13101661740 025540 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static3/000755 000765 000024 00000000000 13101661740 025541 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static3/message3.txt000644 000765 000024 00000000017 12406561462 030016 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static2/message2.txt000644 000765 000024 00000000017 12406561462 030014 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static/forced.txt000644 000765 000024 00000000017 12406561462 027466 0ustar00jnapiorkowskistaff000000 000000 forced message Catalyst-Runtime-5.90115/t/lib/TestMiddleware/share/static/message.txt000644 000765 000024 00000000017 12406561462 027650 0ustar00jnapiorkowskistaff000000 000000 static message Catalyst-Runtime-5.90115/t/lib/TestMiddleware/Controller/Root.pm000644 000765 000024 00000000372 12406561462 026502 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestFromPSGI/Controller/000755 000765 000024 00000000000 13101661740 024521 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestFromPSGI/Controller/Root.pm000644 000765 000024 00000002215 12406561462 026011 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestDataHandlers/Controller/000755 000765 000024 00000000000 13101661740 025465 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestDataHandlers/Controller/Root.pm000644 000765 000024 00000000452 12406561462 026756 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestContentNegotiation/Controller/000755 000765 000024 00000000000 13101661740 026746 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestContentNegotiation/share/000755 000765 000024 00000000000 13101661740 025725 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestContentNegotiation/share/file.txt000644 000765 000024 00000003270 12406561462 027416 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestContentNegotiation/Controller/Root.pm000644 000765 000024 00000003247 12406561462 030244 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppWithoutUnicode/Controller/000755 000765 000024 00000000000 13101661740 026546 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppWithoutUnicode/Controller/Root.pm000644 000765 000024 00000000610 12406561462 030033 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppWithMeta/Controller/000755 000765 000024 00000000000 13101661737 025324 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppWithMeta/Controller/Root.pm000644 000765 000024 00000000610 12406561462 026603 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppViewWarnings/Controller/000755 000765 000024 00000000000 13101661740 026217 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppViewWarnings/Controller/Root.pm000644 000765 000024 00000000551 12406561462 027510 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppUnicode/Controller/000755 000765 000024 00000000000 13101661740 025162 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppUnicode/Controller/Root.pm000644 000765 000024 00000003601 12447323315 026450 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppStats/Controller/000755 000765 000024 00000000000 13101661740 024672 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppStats/Controller/Root.pm000644 000765 000024 00000000563 12406561462 026166 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppShowInternalActions/Controller/000755 000765 000024 00000000000 13101661740 027532 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppShowInternalActions/Controller/Root.pm000644 000765 000024 00000000514 12406561462 031022 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppPluginWithConstructor/Controller/000755 000765 000024 00000000000 13101661740 030134 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppPluginWithConstructor/Controller/Root.pm000644 000765 000024 00000000316 12406561462 031424 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppOneView/Controller/000755 000765 000024 00000000000 13101661740 025150 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppOneView/View/000755 000765 000024 00000000000 13101661740 023737 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppOneView/View/Dummy.pm000644 000765 000024 00000000234 12406561462 025376 0ustar00jnapiorkowskistaff000000 000000 package TestAppOneView::View::Dummy; use base 'Catalyst::View'; sub COMPONENT { bless {}, 'AClass' } package AClass; use base 'Catalyst::View'; 1; Catalyst-Runtime-5.90115/t/lib/TestAppOneView/Controller/Root.pm000644 000765 000024 00000001134 12406561462 026437 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppOnDemand/Controller/000755 000765 000024 00000000000 13101661740 025261 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppOnDemand/Controller/Body.pm000644 000765 000024 00000001374 12406561462 026530 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppNonMooseController/Controller/000755 000765 000024 00000000000 13101661740 027375 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppNonMooseController/ControllerBase.pm000644 000765 000024 00000000133 12406561462 030532 0ustar00jnapiorkowskistaff000000 000000 package TestAppNonMooseController::ControllerBase; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90115/t/lib/TestAppNonMooseController/Controller/Foo.pm000644 000765 000024 00000000161 12406561462 030463 0ustar00jnapiorkowskistaff000000 000000 package TestAppNonMooseController::Controller::Foo; use base qw/TestAppNonMooseController::ControllerBase/; 1; Catalyst-Runtime-5.90115/t/lib/TestAppMetaCompat/Controller/000755 000765 000024 00000000000 13101661740 025626 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppMetaCompat/Controller/Base.pm000644 000765 000024 00000000141 12406561462 027041 0ustar00jnapiorkowskistaff000000 000000 package TestAppMetaCompat::Controller::Base; use strict; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90115/t/lib/TestAppMetaCompat/Controller/Books.pm000644 000765 000024 00000000206 12406561462 027246 0ustar00jnapiorkowskistaff000000 000000 package TestAppMetaCompat::Controller::Books; use strict; use base qw/TestAppMetaCompat::Controller::Base/; sub edit : Local {} 1; Catalyst-Runtime-5.90115/t/lib/TestAppMatchSingleArg/Controller/000755 000765 000024 00000000000 13101661740 026424 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppMatchSingleArg/Controller/Root.pm000644 000765 000024 00000000650 12406561462 027715 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppIndexDefault/Controller/000755 000765 000024 00000000000 13101661740 026150 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppIndexDefault/Controller/Default.pm000644 000765 000024 00000000450 12406561462 030100 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppIndexDefault/Controller/IndexChained.pm000644 000765 000024 00000000437 12406561462 031044 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppIndexDefault/Controller/IndexPrivate.pm000644 000765 000024 00000000263 12406561462 031120 0ustar00jnapiorkowskistaff000000 000000 package TestAppIndexDefault::Controller::IndexPrivate; use base 'Catalyst::Controller'; sub index : Private { my ($self, $c) = @_; $c->res->body('index_private'); } 1; Catalyst-Runtime-5.90115/t/lib/TestAppIndexDefault/Controller/Root.pm000644 000765 000024 00000000465 12406561462 027445 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppEncodingSetInConfig/Controller/000755 000765 000024 00000000000 13101661737 027421 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInConfig/testappencodingsetinconfig.json000644 000765 000024 00000000034 12406561462 033607 0ustar00jnapiorkowskistaff000000 000000 { "encoding": "UTF-8" } Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInConfig/Controller/Root.pm000644 000765 000024 00000000373 12406561462 030706 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppEncodingSetInApp/Controller/000755 000765 000024 00000000000 13101661740 026726 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncodingSetInApp/Controller/Root.pm000644 000765 000024 00000000370 12406561462 030216 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppEncoding/Controller/000755 000765 000024 00000000000 13101661740 025322 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppEncoding/Controller/Root.pm000644 000765 000024 00000002024 12454003036 026577 0ustar00jnapiorkowskistaff000000 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->content_type('image/gif'); $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'; $c->res->content_type('text/plain'); $c->res->body($str); } sub end : Private { my ($self,$c) = @_; } 1; Catalyst-Runtime-5.90115/t/lib/TestAppDoubleAutoBug/Controller/000755 000765 000024 00000000000 13101661740 026275 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppDoubleAutoBug/Controller/Root.pm000644 000765 000024 00000000615 12406561462 027567 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppChainedRecursive/Controller/000755 000765 000024 00000000000 13101661740 027017 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppChainedRecursive/Controller/Foo.pm000644 000765 000024 00000000316 12406561462 030107 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestAppChainedAbsolutePathPart/Controller/000755 000765 000024 00000000000 13101661740 030272 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestAppChainedAbsolutePathPart/Controller/Foo.pm000644 000765 000024 00000000260 12406561462 031360 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp2/Controller/000755 000765 000024 00000000000 13101661740 023735 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp2/Controller/Root.pm000644 000765 000024 00000000445 12406561462 025230 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Action/000755 000765 000024 00000000000 13101661740 022745 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/ActionRole/000755 000765 000024 00000000000 13101661740 023567 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/000755 000765 000024 00000000000 13101661740 023653 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/DispatchType/000755 000765 000024 00000000000 13101661740 024131 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Model/000755 000765 000024 00000000000 13101661740 022570 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Model.pm000644 000765 000024 00000000531 12406561462 023134 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Plugin/000755 000765 000024 00000000000 13101661740 022766 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/RequestBaseBug.pm000644 000765 000024 00000000277 12406561462 024764 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Role.pm000644 000765 000024 00000000507 12406561462 023000 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/View/000755 000765 000024 00000000000 13101661740 022442 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/View/Dump/000755 000765 000024 00000000000 13101661740 023347 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/View/Dump.pm000644 000765 000024 00000003211 12406561462 023711 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/View/Dump/Action.pm000644 000765 000024 00000000273 12406561462 025133 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/View/Dump/Body.pm000644 000765 000024 00000000340 12406561462 024606 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/View/Dump/Env.pm000644 000765 000024 00000001054 12406561462 024444 0ustar00jnapiorkowskistaff000000 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' } grep { $_ !~/^Catalyst/ } 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.90115/t/lib/TestApp/View/Dump/Request.pm000644 000765 000024 00000000340 12406561462 025341 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/View/Dump/Response.pm000644 000765 000024 00000000402 12406561462 025506 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Plugin/AddDispatchTypes.pm000644 000765 000024 00000001241 12406561462 026526 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Plugin/FullyQualified.pm000644 000765 000024 00000000235 12406561462 026252 0ustar00jnapiorkowskistaff000000 000000 package TestApp::Plugin::FullyQualified; use strict; sub fully_qualified { my $c = shift; $c->stash->{fully_qualified} = 1; return $c; } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Plugin/ParameterizedRole.pm000644 000765 000024 00000000447 12406561462 026756 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Model/ClosuresInConfig.pm000644 000765 000024 00000000561 12406561462 026353 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Model/Foo/000755 000765 000024 00000000000 13101661740 023313 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Model/Foo.pm000644 000765 000024 00000000543 12406561462 023662 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Model/Generating.pm000644 000765 000024 00000000562 12406561462 025223 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Model/Foo/Bar.pm000644 000765 000024 00000000165 12406561462 024366 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/DispatchType/CustomPostLoad.pm000644 000765 000024 00000000241 12406561462 027413 0ustar00jnapiorkowskistaff000000 000000 package TestApp::DispatchType::CustomPostLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/DispatchType/CustomPreLoad.pm000644 000765 000024 00000000240 12406561462 027213 0ustar00jnapiorkowskistaff000000 000000 package TestApp::DispatchType::CustomPreLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action/000755 000765 000024 00000000000 13101661740 025070 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action.pm000644 000765 000024 00000000613 12406561462 025435 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/ActionRoles.pm000644 000765 000024 00000001150 12406561462 026437 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Anon.pm000644 000765 000024 00000002142 12406561462 025112 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Args.pm000644 000765 000024 00000000427 12406561462 025117 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Attributes.pm000644 000765 000024 00000001675 12406561462 026357 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/BodyParams.pm000644 000765 000024 00000000657 12406561462 026271 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/ContextClosure.pm000644 000765 000024 00000001400 12406561462 027174 0ustar00jnapiorkowskistaff000000 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'); } sub non_closure : Local { my ($self, $ctx) = @_; $ctx->stash(no_closure => "not a closure"); } __PACKAGE__->meta->make_immutable; 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Dump.pm000644 000765 000024 00000002242 12406561462 025125 0ustar00jnapiorkowskistaff000000 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 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.90115/t/lib/TestApp/Controller/Engine/000755 000765 000024 00000000000 13101661740 025060 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Fork.pm000644 000765 000024 00000002056 12406561462 025124 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/HTTPMethods.pm000644 000765 000024 00000004314 12504614365 026325 0ustar00jnapiorkowskistaff000000 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 typo_option : Path('opt_typo') OPTION { my ($self, $ctx) = @_; $ctx->response->body('typo'); } sub real_options : Path('opt') OPTIONS { my ($self, $ctx) = @_; $ctx->response->body('options'); } 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 chain_default :Chained('check_default') PathPart('') Args(0) { pop->res->body('chain_default'); } 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'); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Immutable/000755 000765 000024 00000000000 13101661740 025572 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Immutable.pm000644 000765 000024 00000000211 12406561462 026131 0ustar00jnapiorkowskistaff000000 000000 package TestApp::Controller::Immutable; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Index.pm000644 000765 000024 00000000256 12406561462 025272 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Keyword.pm000644 000765 000024 00000001005 12406561462 025640 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Log.pm000644 000765 000024 00000000456 12406561462 024746 0ustar00jnapiorkowskistaff000000 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' ); } sub info :Local { my ( $self, $c ) = @_; $c->log->info('info'); $c->res->body( 'logged' ); } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Moose/000755 000765 000024 00000000000 13101661740 024735 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Moose.pm000644 000765 000024 00000001510 12406561462 025277 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Priorities/000755 000765 000024 00000000000 13101661740 026004 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Priorities.pm000644 000765 000024 00000001324 12500123716 026340 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Root.pm000644 000765 000024 00000006760 12406561462 025154 0ustar00jnapiorkowskistaff000000 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'); # route for /go_here doesn't exist # it is only for checking HTTP response code, content-type etc. } 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')); # route for /go_here doesn't exist # it is only for checking HTTP response code, content-type etc. } 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'); # route for /go_here doesn't exist # it is only for checking HTTP response code, content-type etc. } 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'); # route for /go_here doesn't exist # it is only for checking HTTP response code, content-type etc. } sub test_remove_body_with_304 :Global { my ($self, $c) = @_; $c->res->status(304); $c->res->content_type('text/html'); $c->res->body("Body should not be set"); } sub test_remove_body_with_204 :Global { my ($self, $c) = @_; $c->res->status(204); $c->res->content_type('text/html'); $c->res->body("Body should not be set"); } sub test_remove_body_with_100 :Global { my ($self, $c) = @_; $c->res->status(100); $c->res->body("Body should not be set"); } sub test_nobody_with_100 :Global { my ($self, $c) = @_; $c->res->status(100); } sub end : Private { my ($self,$c) = @_; } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm000644 000765 000024 00000000235 12406561462 031025 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm000644 000765 000024 00000000237 12406561462 031356 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Priorities/MultiMethod.pm000644 000765 000024 00000000545 12406561462 030610 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Priorities/path_vs_index.pm000644 000765 000024 00000000236 12406561462 031205 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Moose/MethodModifiers.pm000644 000765 000024 00000000367 12406561462 030372 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Moose/NoAttributes.pm000644 000765 000024 00000000314 12406561462 027723 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Immutable/HardToReload.pm000644 000765 000024 00000001444 12406561462 030452 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Request/000755 000765 000024 00000000000 13101661740 026510 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Engine/Response/000755 000765 000024 00000000000 13101661740 026656 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Engine/Response/Cookies.pm000644 000765 000024 00000002153 12406561462 030620 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Response/Errors.pm000644 000765 000024 00000000576 12406561462 030507 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Response/Headers.pm000644 000765 000024 00000000634 12406561462 030601 0ustar00jnapiorkowskistaff000000 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', [ { some => [qw(fixed content)] } ]); } 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Engine/Response/Large.pm000644 000765 000024 00000000446 12406561462 030261 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Response/Print.pm000644 000765 000024 00000000621 12406561462 030316 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Response/Redirect.pm000644 000765 000024 00000001173 12406561462 030766 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Response/Status.pm000644 000765 000024 00000001456 12406561462 030514 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Request/Uploads.pm000644 000765 000024 00000000737 12406561462 030473 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Engine/Request/URI.pm000644 000765 000024 00000005237 12406561462 027523 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Action.pm000644 000765 000024 00000003603 12406561462 026654 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Auto/000755 000765 000024 00000000000 13101661740 026000 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action/Auto.pm000644 000765 000024 00000000507 12406561462 026347 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Begin.pm000644 000765 000024 00000000435 12406561462 026463 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/000755 000765 000024 00000000000 13101661740 026423 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action/Chained.pm000644 000765 000024 00000022113 12406561462 026767 0ustar00jnapiorkowskistaff000000 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) { } # # Error in the middle of a chain # sub chain_error_a :Chained :PathPart('chained/chain_error') :CaptureArgs(1) { $_[1]->error( 'break in the middle of a chain' ); } sub chain_error_b :Chained('chain_error_a') :PathPart('end') :Args(1) {} # # Die in the middle of a chain # sub chain_die_a :Chained :PathPart('chained/chain_die') :CaptureArgs(1) { die( "die in the middle of a chain\n" ); } 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.90115/t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm000644 000765 000024 00000000603 12406561462 031454 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Default.pm000644 000765 000024 00000000316 12406561462 027021 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Detach.pm000644 000765 000024 00000001725 12406561462 026632 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/DieInEnd.pm000644 000765 000024 00000000442 12406561462 027054 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/End.pm000644 000765 000024 00000000374 12406561462 026147 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Forward.pm000644 000765 000024 00000004031 12406561462 027037 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/ForwardTo.pm000644 000765 000024 00000000350 12406561462 027342 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Global.pm000644 000765 000024 00000000745 12406561462 026643 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Go.pm000644 000765 000024 00000003750 12406561462 026007 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Index.pm000644 000765 000024 00000000304 12406561462 026501 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Inheritance.pm000644 000765 000024 00000002642 12406561462 027672 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Local.pm000644 000765 000024 00000001234 12406561462 026467 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Path.pm000644 000765 000024 00000001667 12406561462 026343 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Private.pm000644 000765 000024 00000001204 12406561462 027044 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Streaming.pm000644 000765 000024 00000002114 12406561462 027364 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/TestMultipath.pm000644 000765 000024 00000000566 12406561462 030253 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/TestRelative.pm000644 000765 000024 00000001437 12406561462 030055 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Visit.pm000644 000765 000024 00000004512 12406561462 026535 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/ArgsOrder.pm000644 000765 000024 00000001635 12406561462 030665 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Auto/000755 000765 000024 00000000000 13101661740 027333 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action/Chained/Auto.pm000644 000765 000024 00000001326 12406561462 027702 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Bar.pm000644 000765 000024 00000000450 12406561462 027473 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/CaptureArgs.pm000644 000765 000024 00000003620 12406561462 031211 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Foo.pm000644 000765 000024 00000001536 12406561462 027520 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/ParentChain/000755 000765 000024 00000000000 13101661740 030617 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm000644 000765 000024 00000001075 12406561462 031167 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/PassedArgs.pm000644 000765 000024 00000001577 12406561462 031036 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm000644 000765 000024 00000000440 12406561462 031040 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Root.pm000644 000765 000024 00000000454 12665177154 027726 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm000644 000765 000024 00000000352 12406561462 032737 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Auto/Bar.pm000644 000765 000024 00000000515 12406561462 030405 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Auto/Detach.pm000644 000765 000024 00000000571 12406561462 031073 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Auto/Foo.pm000644 000765 000024 00000000516 12406561462 030425 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Chained/Auto/Forward.pm000644 000765 000024 00000000575 12406561462 031313 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Auto/Abort.pm000644 000765 000024 00000000703 12406561462 027414 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Auto/Deep.pm000644 000765 000024 00000000527 12406561462 027226 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Auto/Default.pm000644 000765 000024 00000000574 12406561462 027737 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Controller/Action/Auto/Detach.pm000644 000765 000024 00000001372 12614444671 027543 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/ActionRole/Boo.pm000644 000765 000024 00000000442 12406561462 024653 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/ActionRole/Kooh.pm000644 000765 000024 00000000304 12406561462 025031 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/ActionRole/Moo.pm000644 000765 000024 00000000236 12406561462 024667 0ustar00jnapiorkowskistaff000000 000000 package TestApp::ActionRole::Moo; use Moose::Role; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90115/t/lib/TestApp/Action/TestActionArgsFromConstructor.pm000644 000765 000024 00000000621 12406561462 031275 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Action/TestBefore.pm000644 000765 000024 00000000415 12406561462 025354 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Action/TestExtraArgsAction.pm000644 000765 000024 00000000604 12406561462 027210 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Action/TestMatchCaptures.pm000644 000765 000024 00000000576 12406561462 026725 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/TestApp/Action/TestMyAction.pm000644 000765 000024 00000000767 12406561462 025707 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Test/Apple.pm000644 000765 000024 00000000207 12520162327 022466 0ustar00jnapiorkowskistaff000000 000000 package Test::Apple; use strict; use warnings; use parent qw/Catalyst::Controller/; sub default :Path { } sub apple :Local { } 1; Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/Controller/000755 000765 000024 00000000000 13101661740 025040 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/Script/000755 000765 000024 00000000000 13101661740 024161 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/TraitFor/000755 000765 000024 00000000000 13101661740 024447 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/TraitFor/Script/000755 000765 000024 00000000000 13101661740 025713 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/TraitFor/Script.pm000644 000765 000024 00000000273 12406561462 026262 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ScriptTestApp/TraitFor/Script/Bar.pm000644 000765 000024 00000000277 12406561462 026772 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ScriptTestApp/TraitFor/Script/Foo.pm000644 000765 000024 00000000277 12406561462 027011 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ScriptTestApp/Script/Bar.pm000644 000765 000024 00000000204 12406561462 025226 0ustar00jnapiorkowskistaff000000 000000 package ScriptTestApp::Script::Bar; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/Script/CompileTest.pm000644 000765 000024 00000000157 12406561462 026761 0ustar00jnapiorkowskistaff000000 000000 package ScriptTestApp::Script::CompileTest; use Moose; use namespace::autoclean; die("Does not compile"); 1; Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/Script/Foo.pm000644 000765 000024 00000000204 12406561462 025245 0ustar00jnapiorkowskistaff000000 000000 package ScriptTestApp::Script::Foo; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90115/t/lib/ScriptTestApp/Controller/Root.pm000644 000765 000024 00000000260 12406561462 026326 0ustar00jnapiorkowskistaff000000 000000 package ScriptTestApp::Controller::Root; use Moose; use namespace::autoclean; BEGIN { extends 'Catalyst::Controller' } sub default : Chained('/') PathPart('') Args() {} 1; Catalyst-Runtime-5.90115/t/lib/PluginTestApp/Controller/000755 000765 000024 00000000000 13101661740 025032 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/PluginTestApp/Controller/Root.pm000644 000765 000024 00000003031 12406561462 026317 0ustar00jnapiorkowskistaff000000 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 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.90115/t/lib/DeprecatedTestApp/C/000755 000765 000024 00000000000 13101661740 023673 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/DeprecatedTestApp/C/Root.pm000644 000765 000024 00000000514 12406561462 025163 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ChainedActionsApp/Controller/000755 000765 000024 00000000000 13101661740 025610 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ChainedActionsApp/Controller/Root.pm000644 000765 000024 00000004656 12406561462 027113 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Action/000755 000765 000024 00000000000 13101661740 023151 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/Catalyst/ActionRole/000755 000765 000024 00000000000 13101661740 023773 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/Catalyst/Plugin/000755 000765 000024 00000000000 13101661740 023172 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/Catalyst/Script/000755 000765 000024 00000000000 13101661740 023200 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/Catalyst/Script/Bar.pm000644 000765 000024 00000000177 12406561462 024256 0ustar00jnapiorkowskistaff000000 000000 package Catalyst::Script::Bar; use Moose; use namespace::autoclean; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90115/t/lib/Catalyst/Script/Baz.pm000644 000765 000024 00000000443 12406561462 024262 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Script/CompileTest.pm000644 000765 000024 00000000453 12406561462 025777 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Plugin/Test/000755 000765 000024 00000000000 13101661740 024111 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/Catalyst/Plugin/Test/Deprecated.pm000644 000765 000024 00000000667 12406561462 026527 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Plugin/Test/Errors.pm000644 000765 000024 00000001145 12406561462 025733 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Plugin/Test/Headers.pm000644 000765 000024 00000001370 12406561462 026032 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Plugin/Test/MangleDollarUnderScore.pm000644 000765 000024 00000000627 12406561462 031016 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Plugin/Test/Plugin.pm000644 000765 000024 00000001442 12406561462 025715 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/ActionRole/Moo.pm000644 000765 000024 00000000272 12406561462 025073 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/ActionRole/Zoo.pm000644 000765 000024 00000000272 12406561462 025110 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Action/TestAfter.pm000644 000765 000024 00000000616 12406561462 025422 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/Catalyst/Action/TestBefore.pm000644 000765 000024 00000000355 12406561462 025563 0ustar00jnapiorkowskistaff000000 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.90115/t/lib/ACLTestApp/Controller/000755 000765 000024 00000000000 13101661740 024173 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/t/lib/ACLTestApp/Controller/Root.pm000644 000765 000024 00000000454 12406561462 025466 0ustar00jnapiorkowskistaff000000 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.90115/t/conf/extra.conf.in000644 000765 000024 00000002522 12406561462 022736 0ustar00jnapiorkowskistaff000000 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.90115/t/author/http-server.t000644 000765 000024 00000006016 12406561462 023366 0ustar00jnapiorkowskistaff000000 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.90115/t/author/notabs.t000644 000765 000024 00000000173 12406561462 022367 0ustar00jnapiorkowskistaff000000 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.90115/t/author/pod.t000644 000765 000024 00000000125 12406561462 021660 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use Test::Pod 1.14; all_pod_files_ok(); Catalyst-Runtime-5.90115/t/author/podcoverage.t000644 000765 000024 00000001316 12572415042 023373 0ustar00jnapiorkowskistaff000000 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.90115/t/author/spelling.t000644 000765 000024 00000005463 12614432252 022720 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More; use Test::Spelling; add_stopwords(qw( Accel API CGI MVC PSGI Plack README SSI Starman XXXX URI htaccess middleware mixins namespace psgi startup Deprecations catamoose cataplack linearize subclasses subdirectories refactoring adaptors validator remediations 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 IOLayer ctx _application MyApp restarter httponly Utils stash's unescapes actionchain dispatchtype dispatchtypes redispatch redispatching CaptureArgs ChainedParent PathPart PathParts PathPrefix BUILDARGS metaclass namespaces pre ARGV ReverseProxy TT UI filename tempname request's subdirectory ini uninstalled uppercased wiki bitmask uri url urls dir hostname proxied http https IP SSL inline INLINE plugins cpanfile resized FastCGI Stringifies Rethrows DispatchType Wishlist Refactor ROADMAP HTTPS Unescapes Restarter Nginx Refactored ActionClass LocalRegex LocalRegexp MyAction metadata cometd io psgix websocket websockets proxying UTF unicode async codebase dev encodable filenames params MyMiddleware Sendfile JSON xml POSTs POSTed RESTful performant subref actionrole chunked chunking codewise distingush equivilent plack Javascript gzipping ConfigLoader getline whitepaper matchable TBD WIP Andreas André 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 Scala Schutz Sedlacek Sheidlower SpiceMan Styn Szilakszi Tatsuhiko Ulf Upasana Vilain Viljo Wardley Westermann Willert Yuval abraxxa abw alls andrewalker andyg audreyt bricas chansen codebases davewood dhoss dkubb dwc esskar fREW fireartist frew gabb groditi hobbs ilmari jcamacho jhannah jnap jon konobi marcus mgrimes miyagawa mst multipart Napiorkowski naughton ningu nothingmuch numa obra phaylon rafl rainboxx sri szbalint uploadtmp vanstyn willert wreis )); set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok(); done_testing(); Catalyst-Runtime-5.90115/t/author/unicode_plugin_nested_params.t000644 000765 000024 00000004372 12406561462 027017 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/c3_appclass_bug.t000644 000765 000024 00000000633 12406561462 024556 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/c3_mro.t000644 000765 000024 00000001677 12406561462 022721 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/caf_backcompat.t000644 000765 000024 00000001213 12406561462 024436 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/catalyst_test_utf8.t000644 000765 000024 00000001561 12437213776 025366 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/custom_live_component_controller_action_auto_doublebug.t000644 000765 000024 00000002077 12406561462 035025 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/custom_live_path_bug.t000644 000765 000024 00000001317 12406561462 025730 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/deprecated_test_import.t000644 000765 000024 00000000330 12406561462 026251 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/deprecated_test_unimported.t000644 000765 000024 00000000603 12406561462 027130 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/error_page_dump.t000644 000765 000024 00000000517 12406561462 024701 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_action.t000644 000765 000024 00000016602 12406561462 031707 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_auto.t000644 000765 000024 00000014630 12406561462 031401 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_begin.t000644 000765 000024 00000002514 12406561462 031513 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_chained.t000644 000765 000024 00000121540 12406561462 032023 0ustar00jnapiorkowskistaff000000 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_error_a TestApp::Controller::Action::Chained->end ]; my $expected = join( ", ", @expected ); ok( my $response = request('http://localhost/chained/chain_error/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' ); } # # Test dieing 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: Caught exception in TestApp::Controller::Action::Chained->chain_die_a "die 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.90115/t/aggregate/live_component_controller_action_chained2.t000644 000765 000024 00000001567 12406561462 032113 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_default.t000644 000765 000024 00000005347 12406561462 032062 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_detach.t000644 000765 000024 00000005530 12406561462 031660 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_die_in_end.t000644 000765 000024 00000001014 12406561462 032476 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_end.t000644 000765 000024 00000002557 12406561462 031204 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_forward.t000644 000765 000024 00000021064 12406561462 032074 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_global.t000644 000765 000024 00000004531 12406561462 031670 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_go.t000644 000765 000024 00000021574 12406561462 031043 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_index.t000644 000765 000024 00000006305 12406561462 031540 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_index_or_default.t000644 000765 000024 00000001776 12406561462 033753 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_inheritance.t000644 000765 000024 00000007574 12406561462 032733 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_local.t000644 000765 000024 00000010752 12406561462 031524 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_multipath.t000644 000765 000024 00000003477 12406561462 032447 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_path.t000644 000765 000024 00000012066 12406561462 031366 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_path_matchsingle.t000644 000765 000024 00000001262 12406561462 033740 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_private.t000644 000765 000024 00000005065 12406561462 032105 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_streaming.t000644 000765 000024 00000006411 12406561462 032420 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_action_visit.t000644 000765 000024 00000023431 12406561462 031566 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_actionroles.t000644 000765 000024 00000001531 12406561462 031412 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_anon.t000644 000765 000024 00000001617 12406561462 030030 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_args.t000644 000765 000024 00000004323 12406561462 030026 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_attributes.t000644 000765 000024 00000002527 12406561462 031264 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_controller_httpmethods.t000644 000765 000024 00000003651 12475111327 031435 0ustar00jnapiorkowskistaff000000 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'; sub OPTIONS { HTTP::Request->new('OPTIONS', @_); } 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'); is(request(GET '/httpmethods/opt_typo')->content, 'typo'); is(request(POST '/httpmethods/opt_typo')->content, 'typo'); is(request(PUT '/httpmethods/opt_typo')->content, 'typo'); is(request(OPTIONS '/httpmethods/opt')->content, 'options'); is(request(GET '/httpmethods/opt')->content, 'default'); is(request(POST '/httpmethods/opt')->content, 'default'); done_testing; Catalyst-Runtime-5.90115/t/aggregate/live_component_controller_moose.t000644 000765 000024 00000002415 12406561462 030214 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_component_view_single.t000644 000765 000024 00000001411 12406561462 027135 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_auth.t000644 000765 000024 00000001773 12406561462 026611 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_body.t000644 000765 000024 00000005052 12406561462 026577 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_body_demand.t000644 000765 000024 00000004547 12406561462 030117 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_cookies.t000644 000765 000024 00000002640 12406561462 027276 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_env.t000644 000765 000024 00000002060 12406561462 026426 0ustar00jnapiorkowskistaff000000 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; my $response = request("http://localhost/dump/env", { 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 dump/env'; SKIP: { if ( $ENV{CATALYST_SERVER} ) { skip 'Using remote server', 1; } is $env->{$EXPECTED_ENV_VAR}, $EXPECTED_ENV_VAL, 'Value we set as expected for /dump/env' } done_testing; Catalyst-Runtime-5.90115/t/aggregate/live_engine_request_escaped_path.t000644 000765 000024 00000001105 12406561462 030255 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_headers.t000644 000765 000024 00000005413 12406561462 027256 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_parameters.t000644 000765 000024 00000012720 12406561462 030005 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_prepare_parameters.t000755 000765 000024 00000001755 12406561462 031534 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_remote_user.t000644 000765 000024 00000002225 12406561462 030172 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_uploads.t000644 000765 000024 00000031171 12406561462 027312 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_request_uri.t000644 000765 000024 00000016610 12406561462 026443 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_body.t000644 000765 000024 00000000271 12406561462 026743 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_cookies.t000644 000765 000024 00000005510 12406561462 027443 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_emptybody.t000644 000765 000024 00000000734 12406561462 030026 0ustar00jnapiorkowskistaff000000 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, ''; SKIP: { skip "content-length for body of '' is now server dependent", 1; ok !defined $res->header('Content-Length'); } } done_testing; Catalyst-Runtime-5.90115/t/aggregate/live_engine_response_errors.t000644 000765 000024 00000003353 12406561462 027326 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_headers.t000644 000765 000024 00000003023 12406561462 027417 0ustar00jnapiorkowskistaff000000 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' ) { is( $response->header('Content-Length'), $content_length, 'Response Header Content-Length' ) or diag $response->content; is( length($response->content), $response->header('Content-Length'), 'GET method content' ); } } Catalyst-Runtime-5.90115/t/aggregate/live_engine_response_large.t000644 000765 000024 00000001172 12406561462 027101 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_print.t000644 000765 000024 00000001005 12406561462 027136 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_redirect.t000644 000765 000024 00000004254 12406561462 027614 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_response_status.t000644 000765 000024 00000004426 12406561462 027337 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_setup_basics.t000644 000765 000024 00000000464 12406561462 026560 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_engine_setup_plugins.t000644 000765 000024 00000000506 12406561462 026772 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_loop.t000644 000765 000024 00000001057 12406561462 023517 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_plugin_loaded.t000644 000765 000024 00000001471 12406561462 025354 0ustar00jnapiorkowskistaff000000 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 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.90115/t/aggregate/live_priorities.t000644 000765 000024 00000004373 12500115761 024733 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_recursion.t000644 000765 000024 00000001210 12406561462 024546 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/live_view_warnings.t000644 000765 000024 00000000663 12406561462 025432 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/meta_method_unneeded.t000644 000765 000024 00000000737 12406561462 025670 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/psgi_file.t000644 000765 000024 00000003214 12406561462 023465 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/to_app.t000644 000765 000024 00000000262 12454003036 022775 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use TestApp; use Test::More; ok(TestApp->can('to_app')); is(ref(TestApp->to_app), 'CODE'); done_testing; Catalyst-Runtime-5.90115/t/aggregate/unit_controller_actions.t000644 000765 000024 00000001372 12406561462 026471 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_controller_config.t000755 000765 000024 00000010021 12406561462 026270 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_controller_namespace.t000644 000765 000024 00000000635 12406561462 026766 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_action.t000644 000765 000024 00000002335 12406561462 025053 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_action_for.t000644 000765 000024 00000000764 12406561462 025725 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_appclass_roles_in_plugin_list.t000644 000765 000024 00000000460 12406561462 031704 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_classdata.t000644 000765 000024 00000006307 12406561462 025540 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_component.t000644 000765 000024 00000005327 12406561462 025604 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_component_generating.t000644 000765 000024 00000000452 12406561462 030001 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_component_layers.t000644 000765 000024 00000001460 12406561462 027155 0ustar00jnapiorkowskistaff000000 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'); # I commented out this line since we seem to just massively # fail on the 'you already did setup. I have no idea why its # here - jnap #TestApp->setup; is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config'); Catalyst-Runtime-5.90115/t/aggregate/unit_core_component_loading.t000644 000765 000024 00000016375 12614433663 027310 0ustar00jnapiorkowskistaff000000 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 + 9 + 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}, ); } make_component_file( $libdir, 'ExternalExtra', 'Controller', 'Controller', 'FooExternal', ); eval qq( package $appclass; use Catalyst; $shut_up_deprecated_warnings __PACKAGE__->config->{ setup_components } = { search_extra => [ '::Extra', 'ExternalExtra::Controller' ], except => [ "${appclass}::Controller::Foo" ] }; __PACKAGE__->setup; ); can_ok( $appclass, 'components'); $complist = $appclass->components; is(scalar keys %$complist, 24+2, "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' ); isa_ok($appclass->controller('FooExternal'), 'Catalyst::Controller', 'ExternalExtra::Controller::FooExternal 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.90115/t/aggregate/unit_core_component_mro.t000644 000765 000024 00000000732 12406561462 026454 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_controller_actions_config.t000644 000765 000024 00000000375 12406561462 031030 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_ctx_attr.t000644 000765 000024 00000001360 12406561462 025423 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_engine-prepare_path.t000644 000765 000024 00000010327 12406561462 027513 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_engine_fixenv-iis6.t000644 000765 000024 00000004202 12406561462 027265 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_engine_fixenv-lighttpd.t000644 000765 000024 00000003240 12406561462 030233 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_log.t000755 000765 000024 00000003575 12406561462 024371 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More tests => 24; 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, "autoflush"; $log->autoflush(0); 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 should return a new object'; isa_ok $log, $SUBCLASS, '... and the object it returns'; isa_ok $log, $LOG, '... and it also'; can_ok $log, "autoflush"; $log->autoflush(0); 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.90115/t/aggregate/unit_core_log_autoflush.t000755 000765 000024 00000003312 12406561462 026450 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use Test::More tests => 20; 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'; ok @MESSAGES, '... and immediately flush the log'; 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, @_; } } @MESSAGES = (); # clear the message log my $SUBCLASS = 'Catalyst::Log::Subclass'; can_ok $SUBCLASS, 'new'; ok $log = Catalyst::Log::Subclass->new, '... and the log subclass constructor should 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'; ok @MESSAGES, '... and immediately flush the log'; 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.90115/t/aggregate/unit_core_merge_config_hashes.t000644 000765 000024 00000001736 12406561462 027561 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_mvc.t000644 000765 000024 00000021646 12406561462 024371 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_path_to.t000644 000765 000024 00000001515 12406561462 025233 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_plugin.t000644 000765 000024 00000002624 12406561462 025075 0ustar00jnapiorkowskistaff000000 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 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.90115/t/aggregate/unit_core_script_cgi.t000644 000765 000024 00000001223 12406561462 025717 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_create.t000644 000765 000024 00000004223 12406561462 026423 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_fastcgi.t000644 000765 000024 00000005733 12406561462 026607 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_help.t000644 000765 000024 00000001020 12406561462 026100 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_run_options.t000644 000765 000024 00000001574 12406561462 027545 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_server-without_modules.t000644 000765 000024 00000001556 12406561462 031725 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_script_server.t000644 000765 000024 00000015551 12406561462 026474 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_scriptrunner.t000644 000765 000024 00000001403 12406561462 026327 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_setup.t000644 000765 000024 00000005374 12422532613 024736 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_setup_log.t000644 000765 000024 00000004220 12422532613 025564 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_setup_stats.t000644 000765 000024 00000003507 12406561462 026156 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_core_uri_for.t000644 000765 000024 00000021045 12614433663 025244 0ustar00jnapiorkowskistaff000000 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' ); 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 1' ); is( Catalyst::uri_for( $context, '0#fragment', { param1 => 'value1' } )->as_string, 'http://127.0.0.1/foo/yada/0?param1=value1#fragment', 'URI for path 0 with fragment and query params 1' ); 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 3' ); is( Catalyst::uri_for( $context, '/foo#bar/baz', { param1 => 'value1' } )->as_string, 'http://127.0.0.1/foo/foo?param1=value1#bar/baz', 'URI for path with fragment and query params 3' ); is( Catalyst::uri_for( 'TestApp', '/bar/baz' )->as_string, '/bar/baz', 'URI for absolute path, called with only class name' ); ## relative action (or path) doesn't make sense when calling as class method # is( # Catalyst::uri_for( 'TestApp', 'bar/baz' )->as_string, # '/yada/bar/baz', # 'URI for relative path, called with only class name' # ); is( Catalyst::uri_for( 'TestApp', '/', 'arg1', 'arg2' )->as_string, '/arg1/arg2', 'URI for root action with args, called with only class name' ); ## relative action (or path) doesn't make sense when calling as class method # is( Catalyst::uri_for( 'TestApp', '../quux' )->as_string, # '/quux', 'URI for relative dot path, called with only class name' ); is( Catalyst::uri_for( 'TestApp', '/quux', { param1 => 'value1' } )->as_string, '/quux?param1=value1', 'URI for quux action with query params, called with only class name' ); is (Catalyst::uri_for( 'TestApp', '/bar/wibble?' )->as_string, '/bar/wibble%3F', 'Question Mark gets encoded, called with only class name' ); ## relative action (or path) doesn't make sense when calling as class method # is( Catalyst::uri_for( 'TestApp', qw/bar wibble?/, 'with space' )->as_string, # '/yada/bar/wibble%3F/with%20space', 'Space gets encoded, called with only class name' # ); is( Catalyst::uri_for( 'TestApp', '/bar', 'with+plus', { 'also' => 'with+plus' })->as_string, '/bar/with+plus?also=with%2Bplus', 'Plus is not encoded, called with only class name' ); 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' ); # test with empty arg { my @warnings; local $SIG{__WARN__} = sub { push @warnings, @_ }; is( Catalyst::uri_for( $context )->as_string, 'http://127.0.0.1/foo/yada', 'URI with no action' ); is( Catalyst::uri_for( $context, 0 )->as_string, 'http://127.0.0.1/foo/yada/0', 'URI with 0 path' ); is_deeply(\@warnings, [], "No warnings with no path argument"); } $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.90115/t/aggregate/unit_core_uri_for_action.t000644 000765 000024 00000021142 12614441503 026567 0ustar00jnapiorkowskistaff000000 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', } ); # JNAP: I'm going to todo these tests, calling uri_for as a class method # should work, but its not really useful so I think theres not much harm # if someone needs this for a business case they are welcome to figure out # what is going TODO: { local $TODO = "Need to fix using uri_for and uri_for_action as a class method"; # this works, using $ctx is($context->uri_for($context->controller('Action::Chained')->action_for('endpoint')), "http://127.0.0.1/foo/yada/chained/foo/end", "uri_for a controller and action"); # this fails, uri_for returns undef, why isn't this one working?? is( $context->uri_for_action( '/action/chained/endpoint' ), 'http://127.0.0.1/chained/foo/end', "uri_for a controller and action as string"); # this fails, uri_for returns undef is(TestApp->uri_for_action($context->controller('Action::Chained')->action_for('endpoint')), "/chained/foo/end", "uri_for a controller and action, called with only class name"); # this fails, uri_for returns undef is(TestApp->uri_for_action('/action/chained/endpoint' ), "/chained/foo/end", "uri_for a controller and action as string, called with only class name"); # this fails, uri_for returns undef is(TestApp->uri_for_action( $chained_action), "/chained/foo/end", "uri_for action via dispatcher, called with only class name"); } 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.90115/t/aggregate/unit_core_uri_for_multibytechar.t000644 000765 000024 00000003237 12454003036 030170 0ustar00jnapiorkowskistaff000000 000000 use utf8; 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'); 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'); is( $context->uri_for($action, ['♥'], '♥', { '♥' => '♥'}), 'http://127.0.0.1/chained/roundtrip_urifor/' . '%E2%99%A5' . '/' . '%E2%99%A5' . '?' . '%E2%99%A5' . '=' . '%E2%99%A5', 'uri_for with utf8 captures and args'); # ^ the match string is purposefully broken up to aid viewing, please to 'fix' it. done_testing; Catalyst-Runtime-5.90115/t/aggregate/unit_core_uri_with.t000644 000765 000024 00000004053 12406561462 025427 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_dispatcher_requestargs_restore.t000644 000765 000024 00000001470 12406561462 031103 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_engineloader.t000644 000765 000024 00000001476 12406561462 025227 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_load_catalyst_test.t000644 000765 000024 00000013357 12406561462 026456 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t000644 000765 000024 00000000526 12406561462 033773 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_metaclass_compat_non_moose.t000644 000765 000024 00000000144 12406561462 030155 0ustar00jnapiorkowskistaff000000 000000 use strict; use warnings; use lib 't/lib'; use Test::More tests => 1; use_ok('TestAppMetaCompat'); Catalyst-Runtime-5.90115/t/aggregate/unit_metaclass_compat_non_moose_controller.t000644 000765 000024 00000000756 12406561462 032431 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_response.t000644 000765 000024 00000000547 12406561462 024427 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_utils_env_value.t000644 000765 000024 00000002745 12406561462 025777 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_utils_home.t000644 000765 000024 00000001726 12406561462 024741 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_utils_prefix.t000644 000765 000024 00000002001 12406561462 025271 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/unit_utils_request.t000644 000765 000024 00000001112 12406561462 025466 0ustar00jnapiorkowskistaff000000 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.90115/t/aggregate/utf8_content_length.t000644 000765 000024 00000001311 12454003036 025470 0ustar00jnapiorkowskistaff000000 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.90115/script/catalyst.pl000755 000765 000024 00000010437 12406561462 022643 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/000755 000765 000024 00000000000 13101661740 021471 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst.pm000644 000765 000024 00000463402 13101661644 022043 0ustar00jnapiorkowskistaff000000 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::Middleware::ContentLength; use Plack::Middleware::Head; use Plack::Middleware::HTTPExceptions; use Plack::Middleware::FixMissingBodyInRedirect; use Plack::Middleware::MethodOverride; use Plack::Middleware::RemoveRedundantBody; use Catalyst::Middleware::Stash; use Plack::Util; use Class::Load 'load_class'; use Encode 2.21 'decode_utf8', 'encode_utf8'; use Scalar::Util; BEGIN { require 5.008003; } has stack => (is => 'ro', 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; my $class = ref $self; my $composed_request_class = $class->composed_request_class; return $composed_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; } sub composed_request_class { my $class = shift; return $class->_composed_request_class if $class->_composed_request_class; my @traits = (@{$class->request_class_traits||[]}, @{$class->config->{request_class_traits}||[]}); # For each trait listed, figure out what the namespace is. First we try the $trait # as it is in the config. Then try $MyApp::TraitFor::Request:$trait. Last we try # Catalyst::TraitFor::Request::$trait. If none load, throw error. my $trait_ns = 'TraitFor::Request'; my @normalized_traits = map { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; if ($class->debug && scalar(@normalized_traits)) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @normalized_traits; $class->log->debug( "Composed Request Class Traits:\n" . $t->draw . "\n" ); } return $class->_composed_request_class(Moose::Util::with_traits($class->request_class, @normalized_traits)); } has response => ( is => 'rw', default => sub { my $self = shift; my $class = ref $self; my $composed_response_class = $class->composed_response_class; return $composed_response_class->new( $self->_build_response_constructor_args); }, lazy => 1, ); sub _build_response_constructor_args { return +{ _log => $_[0]->log, encoding => $_[0]->encoding, }; } sub composed_response_class { my $class = shift; return $class->_composed_response_class if $class->_composed_response_class; my @traits = (@{$class->response_class_traits||[]}, @{$class->config->{response_class_traits}||[]}); my $trait_ns = 'TraitFor::Response'; my @normalized_traits = map { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; if ($class->debug && scalar(@normalized_traits)) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @normalized_traits; $class->log->debug( "Composed Response Class Traits:\n" . $t->draw . "\n" ); } return $class->_composed_response_class(Moose::Util::with_traits($class->response_class, @normalized_traits)); } 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 _encoding _encode_check finalized_default_middleware request_class_traits response_class_traits stats_class_traits _composed_request_class _composed_response_class _composed_stats_class/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); __PACKAGE__->request_class('Catalyst::Request'); __PACKAGE__->response_class('Catalyst::Response'); __PACKAGE__->stats_class('Catalyst::Stats'); sub composed_stats_class { my $class = shift; return $class->_composed_stats_class if $class->_composed_stats_class; my @traits = (@{$class->stats_class_traits||[]}, @{$class->config->{stats_class_traits}||[]}); my $trait_ns = 'TraitFor::Stats'; my @normalized_traits = map { Class::Load::load_first_existing_class($_, $class.'::'.$trait_ns.'::'. $_, 'Catalyst::'.$trait_ns.'::'.$_) } @traits; if ($class->debug && scalar(@normalized_traits)) { my $column_width = Catalyst::Utils::term_width() - 6; my $t = Text::SimpleTable->new($column_width); $t->row($_) for @normalized_traits; $class->log->debug( "Composed Stats Class Traits:\n" . $t->draw . "\n" ); } return $class->_composed_stats_class(Moose::Util::with_traits($class->stats_class, @normalized_traits)); } __PACKAGE__->_encode_check(Encode::FB_CROAK | Encode::LEAVE_SRC); # Remember to update this in Catalyst::Runtime as well! our $VERSION = '5.90115'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases 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->detach >> 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' ); The stash hash is currently stored in the PSGI C<$env> and is managed by L. Since it's part of the C<$env> items in the stash can be accessed in sub applications mounted under your main L application. For example if you delegate the response of an action to another L application, that sub application will have access to all the stash keys of the main one, and if can of course add more keys of its own. However those new keys will not 'bubble' back up to the main application. For more information the best thing to do is to review the test case: t/middleware-stash.t in the distribution /t directory. =cut sub stash { my $c = shift; $c->log->error("You are requesting the stash but you don't have a context") unless blessed $c; return Catalyst::Middleware::Stash::get_stash($c->req->env)->(@_); } =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'); Calling this will always return an arrayref (if there are no errors it will be an empty arrayref. =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. Please note that if an action throws an exception, the value of state should no longer be considered the return if the last action. It is generally going to be 0, which indicates an error state. Examine $c->error for error details. =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); } =head2 $c->has_errors Returns true if you have errors =cut sub has_errors { scalar(@{shift->error}) ? 1:0 } =head2 $c->last_error Returns the most recent error in the stack (the one most recently added...) or nothing if there are no errors. This does not modify the contents of the error stack. =cut sub last_error { my (@errs) = @{shift->error}; return scalar(@errs) ? $errs[-1]: undef; } =head2 shift_errors shifts the most recently added error off the error stack and returns it. Returns nothing if there are no more errors. =cut sub shift_errors { my ($self) = @_; my @errors = @{$self->error}; my $err = shift(@errors); $self->{error} = \@errors; return $err; } =head2 pop_errors pops the most recently added error off the error stack and returns it. Returns nothing if there are no more errors. =cut sub pop_errors { my ($self) = @_; my @errors = @{$self->error}; my $err = pop(@errors); $self->{error} = \@errors; return $err; } 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(ref $comp eq 'CODE') { $comp = $comp->(); } if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) { return $comp->ACCEPT_CONTEXT( $c, @args ); } $c->log->warn("You called component '${\$comp->catalyst_component_name}' with arguments [@args], but this component does not ACCEPT_CONTEXT, so args are ignored.") if scalar(@args) && $c->debug; 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}; foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { next unless $path =~ /.*::Controller/; $check = $path."::".$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 model defines ACCEPT_CONTEXT. If it does not, the args are discarded. 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}; foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { next unless $path =~ /.*::Model/; $check = $path."::".$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" ); } foreach my $path (@{$appclass->config->{ setup_components }->{ search_extra }}) { next unless $path =~ /.*::View/; $check = $path."::".$name; return $c->_filter_component( $comps->{$check}, @args ) if exists $comps->{$check}; } } 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 has_encoding Returned True if there's a valid encoding =head2 clear_encoding Clears the encoding for the current context =head2 encoding Sets or gets the application encoding. Setting encoding takes either an Encoding object or a string that we try to resolve via L. You would expect to get the encoding object back if you attempt to set it. If there is a failure you will get undef returned and an error message in the log. =cut sub has_encoding { shift->encoding ? 1:0 } sub clear_encoding { my $c = shift; if(blessed $c) { $c->encoding(undef); } else { $c->log->error("You can't clear encoding on the application"); } } sub encoding { my $c = shift; my $encoding; if ( scalar @_ ) { # Don't let one change this once we are too far into the response if(blessed $c && $c->res->finalized_headers) { Carp::croak("You may not change the encoding once the headers are finalized"); return; } # Let it be set to undef if (my $wanted = shift) { $encoding = Encode::find_encoding($wanted) or Carp::croak( qq/Unknown encoding '$wanted'/ ); binmode(STDERR, ':encoding(' . $encoding->name . ')'); } else { binmode(STDERR); } $encoding = ref $c ? $c->{encoding} = $encoding : $c->_encoding($encoding); } else { $encoding = ref $c && exists $c->{encoding} ? $c->{encoding} : $c->_encoding; } return $encoding; } =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. B You can create a custom setup stage that will execute when the application is starting. Use this to customize setup. MyApp->setup(-Custom=value); sub setup_custom { my ($class, $value) = @_; } Can be handy if you want to hook into the setup phase. =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} ); $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 } # 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; } # If you are expecting configuration info as part of your setup, it needs # to get called here and below, since we need the above line to support # ConfigLoader based configs. $class->setup_encoding(); $class->setup_middleware(); # 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."); } # call these so we pre setup the composed classes $class->composed_request_class; $class->composed_response_class; $class->composed_stats_class; $class->setup_finalize; # Flush the log for good measure (in case something turned off 'autoflush' early) $class->log->_flush() if $class->log->can('_flush'); return $class || 1; # Just in case someone named their Application 0... } =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?, \$fragment? ) =head2 $c->uri_for( $action, \@captures?, @args?, \%query_values?, \$fragment? ) =head2 $c->uri_for( $action, [@captures, @args], \%query_values?, \$fragment? ) 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. B If you are using this 'stringy' first argument, we skip encoding and allow you to declare something like: $c->uri_for('/foo/bar#baz') Where 'baz' is a URI fragment. We consider this first argument string to be 'expert' mode where you are expected to create a valid URL and we for the most part just pass it through without a lot of internal effort to escape and encode. 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'); In general the scheme of the generated URI object will follow the incoming request however if your targeted action or action chain has the Scheme attribute it will use that instead. Also, if the targeted Action or Action chain declares Args/CaptureArgs that have type constraints, we will require that your proposed URL verify on those declared constraints. =cut sub uri_for { my ( $c, $path, @args ) = @_; if ( $path->$_isa('Catalyst::Controller') ) { $path = $path->path_prefix; $path =~ s{/+\z}{}; $path .= '/'; } my $fragment = ((scalar(@args) && ref($args[-1]) eq 'SCALAR') ? pop @args : undef ); unless(blessed $path) { if (defined($path) and $path =~ s/#(.+)$//) { if(defined($1) and $fragment) { carp "Abiguious fragment declaration: You cannot define a fragment in '$path' and as an argument '$fragment'"; } if(defined($1)) { $fragment = $1; } } } my $params = ( scalar @args && ref $args[$#args] eq 'HASH' ? pop @args : {} ); undef($path) if (defined $path && $path eq ''); carp "uri_for called with undef argument" if grep { ! defined $_ } @args; my $target_action = $path->$_isa('Catalyst::Action') ? $path : undef; 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) } : ()) ]; my $action = $path; my $expanded_action = $c->dispatcher->expand_action( $action ); my $num_captures = $expanded_action->number_of_captures; # ->uri_for( $action, \@captures_and_args, \%query_values? ) if( !@args && $action->number_of_args ) { unshift @args, splice @$captures, $num_captures; } if($num_captures) { unless($expanded_action->match_captures_constraints($c, $captures)) { carp "captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'"; return; } } $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 ''; # At this point @encoded_args is the remaining Args (all captures removed). if($expanded_action->has_args_constraints) { unless($expanded_action->match_args($c,\@args)) { carp "args [@args] do not match the type constraints in action '$expanded_action'"; return; } } } 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; if($target_action) { $target_action = $c->dispatcher->expand_action($target_action); if(my $s = $target_action->scheme) { $s = lc($s); $class = "URI::$s"; $base->scheme($s); } else { $class = ref($base); } } else { $class = ref($base); } $base =~ s{(?{$_}; #s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go; ## Commented out because seems to lead to double encoding - JNAP s/ /+/g; my $key = $_; $val = '' unless defined $val; (map { my $param = "$_"; $param = encode_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 = encode_utf8($key); # using the URI::Escape pattern here so utf8 chars survive $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $key =~ s/ /+/g; "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } $base = encode_utf8 $base; $base =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; $args = encode_utf8 $args; $args =~ s/([^$URI::uric])/$URI::Escape::escapes{$1}/go; if(defined $fragment) { if(blessed $path) { $fragment = encode_utf8(${$fragment}); $fragment =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $fragment =~ s/ /+/g; } $query .= "#$fragment"; } 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 = $@ ) { #rethow if this can be handled by middleware if ( $c->_handle_http_exception($error) ) { foreach my $err (@{$c->error}) { $c->log->error($err); } $c->clear_errors; $c->log->_flush if $c->log->can('_flush'); $error->can('rethrow') ? $error->rethrow : croak $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_encoding; $c->finalize_headers unless $c->response->finalized_headers; $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. If there is only one error in L and it is an object that does C or C we rethrow the error and presume it caught by middleware up the ladder. Otherwise we return the debugging error page (in debug mode) or we return the default error page (production mode). =cut sub finalize_error { my $c = shift; if($#{$c->error} > 0) { $c->engine->finalize_error( $c, @_ ); } else { my ($error) = @{$c->error}; if ( $c->_handle_http_exception($error) ) { # In the case where the error 'knows what it wants', becauses its PSGI # aware, just rethow and let middleware catch it $error->can('rethrow') ? $error->rethrow : croak $error; } else { $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 ); } # Remove incorrectly added body and content related meta data when returning # an information response, or a response the is required to not include a body $c->finalize_cookies; # This currently is a NOOP but I don't want to remove it since I guess people # might have Response subclasses that use it for something... (JNAP) $c->response->finalize_headers(); # Done $response->finalized_headers(1); } =head2 $c->finalize_encoding Make sure your body is encoded properly IF you set an encoding. By default the encoding is UTF-8 but you can disable it by explicitly setting the encoding configuration value to undef. We can only encode when the body is a scalar. Methods for encoding via the streaming interfaces (such as C and C on L are available). See L. =cut sub finalize_encoding { my $c = shift; my $res = $c->res || return; # Warn if the set charset is different from the one you put into encoding. We need # to do this early since encodable_response is false for this condition and we need # to match the debug output for backcompat (there's a test for this...) -JNAP if( $res->content_type_charset and $c->encoding and (uc($c->encoding->mime_name) ne uc($res->content_type_charset)) ) { my $ct = lc($res->content_type_charset); $c->log->debug("Catalyst encoding config is set to encode in '" . $c->encoding->mime_name . "', content type is '$ct', not encoding "); } if( ($res->encodable_response) and (defined($res->body)) and (ref(\$res->body) eq 'SCALAR') ) { # if you are finding yourself here and your body is already encoded correctly # and you want to turn this off, use $c->clear_encoding to prevent encoding # at this step, or set encoding to undef in the config to do so for the whole # application. See the ENCODING documentaiton for better notes. $c->res->body( $c->encoding->encode( $c->res->body, $c->_encode_check ) ); # Set the charset if necessary. This might be a bit bonkers since encodable response # is false when the set charset is not the same as the encoding mimetype (maybe # confusing action at a distance here.. # Don't try to set the charset if one already exists or if headers are already finalized $c->res->content_type($c->res->content_type . "; charset=" . $c->encoding->mime_name) unless($c->res->content_type_charset || ($c->res->_context && $c->res->finalized_headers && !$c->res->_has_response_cb)); } } =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 { #rethow if this can be handled by middleware if ( $class->_handle_http_exception($_) ) { $_->can('rethrow') ? $_->rethrow : croak $_; } 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); $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? # 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... if ( $c->_handle_http_exception($_) ) { foreach my $err (@{$c->error}) { $c->log->error($err); } $c->clear_errors; $c->log->_flush if $c->log->can('_flush'); $_->can('rethrow') ? $_->rethrow : croak $_; } else { $c->response->status(400); $c->response->content_type('text/plain'); $c->response->body('Bad Request'); $c->finalize; die $_; } }; $c->log_request; $c->{stash} = $c->stash; Scalar::Util::weaken($c->{stash}); return $c; } =head2 $c->prepare_action Prepares action. See L. =cut sub prepare_action { my $c = shift; my $ret = $c->dispatcher->prepare_action( $c, @_); if($c->encoding) { foreach (@{$c->req->arguments}, @{$c->req->captures}) { $_ = $c->_handle_param_unicode_decoding($_); } } return $ret; } =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->request->prepare_body_parameters( $c, @_ ); } =head2 $c->prepare_connection Prepares connection. =cut sub prepare_connection { my $c = shift; $c->request->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 ||= ''; $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $path = decode_utf8($path); $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 @values = (); if(ref $params eq 'Hash::MultiValue') { @values = $params->get_all($key); } else { my $param = $params->{$key}; if( defined($param) ) { @values = ref $param eq 'ARRAY' ? @$param : $param; } } $t->row( $key.( scalar @values > 1 ? ' [multiple]' : ''), join(', ', @values) ); } $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 $app->request_class_traits An arrayref of Ls which are applied to the request class. You can name the full namespace of the role, or a namespace suffix, which will then be tried against the following standard namespace prefixes. $MyApp::TraitFor::Request::$trait_suffix Catalyst::TraitFor::Request::$trait_suffix So for example if you set: MyApp->request_class_traits(['Foo']); We try each possible role in turn (and throw an error if none load) Foo MyApp::TraitFor::Request::Foo Catalyst::TraitFor::Request::Foo The namespace part 'TraitFor::Request' was chosen to assist in backwards compatibility with L which previously provided these features in a stand alone package. =head2 $app->composed_request_class This is the request class which has been composed with any request_class_traits. =head2 $c->response_class Returns or sets the response class. Defaults to L. =head2 $app->response_class_traits An arrayref of Ls which are applied to the response class. You can name the full namespace of the role, or a namespace suffix, which will then be tried against the following standard namespace prefixes. $MyApp::TraitFor::Response::$trait_suffix Catalyst::TraitFor::Response::$trait_suffix So for example if you set: MyApp->response_class_traits(['Foo']); We try each possible role in turn (and throw an error if none load) Foo MyApp::TraitFor::Response::Foo Catalyst::TraitFor::Responset::Foo The namespace part 'TraitFor::Response' was chosen to assist in backwards compatibility with L which previously provided these features in a stand alone package. =head2 $app->composed_response_class This is the request class which has been composed with any response_class_traits. =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->delayed_setup_component($component); } # Inject a component or wrap a stand alone class in an adaptor. This makes a list # of named components in the configuration that are not actually existing (not a # real file). my @injected = $class->setup_injected_components; # All components are registered, now we need to 'init' them. foreach my $component_name (@comps, @injected) { $class->components->{$component_name} = $class->components->{$component_name}->() if (ref($class->components->{$component_name}) || '') eq 'CODE'; } } =head2 $app->setup_injected_components Called by setup_compoents to setup components that are injected. =cut sub setup_injected_components { my ($class) = @_; my @injected_components = keys %{$class->config->{inject_components} ||+{}}; foreach my $injected_comp_name(@injected_components) { $class->setup_injected_component( $injected_comp_name, $class->config->{inject_components}->{$injected_comp_name}); } return map { $class ."::" . $_ } @injected_components; } =head2 $app->setup_injected_component( $injected_component_name, $config ) Setup a given injected component. =cut sub setup_injected_component { my ($class, $injected_comp_name, $config) = @_; if(my $component_class = $config->{from_component}) { my @roles = @{$config->{roles} ||[]}; Catalyst::Utils::inject_component( into => $class, component => $component_class, (scalar(@roles) ? (traits => \@roles) : ()), as => $injected_comp_name); } } =head2 $app->inject_component($MyApp_Component_name => \%args); Add a component that is injected at setup: MyApp->inject_component( 'Model::Foo' => { from_component => 'Common::Foo' } ); Must be called before ->setup. Expects a component name for your current application and \%args where =over 4 =item from_component The target component being injected into your application =item roles An arrayref of Ls that are applied to your component. =back Example MyApp->inject_component( 'Model::Foo' => { from_component => 'Common::Model::Foo', roles => ['Role1', 'Role2'], }); =head2 $app->inject_components Inject a list of components: MyApp->inject_components( 'Model::FooOne' => { from_component => 'Common::Model::Foo', roles => ['Role1', 'Role2'], }, 'Model::FooTwo' => { from_component => 'Common::Model::Foo', roles => ['Role1', 'Role2'], }); =cut sub inject_component { my ($app, $name, $args) = @_; die "Component $name exists" if $app->config->{inject_components}->{$name}; $app->config->{inject_components}->{$name} = $args; } sub inject_components { my $app = shift; while(@_) { $app->inject_component(shift, shift); } } =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( ::M ::Model ::V ::View ::C ::Controller ); my $extra = $config->{ search_extra } || []; unshift @paths, @$extra; my @comps = map { sort { length($a) <=> length($b) } Module::Pluggable::Object->new( search_path => [ map { s/^(?=::)/$class/; $_; } ($_) ], %$config )->plugins } @paths; 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 $app->delayed_setup_component Returns a coderef that points to a setup_component instance. Used internally for when you want to delay setup until the first time the component is called. =cut sub delayed_setup_component { my($class, $component, @more) = @_; return sub { return my $instance = $class->setup_component($component, @more); }; } =head2 $c->setup_component =cut sub setup_component { my( $class, $component ) = @_; unless ( $component->can( 'COMPONENT' ) ) { return $component; } my $config = $class->config_for($component); # 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 ); } || do { 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)./ ); } 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 $class->components->{ $component }; $class->components->{ $component } = $class->setup_component($component); } return $instance; } =head2 $app->config_for( $component_name ) Return the application level configuration (which is not yet merged with any local component configuration, via $component_class->config) for the named component or component object. Example: MyApp->config( 'Model::Foo' => { a => 1, b => 2}, ); my $config = MyApp->config_for('MyApp::Model::Foo'); In this case $config is the hashref C< {a=>1, b=>2} >. This is also handy for looking up configuration for a plugin, to make sure you follow existing L standards for where a plugin should put its configuration. =cut sub config_for { my ($class, $component_name) = @_; my $component_suffix = Catalyst::Utils::class2classsuffix($component_name); my $config = $class->config->{ $component_suffix } || {}; return $config; } =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 (if you are using Lighttpd), L (always applied since this middleware is smart enough to conditionally apply itself). We will also automatically add L if we notice that your HTTP $env variable C is '127.0.0.1'. This is usually an indication that your server is running behind a proxy frontend. However in 2014 this is often not the case. We preserve this code for backwards compatibility however I B recommend that if you are running the server behind a front end proxy that you clearly indicate so with the C configuration setting to true for your environment configurations that run behind a proxy. This way if you change your front end proxy address someday your code would inexplicably stop working as expected. 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}. Please B that if you do use C the middleware is now adding via C rather than this method. If you are using Lighttpd or IIS6 you may wish to apply these middlewares. In general this is no longer a common case but we have this here for backward compatibility. =cut sub apply_default_middlewares { my ($app, $psgi_app) = @_; # Don't add this conditional IF we are explicitly saying we want the # frontend proxy support. We don't need it here since if that is the # case it will be always loaded in the default_middleware. unless($app->config->{using_frontend_proxy}) { $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'; }, ); } # 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 App->psgi_app =head2 App->to_app Returns a PSGI application code reference for the catalyst application C<$c>. This is the bare application created without the C method called. We do however apply C since those are integral to how L functions. Also, unlike starting your application with a generated server script (via L and C) we do not attempt to return a valid L application using any existing C<${myapp}.psgi> scripts in your $HOME directory. B C was originally created when the first PSGI port was done for v5.90000. These are middlewares that are added to achieve backward compatibility with older applications. If you start your application using one of the supplied server scripts (generated with L and the project skeleton script C) we apply C automatically. This was done so that pre and post PSGI port applications would work the same way. This is what you want to be using to retrieve the PSGI application code reference of your Catalyst application for use in a custom F<.psgi> or in your own created server modules. =cut *to_app = \&psgi_app; 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_encoding Sets up the input/output encoding. See L =cut sub setup_encoding { my $c = shift; if( exists($c->config->{encoding}) && !defined($c->config->{encoding}) ) { # Ok, so the user has explicitly said "I don't want encoding..." return; } else { my $enc = defined($c->config->{encoding}) ? delete $c->config->{encoding} : 'UTF-8'; # not sure why we delete it... (JNAP) $c->encoding($enc); } } =head2 handle_unicode_encoding_exception Hook to let you customize how encoding errors are handled. By default we just throw an exception and the default error page will pick it up. Receives a hashref of debug information. Example of call (from the Catalyst internals): my $decoded_after_fail = $c->handle_unicode_encoding_exception({ param_value => $value, error_msg => $_, encoding_step => 'params', }); The calling code expects to receive a decoded string or an exception. You can override this for custom handling of unicode errors. By default we just die. If you want a custom response here, one approach is to throw an HTTP style exception, instead of returning a decoded string or throwing a generic exception. sub handle_unicode_encoding_exception { my ($c, $params) = @_; HTTP::Exception::BAD_REQUEST->throw(status_message=>$params->{error_msg}); } Alternatively you can 'catch' the error, stash it and write handling code later in your application: sub handle_unicode_encoding_exception { my ($c, $params) = @_; $c->stash(BAD_UNICODE_DATA=>$params); # return a dummy string. return 1; } NOTE: Please keep in mind that once an error like this occurs, the request setup is still ongoing, which means the state of C<$c> and related context parts like the request and response may not be setup up correctly (since we haven't finished the setup yet). If you throw an exception the setup is aborted. =cut sub handle_unicode_encoding_exception { my ( $self, $exception_ctx ) = @_; die $exception_ctx->{error_msg}; } # Some unicode helpers cargo culted from the old plugin. These could likely # be neater. sub _handle_unicode_decoding { my ( $self, $value ) = @_; return unless defined $value; ## I think this mess is to support the old nested if ( ref $value eq 'ARRAY' ) { foreach ( @$value ) { $_ = $self->_handle_unicode_decoding($_); } return $value; } elsif ( ref $value eq 'HASH' ) { foreach (keys %$value) { my $encoded_key = $self->_handle_param_unicode_decoding($_); $value->{$encoded_key} = $self->_handle_unicode_decoding($value->{$_}); # If the key was encoded we now have two (the original and current so # delete the original. delete $value->{$_} if $_ ne $encoded_key; } return $value; } else { return $self->_handle_param_unicode_decoding($value); } } sub _handle_param_unicode_decoding { my ( $self, $value, $check ) = @_; return unless defined $value; # not in love with just ignoring undefs - jnap return $value if blessed($value); #don't decode when the value is an object. my $enc = $self->encoding; return $value unless $enc; # don't decode if no encoding is specified $check ||= $self->_encode_check; return try { $enc->decode( $value, $check); } catch { return $self->handle_unicode_encoding_exception({ param_value => $value, error_msg => $_, encoding_step => 'params', }); }; } =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() } 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 default_middleware Returns a list of instantiated PSGI middleware objects which is the default middleware that is active for this application (taking any configuration options into account, excluding your custom added middleware via the C configuration option). You can override this method if you wish to change the default middleware (although do so at risk since some middleware is vital to application function.) The current default middleware list is: Catalyst::Middleware::Stash Plack::Middleware::HTTPExceptions Plack::Middleware::RemoveRedundantBody Plack::Middleware::FixMissingBodyInRedirect Plack::Middleware::ContentLength Plack::Middleware::MethodOverride Plack::Middleware::Head If the configuration setting C is true we add: Plack::Middleware::ReverseProxy If the configuration setting C is true we add: Plack::Middleware::ReverseProxyPath But B that L is not a dependency of the L distribution so if you want to use this option you should add it to your project distribution file. These middlewares will be added at L during the L phase of application startup. =cut sub default_middleware { my $class = shift; my @mw = ( Catalyst::Middleware::Stash->new, Plack::Middleware::HTTPExceptions->new, Plack::Middleware::RemoveRedundantBody->new, Plack::Middleware::FixMissingBodyInRedirect->new, Plack::Middleware::ContentLength->new, Plack::Middleware::MethodOverride->new, Plack::Middleware::Head->new); if($class->config->{using_frontend_proxy}) { push @mw, Plack::Middleware::ReverseProxy->new; } if($class->config->{using_frontend_proxy_path}) { if(Class::Load::try_load_class('Plack::Middleware::ReverseProxyPath')) { push @mw, Plack::Middleware::ReverseProxyPath->new; } else { $class->log->error("Cannot use configuration 'using_frontend_proxy_path' because 'Plack::Middleware::ReverseProxyPath' is not installed"); } } return @mw; } =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) So basically your middleware handles an incoming request from the first registered middleware, down and handles the response from the last middleware up. =cut sub registered_middlewares { my $class = shift; if(my $middleware = $class->_psgi_middleware) { my @mw = ($class->default_middleware, @$middleware); if($class->config->{using_frontend_proxy}) { push @mw, Plack::Middleware::ReverseProxy->new; } return @mw; } else { die "You cannot call ->registered_middlewares until middleware has been setup"; } } sub setup_middleware { my $class = shift; my @middleware_definitions; # If someone calls this method you can add middleware with args. However if its # called without an arg we need to setup the configuration middleware. if(@_) { @middleware_definitions = reverse(@_); } else { @middleware_definitions = reverse(@{$class->config->{'psgi_middleware'}||[]}) unless $class->finalized_default_middleware; $class->finalized_default_middleware(1); # Only do this once, just in case some people call setup over and over... } 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 { $class->setup_data_handlers; return $class->registered_data_handlers; } } 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 { my ($fh, $req) = @_; my $parser = Class::Load::load_first_existing_class('JSON::MaybeXS', 'JSON'); my $slurped; return eval { local $/; $slurped = $fh->getline; $parser->can("decode_json")->($slurped); # decode_json does utf8 decoding for us } || Catalyst::Exception->throw(sprintf "Error Parsing POST '%s', Error: %s", (defined($slurped) ? $slurped : 'undef') ,$@); }, }; } sub _handle_http_exception { my ( $self, $error ) = @_; if ( !$self->config->{always_catch_http_exceptions} && blessed $error && ( $error->can('as_psgi') || ( $error->can('code') && $error->code =~ m/^[1-5][0-9][0-9]$/ ) ) ) { return 1; } } =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 $app->stats_class_traits A arrayref of Ls that are applied to the stats_class before creating it. =head2 $app->composed_stats_class this is the stats_class composed with any 'stats_class_traits'. You can name the full namespace of the role, or a namespace suffix, which will then be tried against the following standard namespace prefixes. $MyApp::TraitFor::Stats::$trait_suffix Catalyst::TraitFor::Stats::$trait_suffix So for example if you set: MyApp->stats_class_traits(['Foo']); We try each possible role in turn (and throw an error if none load) Foo MyApp::TraitFor::Stats::Foo Catalyst::TraitFor::Stats::Foo The namespace part 'TraitFor::Stats' was chosen to assist in backwards compatibility with L which previously provided these features in a stand alone package. =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 - As of version 5.90060 Catalyst rethrows errors conforming to the interface described by L and lets the middleware deal with it. Set true to get the deprecated behaviour and have Catalyst catch HTTP exceptions. =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 - Enabled L on your application (if installed, otherwise log an error). This is useful if your application is not running on the 'root' (or /) of your host server. B if you use this feature you should add the required middleware to your project dependency list since its not automatically a dependency of L. This has been done since not all people need this feature and we wish to restrict the growth of L dependencies. =item * C - See L This now defaults to 'UTF-8'. You my turn it off by setting this configuration value to undef. =item * C Defaults to true. When there is an error in an action chain, the default behavior is to abort the processing of the remaining actions to avoid running them when the application is in an unexpected state. Before version 5.90070, the default used to be false. To keep the old behaviour, you can explicitely set the value to false. E.g. __PACKAGE__->config(abort_chain_on_error_fix => 0); If this setting is set to false, then the remaining actions are performed and the error is caught at the end of the chain. =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 When creating body parameters from a POST, if we run into a multipart POST that does not contain uploads, but instead contains inlined complex data (very uncommon) we cannot reliably convert that into field => value pairs. So instead we create an instance of L. If this causes issue for you, you can disable this by setting C to true (default is false). =item * C Generally we decode incoming POST params based on your declared encoding (the default for this is to decode UTF-8). If this is causing you trouble and you do not wish to turn all encoding support off (with the C configuration parameter) you may disable this step atomically by setting this configuration parameter to true. =item * C If true, then do not try to character decode any wide characters in your request URL query or keywords. Most readings of the relevant specifications suggest these should be UTF-* encoded, which is the default that L will use, however if you are creating a lot of URLs manually or have external evil clients, this might cause you trouble. If you find the changes introduced in Catalyst version 5.90080+ break some of your query code, you may disable the UTF-8 decoding globally using this configuration. This setting takes precedence over C =item * C Catalyst versions 5.90080 - 5.90106 would decode query parts of an incoming request but would not raise an exception when the decoding failed due to incorrect unicode. It now does, but if this change is giving you trouble you may disable it by setting this configuration to true. =item * C By default we decode query and keywords in your request URL using UTF-8, which is our reading of the relevant specifications. This setting allows one to specify a fixed value for how to decode your query. You might need this if you are doing a lot of custom encoding of your URLs and not using UTF-8. =item * C In older versions of Catalyst, when more than one action matched the same path AND all those matching actions declared Args(0), we'd break the tie by choosing the first action defined. We now normalized how Args(0) works so that it follows the same rule as Args(N), which is to say when we need to break a tie we choose the LAST action defined. If this breaks your code and you don't have time to update to follow the new normalized approach, you may set this value to true and it will globally revert to the original chaining behavior. =item * C - See L. =item * C - See L. =item * C An arrayref of Ls that get composed into your stats class. =item * C An arrayref of Ls that get composed into your request class. =item * C An arrayref of Ls that get composed into your response class. =item * C A Hashref of L subclasses that are 'injected' into configuration. For example: MyApp->config({ inject_components => { 'Controller::Err' => { from_component => 'Local::Controller::Errors' }, 'Model::Zoo' => { from_component => 'Local::Model::Foo' }, 'Model::Foo' => { from_component => 'Local::Model::Foo', roles => ['TestRole'] }, }, 'Controller::Err' => { a => 100, b=>200, namespace=>'error' }, 'Model::Zoo' => { a => 2 }, 'Model::Foo' => { a => 100 }, }); Generally L looks for components in your Model/View or Controller directories. However for cases when you which to use an existing component and you don't need any customization (where for when you can apply a role to customize it) you may inject those components into your application. Please note any configuration should be done 'in the normal way', with a key under configuration named after the component affix, as in the above example. Using this type of injection allows you to construct significant amounts of your application with only configuration!. This may or may not lead to increased code understanding. Please not you may also call the ->inject_components application method as well, although you must do so BEFORE setup. =back =head1 EXCEPTIONS Generally when you throw an exception inside an Action (or somewhere in your stack, such as in a model that an Action is calling) that exception is caught by Catalyst and unless you either catch it yourself (via eval or something like L or by reviewing the L stack, it will eventually reach L and return either the debugging error stack page, or the default error page. However, if your exception can be caught by L, L will instead rethrow it so that it can be handled by that middleware (which is part of the default middleware). For example this would allow use HTTP::Throwable::Factory 'http_throw'; sub throws_exception :Local { my ($self, $c) = @_; http_throw(SeeOther => { location => $c->uri_for($self->action_for('redirect')) }); } =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 configuration 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: Alternatively, you may also define middleware by calling the L package method: package MyApp::Web; use Catalyst; __PACKAGE__->setup_middleware( \@middleware_definitions); __PACKAGE__->setup; In the case where you do both (use 'setup_middleware' and configuration) the package call to setup_middleware will be applied earlier (in other words its middleware will wrap closer to the application). Keep this in mind since in some cases the order of middleware is important. The two approaches are not exclusive. =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 Starting in L version 5.90080 encoding is automatically enabled and set to encode all body responses to UTF8 when possible and applicable. Following is documentation on this process. If you are using an older version of L you should review documentation for that version since a lot has changed. By default encoding is now 'UTF-8'. You may turn it off by setting the encoding configuration to undef. MyApp->config(encoding => undef); This is recommended for temporary backwards compatibility only. To turn it off for a single request use the L method to turn off encoding for this request. This can be useful when you are setting the body to be an arbitrary block of bytes, especially if that block happens to be a block of UTF8 text. Encoding is automatically applied when the content-type is set to a type that can be encoded. Currently we encode when the content type matches the following regular expression: $content_type =~ /^text|xml$|javascript$/ Encoding is set on the application, but it is copied to the context object so that you can override it on a request basis. Be default we don't automatically encode 'application/json' since the most common approaches to generating this type of response (Either via L or L) will do so already and we want to avoid double encoding issues. If you are producing JSON response in an unconventional manner (such as via a template or manual strings) you should perform the UTF8 encoding manually as well such as to conform to the JSON specification. NOTE: We also examine the value of $c->response->content_encoding. If you set this (like for example 'gzip', and manually gzipping the body) we assume that you have done all the necessary encoding yourself, since we cannot encode the gzipped contents. If you use a plugin like L you need to update to a modern version in order to have this function correctly with the new UTF8 encoding code, or you can use L or (probably best) do your compression on a front end proxy. =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 andrewalker: André Walker Andrew Bramble Andrew Ford Andrew Ruthven andyg: Andy Grundman audreyt: Audrey Tang bricas: Brian Cassidy Caelum: Rafael Kitover chansen: Christian Hansen Chase Venters C chicks: Christopher Hicks Chisel Wright C Danijel Milicevic C davewood: David Schmidt David Kamholz 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 vanstyn: Henry Van Styn Viljo Marrandi C Will Hawes C willert: Sebastian Willert wreis: Wallace Reis Yuval Kogman, C rainboxx: Matthias Dietrich, C dd070: Dhaval Dhanani Upasana John Napiorkowski (jnap) =head1 COPYRIGHT Copyright (c) 2005-2015, 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.90115/lib/Catalyst/Action.pm000644 000765 000024 00000041536 12700516273 023261 0ustar00jnapiorkowskistaff000000 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', 'blessed'; use Moose::Util::TypeConstraints (); 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 }, ); has number_of_args => ( is=>'ro', init_arg=>undef, isa=>'Int|Undef', required=>1, lazy=>1, builder=>'_build_number_of_args'); sub _build_number_of_args { my $self = shift; if( ! exists $self->attributes->{Args} ) { # When 'Args' does not exist, that means we want 'any number of args'. return undef; } elsif(!defined($self->attributes->{Args}[0])) { # When its 'Args' that internal cue for 'unlimited' return undef; } elsif( scalar(@{$self->attributes->{Args}}) == 1 && looks_like_number($self->attributes->{Args}[0]) ) { # 'Old school' numbered args (is allowed to be undef as well) return $self->attributes->{Args}[0]; } else { # New hotness named arg constraints return $self->number_of_args_constraints; } } sub normalized_arg_number { return $_[0]->number_of_args; } sub comparable_arg_number { return defined($_[0]->number_of_args) ? $_[0]->number_of_args : ~0; } has number_of_args_constraints => ( is=>'ro', isa=>'Int|Undef', init_arg=>undef, required=>1, lazy=>1, builder=>'_build_number_of_args_constraints'); sub _build_number_of_args_constraints { my $self = shift; return unless $self->has_args_constraints; # If there is one constraint and its a ref, we need to decide # if this number 'unknown' number or if the ref allows us to # determine a length. if(scalar @{$self->args_constraints} == 1) { my $tc = $self->args_constraints->[0]; if( $tc->can('is_strictly_a_type_of') && $tc->is_strictly_a_type_of('Tuple')) { my @parameters = @{ $tc->parameters||[]}; if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) { return undef; } else { return my $total_params = scalar(@parameters); } } elsif($tc->is_a_type_of('Ref')) { return undef; } else { return 1; # Its a normal 1 arg type constraint. } } else { # We need to loop through and error on ref types. We don't allow a ref type # in the middle. my $total = 0; foreach my $tc( @{$self->args_constraints}) { if($tc->is_a_type_of('Ref')) { die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in Args for action ${\$self->reverse}"; } else { ++$total; } } return $total; } } has args_constraints => ( is=>'ro', init_arg=>undef, traits=>['Array'], isa=>'ArrayRef', required=>1, lazy=>1, builder=>'_build_args_constraints', handles => { has_args_constraints => 'count', args_constraint_count => 'count', all_args_constraints => 'elements', }); sub _build_args_constraints { my $self = shift; my @arg_protos = @{$self->attributes->{Args}||[]}; return [] unless scalar(@arg_protos); return [] unless defined($arg_protos[0]); # If there is only one arg and it looks like a number # we assume its 'classic' and the number is the number of # constraints. my @args = (); if( scalar(@arg_protos) == 1 && looks_like_number($arg_protos[0]) ) { return \@args; } else { @args = map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" } @arg_protos; } return \@args; } has number_of_captures_constraints => ( is=>'ro', isa=>'Int|Undef', init_arg=>undef, required=>1, lazy=>1, builder=>'_build_number_of_capture_constraints'); sub _build_number_of_capture_constraints { my $self = shift; return unless $self->has_captures_constraints; # If there is one constraint and its a ref, we need to decide # if this number 'unknown' number or if the ref allows us to # determine a length. if(scalar @{$self->captures_constraints} == 1) { my $tc = $self->captures_constraints->[0]; if( $tc->can('is_strictly_a_type_of') && $tc->is_strictly_a_type_of('Tuple')) { my @parameters = @{ $tc->parameters||[]}; if( defined($parameters[-1]) and exists($parameters[-1]->{slurpy})) { return undef; } else { return my $total_params = scalar(@parameters); } } elsif($tc->is_a_type_of('Ref')) { die "You cannot use CaptureArgs($tc) in ${\$self->reverse} because we cannot determined the number of its parameters"; } else { return 1; # Its a normal 1 arg type constraint. } } else { # We need to loop through and error on ref types. We don't allow a ref type # in the middle. my $total = 0; foreach my $tc( @{$self->captures_constraints}) { if($tc->is_a_type_of('Ref')) { die "$tc is a Ref type constraint. You cannot mix Ref and non Ref type constraints in CaptureArgs for action ${\$self->reverse}"; } else { ++$total; } } return $total; } } has captures_constraints => ( is=>'ro', init_arg=>undef, traits=>['Array'], isa=>'ArrayRef', required=>1, lazy=>1, builder=>'_build_captures_constraints', handles => { has_captures_constraints => 'count', captures_constraints_count => 'count', all_captures_constraints => 'elements', }); sub _build_captures_constraints { my $self = shift; my @arg_protos = @{$self->attributes->{CaptureArgs}||[]}; return [] unless scalar(@arg_protos); return [] unless defined($arg_protos[0]); # If there is only one arg and it looks like a number # we assume its 'classic' and the number is the number of # constraints. my @args = (); if( scalar(@arg_protos) == 1 && looks_like_number($arg_protos[0]) ) { return \@args; } else { @args = map { my @tc = $self->resolve_type_constraint($_); scalar(@tc) ? @tc : die "$_ is not a constraint!" } @arg_protos; } return \@args; } sub resolve_type_constraint { my ($self, $name) = @_; if(defined($name) && blessed($name) && $name->can('check')) { # Its already a TC, good to go. return $name; } # This is broken for when there is more than one constraint if($name=~m/::/) { eval "use Type::Registry; 1" || die "Can't resolve type constraint $name without installing Type::Tiny"; my $tc = Type::Registry->new->foreign_lookup($name); return defined $tc ? $tc : die "'$name' not a full namespace type constraint in ${\$self->private_path}"; } my @tc = grep { defined $_ } (eval("package ${\$self->class}; $name")); unless(scalar @tc) { # ok... so its not defined in the package. we need to look at all the roles # and superclasses, look for attributes and figure it out. # Superclasses take precedence; my @supers = $self->class->can('meta') ? map { $_->meta } $self->class->meta->superclasses : (); my @roles = $self->class->can('meta') ? $self->class->meta->calculate_all_roles : (); # So look through all the super and roles in order and return the # first type constraint found. We should probably find all matching # type constraints and try to do some sort of resolution. foreach my $parent (@roles, @supers) { if(my $m = $parent->get_method($self->name)) { if($m->can('attributes')) { my ($key, $value) = map { $_ =~ /^(.*?)(?:\(\s*(.+?)\s*\))?$/ } grep { $_=~/^Args\(/ or $_=~/^CaptureArgs\(/ } @{$m->attributes}; next unless $value eq $name; my @tc = eval "package ${\$parent->name}; $name"; if(scalar(@tc)) { return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; } else { return; } } } } my $classes = join(',', $self->class, @roles, @supers); die "'$name' not a type constraint in '${\$self->private_path}', Looked in: $classes"; } if(scalar(@tc)) { return map { ref($_) ? $_ : Moose::Util::TypeConstraints::find_or_parse_type_constraint($_) } @tc; } else { return; } } has number_of_captures => ( is=>'ro', init_arg=>undef, isa=>'Int', required=>1, lazy=>1, builder=>'_build_number_of_captures'); sub _build_number_of_captures { my $self = shift; if( ! exists $self->attributes->{CaptureArgs} ) { # If there are no defined capture args, thats considered 0. return 0; } elsif(!defined($self->attributes->{CaptureArgs}[0])) { # If you fail to give a defined value, that's also 0 return 0; } elsif( scalar(@{$self->attributes->{CaptureArgs}}) == 1 && looks_like_number($self->attributes->{CaptureArgs}[0]) ) { # 'Old school' numbered captures return $self->attributes->{CaptureArgs}[0]; } else { # New hotness named arg constraints return $self->number_of_captures_constraints; } } 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 ) = @_; return $self->match_args($c, $c->req->args); } sub match_args { my ($self, $c, $args) = @_; my @args = @{$args||[]}; # There there are arg constraints, we must see to it that the constraints # check positive for each arg in the list. if($self->has_args_constraints) { # If there is only one type constraint, and its a Ref or subtype of Ref, # That means we expect a reference, so use the full args arrayref. if( $self->args_constraint_count == 1 && ( $self->args_constraints->[0]->is_a_type_of('Ref') || $self->args_constraints->[0]->is_a_type_of('ClassName') ) ) { # Ok, the the type constraint is a ref type, which is allowed to have # any number of args. We need to check the arg length, if one is defined. # If we had a ref type constraint that allowed us to determine the allowed # number of args, we need to match that number. Otherwise if there was an # undetermined number (~0) then we allow all the args. This is more of an # Optimization since Tuple[Int, Int] would fail on 3,4,5 anyway, but this # way we can avoid calling the constraint when the arg length is incorrect. if( $self->comparable_arg_number == ~0 || scalar( @args ) == $self->comparable_arg_number ) { return $self->args_constraints->[0]->check($args); } else { return 0; } # Removing coercion stuff for the first go #if($self->args_constraints->[0]->coercion && $self->attributes->{Coerce}) { # my $coerced = $self->args_constraints->[0]->coerce($c) || return 0; # $c->req->args([$coerced]); # return 1; #} } else { # Because of the way chaining works, we can expect args that are totally not # what you'd expect length wise. When they don't match length, thats a fail return 0 unless scalar( @args ) == $self->comparable_arg_number; for my $i(0..$#args) { $self->args_constraints->[$i]->check($args[$i]) || return 0; } return 1; } } else { # If infinite args with no constraints, we always match return 1 if $self->comparable_arg_number == ~0; # Otherwise, we just need to match the number of args. return scalar( @args ) == $self->comparable_arg_number; } } sub match_captures { my ($self, $c, $captures) = @_; my @captures = @{$captures||[]}; return 1 unless scalar(@captures); # If none, just say its ok return $self->has_captures_constraints ? $self->match_captures_constraints($c, $captures) : 1; return 1; } sub match_captures_constraints { my ($self, $c, $captures) = @_; my @captures = @{$captures||[]}; # Match is positive if you don't have any. return 1 unless $self->has_captures_constraints; if( $self->captures_constraints_count == 1 && ( $self->captures_constraints->[0]->is_a_type_of('Ref') || $self->captures_constraints->[0]->is_a_type_of('ClassName') ) ) { return $self->captures_constraints->[0]->check($captures); } else { for my $i(0..$#captures) { $self->captures_constraints->[$i]->check($captures[$i]) || return 0; } return 1; } } sub compare { my ($a1, $a2) = @_; return $a1->comparable_arg_number <=> $a2->comparable_arg_number; } sub scheme { return exists $_[0]->attributes->{Scheme} ? $_[0]->attributes->{Scheme}[0] : undef; } sub list_extra_info { my $self = shift; return { Args => $self->normalized_arg_number, 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 match_captures_constraints ($c, \@captures); Does the \@captures given match any constraints (if any constraints exist). Returns true if you ask but there are no constraints. =head2 match_args($c, $args) Does the Args match or not? =head2 resolve_type_constraint Tries to find a type constraint if you have on on a type constrained method. =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 normalized_arg_number The number of arguments (starting with zero) that the current action defines, or undefined if there is not defined number of args (which is later treated as, " as many arguments as you like"). =head2 comparable_arg_number For the purposes of comparison we normalize 'number_of_args' so that if it is undef we mean ~0 (as many args are we can think of). =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 scheme Any defined scheme for the action =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.90115/lib/Catalyst/ActionChain.pm000644 000765 000024 00000007106 12520162327 024214 0ustar00jnapiorkowskistaff000000 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. We # check the global config flag 'abort_chain_on_error_fix', but this # is now considered true by default, so unless someone explicitly sets # it to false we default it to true (if its not defined). my $abort = defined($c->config->{abort_chain_on_error_fix}) ? $c->config->{abort_chain_on_error_fix} : 1; return if ($c->has_errors && $abort); } $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; } sub match_captures { my ($self, $c, $captures) = @_; my @captures = @{$captures||[]}; foreach my $link(@{$self->chain}) { my @local_captures = splice @captures,0,$link->number_of_captures; return unless $link->match_captures($c, \@local_captures); } return 1; } sub match_captures_constraints { my ($self, $c, $captures) = @_; my @captures = @{$captures||[]}; foreach my $link(@{$self->chain}) { my @local_captures = splice @captures,0,$link->number_of_captures; next unless $link->has_captures_constraints; return unless $link->match_captures_constraints($c, \@local_captures); } return 1; } # the scheme defined at the end of the chain is the one we use # but warn if too many. sub scheme { my $self = shift; my @chain = @{ $self->chain }; my ($scheme, @more) = map { exists $_->attributes->{Scheme} ? $_->attributes->{Scheme}[0] : (); } reverse @chain; warn "$self is a chain with two many Scheme attributes (only one is allowed)" if @more; return $scheme; } __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 match_captures Match all the captures that this chain encloses, if any. =head2 scheme Any defined scheme for the actionchain =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.90115/lib/Catalyst/ActionContainer.pm000644 000765 000024 00000003604 12406561462 025121 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/ActionRole/000755 000765 000024 00000000000 13101661740 023530 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Base.pm000644 000765 000024 00000001612 12406561462 022710 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/ClassData.pm000644 000765 000024 00000004252 12406561462 023700 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Component/000755 000765 000024 00000000000 13101661740 023433 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Component.pm000644 000765 000024 00000023772 12614432252 024006 0ustar00jnapiorkowskistaff000000 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); } B Generally when L starts, it initializes all the components and passes the hashref present in any configuration information to the COMPONENT method. For example MyApp->config( 'Model::Foo' => { bar => 'baz', }); You would expect COMPONENT to be called like this ->COMPONENT( 'MyApp', +{ bar=>'baz'}); This would happen ONCE during setup. =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. B All classes that are Ls will have a COMPONENT method, but classes that are intended to be factories or generators will have ACCEPT_CONTEXT. If you have initialization arguments (such as from configuration) that you wish to expose to the ACCEPT_CONTEXT you should proxy them in the factory instance. For example: MyApp::Model::FooFactory; use Moose; extends 'Catalyst::Model'; has type => (is=>'ro', required=>1); sub ACCEPT_CONTEXT { my ($self, $c, @args) = @_; return bless { args=>\@args }, $self->type; } MyApp::Model::Foo->meta->make_immutable; MyApp::Model::Foo->config( type => 'Type1' ); And in a controller: my $type = $c->model('FooFactory', 1,2,3,4): # $type->isa('Type1') B If you define a ACCEPT_CONTEXT method it MUST check to see if the second argument is blessed (is a context) or not (is an application class name) and it MUST return something valid for the case when the scope is application. This is required because a component maybe be called from the application scope even if it requires a context and you must prevent errors from being issued if this happens. Remember not all components that ACCEPT_CONTEXT actually need or use context information (and there is a school of thought that suggestions doing so is a design error anyway...) =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.90115/lib/Catalyst/Contributing.pod000644 000765 000024 00000011541 12614432252 024650 0ustar00jnapiorkowskistaff000000 000000 =encoding UTF-8 =head1 Name Catalyst::Contributing - Contributing to Catalyst and Change management =head1 Description How to contribute to L and what are the criteria for evaluating change and deciding on the future direction of the project. =head2 Change Management In general there are two rules when thinking about changing Catalyst. The first is technical merit of the idea. If there is a bug, then its obvious it needs to be fixed. Less obvious is the types of refactoring that went into giving Catalyst modern features like websocket support, interoperability with event loops and to expose more and more of Catalyst's PSGI underpinnings. When an idea has strong technical merit, it recommends itself. The only thing to consider is the needs of backward compatibility, and to offer people upgrading at least some sort of path forward when features change (such as to have plugins or configuration options to replace or replicate something that is no longer available). Then there is a second and more difficult type of change consideration, which is the general will of the community. Like technical merit, this needs to balance against our commitment to not leave existing users high and dry with changes that break code and offer no path forward that does not involve significant code rewrites. Unlike technical merit, the will of the community can be hard to figure. In general we don't get a lot of bug reports or conversation around Catalyst future evolution. I wish I could find a way to get more involvement, but I also understand this is not very unusual issue for open source projects. I personally don't believe that "silence is consent" either. I think choices need to have broad acceptability or the choosers lose respect and authority. Typical that results in people just drifting away. Without direct involvement the only other way to measure the will of the community is to look at what other choices people are making and what other projects have received the acceptance of a broad number of people. Since Plack is clearly accepted and important it leads me to feel the choice to make Catalyst expose more of its Plack nature and to better play with the larger Plack ecosystem are correct ones. One can also pay attention to the kinds of problems that get reported on IRC, at conferences and the problems that I see having looked at how Catalyst has been used in the wild. For example its clear that Chaining actions could use a tweak in some way since it seems to trip up people a lot. The same goes with $c->forward and $c->go, which tend to lead to confusing code (and combined with the stash is a particularly toxic brew). Going further, if we allow ourselves to look hard at projects outside of Perl we can get lots of great ideas about what has worked for other projects in other languages. When we see certain features and approaches have excited programmers using frameworks like Ruby on Rails, Django, Scala Play, etc. then it should provide us with with help in thinking about how those features might influence the evolution of Catalyst as well. =head2 Reporting a bug Reported bugs via RT or L that come with attached test cases will be more likely addressed quickly than those that do not. Proposing a bugfix patch is also always very welcome, although it is recommended to stick as closely as possible to an actual bug (rather than a feature change) and to not include unneeded changes in your patch such as formatting corrections. In any case it is recommended before spending a lot of time on a patch to discuss the issue and your proposed solution, else you risk spending a lot of time on code that may not get merged, which tends to be frustrating. For bug patches you should create a new branch from the current master. =head2 Proposing a new feature You should first ask yourself if your new idea could rationally live in the extended Catalyst ecosystem independently on CPAN. Ideas that have demonstrated worth over time as stand alone modules are more likely to be considered for core inclusion. Additionally, ideas that are best achieved in core rather than as standalone, are more likely considered for core inclusion than those ideas which could just as well be stand alone. For example, the PSGI integration project happened because it was clear that building Catalyst on top of PSGI standards would lead to a better overall version than keeping it stand alone. You should propose your new idea in a L, on IRC and ideally on the mailing list so that other people can comment on your idea and its merits prior to you writing code. If you write code before proposing the idea you stand a high chance of being frustrated when you idea is not accepted. =head2 AUTHOR John Napiorkowski L =cut Catalyst-Runtime-5.90115/lib/Catalyst/Controller.pm000644 000765 000024 00000077445 13024565234 024200 0ustar00jnapiorkowskistaff000000 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 ); #If there is an error, all bets off if( @{ $c->error }) { return !@{ $c->error }; } else { return $c->state || 1; } } sub _AUTO : Private { my ( $self, $c ) = @_; my @auto = $c->get_actions( 'auto', $c->namespace ); foreach my $auto (@auto) { # We FORCE the auto action user to explicitly return # true. We need to do this since there's some auto # users (Catalyst::Authentication::Credential::HTTP) that # actually do a detach instead. $c->state(0); $auto->dispatch( $c ); return 0 unless $c->state; } return $c->state || 1; } sub _ACTION : Private { my ( $self, $c ) = @_; if ( ref $c->action && $c->action->can('execute') && defined $c->req->action ) { $c->action->dispatch( $c ); } #If there is an error, all bets off if( @{ $c->error }) { return !@{ $c->error }; } else { return $c->state || 1; } } 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}; push @roles, 'Catalyst::ActionRole::Scheme' if $args{attributes}->{Scheme}; push @roles, 'Catalyst::ActionRole::QueryMatching' if $args{attributes}->{Query}; 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_OPTIONS_attr { Method => 'OPTIONS' } sub _parse_HEAD_attr { Method => 'HEAD' } sub _parse_PATCH_attr { Method => 'PATCH' } 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($action_name) Returns the Catalyst::Action object (if any) for a given action in this controller or relative to it. You may refer to actions in controllers nested under the current controllers namespace, or in controllers 'up' from the current controller namespace. For example: package MyApp::Controller::One::Two; use base 'Catalyst::Controller'; sub foo :Local { my ($self, $c) = @_; $self->action_for('foo'); # action 'foo' in Controller 'One::Two' $self->action_for('three/bar'); # action 'bar' in Controller 'One::Two::Three' $self->action_for('../boo'); # action 'boo' in Controller 'One' } This returns 'undef' if there is no action matching the requested action name (after any path normalization) so you should check for this as needed. =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 Allowed values for CaptureArgs is a single integer (CaptureArgs(2), meaning two allowed) or you can declare a L, L or L named constraint such as CaptureArgs(Int,Str) would require two args with the first being a Integer and the second a string. You may declare your own custom type constraints and import them into the controller namespace: package MyApp::Controller::Root; use Moose; use MooseX::MethodAttributes; use MyApp::Types qw/Int/; extends 'Catalyst::Controller'; sub chain_base :Chained(/) CaptureArgs(1) { } sub any_priority_chain :Chained(chain_base) PathPart('') Args(1) { } sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { } See L for more. Please see L for more. =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. Allowed values for Args is a single integer (Args(2), meaning two allowed) or you can declare a L, L or L named constraint such as Args(Int,Str) would require two args with the first being a Integer and the second a string. You may declare your own custom type constraints and import them into the controller namespace: package MyApp::Controller::Root; use Moose; use MooseX::MethodAttributes; use MyApp::Types qw/Tuple Int Str StrMatch UserId/; extends 'Catalyst::Controller'; sub user :Local Args(UserId) { my ($self, $c, $int) = @_; } sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; } sub many_ints :Local Args(ArrayRef[Int]) { my ($self, $c, @ints) = @_; } sub match :Local Args(StrMatch[qr{\d\d-\d\d-\d\d}]) { my ($self, $c, $int) = @_; } If you choose not to use imported type constraints (like L, or you may use L 'stringy' types however just like when you use these types in your declared attributes you must quote them: sub my_moose_type :Local Args('Int') { ... } If you use 'reference' type constraints (such as ArrayRef[Int]) that have an unknown number of allowed matches, we set this the same way "Args" is. Please keep in mind that actions with an undetermined number of args match at lower precedence than those with a fixed number. You may use reference types such as Tuple from L that allows you to fix the number of allowed args. For example Args(Tuple[Int,Int]) would be determined to be two args (or really the same as Args(Int,Int).) You may find this useful for creating custom subtypes with complex matching rules that you wish to reuse over many actions. See L for more. B: It is highly recommended to use L for your type constraints over other options. L exposed a better meta data interface which allows us to do more and better types of introspection driving tests and debugging. =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. =head2 Scheme(...) Allows you to specify a URI scheme for the action or action chain. For example you can required that a given path be C or that it is a websocket endpoint C or C. For an action chain you may currently only have one defined Scheme. package MyApp::Controller::Root; use base 'Catalyst::Controller'; sub is_http :Path(scheme) Scheme(http) Args(0) { my ($self, $c) = @_; $c->response->body("is_http"); } sub is_https :Path(scheme) Scheme(https) Args(0) { my ($self, $c) = @_; $c->response->body("is_https"); } In the above example http://localhost/root/scheme would match the first action (is_http) but https://localhost/root/scheme would match the second. As an added benefit, if an action or action chain defines a Scheme, when using $c->uri_for the scheme of the generated URL will use what you define in the action or action chain (the current behavior is to set the scheme based on the current incoming request). This makes it easier to use uri_for on websites where some paths are secure and others are not. You may also use this to other schemes like websockets. 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.90115/lib/Catalyst/Delta.pod000755 000765 000024 00000051320 12745475337 023254 0ustar00jnapiorkowskistaff000000 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.90105 This version primarily fixed a regression in the way we preserved $c->state which the previous version introduced. Now in the case when you forward to an action, should that action throw an exception it sets state to 0 and is sure that the return value is false. This is to meet expected behavior based on the documentation. If you relied on the last update behavior you may not have regressions but it was thought that we should make the code behave as documented for more than 10 years. We also changed how we compose the request, response and stats base class. We now compose the base class with any configured traits once at the end of the application setup, rather than for each request. This reduced request overhead when you are composing lots of traits. It possible this may break some code that was adding traits after the application setup was finalized. Please shout out if this actually causes you trouble and we'll do the best to accommodate. =head2 VERSION 5.90102 - 5.90103 A significant change is that we now preserve the value of $c->state from action to following action. This gives you a new way to pass a value between actions in a chain, for example. However any 'auto' actions always have $c->state forced to be set to 0, which is the way its been for a long time, this way an auto action is required to return 1 to pass the match. It also exists to maintain compatibility with anyone that exits an auto action with a detach (which is not a documented way to escape matching, but exists in the wild since it worked as a side effect of the code for a long time). Additionally, upon $c->detach we also force set state to 0. Version 5.90102 contains a version of this change but its considered buggy, so that is a version to avoid. =head2 VERSION 5.90100 Support for type constraints in Args and CaptureArgs has been improved. You may now inherit from a base controller that declares type constraints and use roles that declare type constraints. See L for more. You may now. also use a full type constraint namespace instead of importing type constraints into your package namespace. We changed the way the middleware stash works so that it no longer localizes the PSGI env hashref. This was done to fix bugs where people set PSGI ENV hash keys and found them to disappear in certain cases. It also means that now if a sub applications sets stash variables, that stash will now bubble up to the parent application. This may be a breaking change for you since previous versions of this code did not allow that. A workaround is to explicitly delete stash keys in your sub application before returning control to the parent application. =head2 VERSION 5.90097 =head3 Defined how $c->uri_for adds a URI fragment. We now have a specification for creating URIs with fragments (or HTML anchors). Previously you could do this as a side effect of how we create URIs but this side effect behavior was never documented or tested, and was broken when we introduced default UTF-8 encoding. When creating URIs with fragments please follow the new, supported specification: $c->uri_for($action_or_path, \@captures_or_args, @args, \$query, \$fragment); This will be a breaking change for some codebases, we recommend testing if you are creating URLs with fragments. B If you are using the alternative: $c->uri_for('/foo/bar#baz') construction, we do not attempt to encode this and it will make a URL with a fragment of 'baz'. =head2 VERSION 5.90094 =head3 Multipart form POST with character set headers When we did the UTF8 work, we punted on Form POSTs when the POST envelope was multipart and each part had complex headers such as content-types, character sets and so forth. In those cases instead of returning a possibly incorrect value, we returned an object describing the part so that you could figure it out manually. This turned out to be a bad workaround as people did not expect to find that object. So we changed this to try much harder to get a correct value. We still return an object if we fail but we try much harder now. If you used to check for the object you might find that code is no longer needed (although checking for it should not hurt or break anything either). =head2 VERSION 5.90091 =head3 'case_sensitive' configuration At one point in time we allowed you to set a 'case_sensitive' configuration value so that you could find actions by their private names using mixed case. We highly discourage that. If you are using this 'feature' you should be on notice that we plan to remove the code around it in the near future. =head2 VERSION 5.90090+ =head3 Type constraints on Args and CaptureArgs. You may now use a type constraint (using L, L or preferably L in your Args or CaptureArgs action attributes. This can be used to restrict the value of the Arg. For example: sub myaction :Local Args(Int) { ... } Would match '.../myaction/5' but not '.../myaction/string'. When an action (or action chain) has Args (or CaptureArgs) that declare type constraints your arguments to $c->uri_for(...) must match those constraints. See L for more. =head3 Move CatalystX::InjectComponent into core L has a new method 'inject_component' which works the same as the method of the same name in L. =head3 inject_components New configuration key allows you to inject components directly into your application without any subclasses. For example: MyApp->config({ inject_components => { 'Controller::Err' => { from_component => 'Local::Controller::Errors' }, 'Model::Zoo' => { from_component => 'Local::Model::Foo' }, 'Model::Foo' => { from_component => 'Local::Model::Foo', roles => ['TestRole'] }, }, 'Controller::Err' => { a => 100, b=>200, namespace=>'error' }, 'Model::Zoo' => { a => 2 }, 'Model::Foo' => { a => 100 }, }); Injected components are useful to reduce the amount of nearly empty boilerplate classes you might have, particularly when first starting an application. =head3 Component setup changes. Previously you could not depend on an application scoped component doing setup_components since components were setup 'in order'. Now all components are first registered and then setup, so you can now reliably use any component doing setup_components. =head2 VERSION 5.90080+ The biggest change in this release is that UTF8 encoding is now enabled by default. So you no longer need any plugins (such as L) which you can just no go ahead and remove. You also don't need to set the encoding configuration (__PACKAGE__->config(encoding=>'UTF-8')) anymore as well (although its presence hurts nothing). If this change causes you trouble, you can disable it: __PACKAGE__->config(encoding=>undef); For further information, please see L But please report bugs. You will find that a number of common Views have been updated for this release (such as L). In all cases that the author is aware of these updates were to fix test cases only. You shouldn't need to update unless you are installing fresh and want tests to pass. L was updated to be compatible with this release. You will need to upgrade if you are using this plugin. L also has details. A small change is that the configuration setting C was not doing the right thing if you started your application with C and did not apply the default middleware. This setting is now honored in all the ways an application may be started. This could cause trouble if you are using the configuration value and also adding the proxy middleware manually with a custom application startup. The solution is that you only need the configuration value set, or the middleware manually added (not both). =head2 VERSION 5.90060+ =head3 Catalyst::Log object autoflush on by default Starting in 5.90065, the Catalyst::Log object has 'autoflush' which is on by default. This causes all messages to be written to the log immediately instead of at the end of startup and then at the end of each request. In order to access the old behavior, you must now call: $c->log->autoflush(0); =head3 Deprecate Catalyst::Utils::ensure_class_loaded Going forward we recommend you use L. In fact we will be converting all uses of L to L. We will also convert L to be based on L to allow some time for you to update code, however at some future point this method will be removed so you should stop using it now. =head3 Support passing Body filehandles directly to your Plack server. We changed the way we return body content (from response) to whatever Plack handler you are using (Starman, FastCGI, etc.) We no longer always use the streaming interface for the cases when the body is a simple scalar, object or filehandle like. In those cases we now just pass the simple response on to the plack handler. This might lead to some minor differences in how streaming is handled. For example, you might notice that streaming starts properly supporting chunked encoding when on a server that supports that, or that previously missing headers (possible content-length) might appear suddenly correct. Also, if you are using middleware like L and are using a filehandle that sets a readable path, your server might now correctly handle the file (rather than as before where Catalyst would stream it very likely very slowly). In other words, some things might be meaninglessly different and some things that were broken codewise but worked because of Catalyst being incorrect might suddenly be really broken. The behavior is now more correct in that Catalyst plays better with features that Plack offers but if you are making heavy use of the streaming interface there could be some differences so you should test carefully (this is probably not the vast majority of people). In particular if you are developing using one server but deploying using a different one, differences in what those server do with streaming should be noted. Please see note below about changes to filehandle support and existing Plack middleware to aid in backwards compatibility. =head3 Distinguish between body null versus undef. We also now more carefully distinguish the different between a body set to '' and a body that is undef. This might lead to situations where again you'll get a content-length were you didn't get one before or where a supporting server will start chunking output. If this is an issue you can apply the middleware L or report specific problems to the dev team. =head3 More Catalyst Middleware We have started migrating code in Catalyst to equivalent Plack Middleware when such exists and is correct to do so. For example we now use L to determine content length of a response when none is provided. This replaces similar code inlined with L The main advantages to doing this is 1) more similar Catalyst core that is focused on the Catalyst special sauce, 2) Middleware is more broadly shared so we benefit from better collaboration with developers outside Catalyst, 3) In the future you'll be able to change or trim the middleware stack to get additional performance when you don't need all the checks and constraints. =head3 Deprecate Filehandle like objects that do read but not getline We also deprecated setting the response body to an object that does 'read' but not 'getline'. If you are using a custom IO-Handle like object for response you should verify that 'getline' is supported in your interface. Unless we here this case is a major issue for people, we will be removing support in a near future release of Catalyst. When the code encounters this it will issue a warning. You also may run into this issue with L which does read but not getline. For now we will just warn when encountering such an object and fallback to the previous behavior (where L itself unrolls the filehandle and performs blocking streams). However this backwards compatibility will be removed in an upcoming release so you should either rewrite your custom filehandle objects to support getline or start using the middleware that adapts read for getline L. =head3 Response->headers become read-only after finalizing Once the response headers are finalized, trying to change them is not allowed (in the past you could change them and this would lead to unexpected results). =head3 Officially deprecate L L is also officially no longer supported. We will no long run test cases against this and can remove backwards compatibility code for it as deemed necessary for the evolution of the platform. You should simply discontinue use of this engine, as L has been PSGI at the core for several years. =head3 Officially deprecate finding the PSGI $env anyplace other than Request A few early releases of Cataplack had the PSGI $env in L. Code has been maintained here for backwards compatibility reasons. This is no longer supported and will be removed in upcoming release, so you should update your code and / or upgrade to a newer version of L =head3 Deprecate setting Response->body after using write/write_fh Setting $c->res->body to a filehandle after using $c->res->write or $c->res->write_fh is no longer considered allowed, since we can't send the filehandle to the underlying Plack handler. For now we will continue to support setting body to a simple value since this is possible, but at some future release a choice to use streaming indicates that you will do so for the rest of the request. =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 backwards 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.90115/lib/Catalyst/Dispatcher.pm000644 000765 000024 00000056154 13025774122 024134 0ustar00jnapiorkowskistaff000000 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 Encode 2.21 'decode_utf8'; 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; $path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $path = decode_utf8($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'; return $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 ); #If there is an error, all bets off regarding state. Documentation #Specifies that when you forward, if there's an error you must expect #state to be 0. if( @{ $c->error }) { $c->state(0); } 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; $c->state(0); # Needed in order to skip any auto functions 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||[]}; if($c->debug && defined $req->match && length $req->match) { my $match = $req->match; $match =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; $match = decode_utf8($match); $c->log->debug( 'Path is "' . $match . '"' ) } $c->log->debug( 'Arguments are "' . join( '/', map { decode_utf8 $_ } @args ) . '"' ) if ( $c->debug && @args ); } =head2 $self->get_action( $action_name, $namespace ) returns a named action from a given namespace. C<$action_name> may be a relative path on that C<$namespace> such as $self->get_action('../bar', 'foo/baz'); In which case we look for the action at 'foo/bar'. =cut sub get_action { my ( $self, $name, $namespace ) = @_; return unless $name; $namespace = join( "/", grep { length } split '/', ( defined $namespace ? $namespace : "" ) ); return $self->get_action_by_path("${namespace}/${name}"); } =head2 $self->get_action_by_path( $path ); Returns the named action by its full private path. This method performs some normalization on C<$path> so that if it includes '..' it will do the right thing (for example if C<$path> is '/foo/../bar' that is normalized to '/bar'. =cut sub get_action_by_path { my ( $self, $path ) = @_; $path =~s/[^\/]+\/\.\.\/// while $path=~m/[^\/]+\/\.\.\//; $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 ( map @{$_}{sort keys %$_}, $c->components ) { $comp = $comp->() if ref($comp) eq 'CODE'; $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.90115/lib/Catalyst/DispatchType/000755 000765 000024 00000000000 13101661740 024072 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/DispatchType.pm000644 000765 000024 00000003630 12406561462 024441 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Engine/000755 000765 000024 00000000000 13101661737 022704 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Engine.pm000644 000765 000024 00000060535 12743743417 023262 0ustar00jnapiorkowskistaff000000 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::Headers; use Plack::Loader; use Catalyst::EngineLoader; use Encode 2.21 'decode_utf8', 'encode', 'decode'; use Plack::Request::Upload; use Hash::MultiValue; use namespace::clean -except => 'meta'; use utf8; # 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' , weak_ref=>1); 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 ) = @_; my $res = $c->response; # We use this all over ## If we've asked for the write 'filehandle' that means the application is ## doing something custom and is expected to close the response return if $res->_has_write_fh; my $body = $res->body; # save some typing if($res->_has_response_cb) { ## we have not called the response callback yet, so we are safe to send ## the whole body to PSGI my @headers; $res->headers->scan(sub { push @headers, @_ }); # We need to figure out what kind of body we have and normalize it to something # PSGI can deal with if(defined $body) { # Handle objects first if(blessed($body)) { if($body->can('getline')) { # Body is an IO handle that meets the PSGI spec. Nothing to normalize } elsif($body->can('read')) { # In the past, Catalyst only looked for ->read not ->getline. It is very possible # that one might have an object that respected read but did not have getline. # As a result, we need to handle this case for backcompat. # We will just do the old loop for now. In a future version of Catalyst this support # will be removed and one will have to rewrite their custom object or use # Plack::Middleware::AdaptFilehandleRead. In anycase support for this is officially # deprecated and described as such as of 5.90060 my $got; do { $got = read $body, my ($buffer), $CHUNKSIZE; $got = 0 unless $self->write($c, $buffer ); } while $got > 0; close $body; return; } else { # Looks like for backcompat reasons we need to be able to deal # with stringyfiable objects. $body = ["$body"]; } } elsif(ref $body) { if( (ref($body) eq 'GLOB') or (ref($body) eq 'ARRAY')) { # Again, PSGI can just accept this, no transform needed. We don't officially # document the body as arrayref at this time (and there's not specific test # cases. we support it because it simplifies some plack compatibility logic # and we might make it official at some point. } else { $c->log->error("${\ref($body)} is not a valid value for Response->body"); return; } } else { # Body is defined and not an object or reference. We assume a simple value # and wrap it in an array for PSGI $body = [$body]; } } else { # There's no body... $body = []; } $res->_response_cb->([ $res->status, \@headers, $body]); $res->_clear_response_cb; } else { ## Now, if there's no response callback anymore, that means someone has ## called ->write in order to stream 'some stuff along the way'. I think ## for backcompat we still need to handle a ->body. I guess I could see ## someone calling ->write to presend some stuff, and then doing the rest ## via ->body, like in a template. ## We'll just use the old, existing code for this (or most of it) if(my $body = $res->body) { if ( blessed($body) && $body->can('read') or ref($body) eq 'GLOB' ) { ## In this case we have no choice and will fall back on the old ## manual streaming stuff. Not optimal. This is deprecated as of 5.900560+ my $got; do { $got = read $body, my ($buffer), $CHUNKSIZE; $got = 0 unless $self->write($c, $buffer ); } while $got > 0; close $body; } else { # Case where body was set after calling ->write. We'd prefer not to # support this, but I can see some use cases with the way most of the # views work. Since body has already been encoded, we need to do # an 'unencoded_write' here. $self->unencoded_write( $c, $body ); } } $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) Спробуйте ще раз пізніше
(it) Per favore riprova più tardi
$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; my $do_not_decode_query = $c->config->{do_not_decode_query}; my $old_encoding; if(my $new = $c->config->{default_query_encoding}) { $old_encoding = $c->encoding; $c->encoding($new); } my $check = $c->config->{do_not_check_query_encoding} ? undef :$c->_encode_check; my $decoder = sub { my $str = shift; return $str if $do_not_decode_query; return $c->_handle_param_unicode_decoding($str, $check); }; 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 ) { my $keywords = $self->unescape_uri($query_string); $keywords = $decoder->($keywords); $c->request->query_keywords($keywords); return; } $query_string =~ s/\A[&;]+//; my $p = Hash::MultiValue->new( map { defined $_ ? $decoder->($self->unescape_uri($_)) : $_ } map { ( split /=/, $_, 2 )[0,1] } # slice forces two elements split /[&;]+/, $query_string ); $c->encoding($old_encoding) if $old_encoding; $c->request->query_parameters( $c->request->_use_hash_multivalue ? $p : $p->mixed ); } =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 $enc = $c->encoding; my $uploads = $request->_body->upload; my $parameters = $request->parameters; foreach my $name (keys %$uploads) { my $files = $uploads->{$name}; $name = $c->_handle_unicode_decoding($name) if $enc; my @uploads; for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) { my $headers = HTTP::Headers->new( %{ $upload->{headers} } ); my $filename = $upload->{filename}; $filename = $c->_handle_unicode_decoding($filename) if $enc; my $u = Catalyst::Request::Upload->new ( size => $upload->{size}, type => scalar $headers->content_type, charset => scalar $headers->content_type_charset, headers => $headers, tempname => $upload->{tempname}, filename => $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->unencoded_write($c, $buffer) Writes the buffer to the client without encoding. Necessary for already encoded buffers. Used when a $c->write has been done followed by $c->res->body. =cut sub unencoded_write { my ( $self, $c, $buffer ) = @_; $c->response->unencoded_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.90115/lib/Catalyst/EngineLoader.pm000644 000765 000024 00000010073 12406561462 024373 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Exception/000755 000765 000024 00000000000 13101661740 023427 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Exception.pm000644 000765 000024 00000002146 12406561462 023777 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Log.pm000644 000765 000024 00000020072 12454003036 022547 0ustar00jnapiorkowskistaff000000 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 autoflush => (is => 'rw', default => sub {1}); 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); } if( $self->autoflush && !$self->abort ) { $self->_flush; } return 1; } 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 { binmode STDERR, ":utf8"; 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 autoflush When enabled (default), messages are written to the log immediately instead of queued until the end of the request. This option, as well as C, is provided for modules such as L to be able to programmatically suppress the output of log messages. By turning off C (application-wide setting) and then setting the C flag within a given request, all log messages for the given request will be suppressed. C can still be set independently of turning off C, however. It just means any messages sent to the log up until that point in the request will obviously still be emitted, since C means they are written in real-time. If you need to turn off autoflush you should do it like this (in your main app class): after setup_finalize => sub { my $c = shift; $c->log->autoflush(0) if $c->log->can('autoflush'); }; =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.90115/lib/Catalyst/Middleware/000755 000765 000024 00000000000 13101661740 023546 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Model.pm000644 000765 000024 00000001052 12406561462 023074 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Plugin/000755 000765 000024 00000000000 13101661740 022727 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/PSGI.pod000644 000765 000024 00000007022 12406561462 022747 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Request/000755 000765 000024 00000000000 13101661740 023121 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Request.pm000644 000765 000024 00000077044 12614431435 023477 0ustar00jnapiorkowskistaff000000 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 HTTP::Body; use Catalyst::Exception; use Catalyst::Request::PartData; 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) = @_; # Not sure if these returns should not be exceptions... my $content_type = $self->content_type || return; return unless ($self->method eq 'POST' || $self->method eq 'PUT'); 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 { Catalyst::Exception->throw("$content_type is does not have an available data handler"); } } 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, predicate => 'has_body_parameters', 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); next unless $stream_buffer; $stream_buffer->print($chunk) || die sprintf "Failed to write %d bytes to psgi.input file: $!", length( $chunk ); } # 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, $c ) = @_; return $self->body_parameters if $self->has_body_parameters; $self->prepare_body if ! $self->_has_body; unless($self->_body) { my $return = $self->_use_hash_multivalue ? Hash::MultiValue->new : {}; $self->body_parameters($return); return $return; } my $params; my %part_data = %{$self->_body->part_data}; if(scalar %part_data && !$c->config->{skip_complex_post_part_handling}) { foreach my $key (keys %part_data) { my $proto_value = $part_data{$key}; my ($val, @extra) = (ref($proto_value)||'') eq 'ARRAY' ? @$proto_value : ($proto_value); $key = $c->_handle_param_unicode_decoding($key) if ($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}); if(@extra) { $params->{$key} = [map { Catalyst::Request::PartData->build_from_part_data($c, $_) } ($val,@extra)]; } else { $params->{$key} = Catalyst::Request::PartData->build_from_part_data($c, $val); } } } else { $params = $self->_body->param; # If we have an encoding configured (like UTF-8) in general we expect a client # to POST with the encoding we fufilled the request in. Otherwise don't do any # encoding (good change wide chars could be in HTML entity style llike the old # days -JNAP # so, now that HTTP::Body prepared the body params, we gotta 'walk' the structure # and do any needed decoding. # This only does something if the encoding is set via the encoding param. Remember # this is assuming the client is not bad and responds with what you provided. In # general you can just use utf8 and get away with it. # # I need to see if $c is here since this also doubles as a builder for the object :( if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { $params = $c->_handle_unicode_decoding($params); } } my $return = $self->_use_hash_multivalue ? Hash::MultiValue->from_mixed($params) : $params; $self->body_parameters($return) unless $self->has_body_parameters; return $return; } 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; $req->env; 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. If the POST is malformed in some way (such as undefined or not content that matches the content-type) we raise a L with the error text as the message. If the POSTed content type does not match an available data handler, this will also raise an exception. =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. B If your POST is multipart, but contains non file upload parts (such as an line part with an alternative encoding or content type) we do our best to try and figure out how the value should be presented. If there's a specified character set we will use that to decode rather than the default encoding set by the application. However if there are complex headers and we cannot determine the correct way to extra a meaningful value from the upload, in this case any part like this will be represented as an instance of L. Patches and review of this part of the code welcomed. =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 >>. B Interfaces like this, which are based on L and the C method are known to cause demonstrated exploits. It is highly recommended that you avoid using this method, and migrate existing code away from it. Here's a whitepaper of the exploit: L B Further discussion on IRC indicate that the L core team from 'back then' were well aware of this hack and this is the main reason we added the new approach to getting parameters in the first place. Basically this is an exploit that takes advantage of how L<\param> will do one thing in scalar context and another thing in list context. This is combined with how Perl chooses to deal with duplicate keys in a hash definition by overwriting the value of existing keys with a new value if the same key shows up again. Generally you will be vulnerable to this exploit if you are using this method in a direct assignment in a hash, such as with a L create statement. For example, if you have parameters like: user?user=123&foo=a&foo=user&foo=456 You could end up with extra parameters injected into your method calls: $c->model('User')->create({ user => $c->req->param('user'), foo => $c->req->param('foo'), }); Which would look like: $c->model('User')->create({ user => 123, foo => qw(a user 456), }); (or to be absolutely clear if you are not seeing it): $c->model('User')->create({ user => 456, foo => 'a', }); Possible remediations include scrubbing your parameters with a form validator like L or being careful to force scalar context using the scalar keyword: $c->model('User')->create({ user => scalar($c->req->param('user')), foo => scalar($c->req->param('foo')), }); Upcoming versions of L will disable this interface by default and require you to positively enable it should you require it for backwards compatibility reasons. =cut sub param { my $self = shift; if ( @_ == 0 ) { return keys %{ $self->parameters }; } # If anything in @_ is undef, carp about that, and remove it from # the list; my @params = grep { defined($_) ? 1 : do {carp "You called ->params with an undefined value"; 0} } @_; if ( @params == 1 ) { defined(my $param = shift @params) || carp "You called ->params with an undefined value 2"; 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 ( @params > 1 ) { my $field = shift @params; $self->parameters->{$field} = [@params]; } } =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($_); } }; 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 $self->env Access to the raw PSGI env. =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.90115/lib/Catalyst/Response/000755 000765 000024 00000000000 13101661740 023267 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/Response.pm000644 000765 000024 00000053746 12737207660 023657 0ustar00jnapiorkowskistaff000000 000000 package Catalyst::Response; use Moose; use HTTP::Headers; use Moose::Util::TypeConstraints; use namespace::autoclean; use Scalar::Util 'blessed'; use Catalyst::Response::Writer; use Catalyst::Utils (); with 'MooseX::Emulate::Class::Accessor::Fast'; our $DEFAULT_ENCODE_CONTENT_TYPE_MATCH = qr{text|xml$|javascript$}; has encodable_content_type => ( is => 'rw', required => 1, default => sub { $DEFAULT_ENCODE_CONTENT_TYPE_MATCH } ); 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', #Pointless since we control how this is built #writer => '_set_writer', Now that its lazy I think this is safe to remove clearer => '_clear_writer', predicate => '_has_writer', lazy => 1, builder => '_build_writer', ); sub _build_writer { my $self = shift; ## These two lines are probably crap now... $self->_context->finalize_headers unless $self->finalized_headers; my @headers; $self->headers->scan(sub { push @headers, @_ }); my $writer = $self->_response_cb->([ $self->status, \@headers ]); $self->_clear_response_cb; return $writer; } has write_fh => ( is=>'ro', predicate=>'_has_write_fh', lazy=>1, builder=>'_build_write_fh', ); sub _build_write_fh { my $writer = $_[0]->_writer; # We need to get the finalize headers side effect... my $requires_encoding = $_[0]->encodable_response; my %fields = ( _writer => $writer, _context => $_[0]->_context, _requires_encoding => $requires_encoding, ); return bless \%fields, 'Catalyst::Response::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 content_type_charset header)], default => sub { HTTP::Headers->new() }, required => 1, lazy => 1, ); has _context => ( is => 'rw', weak_ref => 1, clearer => '_clear_context', ); before [qw(status headers content_encoding content_length content_type )] => sub { my $self = shift; $self->_context->log->warn( "Useless setting a header value after finalize_headers and the response callback has been called." . " Since we don't support tail headers this will not work as you might expect." ) if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); }; # This has to be different since the first param to ->header is the header name and presumably # you should be able to request the header even after finalization, just not try to change it. before 'header' => sub { my $self = shift; my $header = shift; $self->_context->log->warn( "Useless setting a header value after finalize_headers and the response callback has been called." . " Since we don't support tail headers this will not work as you might expect." ) if ( $self->_context && $self->finalized_headers && !$self->_has_response_cb && @_ ); }; 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; if($self->encodable_response) { $buffer = $self->_context->encoding->encode( $buffer, $self->_context->_encode_check ) } my $len = length($buffer); $self->_writer->write($buffer); return $len; } sub unencoded_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) = @_; return; } sub from_psgi_response { my ($self, $psgi_res) = @_; if(blessed($psgi_res) && $psgi_res->can('as_psgi')) { $psgi_res = $psgi_res->as_psgi; } if(ref $psgi_res eq 'ARRAY') { my ($status, $headers, $body) = @$psgi_res; $self->status($status); $self->headers(HTTP::Headers->new(@$headers)); # Can be arrayref or filehandle... if(defined $body) { # probably paranoia ref $body eq 'ARRAY' ? $self->body(join('', @$body)) : $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(defined $maybe_body) { # Can be arrayref or filehandle... ref $maybe_body eq 'ARRAY' ? $self->body(join('', @$maybe_body)) : $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"; } # Encoding compatibilty. If the response set a charset, well... we need # to assume its properly encoded and NOT encode for this response. Otherwise # We risk double encoding. if($self->content_type_charset) { # We have to do this since for backcompat reasons having a charset doesn't always # mean that the body is already encoded :( $self->_context->clear_encoding; } } =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 getline method in the same fashion), or a filehandle GLOB. These will be passed down to the PSGI handler you are using and might be optimized using server specific abilities (for example L will attempt to server a real local file in a non blocking manner). If you are using a filehandle as the body response you are responsible for making sure it conforms to the L specification with regards to content encoding. Unlike with scalar body values or when using the streaming interfaces we currently do not attempt to normalize and encode your filehandle. In general this means you should be sure to be sending bytes not UTF8 decoded multibyte characters. Most of the time when you do: open(my $fh, '<:raw', $path); You should be fine. If you open a filehandle with a L layer you probably are not fine. You can usually fix this by explicitly using binmode to set the IOLayer to :raw. Its possible future versions of L will try to 'do the right thing'. 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. Please note that the object needs to implement C, not just C. Older versions of L expected your filehandle like objects to do read. If you have code written for this expectation and you cannot change the code to meet the L specification, you can try the following middleware L which will attempt to wrap your object in an interface that so conforms. Starting from version 5.90060, when using an L object, you may want to use L, to delegate the actual serving to the frontend server. To do so, you need to pass to C an IO object with a C method. This can be achieved in two ways. Either using L: my $fh = IO::File->new($file, 'r'); Plack::Util::set_io_path($fh, $file); Or using L my $fh = IO::File::WithPath->new($file, 'r'); And then passing the filehandle to body and setting headers, if needed. $c->response->body($fh); $c->response->headers->content_type('text/plain'); $c->response->headers->content_length(-s $file); $c->response->headers->last_modified((stat($file))[9]); L can be loaded in the application so: __PACKAGE__->config( psgi_middleware => [ 'XSendfile', # other middlewares here... ], ); B that loading the middleware without configuring the webserver to set the request header C to a supported type (C for nginx, C for Apache and Lighttpd), could lead to the disclosure of private paths to malicious clients setting that header. Nginx needs the additional X-Accel-Mapping header to be set in the webserver configuration, so the middleware will replace the absolute path of the IO object with the internal nginx path. This is also useful to prevent a buggy app to server random files from the filesystem, as it's an internal redirect. An nginx configuration for FastCGI could look so: server { server_name example.com; root /my/app/root; location /private/repo/ { internal; alias /my/app/repo/; } location /private/staging/ { internal; alias /my/app/staging/; } location @proxy { include /etc/nginx/fastcgi_params; fastcgi_param SCRIPT_NAME ''; fastcgi_param PATH_INFO $fastcgi_script_name; fastcgi_param HTTP_X_SENDFILE_TYPE X-Accel-Redirect; fastcgi_param HTTP_X_ACCEL_MAPPING /my/app=/private; fastcgi_pass unix:/my/app/run/app.sock; } } In the example above, passing filehandles with a local path matching /my/app/staging or /my/app/repo will be served by nginx. Passing paths with other locations will lead to an internal server error. Setting the body to a filehandle without the C method bypasses the middleware completely. For Apache and Lighttpd, the mapping doesn't apply and setting the X-Sendfile-Type is enough. =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->content_type_charset Shortcut for $res->headers->content_type_charset; =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. B If $url is an object that does ->as_string (such as L, which is what you get from ->uri_for) we automatically call that to stringify. This should ease the common case usage return $c->res->redirect( $c->uri_for(...)); =cut sub redirect { my $self = shift; if (@_) { my $location = shift; my $status = shift || 302; if(blessed($location) && $location->can('as_string')) { $location = $location->as_string; } $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. Calling this method will finalize your headers and send the headers and status code response to the client (so changing them afterwards is a waste... be sure to set your headers correctly first). You may call this as often as you want throughout your response cycle. You may even set a 'body' afterward. So for example you might write your HTTP headers and the HEAD section of your document and then set the body from a template driven from a database. In some cases this can seem to the client as if you had a faster overall response (but note that unless your server support chunked body your content is likely to get queued anyway (L and most other http 1.1 webservers support this). If there is an encoding set, we encode each line of the response (the default encoding is UTF-8). =head2 $res->unencoded_write( $data ) Works just like ->write but we don't apply any content encoding to C<$data>. Use this if you are already encoding the $data or the data is arriving from an encoded storage. =head2 $res->write_fh Returns an instance of L, which is a lightweight decorator over the PSGI C<$writer> object (see L). In addition to proxying the C and C method from the underlying PSGI writer, this proxy object knows any application wide encoding, and provides a method C that will properly encode your written lines based upon your encoding settings. By default in L responses are UTF-8 encoded and this is the encoding used if you respond via C. If you want to handle encoding yourself, you can use the C method directly. Encoding only applies to content types for which it matters. Currently the following content types are assumed to need encoding: text (including HTML), xml and javascript. We provide access to this object so that you can properly close over it for use in 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 }); } Like the 'write' method, calling this will finalize headers. Unlike 'write' when you can this it is assumed you are taking control of the response so the body is never finalized (there isn't one anyway) and you need to call the close method. =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. If passed an object, will expect that object to do a method C. 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. You may wish to review 'PSGI Helpers' under L for help in properly nesting applications. B If your external PSGI application returns a response that has a character set associated with the content type (such as "text/html; charset=UTF-8") we set $c->clear_encoding to remove any additional content type encoding processing later in the application (this is done to avoid double encoding issues). =head2 encodable_content_type This is a regular expression used to determine of the current content type should be considered encodable. Currently we apply default encoding (usually UTF8) to text type contents. Here's the default regular expression: This would match content types like: text/plain text/html text/xml application/javascript application/xml application/vnd.user+xml B: We don't encode JSON content type responses by default since most of the JSON serializers that are commonly used for this task will do so automatically and we don't want to double encode. If you are not using a tool like L to produce JSON type content, (for example you are using a template system, or creating the strings manually) you will need to either encoding the body yourself: $c->response->body( $c->encoding->encode( $body, $c->_encode_check ) ); Or you can alter the regular expression using this attribute. =head2 encodable_response Given a L return true if its one that can be encoded. make sure there is an encoding set on the response make sure the content type is encodable make sure no content type charset has been already set to something different from the global encoding make sure no content encoding is present. Note this does not inspect a body since we do allow automatic encoding on streaming type responses. =cut sub encodable_response { my ($self) = @_; return 0 unless $self->_context; # Cases like returning a HTTP Exception response you don't have a context here... return 0 unless $self->_context->encoding; # The response is considered to have a 'manual charset' when a charset is already set on # the content type of the response AND it is not the same as the one we set in encoding. # If there is no charset OR we are asking for the one which is the same as the current # required encoding, that is a flag that we want Catalyst to encode the response automatically. my $has_manual_charset = 0; if(my $charset = $self->content_type_charset) { $has_manual_charset = (uc($charset) ne uc($self->_context->encoding->mime_name)) ? 1:0; } # Content type is encodable if it matches the regular expression stored in this attribute my $encodable_content_type = $self->content_type =~ m/${\$self->encodable_content_type}/ ? 1:0; # The content encoding is allowed (for charset encoding) only if its empty or is set to identity my $allowed_content_encoding = (!$self->content_encoding || $self->content_encoding eq 'identity') ? 1:0; # The content type must be an encodable type, and there must be NO manual charset and also # the content encoding must be the allowed values; if( $encodable_content_type and !$has_manual_charset and $allowed_content_encoding ) { return 1; } else { return 0; } } =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.90115/lib/Catalyst/RouteMatching.pod000644 000765 000024 00000036707 12614432252 024765 0ustar00jnapiorkowskistaff000000 000000 =encoding UTF-8 =head1 Name Catalyst::RouteMatching - How Catalyst maps an incoming URL to actions in controllers. =head1 Description This is a WIP document intended to help people understand the logic that L uses to determine how to match in incoming request to an action (or action chain) in a controller. =head2 Request to Controller/Action Matching L maps requests to action using a 'longest path wins' approach. That means that if the request is '/foo/bar/baz' That means the action 'baz' matches: package MyApp::Controller::Foo; use Moose; use MooseX::MethodAttributes extends 'Catalyst::Controller'; sub bar :Path('bar') Args(1) { ...} sub baz :Path('bar/baz') Args(0) { ... } Path length matches take precedence over all other types of matches (included HTTP Method, Scheme, etc.). The same holds true for Chained actions. Generally the chain that matches the most PathParts wins. =head2 Args(N) versus Args 'Args' matches any number of args. Because this functions as a sort of catchall, we treat 'Args' as the lowest precedence of any Args(N) when N is 0 to infinity. An action with 'Args' always get the last chance to match. =head2 When two or more actions match a given Path Sometimes two or more actions match the same path and all have the same PathPart length. For example: package MyApp::Controller::Root; use Moose; use MooseX::MethodAttributes extends 'Catalyst::Controller'; sub root :Chained(/) CaptureArgs(0) { } sub one :Chained(root) PathPart('') Args(0) { } sub two :Chained(root) PathPart('') Args(0) { } sub three :Chained(root) PathPart('') Args(0) { } __PACKAGE__->meta->make_immutable; In this case the last defined action wins (for the example that is action 'three'). This is most common to happen when you are using action matching beyond paths, such as when using method matching: package MyApp::Controller::Root; use Moose; use MooseX::MethodAttributes extends 'Catalyst::Controller'; sub root :Chained(/) CaptureArgs(0) { } sub any :Chained(root) PathPart('') Args(0) { } sub get :GET Chained(root) PathPart('') Args(0) { } __PACKAGE__->meta->make_immutable; In the above example GET /root could match both actions. In this case you should define your 'catchall' actions higher in the controller. =head2 Type Constraints in Args and Capture Args Beginning in Version 5.90090+ you may use L, L or L type constraints to further declare allowed matching for Args or CaptureArgs. Here is a simple example: package MyApp::Controller::User; use Moose; use MooseX::MethodAttributes; use MooseX::Types::Moose qw(Int); extends 'Catalyst::Controller'; sub find :Path('') Args(Int) { my ($self, $c, $int) = @_; } __PACKAGE__->meta->make_immutable; In this case the incoming request "http://localhost:/user/100" would match the action C but "http://localhost:/user/not_a_number" would not. You may find declaring constraints in this manner aids with debugging, automatic generation of documentation and reducing the amount of manual checking you might need to do in your actions. For example if the argument in the given action was going to be used to lookup a row in a database, if the matching field expected an integer, a string might cause a database exception, prompting you to add additional checking of the argument prior to using it. In general it is hoped this feature can lead to reduced validation boilerplate and more easily understood and declarative actions. More than one argument may be added by comma separating your type constraint names, for example: use Types::Standard qw/Int Str/; sub find :Path('') Args(Int,Int,Str) { my ($self, $c, $int1, $int2, $str) = @_; } Would require three arguments, an integer, integer and a string. Note in this example we constrained the args using imported types via L. Although you may use stringy Moose types, we recommend imported types since this is less ambiguous to your readers. If you want to use Moose stringy types. you must quote them (either "Int" or 'Int' is fine). Conversely, you should not quote types that are imported! =head3 Using type constraints in a controller By default L allows all the standard, built-in, named type constraints that come bundled with L. However it is trivial to create your own Type constraint libraries and export them to a controller that wishes to use them. We recommend using L or L for this. Here is an example using some extended type constraints via the L library that is packaged with L: package MyApp::Controller::User; use Moose; use MooseX::MethodAttributes; use Types::Standard qw/StrMatch Int/; extends 'Catalyst::Controller'; sub looks_like_a_date :Path('') Args(StrMatch[qr{\d\d-\d\d-\d\d}]) { my ($self, $c, $int) = @_; } __PACKAGE__->meta->make_immutable; This would match URLs like "http://localhost/user/11-11-2015" for example. If you've been missing the old RegExp matching, this can emulate a good chunk of that ability, and more. A tutorial on how to make custom type libraries is outside the scope of this document. I'd recommend looking at the copious documentation in L or in L if you prefer that system. The author recommends L if you are unsure which to use. =head3 Type constraint namespace. By default we assume the namespace which defines the type constraint is in the package which contains the action declaring the arg or capture arg. However if you do not wish to import type constraints into you package, you may use a fully qualified namespace for your type constraint. If you do this you must install L which defines the code used to lookup and normalize the various types of Type constraint libraries. Example: package MyApp::Example; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub an_int_ns :Local Args(MyApp::Types::Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } Would basically work the same as: package MyApp::Example; use Moose; use MooseX::MethodAttributes; use MyApp::Types 'Int'; extends 'Catalyst::Controller'; sub an_int_ns :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } =head3 namespace::autoclean If you want to use L in your controllers you must 'except' imported type constraints since the code that resolves type constraints in args / capture args run after the cleaning. For example: package MyApp::Controller::Autoclean; use Moose; use MooseX::MethodAttributes; use namespace::autoclean -except => 'Int'; use MyApp::Types qw/Int/; extends 'Catalyst::Controller'; sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (autoclean)'); } =head3 Using roles and base controller with type constraints If your controller is using a base class or a role that has an action with a type constraint you should declare your use of the type constraint in that role or base controller in the same way as you do in main controllers. Catalyst will try to find the package with declares the type constraint first by looking in any roles and then in superclasses. It will use the first package that defines the type constraint. For example: package MyApp::Role; use Moose::Role; use MooseX::MethodAttributes::Role; use MyApp::Types qw/Int/; sub an_int :Local Args(Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } sub an_int_ns :Local Args(MyApp::Types::Int) { my ($self, $c, $int) = @_; $c->res->body('an_int (withrole)'); } package MyApp::BaseController; use Moose; use MooseX::MethodAttributes; use MyApp::Types qw/Int/; extends 'Catalyst::Controller'; sub from_parent :Local Args(Int) { my ($self, $c, $id) = @_; $c->res->body('from_parent $id'); } package MyApp::Controller::WithRole; use Moose; use MooseX::MethodAttributes; extends 'MyApp::BaseController'; with 'MyApp::Role'; If you have complex controller hierarchy, we do not at this time attempt to look for all packages with a match type constraint, but instead take the first one found. In the future we may add code that attempts to insure a sane use of subclasses with type constraints but right now there are no clear use cases so report issues and interests. =head3 Match order when more than one Action matches a path. As previously described, L will match 'the longest path', which generally means that named path / path_parts will take precedence over Args or CaptureArgs. However, what will happen if two actions match the same path with equal args? For example: sub an_int :Path(user) Args(Int) { } sub an_any :Path(user) Args(1) { } In this case L will check actions starting from the LAST one defined. Generally this means you should put your most specific action rules LAST and your 'catch-alls' first. In the above example, since Args(1) will match any argument, you will find that that 'an_int' action NEVER gets hit. You would need to reverse the order: sub an_any :Path(user) Args(1) { } sub an_int :Path(user) Args(Int) { } Now requests that match this path would first hit the 'an_int' action and will check to see if the argument is an integer. If it is, then the action will execute, otherwise it will pass and the dispatcher will check the next matching action (in this case we fall through to the 'an_any' action). =head3 Type Constraints and Chained Actions Using type constraints in Chained actions works the same as it does for Path and Local or Global actions. The only difference is that you may declare type constraints on CaptureArgs as well as Args. For Example: use Types::Standard qw/Int Tuple/; sub chain_base :Chained(/) CaptureArgs(1) { } sub any_priority_chain :GET Chained(chain_base) PathPart('') Args(1) { } sub int_priority_chain :Chained(chain_base) PathPart('') Args(Int) { } sub link_any :Chained(chain_base) PathPart('') CaptureArgs(1) { } sub any_priority_link_any :Chained(link_any) PathPart('') Args(1) { } sub int_priority_link_any :Chained(link_any) PathPart('') Args(Int) { } sub link_int :Chained(chain_base) PathPart('') CaptureArgs(Int) { } sub any_priority_link :Chained(link_int) PathPart('') Args(1) { } sub int_priority_link :Chained(link_int) PathPart('') Args(Int) { } sub link_int_int :Chained(chain_base) PathPart('') CaptureArgs(Int,Int) { } sub any_priority_link2 :Chained(link_int_int) PathPart('') Args(1) { } sub int_priority_link2 :Chained(link_int_int) PathPart('') Args(Int) { } sub link_tuple :Chained(chain_base) PathPart('') CaptureArgs(Tuple[Int,Int,Int]) { } sub any_priority_link3 :Chained(link_tuple) PathPart('') Args(1) { } sub int_priority_link3 :Chained(link_tuple) PathPart('') Args(Int) { } These chained actions might create match tables like the following: [debug] Loaded Chained actions: .-------------------------------------+--------------------------------------. | Path Spec | Private | +-------------------------------------+--------------------------------------+ | /chain_base/*/* | /chain_base (1) | | | => GET /any_priority_chain (1) | | /chain_base/*/*/* | /chain_base (1) | | | -> /link_int (Int) | | | => /any_priority_link (1) | | /chain_base/*/*/*/* | /chain_base (1) | | | -> /link_int_int (Int,Int) | | | => /any_priority_link2 (1) | | /chain_base/*/*/*/*/* | /chain_base (1) | | | -> /link_tuple (Tuple[Int,Int,Int]) | | | => /any_priority_link3 (1) | | /chain_base/*/*/* | /chain_base (1) | | | -> /link_any (1) | | | => /any_priority_link_any (1) | | /chain_base/*/*/*/*/*/* | /chain_base (1) | | | -> /link_tuple (Tuple[Int,Int,Int]) | | | -> /link2_int (UserId) | | | => GET /finally (Int) | | /chain_base/*/*/*/*/*/... | /chain_base (1) | | | -> /link_tuple (Tuple[Int,Int,Int]) | | | -> /link2_int (UserId) | | | => GET /finally2 (...) | | /chain_base/*/* | /chain_base (1) | | | => /int_priority_chain (Int) | | /chain_base/*/*/* | /chain_base (1) | | | -> /link_int (Int) | | | => /int_priority_link (Int) | | /chain_base/*/*/*/* | /chain_base (1) | | | -> /link_int_int (Int,Int) | | | => /int_priority_link2 (Int) | | /chain_base/*/*/*/*/* | /chain_base (1) | | | -> /link_tuple (Tuple[Int,Int,Int]) | | | => /int_priority_link3 (Int) | | /chain_base/*/*/* | /chain_base (1) | | | -> /link_any (1) | | | => /int_priority_link_any (Int) | '-------------------------------------+--------------------------------------' As you can see the same general path could be matched by various action chains. In this case the rule described in the previous section should be followed, which is that L will start with the last defined action and work upward. For example the action C would be checked before C. The same applies for actions that are midway links in a longer chain. In this case C would be checked before C. So as always we recommend that you place you priority or most constrained actions last and you least or catch-all actions first. Although this reverse order checking may seen counter intuitive it does have the added benefit that when inheriting controllers any new actions added would take check precedence over those in your parent controller or consumed role. Please note that your declared type constraint names will now appear in the debug console. =head1 Author John Napiorkowski L =cut Catalyst-Runtime-5.90115/lib/Catalyst/Runtime.pm000644 000765 000024 00000001206 13101661634 023453 0ustar00jnapiorkowskistaff000000 000000 package Catalyst::Runtime; use strict; use warnings; BEGIN { require 5.008003; } # Remember to update this in Catalyst as well! our $VERSION = '5.90115'; $VERSION = eval $VERSION if $VERSION =~ /_/; # numify for warning-free dev releases =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.90115/lib/Catalyst/Script/000755 000765 000024 00000000000 13101661740 022735 5ustar00jnapiorkowskistaff000000 000000 Catalyst-Runtime-5.90115/lib/Catalyst/ScriptRole.pm000644 000765 000024 00000005555 13101634223 024123 0ustar00jnapiorkowskistaff000000 000000 package Catalyst::ScriptRole; use Moose::Role; use Pod::Usage; use MooseX::Getopt; use Catalyst::EngineLoader; use Moose::Util::TypeConstraints; use Catalyst::Utils; use namespace::autoclean; subtype 'Catalyst::ScriptRole::LoadableClass', as 'ClassName'; coerce 'Catalyst::ScriptRole::LoadableClass', from 'Str', via { Catalyst::Utils::ensure_class_loaded($_); $_ }; 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; Catalyst::Utils::ensure_class_loaded($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.90115/lib/Catalyst/ScriptRunner.pm000644 000765 000024 00000006061 12406561462 024477 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Stats.pm000644 000765 000024 00000024572 12406561462 023146 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Test.pm000644 000765 000024 00000034766 12406561462 022775 0ustar00jnapiorkowskistaff000000 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.90115/lib/Catalyst/Upgrading.pod000644 000765 000024 00000110540 12745475316 024135 0ustar00jnapiorkowskistaff000000 000000 =head1 NAME Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst =head1 Upgrading to Catalyst 5.90100 We changed the way the middleware stash works so that it no longer localizes the PSGI env hashref. This was done to fix bugs where people set PSGI ENV hash keys and found them to disappear in certain cases. It also means that now if a sub applications sets stash variables, that stash will now bubble up to the parent application. This may be a breaking change for you since previous versions of this code did not allow that. A workaround is to explicitly delete stash keys in your sub application before returning control to the parent application. =head1 Upgrading to Catalyst 5.90097 In older versions of Catalyst one could construct a L with a fragment (such as https://localhost/foo/bar#fragment) by using a '#' in the path or final argument, for example: $c->uri_for($action, 'foo#fragment'); This behavior was never documented and would break if using the Unicode plugin, or when adding a query to the arguments: $c->uri_for($action, 'foo#fragment', +{ a=>1, b=>2}); would define a fragment like "#fragment?a=1&b=2". When we introduced UTF-8 encoding by default in Catalyst 5.9008x this side effect behavior was broken since we started encoding the '#' when it was part of the URI path. In version 5.90095 and 5.90096 we attempted to fix this, but all we managed to do was break people with URIs that included '#' as part of the path data, when it was not expected to be a fragment delimiter. In general L prefers an explicit specification rather than relying on side effects or domain specific mini languages. As a result we are now defining how to set a fragment for a URI via ->uri_for: $c->uri_for($action_or_path, \@captures_or_args, @args, \$query, \$fragment); If you are relying on the previous side effect behavior your URLs will now encode the '#' delimiter, which is going to be a breaking change for you. You need to alter your code to match the new specification or modify uri_for for your local case. Patches to solve this are very welcomed, as long as they don't break existing test cases. B If you are using the string form of the first argument: $c->uri_for('/foo/bar#baz') construction, we do not attempt to encode this and it will make a URL with a fragment of 'baz'. =head1 Upgrading to Catalyst 5.90095 The method C in L was actually returning the first error. This has been fixed but there is a small chance it could be a breaking issue for you. If this gives you trouble changing to C is the easiest workaround (although that does modify the error stack so if you are relying on that not being changed you should try something like @{$c->errors}[-1] instead. Since this method is relatively new and the cases when the error stack actually has more than one error in it, we feel the exposure is very low, but bug reports are very welcomed. =head1 Upgrading to Catalyst 5.90090 L has a new method 'inject_component' which works the same as the method of the same name in L. You should start converting any use of the non core method in your code as future changes to Catalyst will be synchronized to the core method first. We reserve the right to cease support of the non core version should we reach a point in time where it cannot be properly supported as an external module. Luckily this should be a trivial search and replace. Change all occurrences of: CatalystX::InjectComponent->inject(...) Into Catalyst::Utils::inject_component(...) and we expect everything to work the same (we'd consider it not working the same to be a bug, and please report it.) We also cored features from L to compose a role into the request, response and stats classes. The main difference is that with L you did: package MyApp; use Catalyst; use CatalystX::RoleApplicator; __PACKAGE__->apply_request_class_roles( qw/My::Request::Role Other::Request::Role/); Whereas now we have three class attributes, 'request_class_traits', 'response_class_traits' and 'stats_class_traits', so you use like this (note this value is an ArrayRef) package MyApp; use Catalyst; __PACKAGE__->request_class_traits([qw/ My::Request::Role Other::Request::Role/]); (And the same for response_class_traits and stats_class_traits. We left off the traits for Engine, since that class does a lot less nowadays, and dispatcher. If you used those and can share a use case, we'd be likely to support them. Lastly, we have some of the feature from L in core. This should mostly work the same way in core, except for now the core version does not create an automatic base wrapper class for your configured components (it requires these to be catalyst components and injects them directly. So if you make heavy use of custom base classes in L you might need a bit of work to use the core version (although there is no reason to stop using L since it should continue to work fine and we'd consider issues with it to be bugs). Here's one way to map from L to core: In L: MyApp->config( 'Model::MyClass' => { class => 'MyClass', args => { %args }, }); and now in core: MyApp->config( inject_components => { 'Model::MyClass' => { from_component => 'My::Class' }, }, 'Model::MyClass' => { %args }, ); Although the core behavior requires more code, it better separates concerns as well as plays more into core Catalyst expectations of how configuration should look. Also we added a new develop console mode only warning when you call a component with arguments that don't expect or do anything meaningful with those args. Its possible if you are logging debug mode in production (please don't...) this could add verbosity to those logs if you also happen to be calling for components and passing pointless arguments. We added this warning to help people not make this error and to better understand the component resolution flow. =head1 Upgrading to Catalyst 5.90085 In this version of Catalyst we made a small change to Chained Dispatching so that when two or more actions all have the same path specification AND they all have Args(0), we break the tie by choosing the last action defined, and not the first one defined. This was done to normalize Chaining to following the 'longest Path wins, and when several actions match the same Path specification we choose the last defined.' rule. Previously Args(0) was hard coded to be a special case such that the first action defined would match (which is not the case when Args is not zero.) Its possible that this could be a breaking change for you, if you had used action roles (custom or otherwise) to add additional matching rules to differentiate between several Args(0) actions that share the same root action chain. For example if you have code now like this: sub check_default :Chained(/) 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'); } The way that chaining will work previous is that when two or more equal actions can match, the 'top' one wins. So if the request is "GET .../check_default" BOTH actions 'default_get' AND 'chain_default' would match. To break the tie in the case when Args is 0, we'd previous take the 'top' (or first defined) action. Unfortunately this treatment of Args(0) is special case. In all other cases we choose the 'last defined' action to break a tie. So this version of Catalyst changed the dispatcher to make Args(0) no longer a special case for breaking ties. This means that the above code must now become: sub check_default :Chained(/) CaptureArgs(0) { ... } sub chain_default :Chained('check_default') PathPart('') Args(0) { pop->res->body('chain_default'); } 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'); } If we want it to work as expected (for example we we GET to match 'default_get' and POST to match 'default_post' and any other http Method to match 'chain_default'). In other words Arg(0) and chained actions must now follow the normal rule where in a tie the last defined action wins and you should place all your less defined or 'catch all' actions first. If this causes you trouble and you can't fix your code to conform, you may set the application configuration setting "use_chained_args_0_special_case" to true and that will revert you code to the previous behavior. =head2 More backwards compatibility options with UTF-8 changes In order to give better backwards compatibility with the 5.90080+ UTF-8 changes we've added several configuration options around control of how we try to decode your URL keywords / query parameters. C If true, then do not try to character decode any wide characters in your request URL query or keywords. Most readings of the relevant specifications suggest these should be UTF-* encoded, which is the default that L will use, however if you are creating a lot of URLs manually or have external evil clients, this might cause you trouble. If you find the changes introduced in Catalyst version 5.90080+ break some of your query code, you may disable the UTF-8 decoding globally using this configuration. This setting takes precedence over C and C C By default we decode query and keywords in your request URL using UTF-8, which is our reading of the relevant specifications. This setting allows one to specify a fixed value for how to decode your query. You might need this if you are doing a lot of custom encoding of your URLs and not using UTF-8. This setting take precedence over C. C Setting this to true will default your query decoding to whatever your general global encoding is (the default is UTF-8). =head1 Upgrading to Catalyst 5.90080 UTF8 encoding is now default. For temporary backwards compatibility, if this change is causing you trouble, you can disable it by setting the application configuration option to undef: MyApp->config(encoding => undef); But please consider this a temporary measure since it is the intention that UTF8 is enabled going forwards and the expectation is that other ecosystem projects will assume this as well. At some point you application will not correctly function without this setting. As of 5.90084 we've added two additional configuration flags for more selective control over some encoding changes: 'skip_body_param_unicode_decoding' and 'skip_complex_post_part_handling'. You may use these to more selectively disable new features while you are seeking a long term fix. Please review CONFIGURATION in L. For further information, please see L A number of projects in the wider ecosystem required minor updates to be able to work correctly. Here's the known list: L, L, L, L, L You will need to update to modern versions in most cases, although quite a few of these only needed minor test case and documentation changes so you will need to review the changelog of each one that is relevant to you to determine your true upgrade needs. =head1 Upgrading to Catalyst 5.90060 Starting in the v5.90059_001 development release, the regexp dispatch type is no longer automatically included as a dependency. If you are still using this dispatch type, you need to add L into your build system. The standalone distribution of Regexp will be supported for the time being, but should we find that supporting it prevents us from moving L forward in necessary ways, we reserve the right to drop that support. It is highly recommended that you use this last stage of deprecation to change your code. =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