lib/MooseX/AttributeHelpers/MethodProvider/String.pm

   1
   2 package MooseX::AttributeHelpers::MethodProvider::String;
   3 use Moose::Role;
   4
   5 our $VERSION   = '0.22';
   6 $VERSION = eval $VERSION;
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 sub append : method {
  10     my ($attr, $reader, $writer) = @_;
  11
  12     return sub { $writer->( $_[0],  $reader->($_[0]) . $_[1] ) };
  13 }
  14
  15 sub prepend : method {
  16     my ($attr, $reader, $writer) = @_;
  17
  18     return sub { $writer->( $_[0],  $_[1] . $reader->($_[0]) ) };
  19 }
  20
  21 sub replace : method {
  22     my ($attr, $reader, $writer) = @_;
  23
  24     return sub {
  25         my ( $self, $regex, $replacement ) = @_;
  26         my $v = $reader->($_[0]);
  27
  28         if ( (ref($replacement)||'') eq 'CODE' ) {
  29             $v =~ s/$regex/$replacement->()/e;
  30         } else {
  31             $v =~ s/$regex/$replacement/;
  32         }
  33
  34         $writer->( $_[0], $v);
  35     };
  36 }
  37
  38 sub match : method {
  39     my ($attr, $reader, $writer) = @_;
  40     return sub { $reader->($_[0]) =~ $_[1] };
  41 }
  42
  43 sub chop : method {
  44     my ($attr, $reader, $writer) = @_;
  45     return sub {
  46         my $v = $reader->($_[0]);
  47         CORE::chop($v);
  48         $writer->( $_[0], $v);
  49     };
  50 }
  51
  52 sub chomp : method {
  53     my ($attr, $reader, $writer) = @_;
  54     return sub {
  55         my $v = $reader->($_[0]);
  56         chomp($v);
  57         $writer->( $_[0], $v);
  58     };
  59 }
  60
  61 sub inc : method {
  62     my ($attr, $reader, $writer) = @_;
  63     return sub {
  64         my $v = $reader->($_[0]);
  65         $v++;
  66         $writer->( $_[0], $v);
  67     };
  68 }
  69
  70 sub clear : method {
  71     my ($attr, $reader, $writer) = @_;
  72     return sub { $writer->( $_[0], '' ) }
  73 }
  74
  75 sub length : method {
  76     my ($attr, $reader, $writer) = @_;
  77     return sub {
  78         my $v = $reader->($_[0]);
  79         return CORE::length($v);
  80     };
  81 }
  82
  83 sub substr : method {
  84     my ($attr, $reader, $writer) = @_;
  85     return sub {
  86         my $self = shift;
  87         my $v = $reader->($self);
  88
  89         my $offset      = defined $_[0] ? shift : 0;
  90         my $length      = defined $_[0] ? shift : CORE::length($v);
  91         my $replacement = defined $_[0] ? shift : undef;
  92
  93         my $ret;
  94         if (defined $replacement) {
  95             $ret = CORE::substr($v, $offset, $length, $replacement);
  96             $writer->($self, $v);
  97         }
  98         else {
  99             $ret = CORE::substr($v, $offset, $length);
 100         }
 101
 102         return $ret;
 103     };
 104 }
 105
 106 1;
 107
 108 __END__
 109
 110 =pod
 111
 112 =head1 NAME
 113
 114 MooseX::AttributeHelpers::MethodProvider::String
 115
 116 =head1 DESCRIPTION
 117
 118 This is a role which provides the method generators for
 119 L<MooseX::AttributeHelpers::String>.
 120
 121 =head1 METHODS
 122
 123 =over 4
 124
 125 =item B<meta>
 126
 127 =back
 128
 129 =head1 PROVIDED METHODS
 130
 131 =over 4
 132
 133 =item B<append>
 134
 135 =item B<prepend>
 136
 137 =item B<replace>
 138
 139 =item B<match>
 140
 141 =item B<chomp>
 142
 143 =item B<chop>
 144
 145 =item B<inc>
 146
 147 =item B<clear>
 148
 149 =item B<length>
 150
 151 =item B<substr>
 152
 153 =back
 154
 155 =head1 BUGS
 156
 157 All complex software has bugs lurking in it, and this module is no
 158 exception. If you find a bug please either email me, or add the bug
 159 to cpan-RT.
 160
 161 =head1 AUTHOR
 162
 163 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 164
 165 =head1 COPYRIGHT AND LICENSE
 166
 167 Copyright 2007-2009 by Infinity Interactive, Inc.
 168
 169 L<http://www.iinteractive.com>
 170
 171 This library is free software; you can redistribute it and/or modify
 172 it under the same terms as Perl itself.
 173
 174 =cut