X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FClassData.pm;h=76cdbeced4310fea45d7827c1b15ac4948bf4fe5;hb=e30ed35ddf9e2a389fc84fe13abaf7a46e9f9478;hp=23fd1107b999bcc97a05b8ff3ed2ef93a93e7288;hpb=efbfd430a9e62335eca426a2be3bc098d65f8d1a;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/ClassData.pm b/lib/Catalyst/ClassData.pm index 23fd110..76cdbec 100644 --- a/lib/Catalyst/ClassData.pm +++ b/lib/Catalyst/ClassData.pm @@ -1,6 +1,7 @@ package Catalyst::ClassData; use Moose::Role; +use Class::MOP; use Scalar::Util 'blessed'; sub mk_classdata { @@ -10,26 +11,40 @@ sub mk_classdata { my $slot = '$'.$attribute; my $accessor = sub { + my $meta = $_[0]->meta; if(@_ > 1){ - $_[0]->meta->add_package_symbol($slot, \ $_[1]); + $meta->namespace->{$attribute} = \$_[1]; return $_[1]; } - foreach my $super ( $_[0], $_[0]->meta->linearized_isa ) { - my $meta = $super->meta; - if( $meta->has_package_symbol($slot) ){ - return $meta->get_package_symbol($slot); + + if( $meta->has_package_symbol($slot) ){ + return ${ $meta->get_package_symbol($slot) }; + } 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) }; + } } } return; }; - my $accessor = eval $code; - confess("Failed to create accessor: $@ \n $code \n") + + confess("Failed to create accessor: $@ ") unless ref $accessor eq 'CODE'; my $meta = $class->meta; + my $immutable_options; + if( $meta->is_immutable ){ + $immutable_options = $meta->get_immutable_options; + $meta->make_mutable; + } my $alias = "_${attribute}_accessor"; $meta->add_method($alias, $accessor); $meta->add_method($attribute, $accessor); + if(defined $immutable_options){ + $meta->make_immutable($immutable_options); + } $class->$attribute($_[2]) if(@_ > 2); return $accessor; } @@ -38,17 +53,25 @@ sub mk_classdata { __END__ -# my $code = ' sub { -# if(@_ > 1){ -# $_[0]->meta->add_package_symbol(\''.$slot.'\', \ $_[1]); -# return $_[1]; -# } -# foreach my $super ( $_[0], $_[0]->meta->linearized_isa ) { -# my $meta = $super->meta; -# if( $meta->has_package_symbol(\''.$slot.'\') ){ -# return $meta->get_package_symbol(\''.$slot.'\'); -# } -# } -# return; -# }'; -# my $accessor = eval $code; + +=head1 NAME + +Catalyst::ClassData - Class data acessors + +=head1 METHODS + +=head2 mk_classdata $name, $optional_value + +A moose-safe clone of L that borrows some ideas from +L; + +=head1 AUTHOR + +Guillermo Roditi + +=head1 COPYRIGHT + +This program is free software, you can redistribute it and/or modify it under +the same terms as Perl itself. + +=cut