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