package Typed;

sub TIESCALAR {
    my $class = shift;
    my $test_function = shift;
    bless [ undef, $test_function ], $class;
}

sub FETCH {
    my $self = shift;
    $self->[0];
}

sub STORE {
    my $self = shift;
    my $v = shift;
    if ($self->[1]->($v)) {
        $self->[0] = $v;
    } else {
        die "'$v' is an illegal value for " . ref($self) . "\n";
    }
}

package Typed::Integer;

our @ISA = 'Typed';

sub TIESCALAR {
    my $class = shift;
    Typed::TIESCALAR($class, sub { my $n = shift; $n =~ /^[\+-]?\d+$/ });
}

package Typed::Number::Natural;

our @ISA = 'Typed'; # could say 'Typed::Integer' but it makes no difference here

sub TIESCALAR {
    my $class = shift;
    Typed::TIESCALAR(
            $class,
            sub {
                my $n = shift;
                ($n !~ /\D/) && ($n > 0);
            }
        );
}

package Typed::VarChar;

our @ISA = 'Typed';

sub TIESCALAR {
    my $class = shift;
    tie my $n, 'Typed::Number::Natural';
    $n = shift;
    my $r = Typed::TIESCALAR(
            $class,
            sub {
                my $s = shift;
                defined($s) && (length($s) <= $n);
            }
        );
}

package main; # "where the action is"

tie my $x, 'Typed::Integer';
$x = 100; # OK
$x = -12; # OK
$x = 1.1; # dies, uh I mean "throws an exception"
$x = 'stuff'; # dies

tie my $z, 'Typed::VarChar', 5;
$z = 'chars'; # OK
$z = ''; # OK
$z = 'Fairly long string'; # dies