From: Guillermo Roditi Date: Mon, 23 Jun 2008 20:59:23 +0000 (+0000) Subject: reverting back to when tests pass. applying changes one by one to find what failed X-Git-Tag: 5.8000_03~124 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=e8b9f2a92084b3b9dab6b2b879900481b8548b3b reverting back to when tests pass. applying changes one by one to find what failed r16978@martha (orig r7501): groditi | 2008-03-15 00:42:23 -0400 --- diff --git a/Makefile.PL b/Makefile.PL index d183865..ab5e7c6 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -1,15 +1,11 @@ use inc::Module::Install 0.64; -use 5.008001; +use 5.008001; perl_version '5.8.1'; name 'Catalyst-Runtime'; all_from 'lib/Catalyst/Runtime.pm'; -#from Moose port: -requires 'Moose'; #version tbd. -requires 'MooseX::ClassAttribute'; #version tbd - requires 'perl' => '5.8.1'; requires 'Carp'; requires 'Class::Accessor::Fast'; @@ -42,7 +38,7 @@ if (-e 'inc/.author') { build_requires 'Test::Pod' => 1.14; build_requires 'Test::Pod::Coverage' => 1.04; - if ($^O eq 'darwin') { + if ($^O eq 'darwin') { my $osx_ver = `/usr/bin/sw_vers -productVersion`; chomp $osx_ver; @@ -52,7 +48,7 @@ if (-e 'inc/.author') { makemaker_args(dist => { PREOP => qq{\@if [ "\$\$$attr" != "true" ]; then}. qq{ echo "You must set the ENV variable $attr to true,"; }. - ' echo "to avoid getting resource forks in your dist."; exit 255; fi' }); + ' echo "to avoid getting resource forks in your dist."; exit 255; fi' }); } } @@ -72,7 +68,7 @@ print <<"EOF"; perl -MCPANPLUS -e 'install Catalyst::Devel' # or perl -MCPAN -e 'install Catalyst::Devel' - To get some commonly used plugins, as well as the TT view and DBIC + To get some commonly used plugins, as well as the TT view and DBIC model, install Task::Catalyst in the same way. Have fun! diff --git a/TODO b/TODO index 34b771a..68132aa 100644 --- a/TODO +++ b/TODO @@ -7,8 +7,6 @@ * Catalyst::Action * Catalyst::ActionChain * Catalyst::ActionContainer - * Catalyst::Log - * Catalyst::Exception - Make classes immutable at setup() time diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 381a250..9183864 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,9 +1,7 @@ package Catalyst; -use Moose; -#use MooseX::ClassAttribute; -extends 'Catalyst::Component'; - +use strict; +use base 'Catalyst::Component'; use bytes; use Catalyst::Exception; use Catalyst::Log; @@ -32,15 +30,9 @@ use Carp qw/croak carp/; BEGIN { require 5.008001; } -has counter => ( is => 'rw'); -has request => ( is => 'rw'); -has response => ( is => 'rw'); -has state => ( is => 'rw'); -has action => ( is => 'rw'); -has stack => ( is => 'rw'); -has namespace => ( is => 'rw'); -has stats => ( is => 'rw'); - +__PACKAGE__->mk_accessors( + qw/counter request response state action stack namespace stats/ +); attributes->import( __PACKAGE__, \&namespace, 'lvalue' ); @@ -60,22 +52,9 @@ our $START = time; our $RECURSION = 1000; our $DETACH = "catalyst_detach\n"; -# class_has components => (is => 'rw'); -# class_has arguments => (is => 'rw'); -# class_has dispatcher => (is => 'rw'); -# class_has engine => (is => 'rw'); -# class_has log => (is => 'rw'); -# class_has dispatcher_class => (is => 'rw', required => 1, default => sub {'Catalyst::Dispatcher'}); -# class_has engine_class => (is => 'rw', required => 1, default => sub {'Catalyst::Engine::CGI'}); -# class_has context_class => (is => 'rw'); -# class_has request_class => (is => 'rw', required => 1, default => sub {'Catalyst::Request'}); -# class_has response_class => (is => 'rw', required => 1, default => sub {'Catalyst::Response'}); -# class_has stats_class => (is => 'rw', required => 1, default => sub {'Catalyst::Stats'}); -# class_has setup_finished => (is => 'rw'); - __PACKAGE__->mk_classdata($_) for qw/components arguments dispatcher engine log dispatcher_class - engine_class context_class request_class response_class stats_class + engine_class context_class request_class response_class stats_class setup_finished/; __PACKAGE__->dispatcher_class('Catalyst::Dispatcher'); @@ -100,9 +79,6 @@ sub import { unless ( $caller->isa('Catalyst') ) { no strict 'refs'; push @{"$caller\::ISA"}, $class, 'Catalyst::Controller'; - #my $caller_meta = $caller->meta; - #my @isa = $caller_meta->superclasses; - #$caller_meta->superclasses(@isa, $class, 'Catalyst::Controller'); } $caller->arguments( [@arguments] ); @@ -136,30 +112,30 @@ documentation and tutorials. ### in lib/MyApp.pm use Catalyst qw/-Debug/; # include plugins here as well - + ### In lib/MyApp/Controller/Root.pm (autocreated) sub foo : Global { # called for /foo, /foo/1, /foo/1/2, etc. my ( $self, $c, @args ) = @_; # args are qw/1 2/ for /foo/1/2 $c->stash->{template} = 'foo.tt'; # set the template # lookup something from db -- stash vars are passed to TT - $c->stash->{data} = + $c->stash->{data} = $c->model('Database::Foo')->search( { country => $args[0] } ); if ( $c->req->params->{bar} ) { # access GET or POST parameters $c->forward( 'bar' ); # process another action - # do something else after forward returns + # do something else after forward returns } } - + # The foo.tt TT template can use the stash data from the database [% WHILE (item = data.next) %] [% item.foo %] [% END %] - + # called for /bar/of/soap, /bar/of/soap/10, etc. sub bar : Path('/bar/of/soap') { ... } # called for all actions, from the top-most controller downwards - sub auto : Private { + sub auto : Private { my ( $self, $c ) = @_; if ( !$c->user_exists ) { # Catalyst::Plugin::Authentication $c->res->redirect( '/login' ); # require login @@ -167,9 +143,9 @@ documentation and tutorials. } return 1; # success; carry on to next action } - + # called after all actions are finished - sub end : Private { + sub end : Private { my ( $self, $c ) = @_; if ( scalar @{ $c->error } ) { ... } # handle errors return if $c->res->body; # already have a response @@ -179,20 +155,20 @@ documentation and tutorials. ### in MyApp/Controller/Foo.pm # called for /foo/bar sub bar : Local { ... } - + # called for /blargle sub blargle : Global { ... } - + # an index action matches /foo, but not /foo/1, etc. sub index : Private { ... } - + ### in MyApp/Controller/Foo/Bar.pm # called for /foo/bar/baz sub baz : Local { ... } - + # first Root auto is called, then Foo auto, then this sub auto : Private { ... } - + # powerful regular expression paths are also possible sub details : Regex('^product/(\w+)/details$') { my ( $self, $c ) = @_; @@ -273,7 +249,7 @@ from the system environment with CATALYST_STATS or _STATS. The environment settings override the application, with _STATS having the highest priority. -e.g. +e.g. use Catalyst qw/-Stats=1/ @@ -344,8 +320,8 @@ sub forward { my $c = shift; $c->dispatcher->forward( $c, @_ ) } =head2 $c->detach() -The same as C, but doesn't return to the previous action when -processing is finished. +The same as C, but doesn't return to the previous action when +processing is finished. When called with no arguments it escapes the processing chain entirely. @@ -372,7 +348,7 @@ Catalyst). $c->stash->{foo} = $bar; $c->stash( { moose => 'majestic', qux => 0 } ); $c->stash( bar => 1, gorch => 2 ); # equivalent to passing a hashref - + # stash is automatically passed to the view for use in a template $c->forward( 'MyApp::View::TT' ); @@ -480,7 +456,7 @@ sub _comp_prefixes { return $comp; } -# Find possible names for a prefix +# Find possible names for a prefix sub _comp_names { my ( $c, @prefixes ) = @_; @@ -552,7 +528,7 @@ Gets a L instance by name. Any extra arguments are directly passed to ACCEPT_CONTEXT. -If the name is omitted, it will look for +If the name is omitted, it will look for - a model object in $c->stash{current_model_instance}, then - a model name in $c->stash->{current_model}, then - a config setting 'default_model', or @@ -566,7 +542,7 @@ sub model { @args ) if $name; if (ref $c) { - return $c->stash->{current_model_instance} + return $c->stash->{current_model_instance} if $c->stash->{current_model_instance}; return $c->model( $c->stash->{current_model} ) if $c->stash->{current_model}; @@ -597,7 +573,7 @@ Gets a L instance by name. Any extra arguments are directly passed to ACCEPT_CONTEXT. -If the name is omitted, it will look for +If the name is omitted, it will look for - a view object in $c->stash{current_view_instance}, then - a view name in $c->stash->{current_view}, then - a config setting 'default_view', or @@ -611,7 +587,7 @@ sub view { @args ) if $name; if (ref $c) { - return $c->stash->{current_view_instance} + return $c->stash->{current_view_instance} if $c->stash->{current_view_instance}; return $c->view( $c->stash->{current_view} ) if $c->stash->{current_view}; @@ -700,15 +676,14 @@ L. =cut -around config => sub { - my $orig = shift; +sub config { my $c = shift; $c->log->warn("Setting config after setup has been run is not a good idea.") if ( @_ and $c->setup_finished ); - $c->$orig(@_); -}; + $c->NEXT::config(@_); +} =head2 $c->log @@ -786,7 +761,6 @@ sub plugin { $class->_register_plugin( $plugin, 1 ); eval { $plugin->import }; - #MooseX::ClassAttribute::process_class_attribute($class, $name => (is => 'rw')); $class->mk_classdata($name); my $obj; eval { $obj = $plugin->new(@args) }; @@ -877,7 +851,7 @@ You are running an old script! EOF } - + if ( $class->debug ) { my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins; @@ -986,7 +960,7 @@ sub uri_for { } unshift(@args, $namespace || ''); } - + # join args with '/', or a blank string my $args = join('/', grep { defined($_) } @args); $args =~ s/\?/%3F/g; # STUPID STUPID SPECIAL CASE @@ -1157,7 +1131,7 @@ sub welcome_message {

