[Moose-commits] r7107 - in MooseX-FollowPBP/trunk: lib/MooseX
lib/MooseX/FollowPBP lib/MooseX/FollowPBP/Role t
autarch at code2.0beta.co.uk
autarch at code2.0beta.co.uk
Tue Dec 16 20:25:55 GMT 2008
Author: autarch
Date: 2008-12-16 12:25:54 -0800 (Tue, 16 Dec 2008)
New Revision: 7107
Added:
MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/
MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/
MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/Attribute.pm
MooseX-FollowPBP/trunk/t/basic.t
Modified:
MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP.pm
Log:
it works
Added: MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/Attribute.pm
===================================================================
--- MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/Attribute.pm (rev 0)
+++ MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/Attribute.pm 2008-12-16 20:25:54 UTC (rev 7107)
@@ -0,0 +1,77 @@
+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 NAME
+
+MooseX::FollowPBP::Role::Attribute - Names accessors in the I<Perl Best Practices> style
+
+=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<Perl Best Practices>.
+
+=head1 AUTHOR
+
+Dave Rolsky, C<< <autarch at urth.org> >>
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2008 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
+
Property changes on: MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP/Role/Attribute.pm
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Rev
Name: svn:eol-style
+ native
Modified: MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP.pm
===================================================================
--- MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP.pm 2008-12-16 20:23:26 UTC (rev 7106)
+++ MooseX-FollowPBP/trunk/lib/MooseX/FollowPBP.pm 2008-12-16 20:25:54 UTC (rev 7107)
@@ -3,9 +3,32 @@
use strict;
use warnings;
-our $VERSION = '0.01';
+our $VERSION = '0.03';
+use Moose 0.5504 ();
+use Moose::Exporter;
+use Moose::Util::MetaRole;
+use MooseX::FollowPBP::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::FollowPBP::Role::Attribute'],
+ );
+}
+
1;
__END__
@@ -14,34 +37,40 @@
=head1 NAME
-MooseX::FollowPBP - The fantastic new MooseX::FollowPBP!
+MooseX::FollowPBP - Name your accessors get_foo() and set_foo()
=head1 SYNOPSIS
-XXX - change this!
-
use MooseX::FollowPBP;
+ use Moose;
- my $foo = MooseX::FollowPBP->new();
+ # make some attributes
- ...
-
=head1 DESCRIPTION
-=head1 METHODS
+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<Perl Best Practices>.
-This class provides the following methods
+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 AUTHOR
Dave Rolsky, C<< <autarch at urth.org> >>
=head1 BUGS
-Please report any bugs or feature requests to C<bug-moosex-followpbp at rt.cpan.org>,
-or through the web interface at L<http://rt.cpan.org>. I will be
-notified, and then you'll automatically be notified of progress on
-your bug as I make changes.
+Please report any bugs or feature requests to
+C<bug-moosex-followpbp at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org>. I will be notified, and then you'll
+automatically be notified of progress on your bug as I make changes.
=head1 COPYRIGHT & LICENSE
Added: MooseX-FollowPBP/trunk/t/basic.t
===================================================================
--- MooseX-FollowPBP/trunk/t/basic.t (rev 0)
+++ MooseX-FollowPBP/trunk/t/basic.t 2008-12-16 20:25:54 UTC (rev 7107)
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+
+use Test::More tests => 18;
+
+
+{
+ package Standard;
+
+ use Moose;
+
+ has 'thing' => ( is => 'rw' );
+ has '_private' => ( is => 'rw' );
+}
+
+{
+ package PBP;
+
+ use MooseX::FollowPBP;
+ use Moose;
+
+ has 'thing' => ( is => 'rw' );
+ has '_private' => ( is => 'rw' );
+}
+
+{
+ package PBP2;
+
+ # Make sure load order doesn't matter
+ 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( PBP2->can('get_thing'), 'PBP2->get_thing() exists' );
+ok( PBP2->can('set_thing'), 'PBP2->set_thing() exists' );
+ok( PBP2->can('_get_private'), 'PBP2->_get_private() exists' );
+ok( PBP2->can('_set_private'), 'PBP2->_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' );
+
Property changes on: MooseX-FollowPBP/trunk/t/basic.t
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Rev
Name: svn:eol-style
+ native
More information about the Moose-commits
mailing list