File Coverage

blib/lib/Data/Dump/FilterContext.pm
Criterion Covered Total %
statement 35 37 94.5
branch 2 2 100.0
condition 14 15 93.3
subroutine 14 15 93.3
pod 0 15 0.0
total 65 84 77.3


line stmt bran cond sub pod time code
1             package Data::Dump::FilterContext;
2              
3             sub new {
4 11     11 0 15 my($class, $obj, $oclass, $type, $ref, $pclass, $pidx, $idx) = @_;
5 11   100     67 return bless {
6             object => $obj,
7             class => $ref && $oclass,
8             reftype => $type,
9             is_ref => $ref,
10             pclass => $pclass,
11             pidx => $pidx,
12             idx => $idx,
13             }, $class;
14             }
15              
16             sub object_ref {
17 2     2 0 70 my $self = shift;
18 2         10 return $self->{object};
19             }
20              
21             sub class {
22 4     4 0 4 my $self = shift;
23 4   100     15 return $self->{class} || "";
24             }
25              
26             *is_blessed = \&class;
27              
28             sub reftype {
29 0     0 0 0 my $self = shift;
30 0         0 return $self->{reftype};
31             }
32              
33             sub is_scalar {
34 2     2 0 2 my $self = shift;
35 2         5 return $self->{reftype} eq "SCALAR";
36             }
37              
38             sub is_array {
39 2     2 0 2 my $self = shift;
40 2         5 return $self->{reftype} eq "ARRAY";
41             }
42              
43             sub is_hash {
44 2     2 0 2 my $self = shift;
45 2         6 return $self->{reftype} eq "HASH";
46             }
47              
48             sub is_code {
49 2     2 0 2 my $self = shift;
50 2         4 return $self->{reftype} eq "CODE";
51             }
52              
53             sub is_ref {
54 2     2 0 2 my $self = shift;
55 2         6 return $self->{is_ref};
56             }
57              
58             sub container_class {
59 2     2 0 3 my $self = shift;
60 2   100     13 return $self->{pclass} || "";
61             }
62              
63             sub container_self {
64 2     2 0 2 my $self = shift;
65 2 100       10 return "" unless $self->{pclass};
66 1         1 my $idx = $self->{idx};
67 1         2 my $pidx = $self->{pidx};
68 1         4 return Data::Dump::fullname("self", [@$idx[$pidx..(@$idx - 1)]]);
69             }
70              
71             sub expr {
72 2     2 0 3 my $self = shift;
73 2   100     6 my $top = shift || "var";
74 2         3 $top =~ s/^\$//; # it's always added by fullname()
75 2         3 my $idx = $self->{idx};
76 2         3 return Data::Dump::fullname($top, $idx);
77             }
78              
79             sub object_isa {
80 6     6 0 13 my($self, $class) = @_;
81 6   100     42 return $self->{class} && $self->{class}->isa($class);
82             }
83              
84             sub container_isa {
85 2     2 0 3 my($self, $class) = @_;
86 2   66     23 return $self->{pclass} && $self->{pclass}->isa($class);
87             }
88              
89             sub depth {
90 2     2 0 2 my $self = shift;
91 2         2 return scalar @{$self->{idx}};
  2         5  
92             }
93              
94             1;