Tie::CheckVariables - check/validate variables for their datatype

  use Tie::CheckVariables

  tie my $scalar,'Tie::CheckVariables','integer';
  $scalar = 88; # is ok
  $scalar = 'test'; # is not ok, throws error

  untie $scalar;

  use Tie::CheckVariables;

  Tie::CheckVariables->on_error(sub{print "ERROR!"});

  tie my $scalar,'Tie::CheckVariables','integer';
  $scalar = 'a'; # ERROR! is printed
  untie $scalar;

  use Tie::CheckVariables;

  Tie::CheckVariables->register('url','^http://');
  tie my $test_url,'Tie::CheckVariables','url';
  $test_url = 'http://www.perl.org';
  untie $test_url;

package Tie::CheckVariables;

use strict;
use warnings;
use Carp;

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

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

  $self->_type($type);
	
  return $self;
}

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

sub STORE {
  my ($self,$value) = @_;
    
  my $re = $self->_regex();
  if(!(ref $value) && $value =~ /$re/){
    $self->{VALUE} = $value;
  }
  else{
    $self->{VALUE} = undef;
    $error_code->();
    #croak "no valid input";
  }
}

sub UNTIE {}

sub DESTROY {}

sub _regex{
  my ($self) = @_;
  $self->{REGEXP} = _get_regex($self->_type()) unless($self->{REGEXP});
  return $self->{REGEXP};
}# regex

sub _type{
  my ($self,$type) = @_;
  $self->{TYPE} = $type if(defined $type);
  return $self->{TYPE};
}# type

sub _get_regex{
  my ($type) = @_;
	      
  return $hash{$type} if(exists $hash{$type});
}# get_regex

sub register{
  my ($class,$type,$regex) = @_;
  return unless($class eq 'Tie::CheckVariables');
  $hash{$type} = qr{$regex};
}# register

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


1;

__END__