foo
[gitmo/Moose-Policy.git] / lib / Moose / Policy.pm
index 799a513..8225c76 100644 (file)
 package Moose::Policy;
 
-# vim:ts=4:sw=4:et:sta
-
 use strict;
 use warnings;
 
-our $VERSION = '0.01';
+our $VERSION = '0.02';
 
 use Moose        ();
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
+sub import {
+    shift;
+
+    my $policy = shift || return;
+
+    unless (Moose::_is_class_already_loaded($policy)) {
+        # otherwise require it ...
+        my $file = $policy . '.pm';
+        $file =~ s{::}{/}g;
+        eval { CORE::require($file) };
+        confess "Could not load policy module " .
+        "'$policy' because : $UNIVERSAL::require::ERROR"
+            if $@;        
+    }
+
+    my $package = caller();
+    $package->can('meta') and
+        croak("'$package' already has a meta() method, this is very problematic");
+
+    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
 
-This class allows you to specify your project-wide or company-wide Moose
-meta policy in one location.
-
   package Foo;
 
-  use Moose::Policy 'My::MooseBestPractice';
+  use Moose::Policy 'Moose::Policy::FollowPBP';
   use Moose;
 
   has 'bar' => (is => 'rw', default => 'Foo::bar');
   has 'baz' => (is => 'ro', default => 'Foo::baz');
 
-=head1 USAGE
+  # Foo now has (get, set)_bar methods as well as get_baz
 
-  use Moose::Policy 'My::Policy';
-  use Moose;
-  ...
-  no Moose;
+=head1 DESCRIPTION
 
-=over
+This module allows you to specify your project-wide or even company-wide 
+Moose meta-policy. 
 
-=item YOU MUST
+Most all of Moose's features can be customized through the use of custom 
+metaclasses, however fiddling with the metaclasses can be hairy. Moose::Policy 
+removes most of that hairiness and makes it possible to cleanly contain 
+a set of meta-level customizations in one easy to use module.
 
-  use Moose::Policy 'My::Policy';
+This is the first release of this module and it should not be considered to 
+be complete by any means. It is very basic implemenation at this point and 
+will likely get more feature-full over time, as people request features.
+So if you have a suggestion/need/idea, please speak up.
 
-=item BEFORE
+=head2 What is a meta-policy?
 
-  use Moose;
+A meta-policy is a set of custom Moose metaclasses which can be used to 
+implement a number of customizations and restrictions on a particular 
+Moose class. 
 
-=back
+For instance, L<Moose::Policy::SingleInheritence> enforces that all 
+specified Moose classes can only use single inheritence. It does this 
+by trapping the call to C<superclasses> on the metaclass and only allowing 
+you to assign a single superclass. 
 
-=head2 The Policy
+The L<Moose::Policy::FollowPBP> policy changes the default behavior of 
+accessors to fit the recomendations found in Perl Best Practices. 
 
-The argument to C<import()> is a package name.  This package is
-require()'d and queried for the following constants:
+=head1 CAVEATS
 
-=over
+=head2 Always load Moose::Policy first.
 
-=item metaclass 
+You B<must> put the following line of code: 
 
-Defaults to C<'Moose::Meta::Class'>.
+  use Moose::Policy 'My::Policy';
 
-=item attribute_metaclass
+before this line:
 
-=item instance_metaclass
+  use Moose;
 
-=item method_metaclass
+This is because Moose::Policy must be given the opportunity to set the 
+custom metaclass before Moose has set it's default metaclass. In fact, if 
+you try to set a Moose::Policy and there is a C<meta> method available, 
+not only will kittens die, but your program will too.
 
-=back
+=head2 Policys are class scoped
 
-These values are then used to setup your $package->meta object.
+You must repeat the policy for each class you want to us it. It is B<not> 
+inherited. This may change in the future, probably it will be a Moose::Policy 
+itself to allow Moose policys to be inherited.
 
-Your policy package could be simply a list of constants.
+=head1 THE POLICY
 
-  package My::Policy;
-  use constant attribute_metaclass => 'My::Moose::Meta::Attribute';
+A Policy is set by passing C<Moose::Polocy::import()> a package name.  This 
+package is then queried for what metaclasses it should use. The possible 
+metaclass values are:
 
-But the methods are told what package is using the policy, so they could
-concievably give different answers.
+=over
 
-  package My::FancyPolicy;
+=item B<metaclass> 
 
-  sub attribute_metaclass {
-    my $self = shift;
-    my ($user_package) = @_;
-    return('Our::Attributes::Stricter')
-      if $user_package =~ m/^Private::Banking::Money/;
-    return('Our::Attributes');
-  }
+This defaults to C<Moose::Meta::Class>.
 
-=head1 AUTHOR
+=item B<attribute_metaclass>
 
-Stevan Little E<lt>stevan@iinteractive.comE<gt>
+=item B<instance_metaclass>
 
-In response to a feature request by Eric Wilhelm and suggestions by Matt
-Trout.
+=item B<method_metaclass>
 
-Documentation and some code are Eric's fault.
+=back
 
-=head1 COPYRIGHT AND LICENSE
+For examples of what a Policy actually looks like see the examples in 
+C<Moose::Policy::> and the test suite. More docs to come on this later (probably 
+a cookbook or something).
 
-...
+=head1 FUTURE PLANS
 
-=head1 SEE ALSO
+As I said above, this is the first release and it is by no means feature complete. 
+There are a number of thoughts on the future direction of this module. Here are 
+some random thoughts on that, in no particular order.
 
-L<Moose>, L<Moose::Meta::Class>
+=over 4
 
-=cut
+=item Make set of policy roles
 
-sub import {
-    shift;
+Roles are an excellent way to combine sets of behaviors together into one, and 
+custom metaclasses are actually better composed by roles then by inheritence. 
+The ideal situation is that this module will provide a set of roles which can be 
+used to compose you meta-policy with relative ease.
 
-    my $policy = shift || return;
+=back
 
-    unless (Moose::_is_class_already_loaded($policy)) {
-        ($policy->require) or confess "Could not load policy module " .
-            "'$policy' because : $UNIVERSAL::require::ERROR";
-    }
+=head1 BUGS
 
-    my $package = caller();
-    $package->can('meta') and
-        croak("'$package' already has a meta() method");
+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.
 
-    my $metaclass = 'Moose::Meta::Class';
-    $metaclass = $policy->metaclass($package)
-        if $policy->can('metaclass');
+=head1 AUTHOR
 
-    my %options;
+Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
-    # build options out of policy's constants
-    $policy->can($_) and $options{":$_"} = $policy->$_($package)
-        for (qw(
-            attribute_metaclass
-            instance_metaclass
-            method_metaclass
-            ));
+Eric Wilhelm
 
-    # 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)
-    });
-}
+=head1 COPYRIGHT AND LICENSE
 
-1;
+Copyright 2006 by Infinity Interactive, Inc.
 
-__END__
+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