adding in some basic policies and some tests

[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) or confess "Could not load policy module " .
            "'$policy' because : $UNIVERSAL::require::ERROR";
    }

    my $package = caller();
    $package->can('meta') and
        croak("'$package' already has a meta() method");

    my $metaclass = 'Moose::Meta::Class';
    $metaclass = $policy->metaclass($package)
        if $policy->can('metaclass');

    my %options;

    # build options out of policy's constants
    $policy->can($_) and $options{":$_"} = $policy->$_($package)
        for (qw(
            attribute_metaclass
            instance_metaclass
            method_metaclass
            ));

    # 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__

=pod

=head1 NAME

Moose::Policy - moose-mounted police

=head1 SYNOPSIS

  package Foo;

  use Moose::Policy 'My::MooseBestPractice';
  use Moose;

  has 'bar' => (is => 'rw', default => 'Foo::bar');
  has 'baz' => (is => 'ro', default => 'Foo::baz');

=head1 DESCRIPTION

This class allows you to specify your project-wide or company-wide Moose
meta policy in one location.

=head1 CAVEAT

=over 4

=item YOU MUST

  use Moose::Policy 'My::Policy';

=item BEFORE

  use Moose;

=back

=head2 The Policy

The argument to C<import()> is a package name.  This package is
require()'d and queried for the following constants:

=over

=item metaclass 

Defaults to C<'Moose::Meta::Class'>.

=item attribute_metaclass

=item instance_metaclass

=item method_metaclass

=back

These values are then used to setup your $package->meta object.

Your policy package could be simply a list of constants.

  package My::Policy;
  use constant attribute_metaclass => 'My::Moose::Meta::Attribute';

But the methods are told what package is using the policy, so they could
concievably give different answers.

  package My::FancyPolicy;

  sub attribute_metaclass {
    my $self = shift;
    my ($user_package) = @_;
    return('Our::Attributes::Stricter')
      if $user_package =~ m/^Private::Banking::Money/;
    return('Our::Attributes');
  }

=head1 SEE ALSO

L<Moose>, L<Moose::Meta::Class>

=head1 BUGS

All complex software has bugs lurking in it, and this module is no 
exception. If you find a bug please either email me, or add the bug
to cpan-RT.

=head1 AUTHOR

Stevan Little E<lt>stevan@iinteractive.comE<gt>

Eric Wilhelm E<lt>...E<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2006 by Infinity Interactive, Inc.

L<http://www.iinteractive.com>

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.

=cut