1 package Scalar::RefType;

     2 use strict;

     3 use warnings;

     4 use Carp;

     5 

     6 our $VERSION = '0.02';

     7 

     8 sub TIESCALAR {

     9     my ($class, $type) = @_;

    10     return bless {

    11         value => undef,

    12         type  => @_ < 2 ? undef

    13         : ref($type)    ? ref($type)

    14         : length($type) ? $type

    15         :                 ''

    16     };

    17 }

    18 

    19 sub FETCH { return $_[0]->{value} }

    20 

    21 sub STORE {

    22     my ($self, $value) = @_;

    23     my $ref = ref $value // '';

    24     $self->{type} //= $ref;

    25     croak 'invalid reference type' if $ref ne $self->{type};

    26     return $self->{value} = $value;

    27 }

    28 

    29 __END__

    30 

    31 =head1 NAME

    32 

    33  Scalar::RefType - simple scalar type checker

    34 

    35 =head1 SYNOPSIS

    36 

    37  use Scalar::RefType;

    38 

    39  tie my $h1 => 'Scalar::RefType', {};

    40  tie my $h2 => 'Scalar::RefType', 'HASH';

    41  tie my $h3 => 'Scalar::RefType';

    42 

    43  $h1 = [];  # dies, violates the type

    44  $h2 = [];  # dies, violates the type

    45 

    46  $h3 = {};  # sets the type

    47  $h3 = [];  # dies

    48 

    49 =head1 DESCRIPTION

    50 

    51 This little module allows you to tie the type of a scalar to a specified

    52 reference type. If the refererence type of an assignment violates the 

    53 tied type, the assignment throws an exception.

    54 

    55 =head1 AUTHOR

    56 

    57 Heiko Schlittermann <hs@schlittermann.de>

    58 

    59 =cut