Commit | Line | Data |
667db0bf |
1 | |
2 | package MooseX::AttributeHelpers::Sugar; |
3 | use Carp qw(confess); |
4 | use Exporter qw(import); |
5 | our @EXPORT = qw(define_attribute_helper); |
6 | |
7 | sub define_attribute_helper (%) { |
8 | my %info = @_; |
9 | my $class = caller(); |
10 | my $meta = $class->meta; |
11 | |
12 | $meta->add_method('helper_type', sub {$info{helper_type}}); |
13 | $meta->add_method('default_options', sub {$info{default_options}}); |
14 | $meta->add_method('auto_provide', sub {$info{auto_provide} || 0}); |
15 | |
16 | if(my $provider = $info{method_provider}) { |
17 | eval "require $provider"; |
18 | confess "Error loading method provider" if $@; |
19 | $meta->add_attribute('+method_provider', default => $provider); |
20 | } |
21 | |
22 | if (my $cons = $info{method_constructors}) { |
23 | $meta->add_attribute('+method_constructors', default => $cons) |
24 | } |
25 | |
26 | if (my $s = $info{shortcut}) { |
27 | $meta->create("Moose::Meta::Attribute::Custom::$s", |
28 | methods => {register_implementation => sub { $class }}, |
29 | ); |
30 | } |
31 | } |
32 | |
33 | 1; |
34 | |
35 | __END__ |
36 | |
37 | =pod |
38 | |
39 | =head1 NAME |
40 | |
41 | MooseX::AttributeHelpers::Sugar - Convenience for defining AttributeHelper |
42 | metaclasses. |
43 | |
44 | =head1 SYNOPSIS |
45 | |
46 | package MooseX::AttributeHelpers::Counter; |
47 | use Moose; |
48 | use MooseX::AttributeHelpers::Sugar; |
49 | |
50 | extends 'MooseX::AttributeHelpers::Base'; |
51 | |
52 | define_attribute_helper ( |
53 | default_options => { |
54 | is => 'ro', |
55 | default => 0, |
56 | }, |
57 | |
58 | helper_type => 'Num', |
59 | method_provider => 'MooseX::AttributeHelpers::MethodProvider::Counter', |
60 | auto_provide => 1, |
61 | shortcut => 'Counter', |
62 | ); |
63 | |
64 | no Moose; |
65 | no MooseX::AttributeHelpers::Sugar; |
66 | |
67 | 1; |
68 | |
69 | =head1 DESCRIPTION |
70 | |
71 | This is just sugar to let you declaratively subclass |
72 | L<MooseX::AttributeHelpers::Base>. You still need to explicitly subclass, but |
73 | most of the boilerplate is taken care of for you by the sugar. One function is |
74 | exported. |
75 | |
76 | =over 4 |
77 | |
78 | =item B<define_attribute_helper> |
79 | |
80 | The following parameters are accepted, and are used to override methods in |
81 | the base class (see its documentation for details). |
82 | |
83 | =item B<default_options> I<HashRef> |
84 | |
85 | =item B<helper_type> I<String> |
86 | |
87 | =item B<auto_provide> I<Bool> |
88 | |
89 | =item B<method_provider> I<ClassName> |
90 | |
91 | =item B<method_constructors> I<HashRef> |
92 | |
93 | =back |
94 | |
95 | =head SHORTCUT |
96 | |
97 | For ease of use of the generated metaclasses, if you pass in a "shortcut" |
98 | parameter to define_attribute_helper, a class at |
99 | Moose::Meta::Attribute::Custom::$shortcut will be generated for you, which |
100 | allows clients of your class to specify their metaclass by this shortcut |
101 | (without the long prefix). |
102 | |
103 | =head1 BUGS |
104 | |
105 | All complex software has bugs lurking in it, and this module is no |
106 | exception. If you find a bug please either email me, or add the bug |
107 | to cpan-RT. |
108 | |
109 | =head1 AUTHOR |
110 | |
111 | Paul Driver E<lt> frodwith at cpan.org E<gt> |
112 | |
113 | =head1 COPYRIGHT AND LICENSE |
114 | |
115 | Copyright 2007, 2008 by Infinity Interactive, Inc. |
116 | |
117 | L<http://www.iinteractive.com> |
118 | |
119 | This library is free software; you can redistribute it and/or modify |
120 | it under the same terms as Perl itself. |
121 | |
122 | =cut |