File Coverage

blib/lib/Method/Cached/KeyRule.pm
Criterion Covered Total %
statement 41 41 100.0
branch 10 10 100.0
condition n/a
subroutine 9 9 100.0
pod 0 5 0.0
total 60 65 92.3


line stmt bran cond sub pod time code
1             package Method::Cached::KeyRule;
2              
3 6     6   25 use strict;
  6         7  
  6         156  
4 6     6   23 use warnings;
  6         6  
  6         148  
5 6     6   24 use Scalar::Util;
  6         7  
  6         328  
6              
7             {
8 6     6   22 no strict 'refs';
  6         9  
  6         2210  
9              
10             sub regularize {
11 103     103 0 136 my $key_rule = shift;
12 103         130 my $ref = ref $key_rule;
13 103 100       227 $ref || return &{$key_rule || 'LIST'}(@_);
  64 100       377  
14 39 100       156 $ref eq 'CODE' && return $key_rule->(@_);
15 15         8 my $key;
16 15         12 for my $rule (@{$key_rule}) {
  15         17  
17 30 100       45 $key = ref $rule ? $rule->(@_) : &{$rule}(@_);
  25         47  
18             }
19 15         20 return $key;
20             }
21             }
22              
23             sub SELF_SHIFT {
24 5     5 0 8 my ($method_name, $args) = @_;
25 5         5 shift @{$args};
  5         4  
26 5         8 return;
27             }
28              
29             sub PER_OBJECT {
30 5     5 0 5 my ($method_name, $args) = @_;
31 5         14 $args->[0] = Scalar::Util::refaddr $args->[0];
32 5         6 return;
33             }
34              
35             sub LIST {
36 73     73 0 141 my ($method_name, $args) = @_;
37 73         279 local $^W = 0;
38 73         94 $method_name . join chr(28), @{$args};
  73         466  
39             }
40              
41             sub HASH {
42 6     6 0 8 my ($method_name, $args) = @_;
43 6         25 local $^W = 0;
44 6         13 my ($ser, %hash) = (q{}, @{$args});
  6         19  
45             map {
46 6 100       27 $ser .= chr(28) . $_ . (defined $hash{$_} ? '=' . $hash{$_} : q{})
  12         95  
47             } sort keys %hash;
48 6         39 $method_name . $ser;
49             }
50              
51             1;
52              
53             __END__