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     $options{':attribute_metaclass'} = $policy->attribute_metaclass
  29         if $policy->can('attribute_metaclass');
  30
  31     my $package = caller();
  32
  33     # create a meta object so we can install &meta
  34     my $meta = $metaclass->initialize($package => %options);
  35     $meta->add_method('meta' => sub {
  36         # we must re-initialize so that it
  37         # works as expected in subclasses,
  38         # since metaclass instances are
  39         # singletons, this is not really a
  40         # big deal anyway.
  41         $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
  42     });
  43 }
  44
  45 1;
  46
  47 __END__
  48