File Coverage

blib/lib/Switch/Perlish/Smatch/Array.pm
Criterion Covered Total %
statement 31 31 100.0
branch n/a
condition 12 12 100.0
subroutine 11 11 100.0
pod n/a
total 54 54 100.0


line stmt bran cond sub pod time code
1             package Switch::Perlish::Smatch::Array;
2              
3             $VERSION = '1.0.0';
4              
5 11     11   79 use strict;
  11         20  
  11         1599  
6 11     11   63 use warnings;
  11         23  
  11         352  
7              
8 11     11   62 use Switch::Perlish::Smatch 'smatch';
  11         19  
  11         7668  
9              
10             ## DESC - Smatch for $m in @$t.
11             sub _VALUE {
12 2     2   4 my($t, $m) = @_;
13             smatch($m, $_) and return 1
14 2   100     12 for @$t;
15 1         9 return;
16             }
17              
18             ## DESC - Return false as $t is already defined.
19 1     1   8 sub _UNDEF { return }
20              
21             ## DESC - Check if $m points to an element of @$t.
22             sub _SCALAR {
23 2     2   5 my($t, $m) = @_;
24             \$_ == $m and return 1
25 2   100     24 for @$t;
26 1         8 return;
27             }
28              
29             ## This also doesn't feel right.
30             ## DESC - Smatch for an element of @$m in @$t.
31             sub _ARRAY {
32 4     4   7 my($t, $m) = @_;
33 4         9 for my $el (@$t) {
34             smatch($el, $_) and return 1
35 8   100     36 for @$m;
36             }
37 2         19 return;
38             }
39              
40             ## This is what I get for JFDI.
41             ## DESC - Check if an element of @$t exists as a key in %$m.
42             sub _HASH {
43 2     2   16 my($t, $m) = @_;
44             exists $m->{$_} and return 1
45 2   100     19 for @$t;
46 1         8 return;
47             }
48              
49             ## DESC - Call &$m with @$t.
50             sub _CODE {
51 2     2   4 my($t, $m) = @_;
52 2         8 return $m->(@$t);
53             }
54              
55             ## More uncertainty.
56             ## DESC - Check if an element of @$t exists as a method of $m.
57             sub _OBJECT {
58 2     2   5 my($t, $m) = @_;
59             $m->can($_) and return 1
60 2   100     49 for @$t;
61 1         8 return;
62             }
63              
64             ## DESC - Match $m against the elements of @$t.
65             sub _Regexp {
66 2     2   70 my($t, $m) = @_;
67             /$m/ and return 1
68 2   100     40 for @$t;
69 1         10 return;
70             }
71              
72             Switch::Perlish::Smatch->register_package( __PACKAGE__, 'ARRAY' );
73              
74             1;
75              
76             =pod
77              
78             =head1 NAME
79              
80             Switch::Perlish::Smatch::Array - The C comparatory category package.
81              
82             =head1 VERSION
83              
84             1.0.0 - Initial release.
85              
86             =head1 DESCRIPTION
87              
88             This package provides the default implementation for the C comparator
89             category. For more information on the comparator implementation see.
90             L.
91              
92             =head1 SEE. ALSO
93              
94             L
95              
96             L
97              
98             =head1 AUTHOR
99              
100             Dan Brook C<< >>
101              
102             =head1 COPYRIGHT
103              
104             Copyright (c) 2006, Dan Brook. All Rights Reserved. This module is free
105             software. It may be used, redistributed and/or modified under the same
106             terms as Perl itself.
107              
108             =cut