MouseX::AttributeHelpers::String - MouseX::AttributeHelpers::String documentation

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

Index

Code Index:

NAME

Top

MouseX::AttributeHelpers::String

SYNOPSIS

Top

    package MyHomePage;
    use Mouse;
    use MouseX::AttributeHelpers;

    has 'text' => (
        metaclass => 'String',
        is        => 'rw',
        isa       => 'Str',
        default   => '',
        provides  => {
            append => 'add_text',
            clear  => 'clear_text',
        },
    );

    package main;
    my $page = MyHomePage->new;

    $page->add_text("foo"); # same as $page->text($page->text . "foo");
    $page->clear_text;      # same as $page->text('');

DESCRIPTION

Top

This module provides a simple string attribute, to which mutating string operations can be applied more easily.

PROVIDERS

Top

append

prepend

replace

match

chop

chomp

inc

clear

METHODS

Top

method_constructors

helper_type

helper_default

AUTHOR

Top

NAKAGAWA Masaki <masaki@cpan.org>

LICENSE

Top

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

SEE ALSO

Top

MouseX::AttributeHelpers, MouseX::AttributeHelpers::Base

MouseX-AttributeHelpers documentation Contained in the MouseX-AttributeHelpers distribution. 
package MouseX::AttributeHelpers::String;
use Mouse;

extends 'MouseX::AttributeHelpers::Base';

has '+method_constructors' => (
    default => sub {
        return +{
            append => sub {
                my (undef, $name) = @_;
                return sub { $_[0]->{$name} .= $_[1] };
            },
            prepend => sub {
                my (undef, $name) = @_;
                return sub { $_[0]->{$name} = $_[1] . $_[0]->{$name} };
            },
            replace => sub {
                my (undef, $name) = @_;
                return sub {
                    (ref $_[2] || '') eq 'CODE'
                        ? $_[0]->{$name} =~ s/$_[1]/$_[2]->()/e
                        : $_[0]->{$name} =~ s/$_[1]/$_[2]/;
                };
            },
            match => sub {
                my (undef, $name) = @_;
                return sub { $_[0]->{$name} =~ $_[1] };
            },
            chop => sub {
                my (undef, $name) = @_;
                return sub { chop $_[0]->{$name} };
            },
            chomp => sub {
                my (undef, $name) = @_;
                return sub { chomp $_[0]->{$name} };
            },
            inc => sub {
                my (undef, $name) = @_;
                return sub { $_[0]->{$name}++ };
            },
            clear => sub {
                my (undef, $name) = @_;
                return sub { $_[0]->{$name} = '' };
            },
        };
    },
);

sub helper_type    { 'Str' }
sub helper_default { '' }

no Mouse;
__PACKAGE__->meta->make_immutable(inline_constructor => 0);
__END__