12 use Scalar::Util 'blessed';
17 my $policy = shift || return;
19 unless (Moose::_is_class_already_loaded($policy)) {
20 ($policy->require) or confess "Could not load policy module " .
21 "'$policy' because : $UNIVERSAL::require::ERROR";
24 my $package = caller();
25 $package->can('meta') and
26 croak("'$package' already has a meta() method");
28 my $metaclass = 'Moose::Meta::Class';
29 $metaclass = $policy->metaclass($package)
30 if $policy->can('metaclass');
34 # build options out of policy's constants
35 $policy->can($_) and $options{":$_"} = $policy->$_($package)
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)
60 Moose::Policy - moose-mounted police
66 use Moose::Policy 'My::MooseBestPractice';
69 has 'bar' => (is => 'rw', default => 'Foo::bar');
70 has 'baz' => (is => 'ro', default => 'Foo::baz');
74 This class allows you to specify your project-wide or company-wide Moose
75 meta policy in one location.
83 use Moose::Policy 'My::Policy';
93 The argument to C<import()> is a package name. This package is
94 require()'d and queried for the following constants:
100 Defaults to C<'Moose::Meta::Class'>.
102 =item attribute_metaclass
104 =item instance_metaclass
106 =item method_metaclass
110 These values are then used to setup your $package->meta object.
112 Your policy package could be simply a list of constants.
115 use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
117 But the methods are told what package is using the policy, so they could
118 concievably give different answers.
120 package My::FancyPolicy;
122 sub attribute_metaclass {
124 my ($user_package) = @_;
125 return('Our::Attributes::Stricter')
126 if $user_package =~ m/^Private::Banking::Money/;
127 return('Our::Attributes');
132 L<Moose>, L<Moose::Meta::Class>
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
142 Stevan Little E<lt>stevan@iinteractive.comE<gt>
144 Eric Wilhelm E<lt>...E<gt>
146 =head1 COPYRIGHT AND LICENSE
148 Copyright 2006 by Infinity Interactive, Inc.
150 L<http://www.iinteractive.com>
152 This library is free software; you can redistribute it and/or modify
153 it under the same terms as Perl itself.