# HG changeset patch # User Heiko Schlittermann (JUMPER) # Date 1406662009 -7200 # Node ID 82e2b6a853a7ff4ef4b69f149ce023fd90863be2 # Parent f65c3dd5742a6874f6f68c182927a87805022b3a Added auto mode. The first assignment sets the type. diff -r f65c3dd5742a -r 82e2b6a853a7 MANIFEST --- a/MANIFEST Tue Jul 29 12:17:35 2014 +0200 +++ b/MANIFEST Tue Jul 29 21:26:49 2014 +0200 @@ -2,3 +2,5 @@ lib/Scalar/RefType.pm MANIFEST This list of files t/10-usage.t +META.yml +META.json diff -r f65c3dd5742a -r 82e2b6a853a7 lib/Scalar/RefType.pm --- a/lib/Scalar/RefType.pm Tue Jul 29 12:17:35 2014 +0200 +++ b/lib/Scalar/RefType.pm Tue Jul 29 21:26:49 2014 +0200 @@ -7,7 +7,13 @@ sub TIESCALAR { my ($class, $type) = @_; - return bless { value => undef, type => ref $type ? ref $type : $type // '' }; + return bless { + value => undef, + type => @_ < 2 ? undef + : ref($type) ? ref($type) + : length($type) ? $type + : '' + }; } sub FETCH { return $_[0]->{value} } @@ -15,9 +21,8 @@ sub STORE { my ($self, $value) = @_; my $ref = ref $value // ''; - if ($ref ne $self->{type}) { - croak 'invalid reference type'; - } + $self->{type} //= $ref; + croak 'invalid reference type' if $ref ne $self->{type}; return $self->{value} = $value; } @@ -33,14 +38,18 @@ tie my $h1 => 'Scalar::RefType', {}; tie my $h2 => 'Scalar::RefType', 'HASH'; + tie my $h3 => 'Scalar::RefType'; - # dies: - $h1 = []; + $h1 = []; # dies, violates the type + $h2 = []; # dies, violates the type + + $h3 = {}; # sets the type + $h3 = []; # dies =head1 DESCRIPTION This little module allows you to tie the type of a scalar to a specified -reference type. If the refererence type of an assignment violetes the +reference type. If the refererence type of an assignment violates the tied type, the assignment throws an exception. =head1 AUTHOR diff -r f65c3dd5742a -r 82e2b6a853a7 t/10-usage.t --- a/t/10-usage.t Tue Jul 29 12:17:35 2014 +0200 +++ b/t/10-usage.t Tue Jul 29 21:26:49 2014 +0200 @@ -6,16 +6,12 @@ use Test::Exception; use_ok 'Scalar::RefType' or BAIL_OUT q{Can't load the module}; -isa_ok tie(my $h => 'Scalar::RefType', {}) => 'Scalar::RefType'; -isa_ok tie(my $a => 'Scalar::RefType', []) => 'Scalar::RefType'; -isa_ok tie(my $s => 'Scalar::RefType', \(undef)) => 'Scalar::RefType'; -isa_ok tie(my $p => 'Scalar::RefType', undef) => 'Scalar::RefType'; subtest 'NAMES' => sub { isa_ok tie(my $h => 'Scalar::RefType', ref {}) => 'Scalar::RefType'; isa_ok tie(my $a => 'Scalar::RefType', ref []) => 'Scalar::RefType'; isa_ok tie(my $s => 'Scalar::RefType', ref \(undef)) => 'Scalar::RefType'; - isa_ok tie(my $p => 'Scalar::RefType', '') => 'Scalar::RefType'; + isa_ok tie(my $p => 'Scalar::RefType', '') => 'Scalar::RefType'; is tied($h)->{type}, 'HASH' => 'is a hash ref'; is tied($a)->{type}, 'ARRAY' => 'is a array ref'; @@ -24,6 +20,18 @@ }; +subtest 'AUTO' => sub { + isa_ok tie(my $x => 'Scalar::RefType') => 'Scalar::RefType'; + ok $x = {} => 'hash: assignment'; + is tied($x)->{type}, 'HASH' => 'hash: type'; + throws_ok { $x = [] } qr/invalid/ => 'invalid type assignment'; +}; + +isa_ok tie(my $h => 'Scalar::RefType', {}) => 'Scalar::RefType'; +isa_ok tie(my $a => 'Scalar::RefType', []) => 'Scalar::RefType'; +isa_ok tie(my $s => 'Scalar::RefType', \(undef)) => 'Scalar::RefType'; +isa_ok tie(my $p => 'Scalar::RefType', undef) => 'Scalar::RefType'; + is tied($h)->{type}, 'HASH' => 'is a hash ref'; is tied($a)->{type}, 'ARRAY' => 'is a array ref'; is tied($s)->{type}, 'SCALAR' => 'is a scalar';