Catalyst-Runtime-5.90126/0000755000000000000000000000000013611202206015215 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/LICENSE0000644000000000000000000004342513611202206016232 0ustar00rootwheel00000000000000Terms of the Perl programming language system itself a) the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version, or b) the "Artistic License" --- The GNU General Public License, Version 1, February 1989 --- This software is Copyright (c) 2020 by Sebastian Riedel . This is free software, licensed under: The GNU General Public License, Version 1, February 1989 GNU GENERAL PUBLIC LICENSE Version 1, February 1989 Copyright (C) 1989 Free Software Foundation, Inc. 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The license agreements of most software companies try to keep users at the mercy of those companies. By contrast, our General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. The General Public License applies to the Free Software Foundation's software and to any other program whose authors commit to using it. You can use it for your programs, too. When we speak of free software, we are referring to freedom, not price. Specifically, the General Public License is designed to make sure that you have the freedom to give away or sell copies of free software, that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of a such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must tell them their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any work containing the Program or a portion of it, either verbatim or with modifications. Each licensee is addressed as "you". 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this General Public License and to the absence of any warranty; and give any other recipients of the Program a copy of this General Public License along with the Program. You may charge a fee for the physical act of transferring a copy. 2. You may modify your copy or copies of the Program or any portion of it, and copy and distribute such modifications under the terms of Paragraph 1 above, provided that you also do the following: a) cause the modified files to carry prominent notices stating that you changed the files and the date of any change; and b) cause the whole of any work that you distribute or publish, that in whole or in part contains the Program or any part thereof, either with or without modifications, to be licensed at no charge to all third parties under the terms of this General Public License (except that you may choose to grant warranty protection to some or all third parties, at your option). c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the simplest and most usual way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this General Public License. d) You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. Mere aggregation of another independent work with the Program (or its derivative) on a volume of a storage or distribution medium does not bring the other work under the scope of these terms. 3. You may copy and distribute the Program (or a portion or derivative of it, under Paragraph 2) in object code or executable form under the terms of Paragraphs 1 and 2 above provided that you also do one of the following: a) accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Paragraphs 1 and 2 above; or, b) accompany it with a written offer, valid for at least three years, to give any third party free (except for a nominal charge for the cost of distribution) a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Paragraphs 1 and 2 above; or, c) accompany it with the information you received as to where the corresponding source code may be obtained. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form alone.) Source code for a work means the preferred form of the work for making modifications to it. For an executable file, complete source code means all the source code for all modules it contains; but, as a special exception, it need not include source code for modules which are standard libraries that accompany the operating system on which the executable file runs, or for standard header files or definitions files that accompany that operating system. 4. You may not copy, modify, sublicense, distribute or transfer the Program except as expressly provided under this General Public License. Any attempt otherwise to copy, modify, sublicense, distribute or transfer the Program is void, and will automatically terminate your rights to use the Program under this License. However, parties who have received copies, or rights to use copies, from you under this General Public License will not have their licenses terminated so long as such parties remain in full compliance. 5. By copying, distributing or modifying the Program (or any work based on the Program) you indicate your acceptance of this license to do so, and all its terms and conditions. 6. Each time you redistribute the Program (or any work based on the Program), the recipient automatically receives a license from the original licensor to copy, distribute or modify the Program subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. 7. The Free Software Foundation may publish revised and/or new versions of the General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Program specifies a version number of the license which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Program does not specify a version number of the license, you may choose any version ever published by the Free Software Foundation. 8. If you wish to incorporate parts of the Program into other free programs whose distribution conditions are different, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 9. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 10. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS Appendix: How to Apply These Terms to Your New Programs If you develop a new program, and you want it to be of the greatest possible use to humanity, the best way to achieve this is to make it free software which everyone can redistribute and change under these terms. To do so, attach the following notices to the program. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) 19yy This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 1, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19xx name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (a program to direct compilers to make passes at assemblers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice That's all there is to it! --- The Artistic License 1.0 --- This software is Copyright (c) 2020 by Sebastian Riedel . This is free software, licensed under: The Artistic License 1.0 The Artistic License Preamble The intent of this document is to state the conditions under which a Package may be copied, such that the Copyright Holder maintains some semblance of artistic control over the development of the package, while giving the users of the package the right to use and distribute the Package in a more-or-less customary fashion, plus the right to make reasonable modifications. Definitions: - "Package" refers to the collection of files distributed by the Copyright Holder, and derivatives of that collection of files created through textual modification. - "Standard Version" refers to such a Package if it has not been modified, or has been modified in accordance with the wishes of the Copyright Holder. - "Copyright Holder" is whoever is named in the copyright or copyrights for the package. - "You" is you, if you're thinking about copying or distributing this Package. - "Reasonable copying fee" is whatever you can justify on the basis of media cost, duplication charges, time of people involved, and so on. (You will not be required to justify it to the Copyright Holder, but only to the computing community at large as a market that must bear the fee.) - "Freely Available" means that no fee is charged for the item itself, though there may be fees involved in handling the item. It also means that recipients of the item may redistribute it under the same conditions they received it. 1. You may make and give away verbatim copies of the source form of the Standard Version of this Package without restriction, provided that you duplicate all of the original copyright notices and associated disclaimers. 2. You may apply bug fixes, portability fixes and other modifications derived from the Public Domain or from the Copyright Holder. A Package modified in such a way shall still be considered the Standard Version. 3. You may otherwise modify your copy of this Package in any way, provided that you insert a prominent notice in each changed file stating how and when you changed that file, and provided that you do at least ONE of the following: a) place your modifications in the Public Domain or otherwise make them Freely Available, such as by posting said modifications to Usenet or an equivalent medium, or placing the modifications on a major archive site such as ftp.uu.net, or by allowing the Copyright Holder to include your modifications in the Standard Version of the Package. b) use the modified Package only within your corporation or organization. c) rename any non-standard executables so the names do not conflict with standard executables, which must also be provided, and provide a separate manual page for each non-standard executable that clearly documents how it differs from the Standard Version. d) make other distribution arrangements with the Copyright Holder. 4. You may distribute the programs of this Package in object code or executable form, provided that you do at least ONE of the following: a) distribute a Standard Version of the executables and library files, together with instructions (in the manual page or equivalent) on where to get the Standard Version. b) accompany the distribution with the machine-readable source of the Package with your modifications. c) accompany any non-standard executables with their corresponding Standard Version executables, giving the non-standard executables non-standard names, and clearly documenting the differences in manual pages (or equivalent), together with instructions on where to get the Standard Version. d) make other distribution arrangements with the Copyright Holder. 5. You may charge a reasonable copying fee for any distribution of this Package. You may charge any fee you choose for support of this Package. You may not charge a fee for this Package itself. However, you may distribute this Package in aggregate with other (possibly commercial) programs as part of a larger (possibly commercial) software distribution provided that you do not advertise this Package as a product of your own. 6. The scripts and library files supplied as input to or produced as output from the programs of this Package do not automatically fall under the copyright of this Package, but belong to whomever generated them, and may be sold commercially, and may be aggregated with this Package. 7. C or perl subroutines supplied by you and linked into this Package shall not be considered part of this Package. 8. The name of the Copyright Holder may not be used to endorse or promote products derived from this software without specific prior written permission. 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR PURPOSE. The End Catalyst-Runtime-5.90126/Changes0000644000000000000000000043653413611200226016527 0ustar00rootwheel00000000000000# This file documents the revision history for Perl extension Catalyst. 5.90126 - 2020-01-19 - fix for broken distribution 5.90125 - 2020-01-18 - Support samesite flag for cookies (mitchjacksontech++) - utility method on Catalyst::Action 'equals' - new predicate methods 'has_request' and 'has_response'. Useful in plugins that might run bits before a request is finalized. 5.90124 - 2019-01-18 - Fix problem with from_psgi_response and streaming applications ( https://github.com/perl-catalyst/catalyst-runtime/pull/168). 5.90123 - 2018-11-27 - Fix emitting warnings when REMOTE_ADDR is undefined (RT#113388) - Fix $c->req->hostname empty for IPv6 clients (RT#75731) - split code to log stats report into a separate log_stats method (RT#127392) 5.90122 - 2018-11-03 - releasing as stable 5.90_121 - 2018-10-22 - use the :utf8_strict (PerlIO::utf8_strict) rather than :encoding file handle layer to handle decoding uploads, as a performance boost. - fix handling of decoding uploaded files. this fixes the usage of sysread on :utf8 handles, and reenables the tests on all perl versions. Fixes CPAN RT#125843. See also erl RT#133585. - giving incorrect types to uri_for will warn to logs rather than via carp - silence warning and error output from tests 5.90120 - 2018-10-19 - avoid problematic test using sysread() on :utf8 filehandles on dev perl versions where this is fatal (starting with 5.29.4). see RT#125843. 5.90119 - 2018-09-24 - fix test for changes in MooseX::Getopt 0.73 (RT#127050) 5.90118 - 2018-05-01 - fix handling of fragments in uri_for when path is an unblessed string (GH#160) - ensure catalyst.pl is included with dist - drop IO::Scalar prereq - include optional test prereqs as develop prereqs - remove unused developer prereq on Catalyst::Engine::PSGI - use namespace::clean consistently rather than namespace::autoclean - use JSON for test metadata to avoid needing YAML - use JSON::MaybeXS consistently in code - drop unused prereq of HTTP::Request::AsCGI - drop unneeded prereq of Class::Data::Inheritable - fix tests to cope with changes in new versions of Time::HiRes - POD typo and syntax fixes 5.90117 - 2018-01-21 - Fixed errors in distribution packaging 5.90116 - 2018-01-19 - Switch from Module::Install to Distar (solves problems that MI has with newer Perl) haarg++ - Killed Test::Aggregate since its clearly doomed - PR135 - improved test cases for query keywork - PR158 - improved docs for Catalyst::Test - PR157 - improved error response for data_handlers - PR156 - POD fixes - PR154 - Few dependencies - PR152 - Better support for HTTP Patch 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.90126/MANIFEST0000644000000000000000000004277713611202206016367 0ustar00rootwheel00000000000000Changes 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 maint/Makefile.PL.include Makefile.PL MANIFEST This list of files 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/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/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/Guff.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/Guff.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/Guff.pm t/lib/TestApp/ActionRole/Kooh.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.json t/optional_stress.t 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/query_keywords_and_parameters.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 xt/author/http-server.t xt/author/notabs.t xt/author/pod.t xt/author/podcoverage.t xt/author/spelling.t xt/author/unicode_plugin_nested_params.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) README README file (added by Distar) LICENSE LICENSE file (added by Distar) Catalyst-Runtime-5.90126/t/0000755000000000000000000000000013611202203015455 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/evil_stash.t0000644000000000000000000000131613366373233020027 0ustar00rootwheel00000000000000use 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.90126/t/abort-chain-2.t0000644000000000000000000000232613366373233020216 0ustar00rootwheel00000000000000use 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('-Log=fatal'); } 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.90126/t/encoding_set_in_app.t0000644000000000000000000000047112406561462021653 0ustar00rootwheel00000000000000use 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.90126/t/relative_root_action_for_bug.t0000644000000000000000000000404013025775570023603 0ustar00rootwheel00000000000000use 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.90126/t/arg_constraints.t0000644000000000000000000003357413366373233021101 0ustar00rootwheel00000000000000use 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::clean -except => [ 'meta' ]; 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('-Log=fatal'); } 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.90126/t/dead_load_multiple_chained_attributes.t0000644000000000000000000000102312406561462025406 0ustar00rootwheel00000000000000use 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.90126/t/bad_warnings.t0000644000000000000000000000302113366373233020317 0ustar00rootwheel00000000000000use 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('-Log=fatal'); } 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.90126/t/plack-middleware-config.t0000644000000000000000000000257512406561462022343 0ustar00rootwheel00000000000000#!/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.90126/t/bad_middleware_error.t0000644000000000000000000000040512406561462022015 0ustar00rootwheel00000000000000#!/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.90126/t/middleware-stash.t0000644000000000000000000000322712572364356021132 0ustar00rootwheel00000000000000use 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.90126/t/unit_core_script_test.t0000644000000000000000000000236312406561463022301 0ustar00rootwheel00000000000000use 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.90126/t/configured_comps.t0000644000000000000000000000537113366373233021221 0ustar00rootwheel00000000000000use 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.90126/t/optional_apache-cgi-rewrite.pl0000644000000000000000000000300613366373233023401 0ustar00rootwheel00000000000000# 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.90126/t/optional_apache-cgi.pl0000644000000000000000000000277213366373233021733 0ustar00rootwheel00000000000000# 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.90126/t/something/0000755000000000000000000000000013611202202017451 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/something/script/0000755000000000000000000000000013611202202020755 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/something/script/foo/0000755000000000000000000000000013611202202021540 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/something/script/foo/bar/0000755000000000000000000000000013611202202022304 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/something/script/foo/bar/for_dist0000644000000000000000000000000013230210226024030 0ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/something/Makefile.PL0000644000000000000000000000000013230210177021420 0ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/unicode-exception-return-value.t0000644000000000000000000000474113366373233023744 0ustar00rootwheel00000000000000use 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.90126/t/utf_incoming.t0000644000000000000000000004432113366373233020352 0ustar00rootwheel00000000000000use 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('-Log=fatal'), '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.90126/t/01use.t0000644000000000000000000000006012406561462016613 0ustar00rootwheel00000000000000use Test::More tests => 1; use_ok('Catalyst'); Catalyst-Runtime-5.90126/t/data_handler.t0000644000000000000000000000243613231213075020264 0ustar00rootwheel00000000000000#!/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'; } { my $out; local *STDERR; open(STDERR, ">", \$out) or die "Can't open STDERR: $!"; ok my $req = POST $c->uri_for_action('/test_nested_for'), 'Content-Type' => 'multipart/form-data', Content => { die => "a horrible death" }; ok my $response = request $req; is($out, "[error] multipart/form-data does not have an available data handler. Valid data_handlers are application/json, application/x-www-form-urlencoded.\n", 'yep we throw the slightly more usefull error'); } done_testing; Catalyst-Runtime-5.90126/t/unicode_plugin_live.t0000644000000000000000000000477213366373233021722 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; # 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($@); # 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.90126/t/plugin_new_method_backcompat.t0000644000000000000000000000240412406561462023555 0ustar00rootwheel00000000000000# 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.90126/t/undef_encoding_regression.t0000644000000000000000000000156312745474071023103 0ustar00rootwheel00000000000000use 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.90126/t/unicode_plugin_no_encoding.t0000644000000000000000000000260412454003036023221 0ustar00rootwheel00000000000000use 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.90126/t/plack-middleware.t0000644000000000000000000000304212475111327021063 0ustar00rootwheel00000000000000#!/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.90126/t/optional_lighttpd-fastcgi.t0000644000000000000000000000611513366373233023032 0ustar00rootwheel00000000000000use 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.90126/t/unicode_plugin_config.t0000644000000000000000000000117012572364356022221 0ustar00rootwheel00000000000000use 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.90126/t/live_stats.t0000644000000000000000000000110612406561462020035 0ustar00rootwheel00000000000000use 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.90126/t/abort-chain-1.t0000644000000000000000000000223113366373233020210 0ustar00rootwheel00000000000000use 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('-Log=fatal'); } 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.90126/t/aggregate/0000755000000000000000000000000013611202203017403 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/aggregate/to_app.t0000644000000000000000000000026212454003036021061 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_engineloader.t0000644000000000000000000000147612406561462023313 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_cookies.t0000644000000000000000000000551012406561462025527 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_engine_fixenv-lighttpd.t0000644000000000000000000000324012406561462026317 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_escaped_path.t0000644000000000000000000000110512406561462026341 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_redirect.t0000644000000000000000000000425412406561462025700 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_large.t0000644000000000000000000000116613366373233025173 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_setup.t0000644000000000000000000000537412422532613023022 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_priorities.t0000644000000000000000000000437013366373233023027 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_print.t0000644000000000000000000000100113366373233025221 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/meta_method_unneeded.t0000644000000000000000000000073712406561462023754 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/c3_appclass_bug.t0000644000000000000000000000063312406561462022642 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_end.t0000644000000000000000000000255712406561462027270 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_run_options.t0000644000000000000000000000157412406561462025631 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_path.t0000644000000000000000000001206612406561462027452 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_plugin.t0000644000000000000000000000262412406561462023161 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_engine_fixenv-iis6.t0000644000000000000000000000420212406561462025351 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_uri_for_action.t0000644000000000000000000002110513366373233024663 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_parameters.t0000644000000000000000000001344313366373233026077 0ustar00rootwheel00000000000000use strict; use warnings; use FindBin; use lib "$FindBin::Bin/../lib"; use Test::More tests => 56; 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 $body_parameters = { a => 1, blank => '', }; my $query_parameters = { 'query string' => undef }; my $parameters = { %$body_parameters, %$query_parameters }; my $request = POST( 'http://localhost/dump/request/a/b?query+string', 'Content' => $body_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->query_parameters, $query_parameters, 'Catalyst::Request query_parameters' ); is_deeply( $creq->body_parameters, $body_parameters, 'Catalyst::Request body_parameters' ); 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.90126/t/aggregate/live_engine_response_errors.t0000644000000000000000000000335312406561462025412 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_utils_prefix.t0000644000000000000000000000200112406561462023355 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_inheritance.t0000644000000000000000000000757412406561462031017 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_controller_config.t0000755000000000000000000001002112406561462024354 0ustar00rootwheel00000000000000## ============================================================================ ## 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.90126/t/aggregate/live_engine_request_headers.t0000644000000000000000000000540113366373233025342 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_uploads.t0000644000000000000000000003114413366373233025401 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_merge_config_hashes.t0000644000000000000000000000173612406561462025645 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_metaclass_compat_extend_non_moose_controller.t0000644000000000000000000000052612406561462032057 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/utf8_content_length.t0000644000000000000000000000131112454003036023554 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_fastcgi.t0000644000000000000000000000575513366373233024702 0ustar00rootwheel00000000000000use 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::clean -except => [ 'meta' ]; 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.90126/t/aggregate/unit_core_scriptrunner.t0000644000000000000000000000140312406561462024413 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_component_generating.t0000644000000000000000000000045212406561462026065 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/deprecated_test_unimported.t0000644000000000000000000000060312406561462025214 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_auth.t0000644000000000000000000000176713366373233024703 0ustar00rootwheel00000000000000# 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.90126/t/aggregate/live_component_controller_action_die_in_end.t0000644000000000000000000000101412406561462030562 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_local.t0000644000000000000000000001074113366373233027611 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_utils_home.t0000644000000000000000000000172612406561462023025 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_controller_actions_config.t0000644000000000000000000000037512406561462027114 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_prepare_parameters.t0000755000000000000000000000175512406561462027620 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_detach.t0000644000000000000000000000553012406561462027744 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_action.t0000644000000000000000000000233512406561462023137 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_help.t0000644000000000000000000000110313366373233024171 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; use Test::Fatal; use FindBin qw/$Bin/; use lib "$Bin/../lib"; no warnings 'once'; *CORE::GLOBAL::exit = sub {}; { 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.90126/t/aggregate/live_component_controller_action_action.t0000644000000000000000000001660212406561462027773 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_uri_for_multibytechar.t0000644000000000000000000000323712454003036026254 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_path_matchsingle.t0000644000000000000000000000126212406561462032024 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_setup_log.t0000644000000000000000000000464713366373233023676 0ustar00rootwheel00000000000000use 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'); $meta->add_after_method_modifier('log', sub { my ($self, $log) = @_; if ($log) { open my $err_fh, '>', \(my $err_out) or die 'unable to open in memory buffer'; $log->psgienv({ 'psgi.errors' => $err_fh }); } }); return $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.90126/t/aggregate/live_component_controller_anon.t0000644000000000000000000000161712406561462026114 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_plugin_loaded.t0000644000000000000000000000147112406561462023440 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_action_for.t0000644000000000000000000000076412406561462024011 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/error_page_dump.t0000644000000000000000000000051712406561462022765 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_index_or_default.t0000644000000000000000000000177612406561462032037 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_status.t0000644000000000000000000000442612406561462025423 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_default.t0000644000000000000000000000530213366373233030140 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_component_loading.t0000644000000000000000000001637512614433663025374 0ustar00rootwheel00000000000000# 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.90126/t/aggregate/live_component_controller_action_forward.t0000644000000000000000000002106412406561462030160 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_engine-prepare_path.t0000644000000000000000000001032712406561462025577 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_body_demand.t0000644000000000000000000000453313366373233026201 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_path_to.t0000644000000000000000000000151512406561462023317 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_chained.t0000644000000000000000000012152213366373233030112 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_remote_user.t0000644000000000000000000000222512406561462026256 0ustar00rootwheel00000000000000# 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.90126/t/aggregate/unit_metaclass_compat_non_moose_controller.t0000644000000000000000000000075612406561462030515 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_view_warnings.t0000644000000000000000000000065313366373233023520 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_global.t0000644000000000000000000000453112406561462027754 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_server.t0000644000000000000000000001555112406561462024560 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_create.t0000644000000000000000000000422312406561462024507 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_uri_with.t0000644000000000000000000000405312406561462023513 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_log.t0000755000000000000000000000357512406561462022455 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/caf_backcompat.t0000644000000000000000000000121312406561462022522 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_chained2.t0000644000000000000000000000156712406561462030177 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_recursion.t0000644000000000000000000000120013366373233022634 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/deprecated_test_import.t0000644000000000000000000000033012406561462024335 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_view_single.t0000644000000000000000000000141112406561462025221 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_loop.t0000644000000000000000000000105712406561462021603 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_response.t0000644000000000000000000000054712406561462022513 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/custom_live_path_bug.t0000644000000000000000000000131712406561462024014 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_cookies.t0000644000000000000000000000264012406561462025362 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_load_catalyst_test.t0000644000000000000000000001334713366373233024544 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_env.t0000644000000000000000000000205713366373233024523 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_setup_stats.t0000644000000000000000000000350712406561462024242 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_utils_request.t0000644000000000000000000000111212406561462023552 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_utils_env_value.t0000644000000000000000000000274512406561462024063 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_classdata.t0000644000000000000000000000630712406561462023624 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_mvc.t0000644000000000000000000002165713366373233022462 0ustar00rootwheel00000000000000use 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('fatal'); } { 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.90126/t/aggregate/live_component_controller_action_visit.t0000644000000000000000000002343112406561462027652 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_body.t0000644000000000000000000000027112406561462025027 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_appclass_roles_in_plugin_list.t0000644000000000000000000000046012406561462027770 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_controller_actions.t0000644000000000000000000000137212406561462024555 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_headers.t0000644000000000000000000000302312406561462025503 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/c3_mro.t0000644000000000000000000000167712406561462021005 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_begin.t0000644000000000000000000000251412406561462027577 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/catalyst_test_utf8.t0000644000000000000000000000155613366373233023453 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_attributes.t0000644000000000000000000000252712406561462027350 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_metaclass_compat_non_moose.t0000644000000000000000000000014412406561462026241 0ustar00rootwheel00000000000000use strict; use warnings; use lib 't/lib'; use Test::More tests => 1; use_ok('TestAppMetaCompat'); Catalyst-Runtime-5.90126/t/aggregate/live_engine_request_body.t0000644000000000000000000000505212406561462024663 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_ctx_attr.t0000644000000000000000000000136012406561462023507 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_moose.t0000644000000000000000000000240613366373233026303 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_multipath.t0000644000000000000000000000347712406561462030533 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_go.t0000644000000000000000000002157412406561462027127 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_auto.t0000644000000000000000000001463012406561462027465 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_controller_namespace.t0000644000000000000000000000063512406561462025052 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_log_autoflush.t0000755000000000000000000000331613201351656024534 0ustar00rootwheel00000000000000use 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::SubclassAutoflush; 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::SubclassAutoflush'; can_ok $SUBCLASS, 'new'; ok $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.90126/t/aggregate/unit_core_component_layers.t0000644000000000000000000000146012406561462025241 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_response_emptybody.t0000644000000000000000000000073412406561462026112 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_actionroles.t0000644000000000000000000000153613201351656027477 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; use FindBin; use lib "$FindBin::Bin/../lib"; use Catalyst::Test 'TestApp'; my %roles = ( foo => 'TestApp::ActionRole::Guff', bar => 'TestApp::ActionRole::Guff', baz => 'Guff', 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::Guff'); 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.90126/t/aggregate/unit_core_script_cgi.t0000644000000000000000000000122312406561462024003 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_httpmethods.t0000644000000000000000000000364613366373233027533 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_dispatcher_requestargs_restore.t0000644000000000000000000000147012406561462027167 0ustar00rootwheel00000000000000# 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.90126/t/aggregate/live_engine_setup_plugins.t0000644000000000000000000000050612406561462025056 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_index.t0000644000000000000000000000630512406561462027624 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_engine_request_uri.t0000644000000000000000000001657713366373233024546 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/custom_live_component_controller_action_auto_doublebug.t0000644000000000000000000000207712406561462033111 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_args.t0000644000000000000000000000431313366373233026114 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/psgi_file.t0000644000000000000000000000321412406561462021551 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_script_server-without_modules.t0000644000000000000000000000140213201351656027773 0ustar00rootwheel00000000000000use 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; my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( Starman::Server Plack::Handler::Starman MooseX::Daemonize MooseX::Daemonize::Pid::File MooseX::Daemonize::Core ); local @INC = (sub { return unless exists $hidden{$_[1]}; die "Can't locate $_[1] in \@INC (hidden)\n"; }, @INC); do "$Bin/../aggregate/unit_core_script_server.t" or die $@ || 'test returned false'; 1; Catalyst-Runtime-5.90126/t/aggregate/live_engine_setup_basics.t0000644000000000000000000000046412406561462024644 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_streaming.t0000644000000000000000000000641112406561462030504 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_component.t0000644000000000000000000000534013366373233023666 0ustar00rootwheel00000000000000use 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('fatal'); } 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.90126/t/aggregate/unit_core_component_mro.t0000644000000000000000000000073212406561462024540 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/live_component_controller_action_private.t0000644000000000000000000000506512406561462030171 0ustar00rootwheel00000000000000use 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.90126/t/aggregate/unit_core_uri_for.t0000644000000000000000000002251713366373233023336 0ustar00rootwheel00000000000000use 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', 'with space', { 'also with' => 'space here' })->as_string, 'http://127.0.0.1/foo/bar/with%20space?also+with=space+here', 'Spaces encoded correctly' ); 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, '/bar', { param1 => 'value1' }, \'fragment' )->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' ); is( Catalyst::uri_for( 'TestApp', '/bar', 'with space', { 'also with' => 'space here' })->as_string, '/bar/with%20space?also+with=space+here', 'Spaces encoded correctly, 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' ); is( Catalyst::uri_for( $context, bless( { string => 'test' }, 'MyStringThing' ), \'fragment' ), 'http://127.0.0.1/test#fragment', 'overloaded object handled correctly' ); done_testing; Catalyst-Runtime-5.90126/t/http_method.t0000644000000000000000000000406613366373233020212 0ustar00rootwheel00000000000000use 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.90126/t/psgi-log.t0000644000000000000000000000502412502064643017400 0ustar00rootwheel00000000000000=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.90126/t/more-psgi-compat.t0000644000000000000000000000235212435153347021050 0ustar00rootwheel00000000000000#!/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.90126/t/live_show_internal_actions_warnings.t0000644000000000000000000000114612406561462025207 0ustar00rootwheel00000000000000use 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.90126/t/content_negotiation.t0000644000000000000000000000472512406561462021744 0ustar00rootwheel00000000000000#!/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.90126/t/live_component_controller_context_closure.t0000644000000000000000000000206513366373233026454 0ustar00rootwheel00000000000000use 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|REGEXP)/; 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.90126/t/remove_redundant_body.t0000644000000000000000000000161012406561462022236 0ustar00rootwheel00000000000000use 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.90126/t/psgi_utils.t0000644000000000000000000002527013417645771020063 0ustar00rootwheel00000000000000use 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"]]); } sub streaming_body :Local { my ($self, $c) = @_; my $psgi_app = sub { my $respond = shift; my $writer = $respond->([200,["Content-Type" => "text/plain"]]); $writer->write("body"); $writer->close; }; $c->res->from_psgi_response($psgi_app); } sub streaming_body_with_charset :Local { my ($self, $c) = @_; my $psgi_app = sub { my $respond = shift; my $writer = $respond->([200,["Content-Type" => "text/plain; charset=utf-8"]]); $writer->write("body"); $writer->close; }; #$c->clear_encoding; $c->res->from_psgi_response($psgi_app); } 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"; } { my ($res, $c) = ctx_request('/docs/streaming_body'); is $res->content, "body"; } { my ($res, $c) = ctx_request('/docs/streaming_body_with_charset'); is $res->content, "body"; } done_testing(); Catalyst-Runtime-5.90126/t/execute_exception.t0000644000000000000000000000234413366373233021410 0ustar00rootwheel00000000000000use 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('-Log=fatal'); } use Catalyst::Test 'MyApp'; { my ($res, $c); ctx_request("/dont_throw"); ctx_request("/do_throw"); ctx_request("/dont_throw"); } done_testing; Catalyst-Runtime-5.90126/t/useless_set_headers.t0000644000000000000000000000324213366373233021717 0ustar00rootwheel00000000000000use 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('warn')); 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.90126/t/args0_bug.t0000644000000000000000000000510312520162327017524 0ustar00rootwheel00000000000000use 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.90126/t/utf8.txt0000644000000000000000000000005112454003036017107 0ustar00rootwheel00000000000000

