X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FClassData.pm;h=f79149b063d4abcd5678460da8c0fc068c3443be;hp=04e074c556f639df2af621c9cadb7d275fe59414;hb=8ad6fd584ff18d88abf31629d4593ba94eeb7647;hpb=ce50990ee94a229c4814be98afc17f2b6a065a43 diff --git a/lib/Catalyst/ClassData.pm b/lib/Catalyst/ClassData.pm index 04e074c..f79149b 100644 --- a/lib/Catalyst/ClassData.pm +++ b/lib/Catalyst/ClassData.pm @@ -1,29 +1,40 @@ package Catalyst::ClassData; use Moose::Role; +use Moose::Meta::Class (); use Class::MOP; -use Scalar::Util 'blessed'; +use Moose::Util (); sub mk_classdata { - my ($class, $attribute) = @_; + my ($class, $attribute, $warn_on_instance) = @_; confess("mk_classdata() is a class method, not an object method") if blessed $class; my $slot = '$'.$attribute; my $accessor = sub { - my $meta = $_[0]->meta; - if(@_ > 1){ + my $pkg = ref $_[0] || $_[0]; + my $meta = Moose::Util::find_meta($pkg) + || Moose::Meta::Class->initialize( $pkg ); + if (@_ > 1) { $meta->namespace->{$attribute} = \$_[1]; return $_[1]; } - if( $meta->has_package_symbol($slot) ){ - return ${ $meta->get_package_symbol($slot) }; + # tighter version of + # if ( $meta->has_package_symbol($slot) ) { + # return ${ $meta->get_package_symbol($slot) }; + # } + no strict 'refs'; + my $v = *{"${pkg}::${attribute}"}{SCALAR}; + if (defined ${$v}) { + return ${$v}; } else { foreach my $super ( $meta->linearized_isa ) { - my $super_meta = Moose::Meta::Class->initialize($super); - if( $super_meta->has_package_symbol($slot) ){ - return ${ $super_meta->get_package_symbol($slot) }; + # tighter version of same after + # my $super_meta = Moose::Meta::Class->initialize($super); + my $v = ${"${super}::"}{$attribute} ? *{"${super}::${attribute}"}{SCALAR} : undef; + if (defined ${$v}) { + return ${$v}; } } } @@ -33,10 +44,21 @@ sub mk_classdata { confess("Failed to create accessor: $@ ") unless ref $accessor eq 'CODE'; - my $meta = $class->meta; + my $meta = $class->Class::MOP::Object::meta(); + confess "${class}'s metaclass is not a Class::MOP::Class" + unless $meta->isa('Class::MOP::Class'); + + my $was_immutable = $meta->is_immutable; + my %immutable_options = $meta->immutable_options; + + $meta->make_mutable if $was_immutable; + my $alias = "_${attribute}_accessor"; $meta->add_method($alias, $accessor); $meta->add_method($attribute, $accessor); + + $meta->make_immutable(%immutable_options) if $was_immutable; + $class->$attribute($_[2]) if(@_ > 2); return $accessor; } @@ -48,7 +70,7 @@ __END__ =head1 NAME -Catalyst::ClassData - Class data acessors +Catalyst::ClassData - Class data accessors =head1 METHODS @@ -59,11 +81,15 @@ L; =head1 AUTHOR +=begin stopwords + Guillermo Roditi +=end stopwords + =head1 COPYRIGHT -This program is free software, you can redistribute it and/or modify it under +This library is free software. You can redistribute it and/or modify it under the same terms as Perl itself. =cut