From: stevan Date: Wed, 9 Aug 2006 20:53:28 +0000 (+0000) Subject: version 0.01 X-Git-Tag: 0_01^0 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=0f7513779ca5767f381e86460390b4222b4f8a4a;p=gitmo%2FMoose-Policy.git version 0.01 --- diff --git a/Build.PL b/Build.PL index d610f08..50c9145 100644 --- a/Build.PL +++ b/Build.PL @@ -6,7 +6,9 @@ my $build = Module::Build->new( module_name => 'Moose::Policy', license => 'perl', requires => { - 'Moose' => '0.11', + 'Scalar::Util' => '1.18', + 'Carp' => '0', + 'Moose' => '0.11', }, optional => { }, diff --git a/Changes b/Changes index 9bab406..5c0b895 100644 --- a/Changes +++ b/Changes @@ -1,4 +1,5 @@ Revision history for Perl extension Moose-Policy -0.01 - - module created \ No newline at end of file +0.01 Wed. Aug. 9, 2006 + - module created by Stevan Little and Eric Willhelm, + with input form Matt Trout and the #moose crew. \ No newline at end of file diff --git a/MANIFEST b/MANIFEST index 8066cf6..4e798f5 100644 --- a/MANIFEST +++ b/MANIFEST @@ -6,7 +6,15 @@ MANIFEST MANIFEST.SKIP README lib/Moose/Policy.pm +lib/Moose/Policy/FollowPBP.pm +lib/Moose/Policy/JavaAccessors.pm +lib/Moose/Policy/SingleInheritence.pm t/000_load.t t/001_basic.t t/002_dynamic.t t/003_saidso.t +t/010_FollowPBP_test.t +t/011_JavaAccessors_test.t +t/020_SingleInheritence_test.t +t/pod.t +t/pod_coverage.t diff --git a/README b/README index 3b40f52..624f33b 100644 --- a/README +++ b/README @@ -16,6 +16,8 @@ DEPENDENCIES This module requires these other modules and libraries: + Carp + Scalar::Util Moose COPYRIGHT AND LICENCE diff --git a/lib/Moose/Policy.pm b/lib/Moose/Policy.pm index b609acc..8acc16a 100644 --- a/lib/Moose/Policy.pm +++ b/lib/Moose/Policy.pm @@ -21,7 +21,7 @@ sub import { my $package = caller(); $package->can('meta') and - croak("'$package' already has a meta() method"); + croak("'$package' already has a meta() method, this is very problematic"); my $metaclass = 'Moose::Meta::Class'; $metaclass = $policy->metaclass($package) @@ -61,73 +61,106 @@ Moose::Policy - moose-mounted police 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'); + # Foo now has (get, set)_bar methods as well as get_baz + =head1 DESCRIPTION -This class allows you to specify your project-wide or company-wide Moose -meta policy in one location. +This module allows you to specify your project-wide or even company-wide +Moose meta-policy. -=head1 CAVEAT +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. -=over 4 +This is the first release of this module and should 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. + +=head2 What is a meta-policy? + +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. + +For instance, L enforces that all +specified Moose classes can only use single inheritence. It does this +by trapping the call to C on the metaclass and only allowing +you to assign a single superclass. + +The L policy changes the default behavior of +accessors to fit the recomendations found in Perl Best Practices. + +=head1 CAVEATS -=item YOU MUST +=head2 Always load Moose::Policy first. + +You B put the following line of code: use Moose::Policy 'My::Policy'; -=item BEFORE +before this line: use Moose; -=back +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 method available, +not only will kittens die, but your program will too. + +=head2 Policys are class scoped + +You must repeat the policy for each class you want to us it. It is B +inherited. This may change in the future, probably it will be a Moose::Policy +itself to allow Moose policys to be inherited. -=head2 The Policy +=head1 THE POLICY -The argument to C is a package name. This package is -require()'d and queried for the following constants: +A Policy is set by passing C a package name. This +package is then queried for what metaclasses it should use. The possible +metaclass values are: =over -=item metaclass +=item B -Defaults to C<'Moose::Meta::Class'>. +This defaults to C. -=item attribute_metaclass +=item B -=item instance_metaclass +=item B -=item method_metaclass +=item B =back -These values are then used to setup your $package->meta object. +For examples of what a Policy actually looks like see the examples in +C and the test suite. More docs to come on this later (probably +a cookbook or something). -Your policy package could be simply a list of constants. +=head1 FUTURE PLANS - package My::Policy; - use constant attribute_metaclass => 'My::Moose::Meta::Attribute'; +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. -But the methods are told what package is using the policy, so they could -concievably give different answers. - - package My::FancyPolicy; +=over 4 - sub attribute_metaclass { - my $self = shift; - my ($user_package) = @_; - return('Our::Attributes::Stricter') - if $user_package =~ m/^Private::Banking::Money/; - return('Our::Attributes'); - } +=item Make set of policy roles -=head1 SEE ALSO +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. -L, L +=back =head1 BUGS diff --git a/lib/Moose/Policy/FollowPBP.pm b/lib/Moose/Policy/FollowPBP.pm index 0ba906b..8fc7e3f 100644 --- a/lib/Moose/Policy/FollowPBP.pm +++ b/lib/Moose/Policy/FollowPBP.pm @@ -33,4 +33,45 @@ __END__ =pod +=head1 NAME + +Moose::Policy::FollowPBP - Follow the recomendations in Perl Best Practices + +=head1 SYNOPSIS + + package Foo; + + use Moose::Policy 'Moose::Policy::FollowPBP'; + use Moose; + + has 'bar' => (is => 'rw', default => 'Foo::bar'); + has 'baz' => (is => 'ro', default => 'Foo::baz'); + + # Foo now has (get, set)_bar methods as well as get_baz + +=head1 DESCRIPTION + +This meta-policy changes the behavior of Moose's default behavior in +regard to accessors to follow the recomdnations found in Damian +Conway's book Perl Best Practices. + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut diff --git a/lib/Moose/Policy/JavaAccessors.pm b/lib/Moose/Policy/JavaAccessors.pm index fea56dd..0bb5e49 100644 --- a/lib/Moose/Policy/JavaAccessors.pm +++ b/lib/Moose/Policy/JavaAccessors.pm @@ -33,4 +33,51 @@ __END__ =pod +=head1 NAME + +Moose::Policy::JavaAccessors - BeCause EveryOne Loves CamelCase + +=head1 SYNOPSIS + + package Foo; + + use Moose::Policy 'Moose::Policy::JavaAccessors'; + use Moose; + + has 'bar' => (is => 'rw', default => 'Foo::bar'); + has 'baz' => (is => 'ro', default => 'Foo::baz'); + + # Foo now has (get, set)Bar methods as well as getBaz + +=head1 DESCRIPTION + +This meta-policy changes the behavior of Moose's default behavior in +regard to accessors to follow Java convention and use CamelCase. + +=head1 CAVEAT + +This does a very niave conversion to CamelCase, basically it just +runs C on the attribute name. Since I don't use CamelCase +(at least not anymore), this is good enough. If you really want to +use this, and need a more sophisicated conversion, patches welcome :) + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut diff --git a/lib/Moose/Policy/SingleInheritence.pm b/lib/Moose/Policy/SingleInheritence.pm index 27c4d37..4addcf6 100644 --- a/lib/Moose/Policy/SingleInheritence.pm +++ b/lib/Moose/Policy/SingleInheritence.pm @@ -21,4 +21,55 @@ __END__ =pod +=head1 NAME + +Moose::Policy::SingleInheritence - Why would you ever need more than one? + +=head1 SYNOPSIS + + package Foo; + + use Moose::Policy 'Moose::Policy::SingleInheritence'; + use Moose; + + package Bar; + + use Moose::Policy 'Moose::Policy::SingleInheritence'; + use Moose; + + package Foo::Bar; + + use Moose::Policy 'Moose::Policy::SingleInheritence'; + use Moose; + + extends 'Foo', 'Bar'; # BOOM!!!! + +=head1 DESCRIPTION + +This module restricts Moose's C keyword so that you can only assign +a single superclass. + +This is mostly an example of how you can restrict behavior with meta-policies +in addition to extending and/or customising them. However, sometimes enforcing +a policy like this can be a good thing. + +=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 Estevan@iinteractive.comE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006 by Infinity Interactive, Inc. + +L + +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 0b50253..8554a7d 100644 --- a/t/001_basic.t +++ b/t/001_basic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 11; BEGIN { use_ok('Moose::Policy'); diff --git a/t/002_dynamic.t b/t/002_dynamic.t index 1005d7a..6b1fa2a 100644 --- a/t/002_dynamic.t +++ b/t/002_dynamic.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 12; BEGIN { use_ok('Moose::Policy'); diff --git a/t/003_saidso.t b/t/003_saidso.t index e1ee7d5..b3d5d18 100644 --- a/t/003_saidso.t +++ b/t/003_saidso.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 22; BEGIN { use_ok('Moose::Policy'); diff --git a/t/010_FollowPBP_test.t b/t/010_FollowPBP_test.t index 0416ead..d010167 100644 --- a/t/010_FollowPBP_test.t +++ b/t/010_FollowPBP_test.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 28; BEGIN { use_ok('Moose::Policy'); @@ -36,3 +36,51 @@ ok(! $foo->can('set_baz'), 'without setter'); is($foo->get_bar, 'Foo::bar', '... got the right default value'); is($foo->get_baz, 'Foo::baz', '... got the right default value'); +{ + package Bar; + use Moose::Policy 'Moose::Policy::FollowPBP'; + use Moose; + + extends 'Foo'; + + has 'boing' => (is => 'rw', default => 'Bar::boing'); +} + +isa_ok(Bar->meta, 'Moose::Meta::Class'); +is(Bar->meta->attribute_metaclass, 'Moose::Policy::FollowPBP::Attribute', '... got our custom attr metaclass'); + +isa_ok(Bar->meta->get_attribute('boing'), 'Moose::Policy::FollowPBP::Attribute'); + +my $bar = Bar->new; +isa_ok($bar, 'Bar'); +isa_ok($bar, 'Foo'); + +can_ok($bar, 'get_boing'); +can_ok($bar, 'set_boing'); + +is($bar->get_boing, 'Bar::boing', '... got the right default value'); +$bar->set_boing('Woot!'); +is($bar->get_boing, 'Woot!', '... got the right changed value'); + +{ + package Baz; + use Moose; + + extends 'Bar'; + + has 'bling' => (is => 'ro', default => 'Baz::bling'); +} + +isa_ok(Baz->meta, 'Moose::Meta::Class'); +is(Baz->meta->attribute_metaclass, 'Moose::Meta::Attribute', '... got our custom attr metaclass'); + +isa_ok(Baz->meta->get_attribute('bling'), 'Moose::Meta::Attribute'); + +my $baz = Baz->new; +isa_ok($baz, 'Baz'); +isa_ok($baz, 'Bar'); +isa_ok($baz, 'Foo'); + +can_ok($baz, 'bling'); + +is($baz->bling, 'Baz::bling', '... got the right default value'); diff --git a/t/011_JavaAccessors_test.t b/t/011_JavaAccessors_test.t index 93540c9..9f78cc0 100644 --- a/t/011_JavaAccessors_test.t +++ b/t/011_JavaAccessors_test.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 11; BEGIN { use_ok('Moose::Policy'); diff --git a/t/020_SingleInheritence_test.t b/t/020_SingleInheritence_test.t index a9d208a..ba69bd9 100644 --- a/t/020_SingleInheritence_test.t +++ b/t/020_SingleInheritence_test.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More 'no_plan'; +use Test::More tests => 2; use Test::Exception; BEGIN {