From: Dave Rolsky Date: Wed, 14 Nov 2007 21:50:34 +0000 (+0000) Subject: initial code import X-Git-Tag: 0.01~4 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a338e27f75b5b7d618b44c9174b86e23ba3d5133;p=gitmo%2FMooseX-SemiAffordanceAccessor.git initial code import --- a338e27f75b5b7d618b44c9174b86e23ba3d5133 diff --git a/Build.PL b/Build.PL new file mode 100644 index 0000000..a126050 --- /dev/null +++ b/Build.PL @@ -0,0 +1,19 @@ +use strict; +use warnings; + +use Module::Build; + +my $builder = Module::Build->new + ( module_name => 'MooseX::Policy::SemiAffordanceAccessor', + license => 'perl', + requires => { 'Moose' => 0, + 'Moose::Policy' => '0.03', + }, + build_requires => { 'Test::More' => 0, + }, + create_makefile_pl => 'passthrough', + create_readme => 1, + sign => 1, + ); + +$builder->create_build_script(); diff --git a/Changes b/Changes new file mode 100644 index 0000000..cd710fd --- /dev/null +++ b/Changes @@ -0,0 +1,3 @@ +0.01 Date/time + +* First version, released on an unsuspecting world. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..623cdfd --- /dev/null +++ b/MANIFEST @@ -0,0 +1,10 @@ +Build.PL +Changes +MANIFEST +MANIFEST.SKIP +META.yml # Will be created by "make dist" +README # Will be created by "make dist" +lib/MooseX/Policy/SemiAffordanceAccessor.pm +t/perlcritic.t +t/pod-coverage.t +t/pod.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP new file mode 100644 index 0000000..a834675 --- /dev/null +++ b/MANIFEST.SKIP @@ -0,0 +1,27 @@ +# Avoid version control files. +\bRCS\b +\bCVS\b +,v$ +\B\.svn\b + +# Avoid Makemaker generated and utility files. +\bMakefile$ +\bblib +\bMakeMaker-\d +\bpm_to_blib$ +\bblibdirs$ +^MANIFEST\.SKIP$ + +# Avoid Module::Build generated and utility files. +\bBuild$ +\b_build + +# Avoid temp and backup files. +~$ +\.old$ +\.bak$ +\#$ +\b\.# + +# Avoid tarballs +\.(?:tar|tgz|tar\.gz)$ diff --git a/lib/MooseX/Policy/SemiAffordanceAccessor.pm b/lib/MooseX/Policy/SemiAffordanceAccessor.pm new file mode 100644 index 0000000..32fb2a7 --- /dev/null +++ b/lib/MooseX/Policy/SemiAffordanceAccessor.pm @@ -0,0 +1,98 @@ +package MooseX::Policy::SemiAffordanceAccessor; + +use strict; +use warnings; + +our $VERSION = '0.01'; +our $AUTHORITY = 'cpan:DROLSKY'; + +use constant attribute_metaclass => 'MooseX::Policy::SemiAffordanceAccessor::Attribute'; + + +package MooseX::Policy::SemiAffordanceAccessor::Attribute; + +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_". + +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/t/basic.t b/t/basic.t new file mode 100644 index 0000000..8d42041 --- /dev/null +++ b/t/basic.t @@ -0,0 +1,35 @@ +use strict; +use warnings; + +use Test::More tests => 8; + + +{ + package Standard; + + use Moose; + + has 'thing' => ( is => 'rw' ); + has '_private' => ( is => 'rw' ); +} + +{ + package SF; + + use Moose::Policy 'MooseX::Policy::SemiAffordanceAccessor'; + use Moose; + + 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' ); diff --git a/t/perlcritic.t b/t/perlcritic.t new file mode 100644 index 0000000..491250c --- /dev/null +++ b/t/perlcritic.t @@ -0,0 +1,13 @@ +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 'use Test::Perl::Critic ( -severity => 4 )'; +plan skip_all => 'Test::Perl::Critic required for testing POD' if $@; + +all_critic_ok(); diff --git a/t/pod-coverage.t b/t/pod-coverage.t new file mode 100644 index 0000000..aa1f35b --- /dev/null +++ b/t/pod-coverage.t @@ -0,0 +1,14 @@ +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 "use Test::Pod::Coverage 1.04"; +plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" + if $@; + +all_pod_coverage_ok(); diff --git a/t/pod.t b/t/pod.t new file mode 100644 index 0000000..3f86494 --- /dev/null +++ b/t/pod.t @@ -0,0 +1,13 @@ +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 "use Test::Pod 1.14"; +plan skip_all => "Test::Pod 1.14 required for testing POD" if $@; + +all_pod_files_ok();