Commit | Line | Data |
a7caa492 |
1 | package Catalyst::ClassData; |
2 | |
3 | use Moose::Role; |
76aab993 |
4 | use Class::MOP; |
a7caa492 |
5 | use Scalar::Util 'blessed'; |
6 | |
7 | sub mk_classdata { |
efbfd430 |
8 | my ($class, $attribute) = @_; |
a7caa492 |
9 | confess("mk_classdata() is a class method, not an object method") |
efbfd430 |
10 | if blessed $class; |
11 | |
12 | my $slot = '$'.$attribute; |
13 | my $accessor = sub { |
46d0346d |
14 | my $meta = $_[0]->meta; |
efbfd430 |
15 | if(@_ > 1){ |
ce50990e |
16 | $meta->namespace->{$attribute} = \$_[1]; |
efbfd430 |
17 | return $_[1]; |
18 | } |
76aab993 |
19 | |
46d0346d |
20 | if( $meta->has_package_symbol($slot) ){ |
21 | return ${ $meta->get_package_symbol($slot) }; |
22 | } else { |
23 | foreach my $super ( $meta->linearized_isa ) { |
24 | my $super_meta = Moose::Meta::Class->initialize($super); |
25 | if( $super_meta->has_package_symbol($slot) ){ |
26 | return ${ $super_meta->get_package_symbol($slot) }; |
27 | } |
efbfd430 |
28 | } |
29 | } |
30 | return; |
a7caa492 |
31 | }; |
76aab993 |
32 | |
33 | confess("Failed to create accessor: $@ ") |
efbfd430 |
34 | unless ref $accessor eq 'CODE'; |
a7caa492 |
35 | |
efbfd430 |
36 | my $meta = $class->meta; |
843c9233 |
37 | my $immutable_options; |
38 | if( $meta->is_immutable ){ |
39 | $immutable_options = $meta->get_immutable_options; |
40 | $meta->make_mutable; |
41 | } |
a7caa492 |
42 | my $alias = "_${attribute}_accessor"; |
efbfd430 |
43 | $meta->add_method($alias, $accessor); |
44 | $meta->add_method($attribute, $accessor); |
843c9233 |
45 | if(defined $immutable_options){ |
46 | $meta->make_immutable($immutable_options); |
47 | } |
efbfd430 |
48 | $class->$attribute($_[2]) if(@_ > 2); |
a7caa492 |
49 | return $accessor; |
50 | } |
51 | |
52 | 1; |
53 | |
54 | __END__ |
46d0346d |
55 | |
56 | |
57 | =head1 NAME |
58 | |
59 | Catalyst::ClassData - Class data acessors |
60 | |
61 | =head1 METHODS |
62 | |
63 | =head2 mk_classdata $name, $optional_value |
64 | |
65 | A moose-safe clone of L<Class::Data::Inheritable> that borrows some ideas from |
66 | L<Class::Accessor::Grouped>; |
67 | |
68 | =head1 AUTHOR |
69 | |
70 | Guillermo Roditi |
71 | |
72 | =head1 COPYRIGHT |
73 | |
74 | This program is free software, you can redistribute it and/or modify it under |
75 | the same terms as Perl itself. |
76 | |
77 | =cut |