File Coverage

blib/lib/Tie/CheckVariables.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	24	24	100.0
condition	6	6	100.0
subroutine	13	13	100.0
pod	2	2	100.0
total	97	97	100.0

package Tie::CheckVariables;

# ABSTRACT: check/validate variables for their datatype

use strict;
use warnings;

use Carp;
use Scalar::Util qw(blessed);

our $VERSION = 0.05;

my %hash = (
    integer => qr{^[-+]?\d+$},
    float   => qr{^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$},
    string  => qr{.+},
);

my $error_code = sub { die "Invalid value $_[0]" };

sub TIESCALAR{
    my ($class, $type) = @_;

    my $self = {};
    bless $self, $class;

    $self->_type(
        blessed $type && $type->isa('Type::Tiny') ?
            $type->compiled_check :
            $type
    );

    return $self;
}

sub FETCH {
    my $self = shift;
    return $self->{VALUE};
}

sub STORE {
    my ($self,$value) = @_;

    my $check = $self->_check();

    my $success;
    my $is_code = 'CODE' eq ref $check;

    if ( !defined $check ) {
        $self->{VALUE} = $value;
        $success = 1;
    }
    elsif ( $is_code ) {
        eval {
            $success = $check->($value);
        };
    }
    elsif ( !ref $value && $value =~ $check ) {
        $success = 1;
    }

    if ( $success ) {
        $self->{VALUE} = $value;
    }
    else {
        $self->{VALUE} = undef;
        $error_code->( $value );
        #croak "no valid input";
    }
}

sub UNTIE {}

sub _check {
    my ($self) = @_;

    return $self->{CHECK} if $self->{CHECK};

    my $type    = $self->_type;
    my $is_code = grep{ $_ eq ref $type }qw(CODE Type::Tiny);
    $self->{CHECK} = !$is_code ? _get_regex( $type ) : $type;

    return $self->{CHECK};
}

sub _type {
    my ($self,$type) = @_;

    $self->{TYPE} = $type if defined $type;
    return $self->{TYPE};
}

sub _get_regex {
    my ($type) = @_;

    return if !$type;
    return qr/.*/ if !exists $hash{$type};
    return $hash{$type};
}

sub register {
    my ($class,$type,$regex) = @_;

    return if $class ne 'Tie::CheckVariables';

    $hash{$type} = qr{$regex};
}

sub on_error {
    my ($class,$coderef) = @_;
    $error_code = $coderef if 'CODE' eq ref $coderef;
}


1;

__END__