lib/MooseX/AttributeHelpers/MethodProvider/String.pm

   1
   2 package MooseX::AttributeHelpers::MethodProvider::String;
   3 use Moose::Role;
   4
   5 our $VERSION   = '0.21';
   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 substr : method {
  76     my ($attr, $reader, $writer) = @_;
  77     return sub {
  78         my $self = shift;
  79         my $v = $reader->($self);
  80
  81         my $offset      = defined $_[0] ? shift : 0;
  82         my $length      = defined $_[0] ? shift : CORE::length($v);
  83         my $replacement = defined $_[0] ? shift : undef;
  84
  85         my $ret;
  86         if (defined $replacement) {
  87             $ret = CORE::substr($v, $offset, $length, $replacement);
  88             $writer->($self, $v);
  89         }
  90         else {
  91             $ret = CORE::substr($v, $offset, $length);
  92         }
  93
  94         return $ret;
  95     };
  96 }
  97
  98 1;
  99
 100 __END__
 101
 102 =pod
 103
 104 =head1 NAME
 105
 106 MooseX::AttributeHelpers::MethodProvider::String
 107
 108 =head1 DESCRIPTION
 109
 110 This is a role which provides the method generators for
 111 L<MooseX::AttributeHelpers::String>.
 112
 113 =head1 METHODS
 114
 115 =over 4
 116
 117 =item B<meta>
 118
 119 =back
 120
 121 =head1 PROVIDED METHODS
 122
 123 =over 4
 124
 125 =item B<append>
 126
 127 =item B<prepend>
 128
 129 =item B<replace>
 130
 131 =item B<match>
 132
 133 =item B<chomp>
 134
 135 =item B<chop>
 136
 137 =item B<inc>
 138
 139 =item B<clear>
 140
 141 =item B<substr>
 142
 143 =back
 144
 145 =head1 BUGS
 146
 147 All complex software has bugs lurking in it, and this module is no
 148 exception. If you find a bug please either email me, or add the bug
 149 to cpan-RT.
 150
 151 =head1 AUTHOR
 152
 153 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 154
 155 =head1 COPYRIGHT AND LICENSE
 156
 157 Copyright 2007-2009 by Infinity Interactive, Inc.
 158
 159 L<http://www.iinteractive.com>
 160
 161 This library is free software; you can redistribute it and/or modify
 162 it under the same terms as Perl itself.
 163
 164 =cut