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 28 my($class, $obj, $oclass, $type, $ref, $pclass, $pidx, $idx) = @_;
5 11   100     114 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 180 my $self = shift;
18 2         9 return $self->{object};
19             }
20              
21             sub class {
22 4     4 0 8 my $self = shift;
23 4   100     34 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 4 my $self = shift;
35 2         8 return $self->{reftype} eq "SCALAR";
36             }
37              
38             sub is_array {
39 2     2 0 3 my $self = shift;
40 2         16 return $self->{reftype} eq "ARRAY";
41             }
42              
43             sub is_hash {
44 2     2 0 3 my $self = shift;
45 2         8 return $self->{reftype} eq "HASH";
46             }
47              
48             sub is_code {
49 2     2 0 4 my $self = shift;
50 2         7 return $self->{reftype} eq "CODE";
51             }
52              
53             sub is_ref {
54 2     2 0 4 my $self = shift;
55 2         22 return $self->{is_ref};
56             }
57              
58             sub container_class {
59 2     2 0 4 my $self = shift;
60 2   100     11 return $self->{pclass} || "";
61             }
62              
63             sub container_self {
64 2     2 0 4 my $self = shift;
65 2 100       7 return "" unless $self->{pclass};
66 1         2 my $idx = $self->{idx};
67 1         2 my $pidx = $self->{pidx};
68 1         6 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     9 my $top = shift || "var";
74 2         4 $top =~ s/^\$//; # it's always added by fullname()
75 2         3 my $idx = $self->{idx};
76 2         16 return Data::Dump::fullname($top, $idx);
77             }
78              
79             sub object_isa {
80 6     6 0 24 my($self, $class) = @_;
81 6   100     42 return $self->{class} && $self->{class}->isa($class);
82             }
83              
84             sub container_isa {
85 2     2 0 4 my($self, $class) = @_;
86 2   66     17 return $self->{pclass} && $self->{pclass}->isa($class);
87             }
88              
89             sub depth {
90 2     2 0 4 my $self = shift;
91 2         2 return scalar @{$self->{idx}};
  2         8  
92             }
93              
94             1;