File Coverage

blib/lib/MooX/Value.pm

Criterion	Covered	Total	%
statement	29	30	96.6
branch	4	6	66.6
condition			n/a
subroutine	10	10	100.0
pod	2	2	100.0
total	45	48	93.7

package MooX::Value;

use warnings;
use strict;

use Moo;
use namespace::clean;

our $VERSION = '0.04';

has value => ( is => 'ro' );

sub BUILDARGS
{
    my ($class, $value) = @_;
    return { 'value' => $value };
}

sub BUILD
{
    my ($self) = @_;
    my ($why, $long, $data) = $self->_why_invalid( $self->{value} );
    $self->_throw_exception( $why, $long, $data ) if defined $why;
    $self->{value} = $self->_untaint( $self->value );
    return $self;
}

# A subclass must override this method or _is_invalid to be able to create value objects.
sub _why_invalid
{
    my ($self, $value) = @_;
    return ( ref($self) . ": Invalid parameter when creating value object.", "", undef )
        unless $self->_is_valid( $value );
    return;
}

# A subclass must override this method or _why_invalid to be able to create value objects.
sub _is_valid
{
    my ($self, $value) = @_;
    return;
}

# Default exception support just uses die to throw an exception.
sub _throw_exception
{
    my ($self, $why, $longmsg, $data) = @_;
    die $why;
}

# Brute force untaint.
sub _untaint
{
    my ($self, $value) = @_;

    # Can only untaint scalars
    return $value if ref $value;

    # This is usually a very bad idea. It should be safe here because the class
    # has, by definition, validated the input before we get to this function.
    # If there is a problem, the validation code should be corrected.
    $value =~ m/\A(.*)\z/;
    return $1;
}

1;
__END__