lib/Moose/Policy.pm

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