package Moose::Policy;
+use Moose 'confess', 'blessed';
-# vim:ts=4:sw=4:et:sta
+our $VERSION = '0.04';
+our $AUTHORITY = 'cpan:STEVAN';
-use strict;
-use warnings;
+sub import {
+ shift;
+
+ my $policy = shift || return;
+
+ unless (Class::MOP::is_class_loaded($policy)) {
+ # otherwise require it ...
+ eval { Class::MOP::load_class($policy) };
+ confess "Could not load policy module '$policy' because : $@"
+ if $@;
+ }
-our $VERSION = '0.01';
+ my $package = caller();
+ $package->can('meta') and
+ croak("'$package' already has a meta() method, this is very problematic");
-use Moose ();
-use Carp 'confess';
-use Scalar::Util 'blessed';
+ my $metaclass = 'Moose::Meta::Class';
+ $metaclass = $policy->metaclass($package)
+ if $policy->can('metaclass');
+
+ my %options;
+
+ # build options out of policy's constants
+ $policy->can($_) and $options{"$_"} = $policy->$_($package)
+ for (qw(
+ attribute_metaclass
+ instance_metaclass
+ method_metaclass
+ ));
+
+ # create a meta object so we can install &meta
+ my $meta = $metaclass->initialize($package => %options);
+ $meta->add_method('meta' => sub {
+ # we must re-initialize so that it works as expected in
+ # subclasses, since metaclass instances are singletons, this is
+ # not really a big deal anyway.
+ $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
+ });
+}
+
+1;
+
+__END__
+
+=pod
=head1 NAME
-Moose::Policy - moose-mounted police
+Moose::Policy - Moose-mounted police
=head1 SYNOPSIS
-This class allows you to specify your project-wide or company-wide Moose
-meta policy in one location.
-
package Foo;
- use Moose::Policy 'My::MooseBestPractice';
+ use Moose::Policy 'Moose::Policy::FollowPBP';
use Moose;
has 'bar' => (is => 'rw', default => 'Foo::bar');
has 'baz' => (is => 'ro', default => 'Foo::baz');
-=head1 USAGE
+ # Foo now has (get, set)_bar methods as well as get_baz
- use Moose::Policy 'My::Policy';
- use Moose;
- ...
- no Moose;
+=head1 DESCRIPTION
-=over
+This module allows you to specify your project-wide or even company-wide
+Moose meta-policy.
-=item YOU MUST
+Most all of Moose's features can be customized through the use of custom
+metaclasses, however fiddling with the metaclasses can be hairy. Moose::Policy
+removes most of that hairiness and makes it possible to cleanly contain
+a set of meta-level customizations in one easy to use module.
- use Moose::Policy 'My::Policy';
+This is still an release of this module and it should not be considered to
+be complete by any means. It is very basic implemenation at this point and
+will likely get more feature-full over time, as people request features.
+So if you have a suggestion/need/idea, please speak up.
-=item BEFORE
+=head2 What is a meta-policy?
- use Moose;
+A meta-policy is a set of custom Moose metaclasses which can be used to
+implement a number of customizations and restrictions on a particular
+Moose class.
-=back
+For instance, L<Moose::Policy::SingleInheritence> enforces that all
+specified Moose classes can only use single inheritance. It does this
+by trapping the call to C<superclasses> on the metaclass and only allowing
+you to assign a single superclass.
-=head2 The Policy
+The L<Moose::Policy::FollowPBP> policy changes the default behavior of
+accessors to fit the recomendations found in Perl Best Practices.
-The argument to C<import()> is a package name. This package is
-require()'d and queried for the following constants:
+=head1 CAVEATS
-=over
+=head2 Always load Moose::Policy first.
+
+You B<must> put the following line of code:
+
+ use Moose::Policy 'My::Policy';
-=item metaclass
+before this line:
-Defaults to C<'Moose::Meta::Class'>.
+ use Moose;
-=item attribute_metaclass
+This is because Moose::Policy must be given the opportunity to set the
+custom metaclass before Moose has set it's default metaclass. In fact, if
+you try to set a Moose::Policy and there is a C<meta> method available,
+not only will kittens die, but your program will too.
-=item instance_metaclass
+=head2 Policies are class scoped
-=item method_metaclass
+You must repeat the policy for each class you want to use it. It is B<not>
+inherited. This may change in the future, probably it will be a Moose::Policy
+itself to allow Moose policies to be inherited.
-=back
+=head1 THE POLICY
-These values are then used to setup your $package->meta object.
+A Policy is set by passing C<Moose::Policy::import()> a package name. This
+package is then queried for what metaclasses it should use. The possible
+metaclass values are:
-Your policy package could be simply a list of constants.
+=over
- package My::Policy;
- use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
+=item B<metaclass>
-But the methods are told what package is using the policy, so they could
-concievably give different answers.
+This defaults to C<Moose::Meta::Class>.
- package My::FancyPolicy;
+=item B<attribute_metaclass>
- sub attribute_metaclass {
- my $self = shift;
- my ($user_package) = @_;
- return('Our::Attributes::Stricter')
- if $user_package =~ m/^Private::Banking::Money/;
- return('Our::Attributes');
- }
+=item B<instance_metaclass>
-=head1 AUTHOR
+=item B<method_metaclass>
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
+=back
-In response to a feature request by Eric Wilhelm and suggestions by Matt
-Trout.
+For examples of what a Policy actually looks like see the examples in
+C<Moose::Policy::> and the test suite. More docs to come on this later (probably
+a cookbook or something).
-Documentation and some code are Eric's fault.
+=head1 METHODS
-=head1 COPYRIGHT AND LICENSE
+=over 4
-...
+=item B<meta>
-=head1 SEE ALSO
+=back
-L<Moose>, L<Moose::Meta::Class>
+=head1 FUTURE PLANS
-=cut
+As I said above, this is the first release and it is by no means feature complete.
+There are a number of thoughts on the future direction of this module. Here are
+some random thoughts on that, in no particular order.
-sub import {
- shift;
+=over 4
- my $policy = shift || return;
+=item Make set of policy roles
- unless (Moose::_is_class_already_loaded($policy)) {
- ($policy->require) or confess "Could not load policy module " .
- "'$policy' because : $UNIVERSAL::require::ERROR";
- }
+Roles are an excellent way to combine sets of behaviors together into one, and
+custom metaclasses are actually better composed by roles then by inheritence.
+The ideal situation is that this module will provide a set of roles which can be
+used to compose your meta-policy with relative ease.
- my $package = caller();
- $package->can('meta') and
- croak("'$package' already has a meta() method");
+=back
- my $metaclass = 'Moose::Meta::Class';
- $metaclass = $policy->metaclass($package)
- if $policy->can('metaclass');
+=head1 BUGS
- my %options;
+All complex software has bugs lurking in it, and this module is no
+exception. If you find a bug please either email me, or add the bug
+to cpan-RT.
- # build options out of policy's constants
- $policy->can($_) and $options{":$_"} = $policy->$_($package)
- for (qw(
- attribute_metaclass
- instance_metaclass
- method_metaclass
- ));
+=head1 AUTHOR
- # create a meta object so we can install &meta
- my $meta = $metaclass->initialize($package => %options);
- $meta->add_method('meta' => sub {
- # we must re-initialize so that it works as expected in
- # subclasses, since metaclass instances are singletons, this is
- # not really a big deal anyway.
- $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
- });
-}
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
-1;
+Eric Wilhelm
-__END__
+=head1 COPYRIGHT AND LICENSE
+
+Copyright 2006-2007 by Infinity Interactive, Inc.
+
+L<http://www.iinteractive.com>
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut