lib/Moose/Policy.pm

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