X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FComponent.pm;h=2950f4458af9b3a0b1ec7c9ebd7c0cf9501c5c9a;hb=46d0346ddafe8e167c679cddef9834946598e689;hp=7de7e4e1c423ed55847ce12417731acd549e68b9;hpb=6f1f968a6bc42bf4a4b50a1ee22d3aaecd801876;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm index 7de7e4e..2950f44 100644 --- a/lib/Catalyst/Component.pm +++ b/lib/Catalyst/Component.pm @@ -1,16 +1,15 @@ package Catalyst::Component; -use MRO::Compat; -use mro 'c3'; 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'; -no Moose; =head1 NAME @@ -55,63 +54,68 @@ component loader with config() support and a process() method placeholder. =cut -__PACKAGE__->mk_classdata($_) for qw/_config _plugins/; +__PACKAGE__->mk_classdata('_plugins'); -sub new { - my ( $self, $c ) = @_; +around new => sub { + my ( $orig, $self) = @_; # Temporary fix, some components does not pass context to constructor my $arguments = ( ref( $_[-1] ) eq 'HASH' ) ? $_[-1] : {}; my $args = $self->merge_config_hashes( $self->config, $arguments ); - $self->next::method( $args ); -} + $self->$orig( $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] : {}; - - - #this is not the EXACT logic we had before, since the original tested - #for a true value before returning meaning that a subsequent COMPONENT - #call could return undef and that would trigger a try to new, which could - #again return undef, which would lead to a straight bless of the args and - #config. I did not mantain that behavior because it did not seemed sane - # please rip me a new one if you have reason to believe i am being stupid - # --groditi - return $self->next::can ? - $self->next::method($c, $arguments) : $self->new($c, $arguments); + 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); + } + return $self->new($c, $arguments); } sub config { - my $self = shift; - my $config_sub = $self->can('_config'); - my $config = $self->$config_sub() || {}; - if (@_) { - my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} }; - $self->_config( - $self->merge_config_hashes( $config, $newconfig ) - ); - } else { - # this is a bit of a kludge, required to make - # __PACKAGE__->config->{foo} = 'bar'; - # work in a subclass. 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. - - $self->_config( $config ); - - if ((my $config_sub_now = $self->can('_config')) ne $config_sub) { - - $config = $self->merge_config_hashes( $config, {} ); - $self->$config_sub_now( $config ); + my $self = shift; + my $class = blessed $self || $self; + + my $config; + my $meta = $class->meta; + if( $meta->has_package_symbol('$config') ){ + $config = ${ $meta->get_package_symbol('$config') }; + } else { + foreach my $super ( $meta->linearized_isa ) { + my $super_meta = Moose::Meta::Class->initialize($super); + if( $super_meta->has_package_symbol('$config') ){ + $config = ${ $super_meta->get_package_symbol('$config') }; + unless( @_ ){ #don't copy and write it twice + $config = $class->merge_config_hashes( $config, {} ); + $meta->add_package_symbol('$config', \ $config); } + last; + } } - return $config; + } + + unless( defined $config ){ + $config = {}; + $meta->add_package_symbol('$config', \ $config) unless @_; + } + + if (@_) { + my $from_args = { %{@_ > 1 ? {@_} : $_[0]} }; + my $new_config = $class->merge_config_hashes( $config, $from_args); + $meta->add_package_symbol('$config', \ $new_config); + } + + return $config; } sub merge_config_hashes { @@ -126,6 +130,8 @@ sub process { . " did not override Catalyst::Component::process" ); } + +__PACKAGE__->meta->make_immutable; 1; __END__