File Coverage

blib/lib/Switch/Perlish/Smatch/Value.pm
Criterion Covered Total %
statement 24 25 96.0
branch n/a
condition 2 2 100.0
subroutine 10 11 90.9
pod n/a
total 36 38 94.7


line stmt bran cond sub pod time code
1             package Switch::Perlish::Smatch::Value;
2              
3             $VERSION = '1.0.0';
4              
5 11     11   58 use strict;
  11         21  
  11         400  
6 11     11   56 use warnings;
  11         20  
  11         441  
7              
8 11     11   69 use Switch::Perlish::Smatch 'value_cmp';
  11         18  
  11         5220  
9              
10             ## DESC - Call C with $t and $m.
11             sub _VALUE {
12 66     66   230 my($t, $m) = @_;
13 66         187 return value_cmp($t, $m);
14             }
15              
16             ## DESC - Return false, a VALUE is always defined.
17 0     0   0 sub _UNDEF { return }
18              
19             ## DESC - Check if what $m points to is the same as $t.
20             sub _SCALAR {
21 1     1   3 my($t, $m) = @_;
22 1         5 return value_cmp($t, $$m);
23             }
24              
25             ## DESC - Check if the $t is in $m.
26             sub _ARRAY {
27 2     2   4 my($t, $m) = @_;
28             Switch::Perlish::Smatch::value_cmp($t, $_) and return 1
29 2   100     9 for @$m;
30 1         9 return;
31             }
32              
33             ## Provide a wrapper sub to test against hash values?
34             ## DESC - Check if the $t exists as a key in $m.
35             sub _HASH {
36 2     2   4 my($t, $m) = @_;
37 2         13 return exists $m->{$t};
38             }
39              
40             ## DESC - Pass $t to &$m.
41             sub _CODE {
42 2     2   4 my($t, $m) = @_;
43 2         16 return $m->($t);
44             }
45              
46             ## DESC - Check if the method $t exists in $m.
47             sub _OBJECT {
48 2     2   4 my($t, $m) = @_;
49 2         29 return $m->can($t);
50             }
51              
52             ## DESC - Regexp match $t against $m.
53             sub _Regexp {
54 2     2   4 my($t, $m) = @_;
55 2         23 return $t =~ /$m/;
56             }
57              
58             Switch::Perlish::Smatch->register_package( __PACKAGE__, 'VALUE' );
59              
60             1;
61              
62             =pod
63              
64             =head1 NAME
65              
66             Switch::Perlish::Smatch::Value - The C comparatory category package.
67              
68             =head1 VERSION
69              
70             1.0.0 - Initial release.
71              
72             =head1 DESCRIPTION
73              
74             This package provides the default implementation for the C comparator
75             category. For more information on the comparator implementation see.
76             L.
77              
78             =head1 SEE. ALSO
79              
80             L
81              
82             L
83              
84             =head1 AUTHOR
85              
86             Dan Brook C<< >>
87              
88             =head1 COPYRIGHT
89              
90             Copyright (c) 2006, Dan Brook. All Rights Reserved. This module is free
91             software. It may be used, redistributed and/or modified under the same
92             terms as Perl itself.
93              
94             =cut