lib/MooseX/AttributeHelpers/MethodProvider/String.pm

   1 package MooseX::AttributeHelpers::MethodProvider::String;
   2 use MooseX::AttributeHelpers::MethodProvider;
   3
   4 our $VERSION   = '0.01';
   5 our $AUTHORITY = 'cpan:STEVAN';
   6
   7 add_method_provider String => (
   8     type => 'Str',
   9     provides => {
  10         append => sub {
  11             my ($attr, $reader, $writer) = @_;
  12             return sub { $writer->( $_[0],  $reader->($_[0]) . $_[1] ) };
  13         },
  14
  15         prepend => sub {
  16             my ($attr, $reader, $writer) = @_;
  17             return sub { $writer->( $_[0],  $_[1] . $reader->($_[0]) ) };
  18         },
  19
  20         replace => sub {
  21             my ($attr, $reader, $writer) = @_;
  22             return sub {
  23                 my ( $self, $regex, $replacement ) = @_;
  24                 my $v = $reader->($_[0]);
  25
  26                 if ( (ref($replacement)||'') eq 'CODE' ) {
  27                     $v =~ s/$regex/$replacement->()/e;
  28                 } else {
  29                     $v =~ s/$regex/$replacement/;
  30                 }
  31
  32                 $writer->( $_[0], $v);
  33             };
  34         },
  35
  36         match => sub {
  37             my ($attr, $reader, $writer) = @_;
  38             return sub { $reader->($_[0]) =~ $_[1] };
  39         },
  40
  41         chop => sub {
  42             my ($attr, $reader, $writer) = @_;
  43             return sub {
  44                 my $v = $reader->($_[0]);
  45                 CORE::chop($v);
  46                 $writer->( $_[0], $v);
  47             };
  48         },
  49
  50         chomp => sub {
  51             my ($attr, $reader, $writer) = @_;
  52             return sub {
  53                 my $v = $reader->($_[0]);
  54                 chomp($v);
  55                 $writer->( $_[0], $v);
  56             };
  57         },
  58
  59         inc => sub {
  60             my ($attr, $reader, $writer) = @_;
  61             return sub {
  62                 my $v = $reader->($_[0]);
  63                 $v++;
  64                 $writer->( $_[0], $v);
  65             };
  66         },
  67
  68         clear => sub {
  69             my ($attr, $reader, $writer ) = @_;
  70             return sub { $writer->( $_[0], '' ) }
  71         },
  72     },
  73 );
  74
  75 1;
  76
  77 __END__
  78
  79 =pod
  80
  81 =head1 NAME
  82
  83 MooseX::AttributeHelpers::MethodProvider::String
  84
  85 =head1 DESCRIPTION
  86
  87 This module provides the method factories for
  88 L<MooseX::AttributeHelpers::String>.
  89
  90 =head1 PROVIDED METHODS
  91
  92 It should be noted that all methods modify attribute values in place.
  93
  94 =over 4
  95
  96 =item I<inc>
  97
  98 Increments the value stored in this slot using the magical string autoincrement
  99 operator. Note that Perl doesn't provide analogeous behavior in C<-->, so
 100 C<dec> is not available.
 101
 102 =item I<append> C<$string>
 103
 104 Append a string, like C<.=>.
 105
 106 =item I<prepend> C<$string>
 107
 108 Prepend a string.
 109
 110 =item I<replace> C<$pattern> C<$replacement>
 111
 112 Performs a regexp substitution (L<perlop/s>). There is no way to provide the
 113 C<g> flag, but code references will be accepted for the replacement, causing
 114 the regex to be modified with a single C<e>. C</smxi> can be applied using the
 115 C<qr> operator.
 116
 117 =item I<match> C<$pattern>
 118
 119 Like I<replace> but without the replacement. Provided mostly for completeness.
 120
 121 =item C<chop>
 122
 123 L<perlfunc/chop>
 124
 125 =item C<chomp>
 126
 127 L<perlfunc/chomp>
 128
 129 =item C<clear>
 130
 131 Sets the string to the empty string (not the value passed to C<default>).
 132
 133 =back
 134
 135 =head1 BUGS
 136
 137 All complex software has bugs lurking in it, and this module is no
 138 exception. If you find a bug please either email me, or add the bug
 139 to cpan-RT.
 140
 141 =head1 AUTHOR
 142
 143 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 144
 145 =head1 COPYRIGHT AND LICENSE
 146
 147 Copyright 2007-2008 by Infinity Interactive, Inc.
 148
 149 L<http://www.iinteractive.com>
 150
 151 This library is free software; you can redistribute it and/or modify
 152 it under the same terms as Perl itself.
 153
 154 =cut