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