From: Dave Rolsky Date: Wed, 14 Jul 2010 20:37:54 +0000 (-0500) Subject: initial git checkin X-Git-Tag: v0.03~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a623c11370371e7e44577fa0938c57371d0d4103;p=gitmo%2FMooseX-FollowPBP.git initial git checkin --- a623c11370371e7e44577fa0938c57371d0d4103 diff --git a/Changes b/Changes new file mode 100644 index 0000000..03d0ac4 --- /dev/null +++ b/Changes @@ -0,0 +1,9 @@ +0.02 2008-02-06 + +- Add a missing dependency on Moose so it gets tested. + + +0.01 2008-12-16 + +- This code was extracted from Moose::Policy, and works without + needing said module. diff --git a/dist.ini b/dist.ini new file mode 100644 index 0000000..721870f --- /dev/null +++ b/dist.ini @@ -0,0 +1,37 @@ +name = MooseX-FollowPBP +author = Dave Rolsky +copyright_year = 2010 + +version = 0.06 + +[@Basic] + +[InstallGuide] +[MetaJSON] + +[MetaResources] +bugtracker.web = http://rt.cpan.org/NoAuth/Bugs.html?Dist={{MooseX-FollowPBP}} +bugtracker.mailto = bug-moosex-semiaffordanceaccessor@rt.cpan.org +repository.url = git://git.moose.perl.org/MooseX-FollowPBP.git +repository.web = http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo/MooseX-FollowPBP.git;a=summary +repository.type = hg + +[PodWeaver] + +[PkgVersion] + +[KwaliteeTests] +[PodTests] +[NoTabsTests] +[EOLTests] +[Signature] + +[CheckChangeLog] + +[Prereqs] +Moose = 0.94 + +[Prereqs / TestRequires] +Test::More = 0.88 + +[@Git] diff --git a/lib/MooseX/FollowPBP.pm b/lib/MooseX/FollowPBP.pm new file mode 100644 index 0000000..e048ca7 --- /dev/null +++ b/lib/MooseX/FollowPBP.pm @@ -0,0 +1,54 @@ +package MooseX::FollowPBP; + +use strict; +use warnings; + +use Moose 0.94 (); +use Moose::Exporter; +use Moose::Util::MetaRole; +use MooseX::FollowPBP::Role::Attribute; + +Moose::Exporter->setup_import_methods( + class_metaroles => { + attribute => ['MooseX::FollowPBP::Role::Attribute'], + }, +); + +1; + +# ABSTRACT: Name your accessors get_foo() and set_foo() + +__END__ + +=pod + +=head1 SYNOPSIS + + use MooseX::FollowPBP; + 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 are prefixed with +"get_" as the accessor, while set methods are prefixed with +"set_". This is the naming style recommended by Damian Conway in +I. + +If you define an attribute with a leading underscore, then both the +get and set method will also have an underscore prefix. + +If you explicitly set a "reader" or "writer" name when creating an +attribute, then that attribute's naming scheme is left unchanged. + +=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. + +=cut diff --git a/lib/MooseX/FollowPBP/Role/Attribute.pm b/lib/MooseX/FollowPBP/Role/Attribute.pm new file mode 100644 index 0000000..31ec061 --- /dev/null +++ b/lib/MooseX/FollowPBP/Role/Attribute.pm @@ -0,0 +1,62 @@ +package MooseX::FollowPBP::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} ) ) + { + my $get; + my $set; + + if ( $name =~ s/^_// ) + { + $get = '_get_'; + $set = '_set_'; + } + else + { + $get = 'get_'; + $set = 'set_'; + } + + $options->{reader} = $get . $name; + + if ( $options->{is} eq 'rw' ) + { + $options->{writer} = $set . $name; + } + + delete $options->{is}; + } +}; + +no Moose::Role; + +1; + +=head1 SYNOPSIS + + Moose::Util::MetaRole::apply_metaclass_roles + ( for_class => $p{for_class}, + attribute_metaclass_roles => + ['MooseX::FollowPBP::Role::Attribute'], + ); + +=head1 DESCRIPTION + +This role applies a method modifier to the C<_process_options()> +method, and tweaks the reader and writer parameters so that they +follow the style recommended in I. + +=cut + diff --git a/t/basic.t b/t/basic.t new file mode 100644 index 0000000..9e0e5d5 --- /dev/null +++ b/t/basic.t @@ -0,0 +1,55 @@ +use strict; +use warnings; + +use Test::More; + + +{ + package Standard; + + use Moose; + + has 'thing' => ( is => 'rw' ); + has '_private' => ( is => 'rw' ); +} + +{ + package PBP; + + use Moose; + use MooseX::FollowPBP; + + has 'thing' => ( is => 'rw' ); + has '_private' => ( is => 'rw' ); +} + +{ + package PBP3; + + use Moose; + use MooseX::FollowPBP; + + has 'ro' => ( is => 'ro' ); + has 'thing' => ( is => 'rw', reader => 'thing' ); + has 'thing2' => ( is => 'rw', writer => 'set_it' ); +} + + +ok( ! Standard->can('get_thing'), 'Standard->get_thing() does not exist' ); +ok( ! Standard->can('set_thing'), 'Standard->set_thing() does not exist' ); +ok( ! Standard->can('_get_private'), 'Standard->_get_private() does not exist' ); +ok( ! Standard->can('_set_private'), 'Standard->_set_private() does not exist' ); + +ok( PBP->can('get_thing'), 'PBP->get_thing() exists' ); +ok( PBP->can('set_thing'), 'PBP->set_thing() exists' ); +ok( PBP->can('_get_private'), 'PBP->_get_private() exists' ); +ok( PBP->can('_set_private'), 'PBP->_set_private() exists' ); + +ok( PBP3->can('get_ro'), 'PBP3->get_ro exists' ); +ok( ! PBP3->can('set_ro'), 'PBP3->set_ro does not exist' ); +ok( ! PBP3->can('get_thing'), 'PBP3->get_thing does not exist' ); +ok( ! PBP3->can('set_thing'), 'PBP3->set_thing does not exist' ); +ok( ! PBP3->can('get_thing2'), 'PBP3->get_thing2 does not exist' ); +ok( ! PBP3->can('set_thing2'), 'PBP3->set_thing2 does not exist' ); + +done_testing(); diff --git a/t/kwalitee.t b/t/kwalitee.t new file mode 100644 index 0000000..4c275b7 --- /dev/null +++ b/t/kwalitee.t @@ -0,0 +1,12 @@ +use strict; +use warnings; + +use Test::More; + + +plan skip_all => 'This test is only run for the module author' + unless -d '.svn' || $ENV{IS_MAINTAINER}; + +eval { require Test::Kwalitee; Test::Kwalitee->import() }; +plan skip_all => "Test::Kwalitee needed for testing kwalitee" + if $@;