From: Dave Rolsky Date: Wed, 27 Aug 2008 16:10:17 +0000 (+0000) Subject: Renamed to MooseX::SemiAffordanceAccessor, because we no longer need X-Git-Tag: 0.03~7 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b95d9f9b2b5049c0ddcb70a65712a97fb3b56c66;p=gitmo%2FMooseX-SemiAffordanceAccessor.git Renamed to MooseX::SemiAffordanceAccessor, because we no longer need Moose::Policy, just Moose::Util::MetaRole. --- diff --git a/Build.PL b/Build.PL index 6b6d2d3..7212dce 100644 --- a/Build.PL +++ b/Build.PL @@ -6,10 +6,9 @@ require 5.00601; use Module::Build; my $builder = Module::Build->new - ( module_name => 'MooseX::Policy::SemiAffordanceAccessor', + ( module_name => 'MooseX::SemiAffordanceAccessor', license => 'perl', - requires => { 'Moose' => 0, - 'Moose::Policy' => 0, + requires => { 'Moose' => 0.55_01, }, build_requires => { 'Test::More' => 0, }, diff --git a/Changes b/Changes index 792fb07..bc61af9 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,9 @@ +0.03 + +- Renamed to MooseX::SemiAffordanceAccessor because it no longer + requires the Moose::Policy module. + + 0.02 2007-11-15 - Require 5.6.1 in the Build.PL. diff --git a/MANIFEST b/MANIFEST deleted file mode 100644 index b605efd..0000000 --- a/MANIFEST +++ /dev/null @@ -1,11 +0,0 @@ -Build.PL -Changes -lib/MooseX/Policy/SemiAffordanceAccessor.pm -MANIFEST -META.yml # Will be created by "make dist" -README # Will be created by "make dist" -t/basic.t -t/perlcritic.t -t/pod-coverage.t -t/pod.t -Makefile.PL diff --git a/lib/MooseX/Policy/SemiAffordanceAccessor.pm b/lib/MooseX/Policy/SemiAffordanceAccessor.pm deleted file mode 100644 index 2ac988f..0000000 --- a/lib/MooseX/Policy/SemiAffordanceAccessor.pm +++ /dev/null @@ -1,103 +0,0 @@ -package MooseX::Policy::SemiAffordanceAccessor; - -use strict; -use warnings; - -our $VERSION = '0.02'; -our $AUTHORITY = 'cpan:DROLSKY'; - -use constant attribute_metaclass => ## no critic ProhibitConstantPragma - 'MooseX::Policy::SemiAffordanceAccessor::Attribute'; - - -package MooseX::Policy::SemiAffordanceAccessor::Attribute; ## no critic ProhibitMultiplePackages - - -use Moose; - -extends 'Moose::Meta::Attribute'; - -before '_process_options' => sub -{ - my $class = shift; - my $name = shift; - my $options = shift; - - if ( exists $options->{is} && - ! ( exists $options->{reader} || exists $options->{writer} ) ) - { - if ( $options->{is} eq 'ro' ) - { - $options->{reader} = $name; - } - elsif ( $options->{is} eq 'rw' ) - { - $options->{reader} = $name; - - my $prefix = 'set'; - if ( $name =~ s/^_// ) - { - $prefix = '_set'; - } - - $options->{writer} = $prefix . q{_} . $name; - } - - delete $options->{is}; - } -}; - - -1; - -__END__ - -=pod - -=head1 NAME - -MooseX::Policy::SemiAffordanceAccessor - A policy to name accessors foo() and set_foo() - -=head1 SYNOPSIS - - use Moose::Policy 'MooseX::Policy::SemiAffordanceAccessor'; - use Moose; - - # make some attributes - -=head1 DESCRIPTION - -This class does not provide any methods. Just loading it changes the -default naming policy for the package so that accessors are separated -into get and set methods. The get methods have the same name as the -accessor, while set methods are prefixed with "set_". - -If you define an attribute with a leading underscore, then the set -method will start with "_set_". - -If you explicitly set a "reader" or "writer" name when creating an -attribute, then this policy skips that attribute. - -The name "semi-affordance" comes from David Wheeler's Class::Meta -module. - -=head1 AUTHOR - -Dave Rolsky, C<< >> - -=head1 BUGS - -Please report any bugs or feature requests to -C, or through -the web interface at L. I will be notified, and -then you'll automatically be notified of progress on your bug as I -make changes. - -=head1 COPYRIGHT & LICENSE - -Copyright 2007 Dave Rolsky, All Rights Reserved. - -This program is free software; you can redistribute it and/or modify -it under the same terms as Perl itself. - -=cut diff --git a/lib/MooseX/SemiAffordanceAccessor.pm b/lib/MooseX/SemiAffordanceAccessor.pm new file mode 100644 index 0000000..d8c894f --- /dev/null +++ b/lib/MooseX/SemiAffordanceAccessor.pm @@ -0,0 +1,86 @@ +package MooseX::SemiAffordanceAccessor; + +use strict; +use warnings; + +our $VERSION = '0.03'; + +use Moose (); +use Moose::Exporter; +use Moose::Util::MetaRole; +use MooseX::SemiAffordanceAccessor::Role::Attribute; + +# The main reason to use this is to ensure that we get the right value +# in $p{for_class} later. +Moose::Exporter->setup_import_methods(); + + +sub init_meta +{ + shift; + my %p = @_; + + Moose->init_meta(%p); + + return + Moose::Util::MetaRole::apply_metaclass_roles + ( for_class => $p{for_class}, + attribute_metaclass_roles => + ['MooseX::SemiAffordanceAccessor::Role::Attribute'], + ); +} + + +1; + +__END__ + +=pod + +=head1 NAME + +MooseX::SemiAffordanceAccessor - Name your accessors foo() and set_foo() + +=head1 SYNOPSIS + + use MooseX::SemiAffordanceAccessor; + use Moose; + + # make some attributes + +=head1 DESCRIPTION + +This module does not provide any methods. Simply loading it changes +the default naming policy for the loading class so that accessors are +separated into get and set methods. The get methods have the same name +as the accessor, while set methods are prefixed with "set_". + +If you define an attribute with a leading underscore, then the set +method will start with "_set_". + +If you explicitly set a "reader" or "writer" name when creating an +attribute, then that attribute's naming scheme is left unchanged. + +The name "semi-affordance" comes from David Wheeler's Class::Meta +module. + +=head1 AUTHOR + +Dave Rolsky, C<< >> + +=head1 BUGS + +Please report any bugs or feature requests to +C, or through +the web interface at L. I will be notified, and +then you'll automatically be notified of progress on your bug as I +make changes. + +=head1 COPYRIGHT & LICENSE + +Copyright 2007 Dave Rolsky, All Rights Reserved. + +This program is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + +=cut diff --git a/lib/MooseX/SemiAffordanceAccessor/Role/Attribute.pm b/lib/MooseX/SemiAffordanceAccessor/Role/Attribute.pm new file mode 100644 index 0000000..34e1f7d --- /dev/null +++ b/lib/MooseX/SemiAffordanceAccessor/Role/Attribute.pm @@ -0,0 +1,41 @@ +package MooseX::SemiAffordanceAccessor::Role::Attribute; + +use strict; +use warnings; + +use Moose::Role; + + +before '_process_options' => sub +{ + my $class = shift; + my $name = shift; + my $options = shift; + + if ( exists $options->{is} && + ! ( exists $options->{reader} || exists $options->{writer} ) ) + { + if ( $options->{is} eq 'ro' ) + { + $options->{reader} = $name; + } + elsif ( $options->{is} eq 'rw' ) + { + $options->{reader} = $name; + + my $prefix = 'set'; + if ( $name =~ s/^_// ) + { + $prefix = '_set'; + } + + $options->{writer} = $prefix . q{_} . $name; + } + + delete $options->{is}; + } +}; + +no Moose::Role; + +1; diff --git a/t/basic.t b/t/basic.t index 8d42041..8aa8dcd 100644 --- a/t/basic.t +++ b/t/basic.t @@ -1,7 +1,7 @@ use strict; use warnings; -use Test::More tests => 8; +use Test::More tests => 12; { @@ -14,22 +14,38 @@ use Test::More tests => 8; } { - package SF; + package SAA; - use Moose::Policy 'MooseX::Policy::SemiAffordanceAccessor'; + use MooseX::SemiAffordanceAccessor; use Moose; has 'thing' => ( is => 'rw' ); has '_private' => ( is => 'rw' ); } +{ + package SAA2; + + # Make sure load order doesn't matter + use Moose; + use MooseX::SemiAffordanceAccessor; + + has 'thing' => ( is => 'rw' ); + has '_private' => ( is => 'rw' ); +} + ok( Standard->can('thing'), 'Standard->thing() exists' ); ok( ! Standard->can('set_thing'), 'Standard->set_thing() does not exist' ); ok( Standard->can('_private'), 'Standard->_private() exists' ); ok( ! Standard->can('_set_private'), 'Standard->_set_private() does not exist' ); -ok( SF->can('thing'), 'SF->thing() exists' ); -ok( SF->can('set_thing'), 'SF->set_thing() exists' ); -ok( SF->can('_private'), 'SF->_private() exists' ); -ok( SF->can('_set_private'), 'SF->_set_private() exists' ); +ok( SAA->can('thing'), 'SAA->thing() exists' ); +ok( SAA->can('set_thing'), 'SAA->set_thing() exists' ); +ok( SAA->can('_private'), 'SAA->_private() exists' ); +ok( SAA->can('_set_private'), 'SAA->_set_private() exists' ); + +ok( SAA2->can('thing'), 'SAA2->thing() exists' ); +ok( SAA2->can('set_thing'), 'SAA2->set_thing() exists' ); +ok( SAA2->can('_private'), 'SAA2->_private() exists' ); +ok( SAA2->can('_set_private'), 'SAA2->_set_private() exists' );