lib/Moose/Meta/Attribute/Native/MethodProvider/String.pm

   1 package Moose::Meta::Attribute::Native::MethodProvider::String;
   2 use Moose::Role;
   3
   4 our $VERSION   = '0.95';
   5 $VERSION = eval $VERSION;
   6 our $AUTHORITY = 'cpan:STEVAN';
   7
   8 sub append : method {
   9     my ( $attr, $reader, $writer ) = @_;
  10
  11     return sub { $writer->( $_[0], $reader->( $_[0] ) . $_[1] ) };
  12 }
  13
  14 sub prepend : method {
  15     my ( $attr, $reader, $writer ) = @_;
  16
  17     return sub { $writer->( $_[0], $_[1] . $reader->( $_[0] ) ) };
  18 }
  19
  20 sub replace : method {
  21     my ( $attr, $reader, $writer ) = @_;
  22
  23     return sub {
  24         my ( $self, $regex, $replacement ) = @_;
  25         my $v = $reader->( $_[0] );
  26
  27         if ( ( ref($replacement) || '' ) eq 'CODE' ) {
  28             $v =~ s/$regex/$replacement->()/e;
  29         }
  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 Moose::Meta::Attribute::Native::MethodProvider::String
 115
 116 =head1 DESCRIPTION
 117
 118 This is a role which provides the method generators for
 119 L<Moose::Meta::Attribute::Native::Trait::String>. Please check there for
 120 documentation on what methods are provided.
 121
 122 =head1 METHODS
 123
 124 =over 4
 125
 126 =item B<meta>
 127
 128 =back
 129
 130 =head1 BUGS
 131
 132 See L<Moose/BUGS> for details on reporting bugs.
 133
 134 =head1 AUTHOR
 135
 136 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 137
 138 =head1 COPYRIGHT AND LICENSE
 139
 140 Copyright 2007-2009 by Infinity Interactive, Inc.
 141
 142 L<http://www.iinteractive.com>
 143
 144 This library is free software; you can redistribute it and/or modify
 145 it under the same terms as Perl itself.
 146
 147 =cut