File Coverage

blib/lib/Repl/Spec/Type/InstanceType.pm
Criterion Covered Total %
statement 17 26 65.3
branch 0 4 0.0
condition 1 9 11.1
subroutine 5 7 71.4
pod 3 3 100.0
total 26 49 53.0


line stmt bran cond sub pod time code
1             =head1 NAME
2            
3             Repl::Spec::Type::InstanceType - A parameter guard that ensures instances of a specified class.
4            
5             =head1 SYNOPSIS
6            
7             This type guard ensures that a reference parameter was passed by the user
8             containing a reference to an abject belonging to a specified class. Reference types 'ARRAY' and 'HASH' can be used as well.
9            
10             =head1 DESCRIPTION
11            
12             =head1 Methods
13            
14             =over 4
15            
16             =item C
17            
18             Parameters: A string denoting a class name or 'ARRAY' or 'HASH'.
19            
20             =item C
21            
22             Parameters: A single expression.
23             Returns: The same reference. No conversions are applied.
24            
25             =item C
26            
27             =head1 SEE ALSO
28            
29             L
30             L
31             L
32             L
33             L
34             L
35             L
36             L
37            
38             =cut
39            
40             package Repl::Spec::Type::InstanceType;
41            
42 1     1   6 use strict;
  1         2  
  1         38  
43 1     1   56 use warnings;
  1         3  
  1         30  
44 1     1   13 use Carp;
  1         3  
  1         105  
45            
46 1         504 use Scalar::Util qw(blessed dualvar isweak readonly refaddr reftype tainted
47 1     1   7 weaken isvstring looks_like_number set_prototype);
  1         2  
48            
49             # Parameters:
50             # - The package name (string) or reference type (HASH, ARRAY) to which
51             # the argument must belong.
52             sub new
53             {
54 4     4 1 8 my $invocant = shift;
55 4         5 my $classname = shift;
56            
57 4   33     16 my $class = ref($invocant) || $invocant;
58            
59 4         9 my $self = {CLASS=>$classname};
60 4         211 return bless $self, $class;
61             }
62            
63             sub guard
64             {
65 0     0 1   my $self = shift;
66 0           my $arg = shift;
67            
68 0           my $classname = $self->{CLASS};
69 0 0 0       return $arg if (blessed($arg) && UNIVERSAL::isa($arg, $classname));
70 0 0 0       return $arg if (ref($arg) && ($classname eq ref($arg)));
71 0           croak sprintf("Expected '%s' instance but received '%s'.", $classname, $arg);
72             }
73            
74             sub name
75             {
76 0     0 1   my $self = shift;
77 0           my $classname = $self->{CLASS};
78 0           return sprintf("%s reference", $classname);
79             }
80            
81             1;