Added auto mode.
authorHeiko Schlittermann (JUMPER) <hs@schlittermann.de>
Tue, 29 Jul 2014 21:26:49 +0200
changeset 1 82e2b6a853a7
parent 0 f65c3dd5742a
child 2 54cabdf79181
Added auto mode. The first assignment sets the type.
MANIFEST
lib/Scalar/RefType.pm
t/10-usage.t
--- 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
--- 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
--- 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';