File Coverage

blib/lib/Devel/MAT/Tool/Symbols.pm
Criterion Covered Total %
statement 32 92 34.7
branch 0 30 0.0
condition 0 15 0.0
subroutine 11 18 61.1
pod 0 2 0.0
total 43 157 27.3


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, 2017-2018 -- leonerd@leonerd.org.uk
5              
6             package Devel::MAT::Tool::Symbols 0.49;
7              
8 5     5   3109 use v5.14;
  5         15  
9 5     5   24 use warnings;
  5         20  
  5         130  
10 5     5   23 use base qw( Devel::MAT::Tool );
  5         8  
  5         420  
11              
12 5     5   33 use constant CMD => "symbols";
  5         27  
  5         286  
13 5     5   27 use constant CMD_DESC => "Display a list of the symbol table";
  5         10  
  5         1369  
14              
15             =head1 NAME
16              
17             C - display a list of the symbol table
18              
19             =head1 DESCRIPTION
20              
21             This C tool displays a list names from the symbol table.
22              
23             =cut
24              
25             =head1 COMMANDS
26              
27             =head2 symbols
28              
29             pmat> symbols strict
30             $strict::VERSION
31             &strict::all_bits
32             &strict::all_explicit_bits
33             &strict::bits
34             &strict::import
35             &strict::unimport
36              
37             Prints a list of every name inside a symbol table hash ("stash"), starting
38             from the one given by name, or the toplevel default stash if none is provided.
39              
40             Takes the following named options:
41              
42             =over 4
43              
44             =item --recurse, -R
45              
46             Recursively show the inner symbols inside stashes.
47              
48             =back
49              
50             =cut
51              
52             sub extract_symbols
53             {
54 0     0 0   my ( $stash, $prefix ) = @_;
55              
56 0           my @ret;
57 0           foreach my $key ( sort $stash->keys ) {
58 0           my $gv = $stash->value( $key );
59              
60 0           my $name;
61 0 0         if( $key =~ m/^([\0-\x1f])/ ) {
62 0           $name = "{^" . chr(ord($1)+0x40) . substr( $key, 1 ) . "}";
63             }
64             else {
65 0           $name = $prefix . $key;
66             }
67              
68 0           push @ret, [ $gv, $name ];
69             }
70              
71 0           return @ret;
72             }
73              
74             sub _show_symbol
75             {
76 0     0     my ( $name, $sv ) = @_;
77              
78 0           Devel::MAT::Cmd->printf( "%s at %s\n",
79             Devel::MAT::Cmd->format_symbol( $name, $sv ),
80             Devel::MAT::Cmd->format_sv( $sv ),
81             );
82             }
83              
84 5         382 use constant CMD_OPTS => (
85             recurse => { help => "recursively show inner symbols",
86             alias => "R" },
87 5     5   32 );
  5         9  
88              
89 5         2121 use constant CMD_ARGS => (
90             { name => "start", help => "show symbols within this symbol, rather than %main::" },
91 5     5   31 );
  5         9  
