Commit | Line | Data |
82cfc049 |
1 | package Moose::Policy; |
2 | |
8e7059d6 |
3 | # vim:ts=4:sw=4:et:sta |
4 | |
82cfc049 |
5 | use strict; |
6 | use warnings; |
7 | |
b9238462 |
8 | our $VERSION = '0.01'; |
9 | |
10 | use Moose (); |
11 | use Carp 'confess'; |
12 | use Scalar::Util 'blessed'; |
13 | |
2756232e |
14 | sub import { |
15 | shift; |
16 | |
17 | my $policy = shift || return; |
18 | |
19 | unless (Moose::_is_class_already_loaded($policy)) { |
20 | ($policy->require) or confess "Could not load policy module " . |
21 | "'$policy' because : $UNIVERSAL::require::ERROR"; |
22 | } |
23 | |
24 | my $package = caller(); |
25 | $package->can('meta') and |
26 | croak("'$package' already has a meta() method"); |
27 | |
28 | my $metaclass = 'Moose::Meta::Class'; |
29 | $metaclass = $policy->metaclass($package) |
30 | if $policy->can('metaclass'); |
31 | |
32 | my %options; |
33 | |
34 | # build options out of policy's constants |
35 | $policy->can($_) and $options{":$_"} = $policy->$_($package) |
36 | for (qw( |
37 | attribute_metaclass |
38 | instance_metaclass |
39 | method_metaclass |
40 | )); |
41 | |
42 | # create a meta object so we can install &meta |
43 | my $meta = $metaclass->initialize($package => %options); |
44 | $meta->add_method('meta' => sub { |
45 | # we must re-initialize so that it works as expected in |
46 | # subclasses, since metaclass instances are singletons, this is |
47 | # not really a big deal anyway. |
48 | $metaclass->initialize((blessed($_[0]) || $_[0]) => %options) |
49 | }); |
50 | } |
51 | |
52 | 1; |
53 | |
54 | __END__ |
55 | |
56 | =pod |
57 | |
8e7059d6 |
58 | =head1 NAME |
59 | |
60 | Moose::Policy - moose-mounted police |
61 | |
62 | =head1 SYNOPSIS |
63 | |
8e7059d6 |
64 | package Foo; |
65 | |
66 | use Moose::Policy 'My::MooseBestPractice'; |
67 | use Moose; |
68 | |
69 | has 'bar' => (is => 'rw', default => 'Foo::bar'); |
70 | has 'baz' => (is => 'ro', default => 'Foo::baz'); |
71 | |
2756232e |
72 | =head1 DESCRIPTION |
8e7059d6 |
73 | |
2756232e |
74 | This class allows you to specify your project-wide or company-wide Moose |
75 | meta policy in one location. |
8e7059d6 |
76 | |
2756232e |
77 | =head1 CAVEAT |
78 | |
79 | =over 4 |
8e7059d6 |
80 | |
81 | =item YOU MUST |
82 | |
83 | use Moose::Policy 'My::Policy'; |
84 | |
85 | =item BEFORE |
86 | |
87 | use Moose; |
88 | |
89 | =back |
90 | |
91 | =head2 The Policy |
92 | |
93 | The argument to C<import()> is a package name. This package is |
94 | require()'d and queried for the following constants: |
95 | |
96 | =over |
97 | |
98 | =item metaclass |
99 | |
100 | Defaults to C<'Moose::Meta::Class'>. |
101 | |
102 | =item attribute_metaclass |
103 | |
104 | =item instance_metaclass |
105 | |
106 | =item method_metaclass |
107 | |
108 | =back |
109 | |
110 | These values are then used to setup your $package->meta object. |
111 | |
112 | Your policy package could be simply a list of constants. |
113 | |
114 | package My::Policy; |
115 | use constant attribute_metaclass => 'My::Moose::Meta::Attribute'; |
116 | |
117 | But the methods are told what package is using the policy, so they could |
118 | concievably give different answers. |
119 | |
120 | package My::FancyPolicy; |
121 | |
122 | sub attribute_metaclass { |
123 | my $self = shift; |
124 | my ($user_package) = @_; |
125 | return('Our::Attributes::Stricter') |
126 | if $user_package =~ m/^Private::Banking::Money/; |
127 | return('Our::Attributes'); |
128 | } |
129 | |
8e7059d6 |
130 | =head1 SEE ALSO |
131 | |
132 | L<Moose>, L<Moose::Meta::Class> |
133 | |
2756232e |
134 | =head1 BUGS |
8e7059d6 |
135 | |
2756232e |
136 | All complex software has bugs lurking in it, and this module is no |
137 | exception. If you find a bug please either email me, or add the bug |
138 | to cpan-RT. |
8e7059d6 |
139 | |
2756232e |
140 | =head1 AUTHOR |
8e7059d6 |
141 | |
2756232e |
142 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
8e7059d6 |
143 | |
2756232e |
144 | Eric Wilhelm E<lt>...E<gt> |
8e7059d6 |
145 | |
2756232e |
146 | =head1 COPYRIGHT AND LICENSE |
8e7059d6 |
147 | |
2756232e |
148 | Copyright 2006 by Infinity Interactive, Inc. |
b9238462 |
149 | |
2756232e |
150 | L<http://www.iinteractive.com> |
82cfc049 |
151 | |
2756232e |
152 | This library is free software; you can redistribute it and/or modify |
153 | it under the same terms as Perl itself. |
82cfc049 |
154 | |
2756232e |
155 | =cut |
bfacd619 |
156 | |