This is stream_body_fh action ♥

Catalyst-Runtime-5.90126/t/live_redirect_body.t0000644000000000000000000000471512406561462021526 0ustar00rootwheel00000000000000use 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.90126/t/psgi_file_testapp.t0000644000000000000000000000110012406561462021353 0ustar00rootwheel00000000000000use 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.90126/t/unicode_plugin_request_decode.t0000644000000000000000000000371512454003036023736 0ustar00rootwheel00000000000000use 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.90126/t/query_keywords_and_parameters.t0000644000000000000000000000430113366373233024024 0ustar00rootwheel00000000000000use 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) GET { my( $self, $c ) = @_; } package MyApp; use Catalyst; MyApp->setup; } use HTTP::Request::Common; use Catalyst::Test 'MyApp'; # These tests assume that the decoding that occurs for the query string follows # the payload decoding algorithm described here: # https://www.w3.org/TR/html5/forms.html#url-encoded-form-data { ok my $req = GET 'root/bar'; my ($res, $c) = ctx_request($req); ok !defined($c->req->query_keywords), 'query_keywords is not defined when no ?'; is_deeply $c->req->query_parameters, {}, 'query_parameters defined, but empty for no ?'; } { ok my $req = GET 'root/bar?'; my ($res, $c) = ctx_request($req); ok !defined $c->req->query_keywords, 'query_keywords is not defined when ? with empty query string'; is_deeply $c->req->query_parameters, {}, 'query_parameters defined, but empty with empty query string'; } { ok my $req = GET 'root/bar?a=b'; my ($res, $c) = ctx_request($req); ok !defined($c->req->query_keywords), 'query_keywords undefined when isindex not set'; is_deeply $c->req->query_parameters, { a => 'b' }, 'query_parameters defined for ?a=b'; } { ok my $req = GET 'root/bar?x'; my ($res, $c) = ctx_request($req); is $c->req->query_keywords, 'x', 'query_keywords defined for ?x'; # The algorithm reads like 'x' should be treated as a value, not a name. # Perl does not support undef as a hash key. I feel this would be the best # alternative as isindex is moving towards complete deprecation. is_deeply $c->req->query_parameters, { 'x' => undef }, 'query_parameters defined for ?x'; } { ok my $req = GET 'root/bar?x&a=b'; my ($res, $c) = ctx_request($req); is $c->req->query_keywords, 'x', 'query_keywords defined for ?x&a=b'; # See comment above about the 'query_parameters defined for ?x' test case. is_deeply $c->req->query_parameters, { 'x' => undef, a => 'b' }, 'query_parameters defined for ?x&a=b'; } done_testing(); Catalyst-Runtime-5.90126/t/custom_exception_class_simple.t0000644000000000000000000000045512406561462024014 0ustar00rootwheel00000000000000use 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.90126/t/optional_threads.t0000644000000000000000000000235313366373233021227 0ustar00rootwheel00000000000000use 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.90126/t/live_fork.t0000644000000000000000000000316513366373233017652 0ustar00rootwheel00000000000000# 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); use JSON::MaybeXS qw(decode_json); 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 JSON'); 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 JSON'); 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 JSON'); 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 { decode_json($result) }; } done_testing; Catalyst-Runtime-5.90126/t/unicode-exception-bug.t0000644000000000000000000000270613366373233022067 0ustar00rootwheel00000000000000use 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.90126/t/live_catalyst_test.t0000644000000000000000000000312113366373233021564 0ustar00rootwheel00000000000000use 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.90126/t/optional_http-server-restart.t0000644000000000000000000000733612406561462023545 0ustar00rootwheel00000000000000# 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.90126/t/unit_utils_load_class.t0000644000000000000000000000451613366373233022256 0ustar00rootwheel00000000000000use 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.90126/t/unit_utils_subdir.t0000644000000000000000000000256712406561463021444 0ustar00rootwheel00000000000000use 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.90126/t/no_test_stash_bug.t0000644000000000000000000000100412504614365021367 0ustar00rootwheel00000000000000use 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.90126/t/class_traits_CAR_bug.t0000644000000000000000000000316213366373233021704 0ustar00rootwheel00000000000000use 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 { my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( Foo Bar ); unshift @INC, sub { return unless exists $hidden{$_[1]}; die "Can't locate $_[1] in \@INC (hidden)\n"; }; } 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; } BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; BEGIN { extends 'Catalyst::Controller' }; sub root :Path('/') {} } { 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.90126/t/dispatch_on_scheme.t0000644000000000000000000000616212454003036021475 0ustar00rootwheel00000000000000use 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.90126/t/accept_context_regression.t0000644000000000000000000000120013366373233023121 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; BEGIN { 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__; } BEGIN { 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__; } BEGIN { package MyApp; use Catalyst; MyApp->setup; } use Catalyst::Test 'MyApp'; my ($res, $c) = ctx_request('/root/test_model'); ok $res; done_testing; Catalyst-Runtime-5.90126/t/dead_no_unknown_error.t0000644000000000000000000000032413366373233022245 0ustar00rootwheel00000000000000use 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.90126/t/undef-params.t0000644000000000000000000000223012520162327020233 0ustar00rootwheel00000000000000use 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.90126/t/optional_apache-fastcgi-non-root.pl0000644000000000000000000000303513366373233024353 0ustar00rootwheel00000000000000# 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.90126/t/unicode_plugin_charset_utf8.t0000644000000000000000000000140112454003036023330 0ustar00rootwheel00000000000000use 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.90126/t/unit_stats.t0000644000000000000000000001056213366373233020066 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More tests => 13; use Time::HiRes (); use Tree::Simple; my @fudge_t = ( 0, 0 ); BEGIN { no warnings; *Time::HiRes::gettimeofday = sub () { return @fudge_t }; my $original_tv_interval = \&Time::HiRes::tv_interval; *Time::HiRes::tv_interval = sub ($;@) { return $original_tv_interval->($_[0], $_[1] || [Time::HiRes::gettimeofday()]); }; } 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.90126/t/not_utf8_query_bug.t0000644000000000000000000000170012504614365021510 0ustar00rootwheel00000000000000use 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.90126/t/optional_memleak.t0000644000000000000000000000340513366373233021207 0ustar00rootwheel00000000000000use 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 $@; use JSON::MaybeXS qw(decode_json); our $t = Proc::ProcessTable->new( cache_ttys => 1 ); our ( $initial, $final ) = ( 0, 0 ); my $test_data = do { open my $fh, '<:raw', "$FindBin::Bin/optional_stress.json" or die "$!"; local $/; <$fh>; }; our $tests = decode_json($test_data); 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.90126/t/unit_core_methodattributes_method_metaclass_on_subclasses.t0000644000000000000000000000115212406561463031637 0ustar00rootwheel00000000000000use 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.90126/t/class_traits.t0000644000000000000000000000347213366373233020366 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; use Class::MOP; BEGIN { my %hidden = map { (my $m = "$_.pm") =~ s{::}{/}g; $m => 1 } qw( Foo Bar ); unshift @INC, sub { return unless exists $hidden{$_[1]}; die "Can't locate $_[1] in \@INC (hidden)\n"; }; } 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' } } BEGIN { package TestApp::Controller::Root; $INC{'TestApp/Controller/Root.pm'} = __FILE__; use Moose; BEGIN { extends 'Catalyst::Controller' }; sub root :Path('/') {} } { 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.90126/t/consumes.t0000644000000000000000000000231112453066027017512 0ustar00rootwheel00000000000000use 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.90126/t/lib/0000755000000000000000000000000013611202203016223 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppMatchSingleArg/0000755000000000000000000000000013611202202022353 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppMatchSingleArg/Controller/0000755000000000000000000000000013611202202024476 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppMatchSingleArg/Controller/Root.pm0000644000000000000000000000065012406561462026001 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestMiddleware.pm0000644000000000000000000000157712406561462021530 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppArgsEmptyParens.pm0000644000000000000000000000132112726017446023166 0ustar00rootwheel00000000000000package 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.90126/t/lib/ChainedActionsApp.pm0000644000000000000000000000057113366373233022124 0ustar00rootwheel00000000000000package ChainedActionsApp; use Moose; use TestLogger; use Catalyst::Runtime 5.80; use Catalyst qw//; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/PluginTestApp/0000755000000000000000000000000013611202202020761 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/PluginTestApp/Controller/0000755000000000000000000000000013611202202023104 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/PluginTestApp/Controller/Root.pm0000644000000000000000000000303112406561462024403 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestDataHandlers.pm0000644000000000000000000000020112406561462021764 0ustar00rootwheel00000000000000package TestDataHandlers; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' } ); __PACKAGE__->setup; Catalyst-Runtime-5.90126/t/lib/TestAppToTestScripts.pm0000644000000000000000000000022112406561462022667 0ustar00rootwheel00000000000000package TestAppToTestScripts; use strict; use warnings; use Carp; our @RUN_ARGS; sub run { @RUN_ARGS = @_; 1; # Does this work? } 1; Catalyst-Runtime-5.90126/t/lib/DeprecatedTestApp.pm0000644000000000000000000000031412406561462022140 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppStats.pm0000644000000000000000000000065212406561462021203 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestAppShowInternalActions.pm0000644000000000000000000000067513366373233024053 0ustar00rootwheel00000000000000package TestAppShowInternalActions; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestAppViewWarnings.pm0000644000000000000000000000062212406561462022525 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestAppPathBug.pm0000644000000000000000000000067712406561462021446 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestApp/0000755000000000000000000000000013611202203017603 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/ActionRole/0000755000000000000000000000000013611202203021642 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/ActionRole/Guff.pm0000644000000000000000000000023713201351656023105 0ustar00rootwheel00000000000000package TestApp::ActionRole::Guff; use Moose::Role; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90126/t/lib/TestApp/ActionRole/Boo.pm0000644000000000000000000000044212406561462022737 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/ActionRole/Kooh.pm0000644000000000000000000000032513366373233023123 0ustar00rootwheel00000000000000package TestApp::ActionRole::Kooh; use Moose::Role; use namespace::clean -except => [ 'meta' ]; after execute => sub { my ($self, $controller, $c) = @_; $c->response->header('X-Affe' => 'Tiger'); }; 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Plugin/0000755000000000000000000000000013611202202021040 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Plugin/AddDispatchTypes.pm0000644000000000000000000000124112406561462024612 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Plugin/ParameterizedRole.pm0000644000000000000000000000047113366373233025042 0ustar00rootwheel00000000000000package TestApp::Plugin::ParameterizedRole; use MooseX::Role::Parameterized; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestApp/Plugin/FullyQualified.pm0000644000000000000000000000023512406561462024336 0ustar00rootwheel00000000000000package TestApp::Plugin::FullyQualified; use strict; sub fully_qualified { my $c = shift; $c->stash->{fully_qualified} = 1; return $c; } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/RequestBaseBug.pm0000644000000000000000000000027712406561462023050 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Role.pm0000644000000000000000000000050613366373233021066 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/0000755000000000000000000000000013611202203021726 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Immutable.pm0000644000000000000000000000021112406561462024215 0ustar00rootwheel00000000000000package TestApp::Controller::Immutable; use Moose; BEGIN { extends 'Catalyst::Controller' } no Moose; __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Immutable/0000755000000000000000000000000013611202202023644 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Immutable/HardToReload.pm0000644000000000000000000000144412406561462026536 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Log.pm0000644000000000000000000000045612406561462023032 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Moose/0000755000000000000000000000000013611202202023007 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Moose/NoAttributes.pm0000644000000000000000000000031412406561462026007 0ustar00rootwheel00000000000000package TestApp::Controller::Moose::NoAttributes; use Moose; extends qw/Catalyst::Controller/; __PACKAGE__->config( actions => { test => { Local => undef } } ); sub test { } no Moose; 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Moose/MethodModifiers.pm0000644000000000000000000000036712406561462026456 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Index.pm0000644000000000000000000000025612406561462023356 0ustar00rootwheel00000000000000package TestApp::Controller::Index; use strict; use base 'Catalyst::Controller'; sub index : Private { my ( $self, $c ) = @_; $c->res->body( 'Index index' ); } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/ContextClosure.pm0000644000000000000000000000140012406561462025260 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Attributes.pm0000644000000000000000000000167512406561462024443 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestApp/Controller/Fork.pm0000644000000000000000000000207613366373233023215 0ustar00rootwheel00000000000000# Fork.pm # Copyright (c) 2006 Jonathan Rockway package TestApp::Controller::Fork; use strict; use warnings; use base 'Catalyst::Controller'; use JSON::MaybeXS qw(encode_json); 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(encode_json({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(encode_json({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(encode_json({pid => $pid, result => $x})); } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Moose.pm0000644000000000000000000000151012406561462023363 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action.pm0000644000000000000000000000061312406561462023521 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/BodyParams.pm0000644000000000000000000000065712406561462024355 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Keyword.pm0000644000000000000000000000100512406561462023724 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/0000755000000000000000000000000013611202203023143 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Action/Visit.pm0000644000000000000000000000451212406561462024621 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Global.pm0000644000000000000000000000074512406561462024727 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Index.pm0000644000000000000000000000030412406561462024565 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Begin.pm0000644000000000000000000000043512406561462024547 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/ForwardTo.pm0000644000000000000000000000035012406561462025426 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Auto/0000755000000000000000000000000013611202201024051 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Action/Auto/Abort.pm0000644000000000000000000000070312406561462025500 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Auto/Detach.pm0000644000000000000000000000137212614444671025627 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Auto/Default.pm0000644000000000000000000000057412406561462026023 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Auto/Deep.pm0000644000000000000000000000052712406561462025312 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Local.pm0000644000000000000000000000123412406561462024553 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/TestMultipath.pm0000644000000000000000000000056612406561462026337 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Action.pm0000644000000000000000000000360312406561462024740 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/0000755000000000000000000000000013611202203024476 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm0000644000000000000000000000044012406561462027124 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/PassedArgs.pm0000644000000000000000000000157712406561462027122 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Auto/0000755000000000000000000000000013611202202025405 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Action/Chained/Auto/Detach.pm0000644000000000000000000000057112406561462027157 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Auto/Forward.pm0000644000000000000000000000057512406561462027377 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Auto/Bar.pm0000644000000000000000000000051512406561462026471 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Auto/Foo.pm0000644000000000000000000000051612406561462026511 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/ArgsOrder.pm0000644000000000000000000000163512406561462026751 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/CaptureArgs.pm0000644000000000000000000000361713366373233027306 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/ParentChain/0000755000000000000000000000000013611202203026672 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm0000644000000000000000000000035212406561462031023 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Bar.pm0000644000000000000000000000045012406561462025557 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm0000644000000000000000000000107512406561462027253 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Root.pm0000644000000000000000000000045412665177154026012 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Auto.pm0000644000000000000000000000132612406561462025766 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained/Foo.pm0000644000000000000000000000153612406561462025604 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/End.pm0000644000000000000000000000037412406561462024233 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Detach.pm0000644000000000000000000000172512406561462024716 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Default.pm0000644000000000000000000000031612406561462025105 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/ConfigSmashArrayRefs.pm0000644000000000000000000000060312406561462027540 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Chained.pm0000644000000000000000000002230113366373233025055 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/TestRelative.pm0000644000000000000000000000143712406561462026141 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Forward.pm0000644000000000000000000000403112406561462025123 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Go.pm0000644000000000000000000000375012406561462024073 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/DieInEnd.pm0000644000000000000000000000044212406561462025140 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Streaming.pm0000644000000000000000000000211412406561462025450 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Auto.pm0000644000000000000000000000050712406561462024433 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Inheritance.pm0000644000000000000000000000264212406561462025756 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Private.pm0000644000000000000000000000120412406561462025130 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Action/Path.pm0000644000000000000000000000166712406561462024427 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Dump.pm0000644000000000000000000000224212406561462023211 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Args.pm0000644000000000000000000000042712406561462023203 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/HTTPMethods.pm0000644000000000000000000000427613366373233024423 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Priorities/0000755000000000000000000000000013611202202024056 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Priorities/loc_vs_index.pm0000644000000000000000000000023512406561462027111 0ustar00rootwheel00000000000000package TestApp::Controller::Priorities::loc_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Priorities/MultiMethod.pm0000644000000000000000000000054512406561462026674 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Priorities/path_vs_index.pm0000644000000000000000000000023612406561462027271 0ustar00rootwheel00000000000000package TestApp::Controller::Priorities::path_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Priorities/locre_vs_index.pm0000644000000000000000000000023712406561462027442 0ustar00rootwheel00000000000000package TestApp::Controller::Priorities::locre_vs_index; use strict; use base 'Catalyst::Controller'; sub index :Private { $_[1]->res->body( 'index' ) } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Root.pm0000644000000000000000000000676012406561462023240 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/0000755000000000000000000000000013611202201023131 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Engine/Response/0000755000000000000000000000000013611202203024731 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Engine/Response/Cookies.pm0000644000000000000000000000215312406561462026704 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Redirect.pm0000644000000000000000000000117312406561462027052 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Large.pm0000644000000000000000000000044513366373233026347 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Print.pm0000644000000000000000000000061513366373233026410 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Headers.pm0000644000000000000000000000063412406561462026665 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Errors.pm0000644000000000000000000000057612406561462026573 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Response/Status.pm0000644000000000000000000000145612406561462026600 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Request/0000755000000000000000000000000013611202202024562 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Controller/Engine/Request/URI.pm0000644000000000000000000000514313366373233025606 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Engine/Request/Uploads.pm0000644000000000000000000000073712406561462026557 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/ActionRoles.pm0000644000000000000000000000115413201351656024523 0ustar00rootwheel00000000000000package TestApp::Controller::ActionRoles; use Moose; BEGIN { extends 'Catalyst::Controller' } __PACKAGE__->config( action_roles => ['~Kooh'], action_args => { frew => { boo => 'hello' }, }, ); sub foo : Local Does('Guff') {} sub bar : Local Does('~Guff') {} sub baz : Local Does('+Guff') {} sub quux : Local Does('Zoo') {} sub corge : Local Does('Guff') 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.90126/t/lib/TestApp/Controller/Anon.pm0000644000000000000000000000214212406561462023176 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Controller/Priorities.pm0000644000000000000000000000132412500123716024424 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Action/0000755000000000000000000000000013611202202021017 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Action/TestMyAction.pm0000644000000000000000000000076712406561462023773 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Action/TestMatchCaptures.pm0000644000000000000000000000057713366373233025015 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Action/TestExtraArgsAction.pm0000644000000000000000000000062613366373233025303 0ustar00rootwheel00000000000000package TestApp::Action::TestExtraArgsAction; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestApp/Action/TestBefore.pm0000644000000000000000000000041512406561462023440 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Action/TestActionArgsFromConstructor.pm0000644000000000000000000000064313366373233027370 0ustar00rootwheel00000000000000package TestApp::Action::TestActionArgsFromConstructor; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestApp/Model.pm0000644000000000000000000000053112406561462021220 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Model/0000755000000000000000000000000013611202202020642 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Model/ClosuresInConfig.pm0000644000000000000000000000056013366373233024441 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Model/Generating.pm0000644000000000000000000000056212406561462023307 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/Model/Foo/0000755000000000000000000000000013611202201021364 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/Model/Foo/Bar.pm0000644000000000000000000000016512406561462022452 0ustar00rootwheel00000000000000package TestApp::Model::Foo::Bar; sub model_foo_bar_method_from_foo_bar { "model_foo_bar_method_from_foo_bar" } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/Model/Foo.pm0000644000000000000000000000054312406561462021746 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/0000755000000000000000000000000013611202201020513 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/View/Dump/0000755000000000000000000000000013611202203021422 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/View/Dump/Body.pm0000644000000000000000000000034012406561462022672 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/Dump/Env.pm0000644000000000000000000000105412406561462022530 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/Dump/Action.pm0000644000000000000000000000027312406561462023217 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/Dump/Response.pm0000644000000000000000000000040212406561462023572 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/Dump/Request.pm0000644000000000000000000000034012406561462023425 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/View/Dump.pm0000644000000000000000000000321112406561462021775 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp/DispatchType/0000755000000000000000000000000013611202203022204 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp/DispatchType/CustomPostLoad.pm0000644000000000000000000000024112406561462025477 0ustar00rootwheel00000000000000package TestApp::DispatchType::CustomPostLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90126/t/lib/TestApp/DispatchType/CustomPreLoad.pm0000644000000000000000000000024012406561462025277 0ustar00rootwheel00000000000000package TestApp::DispatchType::CustomPreLoad; use strict; use warnings; use base qw/Catalyst::DispatchType::Path/; # Never match anything.. sub match { } 1; Catalyst-Runtime-5.90126/t/lib/TestAppIndexDefault.pm0000644000000000000000000000022212406561462022452 0ustar00rootwheel00000000000000package TestAppIndexDefault; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/Test/0000755000000000000000000000000013611202201017140 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Test/Apple.pm0000644000000000000000000000020712520162327020552 0ustar00rootwheel00000000000000package Test::Apple; use strict; use warnings; use parent qw/Catalyst::Controller/; sub default :Path { } sub apple :Local { } 1; Catalyst-Runtime-5.90126/t/lib/Catalyst/0000755000000000000000000000000013611202202020006 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/ActionRole/0000755000000000000000000000000013611202202022045 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/ActionRole/Zoo.pm0000644000000000000000000000031313366373233023173 0ustar00rootwheel00000000000000package Catalyst::ActionRole::Zoo; use Moose::Role; use namespace::clean -except => [ 'meta' ]; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90126/t/lib/Catalyst/ActionRole/Guff.pm0000644000000000000000000000031413366373233023314 0ustar00rootwheel00000000000000package Catalyst::ActionRole::Guff; use Moose::Role; use namespace::clean -except => [ 'meta' ]; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90126/t/lib/Catalyst/Plugin/0000755000000000000000000000000013611202201021243 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/Plugin/Test/0000755000000000000000000000000013611202203022164 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/Plugin/Test/MangleDollarUnderScore.pm0000644000000000000000000000062712406561462027102 0ustar00rootwheel00000000000000package 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.90126/t/lib/Catalyst/Plugin/Test/Deprecated.pm0000644000000000000000000000066712406561462024613 0ustar00rootwheel00000000000000package 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.90126/t/lib/Catalyst/Plugin/Test/Plugin.pm0000644000000000000000000000142113366373233024001 0ustar00rootwheel00000000000000package Catalyst::Plugin::Test::Plugin; use Moose; use MRO::Compat; with 'Catalyst::ClassData'; __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(@_); } no Moose; 1; Catalyst-Runtime-5.90126/t/lib/Catalyst/Plugin/Test/Headers.pm0000644000000000000000000000136413366373233024124 0ustar00rootwheel00000000000000package 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.90126/t/lib/Catalyst/Plugin/Test/Errors.pm0000644000000000000000000000113513366373233024021 0ustar00rootwheel00000000000000package 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.90126/t/lib/Catalyst/Script/0000755000000000000000000000000013611202201021251 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/Script/Baz.pm0000644000000000000000000000046513366373233022355 0ustar00rootwheel00000000000000package Catalyst::Script::Baz; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/Catalyst/Script/Bar.pm0000644000000000000000000000022113366373233022333 0ustar00rootwheel00000000000000package Catalyst::Script::Bar; use Moose; use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90126/t/lib/Catalyst/Script/CompileTest.pm0000644000000000000000000000047513366373233024072 0ustar00rootwheel00000000000000package Catalyst::Script::CompileTest; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/Catalyst/Action/0000755000000000000000000000000013611202202021223 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/Catalyst/Action/TestAfter.pm0000644000000000000000000000061612406561462023506 0ustar00rootwheel00000000000000package 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.90126/t/lib/Catalyst/Action/TestBefore.pm0000644000000000000000000000035512406561462023647 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppChainedAbsolutePathPart/0000755000000000000000000000000013611202202024221 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppChainedAbsolutePathPart/Controller/0000755000000000000000000000000013611202202026344 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppChainedAbsolutePathPart/Controller/Foo.pm0000644000000000000000000000026012406561462027444 0ustar00rootwheel00000000000000package TestAppChainedAbsolutePathPart::Controller::Foo; use strict; use warnings; use base qw/Catalyst::Controller/; sub foo : Chained PathPart('/foo/bar') Args(1) { } 1; Catalyst-Runtime-5.90126/t/lib/TestAppViewWarnings/0000755000000000000000000000000013611202201022145 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppViewWarnings/Controller/0000755000000000000000000000000013611202201024270 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppViewWarnings/Controller/Root.pm0000644000000000000000000000055112406561462025574 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppDoubleAutoBug/0000755000000000000000000000000013611202202022224 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppDoubleAutoBug/Controller/0000755000000000000000000000000013611202202024347 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppDoubleAutoBug/Controller/Root.pm0000644000000000000000000000061512406561462025653 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppBadlyImmutable.pm0000644000000000000000000000042612406561462022777 0ustar00rootwheel00000000000000package 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.90126/t/lib/ScriptTestApp/0000755000000000000000000000000013611202203020770 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Script/0000755000000000000000000000000013611202202022233 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Script/Bar.pm0000644000000000000000000000022613366373233023321 0ustar00rootwheel00000000000000package ScriptTestApp::Script::Bar; use Moose; use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Script/CompileTest.pm0000644000000000000000000000020113366373233025036 0ustar00rootwheel00000000000000package ScriptTestApp::Script::CompileTest; use Moose; use namespace::clean -except => [ 'meta' ]; die("Does not compile"); 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Script/Foo.pm0000644000000000000000000000022613366373233023340 0ustar00rootwheel00000000000000package ScriptTestApp::Script::Foo; use Moose; use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; sub run { __PACKAGE__ } 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Controller/0000755000000000000000000000000013611202203023113 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/Controller/Root.pm0000644000000000000000000000030213366373233024412 0ustar00rootwheel00000000000000package ScriptTestApp::Controller::Root; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller' } sub default : Chained('/') PathPart('') Args() {} 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/TraitFor/0000755000000000000000000000000013611202202022521 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/TraitFor/Script/0000755000000000000000000000000013611202202023765 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/TraitFor/Script/Bar.pm0000644000000000000000000000032113366373233025047 0ustar00rootwheel00000000000000package ScriptTestApp::TraitFor::Script::Bar; use Moose::Role; use namespace::clean -except => [ 'meta' ]; around run => sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . '23'; }; 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/TraitFor/Script/Foo.pm0000644000000000000000000000032113366373233025066 0ustar00rootwheel00000000000000package ScriptTestApp::TraitFor::Script::Foo; use Moose::Role; use namespace::clean -except => [ 'meta' ]; around run => sub { my ($orig, $self, @args) = @_; return $self->$orig(@args) . '42'; }; 1; Catalyst-Runtime-5.90126/t/lib/ScriptTestApp/TraitFor/Script.pm0000644000000000000000000000031513366373233024346 0ustar00rootwheel00000000000000package ScriptTestApp::TraitFor::Script; use Moose::Role; use namespace::clean -except => [ 'meta' ]; around run => sub { my ($orig, $self, @args) = @_; return 'moo' . $self->$orig(@args); }; 1; Catalyst-Runtime-5.90126/t/lib/ChainedActionsApp/0000755000000000000000000000000013611202201021536 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ChainedActionsApp/Controller/0000755000000000000000000000000013611202201023661 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ChainedActionsApp/Controller/Root.pm0000644000000000000000000000470013366373233025170 0ustar00rootwheel00000000000000package ChainedActionsApp::Controller::Root; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestAppEncodingSetInConfig.pm0000644000000000000000000000017512406561462023724 0ustar00rootwheel00000000000000package TestAppEncodingSetInConfig; use Moose; use Catalyst qw/ConfigLoader/; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/Guff.pm0000644000000000000000000000026613366373233017477 0ustar00rootwheel00000000000000package Guff; use Moose::Role; use namespace::clean -except => [ 'meta' ]; after execute => sub { my ($self, $controller, $c) = @_; $c->response->body(__PACKAGE__); }; 1; Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInApp.pm0000644000000000000000000000023312406561462023232 0ustar00rootwheel00000000000000package TestAppEncodingSetInApp; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( encoding => 'UTF-8', ); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestAppPluginWithConstructor/0000755000000000000000000000000013611202202024063 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppPluginWithConstructor/Controller/0000755000000000000000000000000013611202202026206 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppPluginWithConstructor/Controller/Root.pm0000644000000000000000000000031612406561462027510 0ustar00rootwheel00000000000000package TestAppPluginWithConstructor::Controller::Root; use base 'Catalyst::Controller'; __PACKAGE__->config->{namespace} = ''; sub foo : Local { my ($self, $c) = @_; $c->res->body('foo'); } 1; Catalyst-Runtime-5.90126/t/lib/TestFromPSGI.pm0000644000000000000000000000026112406561462021026 0ustar00rootwheel00000000000000package TestFromPSGI; use Moose; use Catalyst; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, use_hash_multivalue_in_request => 1, ); __PACKAGE__->setup; Catalyst-Runtime-5.90126/t/lib/TestFromPSGI/0000755000000000000000000000000013611202201020447 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestFromPSGI/Controller/0000755000000000000000000000000013611202201022572 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestFromPSGI/Controller/Root.pm0000644000000000000000000000221512406561462024075 0ustar00rootwheel00000000000000package 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.90126/t/lib/ACLTestApp/0000755000000000000000000000000013611202203020123 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ACLTestApp/Controller/0000755000000000000000000000000013611202203022246 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/ACLTestApp/Controller/Root.pm0000644000000000000000000000045412406561462023552 0ustar00rootwheel00000000000000package 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.90126/t/lib/ACLTestApp.pm0000644000000000000000000000074613366373233020513 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestMiddlewareFromConfig.pm0000644000000000000000000000037312406561462023473 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppMatchSingleArg.pm0000644000000000000000000000022412406561462022730 0ustar00rootwheel00000000000000package TestAppMatchSingleArg; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/0000755000000000000000000000000013611202203023112 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/Custom.pm0000644000000000000000000000016412406561462024743 0ustar00rootwheel00000000000000package TestMiddlewareFromConfig::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/testmiddlewarefromconfig.pl0000644000000000000000000000144112406561462030556 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestMiddlewareFromConfig/Controller/0000755000000000000000000000000013611202201025233 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/Controller/Root.pm0000644000000000000000000000040412406561462026534 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestMiddlewareFromConfig/share/0000755000000000000000000000000013611202203024214 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static/0000755000000000000000000000000013611202202025502 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static/message.txt0000644000000000000000000000001712406561462027706 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static/forced.txt0000644000000000000000000000001712406561462027524 0ustar00rootwheel00000000000000forced message Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static2/0000755000000000000000000000000013611202203025565 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static2/message2.txt0000644000000000000000000000001712406561462030052 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static3/0000755000000000000000000000000013611202202025565 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddlewareFromConfig/share/static3/message3.txt0000644000000000000000000000001712406561462030054 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/TestPath.pm0000644000000000000000000000012312614434663020334 0ustar00rootwheel00000000000000package TestPath; use strict; use warnings; use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestMiddleware/0000755000000000000000000000000013611202203021140 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/Custom.pm0000644000000000000000000000015212406561462022766 0ustar00rootwheel00000000000000package TestMiddleware::Custom; use strict; use warnings; use parent qw/Plack::Middleware::Static/; 1; Catalyst-Runtime-5.90126/t/lib/TestMiddleware/Controller/0000755000000000000000000000000013611202203023263 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/Controller/Root.pm0000644000000000000000000000037212406561462024566 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestMiddleware/share/0000755000000000000000000000000013611202203022242 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static/0000755000000000000000000000000013611202203023531 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static/message.txt0000644000000000000000000000001712406561462025734 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static/forced.txt0000644000000000000000000000001712406561462025552 0ustar00rootwheel00000000000000forced message Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static2/0000755000000000000000000000000013611202203023613 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static2/message2.txt0000644000000000000000000000001712406561462026100 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static3/0000755000000000000000000000000013611202202023613 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestMiddleware/share/static3/message3.txt0000644000000000000000000000001712406561462026102 0ustar00rootwheel00000000000000static message Catalyst-Runtime-5.90126/t/lib/NullPackage.pm0000644000000000000000000000046612406561462020775 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppNonMooseController.pm0000644000000000000000000000014212406561462023700 0ustar00rootwheel00000000000000package TestAppNonMooseController; use base qw/Catalyst/; use Catalyst; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestAppChainedRecursive/0000755000000000000000000000000013611202202022746 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppChainedRecursive/Controller/0000755000000000000000000000000013611202202025071 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppChainedRecursive/Controller/Foo.pm0000644000000000000000000000031612406561462026173 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestDataHandlers/0000755000000000000000000000000013611202202021414 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestDataHandlers/Controller/0000755000000000000000000000000013611202202023537 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestDataHandlers/Controller/Root.pm0000644000000000000000000000050213366373233025041 0ustar00rootwheel00000000000000package TestDataHandlers::Controller::Root; use base 'Catalyst::Controller'; sub root :Path('/') {} 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.90126/t/lib/ScriptTestApp.pm0000644000000000000000000000012012406561462021337 0ustar00rootwheel00000000000000package ScriptTestApp; use Moose; extends 'Catalyst'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestPath/0000755000000000000000000000000013611202201017755 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestPath/Controller/0000755000000000000000000000000013611202202022101 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestPath/Controller/One.pm0000644000000000000000000000036613366373233023211 0ustar00rootwheel00000000000000package TestPath::Controller::One; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller' } sub one :Path { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90126/t/lib/TestPath/Controller/Three.pm0000644000000000000000000000037613366373233023540 0ustar00rootwheel00000000000000package TestPath::Controller::Three; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller' } sub three :Path('') { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90126/t/lib/TestPath/Controller/Four.pm0000644000000000000000000000040413366373233023374 0ustar00rootwheel00000000000000package TestPath::Controller::Four; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller' } sub four :Path('') :Args() { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90126/t/lib/TestPath/Controller/Two.pm0000644000000000000000000000037013366373233023234 0ustar00rootwheel00000000000000package TestPath::Controller::Two; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller' } sub two :Path() { my ( $self, $c ) = @_; $c->response->body( 'OK' ); } __PACKAGE__->meta->make_immutable; Catalyst-Runtime-5.90126/t/lib/TestAppNonMooseController/0000755000000000000000000000000013611202202023324 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppNonMooseController/Controller/0000755000000000000000000000000013611202202025447 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppNonMooseController/Controller/Foo.pm0000644000000000000000000000016112406561462026547 0ustar00rootwheel00000000000000package TestAppNonMooseController::Controller::Foo; use base qw/TestAppNonMooseController::ControllerBase/; 1; Catalyst-Runtime-5.90126/t/lib/TestAppNonMooseController/ControllerBase.pm0000644000000000000000000000013312406561462026616 0ustar00rootwheel00000000000000package TestAppNonMooseController::ControllerBase; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90126/t/lib/TestLogger.pm0000644000000000000000000000052212622377775020673 0ustar00rootwheel00000000000000package 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.90126/t/lib/DeprecatedTestApp/0000755000000000000000000000000013611202202021563 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/DeprecatedTestApp/C/0000755000000000000000000000000013611202202021745 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/DeprecatedTestApp/C/Root.pm0000644000000000000000000000051412406561462023247 0ustar00rootwheel00000000000000package 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.90126/t/lib/DeprecatedActionsInAppClassTestApp.pm0000644000000000000000000000111712406561462025401 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppUnknownError.pm0000644000000000000000000000035712406561462022560 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppClassExceptionSimpleTest.pm0000644000000000000000000000061612406561462025043 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppOnDemand.pm0000644000000000000000000000043613366373233021575 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppOneView/0000755000000000000000000000000013611202203021100 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppOneView/Controller/0000755000000000000000000000000013611202203023223 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppOneView/Controller/Root.pm0000644000000000000000000000113412406561462024523 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppOneView/View/0000755000000000000000000000000013611202202022011 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppOneView/View/Dummy.pm0000644000000000000000000000023412406561462023462 0ustar00rootwheel00000000000000package TestAppOneView::View::Dummy; use base 'Catalyst::View'; sub COMPONENT { bless {}, 'AClass' } package AClass; use base 'Catalyst::View'; 1; Catalyst-Runtime-5.90126/t/lib/PluginTestApp.pm0000644000000000000000000000150712406561462021343 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppIndexDefault/0000755000000000000000000000000013611202201022076 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppIndexDefault/Controller/0000755000000000000000000000000013611202203024223 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppIndexDefault/Controller/IndexChained.pm0000644000000000000000000000043712406561462027130 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppIndexDefault/Controller/IndexPrivate.pm0000644000000000000000000000026312406561462027204 0ustar00rootwheel00000000000000package TestAppIndexDefault::Controller::IndexPrivate; use base 'Catalyst::Controller'; sub index : Private { my ($self, $c) = @_; $c->res->body('index_private'); } 1; Catalyst-Runtime-5.90126/t/lib/TestAppIndexDefault/Controller/Default.pm0000644000000000000000000000045012406561462026164 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppIndexDefault/Controller/Root.pm0000644000000000000000000000046512406561462025531 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp2.pm0000644000000000000000000000046612406561462020251 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp2/0000755000000000000000000000000013611202202017664 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp2/Controller/0000755000000000000000000000000013611202202022007 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestApp2/Controller/Root.pm0000644000000000000000000000044413366373233023316 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppShowInternalActions/0000755000000000000000000000000013611202203023462 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppShowInternalActions/Controller/0000755000000000000000000000000013611202203025605 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppShowInternalActions/Controller/Root.pm0000644000000000000000000000053613366373233027115 0ustar00rootwheel00000000000000package TestAppShowInternalActions::Controller::Root; use Moose; use namespace::clean -except => [ 'meta' ]; 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.90126/t/lib/TestAppOnDemand/0000755000000000000000000000000013611202201021207 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppOnDemand/Controller/0000755000000000000000000000000013611202201023332 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppOnDemand/Controller/Body.pm0000644000000000000000000000136013366373233024612 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppEncodingSetInConfig/0000755000000000000000000000000013611202202023342 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInConfig/testappencodingsetinconfig.json0000644000000000000000000000003412406561462031673 0ustar00rootwheel00000000000000{ "encoding": "UTF-8" } Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInConfig/Controller/0000755000000000000000000000000013611202201025464 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInConfig/Controller/Root.pm0000644000000000000000000000041513366373233026772 0ustar00rootwheel00000000000000package TestAppEncodingSetInConfig::Controller::Root; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller'; } __PACKAGE__->config(namespace => ''); sub default: Local{ my ( $self, $c ) = @_; $c->res->body(''); } 1; Catalyst-Runtime-5.90126/t/lib/TestAppWithMeta/0000755000000000000000000000000013611202203021246 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppWithMeta/Controller/0000755000000000000000000000000013611202203023371 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppWithMeta/Controller/Root.pm0000644000000000000000000000061012406561462024667 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppPluginWithConstructor.pm0000644000000000000000000000072012406561462024441 0ustar00rootwheel00000000000000# 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.90126/t/lib/TestAppWithoutUnicode/0000755000000000000000000000000013611202202022475 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppWithoutUnicode/Controller/0000755000000000000000000000000013611202202024620 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppWithoutUnicode/Controller/Root.pm0000644000000000000000000000061012406561462026117 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppUnicode/0000755000000000000000000000000013611202202021111 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppUnicode/Controller/0000755000000000000000000000000013611202202023234 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppUnicode/Controller/Root.pm0000644000000000000000000000361613366373233024547 0ustar00rootwheel00000000000000package 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. open my $test_file, '<', \"this is a test"; $c->response->body($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.90126/t/lib/TestAppWithoutUnicode.pm0000644000000000000000000000035112406561462023053 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppChainedAbsolutePathPart.pm0000644000000000000000000000051013366373233024577 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppEncoding.pm0000644000000000000000000000023412406561462021627 0ustar00rootwheel00000000000000package TestAppEncoding; use strict; use warnings; use base qw/Catalyst/; use Catalyst; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestAppChainedRecursive.pm0000644000000000000000000000043313366373233023330 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppStats/0000755000000000000000000000000013611202203020622 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppStats/Controller/0000755000000000000000000000000013611202203022745 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppStats/Controller/Root.pm0000644000000000000000000000056312406561462024252 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestApp.pm0000644000000000000000000000665413366373233020177 0ustar00rootwheel00000000000000package 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::clean -except => [ 'meta' ]; # ----------- # 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 Moose; 1; Catalyst-Runtime-5.90126/t/lib/TestAppMetaCompat/0000755000000000000000000000000013611202201021554 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppMetaCompat/Controller/0000755000000000000000000000000013611202203023701 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppMetaCompat/Controller/Books.pm0000644000000000000000000000020612406561462025332 0ustar00rootwheel00000000000000package TestAppMetaCompat::Controller::Books; use strict; use base qw/TestAppMetaCompat::Controller::Base/; sub edit : Local {} 1; Catalyst-Runtime-5.90126/t/lib/TestAppMetaCompat/Controller/Base.pm0000644000000000000000000000014112406561462025125 0ustar00rootwheel00000000000000package TestAppMetaCompat::Controller::Base; use strict; use base qw/Catalyst::Controller/; 1; Catalyst-Runtime-5.90126/t/lib/TestAppDoubleAutoBug.pm0000644000000000000000000000202512406561462022602 0ustar00rootwheel00000000000000use 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.90126/t/lib/TestAppEncodingSetInApp/0000755000000000000000000000000013611202202022655 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInApp/Controller/0000755000000000000000000000000013611202202025000 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncodingSetInApp/Controller/Root.pm0000644000000000000000000000041213366373233026302 0ustar00rootwheel00000000000000package TestAppEncodingSetInApp::Controller::Root; use Moose; use namespace::clean -except => [ 'meta' ]; BEGIN { extends 'Catalyst::Controller'; } __PACKAGE__->config(namespace => ''); sub default: Local{ my ( $self, $c ) = @_; $c->res->body(''); } 1; Catalyst-Runtime-5.90126/t/lib/TestAppUnicode.pm0000644000000000000000000000062412454003036021461 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestContentNegotiation.pm0000644000000000000000000000025112406561462023252 0ustar00rootwheel00000000000000package TestContentNegotiation; use Moose; use Catalyst; extends 'Catalyst'; __PACKAGE__->config( 'Controller::Root', { namespace => '' }, ); __PACKAGE__->setup; Catalyst-Runtime-5.90126/t/lib/TestAppMetaCompat.pm0000644000000000000000000000016612406561462022137 0ustar00rootwheel00000000000000package TestAppMetaCompat; use base qw/Catalyst/; __PACKAGE__->config(name => __PACKAGE__); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestContentNegotiation/0000755000000000000000000000000013611202202022675 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestContentNegotiation/Controller/0000755000000000000000000000000013611202202025020 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestContentNegotiation/Controller/Root.pm0000644000000000000000000000322413366373233026326 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestContentNegotiation/share/0000755000000000000000000000000013611202202023777 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestContentNegotiation/share/file.txt0000644000000000000000000000325013366373233025503 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestPluginWithConstructor.pm0000644000000000000000000000041312406561462023777 0ustar00rootwheel00000000000000# 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.90126/t/lib/TestAppOneView.pm0000644000000000000000000000021512406561462021454 0ustar00rootwheel00000000000000package TestAppOneView; use strict; use warnings; use TestLogger; use Catalyst; __PACKAGE__->log(TestLogger->new); __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/TestAppWithMeta.pm0000644000000000000000000000023112406561462021620 0ustar00rootwheel00000000000000package TestAppWithMeta; use strict; use warnings; use Catalyst; no warnings 'redefine'; sub meta {} use warnings 'redefine'; __PACKAGE__->setup; 1; Catalyst-Runtime-5.90126/t/lib/CDICompatTestPlugin.pm0000644000000000000000000000235313366373233022371 0ustar00rootwheel00000000000000package 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.90126/t/lib/TestAppEncoding/0000755000000000000000000000000013611202201021250 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncoding/Controller/0000755000000000000000000000000013611202201023373 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/lib/TestAppEncoding/Controller/Root.pm0000644000000000000000000000201613366373233024700 0ustar00rootwheel00000000000000package 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.90126/t/deprecated.t0000644000000000000000000000224412406561462017764 0ustar00rootwheel00000000000000use 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.90126/t/set_allowed_method.t0000644000000000000000000000121512520162327021515 0ustar00rootwheel00000000000000use 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.90126/t/abort-chain-3.t0000644000000000000000000000232513366373233020216 0ustar00rootwheel00000000000000use 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('-Log=fatal'); } 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.90126/t/http_exceptions.t0000644000000000000000000000634412435153520021103 0ustar00rootwheel00000000000000use 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.90126/t/catalyst_130pix.gif0000644000000000000000000001310512406561462021114 0ustar00rootwheel00000000000000‰PNG  IHDR‚-í+$‘gAMAÖØÔOX2tEXtSoftwareAdobe ImageReadyqÉe<×IDATxÚì[ \TÕŸ;û¾/ Ã6lÃ"›¢ˆ¤".¹¤¢¹g™•¥¾²,óùzm*ö×ÒʧõÌ2sA@\JAQV‘]Ù—ff€fîl¼of)—§/¤úåùÝß0sî¹ß=çûËÿ;÷‚ôööb}CårÍ… ú†"ÇŠˆ  8æq»ÕG H¯‹«Ü»W+`\\0J%I¯“’–Hk¿¯á5eË——¥¥‰>ýT*âÚÛÍ ÖÅ….?VýàÁÐ’”tóøqÿ³gYùùÆK—N£é%-«Váy¼ÇÚïkØG'ÚŠÁÔíÚ%xã fm­æôi›m1Í(—WÅÇ÷Z­µ?Þ ×hº[Z|&NlÛ¸ÑZSƒ¶´Ø²Po/b±èÚÛ»W¯f>Mƒƒ E1B “{”JSi)²ð1&2YßÓÃ|¬þAJD.iàæMü¸qàŒž¾^Ïéé!šÍV??êcW(eÒ¤æ½{W®4‡†R1.CÃ`´|¾hÕúXûƒ” ÆwåÊæ¢"g±¸•Ï¿!‘ 11“)Y¸0$*ê±êµ|ƒÖœ’R2cã‹/^y…‚ ¤?¼Ròs¯þtö‰HÂáðÏ,YÊåñù-{q3¹'&Ëdª®®Þ?IÛ¹}3ƒáSg6¥²¼lîˆ}Ô0+ÒÓUééÂÕ«¹ Æ umMõÉä㚇&D"ƒŠÐ 8°ØW‘¢­5-%©µµe0R´³Š={L>>Þ &™éç¦MýäØ‘o¾úŠ¶»ûîÊJŠ==}☈çÌ–75  ªË—Ûü‘¿j9¨EÂÊòôs—zzzht0è?P}¢hk;•šÚ¡RQ(”þ0¦d”ËQ¹ÜŠ¢X2™,‘D"“ɤܷuu [´èá­æzÖÅ̪›•`Ë<?84lêŒX*•a´®¦úJvVyi±ª] ÃÍ]3qò°á#~ž†Ñx:õDΕËl6™@  (úí¾½T-$lØÐpÛ(ss®ä^­¯«5 L ®òÔÌ{¢…ãÃ@ ikmÅãm›óOÍœÍáþ¼!ýa`$9vÎ<ø„ÎkygÒRêk!û{HGF…ÃãÏž:yþÇÓL&¾[­Ö£‡‰Ý¥žÑ1kŠFŠº„„Ë‘‘'=<Žz{ <âé™ê㣪®nÏË;ï䔽k×C ìêì|kÕr©›Oà h8È“,&ØǵS£³§RNÀ).L<¾À0 —ú¯ ïÃÂ`€F­‘¹ói8/g®§˜ƒ… <äÛõïþÝ6[]8û)8Ë&Ú.gm—ó©Øq£†U”•ôÍáߟ}£""¦¯«ðfeôlxo(X@ÇÑÌÁo¿v Sµ·z:³I:‚™>i¬ÊR«õ£õï¹ð¨ ná˜d¨Ìfã'„;¬‡ˆI¤`0ÏÍŸ§~“74íÙS¶aƒF"¡ÏšÅ ‰“©‡³b±׶m›žÏyþùˆ +^|ödJ2›ÍË‚ùÑh4Fíf DbqWW—ËózRit𠵺Œqk|\HØP0jAÈ$›8ˆ8ü9½'Ør/ÁÖŒF‹ÌÏWì,Ñj»«nTâp¸ë…ùï¼ýFâñ4ý§³ /NðH0‡­Õj.~ä#Øc0®nd ’Ì?€ÅfÃx 4tûaü¢PÚÿ”¬Kù²eåÉÉìøø __b~~ïÅ‹¶ÄhD@.¯¼r¥íäIa\E«­Û³Ç}õjäÄØÿÕ©Ôd.—á"0(xõÛÿŸS‚8øùnÛ¹{tô8©§7üT*ÚæÇN½y£8zø{€âÏg_î?šxð?{¿ “) &ó£Í;X,¶›‡Ôa^ZñêÜ…‹'MyŠh_ÿîÛ7¾ÿƒÉÊ˹Z^Vv׉I½¼GGǤ$#“HÐÔ.‚›5`q8‘“SÌÄ'aÀ€`qà!¡#’NŸ‡Y•—–@ŠrÙ”°íÜg¶}`[,–¸ømž^èá`0jµ â h¥/½T™™é}ö,óêUÓ×_üý‰aaXX‚ØCjlme ÂìèPët¹ ††¿íÛï/ßl6;|ˆD&Á'±øëƒGœ%.¿Þ ¡RŸ{aY[k (½²¬´£Ce³P,l¼¡®ÖæÝxü°á%ׯAf"ÙÝbôØ6‡Ó'~ÂçÕ쬂¼œ†úºy3‰l èF­®ºy/ Í[¸´ a]ÞÜ”—{eâ“Só®fÃíÀƒ£žš!rÛ—`vðÝÚÚê½_ìœû´à> \­V;‚go¯uÄÈ(p”‡NѨÕZ\^^9eŠxèPùµkþ))¸}ûzärNt´Õl6*•¿Hld²xæLUZš©©É7%¥|ÂFD„dÁ‚ûÈW*” uÑ ×ÇLxòN  6aÓúăߴ+(j5™1½À,[\¾m1à”öÔ ËÕë{úÃpéÂù ï¿SZ|]¯×Q ‡á 8Ž½@î>ÓoùB3[ÌÓÏ3®¢¬fk4¢ÓfÌrŒ™9{Þñ#‰³˜ÅûëÖ|º5Üní??€Øuû úÿ‡°‚ƒ?tˆ±qcCRA&3'&jNž¤ùûëëêÐÆFcKKÿzzª«iAAêC‡è……¢­[Ë×­C;;ï#ß:îéÓÝ1îFp¡ÿý¬Ù¾9A§ÓBÀ‰ŒŠ\þê+ÃGF‚!;ÒÀÿ\BQaþÒgæ_+€»H$.óÍ}î…¥‚ô%’ûíTR¨3gÍAQ‰HOºœ• ¦U„c¦ÍˆMض‹ÁbAÖG„yîÿÏÞÅsc!xÞ‚!ÿgÝÀÄáœ[[qQQägŸmÛ¼™ä⢯¯G››Q;[ýõÑÜlhn&:95¬]ë2f Êå6ûíý`fAc[­X@a^î h;ü=›Ã³]¶âµä³'ÆŸv}±„~YwÿW{ ¬Id0ÏÃ'N}uàðúM }0üÏ6kî>_€ÅaêîßgµE_Øèñlömo[úòŠÓé—Al`p(Håp8…ùyÇH쳤[_0ýoúp0˜-–Æï¾s]±BX] %‚Q¥«·Áp¯£±ÑÜÝmÐht'N—,iÚ¿ßrïgŸPøøù¡d¿[>6Üra‡/×ÖTé `a°€q&9rlA~îôƱB .ÞKŠ‹¬ö殂0âíãëˆÚÅׯ*pù@ÏÆŽ›³ÒiµçÏÄOÝ7@£î›pus_ùú[©?^¸¸šŒFÛØXßß&xÈPý€Í9¦úpL©«±±Û`p÷ó“oÙêkj¬F£Ù{>œ£iRS[·¶åä :õ›K0¹¥/-?ÿãY` ¬Í­?•’ä#ó‡„,quÝñÙ^''gX9Ü –¿åã5Õ7óss€>BE ší/ Ö€@Ðþ+– D¢å¯¾þô¼E`ËEé z~îÕÍÿÚÀ 3¿Úû9tl=HX–•œtÄ¡;†ÀÜFŽz¢ïìî]Ÿ$?:uúLO/oÈÿjµ R:Xž—·c ÄÁÚk… º#á£Ã¿=÷µ7×þ Cwq1M&ÃÚíë>ÄãI÷ï'S©†º:˜¸¹««·¾kgwm½ÞÚÓ‹ë)+ãˆÅOìÛG¾1w´'§N_ó÷nMøÓSÍÏË1¢½~¾`³CÆŽŸrâ›Í̽’}1#ˆ‰PIJd2šº»»!C¥ r pF E8ÔÆ*Uûõ3gË¡á³KÒR“`<°Hõð—ɤŠ•Pƒlüçi[,(ÚK"¡w>ˆVR|84È™1{.éÖòáªôsg¯–Þ¨(µ#ŠÀ)®gxDÄŒYs&¾ž^#"#O¥¦Ah…D˜•ú³7È ׬‰ºv '—«Î³šLÌðpþ¸qwª‰Æ`©¬®¶€¯9î­Ó®ïjG¶w/©3­z=ïÁ mí»‡Ý÷å¿+ÊKzt:lƒè+óg‡¼m׿Éꥌó8,–ÃåMž6=züÄmñ›€ñ X ¾}¶÷ë ﮫ(/’HÈ<¾ú'<9õÓÝÿÙžðxHsqs[ýö;™ç²2/½#uÌÃáÊü¼h4:H"þrÎd2Ù/`HaA‡:9Í™{Ÿñéo³Øµ wAyë Û{Ø€P”XUu»øÐhÐÖÖ? aá#‚CÞYòbò™ŒÅÏ¿8°Â±nÓ¦u¦¤$§ýûÛ=sæDGÃÅ÷ÿç4(¤ãÇ[bbjnÜ8`HLÄ^º„ÍÍ-·÷]}Q&0P2lXÿ—Üd2dÊ”ªÌLݾ}2Ù'6â‡Ç»¸8=ý´iÔ¨nÎmÔ¨„H TVV€]C­|ô|2ù„ÔË«ôúu ªQk€†ˆ8šêQʽÌôó õ€VWwW~nî˜èh™bÐ÷\¾t1pHŒŒ3æJ–­h€Ø•Zc}½Z­†k+ÊÊètz«¼¥¥Y^TXe#œR©Úµ]]ÃGŽ<•šìëç*>ý\]\¯Tݸ!óóøñwæÞ‡X$$êðpÿððÖ¶6eE…®¥Å±˜BK$!~~"þ]Þ9ô—ɸÇç¬__¼~½&;›`CáK&›sr܃ƒßzk`y-_(Ôi»{tÚi3bøþ Ø2·`ª >Y@Ä"PD@àW7“VF §$®®OÅÆBM^\TÊbsŽ9 V^ɆËãzzy»¸¹Á0 ¯ E›ª½Ò“É”H$ *éèPܹyxdf¤Ÿ0)çJöÐðáÎ •Ö©Ñ€ÒƒBà ñttt Dhl79Àp‰àxÀñ":}âæÍÙmqqî±±fµZqNç™3x¡P2}ú@2ŽL¡ 0›M,6›F£ª€þ D"GeÕ×Õ!X,Ïn7PÀ‚Nét†#]Û·ùPHîîRø‚`‹ïÁ§Ù¾é£|e²²’‰>·Ð÷èR¦«»{QA¾«»[g§&+óBSc+ˆZ@Ì&“Õj‘¸¸„† ;–xèÅå+Áù‡Ü;›ªªêzL ÝɩױcƒÅBÝŽ><ü»ï½‘Æþø`UR©T°w¨K®áðxˆ0ÚînÈ`ÎC‚¨vjöî"9Ù6ž»º`0\ÛÔÐà ÖCj<á$vV* :Ãl1ƒZm^uóf‡ªÝÇWÑ¿]©¤P©€ŠR¡;;Û·¶ª!vÁ-ÀŸ £m&Û«T€qC}›»ÇïCsAAñðáP´CFìÅ64â”)QiixÌ_®ýn[ //‹¿?ÙbáBþ4ؘ1&æ/ˆÁï ‡ÅnÚ¤áó0ìõ¶~òdÏ^øK¢€ùÝ‚’cׯ(;»ù‡0Àö‚žyÆù¯úÏÒ¿' [_û¯²O^ÃËÀ7IEND®B`‚Catalyst-Runtime-5.90126/t/optional_stress.json0000644000000000000000000001125713366373233021631 0ustar00rootwheel00000000000000{ "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.90126/t/args-empty-parens-bug.t0000644000000000000000000000124712700516273022014 0ustar00rootwheel00000000000000use 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.90126/t/body_fh.t0000644000000000000000000000530312572364356017304 0ustar00rootwheel00000000000000use 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.90126/t/optional_lighttpd-fastcgi-non-root.t0000644000000000000000000000637213366373233024610 0ustar00rootwheel00000000000000use 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.90126/t/inject_component_util.t0000644000000000000000000000354413366373233022266 0ustar00rootwheel00000000000000use 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.90126/t/state.t0000644000000000000000000000352412622371265017006 0ustar00rootwheel00000000000000use 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.90126/t/dead_load_bad_args.t0000644000000000000000000000362712520162327021402 0ustar00rootwheel00000000000000use 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.90126/t/head_middleware.t0000644000000000000000000000220013366373233020755 0ustar00rootwheel00000000000000use 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.90126/t/http_exceptions_backcompat.t0000644000000000000000000000566112451546667023310 0ustar00rootwheel00000000000000use 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.90126/t/conf/0000755000000000000000000000000013611202202016401 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/t/conf/extra.conf.in0000644000000000000000000000251213366373233021024 0ustar00rootwheel00000000000000 # 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.90126/t/query_constraints.t0000644000000000000000000000721713366373233021470 0ustar00rootwheel00000000000000use 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.90126/t/dead_recursive_chained_attributes.t0000644000000000000000000000203012406561462024562 0ustar00rootwheel00000000000000use 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.90126/t/optional_stress.t0000644000000000000000000000157313366373233021123 0ustar00rootwheel00000000000000use 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 { use JSON::MaybeXS qw(decode_json); my $test_data = do { open my $fh, '<:raw', "$FindBin::Bin/optional_stress.json" or die "$!"; local $/; <$fh>; }; $iters = $ENV{TEST_STRESS} || 10; $tests = decode_json($test_data); 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.90126/t/optional_apache-fastcgi.pl0000644000000000000000000000300213366373233022574 0ustar00rootwheel00000000000000# 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.90126/t/deprecated_appclass_action_warnings.t0000644000000000000000000000073513366373233025125 0ustar00rootwheel00000000000000use 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.90126/t/path_action_empty_brackets.t0000644000000000000000000000170513366373233023255 0ustar00rootwheel00000000000000use 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.90126/t/encoding_set_in_config.t0000644000000000000000000000067612406561462022347 0ustar00rootwheel00000000000000use 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.90126/xt/0000755000000000000000000000000013611202201015643 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/xt/author/0000755000000000000000000000000013611202202017146 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/xt/author/pod.t0000644000000000000000000000012413230220710020113 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; use Test::Pod 1.14; all_pod_files_ok(); Catalyst-Runtime-5.90126/xt/author/spelling.t0000644000000000000000000000560513417640535021201 0ustar00rootwheel00000000000000use 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 Mischa Miyagawa Montes Napiorkowski Naughton Oleg Ragwitz Ramberg Rasnita Reis Riedel Rockway Roditi Rodland Rothenberg Ruthven Sascha Scala Schutz Sedlacek Sheidlower SpiceMan Spiegelmock Styn Szilakszi Tatsuhiko Ulf Upasana Venters 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 naughton ningu nothingmuch numa obra phaylon rafl rainboxx revmischa rrwo sri szbalint uploadtmp vanstyn willert wreis )); set_spell_cmd('aspell list -l en'); all_pod_files_spelling_ok('lib'); done_testing(); Catalyst-Runtime-5.90126/xt/author/podcoverage.t0000644000000000000000000000131513230220710021632 0ustar00rootwheel00000000000000use 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.90126/xt/author/http-server.t0000644000000000000000000000555613366373233021655 0ustar00rootwheel00000000000000use 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 $harness = TAP::Harness->new({ lib => ['lib'], }); my $aggregator = $harness->runtests(@tests); exit $aggregator->has_errors ? 1 : 0; } else { waitpid $pid, 0; return $?; } } Catalyst-Runtime-5.90126/xt/author/notabs.t0000644000000000000000000000015213230220710020620 0ustar00rootwheel00000000000000use strict; use warnings; use File::Spec; use Test::More; use Test::NoTabs; all_perl_files_ok(qw/lib/); Catalyst-Runtime-5.90126/xt/author/unicode_plugin_nested_params.t0000644000000000000000000000435713230220710025256 0ustar00rootwheel00000000000000use strict; use warnings; use Test::More; use utf8; # setup library path use FindBin qw($Bin); use lib "$Bin/../../t/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.90126/README0000644000000000000000000000057313611202205016101 0ustar00rootwheel00000000000000NAME Catalyst::Runtime - The Catalyst Framework Runtime SYNOPSIS See Catalyst. DESCRIPTION This is the primary class for the Catalyst-Runtime distribution, version 5.80. AUTHORS & COPYRIGHT Catalyst Contributors, see Catalyst.pm LICENSE This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. Catalyst-Runtime-5.90126/script/0000755000000000000000000000000013611202201016514 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/script/catalyst.pl0000755000000000000000000001041013366373233020721 0ustar00rootwheel00000000000000#!/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.90126/META.yml0000644000000000000000000000727413611202204016476 0ustar00rootwheel00000000000000--- abstract: 'The Catalyst Framework Runtime' author: - 'Sebastian Riedel ' build_requires: HTTP::Request::Common: '0' HTTP::Status: '0' Test::Fatal: '0' Test::More: '0.88' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Catalyst-Runtime no_index: directory: - t - xt requires: CGI::Simple::Cookie: '1.109' CGI::Struct: '0' Carp: '1.25' Class::C3::Adopt::NEXT: '0.07' 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::Response: '5.813' Hash::MultiValue: '0' JSON::MaybeXS: '1.000000' LWP: '5.837' List::Util: '1.45' MRO::Compat: '0' Module::Pluggable: '4.7' Moose: '1.03' MooseX::Emulate::Class::Accessor::Fast: '0.00903' MooseX::Getopt: '0.48' MooseX::MethodAttributes::Role::AttrContainer::Inheritable: '0.24' MooseX::Role::WithOverloading: '0.09' Path::Class: '0.09' PerlIO::utf8_strict: '0' 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' Socket: '1.96' 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::FindByUID: '0' Try::Tiny: '0.17' URI: '1.65' URI::ws: '0.03' namespace::clean: '0.23' perl: '5.008003' resources: IRC: irc://irc.perl.org/#catalyst MailingList: http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst bugtracker: https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Runtime homepage: http://dev.catalyst.perl.org/ license: http://dev.perl.org/licenses/ repository: git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git version: '5.90126' x_authority: cpan:MSTROUT x_breaks: Catalyst::Action::REST: '<= 0.67' Catalyst::Action::RenderView: '<= 0.07' Catalyst::Authentication::Credential::HTTP: '<= 1.009' Catalyst::Component::ACCEPT_CONTEXT: '<= 0.06' Catalyst::Controller::AllowDisable: '<= 0.03' Catalyst::Devel: '<= 1.19' Catalyst::Model::Akismet: '<= 0.02' Catalyst::Plugin::Authentication: '<= 0.100091' Catalyst::Plugin::ConfigLoader: '<= 0.22' Catalyst::Plugin::DebugCookie: '<= 0.999002' Catalyst::Plugin::ENV: 0 Catalyst::Plugin::HashedCookies: '<= 1.03' Catalyst::Plugin::Session: '<= 0.21' Catalyst::Plugin::Session::State::Cookie: '<= 0.10' Catalyst::Plugin::Session::Store::FastMmap: '<= 0.09' Catalyst::Plugin::Session::Store::File: '<= 0.16' Catalyst::Plugin::SmartURI: '<= 0.032' Catalyst::Plugin::SubRequest: '<= 0.14' Catalyst::Plugin::Unicode::Encoding: '<= 0.2' Catalyst::Plugin::Upload::Image::Magick: '<= 0.03' Catalyst::View::Mason: '<= 0.17' CatalystX::CRUD: '<= 0.42' CatalystX::CRUD::Model::RDBO: '<= 0.20' CatalystX::Imports: '<= 0.03' Reaction: '<= 0.001999' Test::WWW::Mechanize::Catalyst: '<= 0.53' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Catalyst-Runtime-5.90126/lib/0000755000000000000000000000000013611202202015757 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/0000755000000000000000000000000013611202203017544 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Exception.pm0000644000000000000000000000214612406561462022063 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Middleware/0000755000000000000000000000000013611202203021621 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Middleware/Stash.pm0000644000000000000000000000572613366373233023276 0ustar00rootwheel00000000000000use strict; use warnings; package Catalyst::Middleware::Stash; use base 'Plack::Middleware'; use Exporter 'import'; use Carp 'croak'; our @EXPORT_OK = qw(stash get_stash); sub PSGI_KEY () { 'Catalyst.Stash.v2' } sub get_stash { my $env = shift; return $env->{+PSGI_KEY} || croak "You requested a stash, but one does not exist."; } sub stash { my ($host, @args) = @_; return get_stash($host->env) ->(@args); } sub _create_stash { my $self = shift; my $stash = shift || +{}; return sub { if(@_) { my $new_stash = @_ > 1 ? {@_} : $_[0]; croak('stash takes a hash or hashref') unless ref $new_stash; foreach my $key (keys %$new_stash) { $stash->{$key} = $new_stash->{$key}; } } $stash; }; } sub call { my ($self, $env) = @_; $env->{+PSGI_KEY} = $self->_create_stash unless exists($env->{+PSGI_KEY}); return $self->app->($env); } =head1 NAME Catalyst::Middleware::Stash - The Catalyst stash - in middleware =head1 DESCRIPTION We've moved the L stash to middleware. Please don't use this directly since it is likely to move off the Catalyst namespace into a stand alone distribution We store a coderef under the C which can be dereferenced with key values or nothing to access the underlying hashref. Anything placed into the stash will be available in the stash of any 'mounted' Catalyst applications. A mounted Catalyst application may set the stash and 'pass back' information to the parent application. Non Catalyst applications may use this middleware to access and set stash values. Please note I highly recommend having a stronger interface than a stash key between applications. For more information the current test case t/middleware-stash.t is the best documentation. =head1 SUBROUTINES This class defines the following subroutines. =head2 PSGI_KEY Returns the hash key where we store the stash. You should not assume the string value here will never change! Also, its better to use L or L. =head2 get_stash Expect: $psgi_env. Exportable subroutine. Get the stash out of the C<$env>. =head2 stash Expects: An object that does C and arguments Exportable subroutine. Given an object with a method C get or set stash values, either as a method or via hashref modification. This stash is automatically reset for each request (it is not persistent or shared across connected clients. Stash key / value are stored in memory. use Plack::Request; use Catalyst::Middleware::Stash 'stash'; my $app = sub { my $env = shift; my $req = Plack::Request->new($env); my $stashed = $req->stash->{in_the_stash}; # Assume the stash was previously populated. return [200, ['Content-Type' => 'text/plain'], ["I found $stashed in the stash!"]]; }; If the stash does not yet exist, an exception is thrown. =head1 METHODS This class defines the following methods. =head2 call Used by plack to call the middleware =cut 1; Catalyst-Runtime-5.90126/lib/Catalyst/RouteMatching.pod0000644000000000000000000003667513366373233023065 0ustar00rootwheel00000000000000=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.90126/lib/Catalyst/Dispatcher.pm0000644000000000000000000005610513366373233022222 0ustar00rootwheel00000000000000package 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 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.90126/lib/Catalyst/ScriptRole.pm0000644000000000000000000000557713366373233022231 0ustar00rootwheel00000000000000package Catalyst::ScriptRole; use Moose::Role; use Pod::Usage; use MooseX::Getopt; use Catalyst::EngineLoader; use Moose::Util::TypeConstraints; use Catalyst::Utils; use namespace::clean -except => [ 'meta' ]; 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.90126/lib/Catalyst/Log.pm0000644000000000000000000002006213366373233020646 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Response/0000755000000000000000000000000013611202201021340 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Response/Writer.pm0000644000000000000000000000300713366373233023177 0ustar00rootwheel00000000000000package Catalyst::Response::Writer; sub write { shift->{_writer}->write(@_) } sub close { shift->{_writer}->close } sub write_encoded { my ($self, $line) = @_; if((my $enc = $self->{_context}->encoding) && $self->{_requires_encoding}) { # Not going to worry about CHECK arg since Unicode always croaks I think - jnap $line = $enc->encode($line); } $self->write($line); } =head1 NAME Catalyst::Response::Writer - Proxy over the PSGI Writer =head1 SYNOPSIS sub myaction : Path { my ($self, $c) = @_; my $w = $c->response->writer_fh; $w->write("hello world"); $w->close; } =head1 DESCRIPTION This wraps the PSGI writer (see L) for more. We wrap this object so we can provide some additional methods that make sense from inside L =head1 METHODS This class does the following methods =head2 write =head2 close These delegate to the underlying L writer object =head2 write_encoded If the application defines a response encoding (default is UTF8) and the content type is a type that needs to be encoded (text types like HTML or XML and Javascript) we first encode the line you want to write. This is probably the thing you want to always do. If you use the L<\write> method directly you will need to handle your own encoding. =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.90126/lib/Catalyst/Controller.pm0000644000000000000000000007741113366373233022262 0ustar00rootwheel00000000000000package 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 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('Buzz') { ... } # Catalyst::ActionRole:: sub bar : Local Does('~Buzz') { ... } # MyApp::ActionRole::Buzz sub baz : Local Does('+MyApp::ActionRole::Buzz') { ... } =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.90126/lib/Catalyst/UTF8.pod0000644000000000000000000007252013417636712021030 0ustar00rootwheel00000000000000=encoding UTF-8 =head1 Name Catalyst::UTF8 - All About UTF8 and Catalyst Encoding =head1 Description Starting in 5.90080 L will enable UTF8 encoding by default for text like body responses. In addition we've made a ton of fixes around encoding and utf8 scattered throughout the codebase. This document attempts to give an overview of the assumptions and practices that L uses when dealing with UTF8 and encoding issues. You should also review the Changes file, L and L for more. We attempt to describe all relevant processes, try to give some advice and explain where we may have been exceptional to respect our commitment to backwards compatibility. =head1 UTF8 in Controller Actions Using UTF8 characters in your Controller classes and actions. =head2 Summary In this section we will review changes to how UTF8 characters can be used in controller actions, how it looks in the debugging screens (and your logs) as well as how you construct L objects to actions with UTF8 paths (or using UTF8 args or captures). =head2 Unicode in Controllers and URLs package MyApp::Controller::Root; use utf8; use base 'Catalyst::Controller'; sub heart_with_arg :Path('♥') Args(1) { my ($self, $c, $arg) = @_; } sub base :Chained('/') CaptureArgs(0) { my ($self, $c) = @_; } sub capture :Chained('base') PathPart('♥') CaptureArgs(1) { my ($self, $c, $capture) = @_; } sub arg :Chained('capture') PathPart('♥') Args(1) { my ($self, $c, $arg) = @_; } =head2 Discussion In the example controller above we have constructed two matchable URL routes: http://localhost/root/♥/{arg} http://localhost/base/♥/{capture}/♥/{arg} The first one is a classic Path type action and the second uses Chaining, and spans three actions in total. As you can see, you can use unicode characters in your Path and PathPart attributes (remember to use the C pragma to allow these multibyte characters in your source). The two constructed matchable routes would match the following incoming URLs: (heart_with_arg) -> http://localhost/root/%E2%99%A5/{arg} (base/capture/arg) -> http://localhost/base/%E2%99%A5/{capture}/%E2%99%A5/{arg} That path path C<%E2%99%A5> is url encoded unicode (assuming you are hitting this with a reasonably modern browser). Its basically what goes over HTTP when your type a browser location that has the unicode 'heart' in it. However we will use the unicode symbol in your debugging messages: [debug] Loaded Path actions: .-------------------------------------+--------------------------------------. | Path | Private | +-------------------------------------+--------------------------------------+ | /root/♥/* | /root/heart_with_arg | '-------------------------------------+--------------------------------------' [debug] Loaded Chained actions: .-------------------------------------+--------------------------------------. | Path Spec | Private | +-------------------------------------+--------------------------------------+ | /base/♥/*/♥/* | /root/base (0) | | | -> /root/capture (1) | | | => /root/arg | '-------------------------------------+--------------------------------------' And if the requested URL uses unicode characters in your captures or args (such as C) you should see the arguments and captures as their unicode characters as well: [debug] Arguments are "♥" [debug] "GET" request for "base/♥/♥/♥/♥" from "127.0.0.1" .------------------------------------------------------------+-----------. | Action | Time | +------------------------------------------------------------+-----------+ | /root/base | 0.000080s | | /root/capture | 0.000075s | | /root/arg | 0.000755s | '------------------------------------------------------------+-----------' Again, remember that we are display the unicode character and using it to match actions containing such multibyte characters BUT over HTTP you are getting these as URL encoded bytes. For example if you looked at the L C<$env> value for C you would see (for the above request) REQUEST_URI => "/base/%E2%99%A5/%E2%99%A5/%E2%99%A5/%E2%99%A5" So on the incoming request we decode so that we can match and display unicode characters (after decoding the URL encoding). This makes it straightforward to use these types of multibyte characters in your actions and see them incoming in captures and arguments. Please keep this in might if you are doing for example regular expression matching, length determination or other string comparisons, you will need to try these incoming variables as though UTF8 strings. For example in the following action: sub arg :Chained('capture') PathPart('♥') Args(1) { my ($self, $c, $arg) = @_; } when $arg is "♥" you should expect C to be C<1> since it is indeed one character although it will take more than one byte to store. =head2 UTF8 in constructing URLs via $c->uri_for For the reverse (constructing meaningful URLs to actions that contain multibyte characters in their paths or path parts, or when you want to include such characters in your captures or arguments) L will do the right thing (again just remember to use the C pragma). use utf8; my $url = $c->uri_for( $c->controller('Root')->action_for('arg'), ['♥','♥']); When you stringify this object (for use in a template, for example) it will automatically do the right thing regarding utf8 encoding and url encoding. http://localhost/base/%E2%99%A5/%E2%99%A5/%E2%99%A5/%E2%99%A5 Since again what you want is a properly url encoded version of this. In this case your string length will reflect URL encoded bytes, not the character length. Ultimately what you want to send over the wire via HTTP needs to be bytes. =head1 UTF8 in GET Query and Form POST What Catalyst does with UTF8 in your GET and classic HTML Form POST =head2 UTF8 in URL query and keywords The same rules that we find in URL paths also cover URL query parts. That is if one types a URL like this into the browser http://localhost/example?♥=♥♥ When this goes 'over the wire' to your application server its going to be as percent encoded bytes: http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5 When L encounters this we decode the percent encoding and the utf8 so that we can properly display this information (such as in the debugging logs or in a response.) [debug] Query Parameters are: .-------------------------------------+--------------------------------------. | Parameter | Value | +-------------------------------------+--------------------------------------+ | ♥ | ♥♥ | '-------------------------------------+--------------------------------------' All the values and keys that are part of $c->req->query_parameters will be utf8 decoded. So you should not need to do anything special to take those values/keys and send them to the body response (since as we will see later L will do all the necessary encoding for you). Again, remember that values of your parameters are now decode into Unicode strings. so for example you'd expect the result of length to reflect the character length not the byte length. Just like with arguments and captures, you can use utf8 literals (or utf8 strings) in $c->uri_for: use utf8; my $url = $c->uri_for( $c->controller('Root')->action_for('example'), {'♥' => '♥♥'}); When you stringify this object (for use in a template, for example) it will automatically do the right thing regarding utf8 encoding and url encoding. http://localhost/example?%E2%99%A5=%E2%99%A5%E2%99%A5 Since again what you want is a properly url encoded version of this. Ultimately what you want to send over the wire via HTTP needs to be bytes (not unicode characters). Remember if you use any utf8 literals in your source code, you should use the C pragma. B Assuming UTF-8 in your query parameters and keywords may be an issue if you have legacy code where you created URL in templates manually and used an encoding other than UTF-8. In these cases you may find versions of Catalyst after 5.90080+ will incorrectly decode. For backwards compatibility we offer three configurations settings, here described in order of precedence: C If true, then do not try to character decode any wide characters in your request URL query or keywords. You will need to handle this manually in your action code (although if you choose this setting, chances are you already do this). C This setting allows one to specify a fixed value for how to decode your query, instead of using the default, UTF-8. C If this is true we decode using whatever you set C to. =head2 UTF8 in Form POST In general most modern browsers will follow the specification, which says that POSTed form fields should be encoded in the same way that the document was served with. That means that if you are using modern Catalyst and serving UTF8 encoded responses, a browser is supposed to notice that and encode the form POSTs accordingly. As a result since L now serves UTF8 encoded responses by default, this means that you can mostly rely on incoming form POSTs to be so encoded. L will make this assumption and decode accordingly (unless you explicitly turn off encoding...) If you are running Catalyst in developer debug, then you will see the correct unicode characters in the debug output. For example if you generate a POST request: use Catalyst::Test 'MyApp'; use utf8; my $res = request POST "/example/posted", ['♥'=>'♥', '♥♥'=>'♥']; Running in CATALYST_DEBUG=1 mode you should see output like this: [debug] Body Parameters are: .-------------------------------------+--------------------------------------. | Parameter | Value | +-------------------------------------+--------------------------------------+ | ♥ | ♥ | | ♥♥ | ♥ | '-------------------------------------+--------------------------------------' And if you had a controller like this: package MyApp::Controller::Example; use base 'Catalyst::Controller'; sub posted :POST Local { my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->res->body("hearts => ${\$c->req->post_parameters->{♥}}"); } The following test case would be true: use Encode 2.21 'decode_utf8'; is decode_utf8($req->content), 'hearts => ♥'; In this case we decode so that we can print and compare strings with multibyte characters. B In some cases some browsers may not follow the specification and set the form POST encoding based on the server response. Catalyst itself doesn't attempt any workarounds, but one common approach is to use a hidden form field with a UTF8 value (You might be familiar with this from how Ruby on Rails has HTML form helpers that do that automatically). In that case some browsers will send UTF8 encoded if it notices the hidden input field contains such a character. Also, you can add an HTML attribute to your form tag which many modern browsers will respect to set the encoding (accept-charset="utf-8"). And lastly there are some javascript based tricks and workarounds for even more odd cases (just search the web for this will return a number of approaches. Hopefully as more compliant browsers become popular these edge cases will fade. B It is possible for a form POST multipart response (normally a file upload) to contain inline content with mixed content character sets and encoding. For example one might create a POST like this: use utf8; use HTTP::Request::Common; my $utf8 = 'test ♥'; my $shiftjs = 'test テスト'; my $req = POST '/root/echo_arg', Content_Type => 'form-data', Content => [ arg0 => 'helloworld', Encode::encode('UTF-8','♥') => Encode::encode('UTF-8','♥♥'), 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)], ]; In this case we've created a POST request but each part specifies its own content character set (and setting a content encoding would also be possible). Generally one would not run into this situation in a web browser context but for completeness sake Catalyst will notice if a multipart POST contains parts with complex or extended header information. In these cases we will try to inspect the meta data and do the right thing (in the above case we'd use SHIFT_JIS to decode, not UTF-8). However if after inspecting the headers we cannot figure out how to decode the data, in those cases it will not attempt to apply decoding to the form values. Instead the part will be represented as an instance of an object L which will contain all the header information needed for you to perform custom parser of the data. Ideally we'd fix L to be smarter about decoding so please submit your cases of this so we can add intelligence to the parser and find a way to extract a valid value out of it. =head1 UTF8 Encoding in Body Response When does L encode your response body and what rules does it use to determine when that is needed. =head2 Summary use utf8; use warnings; use strict; package MyApp::Controller::Root; use base 'Catalyst::Controller'; use File::Spec; sub scalar_body :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("

