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");
  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 'My::MooseBestPractice';
  65   use Moose;
  66
  67   has 'bar' => (is => 'rw', default => 'Foo::bar');
  68   has 'baz' => (is => 'ro', default => 'Foo::baz');
  69
  70 =head1 DESCRIPTION
  71
  72 This class allows you to specify your project-wide or company-wide Moose
  73 meta policy in one location.
  74
  75 =head1 CAVEAT
  76
  77 =over 4
  78
  79 =item YOU MUST
  80
  81   use Moose::Policy 'My::Policy';
  82
  83 =item BEFORE
  84
  85   use Moose;
  86
  87 =back
  88
  89 =head2 The Policy
  90
  91 The argument to C<import()> is a package name.  This package is
  92 require()'d and queried for the following constants:
  93
  94 =over
  95
  96 =item metaclass
  97
  98 Defaults to C<'Moose::Meta::Class'>.
  99
 100 =item attribute_metaclass
 101
 102 =item instance_metaclass
 103
 104 =item method_metaclass
 105
 106 =back
 107
 108 These values are then used to setup your $package->meta object.
 109
 110 Your policy package could be simply a list of constants.
 111
 112   package My::Policy;
 113   use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
 114
 115 But the methods are told what package is using the policy, so they could
 116 concievably give different answers.
 117
 118   package My::FancyPolicy;
 119
 120   sub attribute_metaclass {
 121     my $self = shift;
 122     my ($user_package) = @_;
 123     return('Our::Attributes::Stricter')
 124       if $user_package =~ m/^Private::Banking::Money/;
 125     return('Our::Attributes');
 126   }
 127
 128 =head1 SEE ALSO
 129
 130 L<Moose>, L<Moose::Meta::Class>
 131
 132 =head1 BUGS
 133
 134 All complex software has bugs lurking in it, and this module is no
 135 exception. If you find a bug please either email me, or add the bug
 136 to cpan-RT.
 137
 138 =head1 AUTHOR
 139
 140 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 141
 142 Eric Wilhelm E<lt>...E<gt>
 143
 144 =head1 COPYRIGHT AND LICENSE
 145
 146 Copyright 2006 by Infinity Interactive, Inc.
 147
 148 L<http://www.iinteractive.com>
 149
 150 This library is free software; you can redistribute it and/or modify
 151 it under the same terms as Perl itself.
 152
 153 =cut
 154