line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Moose::Policy; |
2
|
2
|
|
|
2
|
|
128472
|
use Moose 'confess', 'blessed'; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
5
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:STEVAN'; |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
sub import { |
8
|
|
|
|
|
|
|
shift; |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
my $policy = shift || return; |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
unless (Class::MOP::is_class_loaded($policy)) { |
13
|
|
|
|
|
|
|
# otherwise require it ... |
14
|
|
|
|
|
|
|
eval { Class::MOP::load_class($policy) }; |
15
|
|
|
|
|
|
|
confess "Could not load policy module '$policy' because : $@" |
16
|
|
|
|
|
|
|
if $@; |
17
|
|
|
|
|
|
|
} |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my $package = caller(); |
20
|
|
|
|
|
|
|
$package->can('meta') and |
21
|
|
|
|
|
|
|
croak("'$package' already has a meta() method, this is very problematic"); |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
my $metaclass = 'Moose::Meta::Class'; |
24
|
|
|
|
|
|
|
$metaclass = $policy->metaclass($package) |
25
|
|
|
|
|
|
|
if $policy->can('metaclass'); |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my %options; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
# build options out of policy's constants |
30
|
|
|
|
|
|
|
$policy->can($_) and $options{"$_"} = $policy->$_($package) |
31
|
|
|
|
|
|
|
for (qw( |
32
|
|
|
|
|
|
|
attribute_metaclass |
33
|
|
|
|
|
|
|
instance_metaclass |
34
|
|
|
|
|
|
|
method_metaclass |
35
|
|
|
|
|
|
|
)); |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# create a meta object so we can install &meta |
38
|
|
|
|
|
|
|
my $meta = $metaclass->initialize($package => %options); |
39
|
|
|
|
|
|
|
$meta->add_method('meta' => sub { |
40
|
|
|
|
|
|
|
# we must re-initialize so that it works as expected in |
41
|
|
|
|
|
|
|
# subclasses, since metaclass instances are singletons, this is |
42
|
|
|
|
|
|
|
# not really a big deal anyway. |
43
|
|
|
|
|
|
|
$metaclass->initialize((blessed($_[0]) || $_[0]) => %options) |
44
|
|
|
|
|
|
|
}); |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
1; |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
__END__ |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=pod |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
=head1 NAME |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
Moose::Policy - Moose-mounted police |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head1 SYNOPSIS |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
package Foo; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
use Moose::Policy 'Moose::Policy::FollowPBP'; |
62
|
|
|
|
|
|
|
use Moose; |
63
|
|
|
|
|
|
|
|
64
|
|
|
|
|
|
|
has 'bar' => (is => 'rw', default => 'Foo::bar'); |
65
|
|
|
|
|
|
|
has 'baz' => (is => 'ro', default => 'Foo::baz'); |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# Foo now has (get, set)_bar methods as well as get_baz |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 DEPRECATION NOTICE |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
B<Moose::Policy is deprecated>. |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
L<MooseX::FollowPBP> replaces the L<Moose::Policy::FollowPBP> module. The |
74
|
|
|
|
|
|
|
other policies included in this distribution do not yet have standalone MooseX |
75
|
|
|
|
|
|
|
modules, as of November, 2010. |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
This module has not passed its tests since Moose 1.05, and will probably not |
78
|
|
|
|
|
|
|
be fixed. |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
=head1 DESCRIPTION |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
This module allows you to specify your project-wide or even company-wide |
83
|
|
|
|
|
|
|
Moose meta-policy. |
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
Most all of Moose's features can be customized through the use of custom |
86
|
|
|
|
|
|
|
metaclasses, however fiddling with the metaclasses can be hairy. Moose::Policy |
87
|
|
|
|
|
|
|
removes most of that hairiness and makes it possible to cleanly contain |
88
|
|
|
|
|
|
|
a set of meta-level customizations in one easy to use module. |
89
|
|
|
|
|
|
|
|
90
|
|
|
|
|
|
|
This is still an release of this module and it should not be considered to |
91
|
|
|
|
|
|
|
be complete by any means. It is very basic implemenation at this point and |
92
|
|
|
|
|
|
|
will likely get more feature-full over time, as people request features. |
93
|
|
|
|
|
|
|
So if you have a suggestion/need/idea, please speak up. |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
=head2 What is a meta-policy? |
96
|
|
|
|
|
|
|
|
97
|
|
|
|
|
|
|
A meta-policy is a set of custom Moose metaclasses which can be used to |
98
|
|
|
|
|
|
|
implement a number of customizations and restrictions on a particular |
99
|
|
|
|
|
|
|
Moose class. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
For instance, L<Moose::Policy::SingleInheritence> enforces that all |
102
|
|
|
|
|
|
|
specified Moose classes can only use single inheritance. It does this |
103
|
|
|
|
|
|
|
by trapping the call to C<superclasses> on the metaclass and only allowing |
104
|
|
|
|
|
|
|
you to assign a single superclass. |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
The L<Moose::Policy::FollowPBP> policy changes the default behavior of |
107
|
|
|
|
|
|
|
accessors to fit the recomendations found in Perl Best Practices. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
=head1 CAVEATS |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=head2 Always load Moose::Policy first. |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
You B<must> put the following line of code: |
114
|
|
|
|
|
|
|
|
115
|
|
|
|
|
|
|
use Moose::Policy 'My::Policy'; |
116
|
|
|
|
|
|
|
|
117
|
|
|
|
|
|
|
before this line: |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
use Moose; |
120
|
|
|
|
|
|
|
|
121
|
|
|
|
|
|
|
This is because Moose::Policy must be given the opportunity to set the |
122
|
|
|
|
|
|
|
custom metaclass before Moose has set it's default metaclass. In fact, if |
123
|
|
|
|
|
|
|
you try to set a Moose::Policy and there is a C<meta> method available, |
124
|
|
|
|
|
|
|
not only will kittens die, but your program will too. |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
=head2 Policies are class scoped |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
You must repeat the policy for each class you want to use it. It is B<not> |
129
|
|
|
|
|
|
|
inherited. This may change in the future, probably it will be a Moose::Policy |
130
|
|
|
|
|
|
|
itself to allow Moose policies to be inherited. |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
=head1 THE POLICY |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
A Policy is set by passing C<Moose::Policy::import()> a package name. This |
135
|
|
|
|
|
|
|
package is then queried for what metaclasses it should use. The possible |
136
|
|
|
|
|
|
|
metaclass values are: |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=over |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
=item B<metaclass> |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
This defaults to C<Moose::Meta::Class>. |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
=item B<attribute_metaclass> |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=item B<instance_metaclass> |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=item B<method_metaclass> |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=back |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
For examples of what a Policy actually looks like see the examples in |
153
|
|
|
|
|
|
|
C<Moose::Policy::> and the test suite. More docs to come on this later (probably |
154
|
|
|
|
|
|
|
a cookbook or something). |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 METHODS |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=over 4 |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=item B<meta> |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=back |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
=head1 FUTURE PLANS |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
As I said above, this is the first release and it is by no means feature complete. |
167
|
|
|
|
|
|
|
There are a number of thoughts on the future direction of this module. Here are |
168
|
|
|
|
|
|
|
some random thoughts on that, in no particular order. |
169
|
|
|
|
|
|
|
|
170
|
|
|
|
|
|
|
=over 4 |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
=item Make set of policy roles |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
Roles are an excellent way to combine sets of behaviors together into one, and |
175
|
|
|
|
|
|
|
custom metaclasses are actually better composed by roles then by inheritence. |
176
|
|
|
|
|
|
|
The ideal situation is that this module will provide a set of roles which can be |
177
|
|
|
|
|
|
|
used to compose your meta-policy with relative ease. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=back |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=head1 BUGS |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
All complex software has bugs lurking in it, and this module is no |
184
|
|
|
|
|
|
|
exception. If you find a bug please either email me, or add the bug |
185
|
|
|
|
|
|
|
to cpan-RT. |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=head1 AUTHOR |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
Stevan Little E<lt>stevan@iinteractive.comE<gt> |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
Eric Wilhelm |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
Copyright 2006-2007 by Infinity Interactive, Inc. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
L<http://www.iinteractive.com> |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
This library is free software; you can redistribute it and/or modify |
200
|
|
|
|
|
|
|
it under the same terms as Perl itself. |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
=cut |
203
|
|
|
|
|
|
|
|