92              
93             sub run
94             {
95 0     0 0   my $self = shift;
96 0           my %opts = %{ +shift };
  0            
97              
98 0           my $df = $self->df;
99              
100 0           my @queue;
101              
102 0 0         if( @_ ) {
103 0           my $name = shift @_;
104 0           @queue = extract_symbols( $self->pmat->find_stash( $name ), $name . "::" );
105             }
106             else {
107             # Don't recurse into self-referential 'main::' symbol
108 0           @queue = grep { $_->[1] ne "main::" }
  0            
109             extract_symbols( $df->defstash, "" );
110              
111             # Also skip the "debug location" symbols, whatever those are
112 0           @queue = grep { $_->[1] !~ m/^_
  0            
113             }
114              
115             Devel::MAT::Tool::more->paginate( sub {
116 0     0     my ( $count ) = @_;
117 0   0       while( $count and @queue ) {
118 0           $_ = shift @queue;
119 0 0 0       if( $_->[0]->isa( "Devel::MAT::SV::GLOB" ) ) {
    0          
120 0           my ( $gv, $name ) = @$_;
121 0 0         _show_symbol( '$' . $name, $gv->scalar ), $count-- if $gv->scalar;
122 0 0         _show_symbol( '@' . $name, $gv->array ), $count-- if $gv->array;
123 0 0         _show_symbol( '%' . $name, $gv->hash ), $count-- if $gv->hash;
124 0 0         _show_symbol( '&' . $name, $gv->code ), $count-- if $gv->code;
125              
126 0 0         unshift @queue, [ $gv->hash, $name ] if $gv->hash;
127             }
128             elsif( $opts{recurse} and $_->[0]->isa( "Devel::MAT::SV::STASH" ) ) {
129 0           my ( $stash, $prefix ) = @$_;
130 0           unshift @queue, extract_symbols( $stash, $prefix );
131             }
132             }
133              
134 0           return !!@queue;
135 0           } );
136             }
137              
138             package Devel::MAT::Tool::Symbols::_packages;
139              
140 5     5   32 use base qw( Devel::MAT::Tool );
  5         11  
  5         446  
141              
142 5     5   46 use constant CMD => "packages";
  5         11  
  5         245  
143 5     5   26 use constant CMD_DESC => "Display a list of the packages in the symbol table";
  5         13  
  5         318  
144              
145             =head2 packages
146              
147             Prints a list of every package name in the symbol table.
148              
149             pmat> packages
150             package CORE at STASH(1) at 0x55cde0f74240
151             package CORE::GLOBAL at STASH(0) at 0x55cde0f74270
152             package Carp at STASH(4) at 0x55cde0fa1508
153             ...
154              
155             Takes the following named options:
156              
157             =over 4
158              
159             =item --versions, -V
160              
161             Include the value of the I<$VERSION> of each package, if relevant.
162              
163             =back
164              
165             =cut
166              
167 5         2135 use constant CMD_OPTS => (
168             versions => { help => "show the \$VERSION of each package",
169             alias => "V" },
170 5     5   30 );
  5         16  
171              
172             sub _versionof
173             {
174 0     0     my ( $stash ) = @_;
175              
176             # TODO: might be nice to have $stash->find_symbol
177 0 0         my $versiongv = $stash->value( 'VERSION' ) or return "";
178 0 0         my $versionsv = $versiongv->scalar or return "";
179              
180 0   0       my $version = $versionsv->pv // $versionsv->nv // $versionsv->uv;
      0        
181 0           return " " . Devel::MAT::Cmd->format_value( $version );
182             }
183              
184             sub run
185             {
186 0     0     my $self = shift;
187 0           my %opts = %{ +shift };
  0            
188              
189             my @queue = grep {
190 0 0         $_->[0]->isa( "Devel::MAT::SV::GLOB" ) and $_->[1] ne "main::"
  0            
191             } Devel::MAT::Tool::Symbols::extract_symbols( $self->df->defstash, "" );
192              
193             Devel::MAT::Tool::more->paginate( sub {
194 0     0     my ( $count ) = @_;
195 0   0       while( $count and @queue ) {
196 0           $_ = shift @queue;
197 0           my ( $gv, $name ) = @$_;
198 0 0         next unless my $stash = $gv->hash;
199 0 0         next unless $stash->isa( "Devel::MAT::SV::STASH" );
200              
201             Devel::MAT::Cmd->printf( "%s %s at %s\n",
202             Devel::MAT::Cmd->format_note( "package" ),
203             Devel::MAT::Cmd->format_symbol( $name =~ s/::$//r, $stash ) .
204 0 0         ( $opts{versions} ? _versionof( $stash ) : "" ),
205             Devel::MAT::Cmd->format_sv( $stash ),
206             );
207 0           $count--;
208              
209             unshift @queue, grep {
210 0           $_->[0]->isa( "Devel::MAT::SV::GLOB" )
  0            
211             } Devel::MAT::Tool::Symbols::extract_symbols( $stash, $name );
212             }
213              
214 0           return !!@queue;
215 0           } );
216             }
217              
218             =head1 AUTHOR
219              
220             Paul Evans
221              
222             =cut
223              
224             0x55AA;