[Catalyst-commits] r8371 - in
Catalyst-Runtime/5.80/branches/context_go: . lib lib/Catalyst
lib/Catalyst/DispatchType lib/Catalyst/Engine
lib/Catalyst/Engine/HTTP lib/Catalyst/Engine/HTTP/Restarter
lib/Catalyst/Request script t t/conf t/lib
t/lib/Catalyst/Plugin/Test t/lib/TestApp/Controller
t/lib/TestApp/Controller/Action
t/lib/TestApp/Controller/Action/Chained
t/lib/TestApp/Controller/Action/Chained/ParentChain
t/lib/TestApp/Controller/Engine/Request
t/lib/TestApp/Controller/Engine/Response t/lib/TestApp/Model
t/something t/something/script t/something/script/foo
t/something/script/foo/bar
marcus at dev.catalyst.perl.org
marcus at dev.catalyst.perl.org
Tue Sep 9 00:24:29 BST 2008
Author: marcus
Date: 2008-09-09 00:24:28 +0100 (Tue, 09 Sep 2008)
New Revision: 8371
Added:
Catalyst-Runtime/5.80/branches/context_go/TODO
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ClassData.pm
Catalyst-Runtime/5.80/branches/context_go/t/custom_live_path_bug.t
Catalyst-Runtime/5.80/branches/context_go/t/dead_load_multiple_chained_attributes.t
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain/
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/ForwardTo.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Response/Print.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppPathBug.pm
Catalyst-Runtime/5.80/branches/context_go/t/live_catalyst_test.t
Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_auth.t
Catalyst-Runtime/5.80/branches/context_go/t/live_engine_response_print.t
Catalyst-Runtime/5.80/branches/context_go/t/something/
Catalyst-Runtime/5.80/branches/context_go/t/something/Makefile.PL
Catalyst-Runtime/5.80/branches/context_go/t/something/script/
Catalyst-Runtime/5.80/branches/context_go/t/something/script/foo/
Catalyst-Runtime/5.80/branches/context_go/t/something/script/foo/bar/
Catalyst-Runtime/5.80/branches/context_go/t/something/script/foo/bar/for_dist
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_classdata.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_mro.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_utils_subdir.t
Removed:
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Build.pm
Catalyst-Runtime/5.80/branches/context_go/t/04critic.rc
Modified:
Catalyst-Runtime/5.80/branches/context_go/
Catalyst-Runtime/5.80/branches/context_go/Changes
Catalyst-Runtime/5.80/branches/context_go/Makefile.PL
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Action.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionChain.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionContainer.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/AttrContainer.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Base.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Component.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Controller.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Chained.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Default.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Index.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Path.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Regex.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/CGI.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/FastCGI.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Exception.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Log.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Manual.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Model.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ROADMAP.pod
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request/Upload.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Response.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Runtime.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Stats.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Test.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Utils.pm
Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/View.pm
Catalyst-Runtime/5.80/branches/context_go/script/catalyst.pl
Catalyst-Runtime/5.80/branches/context_go/t/03podcoverage.t
Catalyst-Runtime/5.80/branches/context_go/t/04critic.t
Catalyst-Runtime/5.80/branches/context_go/t/c3_mro.t
Catalyst-Runtime/5.80/branches/context_go/t/conf/extra.conf.in
Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Errors.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Headers.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Plugin.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Forward.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Args.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Request/URI.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Root.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Model/Foo.pm
Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppDoubleAutoBug.pm
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_chained.t
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_forward.t
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_path.t
Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_regexp.t
Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_parameters.t
Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uploads.t
Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uri.t
Catalyst-Runtime/5.80/branches/context_go/t/live_priorities.t
Catalyst-Runtime/5.80/branches/context_go/t/live_stats.t
Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server-restart.t
Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_action_for.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_layers.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_loading.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_mvc.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_core_uri_for.t
Catalyst-Runtime/5.80/branches/context_go/t/unit_stats.t
Log:
r19765 at Command-Central (orig r7584): matthewt | 2008-04-07 15:47:07 +0200
r17518 at agaton (orig r7490): andyg | 2008-03-12 16:09:16 +0000
Add a test and update docs on how to pass-through the Authorization header under Apache mod_fastcgi/mod_cgi
r17803 at agaton (orig r7560): andyg | 2008-04-04 17:08:19 +0100
Patch from Ton Voon to fix bug in HTTP engine where the connection was not closed properly if the client disconnected before sending any headers
r17804 at agaton (orig r7561): andyg | 2008-04-04 17:09:50 +0100
Gah, breaking my own line-length rules
r17819 at agaton (orig r7576): marcus | 2008-04-06 20:42:48 +0100
Patch to fix homefinding for scripts in deep subdirs
r21370 at Command-Central (orig r7947): groditi | 2008-06-23 22:58:04 +0200
r16884 at martha (orig r7477): konobi | 2008-03-11 01:25:42 -0400
Initial commit of Moosified Catalyst parts.
r21371 at Command-Central (orig r7948): groditi | 2008-06-23 22:58:14 +0200
r16970 at martha (orig r7493): groditi | 2008-03-14 18:01:52 -0400
DispatchType stripped of CAF, SUPER and substituted instances of $self->{*} with attributes.
r21372 at Command-Central (orig r7949): groditi | 2008-06-23 22:58:23 +0200
r16971 at martha (orig r7494): groditi | 2008-03-14 18:06:17 -0400
change dispatcher to load classes using Class::MOP::load_class
r21373 at Command-Central (orig r7950): groditi | 2008-06-23 22:58:30 +0200
r16972 at martha (orig r7495): groditi | 2008-03-14 18:25:44 -0400
AttrContainer and additional dep for it
r21374 at Command-Central (orig r7951): groditi | 2008-06-23 22:58:37 +0200
r16973 at martha (orig r7496): groditi | 2008-03-14 19:05:15 -0400
incomplete conversion of Component. i dont grok the next bitand some weird config bit
r21375 at Command-Central (orig r7952): groditi | 2008-06-23 22:58:43 +0200
r16974 at martha (orig r7497): groditi | 2008-03-14 19:33:13 -0400
typo
r21376 at Command-Central (orig r7953): groditi | 2008-06-23 22:58:50 +0200
r16975 at martha (orig r7498): konobi | 2008-03-14 21:58:53 -0400
Add Catalyst::Exception and Catalyst::Log to the Moosified bunch.
r21377 at Command-Central (orig r7954): groditi | 2008-06-23 22:58:57 +0200
r16976 at martha (orig r7499): konobi | 2008-03-14 22:20:06 -0400
Fixup some pre-(make test) typos.
r21378 at Command-Central (orig r7955): groditi | 2008-06-23 22:59:07 +0200
r16977 at martha (orig r7500): groditi | 2008-03-14 23:20:10 -0400
committing broken version. rolling back in a min. just making sure this gets saved somewhere
r21379 at Command-Central (orig r7956): groditi | 2008-06-23 22:59:23 +0200
r16978 at martha (orig r7501): groditi | 2008-03-15 00:42:23 -0400
reverting back to when tests pass. applying changes one by one to find what failed
r21380 at Command-Central (orig r7957): groditi | 2008-06-23 22:59:30 +0200
r16979 at martha (orig r7502): groditi | 2008-03-15 00:51:02 -0400
Path done
r21381 at Command-Central (orig r7958): groditi | 2008-06-23 22:59:36 +0200
r16980 at martha (orig r7503): groditi | 2008-03-15 01:03:50 -0400
add chained to the list of successful conversions :)
r21382 at Command-Central (orig r7959): groditi | 2008-06-23 22:59:43 +0200
r16981 at martha (orig r7504): groditi | 2008-03-15 01:08:08 -0400
load classes with Class::MOP::load_class
r21383 at Command-Central (orig r7960): groditi | 2008-06-23 22:59:49 +0200
r16982 at martha (orig r7505): groditi | 2008-03-15 01:12:50 -0400
AttrContainer no longer ISA C::D::I but still uses it until I figure what to do about ClassAttribute things
r21384 at Command-Central (orig r7961): groditi | 2008-06-23 22:59:56 +0200
r16983 at martha (orig r7506): groditi | 2008-03-15 01:21:42 -0400
reapplying changes by konobi that I accidentally undid earlier. sorry about that
r21385 at Command-Central (orig r7962): groditi | 2008-06-23 23:00:04 +0200
r16998 at martha (orig r7511): groditi | 2008-03-17 15:41:17 -0400
some tests fail and some things are ugly, but i think its a small step forward
r21386 at Command-Central (orig r7963): groditi | 2008-06-23 23:00:11 +0200
r17008 at martha (orig r7521): marcus | 2008-03-25 15:11:29 -0400
Overload to stringify correctly
r21387 at Command-Central (orig r7964): groditi | 2008-06-23 23:00:19 +0200
r17009 at martha (orig r7522): groditi | 2008-03-25 18:36:01 -0400
passing a lot more tests. still alot of work to be done. extends keyword dies on Controller.pm need to get rid of NEXT and convert a lot of the syntax over for clarity. i think the controller path / namespace changes pass the tests, but i do not trust them to be DTRT. need to investigate further.
r21388 at Command-Central (orig r7965): groditi | 2008-06-23 23:00:25 +0200
r17010 at martha (orig r7523): groditi | 2008-03-25 19:06:21 -0400
a couple more details
r21389 at Command-Central (orig r7966): groditi | 2008-06-23 23:00:36 +0200
r17012 at martha (orig r7524): groditi | 2008-03-25 20:45:31 -0400
some more comments and little changes as well as some notes. test output still the same. aplogizing if this breaks something, my SVK is acting really strange
r21390 at Command-Central (orig r7967): groditi | 2008-06-23 23:00:42 +0200
r17014 at martha (orig r7526): marcus | 2008-03-26 15:55:25 -0400
Show failure
r21391 at Command-Central (orig r7968): groditi | 2008-06-23 23:00:47 +0200
r17015 at martha (orig r7527): matthewt | 2008-03-26 16:32:10 -0400
fix MRO
r21392 at Command-Central (orig r7969): groditi | 2008-06-23 23:00:54 +0200
r17016 at martha (orig r7528): matthewt | 2008-03-26 16:46:06 -0400
restore ensure_class_loaded since Class::MOP::load_class doesn't have a force load flag
r21393 at Command-Central (orig r7970): groditi | 2008-06-23 23:01:01 +0200
r17017 at martha (orig r7529): groditi | 2008-03-26 18:49:54 -0400
code improvements in Catalyst::Controller
r21394 at Command-Central (orig r7971): groditi | 2008-06-23 23:01:08 +0200
r17018 at martha (orig r7530): groditi | 2008-03-26 19:42:35 -0400
little things in Catalyst.pm
r21395 at Command-Central (orig r7972): groditi | 2008-06-23 23:17:23 +0200
r17077 at martha (orig r7534): groditi | 2008-03-29 20:51:46 -0400
converting the engines. i had to add use NEXT to some of the test files to make it work. hope thats not a bad thing
r21396 at Command-Central (orig r7973): groditi | 2008-06-23 23:17:40 +0200
r17131 at martha (orig r7537): groditi | 2008-03-31 19:54:34 -0400
enabling immutable finishing porting Log and stats
r21397 at Command-Central (orig r7974): groditi | 2008-06-23 23:17:48 +0200
r21398 at Command-Central (orig r7975): groditi | 2008-06-23 23:18:09 +0200
r17535 at martha (orig r7626): matthewt | 2008-04-22 15:59:49 -0400
reverting (most of) the whitespace changes
r21399 at Command-Central (orig r7976): groditi | 2008-06-23 23:18:19 +0200
r17536 at martha (orig r7627): matthewt | 2008-04-22 16:46:12 -0400
eliminate usage of each() on hashes we don't own, since we can't guarantee the iterator position's been reset so it's a bug waiting to happen
r21400 at Command-Central (orig r7977): groditi | 2008-06-23 23:18:28 +0200
r17650 at martha (orig r7671): groditi | 2008-05-03 15:33:51 -0400
whitespace changes for attributes
r21401 at Command-Central (orig r7978): groditi | 2008-06-23 23:18:34 +0200
r17787 at martha (orig r7718): konobi | 2008-05-07 21:40:12 -0400
Remove redundant and erroneous perl 5.8.1 "requires" line.
r21402 at Command-Central (orig r7979): groditi | 2008-06-23 23:18:49 +0200
r17794 at martha (orig r7725): konobi | 2008-05-08 14:42:41 -0400
* Updated Catalyst::Request and Catalyst::Response to have sensible defaults for attributes
* Updated Catalyst.pm to reflect sensible defaults
* Worked through some TODO items added by groditi
* Fixed up a test that was testing against object internals rather than accessors
r21403 at Command-Central (orig r7980): groditi | 2008-06-23 23:18:56 +0200
r17795 at martha (orig r7726): konobi | 2008-05-08 15:10:48 -0400
Fix tests that were testing object internals instead of accessors.
r21404 at Command-Central (orig r7981): groditi | 2008-06-23 23:19:18 +0200
r17830 at martha (orig r7761): groditi | 2008-05-17 17:52:33 -0400
start using Class::C3, may need to add a reinitalize bit later, not sure
r21405 at Command-Central (orig r7982): groditi | 2008-06-23 23:19:24 +0200
r17833 at martha (orig r7764): konobi | 2008-05-19 19:32:41 -0400
Update dispatcher attributes to have sane defaults.
r21406 at Command-Central (orig r7983): groditi | 2008-06-23 23:19:36 +0200
r17834 at martha (orig r7765): konobi | 2008-05-20 04:11:55 -0400
Remove use of overload
* Fixup some tests
* Fixup some areas of code
r21407 at Command-Central (orig r7984): groditi | 2008-06-23 23:19:43 +0200
r17835 at martha (orig r7766): groditi | 2008-05-20 16:10:51 -0400
making $app be an instance, less symbol table hijacking, cache path_prefix and action_namespace
r21408 at Command-Central (orig r7985): groditi | 2008-06-23 23:20:05 +0200
r17838 at martha (orig r7769): groditi | 2008-05-21 11:23:23 -0400
mro compat stuff
r21409 at Command-Central (orig r7986): groditi | 2008-06-23 23:20:13 +0200
r18298 at martha (orig r7826): groditi | 2008-05-27 21:42:55 -0400
revert MyApp instantiation
r21410 at Command-Central (orig r7987): groditi | 2008-06-23 23:20:34 +0200
r18299 at martha (orig r7827): groditi | 2008-05-27 22:42:31 -0400
bye bye Class::C3. for good.
r21411 at Command-Central (orig r7988): groditi | 2008-06-23 23:20:41 +0200
r18399 at martha (orig r7893): groditi | 2008-06-04 12:15:25 -0400
backcompat for NEXT in &COMPONENT + test
r21412 at Command-Central (orig r7989): groditi | 2008-06-23 23:20:47 +0200
r18425 at martha (orig r7903): groditi | 2008-06-09 14:46:29 -0400
broken classdata version
r21413 at Command-Central (orig r7990): groditi | 2008-06-23 23:20:54 +0200
r18426 at martha (orig r7904): groditi | 2008-06-09 16:00:14 -0400
still failing some tests. waiting for suggestions on whether to fix old CDIretardedness
r21414 at Command-Central (orig r7991): groditi | 2008-06-23 23:21:04 +0200
r18428 at martha (orig r7906): groditi | 2008-06-09 18:37:44 -0400
config wins, groditi loses. FUCK YOU FOR SUPPORTING THAT STUPID BEHAVIOR
r21415 at Command-Central (orig r7992): groditi | 2008-06-23 23:21:10 +0200
r18429 at martha (orig r7907): matthewt | 2008-06-10 12:24:55 -0400
switch from add_package_symbol for the sake of immutable
r21416 at Command-Central (orig r7993): groditi | 2008-06-23 23:21:16 +0200
r18430 at martha (orig r7908): matthewt | 2008-06-10 12:55:37 -0400
put config() back to old code but with a new copy-up test
r21417 at Command-Central (orig r7994): groditi | 2008-06-23 23:21:21 +0200
r18589 at martha (orig r7911): groditi | 2008-06-12 12:43:58 -0400
make class data unlock and relock classes if immutable
r21500 at Command-Central (orig r8009): marcus | 2008-06-26 18:30:56 +0200
Add stringify back for action, and test
r21856 at Command-Central (orig r8149): dandv | 2008-07-22 23:26:55 +0200
Added warnign that path_to() should be called after MyApp->setup, which sets $c->config->{home}
r21860 at Command-Central (orig r8151): dandv | 2008-07-23 12:56:29 +0200
Undoing my commit since the issue had been fixed in Catalyst::Devel 1.08 (#37869)
r22105 at Command-Central (orig r8166): t0m | 2008-07-28 22:39:00 +0200
Commit a failing test for components getting config from self. This is a showstopper regression IMO, so it is not TODO. Change around new to BUILDARGS in C::Component
r22501 at Command-Central (orig r8170): t0m | 2008-07-30 19:05:38 +0200
Bump version requirement for MX::Emulate::CAF to the new release which fixes the issues with immutable/around new/inheritance by avoiding the issue alltogether.
r26467 at Command-Central (orig r8320): matthewt | 2008-09-01 15:06:33 +0200
r18460 at agaton (orig r7637): zarquon | 2008-04-28 09:22:19 +0100
r12983 at zaphod: kd | 2008-04-28 18:10:27 +1000
lighttpd non-root doc fix
r18802 at agaton (orig r7710): bricas | 2008-05-07 14:05:16 +0100
POD: IO::FileHandle => IO::Handle (RT #35690)
r18803 at agaton (orig r7711): bricas | 2008-05-07 14:23:04 +0100
Fix grammar on welcome page (RT #33236)
r18806 at agaton (orig r7714): bricas | 2008-05-07 18:42:22 +0100
Fix for Path('0') handling (RT #29334)
r18807 at agaton (orig r7715): bricas | 2008-05-07 20:23:05 +0100
fix path tests for win32 compat
r18808 at agaton (orig r7716): bricas | 2008-05-07 21:10:08 +0100
Workaround for Win32 and c3_mro.t (RT #26452, tested by Kenichi Ishigaki)
r18823 at agaton (orig r7731): marcus | 2008-05-09 18:04:23 +0100
query param encoding patch
r18824 at agaton (orig r7732): bricas | 2008-05-09 19:47:05 +0100
adding RT ticket #
r18828 at agaton (orig r7736): marcus | 2008-05-11 10:08:43 +0100
test for multiple chained attrs
r18883 at agaton (orig r7748): bricas | 2008-05-14 14:42:12 +0100
just use perl_version() to specify the min. required version of perl
r18884 at agaton (orig r7749): bricas | 2008-05-14 14:42:50 +0100
Provide backwards compatability methods in Catalyst::Stats
r19082 at agaton (orig r7758): marcus | 2008-05-16 19:16:16 +0100
Prepare for release
r19100 at agaton (orig r7776): bricas | 2008-05-23 15:54:22 +0100
Fix regression for relative uri_for arguments after a forward() introduced in 5.7013 (Peter Karman)
r19101 at agaton (orig r7777): bricas | 2008-05-23 15:58:07 +0100
missing file
r19102 at agaton (orig r7778): bricas | 2008-05-23 17:54:30 +0100
Fix regression for "sub foo : Path {}" in the root controller which was introduced when attempting to allow "0" as a Path.
r19106 at agaton (orig r7782): zarquon | 2008-05-23 23:55:26 +0100
r13155 at zaphod: kd | 2008-05-23 19:31:34 +1000
more yaml expurgation
r19108 at agaton (orig r7784): zarquon | 2008-05-23 23:57:59 +0100
r13167 at zaphod: kd | 2008-05-24 08:57:42 +1000
fixing up some merge fun
r19115 at agaton (orig r7790): marcus | 2008-05-25 16:44:47 +0100
Fixed changes
r19119 at agaton (orig r7794): bricas | 2008-05-26 02:28:49 +0100
tidy up Changes a wee bit.
r19207 at agaton (orig r7809): bricas | 2008-05-27 01:40:53 +0100
Get some of the optional_* tests working from dirs with spaces (RT #26455)
r19208 at agaton (orig r7810): bricas | 2008-05-27 02:43:13 +0100
fix up test to match release.
r19209 at agaton (orig r7811): bricas | 2008-05-27 03:42:11 +0100
Fix Catalyst::Utils::home() when application .pm is in the current dir (RT #34437)
r19473 at agaton (orig r7857): bricas | 2008-05-29 14:01:03 +0100
Added the ability to remove parameters in req->uri_with() by passing in an undef value (RT #34782)
r20113 at agaton (orig r7936): bricas | 2008-06-20 19:14:11 +0100
remove a confusing and duplicate bit of documentation
r20115 at agaton (orig r7938): bricas | 2008-06-23 14:38:24 +0100
Fix for LocalRegex when used in the Root controller
r20172 at agaton (orig r7995): bricas | 2008-06-23 23:01:06 +0100
Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)
r20173 at agaton (orig r7996): bricas | 2008-06-24 01:14:21 +0100
remove 0-length query string components so warnings aren't thrown (RT #36428)
r20226 at agaton (orig r8000): marcus | 2008-06-25 20:08:09 +0100
merge compres branch
r20228 at agaton (orig r8002): marcus | 2008-06-25 21:16:15 +0100
merge go branch.
r20229 at agaton (orig r8003): marcus | 2008-06-25 21:38:36 +0100
Prepare for 5.7099_01
r20232 at agaton (orig r8006): marcus | 2008-06-26 07:48:13 +0100
Add go to changes
r20237 at agaton (orig r8011): marcus | 2008-06-27 10:19:04 +0100
Fix warning for dev versions
r20281 at agaton (orig r8012): bricas | 2008-06-27 13:06:54 +0100
rescue :PathPrefix from an old branch
r20374 at agaton (orig r8053): bricas | 2008-06-30 13:19:10 +0100
nuked Catalyst::Build
r20375 at agaton (orig r8054): bricas | 2008-06-30 15:58:05 +0100
authors cleanup
r20378 at agaton (orig r8057): bricas | 2008-06-30 17:25:16 +0100
missed one
r20710 at agaton (orig r8106): t0m | 2008-07-12 13:02:32 +0100
Clarify inner package behavior of companent instantation in the POD. (no 1 of 2 doc patches I promised mst)
r20718 at agaton (orig r8114): bricas | 2008-07-14 19:20:11 +0100
Updated Catalyst::Test docs to mention the use of HTTP::Request objects (Rafael Kitover)
r20835 at agaton (orig r8124): marcus | 2008-07-16 18:13:20 +0100
Prepare 5.7100
r20836 at agaton (orig r8125): bricas | 2008-07-16 18:23:53 +0100
removing some Dumpers
r20837 at agaton (orig r8126): marcus | 2008-07-16 18:32:35 +0100
prepare for devel release
r20839 at agaton (orig r8128): bricas | 2008-07-17 01:37:48 +0100
doc typo fix (rafl)
r20845 at agaton (orig r8134): bricas | 2008-07-17 16:33:07 +0100
tiny doc update
r20846 at agaton (orig r8135): bricas | 2008-07-18 01:01:14 +0100
Fix regression for regexp fallback in model(), view() and controller()
r20847 at agaton (orig r8136): bricas | 2008-07-18 02:21:07 +0100
more fixes to regexp fallback, ugh.
r20858 at agaton (orig r8138): bricas | 2008-07-18 12:23:28 +0100
Added the supplied argument to the regexp fallback warning for easier debugging
r20860 at agaton (orig r8140): bricas | 2008-07-18 13:29:44 +0100
Ensure ACCEPT_CONTEXT is called for results from component()
r20861 at agaton (orig r8141): bricas | 2008-07-18 14:20:02 +0100
add a test for ACCEPT_CONTEXT from regex fallback in view()
r21095 at agaton (orig r8143): marcus | 2008-07-20 09:11:37 +0100
Prepare for _03 dev release
r21101 at agaton (orig r8149): dandv | 2008-07-22 22:26:55 +0100
Added warnign that path_to() should be called after MyApp->setup, which sets $c->config->{home}
r21103 at agaton (orig r8151): dandv | 2008-07-23 11:56:29 +0100
Undoing my commit since the issue had been fixed in Catalyst::Devel 1.08 (#37869)
r21113 at agaton (orig r8161): marcus | 2008-07-25 07:56:31 +0100
Add chained go tests
r21254 at agaton (orig r8175): ash | 2008-08-01 17:58:25 +0100
TODO tests added for :ChainedParent and :Chained('../action') atrs
r21391 at agaton (orig r8185): castaway | 2008-08-05 21:21:25 +0100
Switch syntax example for model to use create=static
r21400 at agaton (orig r8194): marcus | 2008-08-06 21:19:47 +0100
Add pt translation of error msg
r21401 at agaton (orig r8195): bricas | 2008-08-07 12:51:10 +0100
tidy up the name of module in pod
r21404 at agaton (orig r8196): bricas | 2008-08-07 17:31:31 +0100
Fix some Win32 test failures
r21405 at agaton (orig r8197): bricas | 2008-08-08 15:08:12 +0100
go() cannot dispatch to anon. actions, fix code and tests to match.
r21439 at agaton (orig r8199): bricas | 2008-08-08 20:35:45 +0100
pod fix
r21598 at agaton (orig r8231): matthewt | 2008-08-18 13:02:54 +0100
merge rafl's test
r23166 at agaton (orig r8232): gbjk | 2008-08-18 20:03:08 +0100
DispatchType/Chained:
A chain of equal actions but less captures should win over one with more captures.
Less captures is taken to mean it did so less ambiguously, and therefore wins the fight.
A chain of more actions will lose to one of less actions even if it had less captures, though.
i.e.: Actions beat Captures, but Captures decide betwixt Actions.
r23169 at agaton (orig r8235): zarquon | 2008-08-20 19:25:20 +0100
r13745 at harold: kd | 2008-08-20 19:24:42 +0100
improvements to redirect doc
r23356 at agaton (orig r8271): rafl | 2008-08-24 20:31:44 +0100
Move :Chained sugar out of DispatchType::Chained.
r23357 at agaton (orig r8272): rafl | 2008-08-24 20:31:53 +0100
Fix tests for ../action chaining.
rootdef is an endaction; the tests expect two args for chained_rel.
r23358 at agaton (orig r8273): rafl | 2008-08-24 20:32:00 +0100
Implement :Chained('../action').
r23359 at agaton (orig r8274): rafl | 2008-08-24 20:32:08 +0100
Implement :ChainedParent.
r23360 at agaton (orig r8275): rafl | 2008-08-24 20:32:14 +0100
UnTODO :Chained('../action') tests.
r23361 at agaton (orig r8276): rafl | 2008-08-24 20:32:21 +0100
Test :Chained('../../action').
r23362 at agaton (orig r8277): rafl | 2008-08-24 20:32:27 +0100
Implement relative chaining over more than one level.
r23363 at agaton (orig r8278): rafl | 2008-08-24 20:32:34 +0100
UnTODO tests for relative chaining over multiple levels.
r23367 at agaton (orig r8282): rafl | 2008-08-25 18:28:56 +0100
Add a test controller for :Chained('../../action').
Forgot to add it in r8276.
r23380 at agaton (orig r8295): rafl | 2008-08-26 16:20:04 +0100
Changelogging.
r26469 at Command-Central (orig r8322): matthewt | 2008-09-01 16:41:41 +0200
fix stupid merge mistake
r26470 at Command-Central (orig r8323): gbjk | 2008-09-01 16:57:35 +0200
Fix Chained Dispatch broken by chain registration.
r26471 at Command-Central (orig r8324): matthewt | 2008-09-01 17:32:52 +0200
fixup Catalyst::Action
r26476 at Command-Central (orig r8329): zarquon | 2008-09-02 14:01:11 +0200
r13852 at zaphod: kd | 2008-09-02 12:52:50 +0100
rafl doc improvements
r26477 at Command-Central (orig r8330): zarquon | 2008-09-02 14:04:57 +0200
r13854 at zaphod: kd | 2008-09-02 13:04:40 +0100
rafl's doc improvements in 5.8
r26481 at Command-Central (orig r8334): groditi | 2008-09-03 01:54:43 +0200
only call ACCEPT_CONTEXT if we actually have a context
r26484 at Command-Central (orig r8337): rafl | 2008-09-03 08:03:36 +0200
Fix ACCEPT_COMPONENT tests.
As of r8334 MyApp->component doesn't invoke ACCEPT_COMPONENT anymore.
r26485 at Command-Central (orig r8338): rafl | 2008-09-03 08:03:41 +0200
Test MyApp->component not invoking ACCEPT_CONTEXT.
r26487 at Command-Central (orig r8340): rafl | 2008-09-03 10:38:05 +0200
Use Test::NoTabs instead of Test::Perl::Critic.
r26507 at Command-Central (orig r8359): rafl | 2008-09-05 17:50:16 +0200
Make go('/chained/action') execute the full chain, not just the endpoint.
r26508 at Command-Central (orig r8360): rafl | 2008-09-05 20:55:52 +0200
Fix ROADMAP url.
r26515 at Command-Central (orig r8364): rafl | 2008-09-08 15:25:46 +0200
ActionChains part attribute doesn't need a default.
r26516 at Command-Central (orig r8365): rafl | 2008-09-08 15:26:21 +0200
Make ActionChain stringify to its part attribute.
This is used in the listing of private actions in debug mode.
r26517 at Command-Central (orig r8366): marcus | 2008-09-08 22:43:51 +0200
merge in new test actions.
r26518 at Command-Central (orig r8367): marcus | 2008-09-08 22:45:05 +0200
rename test test
r26519 at Command-Central (orig r8368): marcus | 2008-09-08 23:05:23 +0200
Support print for Catalyst::Request
Property changes on: Catalyst-Runtime/5.80/branches/context_go
___________________________________________________________________
Name: svk:merge
- 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:7442
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
+ 1c72fc7c-9ce4-42af-bf25-3bfe470ff1e8:/local/Catalyst/trunk/Catalyst-Runtime:9763
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/compres:7999
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/branches/context_go:8001
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.70/trunk:8295
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.80/branches/Catalyst-Test-Updates:8363
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.80/branches/moose:7911
4ad37cd2-5fec-0310-835f-b3785c72a374:/Catalyst-Runtime/5.80/trunk:8368
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-ChildOf:4443
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-Runtime-jrockway:5857
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-component-setup:4320
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/Catalyst-docs:4325
4ad37cd2-5fec-0310-835f-b3785c72a374:/branches/current/Catalyst-Runtime:5142
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst:4483
4ad37cd2-5fec-0310-835f-b3785c72a374:/trunk/Catalyst-Runtime:6165
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime:8339
d7608cd0-831c-0410-93c0-e5b306c3c028:/local/Catalyst/Catalyst-Runtime-jrockway:8342
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime:6511
e56d974f-7718-0410-8b1c-b347a71765b2:/local/Catalyst-Runtime-current:10442
Modified: Catalyst-Runtime/5.80/branches/context_go/Changes
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/Changes 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/Changes 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,5 +1,72 @@
# This file documents the revision history for Perl extension Catalyst.
+5.8000_01
+ - Port to Moose
+ - Added test for action stringify
+ - Added test for component instances getting $self->{value} from config.
+ - Add Catalyst::Response->print() method (ilmari)
+
+ ))
+
+5.7XXXXXX XXXX
+ - Fix some Win32 test failures
+ - Add pt translation of error message (wreis)
+ - Make :Chained('../action') work (Florian Ragwitz)
+ - 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 (Rafael Kitover)
+
+5.7099_01 2008-06-25 22:36:00
+ - Refactored component resolution (component(), models(), model(), et al). We now
+ throw warnings for two reasons:
+ 1) model() or view() was called with no arguments, and two results are returned
+ -- set default_(model|view), current_(model|view) or current_(model|view)_instance
+ instead
+ 2) you call a component resolution method with a string, and it resorts to a regexp
+ fallback wherein a result is returned -- if you really want to search, call the
+ method with a regex as the argument
+ - remove 0-length query string components so warnings aren't thrown (RT #36428)
+ - Update HTTP::Body dep so that the uploadtmp config value will work (RT #22540)
+ - Fix for LocalRegex when used in the Root controller
+ - Get some of the optional_* tests working from dirs with spaces (RT #26455)
+ - Fix Catalyst::Utils::home() when application .pm is in the current dir (RT #34437)
+ - Added the ability to remove parameters in req->uri_with() by passing in
+ an undef value (RT #34782)
+ - Added $c->go, to do an internal redispatch to another action, while retaining the
+ contents of the stash
+
+5.7014 2008-05-25 15:26:00
+ - Addition of .conf in restart regex in Catalyst::Engine::HTTP::Restarter::Watcher
+ - Fix regression for relative uri_for arguments after a forward()
+ introduced in 5.7013 (Peter Karman)
+ - Fix regression for "sub foo : Path {}" in the root controller which
+ was introduced when attempting to allow "0" as a Path.
+
+5.7013 2008-05-16 18:20:00
+ - Provide backwards compatability methods in Catalyst::Stats
+ - Fix subdirs for scripts that run in subdirs more than one level deep.
+ - Added test and updated docs for handling the Authorization header
+ under mod_fastcgi/mod_cgi.
+ - Fixed bug in HTTP engine where the connection was not closed properly if the
+ client disconnected before sending any headers. (Ton Voon)
+ - POD fix, IO::FileHandle => IO::Handle (RT #35690)
+ - Fix grammar on welcome page (RT #33236)
+ - Fix for Path('0') handling (RT #29334)
+ - Workaround for Win32 and c3_mro.t (RT #26452, tested by Kenichi Ishigaki)
+ - Fix for encoding query parameters (edenc)
+ - Fix Chained multiple test (t0m)
+
5.7012 2007-12-16 23:44:00
- Fix uri_for()'s and uri_with()'s handling of multibyte chars
(Daisuke Murase)
@@ -20,7 +87,7 @@
- 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 '+'
- (Gavin Henry, Tatsuhiko Miyagawa, Oleg Pronin)
+ (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
Modified: Catalyst-Runtime/5.80/branches/context_go/Makefile.PL
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/Makefile.PL 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/Makefile.PL 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,12 +1,12 @@
use inc::Module::Install 0.64;
-use 5.008001;
-perl_version '5.8.1';
+perl_version '5.008001';
name 'Catalyst-Runtime';
all_from 'lib/Catalyst/Runtime.pm';
-requires 'perl' => '5.8.1';
+requires 'MooseX::Emulate::Class::Accessor::Fast' => '0.00300';
+requires 'Moose' => '0.51';
requires 'Carp';
requires 'Class::Accessor::Fast';
requires 'Class::Data::Inheritable';
@@ -15,7 +15,7 @@
requires 'Data::Dump';
requires 'File::Modified';
requires 'HTML::Entities';
-requires 'HTTP::Body' => '0.9';
+requires 'HTTP::Body' => '1.04'; # makes uploadtmp work
requires 'HTTP::Headers' => '1.64';
requires 'HTTP::Request';
requires 'HTTP::Response';
@@ -31,10 +31,10 @@
requires 'Tree::Simple::Visitor::FindByPath';
requires 'URI' => '1.35';
requires 'Text::Balanced'; # core in 5.8.x but mentioned for completeness
+requires 'MRO::Compat';
-
if (-e 'inc/.author') {
- build_requires 'Test::Perl::Critic';
+ build_requires 'Test::NoTabs';
build_requires 'Test::Pod' => 1.14;
build_requires 'Test::Pod::Coverage' => 1.04;
Added: Catalyst-Runtime/5.80/branches/context_go/TODO
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/TODO (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/TODO 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,29 @@
+
+ - Add Class::Accessor compats
+ * Catalyst::Request
+ * Catalyst::Response
+ * Catalyst::Dispatcher
+ * Catalyst::Request::Upload
+ * Catalyst::Action
+ * Catalyst::ActionChain
+ * Catalyst::ActionContainer
+
+ - Make classes immutable at setup() time
+
+
+ - GRODITI's list:
+ * Update Test suite to not assume MyApp ISA Controller
+ - After that I'll set up attr handlers that will output helpful
+ error messages when you do it as well as how to fix it.
+ * comments marked /Moose TODO/i in the code
+ * Fix the CDI compat hack so we can start moving to immutable
+ * Profile before and after immutable.
+ * Now would be a good time to lay ground for the App / Ctx split
+ * Howto mantain branch in sync with the latest checkins ?
+ * Eliminate all instances of $instance->{$key}
+ * MooseX::Emulate::CAF seems to be working like a charm :)
+ * General code cleanups can't hurt
+ * How do we move from NEXT to C3 ? I have never used either of them
+ - What does the lineraized mro look like when we are using moose
+ method modifiers?
+ - Does they all get clumped together or what? Is it a non-issue?
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Action.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Action.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Action.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,9 +1,5 @@
package Catalyst::Action;
-use strict;
-use base qw/Class::Accessor::Fast/;
-
-
=head1 NAME
Catalyst::Action - Catalyst Action
@@ -21,8 +17,17 @@
=cut
-__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/);
+use Moose;
+has class => (is => 'rw');
+has namespace => (is => 'rw');
+has 'reverse' => (is => 'rw');
+has attributes => (is => 'rw');
+has name => (is => 'rw');
+has code => (is => 'rw');
+
+no Moose;
+
use overload (
# Stringify to reverse for debug output etc.
@@ -36,25 +41,35 @@
);
+
+
+no warnings 'recursion';
+
+#__PACKAGE__->mk_accessors(qw/class namespace reverse attributes name code/);
+
sub dispatch { # Execute ourselves against a context
my ( $self, $c ) = @_;
- local $c->{namespace} = $self->namespace;
return $c->execute( $self->class, $self );
}
sub execute {
my $self = shift;
- $self->{code}->(@_);
+ $self->code->(@_);
}
sub match {
my ( $self, $c ) = @_;
+ #would it be unreasonable to store the number of arguments
+ #the action has as it's own attribute?
+ #it would basically eliminate the code below. ehhh. small fish
return 1 unless exists $self->attributes->{Args};
my $args = $self->attributes->{Args}[0];
return 1 unless defined($args) && length($args);
return scalar( @{ $c->req->args } ) == $args;
}
+__PACKAGE__->meta->make_immutable;
+
1;
__END__
@@ -100,10 +115,14 @@
returns the sub name of this action.
-=head1 AUTHOR
+=head2 meta
-Matt S. Trout
+Provided by Moose
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionChain.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionChain.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionChain.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,9 +1,12 @@
package Catalyst::ActionChain;
-use strict;
-use base qw/Catalyst::Action/;
+use Moose;
+extends qw(Catalyst::Action);
+has chain => (is => 'rw');
+no Moose;
+
=head1 NAME
Catalyst::ActionChain - Chain of Catalyst Actions
@@ -20,22 +23,6 @@
=cut
-__PACKAGE__->mk_accessors(qw/chain/);
-
-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,
-
-);
-
-
sub dispatch {
my ( $self, $c ) = @_;
my @captures = @{$c->req->captures||[]};
@@ -58,6 +45,7 @@
return $self->new({ %$final, chain => $actions });
}
+__PACKAGE__->meta->make_immutable;
1;
__END__
@@ -79,12 +67,14 @@
Takes a list of Catalyst::Action objects and constructs and returns a
Catalyst::ActionChain object representing a chain of these actions
-=cut
+=head2 meta
-=head1 AUTHOR
+Provided by Moose
-Matt S. Trout
+=head1 AUTHORS
+Catalyst Contributors, see Catalyst.pm
+
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionContainer.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionContainer.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ActionContainer.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,8 +1,5 @@
package Catalyst::ActionContainer;
-use strict;
-use base qw/Class::Accessor::Fast/;
-
=head1 NAME
Catalyst::ActionContainer - Catalyst Action Container
@@ -18,25 +15,23 @@
=cut
-__PACKAGE__->mk_accessors(qw/part actions/);
+use Moose;
+has part => (is => 'rw', required => 1);
+has actions => (is => 'rw', required => 1, lazy => 1, default => sub { {} });
+
+around new => sub {
+ my ($orig, $self, $params) = @_;
+ $orig->($self, (ref($params) ? $params : { part => $params } ));
+};
+
+no Moose;
+
use overload (
-
# Stringify to path part for tree search
- q{""} => sub { shift->{part} },
-
+ q{""} => sub { shift->part },
);
-sub new {
- my ( $class, $fields ) = @_;
-
- $fields = { part => $fields, actions => {} } unless ref $fields;
-
- $class->SUPER::new($fields);
-}
-
-
-
sub get_action {
my ( $self, $name ) = @_;
return $self->actions->{$name} if defined $self->actions->{$name};
@@ -49,6 +44,8 @@
$self->actions->{$name} = $action;
}
+__PACKAGE__->meta->make_immutable;
+
1;
__END__
@@ -78,10 +75,14 @@
Accessor to the path part this container resolves to. Also what the container
stringifies to.
-=head1 AUTHOR
+=head2 meta
-Matt S. Trout
+Provided by Moose
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/AttrContainer.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/AttrContainer.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/AttrContainer.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,15 +1,15 @@
package Catalyst::AttrContainer;
-use strict;
-use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
-
+use Moose;
use Catalyst::Exception;
-use NEXT;
+use Scalar::Util 'blessed';
+with 'Catalyst::ClassData';
-__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/;
-__PACKAGE__->_attr_cache( {} );
-__PACKAGE__->_action_cache( [] );
+no Moose;
+__PACKAGE__->mk_classdata(_attr_cache => {} );
+__PACKAGE__->mk_classdata( _action_cache => [] );
+
# note - see attributes(3pm)
sub MODIFY_CODE_ATTRIBUTES {
my ( $class, $code, @attrs ) = @_;
@@ -23,7 +23,7 @@
=head1 NAME
-Catalyst::AttrContainer
+Catalyst::AttrContainer - Handles code attribute storage and caching
=head1 SYNOPSIS
@@ -47,10 +47,9 @@
L<Catalyst::Dispatcher>
L<Catalyst>.
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
-Marcus Ramberg, C<mramberg at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Base.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Base.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Base.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,8 @@
package Catalyst::Base;
-use strict;
use base qw/Catalyst::Controller/;
+use Moose;
+no Moose;
1;
@@ -20,15 +21,13 @@
L<Catalyst>, L<Catalyst::Controller>.
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
-Marcus Ramberg, C<mramberg at cpan.org>
-Matt S Trout, C<mst at shadowcatsystems.co.uk>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
-=cut
\ No newline at end of file
+=cut
Deleted: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Build.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Build.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Build.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,141 +0,0 @@
-package Catalyst::Build;
-
-use strict;
-use Module::Build;
-use Path::Class;
-use File::Find 'find';
-
-our @ISA;
-eval "require Module::Build";
-die "Please install Module::Build\n" if $@;
-push @ISA, 'Module::Build';
-
-our @ignore =
- qw/Build Build.PL Changes MANIFEST META.yml Makefile.PL Makefile README
- _build blib lib script t/;
-
-our $FAKE;
-our $ignore = '^(' . join( '|', @ignore ) . ')$';
-
-=head1 NAME
-
-Catalyst::Build - Module::Build extension for Catalyst
-
-=head1 SYNOPSIS
-
-See L<Catalyst>
-
-=head1 DESCRIPTION
-
-L<Module::Build> extension for Catalyst.
-
-=head1 DEPRECATION NOTICE
-
-This module is deprecated in favor of L<Module::Install::Catalyst>. It's
-only left here for compability with older applications.
-
-=head1 METHODS
-
-=over 4
-
-=item new
-
-=cut
-
-sub new {
- my $class = shift;
- my $self = $class->SUPER::new(@_);
-
- my $app_name = $self->{properties}{module_name};
- warn <<"EOF";
-
- Note:
-
- The use of Build.PL for building and distributing Catalyst
- applications is deprecated in Catalyst 5.58.
-
- We recommend using the new Module::Install-based Makefile
- system. You can generate a new Makefile.PL for your application
- by running:
-
- catalyst.pl -force -makefile $app_name
-
-EOF
-
- return $self;
-}
-
-=item ACTION_install
-
-=cut
-
-sub ACTION_install {
- my $self = shift;
- $self->SUPER::ACTION_install;
- $self->ACTION_install_extras;
-}
-
-=item ACTION_fakeinstall
-
-=cut
-
-sub ACTION_fakeinstall {
- my $self = shift;
- $self->SUPER::ACTION_fakeinstall;
- local $FAKE = 1;
- $self->ACTION_install_extras;
-}
-
-=item ACTION_install_extras
-
-=cut
-
-sub ACTION_install_extras {
- my $self = shift;
- my $prefix = $self->{properties}{destdir} || undef;
- my $sitelib = $self->install_destination('lib');
- my @path = defined $prefix ? ( $prefix, $sitelib ) : ($sitelib);
- my $path = dir( @path, split( '::', $self->{properties}{module_name} ) );
- my @files = $self->_find_extras;
- print "Installing extras to $path\n";
- for (@files) {
- $FAKE
- ? print "$_ -> $path (FAKE)\n"
- : $self->copy_if_modified( $_, $path );
- }
-}
-
-sub _find_extras {
- my $self = shift;
- my @all = glob '*';
- my @files;
- for my $file (@all) {
- next if $file =~ /$ignore/;
- if ( -d $file ) {
- find(
- sub {
- return if -d;
- push @files, $File::Find::name;
- },
- $file
- );
- }
- else { push @files, $file }
- }
- return @files;
-}
-
-=back
-
-=head1 AUTHOR
-
-Sebastian Riedel, C<sri at oook.de>
-
-=head1 LICENSE
-
-This library is free software, you can redistribute it and/or modify it under
-the same terms as Perl itself.
-
-=cut
-
-1;
Added: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ClassData.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ClassData.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ClassData.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,77 @@
+package Catalyst::ClassData;
+
+use Moose::Role;
+use Class::MOP;
+use Scalar::Util 'blessed';
+
+sub mk_classdata {
+ my ($class, $attribute) = @_;
+ confess("mk_classdata() is a class method, not an object method")
+ if blessed $class;
+
+ my $slot = '$'.$attribute;
+ my $accessor = sub {
+ my $meta = $_[0]->meta;
+ if(@_ > 1){
+ $meta->namespace->{$attribute} = \$_[1];
+ return $_[1];
+ }
+
+ if( $meta->has_package_symbol($slot) ){
+ return ${ $meta->get_package_symbol($slot) };
+ } else {
+ foreach my $super ( $meta->linearized_isa ) {
+ my $super_meta = Moose::Meta::Class->initialize($super);
+ if( $super_meta->has_package_symbol($slot) ){
+ return ${ $super_meta->get_package_symbol($slot) };
+ }
+ }
+ }
+ return;
+ };
+
+ confess("Failed to create accessor: $@ ")
+ unless ref $accessor eq 'CODE';
+
+ my $meta = $class->meta;
+ my $immutable_options;
+ if( $meta->is_immutable ){
+ $immutable_options = $meta->get_immutable_options;
+ $meta->make_mutable;
+ }
+ my $alias = "_${attribute}_accessor";
+ $meta->add_method($alias, $accessor);
+ $meta->add_method($attribute, $accessor);
+ if(defined $immutable_options){
+ $meta->make_immutable($immutable_options);
+ }
+ $class->$attribute($_[2]) if(@_ > 2);
+ return $accessor;
+}
+
+1;
+
+__END__
+
+
+=head1 NAME
+
+Catalyst::ClassData - Class data acessors
+
+=head1 METHODS
+
+=head2 mk_classdata $name, $optional_value
+
+A moose-safe clone of L<Class::Data::Inheritable> that borrows some ideas from
+L<Class::Accessor::Grouped>;
+
+=head1 AUTHOR
+
+Guillermo Roditi
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Component.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Component.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Component.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,11 +1,16 @@
package Catalyst::Component;
-use strict;
-use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
-use NEXT;
+use Moose;
+use Class::MOP;
+use MooseX::Adopt::Class::Accessor::Fast;
use Catalyst::Utils;
+use MRO::Compat;
+use mro 'c3';
+with 'MooseX::Emulate::Class::Accessor::Fast';
+with 'Catalyst::ClassData';
+
=head1 NAME
Catalyst::Component - Catalyst Component Base Class
@@ -49,46 +54,39 @@
=cut
-__PACKAGE__->mk_classdata($_) for qw/_config _plugins/;
+__PACKAGE__->mk_classdata('_plugins');
+__PACKAGE__->mk_classdata('_config');
-
-
-sub new {
- my ( $self, $c ) = @_;
-
+sub BUILDARGS {
+ my ($self) = @_;
+
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
- return $self->NEXT::new(
- $self->merge_config_hashes( $self->config, $arguments ) );
+ my $args = $self->merge_config_hashes( $self->config, $arguments );
+
+ return $args;
}
+no Moose;
+
sub COMPONENT {
my ( $self, $c ) = @_;
# Temporary fix, some components does not pass context to constructor
my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {};
-
- if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) {
- return $new;
+ if( my $next = $self->next::can ){
+ my $class = blessed $self || $self;
+ my ($next_package) = Class::MOP::get_code_info($next);
+ warn "There is a COMPONENT method resolving after Catalyst::Component in ${next_package}. This behavior is deprecated and will stop working in future releases.";
+ return $next->($self, $arguments);
}
- else {
- if ( my $new = $self->new( $c, $arguments ) ) {
- return $new;
- }
- else {
- my $class = ref $self || $self;
- my $new = $self->merge_config_hashes(
- $self->config, $arguments );
- return bless $new, $class;
- }
- }
+ return $self->new($c, $arguments);
}
sub config {
my $self = shift;
- my $config_sub = $self->can('_config');
- my $config = $self->$config_sub() || {};
+ my $config = $self->_config || {};
if (@_) {
my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} };
$self->_config(
@@ -97,18 +95,14 @@
} else {
# this is a bit of a kludge, required to make
# __PACKAGE__->config->{foo} = 'bar';
- # work in a subclass. Calling the Class::Data::Inheritable setter
- # will create a new _config method in the current class if it's
- # currently inherited from the superclass. So, the can() call will
- # return a different subref in that case and that means we know to
- # copy and reset the value stored in the class data.
+ # work in a subclass. If we don't have the package symbol in the
+ # current class we know we need to copy up to ours, which calling
+ # the setter will do for us.
- $self->_config( $config );
+ unless ($self->meta->has_package_symbol('$_config')) {
- if ((my $config_sub_now = $self->can('_config')) ne $config_sub) {
-
$config = $self->merge_config_hashes( $config, {} );
- $self->$config_sub_now( $config );
+ $self->_config( $config );
}
}
return $config;
@@ -126,6 +120,8 @@
. " did not override Catalyst::Component::process" );
}
+
+__PACKAGE__->meta->make_immutable;
1;
__END__
@@ -187,11 +183,9 @@
L<Catalyst>, L<Catalyst::Model>, L<Catalyst::View>, L<Catalyst::Controller>.
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
-Marcus Ramberg, C<mramberg at cpan.org>
-Matt S Trout, C<mst at shadowcatsystems.co.uk>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Controller.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Controller.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Controller.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,13 +1,49 @@
package Catalyst::Controller;
-use strict;
-use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/;
+#switch to BEGIN { extends qw/ ... /; } ?
+use base qw/Catalyst::Component Catalyst::AttrContainer/;
+use Moose;
+use Scalar::Util qw/blessed/;
use Catalyst::Exception;
use Catalyst::Utils;
use Class::Inspector;
-use NEXT;
+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 =>
+ (
+ is => 'rw',
+ isa => 'HashRef',
+ init_arg => undef,
+ );
+
+# isa => 'ClassName|Catalyst' ?
+has _application => (is => 'rw');
+sub _app{ shift->_application(@_) }
+
+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->actions($attr_value);
+}
+
=head1 NAME
Catalyst::Controller - Catalyst Controller base class
@@ -31,16 +67,14 @@
=cut
+#I think both of these could be attributes. doesn't really seem like they need
+#to ble class data. i think that attributes +default would work just fine
__PACKAGE__->mk_classdata($_) for qw/_dispatch_steps _action_class/;
__PACKAGE__->_dispatch_steps( [qw/_BEGIN _AUTO _ACTION/] );
__PACKAGE__->_action_class('Catalyst::Action');
-__PACKAGE__->mk_accessors( qw/_application/ );
-### _app as alias
-*_app = *_application;
-
sub _DISPATCH : Private {
my ( $self, $c ) = @_;
@@ -73,7 +107,7 @@
my ( $self, $c ) = @_;
if ( ref $c->action
&& $c->action->can('execute')
- && $c->req->action )
+ && defined $c->req->action )
{
$c->action->dispatch( $c );
}
@@ -88,59 +122,86 @@
return !@{ $c->error };
}
-sub new {
+around new => sub {
+ my $orig = shift;
my $self = shift;
my $app = $_[0];
- my $new = $self->NEXT::new(@_);
+ my $new = $self->$orig(@_);
$new->_application( $app );
return $new;
-}
+};
-
sub action_for {
my ( $self, $name ) = @_;
my $app = ($self->isa('Catalyst') ? $self : $self->_application);
return $app->dispatcher->get_action($name, $self->action_namespace);
}
-sub 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 ) = @_;
- unless ( $c ) {
- $c = ($self->isa('Catalyst') ? $self : $self->_application);
+
+ if( ref($self) ){
+ return $self->$orig if $self->has_action_namespace;
+ } else {
+ return $self->config->{namespace} if exists $self->config->{namespace};
}
- my $hash = (ref $self ? $self : $self->config); # hate app-is-class
- return $hash->{namespace} if exists $hash->{namespace};
- return Catalyst::Utils::class2prefix( ref($self) || $self,
- $c->config->{case_sensitive} )
- || '';
-}
-sub path_prefix {
- my ( $self, $c ) = @_;
- unless ( $c ) {
- $c = ($self->isa('Catalyst') ? $self : $self->_application);
+ my $case_s;
+ if( $c ){
+ $case_s = $c->config->{case_sensitive};
+ } else {
+ if ($self->isa('Catalyst')) {
+ $case_s = $self->config->{case_sensitive};
+ } else {
+ if (ref $self) {
+ $case_s = $self->_application->config->{case_sensitive};
+ } else {
+ confess("Can't figure out case_sensitive setting");
+ }
+ }
}
- my $hash = (ref $self ? $self : $self->config); # hate app-is-class
- return $hash->{path} if exists $hash->{path};
- return shift->action_namespace(@_);
-}
+ my $namespace = Catalyst::Utils::class2prefix(ref($self) || $self, $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 register_actions {
my ( $self, $c ) = @_;
my $class = ref $self || $self;
+ #this is still not correct for some reason.
my $namespace = $self->action_namespace($c);
- my %methods;
- $methods{ $self->can($_) } = $_
- for @{ Class::Inspector->methods($class) || [] };
+ my $meta = $self->meta;
+ my %methods = map{ $_->{code}->body => $_->{name} }
+ grep {$_->{class} ne 'Moose::Object'} #ignore Moose::Object methods
+ $meta->compute_all_applicable_methods;
+
# Advanced inheritance support for plugins and the like
+ #moose todo: migrate to eliminate CDI compat
my @action_cache;
- {
- no strict 'refs';
- for my $isa ( @{"$class\::ISA"}, $class ) {
- push @action_cache, @{ $isa->_action_cache }
- if $isa->can('_action_cache');
+ for my $isa ( $meta->superclasses, $class ) {
+ if(my $coderef = $isa->can('_action_cache')){
+ push(@action_cache, @{ $isa->$coderef });
}
}
@@ -156,7 +217,7 @@
if $c->debug;
next;
}
- my $reverse = $namespace ? "$namespace/$method" : $method;
+ my $reverse = $namespace ? "${namespace}/${method}" : $method;
my $action = $self->create_action(
name => $method,
code => $code,
@@ -178,10 +239,7 @@
? $args{attributes}{ActionClass}[0]
: $self->_action_class);
- unless ( Class::Inspector->loaded($class) ) {
- require Class::Inspector->filename($class);
- }
-
+ Class::MOP::load_class($class);
return $class->new( \%args );
}
@@ -204,15 +262,24 @@
}
}
- my $hash = (ref $self ? $self : $self->config); # hate app-is-class
-
- if (exists $hash->{actions} || exists $hash->{action}) {
- my $a = $hash->{actions} || $hash->{action};
- %raw_attributes = ((exists $a->{'*'} ? %{$a->{'*'}} : ()),
- %raw_attributes,
- (exists $a->{$name} ? %{$a->{$name}} : ()));
+ #I know that the original behavior was to ignore action if actions was set
+ # but i actually think this may be a little more sane? we can always remove
+ # the merge behavior quite easily and go back to having actions have
+ # presedence over action by modifying the keys. i honestly think this is
+ # superior while mantaining really high degree of compat
+ my $actions;
+ if( ref($self) ) {
+ $actions = $self->actions;
+ } else {
+ my $cfg = $self->config;
+ $actions = $self->merge_config_hashes($cfg->{actions}, $cfg->{action});
}
+ %raw_attributes = ((exists $actions->{'*'} ? %{$actions->{'*'}} : ()),
+ %raw_attributes,
+ (exists $actions->{$name} ? %{$actions->{$name}} : ()));
+
+
my %final_attributes;
foreach my $key (keys %raw_attributes) {
@@ -222,8 +289,8 @@
foreach my $value (ref($raw) eq 'ARRAY' ? @$raw : $raw) {
my $meth = "_parse_${key}_attr";
- if ( $self->can($meth) ) {
- ( $key, $value ) = $self->$meth( $c, $name, $value );
+ if ( my $code = $self->can($meth) ) {
+ ( $key, $value ) = $self->$code( $c, $name, $value );
}
push( @{ $final_attributes{$key} }, $value );
}
@@ -248,7 +315,7 @@
sub _parse_Path_attr {
my ( $self, $c, $name, $value ) = @_;
- $value ||= '';
+ $value = '' if !defined $value;
if ( $value =~ m!^/! ) {
return ( 'Path', $value );
}
@@ -270,11 +337,52 @@
sub _parse_LocalRegex_attr {
my ( $self, $c, $name, $value ) = @_;
unless ( $value =~ s/^\^// ) { $value = "(?:.*?)$value"; }
- return ( 'Regex', '^' . $self->path_prefix($c) . "/${value}" );
+
+ my $prefix = $self->path_prefix( $c );
+ $prefix .= '/' if length( $prefix );
+
+ return ( 'Regex', "^${prefix}${value}" );
}
sub _parse_LocalRegexp_attr { shift->_parse_LocalRegex_attr(@_); }
+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 = shift;
+ return PathPart => $self->path_prefix;
+}
+
sub _parse_ActionClass_attr {
my ( $self, $c, $name, $value ) = @_;
unless ( $value =~ s/^\+// ) {
@@ -292,6 +400,10 @@
return ( 'ActionClass', $value );
}
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+
1;
__END__
@@ -342,8 +454,8 @@
=head2 $self->path_prefix($c)
-Returns the default path prefix for :Local, :LocalRegex and relative
-:Path actions in this component. Defaults to the action_namespace or
+Returns the default path prefix for :PathPrefix, :Local, :LocalRegex and
+relative :Path actions in this component. Defaults to the action_namespace or
can be overridden from the "path" config key.
=head2 $self->create_action(%args)
@@ -359,10 +471,9 @@
Returns the application instance stored by C<new()>
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at oook.de>
-Marcus Ramberg C<mramberg at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Chained.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Chained.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,11 +1,35 @@
package Catalyst::DispatchType::Chained;
-use strict;
-use base qw/Catalyst::DispatchType/;
+use Moose;
+extends 'Catalyst::DispatchType';
+
use Text::SimpleTable;
use Catalyst::ActionChain;
use URI;
+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
@@ -41,7 +65,7 @@
sub list {
my ( $self, $c ) = @_;
- return unless $self->{endpoints};
+ return unless $self->_endpoints;
my $paths = Text::SimpleTable->new(
[ 35, 'Path Spec' ], [ 36, 'Private' ]
@@ -49,7 +73,7 @@
ENDPOINT: foreach my $endpoint (
sort { $a->reverse cmp $b->reverse }
- @{ $self->{endpoints} }
+ @{ $self->_endpoints }
) {
my $args = $endpoint->attributes->{Args}->[0];
my @parts = (defined($args) ? (("*") x $args) : '...');
@@ -65,7 +89,7 @@
if (defined $pp->[0] && length $pp->[0]);
}
$parent = $curr->attributes->{Chained}->[0];
- $curr = $self->{actions}{$parent};
+ $curr = $self->_actions->{$parent};
unshift(@parents, $curr) if $curr;
}
next ENDPOINT unless $parent eq '/'; # skip dangling action
@@ -97,20 +121,21 @@
sub match {
my ( $self, $c, $path ) = @_;
- return 0 if @{$c->req->args};
+ my $request = $c->request;
+ return 0 if @{$request->args};
my @parts = split('/', $path);
my ($chain, $captures, $parts) = $self->recurse_match($c, '/', \@parts);
- push @{$c->req->args}, @$parts if $parts && @$parts;
+ push @{$request->args}, @$parts if $parts && @$parts;
return 0 unless $chain;
my $action = Catalyst::ActionChain->from_chain($chain);
- $c->req->action("/${action}");
- $c->req->match("/${action}");
- $c->req->captures($captures);
+ $request->action("/${action}");
+ $request->match("/${action}");
+ $request->captures($captures);
$c->action($action);
$c->namespace( $action->namespace );
@@ -125,7 +150,7 @@
sub recurse_match {
my ( $self, $c, $parent, $path_parts ) = @_;
- my $children = $self->{children_of}{$parent};
+ my $children = $self->_children_of->{$parent};
return () unless $children;
my $best_action;
my @captures;
@@ -157,7 +182,14 @@
my ($actions, $captures, $action_parts) = $self->recurse_match(
$c, '/'.$action->reverse, \@parts
);
- if ($actions && (!$best_action || $#$action_parts < $#{$best_action->{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}}))){
$best_action = {
actions => [ $action, @$actions ],
captures=> [ @captures, @$captures ],
@@ -208,32 +240,14 @@
return 0 unless @chained_attr;
- if (@chained_attr > 2) {
+ if (@chained_attr > 1) {
Catalyst::Exception->throw(
"Multiple Chained attributes not supported registering ${action}"
);
}
- my $parent = $chained_attr[0];
+ my $children = ($self->_children_of->{ $chained_attr[0] } ||= {});
- if (defined($parent) && length($parent)) {
- if ($parent eq '.') {
- $parent = '/'.$action->namespace;
- } elsif ($parent !~ m/^\//) {
- if ($action->namespace) {
- $parent = '/'.join('/', $action->namespace, $parent);
- } else {
- $parent = '/'.$parent; # special case namespace '' (root)
- }
- }
- } else {
- $parent = '/'
- }
-
- $action->attributes->{Chained} = [ $parent ];
-
- my $children = ($self->{children_of}{$parent} ||= {});
-
my @path_part = @{ $action->attributes->{PathPart} || [] };
my $part = $action->name;
@@ -242,13 +256,13 @@
$part = $path_part[0];
} elsif (@path_part > 1) {
Catalyst::Exception->throw(
- "Multiple PathPart attributes not supported registering ${action}"
+ "Multiple PathPart attributes not supported registering " . $action->reverse()
);
}
if ($part =~ m(^/)) {
Catalyst::Exception->throw(
- "Absolute parameters to PathPart not allowed registering ${action}"
+ "Absolute parameters to PathPart not allowed registering " . $action->reverse()
);
}
@@ -256,10 +270,10 @@
unshift(@{ $children->{$part} ||= [] }, $action);
- ($self->{actions} ||= {})->{'/'.$action->reverse} = $action;
+ $self->_actions->{'/'.$action->reverse} = $action;
unless ($action->attributes->{CaptureArgs}) {
- unshift(@{ $self->{endpoints} ||= [] }, $action);
+ unshift(@{ $self->_endpoints }, $action);
}
return 1;
@@ -294,7 +308,7 @@
if (defined($pp->[0]) && length($pp->[0]));
}
$parent = $curr->attributes->{Chained}->[0];
- $curr = $self->{actions}{$parent};
+ $curr = $self->_actions->{$parent};
}
return undef unless $parent eq '/'; # fail for dangling action
@@ -305,6 +319,25 @@
}
+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;
+
=head1 USAGE
=head2 Introduction
@@ -480,13 +513,18 @@
C</foo/bar/...>. 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, with the relatives pointing
-to the current controller, 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.
+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
@@ -509,6 +547,19 @@
C</foo/bar>. That action chains directly to C</>, so the C</bar/*/baz/*>
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::Moo
+ sub bar : ChainedParent Args(1) { ... }
+
+This builds a chain like C</bar/*/bar/*>.
+
=item CaptureArgs
Must be specified for every part of the chain that is not an
@@ -555,9 +606,9 @@
you C<detach> out of a chain, the rest of the chain will not get called
after the C<detach>.
-=head1 AUTHOR
+=head1 AUTHORS
-Matt S Trout <mst at shadowcatsystems.co.uk>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Default.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Default.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Default.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,8 +1,10 @@
package Catalyst::DispatchType::Default;
-use strict;
-use base qw/Catalyst::DispatchType/;
+use Moose;
+extends 'Catalyst::DispatchType';
+no Moose;
+
=head1 NAME
Catalyst::DispatchType::Default - Default DispatchType
@@ -45,10 +47,9 @@
return 0;
}
-=head1 AUTHOR
+=head1 AUTHORS
-Matt S Trout
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -57,4 +58,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Index.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Index.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Index.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,8 @@
package Catalyst::DispatchType::Index;
-use strict;
-use base qw/Catalyst::DispatchType/;
+use Moose;
+extends 'Catalyst::DispatchType';
+no Moose;
=head1 NAME
@@ -55,9 +56,9 @@
return "/".$action->namespace;
}
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -66,4 +67,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Path.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Path.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Path.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,10 +1,20 @@
package Catalyst::DispatchType::Path;
-use strict;
-use base qw/Catalyst::DispatchType/;
+use Moose;
+extends 'Catalyst::DispatchType';
+
use Text::SimpleTable;
use URI;
+has _paths => (
+ is => 'rw',
+ isa => 'HashRef',
+ required => 1,
+ default => sub { +{} },
+ );
+
+no Moose;
+
=head1 NAME
Catalyst::DispatchType::Path - Path DispatchType
@@ -26,14 +36,14 @@
sub list {
my ( $self, $c ) = @_;
my $paths = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] );
- foreach my $path ( sort keys %{ $self->{paths} } ) {
+ foreach my $path ( sort keys %{ $self->_paths } ) {
my $display_path = $path eq '/' ? $path : "/$path";
- foreach my $action ( @{ $self->{paths}->{$path} } ) {
+ foreach my $action ( @{ $self->_paths->{$path} } ) {
$paths->row( $display_path, "/$action" );
}
}
$c->log->debug( "Loaded Path actions:\n" . $paths->draw . "\n" )
- if ( keys %{ $self->{paths} } );
+ if ( keys %{ $self->_paths } );
}
=head2 $self->match( $c, $path )
@@ -47,9 +57,9 @@
sub match {
my ( $self, $c, $path ) = @_;
- $path ||= '/';
+ $path = '/' if !defined $path || !length $path;
- foreach my $action ( @{ $self->{paths}->{$path} || [] } ) {
+ foreach my $action ( @{ $self->_paths->{$path} || [] } ) {
next unless $action->match($c);
$c->req->action($path);
$c->req->match($path);
@@ -90,7 +100,7 @@
$path = '/' unless length $path;
$path = URI->new($path)->canonical;
- unshift( @{ $self->{paths}{$path} ||= [] }, $action);
+ unshift( @{ $self->_paths->{$path} ||= [] }, $action);
return 1;
}
@@ -118,10 +128,9 @@
}
}
-=head1 AUTHOR
+=head1 AUTHORS
-Matt S Trout
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -130,4 +139,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Regex.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Regex.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType/Regex.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,10 +1,20 @@
package Catalyst::DispatchType::Regex;
-use strict;
-use base qw/Catalyst::DispatchType::Path/;
+use Moose;
+extends 'Catalyst::DispatchType::Path';
+
use Text::SimpleTable;
use Text::Balanced ();
+has _compiled => (
+ is => 'rw',
+ isa => 'ArrayRef',
+ required => 1,
+ default => sub{ [] },
+ );
+
+no Moose;
+
=head1 NAME
Catalyst::DispatchType::Regex - Regex DispatchType
@@ -26,12 +36,12 @@
sub list {
my ( $self, $c ) = @_;
my $re = Text::SimpleTable->new( [ 35, 'Regex' ], [ 36, 'Private' ] );
- for my $regex ( @{ $self->{compiled} } ) {
+ for my $regex ( @{ $self->_compiled } ) {
my $action = $regex->{action};
$re->row( $regex->{path}, "/$action" );
}
$c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" )
- if ( @{ $self->{compiled} } );
+ if ( @{ $self->_compiled } );
}
=head2 $self->match( $c, $path )
@@ -50,7 +60,7 @@
# Check path against plain text first
- foreach my $compiled ( @{ $self->{compiled} || [] } ) {
+ foreach my $compiled ( @{ $self->_compiled } ) {
if ( my @captures = ( $path =~ $compiled->{re} ) ) {
next unless $compiled->{action}->match($c);
$c->req->action( $compiled->{path} );
@@ -90,7 +100,7 @@
=head2 $self->register_regex($c, $re, $action)
-Register an individual regex on the action. Usually called from the
+Register an individual regex on the action. Usually called from the
register method.
=cut
@@ -98,7 +108,7 @@
sub register_regex {
my ( $self, $c, $re, $action ) = @_;
push(
- @{ $self->{compiled} }, # and compiled regex for us
+ @{ $self->_compiled }, # and compiled regex for us
{
re => qr#$re#,
action => $action,
@@ -139,10 +149,9 @@
return undef;
}
-=head1 AUTHOR
+=head1 AUTHORS
-Matt S Trout
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -151,4 +160,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/DispatchType.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,7 @@
package Catalyst::DispatchType;
-use strict;
-use base 'Class::Accessor::Fast';
+use Moose; # using it to add Moose::Object to @ISA ...
+no Moose;
=head1 NAME
@@ -58,11 +58,12 @@
sub uri_for_action { }
-=head1 AUTHOR
+sub expand_action { }
-Matt S Trout
-Sebastian Riedel, C<sri at cpan.org>
+=head1 AUTHORS
+Catalyst Contributors, see Catalyst.pm
+
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
@@ -70,4 +71,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Dispatcher.pm
===================================================================
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/CGI.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/CGI.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/CGI.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,10 +1,9 @@
package Catalyst::Engine::CGI;
-use strict;
-use base 'Catalyst::Engine';
-use NEXT;
+use Moose;
+extends 'Catalyst::Engine';
-__PACKAGE__->mk_accessors('env');
+has env => (is => 'rw');
=head1 NAME
@@ -54,7 +53,8 @@
my ( $self, $c ) = @_;
local (*ENV) = $self->env || \%ENV;
- $c->request->address( $ENV{REMOTE_ADDR} );
+ my $request = $c->request;
+ $request->address( $ENV{REMOTE_ADDR} );
PROXY_CHECK:
{
@@ -67,20 +67,20 @@
# If we are running as a backend server, the user will always appear
# as 127.0.0.1. Select the most recent upstream IP (last in the list)
my ($ip) = $ENV{HTTP_X_FORWARDED_FOR} =~ /([^,\s]+)$/;
- $c->request->address($ip);
+ $request->address($ip);
}
- $c->request->hostname( $ENV{REMOTE_HOST} );
- $c->request->protocol( $ENV{SERVER_PROTOCOL} );
- $c->request->user( $ENV{REMOTE_USER} );
- $c->request->method( $ENV{REQUEST_METHOD} );
+ $request->hostname( $ENV{REMOTE_HOST} );
+ $request->protocol( $ENV{SERVER_PROTOCOL} );
+ $request->user( $ENV{REMOTE_USER} );
+ $request->method( $ENV{REQUEST_METHOD} );
if ( $ENV{HTTPS} && uc( $ENV{HTTPS} ) eq 'ON' ) {
- $c->request->secure(1);
+ $request->secure(1);
}
if ( $ENV{SERVER_PORT} == 443 ) {
- $c->request->secure(1);
+ $request->secure(1);
}
}
@@ -91,12 +91,12 @@
sub prepare_headers {
my ( $self, $c ) = @_;
local (*ENV) = $self->env || \%ENV;
-
+ my $headers = $c->request->headers;
# Read headers from %ENV
foreach my $header ( keys %ENV ) {
next unless $header =~ /^(?:HTTP|CONTENT|COOKIE)/i;
( my $field = $header ) =~ s/^HTTPS?_//;
- $c->req->headers->header( $field => $ENV{$header} );
+ $headers->header( $field => $ENV{$header} );
}
}
@@ -172,14 +172,15 @@
=cut
-sub prepare_query_parameters {
+around prepare_query_parameters => sub {
+ my $orig = shift;
my ( $self, $c ) = @_;
local (*ENV) = $self->env || \%ENV;
if ( $ENV{QUERY_STRING} ) {
- $self->SUPER::prepare_query_parameters( $c, $ENV{QUERY_STRING} );
+ $self->$orig( $c, $ENV{QUERY_STRING} );
}
-}
+};
=head2 $self->prepare_request($c, (env => \%env))
@@ -199,32 +200,29 @@
=cut
-sub prepare_write {
- my ( $self, $c ) = @_;
-
- # Set the output handle to autoflush
+around prepare_write => sub {
*STDOUT->autoflush(1);
+ return shift->(@_);
+};
- $self->NEXT::prepare_write($c);
-}
-
=head2 $self->write($c, $buffer)
Writes the buffer to the client.
=cut
-sub write {
+around write => sub {
+ my $orig = shift;
my ( $self, $c, $buffer ) = @_;
# Prepend the headers if they have not yet been sent
if ( my $headers = delete $self->{_header_buf} ) {
$buffer = $headers . $buffer;
}
-
- return $self->NEXT::write( $c, $buffer );
-}
+ return $self->$orig( $c, $buffer );
+};
+
=head2 $self->read_chunk($c, $buffer, $length)
=cut
@@ -239,21 +237,18 @@
=head1 SEE ALSO
-L<Catalyst> L<Catalyst::Engine>.
+L<Catalyst>, L<Catalyst::Engine>
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Christian Hansen, <ch at ngmedia.com>
-
-Andy Grundman, <andy at hybridized.org>
-
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
=cut
+no Moose;
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/FastCGI.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/FastCGI.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/FastCGI.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,9 @@
package Catalyst::Engine::FastCGI;
-use strict;
-use base 'Catalyst::Engine::CGI';
+use Moose;
+extends 'Catalyst::Engine::CGI';
+
+# eval { Class::MOP::load_class("FCGI") };
eval "use FCGI";
die "Unable to load the FCGI module, you may need to install it:\n$@\n" if $@;
@@ -324,6 +326,16 @@
For more information on using FastCGI under Apache, visit
L<http://www.fastcgi.com/mod_fastcgi/docs/mod_fastcgi.html>
+=head3 Authorization header with mod_fastcgi or mod_cgi
+
+By default, mod_fastcgi/mod_cgi do not pass along the Authorization header,
+so modules like C<Catalyst::Plugin::Authentication::Credential::HTTP> will
+not work. To enable pass-through of this header, add the following
+mod_rewrite directives:
+
+ RewriteCond %{HTTP:Authorization} ^(.+)
+ RewriteRule ^(.*)$ $1 [E=HTTP_AUTHORIZATION:%1,PT]
+
=head2 Lighttpd
These configurations were tested with Lighttpd 1.4.7.
@@ -364,8 +376,9 @@
=head3 Non-root configuration
You can also run your application at any non-root location with either of the
-above modes.
+above modes. Note the required mod_rewrite rule.
+ url.rewrite = ( "myapp\$" => "myapp/" )
fastcgi.server = (
"/myapp" => (
"MyApp" => (
@@ -388,12 +401,8 @@
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Christian Hansen, <ch at ngmedia.com>
-
-Andy Grundman, <andy at hybridized.org>
-
=head1 THANKS
Bill Moseley, for documentation updates and testing.
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,32 +1,22 @@
package Catalyst::Engine::HTTP::Restarter::Watcher;
-use strict;
-use warnings;
-use base 'Class::Accessor::Fast';
+use Moose;
use File::Find;
use File::Modified;
use File::Spec;
use Time::HiRes qw/sleep/;
-__PACKAGE__->mk_accessors(
- qw/delay
- directory
- modified
- regex
- follow_symlinks
- watch_list/
-);
+has delay => (is => 'rw');
+has regex => (is => 'rw');
+has modified => (is => 'rw');
+has directory => (is => 'rw');
+has watch_list => (is => 'rw');
+has follow_simlinks => (is => 'rw');
-sub new {
- my ( $class, %args ) = @_;
+no Moose;
- my $self = {%args};
-
- bless $self, $class;
-
- $self->_init;
-
- return $self;
+sub BUILD {
+ shift->_init;
}
sub _init {
@@ -157,7 +147,7 @@
my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
directory => '/path/to/MyApp',
- regex => '\.yml$|\.yaml$|\.pm$',
+ regex => '\.yml$|\.yaml$|\.conf|\.pm$',
delay => 1,
);
@@ -188,10 +178,8 @@
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Andy Grundman, <andy at hybridized.org>
-
=head1 THANKS
Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP/Restarter.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,12 +1,12 @@
package Catalyst::Engine::HTTP::Restarter;
-use strict;
-use warnings;
-use base 'Catalyst::Engine::HTTP';
+use Moose;
+extends 'Catalyst::Engine::HTTP';
+
use Catalyst::Engine::HTTP::Restarter::Watcher;
-use NEXT;
-sub run {
+around run => sub {
+ my $orig = shift;
my ( $self, $class, $port, $host, $options ) = @_;
$options ||= {};
@@ -67,8 +67,9 @@
}
}
- return $self->NEXT::run( $class, $port, $host, $options );
-}
+ return $self->$orig( $class, $port, $host, $options );
+ no Moose;
+};
1;
__END__
@@ -97,12 +98,8 @@
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Dan Kubb, <dan.kubb-cpan at onautopilot.com>
-
-Andy Grundman, <andy at hybridized.org>
-
=head1 THANKS
Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine/HTTP.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,13 +1,13 @@
package Catalyst::Engine::HTTP;
-use strict;
-use base 'Catalyst::Engine::CGI';
+use Moose;
+extends 'Catalyst::Engine::CGI';
+
use Data::Dump qw(dump);
use Errno 'EWOULDBLOCK';
use HTTP::Date ();
use HTTP::Headers;
use HTTP::Status;
-use NEXT;
use Socket;
use IO::Socket::INET ();
use IO::Select ();
@@ -52,28 +52,29 @@
my $protocol = $c->request->protocol;
my $status = $c->response->status;
my $message = status_message($status);
-
+ my $res_headers = $c->response->headers;
+
my @headers;
push @headers, "$protocol $status $message";
-
- $c->response->headers->header( Date => HTTP::Date::time2str(time) );
- $c->response->headers->header( Status => $status );
-
+
+ $res_headers->header( Date => HTTP::Date::time2str(time) );
+ $res_headers->header( Status => $status );
+
# Should we keep the connection open?
my $connection = $c->request->header('Connection');
if ( $self->{options}->{keepalive}
&& $connection
&& $connection =~ /^keep-alive$/i
) {
- $c->response->headers->header( Connection => 'keep-alive' );
+ $res_headers->header( Connection => 'keep-alive' );
$self->{_keepalive} = 1;
}
else {
- $c->response->headers->header( Connection => 'close' );
+ $res_headers->header( Connection => 'close' );
}
-
- push @headers, $c->response->headers->as_string("\x0D\x0A");
-
+
+ push @headers, $res_headers->as_string("\x0D\x0A");
+
# Buffer the headers so they are sent with the first write() call
# This reduces the number of TCP packets we are sending
$self->{_header_buf} = join("\x0D\x0A", @headers, '');
@@ -83,29 +84,23 @@
=cut
-sub finalize_read {
- my ( $self, $c ) = @_;
-
+around finalize_read => sub {
# Never ever remove this, it would result in random length output
# streams if STDIN eq STDOUT (like in the HTTP engine)
*STDIN->blocking(1);
+ shift->(@_);
+};
- return $self->NEXT::finalize_read($c);
-}
-
=head2 $self->prepare_read($c)
=cut
-sub prepare_read {
- my ( $self, $c ) = @_;
-
+around prepare_read => sub {
# Set the input handle to non-blocking
*STDIN->blocking(0);
+ shift->(@_);
+};
- return $self->NEXT::prepare_read($c);
-}
-
=head2 $self->read_chunk($c, $buffer, $length)
=cut
@@ -146,9 +141,10 @@
=cut
-sub write {
+around write => sub {
+ my $orig = shift;
my ( $self, $c, $buffer ) = @_;
-
+
# Avoid 'print() on closed filehandle Remote' warnings when using IE
return unless *STDOUT->opened();
@@ -156,9 +152,9 @@
if ( my $headers = delete $self->{_header_buf} ) {
$buffer = $headers . $buffer;
}
-
- my $ret = $self->NEXT::write( $c, $buffer );
-
+
+ my $ret = $self->$orig($c, $buffer);
+
if ( !defined $ret ) {
$self->{_write_error} = $!;
DEBUG && warn "write: Failed to write response ($!)\n";
@@ -166,9 +162,9 @@
else {
DEBUG && warn "write: Wrote response ($ret bytes)\n";
}
-
+
return $ret;
-}
+};
=head2 run
@@ -239,43 +235,43 @@
}
my $pid = undef;
-
+
# Ignore broken pipes as an HTTP server should
local $SIG{PIPE} = 'IGNORE';
-
+
# Restart on HUP
- local $SIG{HUP} = sub {
+ local $SIG{HUP} = sub {
$restart = 1;
warn "Restarting server on SIGHUP...\n";
};
-
+
LISTEN:
while ( !$restart ) {
- while ( accept( Remote, $daemon ) ) {
+ while ( accept( Remote, $daemon ) ) {
DEBUG && warn "New connection\n";
select Remote;
Remote->blocking(1);
-
+
# Read until we see all headers
$self->{inputbuf} = '';
-
+
if ( !$self->_read_headers ) {
# Error reading, give up
+ close Remote;
next LISTEN;
}
my ( $method, $uri, $protocol ) = $self->_parse_request_line;
-
+
DEBUG && warn "Parsed request: $method $uri $protocol\n";
-
next unless $method;
unless ( uc($method) eq 'RESTART' ) {
# Fork
- if ( $options->{fork} ) {
+ if ( $options->{fork} ) {
if ( $pid = fork ) {
DEBUG && warn "Forked child $pid\n";
next;
@@ -416,46 +412,50 @@
sub _read_headers {
my $self = shift;
-
+
while (1) {
my $read = sysread Remote, my $buf, CHUNKSIZE;
-
- if ( !$read ) {
- DEBUG && warn "EOF or error: $!\n";
+
+ if ( !defined $read ) {
+ next if $! == EWOULDBLOCK;
+ DEBUG && warn "Error reading headers: $!\n";
return;
+ } elsif ( $read == 0 ) {
+ DEBUG && warn "EOF\n";
+ return;
}
-
+
DEBUG && warn "Read $read bytes\n";
$self->{inputbuf} .= $buf;
last if $self->{inputbuf} =~ /(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)/s;
}
-
+
return 1;
}
sub _parse_request_line {
my $self = shift;
- # Parse request line
+ # Parse request line
if ( $self->{inputbuf} !~ s/^(\w+)[ \t]+(\S+)(?:[ \t]+(HTTP\/\d+\.\d+))?[^\012]*\012// ) {
return ();
}
-
+
my $method = $1;
my $uri = $2;
my $proto = $3 || 'HTTP/0.9';
-
+
return ( $method, $uri, $proto );
}
sub _parse_headers {
my $self = shift;
-
+
# Copy the buffer for header parsing, and remove the header block
# from the content buffer.
my $buf = $self->{inputbuf};
$self->{inputbuf} =~ s/.*?(\x0D\x0A?\x0D\x0A?|\x0A\x0D?\x0A\x0D?)//s;
-
+
# Parse headers
my $headers = HTTP::Headers->new;
my ($key, $val);
@@ -525,20 +525,16 @@
sub _inet_addr { unpack "N*", inet_aton( $_[0] ) }
+no Moose;
+
=head1 SEE ALSO
-L<Catalyst>, L<Catalyst::Engine>.
+L<Catalyst>, L<Catalyst::Engine>
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Dan Kubb, <dan.kubb-cpan at onautopilot.com>
-
-Sascha Kiefer, <esskar at cpan.org>
-
-Andy Grundman, <andy at hybridized.org>
-
=head1 THANKS
Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Engine.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,8 @@
package Catalyst::Engine;
-use strict;
-use base 'Class::Accessor::Fast';
+use Moose;
+with 'MooseX::Emulate::Class::Accessor::Fast';
+
use CGI::Simple::Cookie;
use Data::Dump qw/dump/;
use Errno 'EWOULDBLOCK';
@@ -12,10 +13,10 @@
use Scalar::Util ();
# input position and length
-__PACKAGE__->mk_accessors(qw/read_position read_length/);
+has read_length => (is => 'rw');
+has read_position => (is => 'rw');
-# Stringify to class
-use overload '""' => sub { return ref shift }, fallback => 1;
+no Moose;
# Amount of data to read from input on each pass
our $CHUNKSIZE = 64 * 1024;
@@ -66,10 +67,11 @@
my ( $self, $c ) = @_;
my @cookies;
+ my $response = $c->response;
- foreach my $name ( keys %{ $c->response->cookies } ) {
+ foreach my $name (keys %{ $response->cookies }) {
- my $val = $c->response->cookies->{$name};
+ my $val = $response->cookies->{$name};
my $cookie = (
Scalar::Util::blessed($val)
@@ -88,7 +90,7 @@
}
for my $cookie (@cookies) {
- $c->res->headers->push_header( 'Set-Cookie' => $cookie );
+ $response->headers->push_header( 'Set-Cookie' => $cookie );
}
}
@@ -127,9 +129,6 @@
# Don't show body parser in the dump
delete $c->req->{_body};
- # Don't show response header state in dump
- delete $c->res->{_finalized_headers};
-
my @infos;
my $i = 0;
for my $dump ( $c->dump_these ) {
@@ -157,6 +156,7 @@
(no) Vennligst prov igjen senere
(dk) Venligst prov igen senere
(pl) Prosze sprobowac pozniej
+(pt) Por favor volte mais tarde
</pre>
$name = '';
@@ -291,14 +291,13 @@
sub finalize_uploads {
my ( $self, $c ) = @_;
- if ( keys %{ $c->request->uploads } ) {
- for my $key ( keys %{ $c->request->uploads } ) {
- my $upload = $c->request->uploads->{$key};
- unlink map { $_->tempname }
- grep { -e $_->tempname }
- ref $upload eq 'ARRAY' ? @{$upload} : ($upload);
- }
+ 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)
@@ -311,10 +310,11 @@
my ( $self, $c ) = @_;
if ( my $length = $self->read_length ) {
- unless ( $c->request->{_body} ) {
- my $type = $c->request->header('Content-Type');
- $c->request->{_body} = HTTP::Body->new( $type, $length );
- $c->request->{_body}->{tmpdir} = $c->config->{uploadtmp}
+ my $request = $c->request;
+ unless ( $request->{_body} ) {
+ my $type = $request->header('Content-Type');
+ $request->{_body} = HTTP::Body->new( $type, $length );
+ $request->{_body}->tmpdir( $c->config->{uploadtmp} )
if exists $c->config->{uploadtmp};
}
@@ -399,25 +399,24 @@
sub prepare_parameters {
my ( $self, $c ) = @_;
+ my $request = $c->request;
+ my $parameters = $request->parameters;
+ my $body_parameters = $request->body_parameters;
+ my $query_parameters = $request->query_parameters;
# We copy, no references
- foreach my $name ( keys %{ $c->request->query_parameters } ) {
- my $param = $c->request->query_parameters->{$name};
- $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
- $c->request->parameters->{$name} = $param;
+ 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 %{ $c->request->body_parameters } ) {
- my $param = $c->request->body_parameters->{$name};
- $param = ref $param eq 'ARRAY' ? [ @{$param} ] : $param;
- if ( my $old_param = $c->request->parameters->{$name} ) {
- if ( ref $old_param eq 'ARRAY' ) {
- push @{ $c->request->parameters->{$name} },
- ref $param eq 'ARRAY' ? @$param : $param;
- }
- else { $c->request->parameters->{$name} = [ $old_param, $param ] }
+ 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));
}
- else { $c->request->parameters->{$name} = $param }
+ $parameters->{$name} = @values > 1 ? \@values : $values[0];
}
}
@@ -452,7 +451,7 @@
# replace semi-colons
$query_string =~ s/;/&/g;
- my @params = split /&/, $query_string;
+ my @params = grep { length $_ } split /&/, $query_string;
for my $item ( @params ) {
@@ -508,40 +507,42 @@
sub prepare_uploads {
my ( $self, $c ) = @_;
-
- return unless $c->request->{_body};
-
- my $uploads = $c->request->{_body}->upload;
- for my $name ( keys %$uploads ) {
+
+ my $request = $c->request;
+ return unless $request->{_body};
+
+ my $uploads = $request->{_body}->upload;
+ my $parameters = $request->parameters;
+ foreach my $name (keys %$uploads) {
my $files = $uploads->{$name};
- $files = ref $files eq 'ARRAY' ? $files : [$files];
my @uploads;
- for my $upload (@$files) {
- my $u = Catalyst::Request::Upload->new;
- $u->headers( HTTP::Headers->new( %{ $upload->{headers} } ) );
- $u->type( $u->headers->content_type );
- $u->tempname( $upload->{tempname} );
- $u->size( $upload->{size} );
- $u->filename( $upload->{filename} );
+ for my $upload (ref $files eq 'ARRAY' ? @$files : ($files)) {
+ my $headers = HTTP::Headers->new( %{ $upload->{headers} } );
+ my $u = Catalyst::Request::Upload->new
+ (
+ size => $upload->{size},
+ type => $headers->content_type,
+ headers => $headers,
+ tempname => $upload->{tempname},
+ filename => $upload->{filename},
+ );
push @uploads, $u;
}
- $c->request->uploads->{$name} = @uploads > 1 ? \@uploads : $uploads[0];
+ $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 $c->request->parameters->{$name}) {
- if (ref $c->request->parameters->{$name} eq 'ARRAY') {
- push @{ $c->request->parameters->{$name} }, @filenames;
+ if (exists $parameters->{$name}) {
+ if (ref $parameters->{$name} eq 'ARRAY') {
+ push @{ $parameters->{$name} }, @filenames;
}
else {
- $c->request->parameters->{$name} =
- [ $c->request->parameters->{$name}, @filenames ];
+ $parameters->{$name} = [ $parameters->{$name}, @filenames ];
}
}
else {
- $c->request->parameters->{$name} =
- @filenames > 1 ? \@filenames : $filenames[0];
+ $parameters->{$name} = @filenames > 1 ? \@filenames : $filenames[0];
}
}
}
@@ -670,10 +671,8 @@
=head1 AUTHORS
-Sebastian Riedel, <sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Andy Grundman, <andy at hybridized.org>
-
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it under
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Exception.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Exception.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Exception.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,15 +1,10 @@
package Catalyst::Exception;
-use strict;
-use vars qw[@ISA $CATALYST_EXCEPTION_CLASS];
+# XXX: See bottom of file for Exception implementation
-BEGIN {
- push( @ISA, $CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base' );
-}
-
package Catalyst::Exception::Base;
-use strict;
+use Moose;
use Carp ();
=head1 NAME
@@ -49,11 +44,14 @@
Carp::croak($message);
}
-=head1 AUTHOR
+=head2 meta
-Sebastian Riedel, C<sri at cpan.org>
-Christian Hansen, C<ch at ngmedia.com>
+Provided by Moose
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify
@@ -61,4 +59,18 @@
=cut
+Catalyst::Exception::Base->meta->make_immutable;
+
+package Catalyst::Exception;
+
+use Moose;
+use vars qw[$CATALYST_EXCEPTION_CLASS];
+
+BEGIN {
+ extends($CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base');
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Log.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Log.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Log.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,18 +1,18 @@
package Catalyst::Log;
-use strict;
-use base 'Class::Accessor::Fast';
+use Moose;
use Data::Dump;
our %LEVELS = ();
-__PACKAGE__->mk_accessors('level');
-__PACKAGE__->mk_accessors('body');
-__PACKAGE__->mk_accessors('abort');
+has level => (is => 'rw');
+has _body => (is => 'rw');
+has abort => (is => 'rw');
{
my @levels = qw[ debug info warn error fatal ];
+ my $meta = __PACKAGE__->meta;
for ( my $i = 0 ; $i < @levels ; $i++ ) {
my $name = $levels[$i];
@@ -20,29 +20,28 @@
$LEVELS{$name} = $level;
- no strict 'refs';
-
- *{$name} = sub {
+ $meta->add_method($name, sub {
my $self = shift;
- if ( $self->{level} & $level ) {
+ if ( $self->level & $level ) {
$self->_log( $name, @_ );
}
- };
+ });
- *{"is_$name"} = sub {
+ $meta->add_method("is_$name", sub {
my $self = shift;
- return $self->{level} & $level;
- };
+ return $self->level & $level;
+ });;
}
}
-sub new {
+around new => sub {
+ my $orig = shift;
my $class = shift;
- my $self = $class->SUPER::new;
+ my $self = $class->$orig;
$self->levels( scalar(@_) ? @_ : keys %LEVELS );
return $self;
-}
+};
sub levels {
my ( $self, @levels ) = @_;
@@ -52,12 +51,20 @@
sub enable {
my ( $self, @levels ) = @_;
- $self->{level} |= $_ for map { $LEVELS{$_} } @levels;
+ my $level = $self->level;
+ for(map { $LEVELS{$_} } @levels){
+ $level |= $_;
+ }
+ $self->level($level);
}
sub disable {
my ( $self, @levels ) = @_;
- $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels;
+ my $level = $self->level;
+ for(map { $LEVELS{$_} } @levels){
+ $level &= ~$_;
+ }
+ $self->level($level);
}
sub _dump {
@@ -70,18 +77,20 @@
my $level = shift;
my $message = join( "\n", @_ );
$message .= "\n" unless $message =~ /\n$/;
- $self->{body} .= sprintf( "[%s] %s", $level, $message );
+ my $body = $self->_body;
+ $body .= sprintf( "[%s] %s", $level, $message );
+ $self->_body($body);
}
sub _flush {
my $self = shift;
- if ( $self->abort || !$self->body ) {
+ if ( $self->abort || !$self->_body ) {
$self->abort(undef);
}
else {
- $self->_send_to_log( $self->body );
+ $self->_send_to_log( $self->_body );
}
- $self->body(undef);
+ $self->_body(undef);
}
sub _send_to_log {
@@ -89,6 +98,9 @@
print STDERR @_;
}
+no Moose;
+__PACKAGE__->meta->make_immutable();
+
1;
__END__
@@ -169,6 +181,10 @@
$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
@@ -217,15 +233,15 @@
You may subclass this module and override this method to get finer control
over the log output.
+=head2 meta
+
=head1 SEE ALSO
L<Catalyst>.
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
-Marcus Ramberg, C<mramberg at cpan.org>
-Christian Hansen, C<ch at ngmedia.com>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -234,4 +250,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Manual.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Manual.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Manual.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -16,9 +16,8 @@
$ perldoc -t Catalyst::Manual::Tutorial::CatalystBasics 2>&1 >/dev/null && echo OK || echo MISSING
If you see "OK" as the output, it's there, if you see "MISSING" you
-need to install the
-L<Catalyst::Manual|http://search.cpan.org/search?query=Catalyst%3A%3AManual&mode=dist>
-distribution.
+need to install the L<Catalyst::Manual> distribution
+(L<http://search.cpan.org/dist/Catalyst-Manual/>).
=over 4
@@ -91,12 +90,13 @@
http://lists.rawmode.org/mailman/listinfo/catalyst
http://lists.rawmode.org/mailman/listinfo/catalyst-dev
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at oook.de>
-Jesse Sheidlower, C<jester at panix.com>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify it
under the same terms as Perl itself.
+
+=cut
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Model.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Model.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Model.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,8 +1,10 @@
package Catalyst::Model;
-use strict;
-use base qw/Catalyst::Component/;
+use Moose;
+extends qw/Catalyst::Component/;
+no Moose;
+
=head1 NAME
Catalyst::Model - Catalyst Model base class
@@ -20,9 +22,9 @@
Implements the same methods as other Catalyst components, see
L<Catalyst::Component>
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at oook.de>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -31,4 +33,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ROADMAP.pod
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ROADMAP.pod 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/ROADMAP.pod 2008-09-08 23:24:28 UTC (rev 8371)
@@ -4,7 +4,7 @@
for the Catalyst framework. It's liable to change at any time. This document
lives in the the catalyst trunk, currently at
- http://dev.catalyst.perl.org/repos/Catalyst/trunk/Catalyst/lib/Catalyst/ROADMAP.pod
+ http://dev.catalyst.perl.org/repos/Catalyst/Catalyst-Runtime/5.80/trunk/lib/Catalyst/ROADMAP.pod
Make sure you get it from there to ensure you have the latest version.
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request/Upload.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request/Upload.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request/Upload.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,17 +1,39 @@
package Catalyst::Request::Upload;
-use strict;
-use base 'Class::Accessor::Fast';
+use Moose;
use Catalyst::Exception;
use File::Copy ();
use IO::File ();
use File::Spec::Unix;
-__PACKAGE__->mk_accessors(qw/filename headers size tempname type basename/);
+has filename => (is => 'rw');
+has headers => (is => 'rw');
+has size => (is => 'rw');
+has tempname => (is => 'rw');
+has type => (is => 'rw');
+has basename => (is => 'rw');
-sub new { shift->SUPER::new( ref( $_[0] ) ? $_[0] : {@_} ) }
+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;
+ },
+);
+
+no Moose;
+
=head1 NAME
Catalyst::Request::Upload - handles file upload requests
@@ -34,11 +56,6 @@
__PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
-It is provided a way to have configurable temporary directory.
-If there is no config uploadtmp, system temprary directory will used.
-
- __PACKAGE__->config( uploadtmp => '/path/to/tmpdir' );
-
See also L<Catalyst>.
=head1 DESCRIPTION
@@ -69,24 +86,6 @@
Opens a temporary file (see tempname below) and returns an L<IO::File> handle.
-=cut
-
-sub fh {
- 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;
-}
-
=head2 $upload->filename
Returns the client-supplied filename.
@@ -163,12 +162,14 @@
Returns the client-supplied Content-Type.
+=head2 meta
+
+Provided by Moose
+
=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Christian Hansen, C<ch at ngmedia.com>
-
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify
@@ -176,4 +177,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Request.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,35 +1,132 @@
package Catalyst::Request;
-use strict;
-use base 'Class::Accessor::Fast';
-
use IO::Socket qw[AF_INET inet_aton];
use Carp;
use utf8;
use URI::http;
use URI::https;
use URI::QueryParam;
+use HTTP::Headers;
-__PACKAGE__->mk_accessors(
- qw/action address arguments cookies headers query_keywords match method
- protocol query_parameters secure captures uri user/
+use Moose;
+
+has action => (is => 'rw');
+has address => (is => 'rw');
+has arguments => (is => 'rw', default => sub { [] });
+has cookies => (is => 'rw', default => sub { {} });
+has query_keywords => (is => 'rw');
+has match => (is => 'rw');
+has method => (is => 'rw');
+has protocol => (is => 'rw');
+has query_parameters => (is => 'rw', default => sub { {} });
+has secure => (is => 'rw', default => 0);
+has captures => (is => 'rw', default => sub { [] });
+has uri => (is => 'rw');
+has user => (is => 'rw');
+has headers => (
+ is => 'rw',
+ isa => 'HTTP::Headers',
+ handles => [qw(content_encoding content_length content_type header referer user_agent)],
+ default => sub { HTTP::Headers->new() },
+ required => 1,
+ lazy => 1,
);
-*args = \&arguments;
-*body_params = \&body_parameters;
-*input = \&body;
-*params = \¶meters;
-*query_params = \&query_parameters;
-*path_info = \&path;
-*snippets = \&captures;
+#Moose ToDo:
+#can we lose the before modifiers which just call prepare_body ?
+#they are wasteful, slow us down and feel cluttery.
+# Can we call prepare_body at BUILD time?
+# Can we make _body an attribute and have the rest of these lazy build from there?
-sub content_encoding { shift->headers->content_encoding(@_) }
-sub content_length { shift->headers->content_length(@_) }
-sub content_type { shift->headers->content_type(@_) }
-sub header { shift->headers->header(@_) }
-sub referer { shift->headers->referer(@_) }
-sub user_agent { shift->headers->user_agent(@_) }
+has _context => (
+ is => 'rw',
+ weak_ref => 1,
+ handles => ['read'],
+);
+has body_parameters => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub { {} },
+);
+
+before body_parameters => sub {
+ my ($self) = @_;
+ $self->_context->prepare_body();
+};
+
+has uploads => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub { {} },
+);
+
+# modifier was a noop (groditi)
+# before uploads => sub {
+# my ($self) = @_;
+# #$self->_context->prepare_body;
+# };
+
+has parameters => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub { {} },
+);
+
+before parameters => sub {
+ my ($self, $params) = @_;
+ #$self->_context->prepare_body();
+ if ( $params && !ref $params ) {
+ $self->_context->log->warn(
+ "Attempt to retrieve '$params' with req->params(), " .
+ "you probably meant to call req->param('$params')" );
+ $params = undef;
+ }
+
+};
+
+has base => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub {
+ my $self = shift;
+ return $self->path if $self->uri;
+ },
+);
+
+has body => (
+ is => 'rw'
+);
+
+before body => sub {
+ my ($self) = @_;
+ $self->_context->prepare_body();
+};
+
+has hostname => (
+ is => 'rw',
+ required => 1,
+ lazy => 1,
+ default => sub {
+ my ($self) = @_;
+ gethostbyaddr( inet_aton( $self->address ), AF_INET )
+ },
+);
+
+no Moose;
+
+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(@_) }
+sub snippets { shift->captures(@_) }
+
=head1 NAME
Catalyst::Request - provides information about the current client request
@@ -122,39 +219,11 @@
If your application was queried with the URI
C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
-=cut
-
-sub base {
- my ( $self, $base ) = @_;
-
- return $self->{base} unless $base;
-
- $self->{base} = $base;
-
- # set the value in path for backwards-compat
- if ( $self->uri ) {
- $self->path;
- }
-
- return $self->{base};
-}
-
=head2 $req->body
Returns the message body of the request, unless Content-Type is
C<application/x-www-form-urlencoded> or C<multipart/form-data>.
-=cut
-
-sub body {
- my $self = shift;
- $self->{_context}->prepare_body;
-
- return unless $self->{_body};
-
- return $self->{_body}->body;
-}
-
=head2 $req->body_parameters
Returns a reference to a hash containing body (POST) parameters. Values can
@@ -164,20 +233,11 @@
print $c->request->body_parameters->{field}->[0];
These are the parameters from the POST part of the request, if any.
-
+
=head2 $req->body_params
Shortcut for body_parameters.
-=cut
-
-sub body_parameters {
- my ( $self, $params ) = @_;
- $self->{_context}->prepare_body;
- $self->{body_parameters} = $params if $params;
- return $self->{body_parameters};
-}
-
=head2 $req->content_encoding
Shortcut for $req->headers->content_encoding.
@@ -240,24 +300,7 @@
=head2 $req->hostname
Returns the hostname of the client.
-
-=cut
-sub hostname {
- my $self = shift;
-
- if ( @_ == 0 && not $self->{hostname} ) {
- $self->{hostname} =
- gethostbyaddr( inet_aton( $self->address ), AF_INET );
- }
-
- if ( @_ == 1 ) {
- $self->{hostname} = shift;
- }
-
- return $self->{hostname};
-}
-
=head2 $req->input
Alias for $req->body.
@@ -348,24 +391,6 @@
Shortcut for $req->parameters.
-=cut
-
-sub parameters {
- my ( $self, $params ) = @_;
- $self->{_context}->prepare_body;
- if ( $params ) {
- if ( ref $params ) {
- $self->{parameters} = $params;
- }
- else {
- $self->{_context}->log->warn(
- "Attempt to retrieve '$params' with req->params(), " .
- "you probably meant to call req->param('$params')" );
- }
- }
- return $self->{parameters};
-}
-
=head2 $req->path
Returns the path, i.e. the part of the URI after $req->base, for the current request.
@@ -419,10 +444,6 @@
You have to set MyApp->config->{parse_on_demand} to use this directly.
-=cut
-
-sub read { shift->{_context}->read(@_); }
-
=head2 $req->referer
Shortcut for $req->headers->referer. Returns the referring page.
@@ -509,15 +530,6 @@
my $upload = $c->request->uploads->{field};
my $upload = $c->request->uploads->{field}->[0];
-=cut
-
-sub uploads {
- my ( $self, $uploads ) = @_;
- $self->{_context}->prepare_body;
- $self->{uploads} = $uploads if $uploads;
- return $self->{uploads};
-}
-
=head2 $req->uri
Returns a URI object for the current request. Stringifies to the URI text.
@@ -525,7 +537,8 @@
=head2 $req->uri_with( { key => 'value' } );
Returns a rewritten URI object for the current request. Key/value pairs
-passed in will override existing parameters. Unmodified pairs will be
+passed in will override existing parameters. You can remove an existing
+parameter by passing in an undef value. Unmodified pairs will be
preserved.
=cut
@@ -535,7 +548,7 @@
carp( 'No arguments passed to uri_with()' ) unless $args;
- for my $value ( values %$args ) {
+ foreach my $value ( values %$args ) {
next unless defined $value;
for ( ref $value eq 'ARRAY' ? @$value : $value ) {
$_ = "$_";
@@ -543,11 +556,12 @@
}
};
- my $uri = $self->uri->clone;
-
+ my $uri = $self->uri->clone;
+ my %query = ( %{ $uri->query_form_hash }, %$args );
+
$uri->query_form( {
- %{ $uri->query_form_hash },
- %$args
+ # remove undef values
+ map { defined $query{ $_ } ? ( $_ => $query{ $_ } ) : () } keys %query
} );
return $uri;
}
@@ -562,12 +576,14 @@
Shortcut to $req->headers->user_agent. Returns the user agent (browser)
version string.
+=head2 meta
+
+Provided by Moose
+
=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Marcus Ramberg, C<mramberg at cpan.org>
-
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify
@@ -575,4 +591,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Response.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Response.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Response.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,16 +1,29 @@
package Catalyst::Response;
-use strict;
-use base 'Class::Accessor::Fast';
+use Moose;
+use HTTP::Headers;
-__PACKAGE__->mk_accessors(qw/cookies body headers location status/);
+has cookies => (is => 'rw', default => sub { {} });
+has body => (is => 'rw', default => '');
+has location => (is => 'rw');
+has status => (is => 'rw', default => 200);
+has finalized_headers => (is => 'rw', default => 0);
+has headers => (
+ is => 'rw',
+ handles => [qw(content_encoding content_length content_type header)],
+ default => sub { HTTP::Headers->new() },
+ required => 1,
+ lazy => 1,
+);
+has _context => (
+ is => 'rw',
+ weak_ref => 1,
+ handles => ['write'],
+);
-*output = \&body;
+sub output { shift->body(@_) }
-sub content_encoding { shift->headers->content_encoding(@_) }
-sub content_length { shift->headers->content_length(@_) }
-sub content_type { shift->headers->content_type(@_) }
-sub header { shift->headers->header(@_) }
+no Moose;
=head1 NAME
@@ -39,12 +52,12 @@
=head1 METHODS
-=head2 $res->body(<$text|$fh|$iofh_object)
+=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<IO::FileHandle> type of object (Something that implements the read method
+you might want to use a L<IO::Handle> type of object (Something that implements the read method
in the same fashion), or a filehandle GLOB. Catalyst
will write it piece by piece into the response.
@@ -106,11 +119,17 @@
=head2 $res->redirect( $url, $status )
-Causes the response to redirect to the specified URL.
+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.
+
=cut
sub redirect {
@@ -127,6 +146,10 @@
return $self->location;
}
+=head2 $res->location
+
+Sets or returns the HTTP 'Location'.
+
=head2 $res->status
Sets or returns the HTTP status.
@@ -137,16 +160,35 @@
Writes $data to the output stream.
+=head2 meta
+
+Provided by Moose
+
+=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<IO::Handle>.
+
=cut
-sub write { shift->{_context}->write(@_); }
+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;
+ }
+
+ return 1;
+}
+
=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
-Marcus Ramberg, C<mramberg at cpan.org>
-
=head1 COPYRIGHT
This program is free software, you can redistribute it and/or modify
@@ -154,4 +196,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Runtime.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Runtime.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Runtime.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -7,11 +7,13 @@
# Remember to update this in Catalyst as well!
-our $VERSION='5.7012';
+our $VERSION='5.7099_03';
+$VERSION= eval $VERSION;
+
=head1 NAME
-Catalyst::Runtime - Catalyst Runtime version
+Catalyst::Runtime - The Catalyst Framework Runtime
=head1 SYNOPSIS
@@ -21,9 +23,9 @@
This is the primary class for the Catalyst-Runtime distribution, version 5.70.
-=head1 AUTHOR
+=head1 AUTHORS
-The Catalyst Core Team - see http://catalyst.perl.org/
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Stats.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Stats.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Stats.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,86 +1,81 @@
package Catalyst::Stats;
-use strict;
-use warnings;
+use Moose;
use Time::HiRes qw/gettimeofday tv_interval/;
use Text::SimpleTable ();
use Tree::Simple qw/use_weak_refs/;
use Tree::Simple::Visitor::FindByUID;
-sub new {
- my $class = shift;
+has enable => (is => 'rw', required => 1, default => sub{ 1 });
+has tree => (
+ is => 'ro',
+ required => 1,
+ default => sub{ Tree::Simple->new({t => [gettimeofday]}) }
+ );
+has stack => (
+ is => 'ro',
+ required => 1,
+ lazy => 1,
+ default => sub { [ shift->tree ] }
+ );
- my $root = Tree::Simple->new({t => [gettimeofday]});
- bless {
- enabled => 1,
- stack => [ $root ],
- tree => $root,
- }, ref $class || $class;
-}
-
-sub enable {
- my ($self, $enable) = @_;
-
- $self->{enabled} = $enable;
-}
-
sub profile {
my $self = shift;
- return unless $self->{enabled};
+ return unless $self->enable;
my %params;
if (@_ <= 1) {
- $params{comment} = shift || "";
+ $params{comment} = shift || "";
}
elsif (@_ % 2 != 0) {
- die "profile() requires a single comment parameter or a list of name-value pairs; found "
- . (scalar @_) . " values: " . join(", ", @_);
+ die "profile() requires a single comment parameter or a list of name-value pairs; found "
+ . (scalar @_) . " values: " . join(", ", @_);
}
else {
- (%params) = @_;
- $params{comment} ||= "";
+ (%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 = $#{$self->{stack}}; $i > 0; $i--) {
- if ($self->{stack}->[$i]->getNodeValue->{action} eq $params{end}) {
- my $node = $self->{stack}->[$i];
- splice(@{$self->{stack}}, $i, 1);
- # Adjust elapsed on partner node
- my $v = $node->getNodeValue;
- $v->{elapsed} = tv_interval($v->{t}, $t);
- return $node->getUID;
+ # 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});
+ # 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 = $self->{stack}->[-1] or return undef;
- my $n = $parent->getChildCount;
- $prev = $parent->getChild($n - 1) if $n > 0;
+ # 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},
+ 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(@{$self->{stack}}, $node) if $params{begin};
+ push(@{$stack}, $node) if $params{begin};
return $node->getUID;
}
@@ -92,14 +87,13 @@
sub report {
my $self = shift;
-# close any remaining open nodes
- for (my $i = $#{$self->{stack}}; $i > 0; $i--) {
- $self->profile(end => $self->{stack}->[$i]->getNodeValue->{action});
- }
+ # close any remaining open nodes
+ map { $self->profile(end => $_->getNodeValue->{action}) }
+ (reverse @{ $self->stack })[1 .. $#{$self->stack}];
my $t = Text::SimpleTable->new( [ 62, 'Action' ], [ 9, 'Time' ] );
my @results;
- $self->{tree}->traverse(
+ $self->tree->traverse(
sub {
my $action = shift;
my $stat = $action->getNodeValue;
@@ -109,7 +103,7 @@
$stat->{elapsed},
$stat->{action} ? 1 : 0,
);
- $t->row( ( q{ } x $r[0] ) . $r[1],
+ $t->row( ( q{ } x $r[0] ) . $r[1],
defined $r[2] ? sprintf("%fs", $r[2]) : '??');
push(@results, \@r);
}
@@ -122,10 +116,56 @@
my $visitor = Tree::Simple::Visitor::FindByUID->new;
$visitor->searchForUID($uid);
- $self->{tree}->accept($visitor);
+ $self->tree->accept($visitor);
return $visitor->getResult;
}
+sub accept {
+ my $self = shift;
+ $self->{tree}->accept( @_ );
+}
+
+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 };
+}
+
+sub traverse {
+ my $self = shift;
+ $self->{tree}->traverse( @_ );
+}
+
+no Moose;
+__PACKAGE__->meta->make_immutable();
+
1;
__END__
@@ -293,14 +333,28 @@
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 COMPATABILITY METHODS
+Some components might expect the stats object to be a regular Tree::Simple object.
+We've added some compatability methods to handle this scenario:
+
+=head2 accept
+
+=head2 addChild
+
+=head2 setNodeValue
+
+=head2 getNodeValue
+
+=head2 traverse
+
=head1 SEE ALSO
-L<Catalyst>.
+L<Catalyst>
-=head1 AUTHOR
+=head1 AUTHORS
-Jon Schutz
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -309,4 +363,6 @@
=cut
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Test.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Test.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Test.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,5 +1,7 @@
package Catalyst::Test;
+use Test::More;
+
use strict;
use warnings;
@@ -7,6 +9,10 @@
use Catalyst::Utils;
use Class::Inspector;
+use parent qw/Exporter/;
+our @EXPORT=qw/&content_like &action_ok &action_redirect &action_notfound &contenttype_is/;
+
+
=head1 NAME
Catalyst::Test - Test Catalyst Applications
@@ -21,6 +27,12 @@
request('index.html');
get('index.html');
+ use HTTP::Request::Common;
+ my $response = request POST '/foo', [
+ bar => 'baz',
+ something => 'else'
+ ];
+
# Run tests against a remote server
CATALYST_SERVER='http://localhost:3000/' prove -r -l lib/ t/
@@ -38,15 +50,22 @@
package main;
+ use Catalyst::Test 'TestApp';
use Test::More tests => 1;
- use Catalyst::Test 'TestApp';
ok( get('/foo') =~ /bar/ );
=head1 DESCRIPTION
-Test Catalyst Applications.
+This module allows you to make requests to a Catalyst application either without
+a server, by simulating the environment of an HTTP request using
+L<HTTP::Request::AsCGI> or remotely if you define the CATALYST_SERVER
+environment variable. This module also adds a few catalyst
+specific testing methods as displayed in the method section.
+The </get> and </request> functions take either a URI or an L<HTTP::Request>
+object.
+
=head2 METHODS
=head2 get
@@ -100,10 +119,13 @@
my $caller = caller(0);
*{"$caller\::request"} = $request;
*{"$caller\::get"} = $get;
+ __PACKAGE__->export_to_level(1);
}
=head2 local_request
+Simulate a request using L<HTTP::Request::AsCGI>.
+
=cut
sub local_request {
@@ -181,13 +203,80 @@
return $agent->request($request);
}
+=head2 action_ok
+
+Fetches the given url and check that the request was successful
+
+=head2 action_redirect
+
+Fetches the given url and check that the request was a redirect
+
+=head2 action_notfound
+
+Fetches the given url and check that the request was not found
+
+=head2 content_like
+
+Fetches the given url and matches the content against it.
+
+=head2 contenttype_is
+
+Check for given mime type
+
+=cut
+
+sub content_like {
+ my $caller=caller(0);
+ no strict 'refs';
+ my $get=*{"$caller\::get"};
+ my $action=shift;
+ return Test::More->builder->like(&$get($action), at _);
+}
+
+sub action_ok {
+ my $caller=caller(0);
+ no strict 'refs';
+ my $request=*{"$caller\::request"};
+ my $action=shift;
+ return Test::More->builder->ok(&$request($action)->is_success, @_);
+}
+
+sub action_redirect {
+ my $caller=caller(0);
+ no strict 'refs';
+ my $request=*{"$caller\::request"};
+ my $action=shift;
+ return Test::More->builder->ok(&$request($action)->is_redirect, at _);
+
+}
+
+sub action_notfound {
+ my $caller=caller(0);
+ no strict 'refs';
+ my $request=*{"$caller\::request"};
+ my $action=shift;
+ return Test::More->builder->is_eq(&$request($action)->code,404, at _);
+
+}
+
+
+sub contenttype_is {
+ my $caller=caller(0);
+ no strict 'refs';
+ my $request=*{"$caller\::request"};
+ my $action=shift;
+ my $res=&$request($action);
+ return Test::More->builder->is_eq(scalar($res->content_type), at _);
+}
+
=head1 SEE ALSO
-L<Catalyst>.
+L<Catalyst>, L<Test::WWW::Mechanize::Catalyst>,
+L<Test::WWW::Selenium::Catalyst>, L<Test::More>, L<HTTP::Request::Common>
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Utils.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Utils.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/Utils.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -8,6 +8,7 @@
use URI;
use Class::Inspector;
use Carp qw/croak/;
+use Cwd;
=head1 NAME
@@ -160,6 +161,7 @@
# find the @INC entry in which $file was found
(my $path = $inc_entry) =~ s/$file$//;
+ $path ||= cwd() if !defined $path || !length $path;
my $home = dir($path)->absolute->cleanup;
# pop off /lib and /blib if they're there
@@ -171,8 +173,9 @@
# clean up relative path:
# MyApp/script/.. -> MyApp
- my ($lastdir) = $home->dir_list( -1, 1 );
- if ( $lastdir eq '..' ) {
+ my $dir;
+ my @dir_list = $home->dir_list();
+ while (($dir = pop(@dir_list)) && $dir eq '..') {
$home = dir($home)->parent->parent;
}
@@ -328,10 +331,9 @@
return;
}
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at cpan.org>
-Yuval Kogman, C<nothingmuch at woobling.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/View.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/View.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst/View.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,7 @@
package Catalyst::View;
-use strict;
-use base qw/Catalyst::Component/;
+use Moose;
+extends qw/Catalyst::Component/;
=head1 NAME
@@ -52,10 +52,9 @@
=cut
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at oook.de>
-Marcus Ramberg, C<mramberg at cpan.org>
+Catalyst Contributors, see Catalyst.pm
=head1 COPYRIGHT
@@ -64,4 +63,7 @@
=cut
+no Moose;
+__PACKAGE__->meta->make_immutable();
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/lib/Catalyst.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,7 @@
package Catalyst;
-use strict;
-use base 'Catalyst::Component';
+use Moose;
+extends 'Catalyst::Component';
use bytes;
use Catalyst::Exception;
use Catalyst::Log;
@@ -13,7 +13,6 @@
use Devel::InnerPackage ();
use File::stat;
use Module::Pluggable::Object ();
-use NEXT;
use Text::SimpleTable ();
use Path::Class::Dir ();
use Path::Class::File ();
@@ -30,21 +29,30 @@
BEGIN { require 5.008001; }
-__PACKAGE__->mk_accessors(
- qw/counter request response state action stack namespace stats/
-);
+has stack => (is => 'rw', default => sub { [] });
+has stash => (is => 'rw', default => sub { {} });
+has state => (is => 'rw', default => 0);
+has stats => (is => 'rw');
+has action => (is => 'rw');
+has counter => (is => 'rw', default => sub { {} });
+has request => (is => 'rw', default => sub { $_[0]->request_class->new({}) }, required => 1, lazy => 1);
+has response => (is => 'rw', default => sub { $_[0]->response_class->new({}) }, required => 1, lazy => 1);
+has namespace => (is => 'rw');
-attributes->import( __PACKAGE__, \&namespace, 'lvalue' );
-
sub depth { scalar @{ shift->stack || [] }; }
+sub comp { shift->component(@_) }
-# Laziness++
-*comp = \&component;
-*req = \&request;
-*res = \&response;
+sub req {
+ # carp "the use of req() is deprecated in favour of request()";
+ my $self = shift; return $self->request(@_);
+}
+sub res {
+ # carp "the use of res() is deprecated in favour of response()";
+ my $self = shift; return $self->response(@_);
+}
# For backwards compatibility
-*finalize_output = \&finalize_body;
+sub finalize_output { shift->finalize_body(@_) };
# For statistics
our $COUNT = 1;
@@ -53,6 +61,8 @@
our $DETACH = "catalyst_detach\n";
our $GO = "catalyst_go\n";
+#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_class context_class request_class response_class stats_class
@@ -66,7 +76,7 @@
# Remember to update this in Catalyst::Runtime as well!
-our $VERSION = '5.7012';
+our $VERSION = '5.7099_03';
sub import {
my ( $class, @arguments ) = @_;
@@ -75,12 +85,18 @@
# callers @ISA.
return unless $class eq 'Catalyst';
- my $caller = caller(0);
+ my $caller = caller();
+ return if $caller eq 'main';
+ my $meta = Moose::Meta::Class->initialize($caller);
+ #Moose->import({ into => $caller }); #do we want to do this?
unless ( $caller->isa('Catalyst') ) {
- no strict 'refs';
- push @{"$caller\::ISA"}, $class, 'Catalyst::Controller';
+ my @superclasses = ($meta->superclasses, $class, 'Catalyst::Controller');
+ $meta->superclasses(@superclasses);
}
+ unless( $meta->has_method('meta') ){
+ $meta->add_method(meta => sub { Moose::Meta::Class->initialize("${caller}") } );
+ }
$caller->arguments( [@arguments] );
$caller->setup_home;
@@ -100,7 +116,7 @@
catalyst.pl MyApp
# add models, views, controllers
- script/myapp_create.pl model MyDatabase DBIC::Schema create=dynamic dbi:SQLite:/path/to/db
+ 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
@@ -313,7 +329,7 @@
=cut
-sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) }
+sub forward { my $c = shift; no warnings 'recursion'; $c->dispatcher->forward( $c, @_ ) }
=head2 $c->detach( $action [, \@arguments ] )
@@ -389,18 +405,22 @@
=cut
-sub stash {
+around stash => sub {
+ my $orig = shift;
my $c = shift;
+ my $stash = $orig->($c);
if (@_) {
- my $stash = @_ > 1 ? {@_} : $_[0];
- croak('stash takes a hash or hashref') unless ref $stash;
- foreach my $key ( keys %$stash ) {
- $c->{stash}->{$key} = $stash->{$key};
+ my $new_stash = @_ > 1 ? {@_} : $_[0];
+ croak('stash takes a hash or hashref') unless ref $new_stash;
+ foreach my $key ( keys %$new_stash ) {
+ $stash->{$key} = $new_stash->{$key};
}
}
- return $c->{stash};
-}
+ return $stash;
+};
+
+
=head2 $c->error
=head2 $c->error($error, ...)
@@ -451,87 +471,66 @@
$c->error(0);
}
+# search components given a name and some prefixes
+sub _comp_search_prefixes {
+ my ( $c, $name, @prefixes ) = @_;
+ my $appclass = ref $c || $c;
+ my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
-# search via regex
-sub _comp_search {
- my ( $c, @names ) = @_;
+ # 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 };
- foreach my $name (@names) {
- foreach my $component ( keys %{ $c->components } ) {
- return $c->components->{$component} if $component =~ /$name/i;
- }
- }
+ # undef for a name will return all
+ return keys %eligible if !defined $name;
- return undef;
-}
+ my $query = ref $name ? $name : qr/^$name$/i;
+ my @result = grep { $eligible{$_} =~ m{$query} } keys %eligible;
-# try explicit component names
-sub _comp_explicit {
- my ( $c, @names ) = @_;
+ return map { $c->components->{ $_ } } @result if @result;
- foreach my $try (@names) {
- return $c->components->{$try} if ( exists $c->components->{$try} );
- }
+ # if we were given a regexp to search against, we're done.
+ return if ref $name;
- return undef;
-}
+ # regexp fallback
+ $query = qr/$name/i;
+ @result = map { $c->components->{ $_ } } grep { $eligible{ $_ } =~ m{$query} } keys %eligible;
-# like component, but try just these prefixes before regex searching,
-# and do not try to return "sort keys %{ $c->components }"
-sub _comp_prefixes {
- my ( $c, $name, @prefixes ) = @_;
+ # no results? try against full names
+ if( !@result ) {
+ @result = map { $c->components->{ $_ } } grep { m{$query} } keys %eligible;
+ }
- my $appclass = ref $c || $c;
+ # don't warn if we didn't find any results, it just might not exist
+ if( @result ) {
+ $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
+ $c->log->warn( 'Relying on the regexp fallback behavior for component resolution is unreliable and unsafe.' );
+ $c->log->warn( 'If you really want to search, pass in a regexp as the argument.' );
+ }
- my @names = map { "${appclass}::${_}::${name}" } @prefixes;
-
- my $comp = $c->_comp_explicit(@names);
- return $comp if defined($comp);
- $comp = $c->_comp_search($name);
- return $comp;
+ return @result;
}
# Find possible names for a prefix
-
sub _comp_names {
my ( $c, @prefixes ) = @_;
-
my $appclass = ref $c || $c;
- my @pre = map { "${appclass}::${_}::" } @prefixes;
+ my $filter = "^${appclass}::(" . join( '|', @prefixes ) . ')::';
- my @names;
-
- COMPONENT: foreach my $comp ($c->component) {
- foreach my $p (@pre) {
- if ($comp =~ s/^$p//) {
- push(@names, $comp);
- next COMPONENT;
- }
- }
- }
-
+ my @names = map { s{$filter}{}; $_; } $c->_comp_search_prefixes( undef, @prefixes );
return @names;
}
-# Return a component if only one matches.
-sub _comp_singular {
- my ( $c, @prefixes ) = @_;
-
- my $appclass = ref $c || $c;
-
- my ( $comp, $rest ) =
- map { $c->_comp_search("^${appclass}::${_}::") } @prefixes;
- return $comp unless $rest;
-}
-
# Filter a component before returning by calling ACCEPT_CONTEXT if available
sub _filter_component {
my ( $c, $comp, @args ) = @_;
- if ( eval { $comp->can('ACCEPT_CONTEXT'); } ) {
+
+ if ( Scalar::Util::blessed($c) && eval { $comp->can('ACCEPT_CONTEXT'); } ) {
return $comp->ACCEPT_CONTEXT( $c, @args );
}
- else { return $comp }
+
+ return $comp;
}
=head2 COMPONENT ACCESSORS
@@ -545,13 +544,23 @@
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 ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/Controller C/ ),
- @args )
- if ($name);
+
+ if( $name ) {
+ 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 );
}
@@ -564,18 +573,27 @@
Any extra arguments are directly passed to ACCEPT_CONTEXT.
If the name is omitted, it will look for
- - a model object in $c->stash{current_model_instance}, then
+ - a model object in $c->stash->{current_model_instance}, then
- a model name in $c->stash->{current_model}, then
- a config setting 'default_model', or
- check if there is only one model, and return it if that's the case.
+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 ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/Model M/ ),
- @args )
- if $name;
+
+ if( $name ) {
+ 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};
@@ -584,19 +602,18 @@
}
return $c->model( $c->config->{default_model} )
if $c->config->{default_model};
- return $c->_filter_component( $c->_comp_singular(qw/Model M/) );
-}
+ my( $comp, $rest ) = $c->_comp_search_prefixes( undef, qw/Model M/);
-=head2 $c->controllers
+ if( $rest ) {
+ $c->log->warn( '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.80, the "random" behavior will not work at all.' );
+ }
-Returns the available names which can be passed to $c->controller
-
-=cut
-
-sub controllers {
- my ( $c ) = @_;
- return $c->_comp_names(qw/Controller C/);
+ return $c->_filter_component( $comp );
}
@@ -609,18 +626,27 @@
Any extra arguments are directly passed to ACCEPT_CONTEXT.
If the name is omitted, it will look for
- - a view object in $c->stash{current_view_instance}, then
+ - a view object in $c->stash->{current_view_instance}, then
- a view name in $c->stash->{current_view}, then
- a config setting 'default_view', or
- check if there is only one view, and return it if that's the case.
+If 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 ) = @_;
- return $c->_filter_component( $c->_comp_prefixes( $name, qw/View V/ ),
- @args )
- if $name;
+
+ if( $name ) {
+ 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};
@@ -629,9 +655,31 @@
}
return $c->view( $c->config->{default_view} )
if $c->config->{default_view};
- return $c->_filter_component( $c->_comp_singular(qw/View V/) );
+
+ 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.80, 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
@@ -664,35 +712,52 @@
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.
+
=cut
sub component {
- my $c = shift;
+ my ( $c, $name, @args ) = @_;
- if (@_) {
+ if( $name ) {
+ my $comps = $c->components;
- my $name = shift;
+ if( !ref $name ) {
+ # is it the exact name?
+ return $c->_filter_component( $comps->{ $name }, @args )
+ if exists $comps->{ $name };
- my $appclass = ref $c || $c;
+ # perhaps we just omitted "MyApp"?
+ my $composed = ( ref $c || $c ) . "::${name}";
+ return $c->_filter_component( $comps->{ $composed }, @args )
+ if exists $comps->{ $composed };
- my @names = (
- $name, "${appclass}::${name}",
- map { "${appclass}::${_}::${name}" }
- qw/Model M Controller C View V/
- );
+ # 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;
+ }
- my $comp = $c->_comp_explicit(@names);
- return $c->_filter_component( $comp, @_ ) if defined($comp);
+ # This is here so $c->comp( '::M::' ) works
+ my $query = ref $name ? $name : qr{$name}i;
- $comp = $c->_comp_search($name);
- return $c->_filter_component( $comp, @_ ) if defined($comp);
+ my @result = grep { m{$query} } keys %{ $c->components };
+ return map { $c->_filter_component( $_, @args ) } @result if ref $name;
+
+ if( $result[ 0 ] ) {
+ $c->log->warn( qq(Found results for "${name}" using regexp fallback.) );
+ $c->log->warn( 'Relying on the regexp fallback behavior for component resolution' );
+ $c->log->warn( 'is unreliable and unsafe. You have been warned' );
+ return $c->_filter_component( $result[ 0 ], @args );
+ }
+
+ # 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
@@ -711,14 +776,15 @@
=cut
-sub config {
+around config => sub {
+ my $orig = shift;
my $c = shift;
$c->log->warn("Setting config after setup has been run is not a good idea.")
if ( @_ and $c->setup_finished );
- $c->NEXT::config(@_);
-}
+ $c->$orig(@_);
+};
=head2 $c->log
@@ -824,7 +890,6 @@
sub setup {
my ( $class, @arguments ) = @_;
-
$class->log->warn("Running setup twice is not a good idea.")
if ( $class->setup_finished );
@@ -933,7 +998,9 @@
}
# Add our self to components, since we are also a component
- $class->components->{$class} = $class;
+ if( $class->isa('Catalyst::Controller') ){
+ $class->components->{$class} = $class;
+ }
$class->setup_actions;
@@ -1009,10 +1076,10 @@
if (my @keys = keys %$params) {
# somewhat lifted from URI::_query's query_form
$query = '?'.join('&', map {
+ my $val = $params->{$_};
s/([;\/?:@&=+,\$\[\]%])/$URI::Escape::escapes{$1}/go;
s/ /+/g;
my $key = $_;
- my $val = $params->{$_};
$val = '' unless defined $val;
(map {
$_ = "$_";
@@ -1131,7 +1198,7 @@
<p>That really depends on what <b>you</b> want to do.
We do, however, provide you with a few starting points.</p>
<p>If you want to jump right into web development with Catalyst
- you might want want to start with a tutorial.</p>
+ you might want to start with a tutorial.</p>
<pre>perldoc <a href="http://cpansearch.perl.org/dist/Catalyst-Manual/lib/Catalyst/Manual/Tutorial.pod">Catalyst::Manual::Tutorial</a></code>
</pre>
<p>Afterwards you can go on to check out a more complete look at our features.</p>
@@ -1241,9 +1308,9 @@
$c->state(0);
if ( $c->depth >= $RECURSION ) {
- my $action = "$code";
+ my $action = $code->reverse();
$action = "/$action" unless $action =~ /->/;
- my $error = qq/Deep recursion detected calling "$action"/;
+ my $error = qq/Deep recursion detected calling "${action}"/;
$c->log->error($error);
$c->error($error);
$c->state(0);
@@ -1254,7 +1321,7 @@
push( @{ $c->stack }, $code );
- eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) };
+ eval { $c->state( $code->execute( $class, $c, @{ $c->req->args } ) || 0 ) };
$c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info;
@@ -1288,9 +1355,10 @@
return if ( ( $code->name =~ /^_.*/ )
&& ( !$c->config->{show_internal_actions} ) );
- $c->counter->{"$code"}++;
+ my $action_name = $code->reverse();
+ $c->counter->{$action_name}++;
- my $action = "$code";
+ my $action = $action_name;
$action = "/$action" unless $action =~ /->/;
# determine if the call was the result of a forward
@@ -1309,7 +1377,7 @@
}
}
- my $uid = "$code" . $c->counter->{"$code"};
+ my $uid = $action_name . $c->counter->{$action_name};
# is this a root-level call or a forwarded call?
if ( $callsub =~ /forward$/ ) {
@@ -1352,6 +1420,8 @@
=cut
+#Why does this exist? This is no longer safe and WILL NOT WORK.
+# it doesnt seem to be used anywhere. can we remove it?
sub _localize_fields {
my ( $c, $localized, $code ) = ( @_ );
@@ -1379,8 +1449,9 @@
}
# Allow engine to handle finalize flow (for POE)
- if ( $c->engine->can('finalize') ) {
- $c->engine->finalize($c);
+ my $engine = $c->engine;
+ if ( my $code = $engine->can('finalize') ) {
+ $engine->$code($c);
}
else {
@@ -1444,31 +1515,34 @@
sub finalize_headers {
my $c = shift;
+ my $response = $c->response; #accessor calls can add up?
+
# Check if we already finalized headers
- return if $c->response->{_finalized_headers};
+ return if $response->finalized_headers;
# Handle redirects
- if ( my $location = $c->response->redirect ) {
+ if ( my $location = $response->redirect ) {
$c->log->debug(qq/Redirecting to "$location"/) if $c->debug;
- $c->response->header( Location => $location );
-
- if ( !$c->response->body ) {
+ $response->header( Location => $location );
+
+ #Moose TODO: we should probably be using a predicate method here ?
+ if ( !$response->body ) {
# Add a default body if none is already present
- $c->response->body(
+ $response->body(
qq{<html><body><p>This item has moved <a href="$location">here</a>.</p></body></html>}
);
}
}
# Content-Length
- if ( $c->response->body && !$c->response->content_length ) {
+ if ( $response->body && !$response->content_length ) {
# get the length from a filehandle
- if ( blessed( $c->response->body ) && $c->response->body->can('read') )
+ if ( blessed( $response->body ) && $response->body->can('read') )
{
- my $stat = stat $c->response->body;
+ my $stat = stat $response->body;
if ( $stat && $stat->size > 0 ) {
- $c->response->content_length( $stat->size );
+ $response->content_length( $stat->size );
}
else {
$c->log->warn('Serving filehandle without a content-length');
@@ -1476,14 +1550,14 @@
}
else {
# everything should be bytes at this point, but just in case
- $c->response->content_length( bytes::length( $c->response->body ) );
+ $response->content_length( bytes::length( $response->body ) );
}
}
# Errors
- if ( $c->response->status =~ /^(1\d\d|[23]04)$/ ) {
- $c->response->headers->remove_header("Content-Length");
- $c->response->body('');
+ if ( $response->status =~ /^(1\d\d|[23]04)$/ ) {
+ $response->headers->remove_header("Content-Length");
+ $response->body('');
}
$c->finalize_cookies;
@@ -1491,7 +1565,7 @@
$c->engine->finalize_headers( $c, @_ );
# Done
- $c->response->{_finalized_headers} = 1;
+ $response->finalized_headers(1);
}
=head2 $c->finalize_output
@@ -1561,7 +1635,10 @@
}
$COUNT++;
- $class->log->_flush() if $class->log->can('_flush');
+
+ if(my $coderef = $class->log->can('_flush')){
+ $class->log->$coderef();
+ }
return $status;
}
@@ -1575,48 +1652,24 @@
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 $c = $class->context_class->new(
- {
- counter => {},
- stack => [],
- request => $class->request_class->new(
- {
- arguments => [],
- body_parameters => {},
- cookies => {},
- headers => HTTP::Headers->new,
- parameters => {},
- query_parameters => {},
- secure => 0,
- captures => [],
- uploads => {}
- }
- ),
- response => $class->response_class->new(
- {
- body => '',
- cookies => {},
- headers => HTTP::Headers->new(),
- status => 200
- }
- ),
- stash => {},
- state => 0
- }
- );
+
+ my $c = $class->context_class->new({});
+ # For on-demand data
+ $c->request->_context($c);
+ $c->response->_context($c);
+
+ #surely this is not the most efficient way to do things...
$c->stats($class->stats_class->new)->enable($c->use_stats);
if ( $c->debug ) {
$c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION );
}
- # For on-demand data
- $c->request->{_context} = $c;
- $c->response->{_context} = $c;
- weaken( $c->request->{_context} );
- weaken( $c->response->{_context} );
-
+ #XXX reuse coderef from can
# Allow engine to direct the prepare flow (for POE)
if ( $c->engine->can('prepare') ) {
$c->engine->prepare( $c, @arguments );
@@ -1640,7 +1693,8 @@
}
my $method = $c->req->method || '';
- my $path = $c->req->path || '/';
+ my $path = $c->req->path;
+ $path = '/' unless length $path;
my $address = $c->req->address || '';
$c->log->debug(qq/"$method" request for "$path" from "$address"/)
@@ -1668,6 +1722,7 @@
sub prepare_body {
my $c = shift;
+ #Moose TODO: what is _body ??
# Do we run for the first time?
return if defined $c->request->{_body};
@@ -1891,6 +1946,11 @@
reference. Items in the array beginning with C<::> will have the
application class name prepended to them.
+All components found will also have any
+L<Devel::InnerPackage|inner packages> loaded and set up as components.
+Note, that modules which are B<not> an I<inner package> of the main
+file namespace loaded will not be instantiated as components.
+
=cut
sub setup_components {
@@ -1917,6 +1977,7 @@
# we know M::P::O found a file on disk so this is safe
Catalyst::Utils::ensure_class_loaded( $component, { ignore_loaded => 1 } );
+ #Class::MOP::load_class($component);
my $module = $class->setup_component( $component );
my %modules = (
@@ -1960,7 +2021,7 @@
Catalyst::Exception->throw(
message =>
qq/Couldn't instantiate component "$component", "COMPONENT() didn't return an object-like value"/
- ) unless eval { $instance->can( 'can' ) };
+ ) unless blessed($instance);
return $instance;
}
@@ -1986,9 +2047,7 @@
$dispatcher = $class->dispatcher_class;
}
- unless (Class::Inspector->loaded($dispatcher)) {
- require Class::Inspector->filename($dispatcher);
- }
+ Class::MOP::load_class($dispatcher);
# dispatcher instance
$class->dispatcher( $dispatcher->new );
@@ -2014,10 +2073,7 @@
if ( $ENV{MOD_PERL} ) {
# create the apache method
- {
- no strict 'refs';
- *{"$class\::apache"} = sub { shift->engine->apache };
- }
+ $class->meta->add_method('apache' => sub { shift->engine->apache });
my ( $software, $version ) =
$ENV{MOD_PERL} =~ /^(\S+)\/(\d+(?:[\.\_]\d+)+)/;
@@ -2074,9 +2130,10 @@
$engine = $class->engine_class;
}
- unless (Class::Inspector->loaded($engine)) {
- require Class::Inspector->filename($engine);
- }
+ Class::MOP::load_class($engine);
+ #unless (Class::Inspector->loaded($engine)) {
+ # require Class::Inspector->filename($engine);
+ #}
# check for old engines that are no longer compatible
my $old_engine;
@@ -2127,11 +2184,10 @@
$home = $env;
}
- unless ($home) {
- $home = Catalyst::Utils::home($class);
- }
+ $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');
}
@@ -2152,8 +2208,7 @@
my $env_debug = Catalyst::Utils::env_value( $class, 'DEBUG' );
if ( defined($env_debug) ? $env_debug : $debug ) {
- no strict 'refs';
- *{"$class\::debug"} = sub { 1 };
+ $class->meta->add_method('debug' => sub { 1 });
$class->log->debug('Debug messages enabled');
}
}
@@ -2177,8 +2232,7 @@
my $env = Catalyst::Utils::env_value( $class, 'STATS' );
if ( defined($env) ? $env : ($stats || $class->debug ) ) {
- no strict 'refs';
- *{"$class\::use_stats"} = sub { 1 };
+ $class->meta->add_method('use_stats' => sub { 1 });
$class->log->debug('Statistics enabled');
}
}
@@ -2216,12 +2270,17 @@
# no ignore_loaded here, the plugin may already have been
# defined in memory and we don't want to error on "no file" if so
- Catalyst::Utils::ensure_class_loaded( $plugin );
+ Class::MOP::load_class( $plugin );
$proto->_plugins->{$plugin} = 1;
unless ($instant) {
no strict 'refs';
- unshift @{"$class\::ISA"}, $plugin;
+ if( $class->can('meta') ){
+ my @superclasses = ($plugin, $class->meta->superclasses );
+ $class->meta->superclasses(@superclasses);
+ } else {
+ unshift @{"$class\::ISA"}, $plugin;
+ }
}
return $class;
}
@@ -2396,80 +2455,86 @@
=head2 L<Catalyst::Test> - The test suite.
-=head1 CREDITS
+=head1 PROJECT FOUNDER
-Andy Grundman
+sri: Sebastian Riedel <sri at cpan.org>
-Andy Wardley
+=head1 CONTRIBUTORS
-Andreas Marienborg
+abw: Andy Wardley
+acme: Leon Brocard <leon at astray.com>
+
Andrew Bramble
Andrew Ford
Andrew Ruthven
-Arthur Bergman
+andyg: Andy Grundman <andy at hybridized.org>
-Autrijus Tang
+audreyt: Audrey Tang
-Brian Cassidy
+bricas: Brian Cassidy <bricas at cpan.org>
-Carl Franks
+chansen: Christian Hansen
-Christian Hansen
+chicks: Christopher Hicks
-Christopher Hicks
+dkubb: Dan Kubb <dan.kubb-cpan at onautopilot.com>
-Dan Sully
+Drew Taylor
-Danijel Milicevic
+esskar: Sascha Kiefer
-David Kamholz
+fireartist: Carl Franks <cfranks at cpan.org>
-David Naughton
+gabb: Danijel Milicevic
-Drew Taylor
-
Gary Ashton Jones
Geoff Richards
-Jesse Sheidlower
+ilmari: Dagfinn Ilmari Mannsåker <ilmari at ilmari.org>
-Jesse Vincent
+jcamacho: Juan Camacho
Jody Belka
Johan Lindstrom
-Juan Camacho
+jon: Jon Schutz <jjschutz at cpan.org>
-Leon Brocard
+marcus: Marcus Ramberg <mramberg at cpan.org>
-Marcus Ramberg
+miyagawa: Tatsuhiko Miyagawa <miyagawa at bulknews.net>
-Matt S Trout
+mst: Matt S. Trout <mst at shadowcatsystems.co.uk>
-Robert Sedlacek
+mugwump: Sam Vilain
-Sam Vilain
+naughton: David Naughton
-Sascha Kiefer
+ningu: David Kamholz <dkamholz at cpan.org>
-Sebastian Willert
+nothingmuch: Yuval Kogman <nothingmuch at woobling.org>
-Tatsuhiko Miyagawa
+numa: Dan Sully <daniel at cpan.org>
-Ulf Edvinsson
+obra: Jesse Vincent
-Yuval Kogman
+omega: Andreas Marienborg
-=head1 AUTHOR
+phaylon: Robert Sedlacek <phaylon at dunkelheit.at>
-Sebastian Riedel, C<sri at oook.de>
+sky: Arthur Bergman
+the_jester: Jesse Sheidlower
+
+Ulf Edvinsson
+
+willert: Sebastian Willert <willert at cpan.org>
+
=head1 LICENSE
This library is free software, you can redistribute it and/or modify it under
@@ -2477,4 +2542,8 @@
=cut
+no Moose;
+
+__PACKAGE__->meta->make_immutable;
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/script/catalyst.pl
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/script/catalyst.pl 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/script/catalyst.pl 2008-09-08 23:24:28 UTC (rev 8371)
@@ -154,11 +154,9 @@
=back
-
The application module generated by the C<catalyst.pl> script is functional,
although it reacts to all requests by outputting a friendly welcome screen.
-
=head1 NOTE
Neither C<catalyst.pl> nor the generated helper script will overwrite existing
@@ -171,22 +169,16 @@
changed the generated code (although you do of course have all your code in a
version control system anyway, don't you ...).
-
-
=head1 SEE ALSO
L<Catalyst::Manual>, L<Catalyst::Manual::Intro>
-=head1 AUTHOR
+=head1 AUTHORS
-Sebastian Riedel, C<sri at oook.de>,
-Andrew Ford, C<A.Ford at ford-mason.co.uk>
+Catalyst Contributors, see Catalyst.pm
-
=head1 COPYRIGHT
-Copyright 2004-2005 Sebastian Riedel. All rights reserved.
-
This library is free software, you can redistribute it and/or modify it under
the same terms as Perl itself.
Modified: Catalyst-Runtime/5.80/branches/context_go/t/03podcoverage.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/03podcoverage.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/03podcoverage.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -4,4 +4,8 @@
plan skip_all => 'Test::Pod::Coverage 1.04 required' if $@;
plan skip_all => 'set TEST_POD to enable this test' unless $ENV{TEST_POD} || -e 'inc/.author';
-all_pod_coverage_ok();
+all_pod_coverage_ok(
+ {
+ also_private => ['BUILD']
+ }
+);
Deleted: Catalyst-Runtime/5.80/branches/context_go/t/04critic.rc
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/04critic.rc 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/04critic.rc 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,5 +0,0 @@
-include = CodeLayout::ProhibitHardTabs
-only = 1
-
-[CodeLayout::ProhibitHardTabs]
-allow_leading_tabs = 0
\ No newline at end of file
Modified: Catalyst-Runtime/5.80/branches/context_go/t/04critic.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/04critic.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/04critic.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -9,14 +9,13 @@
plan skip_all => 'Critic test only for developers.';
}
else {
- eval { require Test::Perl::Critic };
+ eval { require Test::NoTabs };
if ( $@ ) {
plan tests => 1;
- fail( 'You must install Test::Perl::Critic to run 04critic.t' );
+ fail( 'You must install Test::NoTabs to run 04critic.t' );
exit;
}
}
-my $rcfile = File::Spec->catfile( 't', '04critic.rc' );
-Test::Perl::Critic->import( -profile => $rcfile );
-all_critic_ok();
\ No newline at end of file
+Test::NoTabs->import;
+all_perl_files_ok(qw/lib/);
Modified: Catalyst-Runtime/5.80/branches/context_go/t/c3_mro.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/c3_mro.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/c3_mro.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -11,6 +11,10 @@
# 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',
@@ -31,6 +35,6 @@
foreach my $cat_mod (@cat_mods) {
eval " require $cat_mod ";
eval { Class::C3::calculateMRO($cat_mod) };
- ok(!$@, "calculateMRO for $cat_mod");
+ ok(!$@, "calculateMRO for $cat_mod: $@");
}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/conf/extra.conf.in
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/conf/extra.conf.in 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/conf/extra.conf.in 2008-09-08 23:24:28 UTC (rev 8371)
@@ -13,6 +13,10 @@
# 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]
<Location /rewrite>
RewriteEngine on
Added: Catalyst-Runtime/5.80/branches/context_go/t/custom_live_path_bug.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/custom_live_path_bug.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/custom_live_path_bug.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,39 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+our $iters;
+
+BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
+
+use Test::More tests => 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' );
+ }
+ }
+}
Added: Catalyst-Runtime/5.80/branches/context_go/t/dead_load_multiple_chained_attributes.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/dead_load_multiple_chained_attributes.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/dead_load_multiple_chained_attributes.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,31 @@
+#!perl
+
+use strict;
+use warnings;
+use lib 't/lib';
+
+use Test::More;
+
+plan tests => 4;
+
+use Catalyst::Test 'TestApp';
+
+eval q{
+ package TestApp::Controller::Action::Chained;
+ sub should_fail : Chained('/') Chained('foo') Args(0) {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions; };
+ok($@, 'Multiple chained attributes make action setup fail');
+
+eval q{
+ package TestApp::Controller::Action::Chained;
+ no warnings 'redefine';
+ sub should_fail {}
+};
+ok(!$@);
+
+eval { TestApp->setup_actions };
+ok(!$@, 'And ok again') or warn $@;
+
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Errors.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Errors.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Errors.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,6 +1,7 @@
package Catalyst::Plugin::Test::Errors;
use strict;
+use NEXT;
sub error {
my $c = shift;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Headers.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Headers.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Headers.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,6 +1,7 @@
package Catalyst::Plugin::Test::Headers;
use strict;
+use NEXT;
sub prepare {
my $class = shift;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Plugin.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Plugin.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/Catalyst/Plugin/Test/Plugin.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,6 +1,7 @@
package Catalyst::Plugin::Test::Plugin;
use strict;
+use NEXT;
use base qw/Catalyst::Base Class::Data::Inheritable/;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain/Relative.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,10 @@
+package TestApp::Controller::Action::Chained::ParentChain::Relative;
+use warnings;
+use strict;
+
+use base qw/ Catalyst::Controller /;
+
+# using ../ to go up more than one level
+sub chained_rel_two : Chained('../../one') Args(2) { }
+
+1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/ParentChain.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,4 +10,16 @@
#
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;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained/PathPrefix.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,12 @@
+package TestApp::Controller::Action::Chained::PathPrefix;
+
+use strict;
+use warnings;
+
+use base qw/Catalyst::Controller/;
+
+# this is kinda the same thing as: sub instance : Path {}
+# it should respond to: /action/chained/pathprefix/*
+sub instance : Chained('/') PathPrefix Args(1) { }
+
+1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Chained.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -175,6 +175,16 @@
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('') { }
+
sub end :Private {
my ($self, $c) = @_;
return if $c->stash->{no_end};
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Forward.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Forward.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Forward.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -85,4 +85,9 @@
$c->forward(qw/TestApp class_forward_test_method/);
}
+sub forward_to_uri_check : Local {
+ my ( $self, $c ) = @_;
+ $c->forward( 'Action::ForwardTo', 'uri_check' );
+}
+
1;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/ForwardTo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/ForwardTo.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/ForwardTo.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,11 @@
+package TestApp::Controller::Action::ForwardTo;
+
+use strict;
+use base 'TestApp::Controller::Action';
+
+sub uri_check : Private {
+ my ( $self, $c ) = @_;
+ $c->res->body( $c->uri_for('foo/bar')->path );
+}
+
+1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/Go.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -25,7 +25,7 @@
sub five : Local {
my ( $self, $c ) = @_;
- $c->forward('View::Dump::Request');
+ $c->go('View::Dump::Request');
}
sub inheritance : Local {
@@ -66,18 +66,6 @@
$c->go('/action/chained/foo/spoon',[1]);
}
-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');
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Action/TestRelative.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -26,15 +26,4 @@
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;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Args.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Args.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Args.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -2,7 +2,6 @@
use strict;
use base 'Catalyst::Base';
-use Data::Dumper;
sub args :Local {
my ( $self, $c ) = @_;
@@ -14,4 +13,4 @@
$c->res->body( join('', at _) );
}
-1;
\ No newline at end of file
+1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Request/URI.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Request/URI.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Request/URI.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -77,4 +77,26 @@
$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;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Response/Print.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Response/Print.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Engine/Response/Print.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,25 @@
+package TestApp::Controller::Engine::Response::Print;
+
+use strict;
+use base 'Catalyst::Base';
+
+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 $, = ',';
+ $c->res->print(qw/foo bar baz/);
+}
+
+1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Root.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Root.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Controller/Root.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -6,4 +6,18 @@
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 localregex : LocalRegex('^localregex$') {
+ 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');
+}
+
1;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Model/Foo.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Model/Foo.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp/Model/Foo.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -5,8 +5,12 @@
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 }
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestApp.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -29,7 +29,7 @@
sub execute {
my $c = shift;
my $class = ref( $c->component( $_[0] ) ) || $_[0];
- my $action = "$_[1]";
+ my $action = $_[1]->reverse;
my $method;
@@ -77,11 +77,6 @@
$c->response->headers->header( 'X-Class-Go-Test-Method' => 1 );
}
-sub class_visit_test_method :Private {
- my ( $self, $c ) = @_;
- $c->response->headers->header( 'X-Class-Visit-Test-Method' => 1 );
-}
-
sub loop_test : Local {
my ( $self, $c ) = @_;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppDoubleAutoBug.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppDoubleAutoBug.pm 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppDoubleAutoBug.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -18,7 +18,7 @@
sub execute {
my $c = shift;
my $class = ref( $c->component( $_[0] ) ) || $_[0];
- my $action = "$_[1]";
+ my $action = $_[1]->reverse();
my $method;
Added: Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppPathBug.pm
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppPathBug.pm (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/lib/TestAppPathBug.pm 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,19 @@
+use strict;
+use warnings;
+
+package TestAppPathBug;
+
+use Catalyst;
+
+our $VERSION = '0.01';
+
+__PACKAGE__->config( name => 'TestAppPathBug', root => '/some/dir' );
+
+__PACKAGE__->setup;
+
+sub foo : Path {
+ my ( $self, $c ) = @_;
+ $c->res->body( 'This is the foo method.' );
+}
+
+1;
Added: Catalyst-Runtime/5.80/branches/context_go/t/live_catalyst_test.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_catalyst_test.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_catalyst_test.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,11 @@
+use FindBin;
+use lib "$FindBin::Bin/lib";
+use Catalyst::Test 'TestApp';
+
+use Test::More tests => 5;
+
+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');
+contenttype_is('/action/local/one','text/plain','Contenttype check');
\ No newline at end of file
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_chained.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_chained.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_chained.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 124*$iters;
+use Test::More tests => 141*$iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
@@ -528,6 +528,86 @@
}
#
+ # 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.
#
{
@@ -863,4 +943,42 @@
}
+ #
+ # 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' );
+ }
}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_forward.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_forward.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_forward.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 47 * $iters;
+use Test::More tests => 50 * $iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
@@ -235,4 +235,14 @@
'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');
+ }
}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_go.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 54 * $iters;
+use Test::More tests => 50 * $iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
@@ -95,32 +95,15 @@
$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 visit command "Model::Foo": ]
- .q[Action cannot _DISPATCH.], "go('Model::...') test" );
- }
- {
- ok(
- my $response = request('http://localhost/action/go/view'),
- 'Request with args'
- );
- is( $response->content,
- q[FATAL ERROR: Couldn't visit command "View::Dump": ]
- .q[Action cannot _DISPATCH.], "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)' );
+ is( $response->content, 'old' );
}
{
@@ -130,7 +113,7 @@
'Request with args and method'
);
ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'new', 'go() with args (new)' );
+ is( $response->content, 'new' );
}
# test go with embedded args
@@ -141,7 +124,7 @@
'Request'
);
ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'ok', 'go() with args_embed_relative' );
+ is( $response->content, 'ok' );
}
{
@@ -151,7 +134,7 @@
'Request'
);
ok( $response->is_success, 'Response Successful 2xx' );
- is( $response->content, 'ok', 'go() with args_embed_absolute' );
+ is( $response->content, 'ok' );
}
{
my @expected = qw[
@@ -238,10 +221,7 @@
'Request'
);
ok( !$response->is_success, 'Response Fails' );
- is( $response->content,
- q(FATAL ERROR: Couldn't visit command "TestApp": )
- .q(Invalid action or component.), 'Error message'
- );
+ is( $response->content, q(FATAL ERROR: Couldn't go to command "TestApp": Invalid action or component.), 'Error message' );
}
{
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_path.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_path.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_path.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 30*$iters;
+use Test::More tests => 36*$iters;
use Catalyst::Test 'TestApp';
if ( $ENV{CAT_BENCHMARK} ) {
@@ -124,4 +124,22 @@
'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'
+ );
+ }
}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_regexp.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_regexp.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_component_controller_action_regexp.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -10,7 +10,7 @@
BEGIN { $iters = $ENV{CAT_BENCH_ITERS} || 1; }
-use Test::More tests => 28*$iters;
+use Test::More tests => 33*$iters;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -103,4 +103,19 @@
is( $req->captures->[ 0 ], 'mandatory', 'mandatory capture' );
is( $req->captures->[ 1 ], '/optional', 'optional capture' );
}
+
+ # test localregex in the root controller
+ {
+ ok( my $response = request('http://localhost/localregex'),
+ 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->content_type, 'text/plain', 'Response Content-Type' );
+ is( $response->header('X-Catalyst-Action'),
+ '^localregex$', 'Test Action' );
+ is(
+ $response->header('X-Test-Class'),
+ 'TestApp::Controller::Root',
+ 'Test Class'
+ );
+ }
}
Added: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_auth.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_auth.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_auth.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,43 @@
+#!perl
+
+# 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' );
+}
Property changes on: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_auth.t
___________________________________________________________________
Name: svn:keywords
+ Id
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_parameters.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_parameters.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_parameters.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -6,7 +6,7 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 40;
+use Test::More tests => 53;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -32,7 +32,7 @@
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,
+ is_deeply( $creq->parameters, $parameters,
'Catalyst::Request parameters' );
}
@@ -43,7 +43,7 @@
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';
+ is $creq->parameters->{q}, 'foo+bar', '%2b not double decoded';
}
{
@@ -53,7 +53,7 @@
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';
+ is $creq->parameters->{q}, 'foo=bar', '= not ignored';
}
{
@@ -84,10 +84,10 @@
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
isa_ok( $creq, 'Catalyst::Request' );
is( $creq->method, 'POST', 'Catalyst::Request method' );
- is_deeply( $creq->{parameters}, $parameters,
+ 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->uploads, {}, 'Catalyst::Request uploads' );
is_deeply( $creq->cookies, {}, 'Catalyst::Request cookie' );
}
@@ -109,7 +109,7 @@
ok( my $response = request($request), 'Request' );
ok( eval '$creq = ' . $response->content, 'Unserialize Catalyst::Request' );
- is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
+ is_deeply( $creq->parameters, $parameters, 'Catalyst::Request parameters' );
}
# raw query string support
@@ -129,11 +129,34 @@
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->uri->query, 'query+string', 'Catalyst::Request POST query_string' );
is( $creq->query_keywords, 'query string', 'Catalyst::Request query_keywords' );
- is_deeply( $creq->{parameters}, $parameters, 'Catalyst::Request parameters' );
+ 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' );
+ 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' );
+}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uploads.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uploads.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uploads.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -6,7 +6,7 @@
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 75;
+use Test::More tests => 88;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -14,6 +14,7 @@
use HTTP::Headers;
use HTTP::Headers::Util 'split_header_words';
use HTTP::Request::Common;
+use Path::Class::Dir;
{
my $creq;
@@ -60,7 +61,7 @@
my $disposition = $part->header('Content-Disposition');
my %parameters = @{ ( split_header_words($disposition) )[0] };
- my $upload = $creq->{uploads}->{ $parameters{filename} };
+ my $upload = $creq->uploads->{ $parameters{filename} };
isa_ok( $upload, 'Catalyst::Request::Upload' );
@@ -68,7 +69,7 @@
is( $upload->size, length( $part->content ), 'Upload Content-Length' );
# make sure upload is accessible via legacy params->{$file}
- is( $creq->{parameters}->{ $upload->filename },
+ is( $creq->parameters->{ $upload->filename },
$upload->filename, 'legacy param method ok' );
ok( !-e $upload->tempname, 'Upload temp file was deleted' );
@@ -120,7 +121,7 @@
my $disposition = $part->header('Content-Disposition');
my %parameters = @{ ( split_header_words($disposition) )[0] };
- my $upload = $creq->{uploads}->{ $parameters{name} }->[$i];
+ my $upload = $creq->uploads->{ $parameters{name} }->[$i];
isa_ok( $upload, 'Catalyst::Request::Upload' );
is( $upload->type, $part->content_type, 'Upload Content-Type' );
@@ -220,7 +221,7 @@
is( $creq->content_length, $request->content_length,
'Catalyst::Request Content-Length' );
- my $param = $creq->{parameters}->{testfile};
+ my $param = $creq->parameters->{testfile};
ok( @$param == 2, '2 values' );
is( $param->[0], 'textfield value', 'correct value' );
@@ -233,7 +234,7 @@
next unless exists $parameters{filename};
- my $upload = $creq->{uploads}->{ $parameters{name} };
+ my $upload = $creq->uploads->{ $parameters{name} };
isa_ok( $upload, 'Catalyst::Request::Upload' );
@@ -242,3 +243,63 @@
is( $upload->filename, 'catalyst_130pix.gif' );
}
}
+
+# test uploadtmp config var
+
+{
+ 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' );
+ }
+}
+
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uri.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uri.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_engine_request_uri.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,12 +1,10 @@
-#!perl
-
use strict;
use warnings;
use FindBin;
use lib "$FindBin::Bin/lib";
-use Test::More tests => 49;
+use Test::More tests => 66;
use Catalyst::Test 'TestApp';
use Catalyst::Request;
@@ -62,8 +60,8 @@
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' );
+ 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
@@ -71,8 +69,8 @@
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' );
+ 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
@@ -120,3 +118,36 @@
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";
+ ok( my $response = request($uri), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-uri-with' ), $uri, 'uri_with ok' );
+
+ # try with existing param
+ $uri = "$uri?x=1";
+ ok( $response = request($uri), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-uri-with' ), $uri, 'uri_with ok' );
+}
+
+{
+ my $uri = "http://localhost/engine/request/uri/uri_with_undef_ignore";
+ ok( my $response = request($uri), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-uri-with' ), "${uri}?a=1", 'uri_with ok' );
+
+ # remove an existing param
+ ok( $response = request("${uri}?b=1"), 'Request' );
+ ok( $response->is_success, 'Response Successful 2xx' );
+ is( $response->header( 'X-Catalyst-uri-with' ), "${uri}?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' );
+}
+
Added: Catalyst-Runtime/5.80/branches/context_go/t/live_engine_response_print.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_engine_response_print.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_engine_response_print.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,24 @@
+#!perl
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/lib";
+
+use Test::More tests => 9;
+use Catalyst::Test 'TestApp';
+
+my $expected = {
+ one => "foo",
+ two => "foobar",
+ three => "foo,bar,baz",
+};
+
+for my $action ( 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" );
+}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_priorities.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_priorities.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_priorities.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -8,7 +8,6 @@
use Test::More tests => 28;
use Catalyst::Test 'TestApp';
-use Data::Dumper;
local $^W = 0;
Modified: Catalyst-Runtime/5.80/branches/context_go/t/live_stats.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/live_stats.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/live_stats.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -23,7 +23,7 @@
{
ok( my $response = request('http://localhost/'), 'Request' );
ok( $response->is_success, 'Response Successful 2xx' );
- ok( $response->content =~ m/\/default.*?[\d.]+s.*- test.*[\d.]+s/s, 'Stats report');
+ like( $response->content, qr/\/default.*?[\d.]+s.*- test.*[\d.]+s/s, 'Stats report');
}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server-restart.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server-restart.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server-restart.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,5 +1,3 @@
-#!perl
-
# This test tests the standalone server's auto-restart feature.
use strict;
@@ -9,6 +7,7 @@
use FindBin;
use LWP::Simple;
use IO::Socket;
+use IPC::Open3;
use Test::More;
use Time::HiRes qw/sleep/;
eval "use Catalyst::Devel 1.0;";
@@ -21,14 +20,17 @@
plan tests => 120;
+my $tmpdir = "$FindBin::Bin/../t/tmp";
+
# clean up
-rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+rmtree $tmpdir if -d $tmpdir;
# create a TestApp and copy the test libs into it
-mkdir "$FindBin::Bin/../t/tmp";
-chdir "$FindBin::Bin/../t/tmp";
-system
- "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp";
+mkdir $tmpdir;
+chdir $tmpdir;
+
+system( 'perl', "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' );
+
chdir "$FindBin::Bin/..";
File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
@@ -38,9 +40,12 @@
# spawn the standalone HTTP server
my $port = 30000 + int rand( 1 + 10000 );
-my $pid = open my $server,
-"perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart 2>&1 |"
- or die "Unable to spawn standalone HTTP server: $!";
+my( $server, $pid );
+$pid = open3( undef, $server, undef,
+ 'perl', "-I$FindBin::Bin/../lib",
+ "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
+ $port, '-restart' )
+ or die "Unable to spawn standalone HTTP server: $!";
# switch to non-blocking reads so we can fail
# gracefully instead of just hanging forever
@@ -167,9 +172,11 @@
"-restartdirectory $app_root/lib/TestApp/Controller/$_"
} qw/Action Engine/;
-$pid = open $server,
-"perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port -restart $restartdirs 2>&1 |"
- or die "Unable to spawn standalone HTTP server: $!";
+$pid = open3( undef, $server, undef,
+ 'perl', "-I$FindBin::Bin/../lib",
+ "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port',
+ $port, '-restart', $restartdirs )
+ or die "Unable to spawn standalone HTTP server: $!";
$server->blocking( 0 );
Modified: Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/optional_http-server.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,10 +1,9 @@
-#!perl
-
use strict;
use warnings;
use File::Path;
use FindBin;
+use IPC::Open3;
use IO::Socket;
use Test::More;
@@ -18,13 +17,15 @@
# Run a single test by providing it as the first arg
my $single_test = shift;
+my $tmpdir = "$FindBin::Bin/../t/tmp";
+
# clean up
-rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
+rmtree $tmpdir if -d $tmpdir;
# create a TestApp and copy the test libs into it
-mkdir "$FindBin::Bin/../t/tmp";
-chdir "$FindBin::Bin/../t/tmp";
-system "perl -I$FindBin::Bin/../lib $FindBin::Bin/../script/catalyst.pl TestApp";
+mkdir $tmpdir;
+chdir $tmpdir;
+system( 'perl', "-I$FindBin::Bin/../lib", "$FindBin::Bin/../script/catalyst.pl", 'TestApp' );
chdir "$FindBin::Bin/..";
File::Copy::Recursive::dircopy( 't/lib', 't/tmp/TestApp/lib' );
@@ -33,8 +34,9 @@
# spawn the standalone HTTP server
my $port = 30000 + int rand(1 + 10000);
-my $pid = open my $server,
- "perl -I$FindBin::Bin/../lib $FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl -port $port 2>&1 |"
+my $pid = open3( undef, my $server, undef,
+ 'perl', "-I$FindBin::Bin/../lib",
+ "$FindBin::Bin/../t/tmp/TestApp/script/testapp_server.pl", '-port', $port )
or die "Unable to spawn standalone HTTP server: $!";
# wait for it to start
@@ -46,11 +48,12 @@
# run the testsuite against the HTTP server
$ENV{CATALYST_SERVER} = "http://localhost:$port";
+my $return;
if ( $single_test ) {
- system( "perl -Ilib/ $single_test" );
+ $return = system( "perl -Ilib/ $single_test" );
}
else {
- system( 'prove -r -Ilib/ t/live_*' );
+ $return = system( 'prove -r -Ilib/ t/live_*.t' );
}
# shut it down
@@ -60,7 +63,7 @@
# clean up
rmtree "$FindBin::Bin/../t/tmp" if -d "$FindBin::Bin/../t/tmp";
-ok( 'done' );
+is( $return, 0, 'live tests' );
sub check_port {
my ( $host, $port ) = @_;
Added: Catalyst-Runtime/5.80/branches/context_go/t/something/Makefile.PL
===================================================================
Added: Catalyst-Runtime/5.80/branches/context_go/t/something/script/foo/bar/for_dist
===================================================================
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_action_for.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_action_for.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_action_for.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -8,7 +8,7 @@
use Test::More;
-plan tests => 3;
+plan tests => 4;
use_ok('TestApp');
@@ -18,3 +18,6 @@
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');
Added: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_classdata.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_classdata.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_classdata.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,102 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+use Scalar::Util qw/refaddr blessed/;
+use Test::More tests => 37;
+
+{
+ package ClassDataTest;
+ use Moose;
+ with 'Catalyst::ClassData';
+
+ package ClassDataTest2;
+ use Moose;
+ extends 'ClassDataTest';
+
+}
+
+ my $scalar = '100';
+ my $arrayref = [];
+ my $hashref = {};
+ my $scalarref = \$scalar;
+ my $coderef = sub { "beep" };
+
+ my $scalar2 = '200';
+ my $arrayref2 = [];
+ my $hashref2 = {};
+ my $scalarref2 = \$scalar2;
+ my $coderef2 = sub { "beep" };
+
+ my $scalar3 = '300';
+ my $arrayref3 = [];
+ my $hashref3 = {};
+ my $scalarref3 = \$scalar3;
+ my $coderef3 = sub { "beep" };
+
+
+my @accessors = qw/_arrayref _hashref _scalarref _coderef _scalar/;
+ClassDataTest->mk_classdata($_) for @accessors;
+can_ok('ClassDataTest', @accessors);
+
+ClassDataTest2->mk_classdata("beep", "meep");
+is(ClassDataTest2->beep, "meep");
+
+ClassDataTest->_arrayref($arrayref);
+ClassDataTest->_hashref($hashref);
+ClassDataTest->_scalarref($scalarref);
+ClassDataTest->_coderef($coderef);
+ClassDataTest->_scalar($scalar);
+
+is(ref(ClassDataTest->_arrayref), 'ARRAY');
+is(ref(ClassDataTest->_hashref), 'HASH');
+is(ref(ClassDataTest->_scalarref), 'SCALAR');
+is(ref(ClassDataTest->_coderef), 'CODE');
+ok( !ref(ClassDataTest->_scalar) );
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
+
+
+is(ref(ClassDataTest2->_arrayref), 'ARRAY');
+is(ref(ClassDataTest2->_hashref), 'HASH');
+is(ref(ClassDataTest2->_scalarref), 'SCALAR');
+is(ref(ClassDataTest2->_coderef), 'CODE');
+ok( !ref(ClassDataTest2->_scalar) );
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef));
+is(ClassDataTest2->_scalar, $scalar);
+
+ClassDataTest2->_arrayref($arrayref2);
+ClassDataTest2->_hashref($hashref2);
+ClassDataTest2->_scalarref($scalarref2);
+ClassDataTest2->_coderef($coderef2);
+ClassDataTest2->_scalar($scalar2);
+
+is(refaddr(ClassDataTest2->_arrayref), refaddr($arrayref2));
+is(refaddr(ClassDataTest2->_hashref), refaddr($hashref2));
+is(refaddr(ClassDataTest2->_scalarref), refaddr($scalarref2));
+is(refaddr(ClassDataTest2->_coderef), refaddr($coderef2));
+is(ClassDataTest2->_scalar, $scalar2);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef));
+is(ClassDataTest->_scalar, $scalar);
+
+ClassDataTest->_arrayref($arrayref3);
+ClassDataTest->_hashref($hashref3);
+ClassDataTest->_scalarref($scalarref3);
+ClassDataTest->_coderef($coderef3);
+ClassDataTest->_scalar($scalar3);
+
+is(refaddr(ClassDataTest->_arrayref), refaddr($arrayref3));
+is(refaddr(ClassDataTest->_hashref), refaddr($hashref3));
+is(refaddr(ClassDataTest->_scalarref), refaddr($scalarref3));
+is(refaddr(ClassDataTest->_coderef), refaddr($coderef3));
+is(ClassDataTest->_scalar, $scalar3);
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,4 +1,4 @@
-use Test::More tests => 7;
+use Test::More tests => 22;
use strict;
use warnings;
@@ -12,6 +12,9 @@
use base qw/Catalyst/;
__PACKAGE__->components({ map { ($_, $_) } @complist });
+
+ # this is so $c->log->warn will work
+ __PACKAGE__->setup_log;
}
is(MyApp->comp('MyApp::V::View'), 'MyApp::V::View', 'Explicit return ok');
@@ -20,9 +23,70 @@
is(MyApp->comp('Model'), 'MyApp::M::Model', 'Single part return ok');
-is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
-
is_deeply([ MyApp->comp() ], \@complist, 'Empty return ok');
+# Is this desired behaviour?
is_deeply([ MyApp->comp('Foo') ], \@complist, 'Fallthrough return ok');
- # Is this desired behaviour?
+
+# regexp behavior
+{
+ is_deeply( [ MyApp->comp( qr{Model} ) ], [ 'MyApp::M::Model'], 'regexp ok' );
+ is_deeply( [ MyApp->comp('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
+ is_deeply( [ MyApp->comp('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
+ is_deeply( [ MyApp->comp('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+
+ # a couple other varieties for regexp fallback
+ is_deeply( [ MyApp->comp('M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+
+ {
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ is_deeply( [ MyApp->comp('::M::Model') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+ ok( $warnings, 'regexp fallback warnings' );
+
+ $warnings = 0;
+ is_deeply( [ MyApp->comp('Mode') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+ ok( $warnings, 'regexp fallback warnings' );
+
+ $warnings = 0;
+ is(MyApp->comp('::M::'), 'MyApp::M::Model', 'Regex return ok');
+ ok( $warnings, 'regexp fallback for comp() warns' );
+ }
+
+}
+
+# multiple returns
+{
+ my @expected = qw( MyApp::C::Controller MyApp::M::Model );
+ is_deeply( [ MyApp->comp( qr{::[MC]::} ) ], \@expected, 'multiple results fro 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');
+}
+
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_layers.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_layers.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_layers.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,4 +1,4 @@
-use Test::More tests => 5;
+use Test::More tests => 6;
use strict;
use warnings;
use lib 't/lib';
@@ -19,3 +19,8 @@
can_ok($model_foo_bar, 'model_foo_bar_method_from_foo');
can_ok($model_foo_bar, 'model_foo_bar_method_from_foo_bar');
+
+TestApp->setup;
+
+is($model_foo->model_quux_method, 'chunkybacon', 'Model method getting $self->{quux} from config');
+
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_loading.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_loading.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_loading.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -63,6 +63,7 @@
write_component_file(\@dir_list, $name_final, <<EOF);
package $fullname;
+use NEXT;
use base '$compbase';
sub COMPONENT {
my \$self = shift->NEXT::COMPONENT(\@_);
Added: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_mro.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_mro.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_component_mro.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,26 @@
+use Test::More tests => 2;
+use strict;
+use warnings;
+
+{
+ package MyApp::Component;
+ use Test::More;
+
+ sub COMPONENT{
+ my $caller = caller;
+ is($caller, 'Catalyst::Component', 'Correct method resolution');
+ }
+
+ package MyApp::MyComponent;
+
+ use base 'Catalyst::Component', 'MyApp::Component';
+
+}
+
+{
+ my $expects = qr/after Catalyst::Component in MyApp::Component/;
+ local $SIG{__WARN__} = sub {
+ like($_[0], $expects, 'correct warning thrown');
+ };
+ MyApp::MyComponent->COMPONENT('MyApp');
+}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_mvc.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_mvc.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_mvc.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,4 +1,4 @@
-use Test::More tests => 27;
+use Test::More tests => 45;
use strict;
use warnings;
@@ -18,6 +18,9 @@
use base qw/Catalyst/;
__PACKAGE__->components( { map { ( ref($_)||$_ , $_ ) } @complist } );
+
+ # allow $c->log->warn to work
+ __PACKAGE__->setup_log;
}
is( MyApp->view('View'), 'MyApp::V::View', 'V::View ok' );
@@ -39,6 +42,11 @@
is( MyApp->model('M'), 'MyApp::Model::M', 'Model::M ok' );
+# failed search
+{
+ is( MyApp->model('DNE'), undef, 'undef for invalid search' );
+}
+
is_deeply( [ sort MyApp->views ],
[ qw/V View/ ],
'views ok' );
@@ -51,8 +59,15 @@
[ qw/Dummy::Model M Model Test::Object/ ],
'models ok');
-is (MyApp->view , 'MyApp::V::View', 'view() with no defaults ok');
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ like (MyApp->view , qr/^MyApp\::(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'}}, 'MyApp')->view , 'MyApp::View::V', 'current_view ok');
my $view = bless {} , 'MyApp::View::V';
@@ -61,8 +76,15 @@
is ( bless ({stash=>{current_view_instance=> $view, current_view=>'MyApp::V::View' }}, 'MyApp')->view , $view,
'current_view_instance precedes current_view ok');
-is (MyApp->model , 'MyApp::M::Model', 'model() with no defaults ok');
+{
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+ like (MyApp->model , qr/^MyApp\::(M|Model)\::/ , 'model() with no defaults returns *something*');
+ ok( $warnings, 'model() w/o a default is random, warnings thrown' );
+}
+
is ( bless ({stash=>{current_model=>'M'}}, 'MyApp')->model , 'MyApp::Model::M', 'current_model ok');
my $model = bless {} , 'MyApp::Model::M';
@@ -79,14 +101,74 @@
is ( bless ({stash=>{}}, 'MyApp')->model , 'MyApp::Model::M', 'default_model ok');
is ( MyApp->model , 'MyApp::Model::M', 'default_model in class method ok');
+# regexp behavior tests
+{
+ # is_deeply is used because regexp behavior means list context
+ is_deeply( [ MyApp->view( qr{^V[ie]+w$} ) ], [ 'MyApp::V::View' ], 'regexp view ok' );
+ is_deeply( [ MyApp->controller( qr{Dummy\::Model$} ) ], [ 'MyApp::Controller::Model::Dummy::Model' ], 'regexp controller ok' );
+ is_deeply( [ MyApp->model( qr{Dum{2}y} ) ], [ 'MyApp::Model::Dummy::Model' ], 'regexp model ok' );
+
+ # object w/ qr{}
+ is_deeply( [ MyApp->model( qr{Test} ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
+
+ {
+ my $warnings = 0;
+ no warnings 'redefine';
+ local *Catalyst::Log::warn = sub { $warnings++ };
+
+ # object w/ regexp fallback
+ is_deeply( [ MyApp->model( 'Test' ) ], [ MyApp->components->{'MyApp::Model::Test::Object'} ], 'Object returned' );
+ ok( $warnings, 'regexp fallback warnings' );
+ }
+
+ is_deeply( [ MyApp->view('MyApp::V::View$') ], [ 'MyApp::V::View' ], 'Explicit return ok');
+ is_deeply( [ MyApp->controller('MyApp::C::Controller$') ], [ 'MyApp::C::Controller' ], 'Explicit return ok');
+ is_deeply( [ MyApp->model('MyApp::M::Model$') ], [ 'MyApp::M::Model' ], 'Explicit return ok');
+}
+
+{
+ my @expected = qw( MyApp::C::Controller MyApp::Controller::C );
+ is_deeply( [ sort MyApp->controller( qr{^C} ) ], \@expected, 'multiple controller returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyApp::V::View MyApp::View::V );
+ is_deeply( [ sort MyApp->view( qr{^V} ) ], \@expected, 'multiple view returns from regexp search' );
+}
+
+{
+ my @expected = qw( MyApp::M::Model MyApp::Model::M );
+ is_deeply( [ sort MyApp->model( qr{^M} ) ], \@expected, 'multiple model returns from regexp search' );
+}
+
+# failed search
+{
+ is( scalar MyApp->controller( qr{DNE} ), 0, '0 results for failed search' );
+}
+
#checking @args passed to ACCEPT_CONTEXT
-my $args;
{
- no warnings;
- *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
- *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
-}
-MyApp->model('M', qw/foo bar/);
-is_deeply($args, [qw/foo bar/], '$c->model args passed to ACCEPT_CONTEXT ok');
-MyApp->view('V', qw/baz moo/);
-is_deeply($args, [qw/baz moo/], '$c->view args passed to ACCEPT_CONTEXT ok');
+ my $args;
+
+ {
+ no warnings 'once';
+ *MyApp::Model::M::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ *MyApp::View::V::ACCEPT_CONTEXT = sub { my ($self, $c, @args) = @_; $args= \@args};
+ }
+
+ my $c = bless {}, 'MyApp';
+
+ $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');
+
+ undef $args;
+ MyApp->model('M', qw/foo bar/);
+ is($args, undef, 'MyApp->model does not invoke ACCEPT_CONTEXT');
+}
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_core_uri_for.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_core_uri_for.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_core_uri_for.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use Test::More tests => 14;
+use Test::More tests => 15;
use URI;
use_ok('Catalyst');
@@ -58,6 +58,11 @@
'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(
Modified: Catalyst-Runtime/5.80/branches/context_go/t/unit_stats.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_stats.t 2008-09-08 23:08:04 UTC (rev 8370)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_stats.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -3,8 +3,9 @@
use strict;
use warnings;
-use Test::More tests => 6;
+use Test::More tests => 12;
use Time::HiRes qw/gettimeofday/;
+use Tree::Simple;
my @fudge_t = ( 0, 0 );
BEGIN {
@@ -14,75 +15,141 @@
BEGIN { use_ok("Catalyst::Stats") };
+{
+ my $stats = Catalyst::Stats->new;
+ is (ref($stats), "Catalyst::Stats", "new");
-my $stats = Catalyst::Stats->new;
-is (ref($stats), "Catalyst::Stats", "new");
+ my @expected; # level, string, 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] = 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] = 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] = 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[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");
-$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);
-$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 ]);
-$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);
-$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] = 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] = 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] = 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] = 500000;
-$stats->profile(comment => "interleave 2");
-push(@expected, [ 4, "- interleave 2", 0.2, 0 ]);
+ $fudge_t[1] = 600000; # end badly nested block time
+ $stats->profile(end => "badly nested block 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[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");
-$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 ]);
-push(@expected, [ 2, "- attach to uid", 0.1, 0 ]);
+ my @report = $stats->report;
+ is_deeply(\@report, \@expected, "report");
-my @report = $stats->report;
-is_deeply(\@report, \@expected, "report");
+ is ($stats->elapsed, 14, "elapsed");
+}
-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()' );
+}
+
Added: Catalyst-Runtime/5.80/branches/context_go/t/unit_utils_subdir.t
===================================================================
--- Catalyst-Runtime/5.80/branches/context_go/t/unit_utils_subdir.t (rev 0)
+++ Catalyst-Runtime/5.80/branches/context_go/t/unit_utils_subdir.t 2008-09-08 23:24:28 UTC (rev 8371)
@@ -0,0 +1,44 @@
+use Test::More tests => 8;
+
+use strict;
+use warnings;
+
+# simulates an entire testapp rooted at t/something
+# except without bothering creating it since its
+# 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' );
+}
More information about the Catalyst-commits
mailing list