This is scalar_body action ♥

"); } 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; } 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); } =head2 Discussion Beginning with L version 5.90080 You no longer need to set the encoding configuration (although doing so won't hurt anything). Currently we only encode if the content type is one of the types which generally expects a UTF8 encoding. This is determined by the following regular expression: our $DEFAULT_ENCODE_CONTENT_TYPE_MATCH = qr{text|xml$|javascript$}; $c->response->content_type =~ /$DEFAULT_ENCODE_CONTENT_TYPE_MATCH/ This is a global variable in L which is stored in the C attribute of $c->response. You may currently alter this directly on the response or globally. In the future we may offer a configuration setting for this. This would match content-types like the following (examples) text/plain text/html text/xml application/javascript application/xml application/vnd.user+xml You should set your content type prior to header finalization if you want L to encode. B We do not attempt to encode C since the two most commonly used approaches (L and L) have already configured their JSON encoders to produce properly encoding UTF8 responses. If you are rolling your own JSON encoding, you may need to set the encoder to do the right thing (or override the global regular expression to include the JSON media type). =head2 Encoding with Scalar Body L supports several methods of supplying your response with body content. The first and currently most common is to set the L ->body with a scalar string ( as in the example): use utf8; sub scalar_body :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->body("

This is scalar_body action ♥

