MooseX::AttributeHelpers::MethodProvider::String - MooseX::AttributeHelpers::MethodProvider::String documentation

MooseX-AttributeHelpers documentation Contained in the MooseX-AttributeHelpers distribution.

Index

Code Index:

NAME

Top

MooseX::AttributeHelpers::MethodProvider::String

DESCRIPTION

Top

This is a role which provides the method generators for MooseX::AttributeHelpers::String.

METHODS

Top

meta

PROVIDED METHODS

Top

append
prepend
replace
match
chomp
chop
inc
clear
length
substr

BUGS

Top

All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT.

AUTHOR

Top

Stevan Little <stevan@iinteractive.com>

COPYRIGHT AND LICENSE

Top

Copyright 2007-2009 by Infinity Interactive, Inc.

http://www.iinteractive.com

This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

MooseX-AttributeHelpers documentation Contained in the MooseX-AttributeHelpers distribution. 
package MooseX::AttributeHelpers::MethodProvider::String;
use Moose::Role;

our $VERSION   = '0.23';
$VERSION = eval $VERSION;
our $AUTHORITY = 'cpan:STEVAN';

sub append : method {
    my ($attr, $reader, $writer) = @_;

    return sub { $writer->( $_[0],  $reader->($_[0]) . $_[1] ) };
}

sub prepend : method {
    my ($attr, $reader, $writer) = @_;

    return sub { $writer->( $_[0],  $_[1] . $reader->($_[0]) ) };
}

sub replace : method {
    my ($attr, $reader, $writer) = @_;

    return sub {
        my ( $self, $regex, $replacement ) = @_;
        my $v = $reader->($_[0]);

        if ( (ref($replacement)||'') eq 'CODE' ) {
            $v =~ s/$regex/$replacement->()/e;
        } else {
            $v =~ s/$regex/$replacement/;
        }

        $writer->( $_[0], $v);
    };
}

sub match : method {
    my ($attr, $reader, $writer) = @_;
    return sub { $reader->($_[0]) =~ $_[1] };
}

sub chop : method {
    my ($attr, $reader, $writer) = @_;
    return sub {
        my $v = $reader->($_[0]);
        CORE::chop($v);
        $writer->( $_[0], $v);
    };
}

sub chomp : method {
    my ($attr, $reader, $writer) = @_;
    return sub {
        my $v = $reader->($_[0]);
        chomp($v);
        $writer->( $_[0], $v);
    };
}

sub inc : method {
    my ($attr, $reader, $writer) = @_;
    return sub {
        my $v = $reader->($_[0]);
        $v++;
        $writer->( $_[0], $v);
    };
}

sub clear : method {
    my ($attr, $reader, $writer) = @_;
    return sub { $writer->( $_[0], '' ) }
}

sub length : method {
    my ($attr, $reader, $writer) = @_;
    return sub {
        my $v = $reader->($_[0]);
        return CORE::length($v);
    };
}

sub substr : method {
    my ($attr, $reader, $writer) = @_;
    return sub {
        my $self = shift;
        my $v = $reader->($self);

        my $offset      = defined $_[0] ? shift : 0;
        my $length      = defined $_[0] ? shift : CORE::length($v);
        my $replacement = defined $_[0] ? shift : undef;

        my $ret;
        if (defined $replacement) {
            $ret = CORE::substr($v, $offset, $length, $replacement);
            $writer->($self, $v);
        }
        else {
            $ret = CORE::substr($v, $offset, $length);
        }

        return $ret;
    };
}

1;

__END__