lib/Moose/Policy.pm

   1 package Moose::Policy;
   2
   3 # vim:ts=4:sw=4:et:sta
   4
   5 use strict;
   6 use warnings;
   7
   8 our $VERSION = '0.01';
   9
  10 use Moose        ();
  11 use Carp         'confess';
  12 use Scalar::Util 'blessed';
  13
  14 =head1 NAME
  15
  16 Moose::Policy - moose-mounted police
  17
  18 =head1 SYNOPSIS
  19
  20 This class allows you to specify your project-wide or company-wide Moose
  21 meta policy in one location.
  22
  23   package Foo;
  24
  25   use Moose::Policy 'My::MooseBestPractice';
  26   use Moose;
  27
  28   has 'bar' => (is => 'rw', default => 'Foo::bar');
  29   has 'baz' => (is => 'ro', default => 'Foo::baz');
  30
  31 =head1 USAGE
  32
  33   use Moose::Policy 'My::Policy';
  34   use Moose;
  35   ...
  36   no Moose;
  37
  38 =over
  39
  40 =item YOU MUST
  41
  42   use Moose::Policy 'My::Policy';
  43
  44 =item BEFORE
  45
  46   use Moose;
  47
  48 =back
  49
  50 =head2 The Policy
  51
  52 The argument to C<import()> is a package name.  This package is
  53 require()'d and queried for the following constants:
  54
  55 =over
  56
  57 =item metaclass
  58
  59 Defaults to C<'Moose::Meta::Class'>.
  60
  61 =item attribute_metaclass
  62
  63 =item instance_metaclass
  64
  65 =item method_metaclass
  66
  67 =back
  68
  69 These values are then used to setup your $package->meta object.
  70
  71 Your policy package could be simply a list of constants.
  72
  73   package My::Policy;
  74   use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
  75
  76 But the methods are told what package is using the policy, so they could
  77 concievably give different answers.
  78
  79   package My::FancyPolicy;
  80
  81   sub attribute_metaclass {
  82     my $self = shift;
  83     my ($user_package) = @_;
  84     return('Our::Attributes::Stricter')
  85       if $user_package =~ m/^Private::Banking::Money/;
  86     return('Our::Attributes');
  87   }
  88
  89 =head1 AUTHOR
  90
  91 Stevan Little E<lt>stevan@iinteractive.comE<gt>
  92
  93 In response to a feature request by Eric Wilhelm and suggestions by Matt
  94 Trout.
  95
  96 Documentation and some code are Eric's fault.
  97
  98 =head1 COPYRIGHT AND LICENSE
  99
 100 ...
 101
 102 =head1 SEE ALSO
 103
 104 L<Moose>, L<Moose::Meta::Class>
 105
 106 =cut
 107
 108 sub import {
 109     shift;
 110
 111     my $policy = shift || return;
 112
 113     unless (Moose::_is_class_already_loaded($policy)) {
 114         ($policy->require) or confess "Could not load policy module " .
 115             "'$policy' because : $UNIVERSAL::require::ERROR";
 116     }
 117
 118     my $package = caller();
 119     $package->can('meta') and
 120         croak("'$package' already has a meta() method");
 121
 122     my $metaclass = 'Moose::Meta::Class';
 123     $metaclass = $policy->metaclass($package)
 124         if $policy->can('metaclass');
 125
 126     my %options;
 127
 128     # build options out of policy's constants
 129     $policy->can($_) and $options{":$_"} = $policy->$_($package)
 130         for (qw(
 131             attribute_metaclass
 132             instance_metaclass
 133             method_metaclass
 134             ));
 135
 136     # create a meta object so we can install &meta
 137     my $meta = $metaclass->initialize($package => %options);
 138     $meta->add_method('meta' => sub {
 139         # we must re-initialize so that it works as expected in
 140         # subclasses, since metaclass instances are singletons, this is
 141         # not really a big deal anyway.
 142         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
 143     });
 144 }
 145
 146 1;
 147
 148 __END__
 149
 150