"); } In general you should need to do nothing else since L will automatically encode this string during body finalization. The only matter to watch out for is to make sure the string has not already been encoded, as this will result in double encoding errors. B pay attention to the content-type setting in the example. L inspects that content type carefully to determine if the body needs encoding). B If you set the character set of the response L will skip encoding IF the character set is set to something that doesn't match $c->encoding->mime_name. We will assume if you are setting an alternative character set, that means you want to handle the encoding yourself. However it might be easier to set $c->encoding for a given response cycle since you can override this for a given response. For example here's how to override the default encoding and set the correct character set in the response: sub override_encoding :Local { my ($self, $c) = @_; $c->res->content_type('text/plain'); $c->encoding(Encode::find_encoding('Shift_JIS')); $c->response->body("テスト"); } This will use the alternative encoding for a single response. B If you manually set the content-type character set to whatever $c->encoding->mime_name is set to, we STILL encode, rather than assume your manual setting is a flag to override. This is done to support backward compatible assumptions (in particular L has set a utf-8 character set in its default content-type for ages, even though it does not itself do any encoding on the body response). If you are going to handle encoding manually you may set $c->clear_encoding for a single request response cycle, or as in the above example set an alternative encoding. =head2 Encoding with streaming type responses L offers two approaches to streaming your body response. Again, you must remember to set your content type prior to streaming, since invoking a streaming response will automatically finalize and send your HTTP headers (and your content type MUST be one that matches the regular expression given above.) Also, if you are going to override $c->encoding (or invoke $c->clear_encoding), you should do that before anything else! The first streaming method is to use the C method on the response object. This method allows 'inlined' streaming and is generally used with blocking style servers. sub stream_write :Local { my ($self, $c) = @_; $c->response->content_type('text/html'); $c->response->write("

