X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FBase.pm;h=789c6ab9f987b41334456a1761e787f5c9e36946;hb=b77837889755d5af814803443f7ab93a1655b71f;hp=7da4dbce0c16eb81215012388bc4fbc880520876;hpb=fc7ec1d96ee55d1bf42af3abce155ecb717b9e2b;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Base.pm b/lib/Catalyst/Base.pm index 7da4dbc..789c6ab 100644 --- a/lib/Catalyst/Base.pm +++ b/lib/Catalyst/Base.pm @@ -2,9 +2,23 @@ package Catalyst::Base; use strict; use base qw/Class::Data::Inheritable Class::Accessor::Fast/; + +use Catalyst::Exception; use NEXT; -__PACKAGE__->mk_classdata('_config'); +__PACKAGE__->mk_classdata($_) for qw/_attr_cache _action_cache _config/; +__PACKAGE__->_attr_cache( {} ); +__PACKAGE__->_action_cache( [] ); + +# note - see attributes(3pm) +sub MODIFY_CODE_ATTRIBUTES { + my ( $class, $code, @attrs ) = @_; + $class->_attr_cache->{$code} = [@attrs]; + push @{ $class->_action_cache }, [ $code, [@attrs] ]; + return (); +} + +sub FETCH_CODE_ATTRIBUTES { $_[0]->_attr_cache->{ $_[1] } || () } =head1 NAME @@ -33,7 +47,6 @@ Catalyst::Base - Catalyst Universal Base Class # Methods can be a request step $c->forward(qw/MyApp::Model::Something forward_to_me/); - MyApp->action( 'index.html' => \&MyApp::Model::Something::forward_to_me ); # Or just methods print $c->comp('MyApp::Model::Something')->test; @@ -48,24 +61,39 @@ This is the universal base class for Catalyst components It provides you with a generic new() for instantiation through Catalyst's component loader with config() support and a process() method placeholder. -=head2 METHODS +=head1 METHODS + +=over 4 + +=item new($c) =cut sub new { my ( $self, $c ) = @_; - return $self->NEXT::new( $self->config ); + + # Temporary fix, some components does not pass context to constructor + my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {}; + + return $self->NEXT::new( { %{ $self->config }, %{ $arguments } } ); } -=head3 config +# remember to leave blank lines between the consecutive =item's +# otherwise the pod tools don't recognize the subsequent =items + +=item $c->config + +=item $c->config($hashref) + +=item $c->config($key, $value, ...) =cut sub config { my $self = shift; $self->_config( {} ) unless $self->_config; - if ( $_[0] ) { - my $config = $_[1] ? {@_} : $_[0]; + if (@_) { + my $config = @_ > 1 ? {@_} : $_[0]; while ( my ( $key, $val ) = each %$config ) { $self->_config->{$key} = $val; } @@ -73,11 +101,22 @@ sub config { return $self->_config; } -=head3 process +=item $c->process() =cut -sub process { 1 } +sub process { + + Catalyst::Exception->throw( + message => ( ref $_[0] || $_[0] ) . " did not override Catalyst::Base::process" + ); +} + +=item FETCH_CODE_ATTRIBUTES + +=item MODIFY_CODE_ATTRIBUTES + +=back =head1 SEE ALSO @@ -86,6 +125,7 @@ L. =head1 AUTHOR Sebastian Riedel, C +Marcus Ramberg, C =head1 COPYRIGHT