X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FComponent.pm;h=632f543be684d60d027123795d15bcb223c3c9b0;hb=3295c7dbc672a0d1c03f657a2a37f12f322bbece;hp=7de7e4e1c423ed55847ce12417731acd549e68b9;hpb=6f1f968a6bc42bf4a4b50a1ee22d3aaecd801876;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Component.pm b/lib/Catalyst/Component.pm index 7de7e4e..632f543 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,16 +54,18 @@ component loader with config() support and a process() method placeholder. =cut -__PACKAGE__->mk_classdata($_) for qw/_config _plugins/; - -sub new { - my ( $self, $c ) = @_; +__PACKAGE__->mk_classdata('_plugins'); +__PACKAGE__->mk_classdata('_config'); +sub BUILDARGS { + my ($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 ); + + return $args; } sub COMPONENT { @@ -72,23 +73,18 @@ sub COMPONENT { # 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() || {}; + my $config = $self->_config || {}; if (@_) { my $newconfig = { %{@_ > 1 ? {@_} : $_[0]} }; $self->_config( @@ -97,18 +93,14 @@ sub config { } 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 ); + # 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. - if ((my $config_sub_now = $self->can('_config')) ne $config_sub) { + unless ($self->meta->has_package_symbol('$_config')) { $config = $self->merge_config_hashes( $config, {} ); - $self->$config_sub_now( $config ); + $self->_config( $config ); } } return $config; @@ -126,6 +118,9 @@ sub process { . " did not override Catalyst::Component::process" ); } +no Moose; + +__PACKAGE__->meta->make_immutable; 1; __END__ @@ -187,11 +182,9 @@ calling code in the application rather than the component itself. L, L, L, L. -=head1 AUTHOR +=head1 AUTHORS -Sebastian Riedel, C -Marcus Ramberg, C -Matt S Trout, C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT