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


line stmt bran cond sub pod time code
1             package Tie::CheckVariables;
2              
3             # ABSTRACT: check/validate variables for their data type
4              
5 10     10   911510 use strict;
  10         66  
  10         320  
6 10     10   56 use warnings;
  10         21  
  10         267  
7              
8 10     10   54 use Carp;
  10         18  
  10         637  
9 10     10   65 use Scalar::Util qw(blessed);
  10         28  
  10         7197  
10              
11             our $VERSION = '0.07';
12            
13             my %hash = (
14             integer => qr{^[-+]?\d+$},
15             float => qr{^[+-]?(\d+\.\d+|\d+\.|\.\d+|\d+)([eE][+-]?\d+)?$},
16             string => qr{.+},
17             );
18              
19             my $error_code = sub { die "Invalid value $_[0]" };
20              
21             sub TIESCALAR{
22 11     11   4094 my ($class, $type) = @_;
23            
24 11         27 my $self = {};
25 11         28 bless $self, $class;
26              
27 11 100 100     102 $self->_type(
28             blessed $type && $type->isa('Type::Tiny') ?
29             $type->compiled_check :
30             $type
31             );
32            
33 11         36 return $self;
34             }
35              
36             sub FETCH {
37 5     5   98 my $self = shift;
38 5         21 return $self->{VALUE};
39             }
40              
41             sub STORE {
42 33     33   10248 my ($self,$value) = @_;
43            
44 33         86 my $check = $self->_check();
45              
46 33         109 my $success;
47 33         88 my $is_code = 'CODE' eq ref $check;
48              
49 33 100 100     277 if ( !defined $check ) {
    100          
    100          
50 5         9 $self->{VALUE} = $value;
51 5         8 $success = 1;
52             }
53             elsif ( $is_code ) {
54 7         13 eval {
55 7         19 $success = $check->($value);
56             };
57             }
58             elsif ( !ref $value && $value =~ $check ) {
59 11         26 $success = 1;
60             }
61              
62 33 100       109 if ( $success ) {
63 20         77 $self->{VALUE} = $value;
64             }
65             else {
66 13         59 $self->{VALUE} = undef;
67 13         35 $error_code->( $value );
68             #croak "no valid input";
69             }
70             }
71              
72       2     sub UNTIE {}
73              
74             sub _check {
75 33     33   64 my ($self) = @_;
76              
77 33 100       103 return $self->{CHECK} if $self->{CHECK};
78              
79 15         46 my $type = $self->_type;
80 15         35 my $is_code = grep{ $_ eq ref $type }qw(CODE Type::Tiny);
  30         91  
81 15 100       63 $self->{CHECK} = !$is_code ? _get_regex( $type ) : $type;
82              
83 15         57 return $self->{CHECK};
84             }
85              
86             sub _type {
87 26     26   126 my ($self,$type) = @_;
88              
89 26 100       91 $self->{TYPE} = $type if defined $type;
90 26         58 return $self->{TYPE};
91             }
92              
93             sub _get_regex {
94 12     12   26 my ($type) = @_;
95              
96 12 100       37 return if !$type;
97 7 100       37 return qr/.*/ if !exists $hash{$type};
98 5         27 return $hash{$type};
99             }
100              
101             sub register {
102 2     2 1 8 my ($class,$type,$regex) = @_;
103              
104 2 100       10 return if $class ne 'Tie::CheckVariables';
105              
106 1         7 $hash{$type} = qr{$regex};
107             }
108              
109             sub on_error {
110 8     8 1 1370 my ($class,$coderef) = @_;
111 8 100       76 $error_code = $coderef if 'CODE' eq ref $coderef;
112             }
113              
114              
115             1;
116              
117             __END__