lib/MooseX/Policy/SemiAffordanceAccessor.pm

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