lib/MooseX/Policy/SemiAffordanceAccessor.pm

   1 package MooseX::Policy::SemiAffordanceAccessor;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '0.02';
   7 our $AUTHORITY = 'cpan:DROLSKY';
   8
   9 use constant attribute_metaclass =>                        ## no critic ProhibitConstantPragma
  10     'MooseX::Policy::SemiAffordanceAccessor::Attribute';
  11
  12
  13 package MooseX::Policy::SemiAffordanceAccessor::Attribute; ## no critic ProhibitMultiplePackages
  14
  15
  16 use Moose;
  17
  18 extends 'Moose::Meta::Attribute';
  19
  20 before '_process_options' => sub
  21 {
  22     my $class   = shift;
  23     my $name    = shift;
  24     my $options = shift;
  25
  26     if ( exists $options->{is} &&
  27          ! ( exists $options->{reader} || exists $options->{writer} ) )
  28     {
  29         if ( $options->{is} eq 'ro' )
  30         {
  31             $options->{reader} = $name;
  32         }
  33         elsif ( $options->{is} eq 'rw' )
  34         {
  35             $options->{reader} = $name;
  36
  37             my $prefix = 'set';
  38             if ( $name =~ s/^_// )
  39             {
  40                 $prefix = '_set';
  41             }
  42
  43             $options->{writer} = $prefix . q{_} . $name;
  44         }
  45
  46         delete $options->{is};
  47     }
  48 };
  49
  50
  51 1;
  52
  53 __END__
  54
  55 =pod
  56
  57 =head1 NAME
  58
  59 MooseX::Policy::SemiAffordanceAccessor - A policy to name accessors foo() and set_foo()
  60
  61 =head1 SYNOPSIS
  62
  63     use Moose::Policy 'MooseX::Policy::SemiAffordanceAccessor';
  64     use Moose;
  65
  66     # make some attributes
  67
  68 =head1 DESCRIPTION
  69
  70 This class does not provide any methods. Just loading it changes the
  71 default naming policy for the package so that accessors are separated
  72 into get and set methods. The get methods have the same name as the
  73 accessor, while set methods are prefixed with "set_".
  74
  75 If you define an attribute with a leading underscore, then the set
  76 method will start with "_set_".
  77
  78 If you explicitly set a "reader" or "writer" name when creating an
  79 attribute, then this policy skips that attribute.
  80
  81 The name "semi-affordance" comes from David Wheeler's Class::Meta
  82 module.
  83
  84 =head1 AUTHOR
  85
  86 Dave Rolsky, C<< <autarch@urth.org> >>
  87
  88 =head1 BUGS
  89
  90 Please report any bugs or feature requests to
  91 C<bug-moosex-policy-semiaffordanceaccessor@rt.cpan.org>, or through
  92 the web interface at L<http://rt.cpan.org>.  I will be notified, and
  93 then you'll automatically be notified of progress on your bug as I
  94 make changes.
  95
  96 =head1 COPYRIGHT & LICENSE
  97
  98 Copyright 2007 Dave Rolsky, All Rights Reserved.
  99
 100 This program is free software; you can redistribute it and/or modify
 101 it under the same terms as Perl itself.
 102
 103 =cut