lib/Moose/Policy.pm

   1
   2 package Moose::Policy;
   3
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.01';
   8
   9 use Moose        ();
  10 use Carp         'confess';
  11 use Scalar::Util 'blessed';
  12
  13 sub import {
  14     shift;
  15
  16     my $policy = shift || return;
  17
  18     unless (Moose::_is_class_already_loaded($policy)) {
  19         ($policy->require)
  20             || confess "Could not load policy module '$policy' because : " . $UNIVERSAL::require::ERROR;
  21     }
  22
  23     my $metaclass = 'Moose::Meta::Class';
  24     $metaclass = $policy->metaclass if $policy->can('metaclass');
  25
  26     my %options;
  27
  28     # build options out of policy's constants
  29     $policy->can($_) and $options{":$_"} = $policy->$_()
  30         for (qw(
  31             attribute_metaclass
  32             instance_metaclass
  33             method_metaclass
  34             ));
  35
  36     my $package = caller();
  37     $package->can('meta') and
  38         croak("'$package' already has a meta() method");
  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
  44         # works as expected in subclasses,
  45         # since metaclass instances are
  46         # singletons, this is not really a
  47         # big deal anyway.
  48         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
  49     });
  50 }
  51
  52 1;
  53
  54 __END__
  55
  56