From: stevan Date: Sun, 6 Aug 2006 01:30:24 +0000 (+0000) Subject: MANIFEST, Policy POD changes, other misc stuff X-Git-Tag: 0_01~3 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=2756232eadcf7f35de9d19a273b16528d487e7e3;p=gitmo%2FMoose-Policy.git MANIFEST, Policy POD changes, other misc stuff --- diff --git a/Build.PL b/Build.PL index fbc4aec..d610f08 100644 --- a/Build.PL +++ b/Build.PL @@ -6,7 +6,7 @@ my $build = Module::Build->new( module_name => 'Moose::Policy', license => 'perl', requires => { - 'Moose' => '0', + 'Moose' => '0.11', }, optional => { }, diff --git a/MANIFEST b/MANIFEST index e69de29..8066cf6 100644 --- a/MANIFEST +++ b/MANIFEST @@ -0,0 +1,12 @@ +Build.PL +Changes +META.yml +Makefile.PL +MANIFEST +MANIFEST.SKIP +README +lib/Moose/Policy.pm +t/000_load.t +t/001_basic.t +t/002_dynamic.t +t/003_saidso.t diff --git a/README b/README index 9d86e51..3b40f52 100644 --- a/README +++ b/README @@ -20,6 +20,10 @@ This module requires these other modules and libraries: COPYRIGHT AND LICENCE +Copyright (C) 2006 Infinity Interactive, Inc. + +http://www.iinteractive.com + This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. diff --git a/lib/Moose/Policy.pm b/lib/Moose/Policy.pm index 799a513..32ee1ee 100644 --- a/lib/Moose/Policy.pm +++ b/lib/Moose/Policy.pm @@ -11,15 +11,56 @@ 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 -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'; @@ -28,14 +69,14 @@ meta policy in one location. has 'bar' => (is => 'rw', default => 'Foo::bar'); has 'baz' => (is => 'ro', default => 'Foo::baz'); -=head1 USAGE +=head1 DESCRIPTION - use Moose::Policy 'My::Policy'; - use Moose; - ... - no Moose; +This class allows you to specify your project-wide or company-wide Moose +meta policy in one location. -=over +=head1 CAVEAT + +=over 4 =item YOU MUST @@ -86,65 +127,30 @@ concievably give different answers. return('Our::Attributes'); } -=head1 AUTHOR - -Stevan Little Estevan@iinteractive.comE - -In response to a feature request by Eric Wilhelm and suggestions by Matt -Trout. - -Documentation and some code are Eric's fault. - -=head1 COPYRIGHT AND LICENSE - -... - =head1 SEE ALSO L, L -=cut +=head1 BUGS -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"; - } +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 $package = caller(); - $package->can('meta') and - croak("'$package' already has a meta() method"); +=head1 AUTHOR - my $metaclass = 'Moose::Meta::Class'; - $metaclass = $policy->metaclass($package) - if $policy->can('metaclass'); +Stevan Little Estevan@iinteractive.comE - my %options; +Eric Wilhelm E...E - # build options out of policy's constants - $policy->can($_) and $options{":$_"} = $policy->$_($package) - for (qw( - attribute_metaclass - instance_metaclass - method_metaclass - )); +=head1 COPYRIGHT AND LICENSE - # 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) - }); -} +Copyright 2006 by Infinity Interactive, Inc. -1; +L -__END__ +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. +=cut diff --git a/t/001_basic.t b/t/001_basic.t index aab7cdf..0b50253 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -17,7 +17,7 @@ BEGIN { # this method (mostly stolen from M::M::Attribute) just rebuilds the # options so anything with 'is' gets PBP accessors - sub _process_options { + before '_process_options' => sub { my ($class, $name, $options) = @_; if (exists $options->{is}) { if ($options->{is} eq 'ro') {