From: Guillermo Roditi Date: Mon, 23 Jun 2008 20:59:07 +0000 (+0000) Subject: committing broken version. rolling back in a min. just making sure this gets saved... X-Git-Tag: 5.8000_03~125 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=commitdiff_plain;h=6323fda2e7ace0fc0aa06305c674957cedc6d025 committing broken version. rolling back in a min. just making sure this gets saved somewhere r16977@martha (orig r7500): groditi | 2008-03-14 23:20:10 -0400 --- diff --git a/lib/Catalyst.pm b/lib/Catalyst.pm index 9183864..381a250 100644 --- a/lib/Catalyst.pm +++ b/lib/Catalyst.pm @@ -1,7 +1,9 @@ package Catalyst; -use strict; -use base 'Catalyst::Component'; +use Moose; +#use MooseX::ClassAttribute; +extends 'Catalyst::Component'; + use bytes; use Catalyst::Exception; use Catalyst::Log; @@ -30,9 +32,15 @@ use Carp qw/croak carp/; BEGIN { require 5.008001; } -__PACKAGE__->mk_accessors( - qw/counter request response state action stack namespace stats/ -); +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'); + attributes->import( __PACKAGE__, \&namespace, 'lvalue' ); @@ -52,9 +60,22 @@ 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'); @@ -79,6 +100,9 @@ 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] ); @@ -112,30 +136,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 @@ -143,9 +167,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 @@ -155,20 +179,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 ) = @_; @@ -249,7 +273,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/ @@ -320,8 +344,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. @@ -348,7 +372,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' ); @@ -456,7 +480,7 @@ sub _comp_prefixes { return $comp; } -# Find possible names for a prefix +# Find possible names for a prefix sub _comp_names { my ( $c, @prefixes ) = @_; @@ -528,7 +552,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 @@ -542,7 +566,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}; @@ -573,7 +597,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 @@ -587,7 +611,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}; @@ -676,14 +700,15 @@ L. =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 @@ -761,6 +786,7 @@ 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) }; @@ -851,7 +877,7 @@ You are running an old script! EOF } - + if ( $class->debug ) { my @plugins = map { "$_ " . ( $_->VERSION || '' ) } $class->registered_plugins; @@ -960,7 +986,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 @@ -1131,7 +1157,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.

@@ -1183,8 +1209,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 ]; } @@ -1218,11 +1244,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 = $@ ) { @@ -1277,7 +1303,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, ); @@ -1292,7 +1318,7 @@ sub _stats_start_execute { } } else { - + # root-level call $c->stats->profile( begin => $action, @@ -1317,7 +1343,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; @@ -1360,12 +1386,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; @@ -1411,7 +1437,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( @@ -1512,7 +1538,7 @@ sub handle_request { my $c = $class->prepare(@arguments); $c->dispatch; - $status = $c->finalize; + $status = $c->finalize; }; if ( my $error = $@ ) { @@ -1568,7 +1594,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 @@ -1590,7 +1616,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; @@ -1857,9 +1883,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 @@ -1867,7 +1893,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.) @@ -1881,11 +1907,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 }; } @@ -2142,7 +2168,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); >>. @@ -2180,6 +2206,7 @@ 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; } @@ -2274,7 +2301,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, @@ -2288,9 +2315,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. @@ -2302,7 +2329,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 2e50cec..3117824 100644 --- a/lib/Catalyst/AttrContainer.pm +++ b/lib/Catalyst/AttrContainer.pm @@ -1,21 +1,29 @@ package Catalyst::AttrContainer; use Moose; -use MooseX::ClassAttribute; +#use MooseX::ClassAttribute; use Catalyst::Exception; +use Class::Data::Inheritable; +{ + my $mk_classdata = Class::Data::Inheritable->can('mk_classdata'); + __PACKAGE__->meta->add_method(mk_classdata => $mk_classdata); +} -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(_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{ [] } +# ); # note - see attributes(3pm) sub MODIFY_CODE_ATTRIBUTES { diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm index 9cbe331..b5b56e2 100644 --- a/lib/Catalyst/Component.pm +++ b/lib/Catalyst/Component.pm @@ -1,17 +1,27 @@ package Catalyst::Component; use Moose; -use MooseX::ClassAttribute; +#use MooseX::ClassAttribute; use Catalyst::Utils; +use Class::Data::Inheritable; +use NEXT; -has _config => ( - is => 'rw', - isa => 'HashRef', - required => 1, - default => sub { {} } - ); +{ + 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' ); +# class_has _plugins => ( is => 'rw' ); =head1 NAME @@ -81,6 +91,7 @@ sub COMPONENT { 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; @@ -89,6 +100,7 @@ sub COMPONENT { my $class = ref $self || $self; my $new = $self->merge_config_hashes( $self->config, $arguments ); + #this will break, Moose::Object::new won't act like this return bless $new, $class; } } diff --git a/lib/Catalyst/Controller.pm b/lib/Catalyst/Controller.pm index ab77e21..d31b704 100644 --- a/lib/Catalyst/Controller.pm +++ b/lib/Catalyst/Controller.pm @@ -1,13 +1,43 @@ package Catalyst::Controller; -use strict; -use base qw/Catalyst::Component Catalyst::AttrContainer Class::Accessor::Fast/; - +use Moose; +use Class::MOP (); +#use MooseX::ClassAttribute; 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 @@ -17,9 +47,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 @@ -31,15 +61,17 @@ for more info about how Catalyst dispatches to actions. =cut -__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/ ); +# 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; +}; -### _app as alias -*_app = *_application; sub _DISPATCH : Private { my ( $self, $c ) = @_; @@ -88,15 +120,6 @@ 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); @@ -131,9 +154,12 @@ sub register_actions { my $class = ref $self || $self; my $namespace = $self->action_namespace($c); my %methods; - $methods{ $self->can($_) } = $_ - for @{ Class::Inspector->methods($class) || [] }; + { + my $meth_map = $class->meta->get_method_map; + @methods{values %$meth_map} = (keys %$meth_map); + } + #Moose TODO: something tells me that roles could kill the directly code below # Advanced inheritance support for plugins and the like my @action_cache; { @@ -178,10 +204,12 @@ sub create_action { ? $args{attributes}{ActionClass}[0] : $self->_action_class); - unless ( Class::Inspector->loaded($class) ) { - require Class::Inspector->filename($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); + return $class->new( \%args ); } @@ -310,7 +338,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/Model.pm b/lib/Catalyst/Model.pm index 356745e..9ac59fd 100644 --- a/lib/Catalyst/Model.pm +++ b/lib/Catalyst/Model.pm @@ -1,7 +1,7 @@ package Catalyst::Model; -use strict; -use base qw/Catalyst::Component/; +use Moose; +extends 'Catalyst::Component'; =head1 NAME diff --git a/lib/Catalyst/View.pm b/lib/Catalyst/View.pm index 40ed724..11a216f 100644 --- a/lib/Catalyst/View.pm +++ b/lib/Catalyst/View.pm @@ -1,7 +1,7 @@ package Catalyst::View; -use strict; -use base qw/Catalyst::Component/; +use Moose; +extends '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