lib/MooseX/SemiAffordanceAccessor/Role/Attribute.pm

   1 package MooseX::SemiAffordanceAccessor::Role::Attribute;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Moose::Role;
   7
   8
   9 before '_process_options' => sub
  10 {
  11     my $class   = shift;
  12     my $name    = shift;
  13     my $options = shift;
  14
  15     if ( exists $options->{is} &&
  16          ! ( exists $options->{reader} || exists $options->{writer} ) )
  17     {
  18         if ( $options->{is} eq 'ro' )
  19         {
  20             $options->{reader} = $name;
  21             delete $options->{is};
  22         }
  23         elsif ( $options->{is} eq 'rw' )
  24         {
  25             $options->{reader} = $name;
  26
  27             my $prefix = 'set';
  28             if ( $name =~ s/^_// )
  29             {
  30                 $prefix = '_set';
  31             }
  32
  33             $options->{writer} = $prefix . q{_} . $name;
  34             delete $options->{is};
  35         }
  36     }
  37 };
  38
  39 no Moose::Role;
  40
  41 1;
  42
  43 =head1 NAME
  44
  45 MooseX::SemiAffordanceAccessor::Role::Attribute - Names accessors in a semi-affordance style
  46
  47 =head1 SYNOPSIS
  48
  49   Moose::Util::MetaRole::apply_metaclass_roles
  50       ( for_class => $p{for_class},
  51         attribute_metaclass_roles =>
  52         ['MooseX::SemiAffordanceAccessor::Role::Attribute'],
  53       );
  54
  55 =head1 DESCRIPTION
  56
  57 This role applies a method modifier to the C<_process_options()>
  58 method, and tweaks the reader and writer parameters so that they
  59 follow the semi-affordance naming style.
  60
  61 =head1 AUTHOR
  62
  63 Dave Rolsky, C<< <autarch@urth.org> >>
  64
  65 =head1 COPYRIGHT & LICENSE
  66
  67 Copyright 2007-2008 Dave Rolsky, All Rights Reserved.
  68
  69 This program is free software; you can redistribute it and/or modify
  70 it under the same terms as Perl itself.
  71
  72 =cut
  73