File Coverage

lib/Data/Pretty/FilterContext.pm
Criterion Covered Total %
statement 54 56 96.4
branch 2 2 100.0
condition 14 15 93.3
subroutine 21 22 95.4
pod 15 15 100.0
total 106 110 96.3


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