lib/Moose/Policy.pm

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