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__

=pod

=head1 NAME

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

=head1 SYNOPSIS

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

=head1 DATATYPES

You can use these datatypes:

=over 5

=item * integer

=item * float

=item * string

=back

=head1 WHAT TO DO WHEN CHECK FAILS

=head2 on_error

You can specify a subroutine that is invoked on error:

  use Tie::CheckVariables;
  
  Tie::CheckVariables->on_error(sub{print "ERROR!"});
  
  tie my $scalar,'Tie::CheckVariables','integer';
  $scalar = 'a'; # ERROR! is printed
  untie $scalar;

=head1 USE YOUR OWN DATATYPE

=head2 register

If the built-in datatypes aren't enough, you can extend this module with your own datatypes:

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

=head1 BUGS

No known bugs, but "every" piece of code has bugs. If you find bugs, please
use http://rt.cpan.org

=head1 AUTHOR

copyright 2006
Renee Baecker E<lt>module@renee-baecker.deE<gt>

=cut