Commit | Line | Data |
---|---|---|
a7caa492 | 1 | package Catalyst::ClassData; |
2 | ||
3 | use Moose::Role; | |
c98492ae | 4 | use Moose::Meta::Class (); |
76aab993 | 5 | use Class::MOP; |
67837eb6 | 6 | use Moose::Util (); |
a7caa492 | 7 | |
8 | sub mk_classdata { | |
df960201 | 9 | my ($class, $attribute, $warn_on_instance) = @_; |
a7caa492 | 10 | confess("mk_classdata() is a class method, not an object method") |
efbfd430 | 11 | if blessed $class; |
12 | ||
13 | my $slot = '$'.$attribute; | |
14 | my $accessor = sub { | |
eece41a2 | 15 | my $pkg = ref $_[0] || $_[0]; |
b0ad47c1 | 16 | my $meta = Moose::Util::find_meta($pkg) |
c98492ae | 17 | || Moose::Meta::Class->initialize( $pkg ); |
76721d3c | 18 | if (@_ > 1) { |
ce50990e | 19 | $meta->namespace->{$attribute} = \$_[1]; |
efbfd430 | 20 | return $_[1]; |
21 | } | |
76aab993 | 22 | |
eece41a2 | 23 | # tighter version of |
24 | # if ( $meta->has_package_symbol($slot) ) { | |
25 | # return ${ $meta->get_package_symbol($slot) }; | |
26 | # } | |
27 | no strict 'refs'; | |
28 | my $v = *{"${pkg}::${attribute}"}{SCALAR}; | |
29 | if (defined ${$v}) { | |
30 | return ${$v}; | |
46d0346d | 31 | } else { |
32 | foreach my $super ( $meta->linearized_isa ) { | |
eece41a2 | 33 | # tighter version of same after |
34 | # my $super_meta = Moose::Meta::Class->initialize($super); | |
875d8110 | 35 | my $v = ${"${super}::"}{$attribute} ? *{"${super}::${attribute}"}{SCALAR} : undef; |
eece41a2 | 36 | if (defined ${$v}) { |
37 | return ${$v}; | |
46d0346d | 38 | } |
efbfd430 | 39 | } |
40 | } | |
41 | return; | |
a7caa492 | 42 | }; |
76aab993 | 43 | |
44 | confess("Failed to create accessor: $@ ") | |
efbfd430 | 45 | unless ref $accessor eq 'CODE'; |
a7caa492 | 46 | |
74c89dea | 47 | my $meta = $class->Class::MOP::Object::meta(); |
30305469 | 48 | confess "${class}'s metaclass is not a Class::MOP::Class" |
49 | unless $meta->isa('Class::MOP::Class'); | |
46435d36 | 50 | |
51 | my $was_immutable = $meta->is_immutable; | |
46635e11 | 52 | my %immutable_options = $meta->immutable_options; |
17eaca18 | 53 | |
46435d36 | 54 | $meta->make_mutable if $was_immutable; |
55 | ||
a7caa492 | 56 | my $alias = "_${attribute}_accessor"; |
efbfd430 | 57 | $meta->add_method($alias, $accessor); |
58 | $meta->add_method($attribute, $accessor); | |
46435d36 | 59 | |
17eaca18 | 60 | $meta->make_immutable(%immutable_options) if $was_immutable; |
46435d36 | 61 | |
efbfd430 | 62 | $class->$attribute($_[2]) if(@_ > 2); |
a7caa492 | 63 | return $accessor; |
64 | } | |
65 | ||
66 | 1; | |
67 | ||
68 | __END__ | |
46d0346d | 69 | |
70 | ||
71 | =head1 NAME | |
72 | ||
10011c19 | 73 | Catalyst::ClassData - Class data accessors |
46d0346d | 74 | |
75 | =head1 METHODS | |
76 | ||
77 | =head2 mk_classdata $name, $optional_value | |
78 | ||
79 | A moose-safe clone of L<Class::Data::Inheritable> that borrows some ideas from | |
80 | L<Class::Accessor::Grouped>; | |
81 | ||
82 | =head1 AUTHOR | |
83 | ||
84 | Guillermo Roditi | |
85 | ||
86 | =head1 COPYRIGHT | |
87 | ||
536bee89 | 88 | This library is free software. You can redistribute it and/or modify it under |
46d0346d | 89 | the same terms as Perl itself. |
90 | ||
91 | =cut |