# HG changeset patch
# User Heiko Schlittermann (JUMPER) <hs@schlittermann.de>
# Date 1406629055 -7200
# Node ID f65c3dd5742a6874f6f68c182927a87805022b3a

First Version

diff -r 000000000000 -r f65c3dd5742a .hgignore
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/.hgignore	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,7 @@
+\b_build/
+\bblib/
+
+syntax:glob
+Build
+MANIFEST.SKIP.bak
+MANIFEST.bak
diff -r 000000000000 -r f65c3dd5742a Build.PL
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/Build.PL	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,14 @@
+#! perl
+use Module::Build;
+
+Module::Build->new(
+    module_name => 'Scalar::RefType',
+    dist_abstract => 'simple scalar ref type checker',
+    version_from => 'lib/Scalar/RefType.pm',
+    build_requires => {
+	Test::Exception => 0,
+    },
+    requires => {
+	perl => '5.0',
+    }
+)->create_build_script;
diff -r 000000000000 -r f65c3dd5742a MANIFEST
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MANIFEST	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,4 @@
+Build.PL
+lib/Scalar/RefType.pm
+MANIFEST			This list of files
+t/10-usage.t
diff -r 000000000000 -r f65c3dd5742a MANIFEST.SKIP
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MANIFEST.SKIP	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,75 @@
+
+#!start included /home/heiko/perl5/lib/perl5/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.hg\b
+\B\.gitignore\b
+\b_darcs\b
+\B\.cvsignore$
+
+# Avoid VMS specific MakeMaker generated files
+\bDescrip.MMS$
+\bDESCRIP.MMS$
+\bdescrip.mms$
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$         # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+\bBuild.bat$
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.tmp$
+\.#
+\.rej$
+
+# Avoid OS-specific files/dirs
+# Mac OSX metadata
+\B\.DS_Store
+# Mac OSX SMB mount metadata files
+\B\._
+
+# Avoid Devel::Cover and Devel::CoverX::Covered files.
+\bcover_db\b
+\bcovered\b
+ 
+# Avoid MYMETA files
+^MYMETA\.
+#!end included /home/heiko/perl5/lib/perl5/ExtUtils/MANIFEST.SKIP
+
+# Avoid configuration metadata file
+^MYMETA\.
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\bBuild.bat$
+\b_build
+\bBuild.COM$
+\bBUILD.COM$
+\bbuild.com$
+^MANIFEST\.SKIP
+
+# Avoid archives of this distribution
+\bScalar-RefType-[\d\.\_]+
+\.sw.$
diff -r 000000000000 -r f65c3dd5742a lib/Scalar/RefType.pm
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lib/Scalar/RefType.pm	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,50 @@
+package Scalar::RefType;
+use strict;
+use warnings;
+use Carp;
+
+our $VERSION = '0.01';
+
+sub TIESCALAR {
+    my ($class, $type) = @_;
+    return bless { value => undef, type => ref $type ? ref $type : $type // '' };
+}
+
+sub FETCH { return $_[0]->{value} }
+
+sub STORE {
+    my ($self, $value) = @_;
+    my $ref = ref $value // '';
+    if ($ref ne $self->{type}) {
+	croak 'invalid reference type';
+    }
+    return $self->{value} = $value;
+}
+
+__END__
+
+=head1 NAME
+
+ Scalar::RefType - simple scalar type checker
+
+=head1 SYNOPSIS
+
+ use Scalar::RefType;
+
+ tie my $h1 => 'Scalar::RefType', {};
+ tie my $h2 => 'Scalar::RefType', 'HASH';
+
+ # dies:
+ $h1 = [];
+
+=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 
+tied type, the assignment throws an exception.
+
+=head1 AUTHOR
+
+Heiko Schlittermann <hs@schlittermann.de>
+
+=cut
diff -r 000000000000 -r f65c3dd5742a t/10-usage.t
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/t/10-usage.t	Tue Jul 29 12:17:35 2014 +0200
@@ -0,0 +1,45 @@
+#! perl
+
+use strict;
+use warnings;
+use Test::More;
+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';
+
+    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';
+    is tied($p)->{type}, ''       => 'is a "plain"';
+
+};
+
+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';
+is tied($p)->{type}, ''       => 'is a "plain"';
+
+is ref($h = { a => 'A' }), 'HASH' => 'hash: assignment';
+is ref($a = ['a', 'b']), 'ARRAY' => 'array: assignment';
+is ref($s = \6), 'SCALAR' => 'scalar: assignment';
+is ref($p = 6), '' => 'plain: assignment';
+
+is $h->{a}, 'A' => 'hash: got the value';
+is $a->[1], 'b' => 'array: got the value';
+is $$s, 6, => 'scalar: got the value';
+is $p,  6, => 'plain: got the value';
+
+throws_ok { $h = [] } qr/invalid/ => 'hash: dies on invalid type';
+throws_ok { $h = 6 } qr/invalid/  => 'hash: dies on invalid type';
+
+done_testing;