t/001_basic.t - add ro test

[gitmo/Moose-Policy.git] / lib / Moose / Policy.pm

package Moose::Policy;

use strict;
use warnings;

our $VERSION = '0.01';

use Moose        ();
use Carp         'confess';
use Scalar::Util 'blessed';

sub import {
    shift;
    
    my $policy = shift || return;
    
    unless (Moose::_is_class_already_loaded($policy)) {
        ($policy->require)
            || confess "Could not load policy module '$policy' because : " . $UNIVERSAL::require::ERROR;
    }
        
    my $metaclass = 'Moose::Meta::Class';
    $metaclass = $policy->metaclass if $policy->can('metaclass');
    
    my %options;
    
    # build options out of policy's constants
    $policy->can($_) and $options{":$_"} = $policy->$_()
        for (qw(
            attribute_metaclass
            instance_metaclass
            method_metaclass
            ));
    
    my $package = caller();
    $package->can('meta') and
        croak("'$package' already has a meta() method");
    
    # create a meta object so we can install &meta
    my $meta = $metaclass->initialize($package => %options);
    $meta->add_method('meta' => sub {
        # we must re-initialize so that it 
        # works as expected in subclasses, 
        # since metaclass instances are 
        # singletons, this is not really a 
        # big deal anyway.
        $metaclass->initialize((blessed($_[0]) || $_[0]) => %options)
    });    
}

1;

__END__