This is stream_write action ♥

"); } You may call the C method as often as you need to finish streaming all your content. L will encode each line in turn as long as the content-type meets the 'encodable types' requirement and $c->encoding is set (which it is, as long as you did not change it). B If you try to change the encoding after you start the stream, this will invoke an error response. However since you've already started streaming this will not show up as an HTTP error status code, but rather error information in your body response and an error in your logs. B If you use ->body AFTER using ->write (for example you may do this to write your HTML HEAD information as fast as possible) we expect the contents to body to be encoded as it normally would be if you never called ->write. In general unless you are doing weird custom stuff with encoding this is likely to just already do the correct thing. The second way to stream a response is to get the response writer object and invoke methods on that directly: 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; } This can be used just like the C method, but typically you request this object when you want to do a nonblocking style response since the writer object can be closed over or sent to a model that will invoke it in a non blocking manner. For more on using the writer object for non blocking responses you should review the C documentation and also you can look at several articles from last years advent, in particular: L, L, L, L, L. The main difference this year is that previously calling ->write_fh would return the actual L writer object that was supplied by your Plack application handler, whereas now we wrap that object in a lightweight decorator object that proxies the C and C methods and supplies an additional C method. C does the exact same thing as C except that it will first encode the string when necessary. In general if you are streaming encodable content such as HTML this is the method to use. If you are streaming binary content, you should just use the C method (although if the content type is set correctly we would skip encoding anyway, but you may as well avoid the extra noop overhead). The last style of content response that L supports is setting the body to a filehandle like object. In this case the object is passed down to the Plack application handler directly and currently we do nothing to set encoding. 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); } In this example we create a filehandle to a text file that contains UTF8 encoded characters. We pass this down without modification, which I think is correct since we don't want to double encode. However this may change in a future development release so please be sure to double check the current docs and changelog. Its possible a future release will require you to to set a encoding on the IO layer level so that we can be sure to properly encode at body finalization. So this is still an edge case we are writing test examples for. But for now if you are returning a filehandle like response, you are expected to make sure you are following the L specification and return raw bytes. =head2 Override the Encoding on Context As already noted you may change the current encoding (or remove it) by setting an alternative encoding on the context; $c->encoding(Encode::find_encoding('Shift_JIS')); Please note that you can continue to change encoding UNTIL the headers have been finalized. The last setting always wins. Trying to change encoding after header finalization is an error. =head2 Setting the Content Encoding HTTP Header In some cases you may set a content encoding on your response. For example if you are encoding your response with gzip. In this case you are again on your own. If we notice that the content encoding header is set when we hit finalization, we skip automatic encoding: use Encode; use Compress::Zlib; use utf8; sub gzipped :Local { 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 ♥"))); } If you are using L you need to upgrade to the most recent version in order to be compatible with changes introduced in L 5.90080. Other plugins may require updates (please open bugs if you find them). B Content encoding may be set to 'identify' and we will still perform automatic encoding if the content type is encodable and an encoding is present for the context. =head2 Using Common Views The following common views have been updated so that their tests pass with default UTF8 encoding for L: L, L, L, L See L for additional information on L extensions that require upgrades. In generally for the common views you should not need to do anything special. If your actual template files contain UTF8 literals you should set configuration on your View to enable that. For example in TT, if your template has actual UTF8 character in it you should do the following: MyApp::View::TT->config(ENCODING => 'utf-8'); However L wants to do the UTF8 encoding for you (We assume that the authors of that view did this as a workaround to the fact that until now encoding was not core to L. So if you use that view, you either need to tell it to not encode, or you need to turn off encoding for Catalyst. MyApp::View::Xslate->config(encode_body => 0); or MyApp->config(encoding=>undef); Preference is to disable it in the View. Other views may be similar. You should review View documentation and test during upgrading. We tried to make sure most common views worked properly and noted all workaround but if we missed something please alert the development team (instead of introducing a local hack into your application that will mean nobody will ever upgrade it...). =head2 Setting the response from an external PSGI application. L allows one to set the response from an external L application. If you do this, and that external application sets a character set on the content-type, we C for the rest of the response. This is done to prevent double encoding. B Even if the character set of the content type is the same as the encoding set in $c->encoding, we still skip encoding. This is a regrettable difference from the general rule outlined above, where if the current character set is the same as the current encoding, we encode anyway. Nevertheless I think this is the correct behavior since the earlier rule exists only to support backward compatibility with L. In general if you want L to handle encoding, you should avoid setting the content type character set since Catalyst will do so automatically based on the requested response encoding. Its best to request alternative encodings by setting $c->encoding and if you really want manual control of encoding you should always $c->clear_encoding so that programmers that come after you are very clear as to your intentions. =head2 Disabling default UTF8 encoding You may encounter issues with your legacy code running under default UTF8 body encoding. If so you can disable this with the following configurations setting: MyApp->config(encoding=>undef); Where C is your L subclass. If you do not wish to disable all the Catalyst encoding features, you may disable specific features via two additional configuration options: 'skip_body_param_unicode_decoding' and 'skip_complex_post_part_handling'. The first will skip any attempt to decode POST parameters in the creating of body parameters and the second will skip creation of instances of L in the case that the multipart form upload contains parts with a mix of content character sets. If you believe you have discovered a bug in UTF8 body encoding, I strongly encourage you to report it (and not try to hack a workaround in your local code). We also recommend that you regard such a workaround as a temporary solution. It is ideal if L extension authors can start to count on L doing the right thing for encoding. =head1 Conclusion This document has attempted to be a complete review of how UTF8 and encoding works in the current version of L and also to document known issues, gotchas and backward compatible hacks. Please report issues to the development team. =head1 Author John Napiorkowski L =cut Catalyst-Runtime-5.90126/lib/Catalyst/ActionRole/0000755000000000000000000000000013611202202021602 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/ActionRole/QueryMatching.pm0000644000000000000000000000671013366373233024750 0ustar00rootwheel00000000000000package Catalyst::ActionRole::QueryMatching; use Moose::Role; use Moose::Util::TypeConstraints (); requires 'match', 'match_captures', 'list_extra_info'; sub _query_attr { @{shift->attributes->{Query}||[]} } has is_slurpy => ( is=>'ro', init_arg=>undef, isa=>'Bool', required=>1, lazy=>1, builder=>'_build_is_slurpy'); sub _build_is_slurpy { my $self = shift; my($query, @extra) = $self->_query_attr; return $query =~m/^.+,\.\.\.$/ ? 1:0; } has query_constraints => ( is=>'ro', init_arg=>undef, isa=>'ArrayRef|Ref', required=>1, lazy=>1, builder=>'_build_query_constraints'); sub _build_query_constraints { my $self = shift; my ($constraint_proto, @extra) = $self->_query_attr; die "Action ${\$self->private_path} defines more than one 'Query' attribute" if scalar @extra; return +{} unless defined($constraint_proto); $constraint_proto =~s/^(.+),\.\.\.$/$1/; # slurpy is handled elsewhere # Query may be a Hash like Query(p=>Int,q=>Str) OR it may be a Ref like # Query(Tuple[p=>Int, slurpy HashRef]). The only way to figure is to eval it # and look at what we have. my @signature = eval "package ${\$self->class}; $constraint_proto" or die "'$constraint_proto' is not valid Query Contraint at action ${\$self->private_path}, error '$@'"; if(scalar(@signature) > 1) { # Do a dance to support old school stringy types # At this point we 'should' have a hash... my %pairs = @signature; foreach my $key(keys %pairs) { next if ref $pairs{$key}; $pairs{$key} = Moose::Util::TypeConstraints::find_or_parse_type_constraint($pairs{$key}) || die "'$pairs{$key}' is not a valid type constraint in Action ${\$self->private_path}"; } return \%pairs; } else { # We have a 'reference type' constraint, like Dict[p=>Int,...] return $signature[0] if ref($signature[0]); # Is like Tiny::Type return Moose::Util::TypeConstraints::find_or_parse_type_constraint($signature[0]) || die "'$signature[0]' is not a valid type constraint in Action ${\$self->private_path}"; } } around ['match','match_captures'] => sub { my ($orig, $self, $c, @args) = @_; my $tc = $self->query_constraints; if(ref $tc eq 'HASH') { # Do the key names match, unless slurpy? unless($self->is_slurpy) { return 0 unless $self->_compare_arrays([sort keys %$tc],[sort keys %{$c->req->query_parameters}]); } for my $key(keys %$tc) { $tc->{$key}->check($c->req->query_parameters->{$key}) || return 0; } } else { $tc->check($c->req->query_parameters) || return 0; } return $self->$orig($c, @args); }; around 'list_extra_info' => sub { my ($orig, $self, @args) = @_; return { %{ $self->$orig(@args) }, }; }; sub _compare_arrays { my ($self, $first, $second) = @_; no warnings; # silence spurious -w undef complaints return 0 unless @$first == @$second; for (my $i = 0; $i < @$first; $i++) { return 0 if $first->[$i] ne $second->[$i]; } return 1; } 1; =head1 NAME Catalyst::ActionRole::QueryMatching - Match on GET parameters using type constraints =head1 SYNOPSIS TBD =head1 DESCRIPTION TBD =head1 METHODS This role defines the following methods =head2 TBD TBD =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.90126/lib/Catalyst/ActionRole/ConsumesContent.pm0000644000000000000000000001004113366373233025307 0ustar00rootwheel00000000000000package Catalyst::ActionRole::ConsumesContent; use Moose::Role; requires 'match', 'match_captures', 'list_extra_info'; has allowed_content_types => ( is=>'ro', required=>1, lazy=>1, isa=>'ArrayRef', builder=>'_build_allowed_content_types'); has normalized => ( is=>'ro', required=>1, lazy=>1, isa=>'HashRef', builder=>'_build_normalized'); sub _build_normalized { return +{ 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'], }; } sub _build_allowed_content_types { my $self = shift; my @proto = map {split ',', $_ } @{$self->attributes->{Consumes}}; my @converted = map { if(my $normalized = $self->normalized->{$_}) { ref $normalized ? @$normalized : ($normalized); } else { $_; } } @proto; return \@converted; } around ['match','match_captures'] => sub { my ($orig, $self, $ctx, @args) = @_; if(my $content_type = $ctx->req->content_type) { return 0 unless $self->can_consume($content_type); } return $self->$orig($ctx, @args); }; sub can_consume { my ($self, $request_content_type) = @_; my @matches = grep { lc($_) eq lc($request_content_type) } @{$self->allowed_content_types}; return @matches ? 1:0; } around 'list_extra_info' => sub { my ($orig, $self, @args) = @_; return { %{ $self->$orig(@args) }, CONSUMES => $self->allowed_content_types, }; }; 1; =head1 NAME Catalyst::ActionRole::ConsumesContent - Match on HTTP Request Content-Type =head1 SYNOPSIS package MyApp::Web::Controller::MyController; use base 'Catalyst::Controller'; sub start : POST Chained('/') CaptureArg(0) { ... } 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') { ... } ## Alternatively, for common types... sub is_json : Chained('start') Consume(JSON) { ... } sub is_urlencoded : Chained('start') Consumes(UrlEncoded) { ... } sub is_multipart : Chained('start') Consumes(Multipart) { ... } ## Or allow more than one type sub is_more_than_one : Chained('start') : Consumes('application/x-www-form-urlencoded') : Consumes('multipart/form-data') { ## ... } 1; =head1 DESCRIPTION This is an action role that lets your L match on the content type of the incoming request. Generally when there's a PUT or POST request, there's a request content body with a matching MIME content type. Commonly this will be one of the types used with classic HTML forms ('application/x-www-form-urlencoded' for example) but there's nothing stopping you specifying any valid content type. For matching purposes, we match strings but the casing is insensitive. =head1 REQUIRES This role requires the following methods in the consuming class. =head2 match =head2 match_captures Returns 1 if the action matches the existing request and zero if not. =head1 METHODS This role defines the following methods =head2 match =head2 match_captures Around method modifier that return 1 if the request content type matches one of the allowed content types (see L) and zero otherwise. =head2 allowed_content_types An array of strings that are the allowed content types for matching this action. =head2 can_consume Boolean. Does the current request match content type with what this actionrole can consume? =head2 list_extra_info Add the accepted content type to the debug screen. =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.90126/lib/Catalyst/ActionRole/HTTPMethods.pm0000644000000000000000000000666413366373233024303 0ustar00rootwheel00000000000000package Catalyst::ActionRole::HTTPMethods; use Moose::Role; requires 'match', 'match_captures', 'list_extra_info'; sub allowed_http_methods { @{shift->attributes->{Method}||[]} } sub _has_expected_http_method { my ($self, $expected) = @_; return 1 unless scalar(my @allowed = $self->allowed_http_methods); return scalar(grep { lc($_) eq lc($expected) } @allowed) ? 1 : 0; } around ['match','match_captures'] => sub { my ($orig, $self, $ctx, @args) = @_; return 0 unless $self->$orig($ctx, @args); my $expected = $ctx->req->method; return $self->_has_expected_http_method($expected); }; around 'list_extra_info' => sub { my ($orig, $self, @args) = @_; return { %{ $self->$orig(@args) }, HTTP_METHODS => [sort $self->allowed_http_methods], }; }; 1; =head1 NAME Catalyst::ActionRole::HTTPMethods - Match on HTTP Methods =head1 SYNOPSIS package MyApp::Web::Controller::MyController; use Moose; use MooseX::MethodAttributes; extends 'Catalyst::Controller'; sub user_base : Chained('/') CaptureArg(0) { ... } sub get_user : Chained('user_base') Args(1) GET { ... } sub post_user : Chained('user_base') Args(1) POST { ... } sub put_user : Chained('user_base') Args(1) PUT { ... } sub delete_user : Chained('user_base') Args(1) DELETE { ... } sub head_user : Chained('user_base') Args(1) HEAD { ... } sub options_user : Chained('user_base') Args(1) OPTIONS { ... } sub patch_user : Chained('user_base') Args(1) PATCH { ... } sub post_and_put : Chained('user_base') POST PUT Args(1) { ... } sub method_attr : Chained('user_base') Method('DELETE') Args(0) { ... } __PACKAGE__->meta->make_immutable; =head1 DESCRIPTION This is an action role that lets your L match on standard HTTP methods, such as GET, POST, etc. Since most web browsers have limited support for rich HTTP Method vocabularies we use L which allows you to 'tunnel' your request method over POST This works in two ways. You can set an extension HTTP header C which will contain the value of the desired request method, or you may set a search query parameter C. Remember, these only work over HTTP Request type POST. See L for more. =head1 REQUIRES This role requires the following methods in the consuming class. =head2 match =head2 match_captures Returns 1 if the action matches the existing request and zero if not. =head1 METHODS This role defines the following methods =head2 match =head2 match_captures Around method modifier that return 1 if the request method matches one of the allowed methods (see L) and zero otherwise. =head2 allowed_http_methods An array of strings that are the allowed http methods for matching this action normalized as noted above (using X-Method* overrides). =head2 list_extra_info Adds a key => [@values] "HTTP_METHODS" whose value is an ArrayRef of sorted allowed methods to the ->list_extra_info HashRef. This is used primarily for debugging output. =head2 _has_expected_http_method ($expected) Private method which returns 1 if C<$expected> matches one of the allowed in L and zero otherwise. =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.90126/lib/Catalyst/ActionRole/Scheme.pm0000644000000000000000000000426712454003036023365 0ustar00rootwheel00000000000000package Catalyst::ActionRole::Scheme; use Moose::Role; requires 'match', 'match_captures', 'list_extra_info'; around ['match','match_captures'] => sub { my ($orig, $self, $ctx, @args) = @_; my $request_scheme = lc($ctx->req->env->{'psgi.url_scheme'}); my $match_scheme = lc($self->scheme||''); return $request_scheme eq $match_scheme ? $self->$orig($ctx, @args) : 0; }; around 'list_extra_info' => sub { my ($orig, $self, @args) = @_; return { %{ $self->$orig(@args) }, Scheme => $self->attributes->{Scheme}[0]||'', }; }; 1; =head1 NAME Catalyst::ActionRole::Scheme - Match on HTTP Request Scheme =head1 SYNOPSIS package MyApp::Web::Controller::MyController; 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"); } 1; =head1 DESCRIPTION This is an action role that lets your L match on the scheme type of the request. Typically this is C or C but other common schemes that L can handle include C and C (web socket and web socket secure). This also ensures that if you use C on an action that specifies a match scheme, that the generated L object sets its scheme to that automatically (rather than the scheme of the current request object, which is and remains the default behavior.) For matching purposes, we match strings but the casing is insensitive. =head1 REQUIRES This role requires the following methods in the consuming class. =head2 match =head2 match_captures Returns 1 if the action matches the existing request and zero if not. =head1 METHODS This role defines the following methods =head2 match =head2 match_captures Around method modifier that return 1 if the scheme matches =head2 list_extra_info Add the scheme declaration if present to the debug screen. =head1 AUTHORS Catalyst Contributors, see L =head1 COPYRIGHT See L =cut Catalyst-Runtime-5.90126/lib/Catalyst/ClassData.pm0000644000000000000000000000425212406561462021764 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Plugin/0000755000000000000000000000000013611202202021001 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Plugin/Unicode/0000755000000000000000000000000013611202202022367 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Plugin/Unicode/Encoding.pm0000644000000000000000000000075013611200111024452 0ustar00rootwheel00000000000000package Catalyst::Plugin::Unicode::Encoding; our $VERSION = '5.90126'; 1; =head1 NAME Catalyst::Plugin::Unicode::Encoding - Unicode aware Catalyst =head1 DESCRIPTION This plugin has been merged into core. This package only exists to clean out any existing versions on your installed system. =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.90126/lib/Catalyst/Action.pm0000644000000000000000000004206113610701551021333 0ustar00rootwheel00000000000000package 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 equals { my ($self, $target) = @_; return $self->private_path eq $target->private_path ? $self : 0; } 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 equals if( $action->equal($other_action) ) { ... } Returns true if the two actions are equal. =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.90126/lib/Catalyst/Runtime.pm0000644000000000000000000000120613611200117021526 0ustar00rootwheel00000000000000package Catalyst::Runtime; use strict; use warnings; BEGIN { require 5.008003; } # Remember to update this in Catalyst as well! our $VERSION = '5.90126'; $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.90126/lib/Catalyst/Contributing.pod0000644000000000000000000001154112614432252022734 0ustar00rootwheel00000000000000=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.90126/lib/Catalyst/Component/0000755000000000000000000000000013611202203021506 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Component/ContextClosure.pm0000644000000000000000000000354013366373233025052 0ustar00rootwheel00000000000000package Catalyst::Component::ContextClosure; use Moose::Role; use Scalar::Util 'weaken'; use namespace::clean -except => [ 'meta' ]; sub make_context_closure { my ($self, $closure, $ctx) = @_; weaken $ctx; return sub { $closure->($ctx, @_) }; } 1; __END__ =head1 NAME Catalyst::Component::ContextClosure - Moose Role for components which need to close over the $ctx, without leaking =head1 SYNOPSIS package MyApp::Controller::Foo; use Moose; use namespace::clean -except => 'meta'; BEGIN { extends 'Catalyst::Controller'; with 'Catalyst::Component::ContextClosure'; } sub some_action : Local { my ($self, $ctx) = @_; $ctx->stash(a_closure => $self->make_context_closure(sub { my ($ctx) = @_; $ctx->response->body('body set from closure'); }, $ctx)); } =head1 DESCRIPTION A common problem with stashing a closure, that closes over the Catalyst context (often called C<$ctx> or C<$c>), is the circular reference it creates, as the closure holds onto a reference to context, and the context holds a reference to the closure in its stash. This creates a memory leak, unless you always carefully weaken the closures context reference. This role provides a convenience method to create closures, that closes over C<$ctx>. =head1 METHODS =head2 make_context_closure ($closure, $ctx) Returns a code reference, that will invoke C<$closure> with a weakened reference to C<$ctx>. All other parameters to the returned code reference will be passed along to C<$closure>. =head1 SEE ALSO L L L =begin stopwords =head1 AUTHOR Florian Ragwitz =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.90126/lib/Catalyst/Component/ApplicationAttribute.pm0000644000000000000000000000257112406561462026220 0ustar00rootwheel00000000000000package Catalyst::Component::ApplicationAttribute; use Moose::Role; use namespace::clean -except => 'meta'; # Future - isa => 'ClassName|Catalyst' performance? # required => 1 breaks tests.. has _application => (is => 'ro', weak_ref => 1); sub _app { (shift)->_application(@_) } override BUILDARGS => sub { my ($self, $app) = @_; my $args = super(); $args->{_application} = $app; return $args; }; 1; __END__ =head1 NAME Catalyst::Component::ApplicationAttribute - Moose Role for components which capture the application context. =head1 SYNOPSIS package My::Component; use Moose; extends 'Catalyst::Component'; with 'Catalyst::Component::ApplicationAttribute'; # Your code here 1; =head1 DESCRIPTION This role provides a BUILDARGS method which captures the application context into an attribute. =head1 ATTRIBUTES =head2 _application Weak reference to the application context. =head1 METHODS =head2 BUILDARGS ($self, $app) BUILDARGS method captures the application context into the C<_application> attribute. =head2 _application Reader method for the application context. =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.90126/lib/Catalyst/Test.pm0000644000000000000000000003532713230220710021033 0ustar00rootwheel00000000000000package 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'}); Alternately, you can pass in an L object to set arbitrary request headers. my $res = request(GET '/foo/bar', X-Foo => 'Bar', Authorization => 'Bearer JWT_HERE', ... ); =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.90126/lib/Catalyst/Response.pm0000644000000000000000000005677413417652232021742 0ustar00rootwheel00000000000000package Catalyst::Response; use Moose; use HTTP::Headers; use Moose::Util::TypeConstraints; use Scalar::Util 'blessed'; use Catalyst::Response::Writer; use Catalyst::Utils (); use namespace::clean -except => ['meta']; 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') { # Its not clear to me this is correct. Right now if the PSGI application wants # to stream, we stream immediately and then completely bypass the rest of the # Catalyst finalization process (unlike if the PSGI app sets an arrayref). Part of # me thinks we should override the current _response_cb and then let finalize_body # call that. I'm not sure the downside of bypassing those bits. I'm going to leave # this be for now and document the behavior. $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. # We check first to make sure headers have not been finalized. Headers might be finalized # in the case where a PSGI response is streaming and the PSGI application already wrote # to the output stream and close the filehandle. if(!$self->finalized_headers && $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 $res->finalize_headers() 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)); } sub streaming_body :Local { my ($self, $c) = @_; my $psgi_app = sub { my $respond = shift; my $writer = $respond->([200,["Content-Type" => "text/plain"]]); $writer->write("body"); $writer->close; }; $c->res->from_psgi_response($psgi_app); } 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). B If your external PSGI application is streaming, we assume you completely handle the entire jobs (including closing the stream). This will also bypass the output finalization methods on Catalyst (such as 'finalize_body' which gets called but then skipped when it finds that output is already finished.) Its possible this might cause issue with some plugins that want to do 'things' during those finalization methods. Just understand what is happening. =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.90126/lib/Catalyst/Request.pm0000644000000000000000000010026413417640535021557 0ustar00rootwheel00000000000000package Catalyst::Request; use Socket qw( getaddrinfo getnameinfo AI_NUMERICHOST NI_NAMEREQD NIx_NOSERV ); 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' || $self->method eq 'PATCH'); 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( sprintf '%s does not have an available data handler. Valid data_handlers are %s.', $content_type, join ', ', sort keys %{$self->data_handlers} ); } } 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', lazy => 1, default => sub { my ($self) = @_; my ( $err, $sockaddr ) = getaddrinfo( $self->address, # no service '', { flags => AI_NUMERICHOST } ); if ( $err ) { $self->_log->warn("resolve of hostname failed: $err"); return $self->address; } ( $err, my $hostname ) = getnameinfo( $sockaddr->{addr}, NI_NAMEREQD, # we are only interested in the hostname, not the servicename NIx_NOSERV ); if ( $err ) { $self->_log->warn("resolve of hostname failed: $err"); return $self->address; } return $hostname; }, ); 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.90126/lib/Catalyst/Script/0000755000000000000000000000000013611202202021007 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Script/Server.pm0000644000000000000000000002302413366373233022640 0ustar00rootwheel00000000000000package Catalyst::Script::Server; use Moose; use Catalyst::Utils; use Class::Load qw(try_load_class load_class); use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; has debug => ( traits => [qw(Getopt)], cmd_aliases => 'd', isa => 'Bool', is => 'ro', documentation => q{Force debug mode}, ); has host => ( traits => [qw(Getopt)], cmd_aliases => 'h', isa => 'Str', is => 'ro', # N.B. undef (the default) means we bind on all interfaces on the host. documentation => 'Specify a hostname or IP on this host for the server to bind to', ); has fork => ( traits => [qw(Getopt)], cmd_aliases => 'f', isa => 'Bool', is => 'ro', default => 0, documentation => 'Fork the server to be able to serve multiple requests at once', ); has port => ( traits => [qw(Getopt)], cmd_aliases => 'p', isa => 'Int', is => 'ro', lazy => 1, default => sub { Catalyst::Utils::env_value(shift->application_name, 'port') || 3000 }, documentation => 'Specify a different listening port (to the default port 3000)', ); use Moose::Util::TypeConstraints; class_type 'MooseX::Daemonize::Pid::File'; subtype 'Catalyst::Script::Server::Types::Pidfile', as 'MooseX::Daemonize::Pid::File'; coerce 'Catalyst::Script::Server::Types::Pidfile', from 'Str', via { my ($success, $error) = try_load_class("MooseX::Daemonize::Pid::File"); warn("Could not load MooseX::Daemonize::Pid::File, needed for --pid option: $error\n"), exit 1 if not $success; MooseX::Daemonize::Pid::File->new( file => $_ ); }; MooseX::Getopt::OptionTypeMap->add_option_type_to_map( 'Catalyst::Script::Server::Types::Pidfile' => '=s', ); has pidfile => ( traits => [qw(Getopt)], cmd_aliases => 'pid', isa => 'Catalyst::Script::Server::Types::Pidfile', is => 'ro', documentation => 'Specify a pidfile', coerce => 1, predicate => '_has_pidfile', ); # Override MooseX::Daemonize sub dont_close_all_files { 1 } sub BUILD { my $self = shift; if ($self->background) { # FIXME - This is evil. Should we just add MX::Daemonize to the deps? my ($success, $error) = try_load_class("MooseX::Daemonize::Core"); warn("MooseX::Daemonize is needed for the --background option: $error\n"), exit 1 if not $success; ($success, $error) = try_load_class("POSIX"); warn("$error\n"), exit 1 if not $success; MooseX::Daemonize::Core->meta->apply($self); POSIX::close($_) foreach (0..2); } } has keepalive => ( traits => [qw(Getopt)], cmd_aliases => 'k', isa => 'Bool', is => 'ro', default => 0, documentation => 'Support keepalive', ); has background => ( traits => [qw(Getopt)], cmd_aliases => 'bg', isa => 'Bool', is => 'ro', default => 0, documentation => 'Run in the background', ); has restart => ( traits => [qw(Getopt)], cmd_aliases => 'r', isa => 'Bool', is => 'ro', lazy => 1, default => sub { Catalyst::Utils::env_value(shift->application_name, 'reload') || 0; }, documentation => 'use Catalyst::Restarter to detect code changes and restart the application', ); has restart_directory => ( traits => [qw(Getopt)], cmd_aliases => [ 'rdir', 'restartdirectory' ], isa => 'ArrayRef[Str]', is => 'ro', documentation => 'Restarter directory to watch', predicate => '_has_restart_directory', ); has restart_delay => ( traits => [qw(Getopt)], cmd_aliases => 'rd', isa => 'Int', is => 'ro', documentation => 'Set a restart delay', predicate => '_has_restart_delay', ); { use Moose::Util::TypeConstraints; my $tc = subtype 'Catalyst::Script::Server::Types::RegexpRef', as 'RegexpRef'; coerce $tc, from 'Str', via { qr/$_/ }; MooseX::Getopt::OptionTypeMap->add_option_type_to_map($tc => '=s'); has restart_regex => ( traits => [qw(Getopt)], cmd_aliases => 'rr', isa => $tc, coerce => 1, is => 'ro', documentation => 'Restart regex', predicate => '_has_restart_regex', ); } has follow_symlinks => ( traits => [qw(Getopt)], cmd_aliases => 'sym', isa => 'Bool', is => 'ro', default => 0, documentation => 'Follow symbolic links', predicate => '_has_follow_symlinks', ); sub _plack_engine_name { my $self = shift; return $self->fork || $self->keepalive ? 'Starman' : 'Standalone'; } sub _restarter_args { my $self = shift; return ( argv => $self->ARGV, start_sub => sub { $self->_run_application }, ($self->_has_follow_symlinks ? (follow_symlinks => $self->follow_symlinks) : ()), ($self->_has_restart_delay ? (sleep_interval => $self->restart_delay) : ()), ($self->_has_restart_directory ? (directories => $self->restart_directory) : ()), ($self->_has_restart_regex ? (filter => $self->restart_regex) : ()), ), ( map { $_ => $self->$_ } qw(application_name host port debug pidfile fork background keepalive) ); } has restarter_class => ( is => 'ro', isa => 'Str', lazy => 1, default => sub { my $self = shift; Catalyst::Utils::env_value($self->application_name, 'RESTARTER') || 'Catalyst::Restarter'; } ); sub run { my $self = shift; local $ENV{CATALYST_DEBUG} = 1 if $self->debug; if ( $self->restart ) { die "Cannot run in the background and also watch for changed files.\n" if $self->background; die "Cannot write out a pid file and fork for the restarter.\n" if $self->_has_pidfile; # If we load this here, then in the case of a restarter, it does not # need to be reloaded for each restart. require Catalyst; # If this isn't done, then the Catalyst::Devel tests for the restarter # fail. $| = 1 if $ENV{HARNESS_ACTIVE}; Catalyst::Utils::ensure_class_loaded($self->restarter_class); my $subclass = $self->restarter_class->pick_subclass; my $restarter = $subclass->new( $self->_restarter_args() ); $restarter->run_and_watch; } else { if ($self->background) { $self->daemon_fork; return 1 unless $self->is_daemon; load_class($self->application_name); $self->daemon_detach; } $self->pidfile->write if $self->_has_pidfile; $self->_run_application; } } sub _plack_loader_args { my ($self) = shift; return ( port => $self->port, host => $self->host, keepalive => $self->keepalive ? 100 : 1, server_ready => sub { my ($args) = @_; my $name = $args->{server_software} || ref($args); # $args is $server my $host = $args->{host} || 0; my $proto = $args->{proto} || 'http'; print STDERR "$name: Accepting connections at $proto://$host:$args->{port}/\n"; }, ); } around _application_args => sub { my ($orig, $self) = @_; return ( $self->port, $self->host, { %{ $self->$orig }, map { $_ => $self->$_ } qw/ fork keepalive background pidfile keepalive follow_symlinks port host /, }, ); }; __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::Script::Server - Catalyst test server =head1 SYNOPSIS myapp_server.pl [options] Options: -d --debug force debug mode -f --fork handle each request in a new process (defaults to false) --help display this help and exits -h --host host (defaults to all) -p --port port (defaults to 3000) -k --keepalive enable keep-alive connections -r --restart restart when files get modified (defaults to false) --rd --restart_delay delay between file checks (ignored if you have Linux::Inotify2 installed) --rr --restart_regex regex match files that trigger a restart when modified (defaults to '\.yml$|\.yaml$|\.conf|\.pm$') --rdir --restart_directory the directory to search for modified files, can be set multiple times (defaults to '[SCRIPT_DIR]/..') --sym --follow_symlinks follow symlinks in search directories (defaults to false. this is a no-op on Win32) --bg --background run the process in the background --pid --pidfile specify filename for pid file See also: perldoc Catalyst::Manual perldoc Catalyst::Manual::Intro =head1 DESCRIPTION Run a Catalyst test server for this application. =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 Catalyst-Runtime-5.90126/lib/Catalyst/Script/Create.pm0000644000000000000000000000523313366373233022577 0ustar00rootwheel00000000000000package Catalyst::Script::Create; use Moose; use Class::Load 'load_class'; use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; has force => ( traits => [qw(Getopt)], cmd_aliases => 'nonew', isa => 'Bool', is => 'ro', documentation => 'Force new scripts', ); has debug => ( traits => [qw(Getopt)], cmd_aliases => 'd', isa => 'Bool', is => 'ro', documentation => 'Force debug mode', ); has mechanize => ( traits => [qw(Getopt)], cmd_aliases => 'mech', isa => 'Bool', is => 'ro', documentation => 'use WWW::Mechanize', ); has helper_class => ( isa => 'Str', is => 'ro', builder => '_build_helper_class', ); sub _build_helper_class { 'Catalyst::Helper' } sub run { my ($self) = @_; $self->print_usage_text if !$self->ARGV->[0]; my $helper_class = $self->helper_class; load_class($helper_class); my $helper = $helper_class->new( { '.newfiles' => !$self->force, mech => $self->mechanize } ); $self->print_usage_text unless $helper->mk_component( $self->application_name, @{$self->extra_argv} ); } __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::Script::Create - Create a new Catalyst Component =head1 SYNOPSIS myapp_create.pl [options] model|view|controller name [helper] [options] Options: --force don't create a .new file where a file to be created exists --mechanize use Test::WWW::Mechanize::Catalyst for tests if available --help display this help and exits Examples: myapp_create.pl controller My::Controller myapp_create.pl controller My::Controller BindLex myapp_create.pl --mechanize controller My::Controller myapp_create.pl view My::View myapp_create.pl view MyView TT myapp_create.pl view TT TT myapp_create.pl model My::Model myapp_create.pl model SomeDB DBIC::Schema MyApp::Schema create=dynamic\ dbi:SQLite:/tmp/my.db myapp_create.pl model AnotherDB DBIC::Schema MyApp::Schema create=static\ dbi:Pg:dbname=foo root 4321 See also: perldoc Catalyst::Manual perldoc Catalyst::Manual::Intro =head1 DESCRIPTION Create a new Catalyst Component. Existing component files are not overwritten. If any of the component files to be created already exist the file will be written with a '.new' suffix. This behavior can be suppressed with the C<--force> option. =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 Catalyst-Runtime-5.90126/lib/Catalyst/Script/CGI.pm0000644000000000000000000000127013366373233021773 0ustar00rootwheel00000000000000package Catalyst::Script::CGI; use Moose; use namespace::clean -except => [ 'meta' ]; sub _plack_engine_name { 'CGI' } with 'Catalyst::ScriptRole'; __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::Script::CGI - The CGI Catalyst Script =head1 SYNOPSIS myapp_cgi.pl [options] Options: -? --help display this help and exits =head1 DESCRIPTION This is a script to run the Catalyst engine specialized for the CGI environment. =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 Catalyst-Runtime-5.90126/lib/Catalyst/Script/Test.pm0000644000000000000000000000160113366373233022306 0ustar00rootwheel00000000000000package Catalyst::Script::Test; use Moose; use Catalyst::Test (); use namespace::clean -except => [ 'meta' ]; with 'Catalyst::ScriptRole'; sub run { my $self = shift; Catalyst::Test->import($self->application_name); foreach my $arg (@{ $self->ARGV }) { print request($arg)->content . "\n"; } } __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::Script::Test - Test Catalyst application on the command line =head1 SYNOPSIS myapp_test.pl [options] /path Options: -h --help display this help and exits =head1 DESCRIPTION Script to perform a test hit against your application and display the output. =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 Catalyst-Runtime-5.90126/lib/Catalyst/Script/FastCGI.pm0000644000000000000000000001024313366373233022611 0ustar00rootwheel00000000000000package Catalyst::Script::FastCGI; use Moose; use Data::OptList; use namespace::clean -except => [ 'meta' ]; sub _plack_engine_name { 'FCGI' } with 'Catalyst::ScriptRole'; has listen => ( traits => [qw(Getopt)], cmd_aliases => 'l', isa => 'Str', is => 'ro', documentation => 'Specify a listening port/socket', ); has pidfile => ( traits => [qw(Getopt)], cmd_aliases => [qw/pid p/], isa => 'Str', is => 'ro', documentation => 'Specify a pidfile', ); has daemon => ( traits => [qw(Getopt)], isa => 'Bool', is => 'ro', cmd_aliases => [qw/d detach/], # Eww, detach is here as we fucked it up.. Deliberately not documented documentation => 'Daemonize (go into the background)', ); has manager => ( traits => [qw(Getopt)], isa => 'Str', is => 'ro', cmd_aliases => 'M', documentation => 'Use a different FastCGI process manager class', ); has keeperr => ( traits => [qw(Getopt)], cmd_aliases => 'e', isa => 'Bool', is => 'ro', documentation => 'Log STDERR', ); has nproc => ( traits => [qw(Getopt)], cmd_aliases => 'n', isa => 'Int', is => 'ro', documentation => 'Specify a number of child processes', ); has proc_title => ( traits => [qw(Getopt)], isa => 'Str', is => 'ro', lazy => 1, builder => '_build_proc_title', documentation => 'Set the process title', ); sub _build_proc_title { my ($self) = @_; return sprintf 'perl-fcgi-pm [%s]', $self->application_name; } sub BUILD { my ($self) = @_; $self->proc_title; } # Munge the 'listen' arg so that Plack::Handler::FCGI will accept it. sub _listen { my ($self) = @_; if (defined (my $listen = $self->listen)) { return [ $listen ]; } else { return undef; } } sub _plack_loader_args { my ($self) = shift; my $opts = Data::OptList::mkopt([ qw/manager nproc proc_title/, pid => [ 'pidfile' ], daemonize => [ 'daemon' ], keep_stderr => [ 'keeperr' ], listen => [ '_listen' ], ]); my %args = map { $_->[0] => $self->${ \($_->[1] ? $_->[1]->[0] : $_->[0]) } } @$opts; # Plack::Handler::FCGI thinks manager => undef means "use no manager". delete $args{'manager'} unless defined $args{'manager'}; return %args; } around _application_args => sub { my ($orig, $self) = @_; return ( $self->listen, { %{ $self->$orig }, nproc => $self->nproc, pidfile => $self->pidfile, manager => $self->manager, detach => $self->daemon, keep_stderr => $self->keeperr, proc_title => $self->proc_title, } ); }; __PACKAGE__->meta->make_immutable; 1; =head1 NAME Catalyst::Script::FastCGI - The FastCGI Catalyst Script =head1 SYNOPSIS myapp_fastcgi.pl [options] Options: -? --help display this help and exits -l --listen Socket path to listen on (defaults to standard input) can be HOST:PORT, :PORT or a filesystem path -n --nproc specify number of processes to keep to serve requests (defaults to 1, requires -listen) -p --pidfile specify filename for pid file (requires -listen) -d --daemon daemonize (requires -listen) -M --manager specify alternate process manager (FCGI::ProcManager sub-class) or empty string to disable -e --keeperr send error messages to STDOUT, not to the webserver --proc_title set the process title =head1 DESCRIPTION Run a Catalyst application as fastcgi. =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 Catalyst-Runtime-5.90126/lib/Catalyst/DispatchType.pm0000644000000000000000000000363012406561462022525 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Upgrading.pod0000644000000000000000000011077113417640535022221 0ustar00rootwheel00000000000000=head1 NAME Catalyst::Upgrading - Instructions for upgrading to the latest Catalyst =head1 Upgrading to Catalyst 5.90121 A new C method has been added. This will only affect subclasses that have a method with this name added. =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
$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} : ''; $query_string =~ s/\A[&;]+//; my @unsplit_pairs = split /[&;]+/, $query_string; my $p = Hash::MultiValue->new(); my $is_first_pair = 1; for my $pair (@unsplit_pairs) { my ($name, $value) = map { defined $_ ? $decoder->($self->unescape_uri($_)) : $_ } ( split /=/, $pair, 2 )[0,1]; # slice forces two elements if ($is_first_pair) { # If the first pair has no equal sign, then it means the isindex # flag is set. $c->request->query_keywords($name) unless defined $value; $is_first_pair = 0; } $p->add( $name => $value ); } $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.90126/lib/Catalyst/View.pm0000644000000000000000000000237512406561462021043 0ustar00rootwheel00000000000000package Catalyst::View; use Moose; extends qw/Catalyst::Component/; =head1 NAME Catalyst::View - Catalyst View base class =head1 SYNOPSIS package Catalyst::View::Homebrew; use base qw/Catalyst::View/; sub process { # template processing goes here. } =head1 DESCRIPTION This is the Catalyst View base class. It's meant to be used as a base class by Catalyst views. As a convention, views are expected to read template names from $c->stash->{template}, and put the output into $c->res->body. Some views default to render a template named after the dispatched action's private name. (See L.) =head1 METHODS Implements the same methods as other Catalyst components, see L =head2 process gives an error message about direct use. =cut sub process { Catalyst::Exception->throw( message => ( ref $_[0] || $_[0] ). " directly inherits from Catalyst::View. You need to\n". " inherit from a subclass like Catalyst::View::TT instead.\n" ); } =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 no Moose; __PACKAGE__->meta->make_immutable(); 1; Catalyst-Runtime-5.90126/lib/Catalyst/ActionChain.pm0000644000000000000000000000710612520162327022300 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Model.pm0000644000000000000000000000105212406561462021160 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Stats.pm0000644000000000000000000002457212406561462021232 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/Request/0000755000000000000000000000000013611202201021172 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Request/PartData.pm0000644000000000000000000001044613366373233023262 0ustar00rootwheel00000000000000package Catalyst::Request::PartData; use Moose; use HTTP::Headers; use Encode; has [qw/raw_data name size/] => (is=>'ro', required=>1); has headers => ( is=>'ro', required=>1, handles=>[qw/content_type content_encoding content_type_charset/]); sub build_from_part_data { my ($class, $c, $part_data) = @_; # If the headers are complex, we need to work harder to figure out what to do if(my $hdrs = $class->part_data_has_complex_headers($part_data)) { # Ok so its one of two possibilities. If I can inspect the headers and # Figure out what to do, the I will return data. Otherwise I will return # a PartData object and expect you do deal with it. # For now if I can find a charset in the content type I will just decode and # assume I got it right (patches and bug reports welcomed). # Any of these headers means I can't decode if( $hdrs->content_encoding ) { return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } my ($ct, $charset) = $hdrs->content_type_charset; if($ct) { # Good news, we probably have data we can return. If there is a charset # then use that to decode otherwise use the default decoding. if($charset) { return Encode::decode($charset, $part_data->{data}) } else { if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { return $c->_handle_param_unicode_decoding($part_data->{data}); } else { return $part_data->{data} } } } else { # I have no idea what to do with this now.. return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } } else { if($c and $c->encoding and !$c->config->{skip_body_param_unicode_decoding}) { return $c->_handle_param_unicode_decoding($part_data->{data}); } else { return $part_data->{data} } } return $part_data->{data} unless $class->part_data_has_complex_headers($part_data); return $class->new( raw_data => $part_data->{data}, name => $part_data->{name}, size => $part_data->{size}, headers => HTTP::Headers->new(%{ $part_data->{headers} })); } sub part_data_has_complex_headers { my ($class, $part_data) = @_; my %h = %{$part_data->{headers}}; my $hdrs = HTTP::Headers->new(%h); # Remove non threatening headers. $hdrs->remove_header('Content-Length', 'Expires', 'Last-Modified', 'Content-Language'); # If we still have more than one (Content-Disposition) header we need to understand # that and deal with it. return $hdrs->header_field_names > 1 ? $hdrs :0; } __PACKAGE__->meta->make_immutable; =head1 NAME Catalyst::Request::Upload - handles file upload requests =head1 SYNOPSIS my $data_part = To specify where Catalyst should put the temporary files, set the 'uploadtmp' option in the Catalyst config. If unset, Catalyst will use the system temp dir. __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); See also L. =head1 DESCRIPTION =head1 ATTRIBUTES This class defines the following immutable attributes =head2 raw_data The raw data as returned via L. =head2 name The part name that gets extracted from the content-disposition header. =head2 size The raw byte count (over http) of the data. This is not the same as the character length =head2 headers An L object that represents the submitted headers of the POST. This object will handle the following methods: =head3 content_type =head3 content_encoding =head3 content_type_charset These three methods are the same as methods described in L. =head1 METHODS =head2 build_from_part_data Factory method to build an object from part data returned by L =head2 part_data_has_complex_headers Returns true if there more than one header (indicates the part data is complex and contains content type and encoding information.). =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.90126/lib/Catalyst/Request/Upload.pm0000644000000000000000000001565313366373233023013 0ustar00rootwheel00000000000000package Catalyst::Request::Upload; use Moose; with 'MooseX::Emulate::Class::Accessor::Fast'; use Catalyst::Exception; use File::Copy (); use IO::File (); use File::Spec::Unix; use PerlIO::utf8_strict; use namespace::clean -except => 'meta'; has filename => (is => 'rw'); has headers => (is => 'rw'); has size => (is => 'rw'); has tempname => (is => 'rw'); has type => (is => 'rw'); has basename => (is => 'ro', lazy_build => 1); has raw_basename => (is => 'ro', lazy_build => 1); has charset => (is=>'ro', predicate=>'has_charset'); has fh => ( is => 'rw', required => 1, lazy => 1, default => sub { my $self = shift; my $fh = IO::File->new($self->tempname, IO::File::O_RDONLY); unless ( defined $fh ) { my $filename = $self->tempname; Catalyst::Exception->throw( message => qq/Can't open '$filename': '$!'/ ); } return $fh; }, ); sub _build_basename { my $basename = shift->raw_basename; $basename =~ s|[^\w\.-]+|_|g; return $basename; } sub _build_raw_basename { my $self = shift; my $basename = $self->filename; $basename =~ s|\\|/|g; $basename = ( File::Spec::Unix->splitpath($basename) )[2]; return $basename; } no Moose; =for stopwords uploadtmp =head1 NAME Catalyst::Request::Upload - handles file upload requests =head1 SYNOPSIS my $upload = $c->req->upload('field'); $upload->basename; $upload->copy_to; $upload->fh; $upload->decoded_fh $upload->filename; $upload->headers; $upload->link_to; $upload->size; $upload->slurp; $upload->decoded_slurp; $upload->tempname; $upload->type; $upload->charset; To specify where Catalyst should put the temporary files, set the 'uploadtmp' option in the Catalyst config. If unset, Catalyst will use the system temp dir. __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' ); See also L. =head1 DESCRIPTION This class provides accessors and methods to handle client upload requests. =head1 METHODS =head2 $upload->new Simple constructor. =head2 $upload->copy_to Copies the temporary file using L. Returns true for success, false for failure. $upload->copy_to('/path/to/target'); Please note the filename used for the copy target is the 'tempname' that is the actual filename on the filesystem, NOT the 'filename' that was part of the upload headers. This might seem counter intuitive but at this point this behavior is so established that its not something we can change. You can always create your own copy routine that munges the target path as you wish. =cut sub copy_to { my $self = shift; return File::Copy::copy( $self->tempname, @_ ); } =head2 $upload->is_utf8_encoded Returns true of the upload defines a character set at that value is 'UTF-8'. This does not try to inspect your upload and make any guesses if the Content Type charset is undefined. =cut sub is_utf8_encoded { my $self = shift; if(my $charset = $self->charset) { return $charset eq 'UTF-8' ? 1 : 0; } return 0; } =head2 $upload->fh Opens a temporary file (see tempname below) and returns an L handle. This is a filehandle that is opened with no additional IO Layers. =head2 $upload->decoded_fh(?$encoding) Returns a filehandle that has binmode set to UTF-8 if a UTF-8 character set is found. This also accepts an override encoding value that you can use to force a particular L layer. If neither are found the filehandle is set to :raw. This is useful if you are pulling the file into code and inspecting bits and maybe then sending those bits back as the response. (Please note this is not a suitable filehandle to set in the body; use C if you are doing that). Please note that using this method sets the underlying filehandle IO layer so once you use this method if you go back and use the C method you still get the IO layer applied. =cut sub decoded_fh { my ($self, $layer) = @_; my $fh = $self->fh; $layer = ':utf8_strict' if !$layer && $self->is_utf8_encoded; $layer = ':raw' unless $layer; binmode($fh, $layer); return $fh; } =head2 $upload->filename Returns the client-supplied filename. =head2 $upload->headers Returns an L object for the request. =head2 $upload->link_to Creates a hard link to the temporary file. Returns true for success, false for failure. $upload->link_to('/path/to/target'); =cut sub link_to { my ( $self, $target ) = @_; return CORE::link( $self->tempname, $target ); } =head2 $upload->size Returns the size of the uploaded file in bytes. =head2 $upload->slurp(?$encoding) Optionally accepts an argument to define an IO Layer (which is applied to the filehandle via binmode; if no layer is defined the default is set to ":raw". Returns a scalar containing the contents of the temporary file. Note that this will cause the filehandle pointed to by C<< $upload->fh >> to be reset to the start of the file using seek and the file handle to be put into whatever encoding mode is applied. =cut sub slurp { my ( $self, $layer ) = @_; unless ($layer) { $layer = ':raw'; } my $content = ''; my $handle = $self->fh; binmode( $handle, $layer ); $handle->seek(0, IO::File::SEEK_SET); if ($layer eq ':raw') { while ( $handle->sysread( my $buffer, 8192 ) ) { $content .= $buffer; } } else { $content = do { local $/; $handle->getline }; } $handle->seek(0, IO::File::SEEK_SET); return $content; } =head2 $upload->decoded_slurp(?$encoding) Works just like C except we use C instead of C to open a filehandle to slurp. This means if your upload charset is UTF8 we binmode the filehandle to that encoding. =cut sub decoded_slurp { my ( $self, $layer ) = @_; my $handle = $self->decoded_fh($layer); $handle->seek(0, IO::File::SEEK_SET); my $content = do { local $/; $handle->getline }; $handle->seek(0, IO::File::SEEK_SET); return $content; } =head2 $upload->basename Returns basename for C. This filters the name through a regexp C to make it safe for filesystems that don't like advanced characters. This will of course filter UTF8 characters. If you need the exact basename unfiltered use C. =head2 $upload->raw_basename Just like C but without filtering the filename for characters that don't always write to a filesystem. =head2 $upload->tempname Returns the path to the temporary file. =head2 $upload->type Returns the client-supplied Content-Type. =head2 $upload->charset The character set information part of the content type, if any. Useful if you need to figure out any encodings on the file upload. =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.90126/lib/Catalyst/Component.pm0000644000000000000000000002377212614432252022072 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/DispatchType/0000755000000000000000000000000013611202203022145 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/DispatchType/Index.pm0000644000000000000000000000416712406561462023602 0ustar00rootwheel00000000000000package Catalyst::DispatchType::Index; use Moose; extends 'Catalyst::DispatchType'; use namespace::clean -except => 'meta'; =head1 NAME Catalyst::DispatchType::Index - Index DispatchType =head1 SYNOPSIS See L. =head1 DESCRIPTION Dispatch type managing behaviour for index pages. For more information on dispatch types, see: =over 4 =item * L for how they affect application authors =item * L for implementation information. =back =cut has _actions => ( is => 'rw', isa => 'HashRef', default => sub { +{} } ); =head1 METHODS =head2 $self->match( $c, $path ) Check if there's an index action for a given path, and set it up to use it if there is; only matches a full URI - if $c->req->args is already set this DispatchType is guaranteed not to match. =cut sub match { my ( $self, $c, $path ) = @_; return if @{ $c->req->args }; my $result = $c->get_action( 'index', $path ); return 0 unless $result && exists $self->_actions->{ $result->reverse }; if ($result && $result->match($c)) { $c->action($result); $c->namespace( $result->namespace ); $c->req->action('index'); $c->req->match( $c->req->path ); return 1; } return 0; } =head2 $self->register( $c, $action ) Register an action with this DispatchType. =cut sub register { my ( $self, $c, $action ) = @_; $self->_actions->{ $action->reverse } = $action if $action->name eq 'index'; return 1; } =head2 $self->uri_for_action( $action, $captures ) get a URI part for an action; always returns undef is $captures is set since index actions don't have captures =cut sub uri_for_action { my ( $self, $action, $captures ) = @_; return undef if @$captures; return undef unless exists $self->_actions->{ $action->reverse }; return "/".$action->namespace; } sub _is_low_precedence { 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.90126/lib/Catalyst/DispatchType/Default.pm0000644000000000000000000000323312406561462024110 0ustar00rootwheel00000000000000package Catalyst::DispatchType::Default; use Moose; extends 'Catalyst::DispatchType'; no Moose; =head1 NAME Catalyst::DispatchType::Default - Default DispatchType =head1 SYNOPSIS See L. =head1 DESCRIPTION Dispatch type managing default behaviour. For more information on dispatch types, see: =over 4 =item * L for how they affect application authors =item * L for implementation information. =back =head1 METHODS =head2 $self->match( $c, $path ) If path is empty (i.e. all path parts have been converted into args), attempts to find a default for the namespace constructed from the args, or the last inherited default otherwise and will match that. If path is not empty, never matches since Default will only match if all other possibilities have been exhausted. =cut sub match { my ( $self, $c, $path ) = @_; return if $path ne ''; # Not at root yet, wait for it ... my $result = ( $c->get_actions( 'default', $c->req->path ) )[-1]; # Find default on namespace or super if ($result && $result->match($c)) { $c->action($result); $c->namespace( $result->namespace ); $c->req->action('default'); # default methods receive the controller name as the first argument unshift @{ $c->req->args }, $path if $path; $c->req->match(''); return 1; } return 0; } sub _is_low_precedence { 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.90126/lib/Catalyst/DispatchType/Chained.pm0000644000000000000000000006743013366373233024073 0ustar00rootwheel00000000000000package Catalyst::DispatchType::Chained; use Moose; extends 'Catalyst::DispatchType'; use Text::SimpleTable; use Catalyst::ActionChain; use Catalyst::Utils; use URI; use Scalar::Util (); use Encode 2.21 'decode_utf8'; has _endpoints => ( is => 'rw', isa => 'ArrayRef', required => 1, default => sub{ [] }, ); has _actions => ( is => 'rw', isa => 'HashRef', required => 1, default => sub{ {} }, ); has _children_of => ( is => 'rw', isa => 'HashRef', required => 1, default => sub{ {} }, ); no Moose; # please don't perltidy this. hairy code within. =head1 NAME Catalyst::DispatchType::Chained - Path Part DispatchType =head1 SYNOPSIS Path part matching, allowing several actions to sequentially take care of processing a request: # root action - captures one argument after it sub foo_setup : Chained('/') PathPart('foo') CaptureArgs(1) { my ( $self, $c, $foo_arg ) = @_; ... } # child action endpoint - takes one argument sub bar : Chained('foo_setup') Args(1) { my ( $self, $c, $bar_arg ) = @_; ... } =head1 DESCRIPTION Dispatch type managing default behaviour. For more information on dispatch types, see: =over 4 =item * L for how they affect application authors =item * L for implementation information. =back =head1 METHODS =head2 $self->list($c) Debug output for Path Part dispatch points =cut sub list { my ( $self, $c ) = @_; return unless $self->_endpoints; my $avail_width = Catalyst::Utils::term_width() - 9; my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50); my $col2_width = $avail_width - $col1_width; my $paths = Text::SimpleTable->new( [ $col1_width, 'Path Spec' ], [ $col2_width, 'Private' ], ); my $has_unattached_actions; my $unattached_actions = Text::SimpleTable->new( [ $col1_width, 'Private' ], [ $col2_width, 'Missing parent' ], ); ENDPOINT: foreach my $endpoint ( sort { $a->reverse cmp $b->reverse } @{ $self->_endpoints } ) { my $args = $endpoint->list_extra_info->{Args}; my @parts; if($endpoint->has_args_constraints) { @parts = map { "{$_}" } $endpoint->all_args_constraints; } elsif(defined $endpoint->attributes->{Args}) { @parts = (defined($endpoint->attributes->{Args}[0]) ? (("*") x $args) : '...'); } my @parents = (); my $parent = "DUMMY"; my $extra = $self->_list_extra_http_methods($endpoint); my $consumes = $self->_list_extra_consumes($endpoint); my $scheme = $self->_list_extra_scheme($endpoint); my $curr = $endpoint; while ($curr) { if (my $cap = $curr->list_extra_info->{CaptureArgs}) { if($curr->has_captures_constraints) { my $names = join '/', map { "{$_}" } $curr->all_captures_constraints; unshift(@parts, $names); } else { unshift(@parts, (("*") x $cap)); } } if (my $pp = $curr->attributes->{PathPart}) { unshift(@parts, $pp->[0]) if (defined $pp->[0] && length $pp->[0]); } $parent = $curr->attributes->{Chained}->[0]; $curr = $self->_actions->{$parent}; unshift(@parents, $curr) if $curr; } if ($parent ne '/') { $has_unattached_actions = 1; $unattached_actions->row('/' . ($parents[0] || $endpoint)->reverse, $parent); next ENDPOINT; } my @rows; foreach my $p (@parents) { my $name = "/${p}"; if (defined(my $extra = $self->_list_extra_http_methods($p))) { $name = "${extra} ${name}"; } if (defined(my $cap = $p->list_extra_info->{CaptureArgs})) { if($p->has_captures_constraints) { my $tc = join ',', @{$p->captures_constraints}; $name .= " ($tc)"; } else { $name .= " ($cap)"; } } if (defined(my $ct = $p->list_extra_info->{Consumes})) { $name .= ' :'.$ct; } if (defined(my $s = $p->list_extra_info->{Scheme})) { $scheme = uc $s; } unless ($p eq $parents[0]) { $name = "-> ${name}"; } push(@rows, [ '', $name ]); } my $endpoint_arg_info = $endpoint; if($endpoint->has_args_constraints) { my $tc = join ',', @{$endpoint->args_constraints}; $endpoint_arg_info .= " ($tc)"; } else { $endpoint_arg_info .= defined($endpoint->attributes->{Args}[0]) ? " ($args)" : " (...)"; } push(@rows, [ '', (@rows ? "=> " : '').($extra ? "$extra " : ''). ($scheme ? "$scheme: ":'')."/${endpoint_arg_info}". ($consumes ? " :$consumes":"" ) ]); my @display_parts = map { $_ =~s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; decode_utf8 $_ } @parts; $rows[0][0] = join('/', '', @display_parts) || '/'; $paths->row(@$_) for @rows; } $c->log->debug( "Loaded Chained actions:\n" . $paths->draw . "\n" ); $c->log->debug( "Unattached Chained actions:\n", $unattached_actions->draw . "\n" ) if $has_unattached_actions; } sub _list_extra_http_methods { my ( $self, $action ) = @_; return unless defined $action->list_extra_info->{HTTP_METHODS}; return join(', ', @{$action->list_extra_info->{HTTP_METHODS}}); } sub _list_extra_consumes { my ( $self, $action ) = @_; return unless defined $action->list_extra_info->{CONSUMES}; return join(', ', @{$action->list_extra_info->{CONSUMES}}); } sub _list_extra_scheme { my ( $self, $action ) = @_; return unless defined $action->list_extra_info->{Scheme}; return uc $action->list_extra_info->{Scheme}; } =head2 $self->match( $c, $path ) Calls C to see if a chain matches the C<$path>. =cut sub match { my ( $self, $c, $path ) = @_; my $request = $c->request; return 0 if @{$request->args}; my @parts = split('/', $path); my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts); if ($parts && @$parts) { for my $arg (@$parts) { $arg =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; push @{$request->args}, $arg; } } return 0 unless $chain; my $action = Catalyst::ActionChain->from_chain($chain); $request->action("/${action}"); $request->match("/${action}"); $request->captures($captures); $c->action($action); $c->namespace( $action->namespace ); return 1; } =head2 $self->recurse_match( $c, $parent, \@path_parts ) Recursive search for a matching chain. =cut sub recurse_match { my ( $self, $c, $parent, $path_parts ) = @_; my $children = $self->_children_of->{$parent}; return () unless $children; my $best_action; my @captures; TRY: foreach my $try_part (sort { length($b) <=> length($a) } keys %$children) { # $b then $a to try longest part first my @parts = @$path_parts; if (length $try_part) { # test and strip PathPart next TRY unless ($try_part eq join('/', # assemble equal number of parts splice( # and strip them off @parts as well @parts, 0, scalar(@{[split('/', $try_part)]}) ))); # @{[]} to avoid split to @_ } my @try_actions = @{$children->{$try_part}}; TRY_ACTION: foreach my $action (@try_actions) { if (my $capture_attr = $action->attributes->{CaptureArgs}) { my $capture_count = $action->number_of_captures|| 0; # Short-circuit if not enough remaining parts next TRY_ACTION unless @parts >= $capture_count; my @captures; my @parts = @parts; # localise # strip CaptureArgs into list push(@captures, splice(@parts, 0, $capture_count)); # check if the action may fit, depending on a given test by the app next TRY_ACTION unless $action->match_captures($c, \@captures); # try the remaining parts against children of this action my ($actions, $captures, $action_parts, $n_pathparts) = $self->recurse_match( $c, '/'.$action->reverse, \@parts ); # No best action currently # OR The action has less parts # OR The action has equal parts but less captured data (ergo more defined) if ($actions && (!$best_action || $#$action_parts < $#{$best_action->{parts}} || ($#$action_parts == $#{$best_action->{parts}} && $#$captures < $#{$best_action->{captures}} && $n_pathparts > $best_action->{n_pathparts}))) { my @pathparts = split /\//, $action->attributes->{PathPart}->[0]; $best_action = { actions => [ $action, @$actions ], captures=> [ @captures, @$captures ], parts => $action_parts, n_pathparts => scalar(@pathparts) + $n_pathparts, }; } } else { { local $c->req->{arguments} = [ @{$c->req->args}, @parts ]; next TRY_ACTION unless $action->match($c); } my $args_attr = $action->attributes->{Args}->[0]; my $args_count = $action->comparable_arg_number; my @pathparts = split /\//, $action->attributes->{PathPart}->[0]; # No best action currently # OR This one matches with fewer parts left than the current best action, # And therefore is a better match # OR No parts and this expects 0 # The current best action might also be Args(0), # but we couldn't chose between then anyway so we'll take the last seen if ( !$best_action || @parts < @{$best_action->{parts}} || ( !@parts && defined($args_attr) && ( $args_count eq "0" && ( ($c->config->{use_chained_args_0_special_case}||0) || ( exists($best_action->{args_count}) && defined($best_action->{args_count}) ? ($best_action->{args_count} ne 0) : 1 ) ) ) ) ){ $best_action = { actions => [ $action ], captures=> [], parts => \@parts, args_count => $args_count, n_pathparts => scalar(@pathparts), }; } } } } return @$best_action{qw/actions captures parts n_pathparts/} if $best_action; return (); } =head2 $self->register( $c, $action ) Calls register_path for every Path attribute for the given $action. =cut sub register { my ( $self, $c, $action ) = @_; my @chained_attr = @{ $action->attributes->{Chained} || [] }; return 0 unless @chained_attr; if (@chained_attr > 1) { Catalyst::Exception->throw( "Multiple Chained attributes not supported registering ${action}" ); } my $chained_to = $chained_attr[0]; Catalyst::Exception->throw( "Actions cannot chain to themselves registering /${action}" ) if ($chained_to eq '/' . $action); my $children = ($self->_children_of->{ $chained_to } ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; my $part = $action->name; if (@path_part == 1 && defined $path_part[0]) { $part = $path_part[0]; } elsif (@path_part > 1) { Catalyst::Exception->throw( "Multiple PathPart attributes not supported registering " . $action->reverse() ); } if ($part =~ m(^/)) { Catalyst::Exception->throw( "Absolute parameters to PathPart not allowed registering " . $action->reverse() ); } my $encoded_part = URI->new($part)->canonical; $encoded_part =~ s{(?<=[^/])/+\z}{}; $action->attributes->{PathPart} = [ $encoded_part ]; unshift(@{ $children->{$encoded_part} ||= [] }, $action); $self->_actions->{'/'.$action->reverse} = $action; if (exists $action->attributes->{Args} and exists $action->attributes->{CaptureArgs}) { Catalyst::Exception->throw( "Combining Args and CaptureArgs attributes not supported registering " . $action->reverse() ); } unless ($action->attributes->{CaptureArgs}) { unshift(@{ $self->_endpoints }, $action); } return 1; } =head2 $self->uri_for_action($action, $captures) Get the URI part for the action, using C<$captures> to fill the capturing parts. =cut sub uri_for_action { my ( $self, $action, $captures ) = @_; return undef unless ($action->attributes->{Chained} && !$action->attributes->{CaptureArgs}); my @parts = (); my @captures = @$captures; my $parent = "DUMMY"; my $curr = $action; # If this is an action chain get the last action in the chain if($curr->can('chain') ) { $curr = ${$curr->chain}[-1]; } while ($curr) { if (my $cap = $curr->number_of_captures) { return undef unless @captures >= $cap; # not enough captures if ($cap) { unshift(@parts, splice(@captures, -$cap)); } } if (my $pp = $curr->attributes->{PathPart}) { unshift(@parts, $pp->[0]) if (defined($pp->[0]) && length($pp->[0])); } $parent = $curr->attributes->{Chained}->[0]; $curr = $self->_actions->{$parent}; } return undef unless $parent eq '/'; # fail for dangling action return undef if @captures; # fail for too many captures return join('/', '', @parts); } =head2 $c->expand_action($action) Return a list of actions that represents a chained action. See L for more info. You probably want to use the expand_action it provides rather than this directly. =cut sub expand_action { my ($self, $action) = @_; return unless $action->attributes && $action->attributes->{Chained}; my @chain; my $curr = $action; while ($curr) { push @chain, $curr; my $parent = $curr->attributes->{Chained}->[0]; $curr = $self->_actions->{$parent}; } return Catalyst::ActionChain->from_chain([reverse @chain]); } __PACKAGE__->meta->make_immutable; 1; =head1 USAGE =head2 Introduction The C attribute allows you to chain public path parts together by their private names. A chain part's path can be specified with C and can be declared to expect an arbitrary number of arguments. The endpoint of the chain specifies how many arguments it gets through the C attribute. C<:Args(0)> would be none at all, C<:Args> without an integer would be unlimited. The path parts that aren't endpoints are using C to specify how many parameters they expect to receive. As an example setup: package MyApp::Controller::Greeting; use base qw/ Catalyst::Controller /; # this is the beginning of our chain sub hello : PathPart('hello') Chained('/') CaptureArgs(1) { my ( $self, $c, $integer ) = @_; $c->stash->{ message } = "Hello "; $c->stash->{ arg_sum } = $integer; } # this is our endpoint, because it has no :CaptureArgs sub world : PathPart('world') Chained('hello') Args(1) { my ( $self, $c, $integer ) = @_; $c->stash->{ message } .= "World!"; $c->stash->{ arg_sum } += $integer; $c->response->body( join "
\n" => $c->stash->{ message }, $c->stash->{ arg_sum } ); } The debug output provides a separate table for chained actions, showing the whole chain as it would match and the actions it contains. Here's an example of the startup output with our actions above: ... [debug] Loaded Path Part actions: .-----------------------+------------------------------. | Path Spec | Private | +-----------------------+------------------------------+ | /hello/*/world/* | /greeting/hello (1) | | | => /greeting/world | '-----------------------+------------------------------' ... As you can see, Catalyst only deals with chains as whole paths and builds one for each endpoint, which are the actions with C<:Chained> but without C<:CaptureArgs>. Let's assume this application gets a request at the path C. What happens then? First, Catalyst will dispatch to the C action and pass the value C<23> as an argument to it after the context. It does so because we have previously used C<:CaptureArgs(1)> to declare that it has one path part after itself as its argument. We told Catalyst that this is the beginning of the chain by specifying C<:Chained('/')>. Also note that instead of saying C<:PathPart('hello')> we could also just have said C<:PathPart>, as it defaults to the name of the action. After C has run, Catalyst goes on to dispatch to the C action. This is the last action to be called: Catalyst knows this is an endpoint because we did not specify a C<:CaptureArgs> attribute. Nevertheless we specify that this action expects an argument, but at this point we're using C<:Args(1)> to do that. We could also have said C<:Args> or left it out altogether, which would mean this action would get all arguments that are there. This action's C<:Chained> attribute says C and tells Catalyst that the C action in the current controller is its parent. With this we have built a chain consisting of two public path parts. C captures one part of the path as its argument, and also specifies the path root as its parent. So this part is C. The next part is the endpoint C, expecting one argument. It sums up to the path part C. This leads to a complete chain of C which is matched against the requested paths. This example application would, if run and called by e.g. C, set the stash value C to "Hello" and the value C to "23". The C action would then append "World!" to C and add C<12> to the stash's C value. For the sake of simplicity no view is shown. Instead we just put the values of the stash into our body. So the output would look like: Hello World! 35 And our test server would have given us this debugging output for the request: ... [debug] "GET" request for "hello/23/world/12" from "127.0.0.1" [debug] Path is "/greeting/world" [debug] Arguments are "12" [info] Request took 0.164113s (6.093/s) .------------------------------------------+-----------. | Action | Time | +------------------------------------------+-----------+ | /greeting/hello | 0.000029s | | /greeting/world | 0.000024s | '------------------------------------------+-----------' ... What would be common uses of this dispatch technique? It gives the possibility to split up logic that contains steps that each depend on each other. An example would be, for example, a wiki path like C. This chain can be easily built with these actions: sub wiki : PathPart('wiki') Chained('/') CaptureArgs(1) { my ( $self, $c, $page_name ) = @_; # load the page named $page_name and put the object # into the stash } sub rev : PathPart('rev') Chained('wiki') CaptureArgs(1) { my ( $self, $c, $revision_id ) = @_; # use the page object in the stash to get at its # revision with number $revision_id } sub view : PathPart Chained('rev') Args(0) { my ( $self, $c ) = @_; # display the revision in our stash. Another option # would be to forward a compatible object to the action # that displays the default wiki pages, unless we want # a different interface here, for example restore # functionality. } It would now be possible to add other endpoints, for example C to restore this specific revision as the current state. You don't have to put all the chained actions in one controller. The specification of the parent through C<:Chained> also takes an absolute action path as its argument. Just specify it with a leading C. If you want, for example, to have actions for the public paths C and C, just specify two actions with C<:PathPart('foo')> and C<:Chained('/')>. The handler for the former path needs a C<:CaptureArgs(1)> attribute and a endpoint with C<:PathPart('edit')> and C<:Chained('foo')>. For the latter path give the action just a C<:Args(1)> to mark it as endpoint. This sums up to this debugging output: ... [debug] Loaded Path Part actions: .-----------------------+------------------------------. | Path Spec | Private | +-----------------------+------------------------------+ | /foo/* | /controller/foo_view | | /foo/*/edit | /controller/foo_load (1) | | | => /controller/edit | '-----------------------+------------------------------' ... Here's a more detailed specification of the attributes belonging to C<:Chained>: =head2 Attributes =over 8 =item PathPart Sets the name of this part of the chain. If it is specified without arguments, it takes the name of the action as default. So basically C and C are identical. This can also contain slashes to bind to a deeper level. An action with C would bind to C. If you don't specify C<:PathPart> it has the same effect as using C<:PathPart>, it would default to the action name. =item PathPrefix Sets PathPart to the path_prefix of the current controller. =item Chained Has to be specified for every child in the chain. Possible values are absolute and relative private action paths or a single slash C to tell Catalyst that this is the root of a chain. The attribute C<:Chained> without arguments also defaults to the C behavior. Relative action paths may use C<../> to refer to actions in parent controllers. Because you can specify an absolute path to the parent action, it doesn't matter to Catalyst where that parent is located. So, if your design requests it, you can redispatch a chain through any controller or namespace you want. Another interesting possibility gives C<:Chained('.')>, which chains itself to an action with the path of the current controller's namespace. For example: # in MyApp::Controller::Foo sub bar : Chained CaptureArgs(1) { ... } # in MyApp::Controller::Foo::Bar sub baz : Chained('.') Args(1) { ... } This builds up a chain like C. The specification of C<.> as the argument to Chained here chains the C action to an action with the path of the current controller namespace, namely C. That action chains directly to C, so the C chain comes out as the end product. =item ChainedParent Chains an action to another action with the same name in the parent controller. For Example: # in MyApp::Controller::Foo sub bar : Chained CaptureArgs(1) { ... } # in MyApp::Controller::Foo::Bar sub bar : ChainedParent Args(1) { ... } This builds a chain like C. =item CaptureArgs Must be specified for every part of the chain that is not an endpoint. With this attribute Catalyst knows how many of the following parts of the path (separated by C) this action wants to capture as its arguments. If it doesn't expect any, just specify C<:CaptureArgs(0)>. The captures get passed to the action's C<@_> right after the context, but you can also find them as array references in C<< $c->request->captures->[$level] >>. The C<$level> is the level of the action in the chain that captured the parts of the path. An action that is part of a chain (that is, one that has a C<:Chained> attribute) but has no C<:CaptureArgs> attribute is treated by Catalyst as a chain end. 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) { } If you use a reference type constraint in CaptureArgs, it must be a type like Tuple in L that allows us to determine the number of args to match. Otherwise this will raise an error during startup. See L for more. =item Args By default, endpoints receive the rest of the arguments in the path. You can tell Catalyst through C<:Args> explicitly how many arguments your endpoint expects, just like you can with C<:CaptureArgs>. Note that this also affects whether this chain is invoked on a request. A chain with an endpoint specifying one argument will only match if exactly one argument exists in the path. You can specify an exact number of arguments like C<:Args(3)>, including C<0>. If you just say C<:Args> without any arguments, it is the same as leaving it out altogether: The chain is matched regardless of the number of path parts after the endpoint. Just as with C<:CaptureArgs>, the arguments get passed to the action in C<@_> after the context object. They can also be reached through C<< $c->request->arguments >>. You should see 'Args' in L for more details on using type constraints in your Args declarations. =back =head2 Auto actions, dispatching and forwarding Note that the list of C actions called depends on the private path of the endpoint of the chain, not on the chained actions way. The C actions will be run before the chain dispatching begins. In every other aspect, C actions behave as documented. The Cing to other actions does just what you would expect. i.e. only the target action is run. The actions that that action is chained to are not run. If you C out of a chain, the rest of the chain will not get called after the C. =head2 match_captures A method which can optionally be implemented by actions to stop chain matching. See L for further details. =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.90126/lib/Catalyst/DispatchType/Path.pm0000644000000000000000000000767213366373233023436 0ustar00rootwheel00000000000000package Catalyst::DispatchType::Path; use Moose; extends 'Catalyst::DispatchType'; use Text::SimpleTable; use Catalyst::Utils; use URI; use Encode 2.21 'decode_utf8'; has _paths => ( is => 'rw', isa => 'HashRef', required => 1, default => sub { +{} }, ); no Moose; =head1 NAME Catalyst::DispatchType::Path - Path DispatchType =head1 SYNOPSIS See L. =head1 DESCRIPTION Dispatch type managing full path matching behaviour. For more information on dispatch types, see: =over 4 =item * L for how they affect application authors =item * L for implementation information. =back =head1 METHODS =head2 $self->list($c) Debug output for Path dispatch points =cut sub list { my ( $self, $c ) = @_; my $avail_width = Catalyst::Utils::term_width() - 9; my $col1_width = ($avail_width * .50) < 35 ? 35 : int($avail_width * .50); my $col2_width = $avail_width - $col1_width; my $paths = Text::SimpleTable->new( [ $col1_width, 'Path' ], [ $col2_width, 'Private' ] ); foreach my $path ( sort keys %{ $self->_paths } ) { foreach my $action ( @{ $self->_paths->{$path} } ) { my $args = $action->number_of_args; my $parts = defined($args) ? '/*' x $args : '/...'; my $display_path = "/$path/$parts"; $display_path =~ s{/{1,}}{/}g; $display_path =~ s/%([0-9A-Fa-f]{2})/chr(hex($1))/eg; # deconvert urlencoded for pretty view $display_path = decode_utf8 $display_path; # URI does encoding $paths->row( $display_path, "/$action" ); } } $c->log->debug( "Loaded Path actions:\n" . $paths->draw . "\n" ) if ( keys %{ $self->_paths } ); } =head2 $self->match( $c, $path ) For each action registered to this exact path, offers the action a chance to match the path (in the order in which they were registered). Succeeds on the first action that matches, if any; if not, returns 0. =cut sub match { my ( $self, $c, $path ) = @_; $path = '/' if !defined $path || !length $path; my @actions = @{ $self->_paths->{$path} || [] }; foreach my $action ( @actions ) { next unless $action->match($c); $c->req->action($path); $c->req->match($path); $c->action($action); $c->namespace( $action->namespace ); return 1; } return 0; } =head2 $self->register( $c, $action ) Calls register_path for every Path attribute for the given $action. =cut sub register { my ( $self, $c, $action ) = @_; my @register = @{ $action->attributes->{Path} || [] }; $self->register_path( $c, $_, $action ) for @register; return 1 if @register; return 0; } =head2 $self->register_path($c, $path, $action) Registers an action at a given path. =cut sub register_path { my ( $self, $c, $path, $action ) = @_; $path =~ s!^/!!; $path = '/' unless length $path; $path = URI->new($path)->canonical; $path =~ s{(?<=[^/])/+\z}{}; $self->_paths->{$path} = [ sort { $a->compare($b) } ($action, @{ $self->_paths->{$path} || [] }) ]; return 1; } =head2 $self->uri_for_action($action, $captures) get a URI part for an action; always returns undef is $captures is set since Path actions don't have captures =cut sub uri_for_action { my ( $self, $action, $captures ) = @_; return undef if @$captures; if (my $paths = $action->attributes->{Path}) { my $path = $paths->[0]; $path = '/' unless length($path); $path = "/${path}" unless ($path =~ m/^\//); $path = URI->new($path)->canonical; return $path; } else { return undef; } } =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.90126/lib/Catalyst/EngineLoader.pm0000644000000000000000000001011313366373233022455 0ustar00rootwheel00000000000000package Catalyst::EngineLoader; use Moose; use Catalyst::Exception; use Catalyst::Utils; use namespace::clean -except => ['meta']; 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.90126/lib/Catalyst/ActionContainer.pm0000644000000000000000000000360412406561462023205 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst/PSGI.pod0000644000000000000000000000702212406561462021033 0ustar00rootwheel00000000000000=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.90126/lib/Catalyst/Engine/0000755000000000000000000000000013611202203020751 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Engine/HTTP.pm0000644000000000000000000000147412406561462022114 0ustar00rootwheel00000000000000package # Hide from PAUSE Catalyst::Engine::HTTP; use strict; use warnings; use base 'Catalyst::Engine'; warn("You are loading Catalyst::Engine::HTTP explicitly. This is almost certainly a bad idea, as Catalyst::Engine::HTTP has been removed in this version of Catalyst. Please update your application's scripts with: catalyst.pl -force -scripts MyApp to update your scripts to not do this.\n") unless $ENV{HARNESS_ACTIVE}; 1; __END__ =head1 NAME Catalyst::Engine::HTTP - removed module =head1 SYNOPSIS See L. =head1 DESCRIPTION This is here only as some old generated scripts require Catalyst::Engine::HTTP =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.90126/lib/Catalyst/Exception/0000755000000000000000000000000013611202203021502 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/lib/Catalyst/Exception/Interface.pm0000644000000000000000000000267713101634223023761 0ustar00rootwheel00000000000000package Catalyst::Exception::Interface; use Moose::Role; use if !eval { require Moose; Moose->VERSION('2.1300') }, 'MooseX::Role::WithOverloading'; use namespace::clean -except => 'meta'; use overload q{""} => sub { $_[0]->as_string }, fallback => 1; requires qw/as_string throw rethrow/; 1; __END__ =head1 NAME Catalyst::Exception::Interface - Role defining the interface for Catalyst exceptions =head1 SYNOPSIS package My::Catalyst::Like::Exception; use Moose; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Interface'; # This comprises the required interface. sub as_string { 'the exception text for stringification' } sub throw { shift; die @_ } sub rethrow { shift; die @_ } =head1 DESCRIPTION This is a role for the required interface for Catalyst exceptions. It ensures that all exceptions follow the expected interface, and adds overloading for stringification when composed onto a class. Note that if you compose this role onto another role, that role must use L. =head1 REQUIRED METHODS =head2 as_string =head2 throw =head2 rethrow =head1 METHODS =head2 meta Provided by Moose =head1 SEE ALSO =over 4 =item L =item L =back =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.90126/lib/Catalyst/Exception/Detach.pm0000644000000000000000000000144612406561462023255 0ustar00rootwheel00000000000000package Catalyst::Exception::Detach; use Moose; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Basic'; has '+message' => ( default => "catalyst_detach\n", ); __PACKAGE__->meta->make_immutable; 1; __END__ =head1 NAME Catalyst::Exception::Detach - Exception for redispatching using $ctx->detach() =head1 DESCRIPTION This is the class for the Catalyst Exception which is thrown then you call C<< $c->detach() >>. This class is not intended to be used directly by users. =head2 meta Provided by Moose =head1 SEE ALSO =over 4 =item L =item L =back =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.90126/lib/Catalyst/Exception/Basic.pm0000644000000000000000000000360113101634223023066 0ustar00rootwheel00000000000000package Catalyst::Exception::Basic; use Moose::Role; use if !eval { require Moose; Moose->VERSION('2.1300') }, 'MooseX::Role::WithOverloading'; use Carp; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Interface'; has message => ( is => 'ro', isa => 'Str', default => sub { $! || '' }, ); sub as_string { my ($self) = @_; return $self->message; } around BUILDARGS => sub { my ($next, $class, @args) = @_; if (@args == 1 && !ref $args[0]) { @args = (message => $args[0]); } my $args = $class->$next(@args); $args->{message} ||= $args->{error} if exists $args->{error}; return $args; }; sub throw { my $class = shift; my $error = $class->new(@_); local $Carp::CarpLevel = 1; croak $error; } sub rethrow { my ($self) = @_; croak $self; } 1; =head1 NAME Catalyst::Exception::Basic - Basic Catalyst Exception Role =head1 SYNOPSIS package My::Exception; use Moose; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Basic'; # Elsewhere.. My::Exception->throw( qq/Fatal exception/ ); See also L and L. =head1 DESCRIPTION This is the basic Catalyst Exception role which implements all of L. =head1 ATTRIBUTES =head2 message Holds the exception message. =head1 METHODS =head2 as_string Stringifies the exception's message attribute. Called when the object is stringified by overloading. =head2 throw( $message ) =head2 throw( message => $message ) =head2 throw( error => $error ) Throws a fatal exception. =head2 rethrow( $exception ) Rethrows a caught 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 Catalyst-Runtime-5.90126/lib/Catalyst/Exception/Go.pm0000644000000000000000000000142212406561462022424 0ustar00rootwheel00000000000000package Catalyst::Exception::Go; use Moose; use namespace::clean -except => 'meta'; with 'Catalyst::Exception::Basic'; has '+message' => ( default => "catalyst_go\n", ); __PACKAGE__->meta->make_immutable; 1; __END__ =head1 NAME Catalyst::Exception::Go - Exception for redispatching using $ctx->go() =head1 DESCRIPTION This is the class for the Catalyst Exception which is thrown then you call C<< $c->go() >>. This class is not intended to be used directly by users. =head2 meta Provided by Moose =head1 SEE ALSO =over 4 =item L =item L =back =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.90126/lib/Catalyst/Delta.pod0000755000000000000000000005131013366373233021327 0ustar00rootwheel00000000000000=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.90126/lib/Catalyst/Base.pm0000644000000000000000000000161212406561462020774 0ustar00rootwheel00000000000000package 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.90126/lib/Catalyst.pm0000644000000000000000000046421213611200142020113 0ustar00rootwheel00000000000000package 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::Util 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); }, predicate => 'has_request', 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); }, predicate=>'has_response', 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.90126'; $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. There is a predicate method C that returns true if the request object has been created. This is something you might need to check if you are writing plugins that run before a request is finalized. =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. There is a predicate method C that returns true if the request object has been created. This is something you might need to check if you are writing plugins that run before a request is finalized. =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 defined $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)) { $c->log->debug("captures [@{$captures}] do not match the type constraints in actionchain ending with '$expanded_action'") if $c->debug; return undef; } } $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)) { $c->log->debug("args [@args] do not match the type constraints in action '$expanded_action'") if $c->debug; return undef; } } } 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{(?{$_}; my $key = encode_utf8($_); # using the URI::Escape pattern here so utf8 chars survive $key =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $key =~ s/ /+/g; $val = '' unless defined $val; (map { my $param = encode_utf8($_); # using the URI::Escape pattern here so utf8 chars survive $param =~ s/([^A-Za-z0-9\-_.!~*'() ])/$URI::Escape::escapes{$1}/go; $param =~ s/ /+/g; "${key}=$param"; } ( ref $val eq 'ARRAY' ? @$val : $val )); } @keys); } $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 or C<< $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; $c->log_stats if $c->use_stats; return $c->response->status; } =head2 $c->log_stats Logs statistics. =cut sub log_stats { my $c = shift; 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" ); } =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} && $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 uses L. 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 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) = @_; require JSON::MaybeXS; my $slurped; return eval { local $/; $slurped = $fh->getline; JSON::MaybeXS::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 explicitly 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::MaybeXS; __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 chicks: Christopher Hicks Chisel Wright Danijel Milicevic davewood: David Schmidt David Kamholz David Naughton 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 Geoff Richards groditi: Guillermo Roditi hobbs: Andrew Rodland ilmari: Dagfinn Ilmari Mannsåker jcamacho: Juan Camacho jester: Jesse Sheidlower jhannah: Jay Hannah Jody Belka Johan Lindstrom jon: Jon Schutz Jonathan Rockway Kieren Diment 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 revmischa: Mischa Spiegelmock Robert Sedlacek rrwo: Robert Rothenberg SpiceMan: Marcel Montes sky: Arthur Bergman szbalint: Balint Szilakszi t0m: Tomas Doran Ulf Edvinsson vanstyn: Henry Van Styn Viljo Marrandi Will Hawes willert: Sebastian Willert wreis: Wallace Reis Yuval Kogman rainboxx: Matthias Dietrich 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.90126/Makefile.PL0000644000000000000000000002252713417640535017216 0ustar00rootwheel00000000000000use strict; use warnings; use 5.008003; my %META = ( name => 'Catalyst-Runtime', license => 'perl_5', prereqs => { configure => { requires => { 'ExtUtils::MakeMaker' => 0, } }, build => { requires => { } }, test => { requires => { 'Test::Fatal' => 0, 'Test::More' => '0.88', 'HTTP::Request::Common' => 0, 'HTTP::Status' => 0, }, }, runtime => { requires => { 'perl' => 5.008003, 'List::Util' => '1.45', 'namespace::clean' => '0.23', 'MooseX::Emulate::Class::Accessor::Fast' => '0.00903', 'Class::Load' => '0.12', 'Moose' => '1.03', 'MooseX::MethodAttributes::Role::AttrContainer::Inheritable' => '0.24', 'MooseX::Role::WithOverloading' => '0.09', 'Carp' => '1.25', 'Class::C3::Adopt::NEXT' => '0.07', 'CGI::Simple::Cookie' => '1.109', 'Data::Dump' => 0, 'Data::OptList' => 0, 'HTML::Entities' => 0, 'HTML::HeadParser' => 0, 'HTTP::Body' => '1.22', 'HTTP::Headers' => '1.64', 'HTTP::Request' => '5.814', 'HTTP::Response' => '5.813', 'Module::Pluggable' => '4.7', 'Path::Class' => '0.09', 'Scalar::Util' => 0, 'Sub::Exporter' => 0, 'Text::SimpleTable' => '0.03', 'Time::HiRes' => 0, 'Tree::Simple' => '1.15', 'Tree::Simple::Visitor::FindByUID' => 0, 'Try::Tiny' => '0.17', 'Safe::Isa' => 0, 'Socket' => '1.96', 'Task::Weaken' => 0, 'Text::Balanced' => 0, # core in 5.8.x but mentioned for completeness 'MRO::Compat' => 0, 'MooseX::Getopt' => '0.48', 'String::RewritePrefix' => '0.004', # Catalyst::Utils::resolve_namespace 'Devel::InnerPackage' => 0, # No longer core in blead 'Plack' => '0.9991', # IIS6+7 fix middleware 'Plack::Middleware::ReverseProxy' => '0.04', 'Plack::Test::ExternalServer' => 0, 'Encode' => '2.49', 'LWP' => '5.837', # LWP had unicode fail in 5.8.26 'URI' => '1.65', 'URI::ws' => '0.03', 'JSON::MaybeXS' => '1.000000', 'Stream::Buffered' => 0, 'Hash::MultiValue' => 0, 'Plack::Request::Upload' => 0, 'CGI::Struct' => 0, "Plack::Middleware::Conditional" => 0, "Plack::Middleware::IIS6ScriptNameFix" => 0, "Plack::Middleware::IIS7KeepAliveFix" => 0, "Plack::Middleware::LighttpdScriptNameFix" => 0, "Plack::Middleware::ContentLength" => 0, "Plack::Middleware::Head" => 0, "Plack::Middleware::HTTPExceptions" => 0, "Plack::Middleware::FixMissingBodyInRedirect" => '0.09', "Plack::Middleware::MethodOverride" => '0.12', "Plack::Middleware::RemoveRedundantBody" => '0.03', 'PerlIO::utf8_strict' => 0, }, }, develop => { requires => { 'CatalystX::LeakChecker' => '0.05', 'Catalyst::Devel' => '1.0', # For http server test 'Test::WWW::Mechanize::Catalyst' => '0.51', 'Test::TCP' => '2.00', # ditto, ships Net::EmptyPort 'File::Copy::Recursive' => '0.40', 'Starman' => 0, 'MooseX::Daemonize' => 0, 'Test::NoTabs' => 0, 'Test::Pod' => 0, 'Test::Pod::Coverage' => 0, 'Test::Spelling' => 0, 'Pod::Coverage::TrustPod' => 0, 'Catalyst::Plugin::Params::Nested' => 0, 'Catalyst::Plugin::ConfigLoader' => 0, 'Compress::Zlib' => 0, 'Catalyst::Action::REST' => 0, 'Type::Tiny' => 0, 'Proc::ProcessTable' => 0, }, }, }, resources => { repository => { # r/w: catagits@git.shadowcat.co.uk:Catalyst-Runtime.git url => 'git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git', web => 'http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=summary', type => 'git', }, x_IRC => 'irc://irc.perl.org/#catalyst', bugtracker => { web => 'https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Runtime', mailto => 'bug-Catalyst-Runtime@rt.cpan.org', }, license => [ 'http://dev.perl.org/licenses/' ], x_MailingList => 'http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst', homepage => 'http://dev.catalyst.perl.org/', }, no_index => { directory => [ 't', 'xt' ] }, x_breaks => { 'Catalyst::Plugin::SubRequest' => '<= 0.14', 'Catalyst::Model::Akismet' => '<= 0.02', 'Catalyst::Component::ACCEPT_CONTEXT' => '<= 0.06', 'Catalyst::Plugin::ENV' => 0, # 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. }, x_authority => 'cpan:MSTROUT', ); my $tests = 't/*.t t/aggregate/*.t'; my %MM_ARGS = ( test => { TESTS => $tests }, EXE_FILES => [ glob 'script/*.pl' ], PREREQ_PM => { (eval { require Moose; Moose->VERSION('2.1300') } ? () : ( 'MooseX::Role::WithOverloading' => '0.09' )), }, ); ## BOILERPLATE ############################################################### require ExtUtils::MakeMaker; (do './maint/Makefile.PL.include' or die $@) unless -f 'META.yml'; # have to do this since old EUMM dev releases miss the eval $VERSION line my $eumm_version = eval $ExtUtils::MakeMaker::VERSION; my $mymeta = $eumm_version >= 6.57_02; my $mymeta_broken = $mymeta && $eumm_version < 6.57_07; ($MM_ARGS{NAME} = $META{name}) =~ s/-/::/g; ($MM_ARGS{VERSION_FROM} = "lib/$MM_ARGS{NAME}.pm") =~ s{::}{/}g; $META{license} = [ $META{license} ] if $META{license} && !ref $META{license}; $MM_ARGS{LICENSE} = $META{license}[0] if $META{license} && $eumm_version >= 6.30; $MM_ARGS{NO_MYMETA} = 1 if $mymeta_broken; $MM_ARGS{META_ADD} = { 'meta-spec' => { version => 2 }, %META } unless -f 'META.yml'; for (qw(configure build test runtime)) { my $key = $_ eq 'runtime' ? 'PREREQ_PM' : uc $_.'_REQUIRES'; my $r = $MM_ARGS{$key} = { %{$META{prereqs}{$_}{requires} || {}}, %{delete $MM_ARGS{$key} || {}}, }; defined $r->{$_} or delete $r->{$_} for keys %$r; } $MM_ARGS{MIN_PERL_VERSION} = delete $MM_ARGS{PREREQ_PM}{perl} || 0; delete $MM_ARGS{MIN_PERL_VERSION} if $eumm_version < 6.47_01; $MM_ARGS{BUILD_REQUIRES} = {%{$MM_ARGS{BUILD_REQUIRES}}, %{delete $MM_ARGS{TEST_REQUIRES}}} if $eumm_version < 6.63_03; $MM_ARGS{PREREQ_PM} = {%{$MM_ARGS{PREREQ_PM}}, %{delete $MM_ARGS{BUILD_REQUIRES}}} if $eumm_version < 6.55_01; delete $MM_ARGS{CONFIGURE_REQUIRES} if $eumm_version < 6.51_03; ExtUtils::MakeMaker::WriteMakefile(%MM_ARGS); ## END BOILERPLATE ########################################################### 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 -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 Catalyst-Runtime-5.90126/maint/0000755000000000000000000000000013611202201016320 5ustar00rootwheel00000000000000Catalyst-Runtime-5.90126/maint/Makefile.PL.include0000644000000000000000000000162013366373233021740 0ustar00rootwheel00000000000000BEGIN { -e 'Distar' or system("git clone git://git.shadowcat.co.uk/p5sagit/Distar.git") } use lib 'Distar/lib'; use Distar 0.001; author 'Sebastian Riedel '; manifest_include script => 'catalyst.pl'; manifest_include t => 'catalyst_130pix.gif'; manifest_include 't/conf' => 'extra.conf.in'; manifest_include 't/lib/TestAppEncodingSetInConfig' => 'testappencodingsetinconfig.json'; manifest_include 't/lib/TestContentNegotiation/share', 'file.txt'; manifest_include 't/lib/TestMiddleware/share' => qr/.*/; manifest_include 't/lib/TestMiddlewareFromConfig/share' => qr/.*/; manifest_include 't/lib/TestMiddlewareFromConfig' => 'testmiddlewarefromconfig.pl'; manifest_include t => qr/optional_apache-.*\.pl/; manifest_include t => 'optional_stress.json'; manifest_include t => 'something/Makefile.PL'; manifest_include t => 'something/script/foo/bar/for_dist'; manifest_include t => 'utf8.txt'; 1; Catalyst-Runtime-5.90126/META.json0000644000000000000000000001442313611202205016641 0ustar00rootwheel00000000000000{ "abstract" : "The Catalyst Framework Runtime", "author" : [ "Sebastian Riedel " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.36, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Catalyst-Runtime", "no_index" : { "directory" : [ "t", "xt" ] }, "prereqs" : { "build" : { "requires" : {} }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "develop" : { "requires" : { "Catalyst::Action::REST" : "0", "Catalyst::Devel" : "1.0", "Catalyst::Plugin::ConfigLoader" : "0", "Catalyst::Plugin::Params::Nested" : "0", "CatalystX::LeakChecker" : "0.05", "Compress::Zlib" : "0", "File::Copy::Recursive" : "0.40", "MooseX::Daemonize" : "0", "Pod::Coverage::TrustPod" : "0", "Proc::ProcessTable" : "0", "Starman" : "0", "Test::NoTabs" : "0", "Test::Pod" : "0", "Test::Pod::Coverage" : "0", "Test::Spelling" : "0", "Test::TCP" : "2.00", "Test::WWW::Mechanize::Catalyst" : "0.51", "Type::Tiny" : "0" } }, "runtime" : { "requires" : { "CGI::Simple::Cookie" : "1.109", "CGI::Struct" : "0", "Carp" : "1.25", "Class::C3::Adopt::NEXT" : "0.07", "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::Response" : "5.813", "Hash::MultiValue" : "0", "JSON::MaybeXS" : "1.000000", "LWP" : "5.837", "List::Util" : "1.45", "MRO::Compat" : "0", "Module::Pluggable" : "4.7", "Moose" : "1.03", "MooseX::Emulate::Class::Accessor::Fast" : "0.00903", "MooseX::Getopt" : "0.48", "MooseX::MethodAttributes::Role::AttrContainer::Inheritable" : "0.24", "MooseX::Role::WithOverloading" : "0.09", "Path::Class" : "0.09", "PerlIO::utf8_strict" : "0", "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", "Socket" : "1.96", "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::FindByUID" : "0", "Try::Tiny" : "0.17", "URI" : "1.65", "URI::ws" : "0.03", "namespace::clean" : "0.23", "perl" : "5.008003" } }, "test" : { "requires" : { "HTTP::Request::Common" : "0", "HTTP::Status" : "0", "Test::Fatal" : "0", "Test::More" : "0.88" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "mailto" : "bug-Catalyst-Runtime@rt.cpan.org", "web" : "https://rt.cpan.org/Public/Dist/Display.html?Name=Catalyst-Runtime" }, "homepage" : "http://dev.catalyst.perl.org/", "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "git://git.shadowcat.co.uk/catagits/Catalyst-Runtime.git", "web" : "http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits/Catalyst-Runtime.git;a=summary" }, "x_IRC" : "irc://irc.perl.org/#catalyst", "x_MailingList" : "http://lists.scsys.co.uk/cgi-bin/mailman/listinfo/catalyst" }, "version" : "5.90126", "x_authority" : "cpan:MSTROUT", "x_breaks" : { "Catalyst::Action::REST" : "<= 0.67", "Catalyst::Action::RenderView" : "<= 0.07", "Catalyst::Authentication::Credential::HTTP" : "<= 1.009", "Catalyst::Component::ACCEPT_CONTEXT" : "<= 0.06", "Catalyst::Controller::AllowDisable" : "<= 0.03", "Catalyst::Devel" : "<= 1.19", "Catalyst::Model::Akismet" : "<= 0.02", "Catalyst::Plugin::Authentication" : "<= 0.100091", "Catalyst::Plugin::ConfigLoader" : "<= 0.22", "Catalyst::Plugin::DebugCookie" : "<= 0.999002", "Catalyst::Plugin::ENV" : 0, "Catalyst::Plugin::HashedCookies" : "<= 1.03", "Catalyst::Plugin::Session" : "<= 0.21", "Catalyst::Plugin::Session::State::Cookie" : "<= 0.10", "Catalyst::Plugin::Session::Store::FastMmap" : "<= 0.09", "Catalyst::Plugin::Session::Store::File" : "<= 0.16", "Catalyst::Plugin::SmartURI" : "<= 0.032", "Catalyst::Plugin::SubRequest" : "<= 0.14", "Catalyst::Plugin::Unicode::Encoding" : "<= 0.2", "Catalyst::Plugin::Upload::Image::Magick" : "<= 0.03", "Catalyst::View::Mason" : "<= 0.17", "CatalystX::CRUD" : "<= 0.42", "CatalystX::CRUD::Model::RDBO" : "<= 0.20", "CatalystX::Imports" : "<= 0.03", "Reaction" : "<= 0.001999", "Test::WWW::Mechanize::Catalyst" : "<= 0.53" }, "x_serialization_backend" : "JSON::PP version 2.97001" }