In conclusion

-

The Catalyst team hopes you will enjoy using Catalyst as much +

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

@@ -1209,8 +1183,8 @@ that will be dumped on the error page in debug mode. sub dump_these { my $c = shift; - [ Request => $c->req ], - [ Response => $c->res ], + [ Request => $c->req ], + [ Response => $c->res ], [ Stash => $c->stash ], [ Config => $c->config ]; } @@ -1244,11 +1218,11 @@ sub execute { my $stats_info = $c->_stats_start_execute( $code ) if $c->use_stats; push( @{ $c->stack }, $code ); - + eval { $c->state( &$code( $class, $c, @{ $c->req->args } ) || 0 ) }; $c->_stats_finish_execute( $stats_info ) if $c->use_stats and $stats_info; - + my $last = pop( @{ $c->stack } ); if ( my $error = $@ ) { @@ -1303,7 +1277,7 @@ sub _stats_start_execute { # forward, locate the caller if ( my $parent = $c->stack->[-1] ) { $c->stats->profile( - begin => $action, + begin => $action, parent => "$parent" . $c->counter->{"$parent"}, uid => $uid, ); @@ -1318,7 +1292,7 @@ sub _stats_start_execute { } } else { - + # root-level call $c->stats->profile( begin => $action, @@ -1343,7 +1317,7 @@ sub _localize_fields { my $request = delete $localized->{request} || {}; my $response = delete $localized->{response} || {}; - + local @{ $c }{ keys %$localized } = values %$localized; local @{ $c->request }{ keys %$request } = values %$request; local @{ $c->response }{ keys %$response } = values %$response; @@ -1386,12 +1360,12 @@ sub finalize { $c->finalize_body; } - - if ($c->use_stats) { + + if ($c->use_stats) { my $elapsed = sprintf '%f', $c->stats->elapsed; my $av = $elapsed == 0 ? '??' : sprintf '%.3f', 1 / $elapsed; $c->log->info( - "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); + "Request took ${elapsed}s ($av/s)\n" . $c->stats->report . "\n" ); } return $c->response->status; @@ -1437,7 +1411,7 @@ sub finalize_headers { if ( my $location = $c->response->redirect ) { $c->log->debug(qq/Redirecting to "$location"/) if $c->debug; $c->response->header( Location => $location ); - + if ( !$c->response->body ) { # Add a default body if none is already present $c->response->body( @@ -1538,7 +1512,7 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; - $status = $c->finalize; + $status = $c->finalize; }; if ( my $error = $@ ) { @@ -1594,7 +1568,7 @@ sub prepare { $c->stats($class->stats_class->new)->enable($c->use_stats); if ( $c->debug ) { - $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); + $c->res->headers->header( 'X-Catalyst' => $Catalyst::VERSION ); } # For on-demand data @@ -1616,7 +1590,7 @@ sub prepare { # Prepare the body for reading, either by prepare_body # or the user, if they are using $c->read $c->prepare_read; - + # Parse the body unless the user wants it on-demand unless ( $c->config->{parse_on_demand} ) { $c->prepare_body; @@ -1883,9 +1857,9 @@ sub setup_components { my @paths = qw( ::Controller ::C ::Model ::M ::View ::V ); my $config = $class->config->{ setup_components }; my $extra = delete $config->{ search_extra } || []; - + push @paths, @$extra; - + my $locator = Module::Pluggable::Object->new( search_path => [ map { s/^(?=::)/$class/; $_; } @paths ], %$config @@ -1893,7 +1867,7 @@ sub setup_components { my @comps = sort { length $a <=> length $b } $locator->plugins; my %comps = map { $_ => 1 } @comps; - + for my $component ( @comps ) { # We pass ignore_loaded here so that overlay files for (e.g.) @@ -1907,11 +1881,11 @@ sub setup_components { $component => $module, map { $_ => $class->setup_component( $_ ) - } grep { + } grep { not exists $comps{$_} } Devel::InnerPackage::list_packages( $component ) ); - + for my $key ( keys %modules ) { $class->components->{ $key } = $modules{ $key }; } @@ -2168,7 +2142,7 @@ sub setup_stats { } -=head2 $c->registered_plugins +=head2 $c->registered_plugins Returns a sorted list of the plugins which have either been stated in the import list or which have been added via C<< MyApp->plugin(@args); >>. @@ -2206,7 +2180,6 @@ the plugin name does not begin with C. unless ($instant) { no strict 'refs'; unshift @{"$class\::ISA"}, $plugin; - # $class->meta->superclasses($plugin, $class->meta->superclasses); } return $class; } @@ -2301,7 +2274,7 @@ but if you want to handle input yourself, you can enable on-demand parsing with a config parameter. MyApp->config->{parse_on_demand} = 1; - + =head1 PROXY SUPPORT Many production servers operate using the common double-server approach, @@ -2315,9 +2288,9 @@ Catalyst will automatically detect this situation when you are running the frontend and backend servers on the same machine. The following changes are made to the request. - $c->req->address is set to the user's real IP address, as read from + $c->req->address is set to the user's real IP address, as read from the HTTP X-Forwarded-For header. - + The host value for $c->req->base and $c->req->uri is set to the real host, as read from the HTTP X-Forwarded-Host header. @@ -2329,7 +2302,7 @@ configuration option to tell Catalyst to read the proxied data from the headers. MyApp->config->{using_frontend_proxy} = 1; - + If you do not wish to use the proxy support at all, you may set: MyApp->config->{ignore_frontend_proxy} = 1; diff --git a/lib/Catalyst/AttrContainer.pm b/lib/Catalyst/AttrContainer.pm index 3117824..a33d822 100644 --- a/lib/Catalyst/AttrContainer.pm +++ b/lib/Catalyst/AttrContainer.pm @@ -1,36 +1,19 @@ package Catalyst::AttrContainer; -use Moose; -#use MooseX::ClassAttribute; +use strict; +use base qw/Class::Accessor::Fast Class::Data::Inheritable/; + use Catalyst::Exception; -use Class::Data::Inheritable; -{ - my $mk_classdata = Class::Data::Inheritable->can('mk_classdata'); - __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata); -} +use NEXT; -__PACKAGE__->mk_classdata(_attr_cache => {}); -__PACKAGE__->mk_classdata(_action_cache => []); - -# class_has _attr_cache => ( -# is => 'rw', -# isa => 'HashRef', -# required => 1, -# default => sub{{}} -# ); -# class_has _action_cache => ( -# is => 'rw', -# isa => 'ArrayRef', -# required => 1, -# default => sub{ [] } -# ); +__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache/; +__PACKAGE__->_attr_cache( {} ); +__PACKAGE__->_action_cache( [] ); # note - see attributes(3pm) sub MODIFY_CODE_ATTRIBUTES { my ( $class, $code, @attrs ) = @_; - #can't the below just be $class->_attr_cache->{$code} = \@attrs; ? $class->_attr_cache( { %{ $class->_attr_cache }, $code => [@attrs] } ); - #why can't this just be push @{$class->_action_cache}, [$code, \@attrs] ? $class->_action_cache( [ @{ $class->_action_cache }, [ $code, [@attrs] ] ] ); return (); @@ -46,7 +29,7 @@ Catalyst::AttrContainer =head1 DESCRIPTION -This class sets up the code attribute cache. It's a base class for +This class sets up the code attribute cache. It's a base class for L. =head1 METHODS diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm index b5b56e2..116aa9a 100644 --- a/lib/Catalyst/Component.pm +++ b/lib/Catalyst/Component.pm @@ -1,27 +1,9 @@ package Catalyst::Component; -use Moose; -#use MooseX::ClassAttribute; -use Catalyst::Utils; -use Class::Data::Inheritable; +use strict; +use base qw/Class::Accessor::Fast Class::Data::Inheritable/; use NEXT; - -{ - my $mk_classdata = Class::Data::Inheritable->can('mk_classdata'); - __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata); -} - -__PACKAGE__->mk_classdata(_config => {}); -__PACKAGE__->mk_classdata('_plugins'); - -# class_has _config => ( -# is => 'rw', -# isa => 'HashRef', -# required => 1, -# default => sub { {} } -# ); - -# class_has _plugins => ( is => 'rw' ); +use Catalyst::Utils; =head1 NAME @@ -46,7 +28,7 @@ Catalyst::Component - Catalyst Component Base Class my ( $self, $c ) = @_; $c->response->output( $self->{foo} ); } - + 1; # Methods can be a request step @@ -59,7 +41,7 @@ Catalyst::Component - Catalyst Component Base Class =head1 DESCRIPTION -This is the universal base class for Catalyst components +This is the universal base class for Catalyst components (Model/View/Controller). It provides you with a generic new() for instantiation through Catalyst's @@ -67,18 +49,19 @@ component loader with config() support and a process() method placeholder. =cut -#to do: are we switching to moose-style key => value constructors from -# catalyst-style {key => value} constructors ? +__PACKAGE__->mk_classdata($_) for qw/_config _plugins/; + -around new => sub { - my $orig = shift; + +sub new { my ( $self, $c ) = @_; # Temporary fix, some components does not pass context to constructor my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {}; - my $merged = $self->merge_config_hashes( $self->config, $arguments ); - $orig->( $self, $merged ); -}; + + return $self->NEXT::new( + $self->merge_config_hashes( $self->config, $arguments ) ); +} sub COMPONENT { my ( $self, $c ) = @_; @@ -86,32 +69,26 @@ sub COMPONENT { # Temporary fix, some components does not pass context to constructor my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {}; - #Moose TODO: I don't think I fully grok NEXT. is this here for MI or something? - # how can we have a next here? this -is- the base class.... if ( my $new = $self->NEXT::COMPONENT( $c, $arguments ) ) { return $new; } - #new here will always pass because $self ISA Moose::Object else { if ( my $new = $self->new( $c, $arguments ) ) { return $new; } else { my $class = ref $self || $self; - my $new = $self->merge_config_hashes( + my $new = $self->merge_config_hashes( $self->config, $arguments ); - #this will break, Moose::Object::new won't act like this return bless $new, $class; } } } -#Moose TODO: I have no fucking clue what's going on here (groditi) sub config { my $self = shift; my $config_sub = $self->can('_config'); - my $config = $self->$config_sub(); - #my $config = $self->_config; + my $config = $self->$config_sub() || {}; if (@_) { my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} }; $self->_config( @@ -130,7 +107,6 @@ sub config { if ((my $config_sub_now = $self->can('_config')) ne $config_sub) { - #this is retarded. if we want a new ref we could do: { %$config } $config = $self->merge_config_hashes( $config, {} ); $self->$config_sub_now( $config ); } @@ -167,8 +143,8 @@ If this method is present (as it is on all Catalyst::Component subclasses, it is called by Catalyst during setup_components with the application class as $c and any config entry on the application for this component (for example, in the case of MyApp::Controller::Foo this would be -MyApp->config->{'Controller::Foo'}). The arguments are expected to be a -hashref and are merged with the __PACKAGE__->config hashref before calling +MyApp->config->{'Controller::Foo'}). The arguments are expected to be a +hashref and are merged with the __PACKAGE__->config hashref before calling ->new to instantiate the component. =head2 $c->config @@ -177,15 +153,15 @@ hashref and are merged with the __PACKAGE__->config hashref before calling =head2 $c->config($key, $value, ...) -Accessor for this component's config hash. Config values can be set as +Accessor for this component's config hash. Config values can be set as key value pair, or you can specify a hashref. In either case the keys -will be merged with any existing config settings. Each component in +will be merged with any existing config settings. Each component in a Catalyst application has it's own config hash. =head2 $c->process() This is the default method called on a Catalyst component in the dispatcher. -For instance, Views implement this action to render the response body +For instance, Views implement this action to render the response body when you forward to them. The default is an abstract method. =head2 $c->merge_config_hashes( $hashref, $hashref ) diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index d31b704..ab77e21 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,43 +1,13 @@ package Catalyst::Controller; -use Moose; -use Class::MOP (); -#use MooseX::ClassAttribute; +use strict; +use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/; + use Catalyst::Exception; use Catalyst::Utils; use Class::Inspector; use NEXT; -#extends qw/Catalyst::Component Catalyst::AttrContainer/; -use base qw/Catalyst::Component Catalyst::AttrContainer/; - -# class_has _dispatch_steps => -# ( -# is => 'rw', -# isa => 'ArrayRef', -# required => 1, -# default => sub{ [qw/_BEGIN _AUTO _ACTION/] }, -# ); - -# class_has _action_class => -# ( -# is => 'rw', -# isa => 'ClassName', -# required => 1, -# default => sub{ 'Catalyst::Action' }, -# ); - -__PACKAGE__->mk_classdata('_dispatch_steps'); -__PACKAGE__->mk_classdata('_action_class'); - -__PACKAGE__->_action_class('Catalyst::Action'); -__PACKAGE__->_dispatch_steps([qw/_BEGIN _AUTO _ACTION/]); - - -has _application => ( is => 'rw' ); -### _app as alias -*_app = *_application; - =head1 NAME Catalyst::Controller - Catalyst Controller base class @@ -47,9 +17,9 @@ Catalyst::Controller - Catalyst Controller base class package MyApp::Controller::Search use base qw/Catalyst::Controller/; - sub foo : Local { + sub foo : Local { my ($self,$c,@args) = @_; - ... + ... } # Dispatches to /search/foo =head1 DESCRIPTION @@ -61,17 +31,15 @@ for more info about how Catalyst dispatches to actions. =cut -# just emulating old behavior. we could probably do this -# via BUILD later or pass $app as application => $app -around new => sub { - my $orig = shift; - my $self = shift; - my $app = $_[0]; - my $new = $self->$orig(@_); - $new->_application( $app ); - return $new; -}; +__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 ) = @_; @@ -120,6 +88,15 @@ sub _END : Private { return !@{ $c->error }; } +sub new { + my $self = shift; + my $app = $_[0]; + my $new = $self->NEXT::new(@_); + $new->_application( $app ); + return $new; +} + + sub action_for { my ( $self, $name ) = @_; my $app = ($self->isa('Catalyst') ? $self : $self->_application); @@ -154,12 +131,9 @@ sub register_actions { my $class = ref $self || $self; my $namespace = $self->action_namespace($c); my %methods; - { - my $meth_map = $class->meta->get_method_map; - @methods{values %$meth_map} = (keys %$meth_map); - } + $methods{ $self->can($_) } = $_ + for @{ Class::Inspector->methods($class) || [] }; - #Moose TODO: something tells me that roles could kill the directly code below # Advanced inheritance support for plugins and the like my @action_cache; { @@ -204,12 +178,10 @@ sub create_action { ? $args{attributes}{ActionClass}[0] : $self->_action_class); - #can we replace with a single call to Class::MOP::load_class() ? - #unless ( Class::Inspector->loaded($class) ) { - # require Class::Inspector->filename($class); - #} - Class::MOP::load_class($class); - + unless ( Class::Inspector->loaded($class) ) { + require Class::Inspector->filename($class); + } + return $class->new( \%args ); } @@ -338,7 +310,7 @@ controller name. For instance controller 'MyApp::Controller::Foo::Bar' will be bound to 'foo/bar'. The default Root controller is an example of setting namespace to '' (the null string). -=head2 path +=head2 path Sets 'path_prefix', as described below. diff --git a/lib/Catalyst/DispatchType.pm b/lib/Catalyst/DispatchType.pm index 99ce561..e885824 100644 --- a/lib/Catalyst/DispatchType.pm +++ b/lib/Catalyst/DispatchType.pm @@ -1,6 +1,8 @@ package Catalyst::DispatchType; use Moose; +#use strict; +#use base 'Class::Accessor::Fast'; =head1 NAME diff --git a/lib/Catalyst/DispatchType/Chained.pm b/lib/Catalyst/DispatchType/Chained.pm index bc12721..0dc4c25 100644 --- a/lib/Catalyst/DispatchType/Chained.pm +++ b/lib/Catalyst/DispatchType/Chained.pm @@ -1,33 +1,14 @@ package Catalyst::DispatchType::Chained; use Moose; +extends 'Catalyst::DispatchType'; + +#use strict; +#use base qw/Catalyst::DispatchType/; use Text::SimpleTable; use Catalyst::ActionChain; use URI; -extends 'Catalyst::DispatchType'; - -has _endpoints => ( - isa => 'rw', - isa => 'ArrayRef', - required => 1, - default => sub{ [] }, - ); - -has _actions => ( - isa => 'rw', - isa => 'HashRef', - required => 1, - default => sub{ {} }, - ); - -has _children_of => ( - isa => 'rw', - isa => 'HashRef', - required => 1, - default => sub{ {} }, - ); - # please don't perltidy this. hairy code within. =head1 NAME @@ -63,7 +44,7 @@ Debug output for Path Part dispatch points sub list { my ( $self, $c ) = @_; - return unless $self->_endpoints; + return unless $self->{endpoints}; my $paths = Text::SimpleTable->new( [ 35, 'Path Spec' ], [ 36, 'Private' ] @@ -71,7 +52,7 @@ sub list { 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) : '...'); @@ -87,7 +68,7 @@ sub list { 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 @@ -147,7 +128,7 @@ Recursive search for a matching chain. 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; @@ -254,7 +235,7 @@ sub register { $action->attributes->{Chained} = [ $parent ]; - my $children = $self->_children_of->{$parent}; + my $children = ($self->{children_of}{$parent} ||= {}); my @path_part = @{ $action->attributes->{PathPart} || [] }; @@ -278,10 +259,10 @@ sub register { 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; @@ -316,7 +297,7 @@ sub uri_for_action { 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 diff --git a/lib/Catalyst/DispatchType/Default.pm b/lib/Catalyst/DispatchType/Default.pm index 94f5b50..50a1630 100644 --- a/lib/Catalyst/DispatchType/Default.pm +++ b/lib/Catalyst/DispatchType/Default.pm @@ -3,6 +3,10 @@ package Catalyst::DispatchType::Default; use Moose; extends 'Catalyst::DispatchType'; + +#use strict; +#use base qw/Catalyst::DispatchType/; + =head1 NAME Catalyst::DispatchType::Default - Default DispatchType diff --git a/lib/Catalyst/DispatchType/Index.pm b/lib/Catalyst/DispatchType/Index.pm index 8ffda14..ca68118 100644 --- a/lib/Catalyst/DispatchType/Index.pm +++ b/lib/Catalyst/DispatchType/Index.pm @@ -3,6 +3,9 @@ package Catalyst::DispatchType::Index; use Moose; extends 'Catalyst::DispatchType'; +#use strict; +#use base qw/Catalyst::DispatchType/; + =head1 NAME Catalyst::DispatchType::Index - Index DispatchType diff --git a/lib/Catalyst/DispatchType/Path.pm b/lib/Catalyst/DispatchType/Path.pm index 925b4ac..4932c11 100644 --- a/lib/Catalyst/DispatchType/Path.pm +++ b/lib/Catalyst/DispatchType/Path.pm @@ -1,17 +1,12 @@ package Catalyst::DispatchType::Path; use Moose; -use Text::SimpleTable; -use URI; - extends 'Catalyst::DispatchType'; -has _paths => ( - is => 'rw', - isa => 'HashRef', - required => 1, - default => sub {{}} - ); +#use strict; +#use base qw/Catalyst::DispatchType/; +use Text::SimpleTable; +use URI; =head1 NAME @@ -33,17 +28,15 @@ Debug output for Path dispatch points sub list { my ( $self, $c ) = @_; - my %paths = %{ $self->_paths }; - my @keys = sort keys %paths; - return unless @keys; - my $paths_table = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] ); - foreach my $path ( @keys ) { + my $paths = Text::SimpleTable->new( [ 35, 'Path' ], [ 36, 'Private' ] ); + foreach my $path ( sort keys %{ $self->{paths} } ) { my $display_path = $path eq '/' ? $path : "/$path"; - foreach my $action ( @{ $paths{$path} } ) { - $paths_table->row( $display_path, "/$action" ); + foreach my $action ( @{ $self->{paths}->{$path} } ) { + $paths->row( $display_path, "/$action" ); } } - $c->log->debug( "Loaded Path actions:\n" . $paths_table->draw . "\n" ); + $c->log->debug( "Loaded Path actions:\n" . $paths->draw . "\n" ) + if ( keys %{ $self->{paths} } ); } =head2 $self->match( $c, $path ) @@ -59,7 +52,7 @@ sub match { $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); @@ -100,7 +93,7 @@ sub register_path { $path = '/' unless length $path; $path = URI->new($path)->canonical; - unshift( @{ $self->_paths->{$path} ||= [] }, $action); + unshift( @{ $self->{paths}{$path} ||= [] }, $action); return 1; } diff --git a/lib/Catalyst/DispatchType/Regex.pm b/lib/Catalyst/DispatchType/Regex.pm index 0b2264d..61740da 100644 --- a/lib/Catalyst/DispatchType/Regex.pm +++ b/lib/Catalyst/DispatchType/Regex.pm @@ -2,10 +2,18 @@ package Catalyst::DispatchType::Regex; use Moose; extends 'Catalyst::DispatchType::Path'; + +#use strict; +#use base qw/Catalyst::DispatchType::Path/; use Text::SimpleTable; use Text::Balanced (); -has _compiled => (is => 'rw', isa => 'ArrayRef', required => 1, default => sub{[]}); +has _compiled => ( + is => 'rw', + isa => 'ArrayRef', + required => 1, + default => sub{ [] }, + ); =head1 NAME @@ -27,14 +35,13 @@ Output a table of all regex actions, and their private equivalent. sub list { my ( $self, $c ) = @_; - my @regexes = @{ $self->_compiled }; - return unless @regexes; my $re = Text::SimpleTable->new( [ 35, 'Regex' ], [ 36, 'Private' ] ); - for my $regex ( @regexes ) { + for my $regex ( @{ $self->_compiled } ) { my $action = $regex->{action}; $re->row( $regex->{path}, "/$action" ); } - $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" ); + $c->log->debug( "Loaded Regex actions:\n" . $re->draw . "\n" ) + if ( @{ $self->_compiled } ); } =head2 $self->match( $c, $path ) @@ -46,10 +53,10 @@ altering $c. =cut -override match => sub { +sub match { my ( $self, $c, $path ) = @_; - return if super(); + return if $self->SUPER::match( $c, $path ); # Check path against plain text first @@ -66,7 +73,7 @@ override match => sub { } return 0; -}; +} =head2 $self->register( $c, $action ) diff --git a/lib/Catalyst/Dispatcher.pm b/lib/Catalyst/Dispatcher.pm index 2254431..78bb5a3 100644 --- a/lib/Catalyst/Dispatcher.pm +++ b/lib/Catalyst/Dispatcher.pm @@ -1,7 +1,6 @@ package Catalyst::Dispatcher; use Moose; -use Class::MOP (); use Catalyst::Exception; use Catalyst::Utils; @@ -51,7 +50,7 @@ application based on the attributes you set. =head1 METHODS -=head2 new +=head2 new Construct a new dispatcher. @@ -60,7 +59,7 @@ Construct a new dispatcher. sub BUILD { my ($self, $params) = @_; - my $container = + my $container = Catalyst::ActionContainer->new( { part => '/', actions => {} } ); $self->_tree( Tree::Simple->new( $container, Tree::Simple->ROOT ) ); @@ -137,7 +136,7 @@ sub forward { } my @args; - + if ( ref( $extra_params[-1] ) eq 'ARRAY' ) { @args = @{ pop @extra_params } } else { @@ -303,11 +302,11 @@ sub get_action { return $self->_action_hash->{"$namespace/$name"}; } -=head2 $self->get_action_by_path( $path ); - -Returns the named action by its full path. +=head2 $self->get_action_by_path( $path ); + +Returns the named action by its full path. -=cut +=cut sub get_action_by_path { my ( $self, $path ) = @_; @@ -395,7 +394,7 @@ sub register { next if $key eq 'Private'; my $class = "Catalyst::DispatchType::$key"; unless ( $registered->{$class} ) { - eval { Class::MOP::load_class($class) }; + eval "require $class"; push( @{ $self->_dispatch_types }, $class->new ) unless $@; $registered->{$class} = 1; } @@ -513,7 +512,7 @@ sub _load_dispatch_types { for my $type (@types) { my $class = ( $type =~ /^\+(.*)$/ ) ? $1 : "Catalyst::DispatchType::${type}"; - eval { Class::MOP::load_class($class) }; + eval "require $class"; Catalyst::Exception->throw( message => qq/Couldn't load "$class"/ ) if $@; push @{ $self->_dispatch_types }, $class->new; diff --git a/lib/Catalyst/Exception.pm b/lib/Catalyst/Exception.pm index 02610a4..ee85e1e 100644 --- a/lib/Catalyst/Exception.pm +++ b/lib/Catalyst/Exception.pm @@ -1,10 +1,15 @@ package Catalyst::Exception; -# XXX: See bottom of file for Exception implementation +use strict; +use vars qw[@ISA $CATALYST_EXCEPTION_CLASS]; + +BEGIN { + push( @ISA, $CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base' ); +} package Catalyst::Exception::Base; -use Moose; +use strict; use Carp (); =head1 NAME @@ -44,10 +49,6 @@ sub throw { Carp::croak($message); } -=head2 meta - -Provided by Moose - =head1 AUTHOR Sebastian Riedel, C @@ -60,13 +61,4 @@ it under the same terms as Perl itself. =cut -package Catalyst::Exception; - -use Moose; -use vars qw[$CATALYST_EXCEPTION_CLASS]; - -BEGIN { - extends($CATALYST_EXCEPTION_CLASS || 'Catalyst::Exception::Base'); -} - 1; diff --git a/lib/Catalyst/Log.pm b/lib/Catalyst/Log.pm index 01ff75f..822ea32 100644 --- a/lib/Catalyst/Log.pm +++ b/lib/Catalyst/Log.pm @@ -1,20 +1,14 @@ package Catalyst::Log; use strict; -#use base 'Class::Accessor::Fast'; +use base 'Class::Accessor::Fast'; use Data::Dump; our %LEVELS = (); -use Moose; - -has level => (is => 'rw'); -has _body => (is => 'rw'); -has abort => (is => 'rw'); - -#__PACKAGE__->mk_accessors('level'); -#__PACKAGE__->mk_accessors('body'); -#__PACKAGE__->mk_accessors('abort'); +__PACKAGE__->mk_accessors('level'); +__PACKAGE__->mk_accessors('body'); +__PACKAGE__->mk_accessors('abort'); { my @levels = qw[ debug info warn error fatal ]; @@ -31,14 +25,14 @@ has abort => (is => 'rw'); *{$name} = sub { my $self = shift; - if ( $self->level & $level ) { + if ( $self->{level} & $level ) { $self->_log( $name, @_ ); } }; *{"is_$name"} = sub { my $self = shift; - return $self->level & $level; + return $self->{level} & $level; }; } } @@ -58,20 +52,12 @@ sub levels { sub enable { my ( $self, @levels ) = @_; - my $level = $self->level; - for(map { $LEVELS{$_} } @levels){ - $level |= $_; - } - $self->level($level); + $self->{level} |= $_ for map { $LEVELS{$_} } @levels; } sub disable { my ( $self, @levels ) = @_; - my $level = $self->level; - for(map { $LEVELS{$_} } @levels){ - $level &= ~$_; - } - $self->level($level); + $self->{level} &= ~$_ for map { $LEVELS{$_} } @levels; } sub _dump { @@ -84,20 +70,18 @@ sub _log { my $level = shift; my $message = join( "\n", @_ ); $message .= "\n" unless $message =~ /\n$/; - my $body = $self->_body; - $body .= sprintf( "[%s] %s", $level, $message ); - $self->_body($body); + $self->{body} .= sprintf( "[%s] %s", $level, $message ); } 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 { @@ -185,10 +169,6 @@ arguments. $log = Catalyst::Log->new; $log = Catalyst::Log->new( 'warn', 'error' ); -=head2 level - -Contains a bitmask of the currently set log levels. - =head2 levels Set log levels @@ -237,8 +217,6 @@ This protected method is what actually sends the log information to STDERR. You may subclass this module and override this method to get finer control over the log output. -=head2 meta - =head1 SEE ALSO L. diff --git a/lib/Catalyst/Model.pm b/lib/Catalyst/Model.pm index 9ac59fd..356745e 100644 --- a/lib/Catalyst/Model.pm +++ b/lib/Catalyst/Model.pm @@ -1,7 +1,7 @@ package Catalyst::Model; -use Moose; -extends 'Catalyst::Component'; +use strict; +use base qw/Catalyst::Component/; =head1 NAME diff --git a/lib/Catalyst/View.pm b/lib/Catalyst/View.pm index 11a216f..40ed724 100644 --- a/lib/Catalyst/View.pm +++ b/lib/Catalyst/View.pm @@ -1,7 +1,7 @@ package Catalyst::View; -use Moose; -extends 'Catalyst::Component'; +use strict; +use base qw/Catalyst::Component/; =head1 NAME @@ -19,15 +19,15 @@ Catalyst::View - Catalyst View base class =head1 DESCRIPTION -This is the Catalyst View base class. It's meant to be used as +This is the Catalyst View base class. It's meant to be used as a base class by Catalyst views. -As a convention, views are expected to read template names from +As a convention, views are expected to read template names from $c->stash->{template}, and put the output into $c->res->body. Some views default to render a template named after the dispatched action's private name. (See L.) -=head1 METHODS +=head1 METHODS Implements the same methods as other Catalyst components, see L