File Coverage

blib/lib/Devel/MAT/Tool/Identify.pm
Criterion Covered Total %
statement 35 65 53.8
branch 7 18 38.8
condition n/a
subroutine 11 16 68.7
pod 0 7 0.0
total 53 106 50.0


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016-2017 -- leonerd@leonerd.org.uk
5              
6             package Devel::MAT::Tool::Identify 0.50;
7              
8 5     5   3850 use v5.14;
  5         18  
9 5     5   28 use warnings;
  5         11  
  5         156  
10 5     5   27 use base qw( Devel::MAT::ToolBase::GraphWalker );
  5         9  
  5         2383  
11 5     5   31 use utf8;
  5         15  
  5         23  
12              
13 5     5   135 use constant CMD => "identify";
  5         11  
  5         268  
14 5     5   30 use constant CMD_DESC => "Identify an SV by its referrers";
  5         10  
  5         432  
15              
16             =encoding UTF-8
17              
18             =head1 NAME
19              
20             C - identify an SV by its referrers
21              
22             =head1 DESCRIPTION
23              
24             This C tool provides a command to identify an SV by walking up its
25             tree of inrefs, printing useful information that helps to identify what it is
26             by how it can be reached from well-known program roots.
27              
28             =cut
29              
30             =head1 COMMANDS
31              
32             =cut
33              
34             =head2 identify
35              
36             pmat> identify 0x1bbf640
37             IO() at 0x1bbf640 is:
38             └─the io of GLOB(@*I) at 0x1bbf628, which is:
39             └─the ARGV GV
40              
41             Prints a tree of the identification of the SV at the given address.
42              
43             Takes the following named options:
44              
45             =over 4
46              
47             =item --depth D, -d D
48              
49             Limits the output to the given number of steps away from the given initial SV.
50              
51             =item --weak
52              
53             Include weak direct references in the output (by default only strong direct
54             ones will be included).
55              
56             =item --all
57              
58             Include both weak and indirect references in the output.
59              
60             =item --no-elide, -n
61              
62             Don't elide structure in the output.
63              
64             By default, C-type SVs will be skipped over, leading to a shorter
65             neater output by removing this usually-unnecessary noise. If this option is
66             not given, elided reference SVs will be notated by adding C<(via RV)> to the
67             reference description.
68              
69             Additionally, members of the symbol table will be printed as being root SVs,
70             noting their symbol table name. This avoids additional nesting due to the
71             stashes and globs that make up the symbol table. This can also cause SVs to be
72             recognised as symbol table entries, when without it they might be cut off due
73             to the depth limit.
74              
75             =back
76              
77             =cut
78              
79 5         389 use constant CMD_OPTS => (
80             depth => { help => "maximum depth to recurse",
81             type => "i",
82             alias => "d",
83             default => 10 },
84             weak => { help => "include weak references" },
85             all => { help => "include weak and indirect references",
86             alias => "a" },
87             no_elide => { help => "don't elide REF, PAD and symbol structures",
88             alias => "n" },
89 5     5   29 );
  5         10  
90              
91 5     5   35 use constant CMD_ARGS_SV => 1;
  5         9  
  5         4267  
92              
93             sub run
94             {
95 0     0 0 0 my $self = shift;
96 0         0 my %opts = %{ +shift };
  0         0  
97 0         0 my ( $sv ) = @_;
98              
99 0         0 $self->reset;
100              
101 0         0 my $STRONG = 1;
102 0         0 my $DIRECT = 1;
103 0         0 my $ELIDE = !$opts{no_elide};
104              
105 0 0       0 $STRONG = 0 if $opts{weak};
106 0 0       0 $STRONG = 0, $DIRECT = 0 if $opts{all};
107              
108 0         0 $self->pmat->load_tool( "Inrefs", progress => $self->{progress} );
109              
110 0         0 Devel::MAT::Cmd->printf( "%s is:\n",
111             Devel::MAT::Cmd->format_sv( $sv ),
112             );
113              
114             $self->walk_graph( $self->pmat->inref_graph( $sv,
115             depth => $opts{depth},
116 0         0 strong => $STRONG,
117             direct => $DIRECT,
118             elide => $ELIDE,
119             ), "" );
120             }
121              
122             sub _strength_label
123             {
124 7     7   44 my ( $strength ) = @_;
125 7 50       30 $strength eq "strong" ? "" :
126             Devel::MAT::Cmd->format_note( "[$strength]", 1 ) . " ",
127             }
128              
129             sub on_walk_nothing
130             {
131 0     0 0 0 shift;
132 0         0 my ( $node, $indent ) = @_;
133 0         0 Devel::MAT::Cmd->printf( "$indent└─not found\n" );
134             }
135              
136             sub on_walk_EDEPTH
137             {
138 0     0 0 0 shift;
139 0         0 my ( $node, $indent ) = @_;
140 0         0 Devel::MAT::Cmd->printf( "$indent└─not found at this depth\n" );
141             }
142              
143             sub on_walk_again
144             {
145 0     0 0 0 shift;
146 0         0 my ( $node, $cyclic, $id, $indent ) = @_;
147              
148 0         0 Devel::MAT::Cmd->printf( "$indent└─already found " );
149              
150 0 0       0 Devel::MAT::Cmd->printf( "%s ",
151             Devel::MAT::Cmd->format_note( "circularly" )
152             ) if $cyclic;
153              
154 0 0       0 if( defined $id ) {
155 0         0 Devel::MAT::Cmd->printf( "as %s\n",
156             Devel::MAT::Cmd->format_note( "*$id" ),
157             );
158             }
159             else {
160 0         0 Devel::MAT::Cmd->printf( "%s\n",
161             Devel::MAT::Cmd->format_note( "circularly" ),
162             );
163             }
164             }
165              
166             sub on_walk_root
167             {
168 3     3 0 6 shift;
169 3         10 my ( $node, $root, $isfinal, $indent ) = @_;
170              
171 3 50       13 Devel::MAT::Cmd->printf( $indent . ( $isfinal ? "└─%s%s\n" : "├─%s%s\n" ),
172             _strength_label( $root->strength ), $root->name,
173             );
174             }
175              
176             sub on_walk_ref
177             {
178 4     4 0 6 shift;
179 4         11 my ( $node, $ref, $sv, $ref_id, $is_final, $indent ) = @_;
180              
181 4 100       25 Devel::MAT::Cmd->printf(
182             $indent . ( $is_final ? "└─" : "├─" ) );
183              
184 4         39 Devel::MAT::Cmd->printf( "%s%s of %s, which is",
185             _strength_label( $ref->strength ),
186             $ref->name,
187             Devel::MAT::Cmd->format_sv( $sv ),
188             );
189              
190 4 50       41 if( $ref_id ) {
191 0         0 Devel::MAT::Cmd->printf( " %s",
192             Devel::MAT::Cmd->format_note( "(*$ref_id)" ),
193             );
194             }
195              
196 4         14 Devel::MAT::Cmd->printf( ":\n" );
197              
198             # return recursion args:
199 4 100       33 return ( $indent . ( $is_final ? " " : "│ " ) );
200             }
201              
202             sub on_walk_itself
203             {
204 0     0 0   shift;
205 0           my ( $node, $indent ) = @_;
206 0           Devel::MAT::Cmd->printf( "${indent}itself\n" );
207             }
208              
209             =head1 AUTHOR
210              
211             Paul Evans
212              
213             =cut
214              
215             0x55AA;