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=87b68c9952a85454bfb9d91c3ed48c1accb6a261;hb=8ad6fd584ff18d88abf31629d4593ba94eeb7647;hpb=76721d3c6f8660effa365b8c1574b1e87f4973cb diff --git a/lib/Catalyst/ClassData.pm b/lib/Catalyst/ClassData.pm index 87b68c9..f79149b 100644 --- a/lib/Catalyst/ClassData.pm +++ b/lib/Catalyst/ClassData.pm @@ -1,33 +1,22 @@ package Catalyst::ClassData; use Moose::Role; +use Moose::Meta::Class (); use Class::MOP; -use Class::MOP::Object; -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 $pkg = ref $_[0] || $_[0]; - my $meta = $pkg->Class::MOP::Object::meta(); + my $meta = Moose::Util::find_meta($pkg) + || Moose::Meta::Class->initialize( $pkg ); if (@_ > 1) { $meta->namespace->{$attribute} = \$_[1]; - no strict 'refs'; - if (! *{"${pkg}::${attribute}"}{CODE} ) { - foreach my $super ( $meta->linearized_isa ) { - # If there is a code symbol for this class data in a parent class, but not in our - # class then copy it into our package. This is evil. - my $parent_symbol = *{"${super}::${attribute}"}{CODE} ? \&{"${super}::${attribute}"} : undef; - if (defined $parent_symbol) { - *{"${pkg}::${attribute}"} = $parent_symbol; - last; - } - } - } return $_[1]; } @@ -56,17 +45,20 @@ sub mk_classdata { unless ref $accessor eq 'CODE'; my $meta = $class->Class::MOP::Object::meta(); - my $immutable_options; - if( $meta->is_immutable ){ - $immutable_options = $meta->get_immutable_options; - $meta->make_mutable; - } + 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); - if(defined $immutable_options){ - $meta->make_immutable(%{ $immutable_options }); - } + + $meta->make_immutable(%immutable_options) if $was_immutable; + $class->$attribute($_[2]) if(@_ > 2); return $accessor; } @@ -78,7 +70,7 @@ __END__ =head1 NAME -Catalyst::ClassData - Class data acessors +Catalyst::ClassData - Class data accessors =head1 METHODS @@ -89,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