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-2020 -- leonerd@leonerd.org.uk 5 6package Devel::MAT::Tool::Show 0.44; 7 8use v5.14; 9use warnings; 10use base qw( Devel::MAT::Tool ); 11 12use List::Util qw( max ); 13 14use constant CMD => "show"; 15use constant CMD_DESC => "Show information about a given SV"; 16 17use constant CMD_OPTS => ( 18 full_pv => { help => "show the full captured PV", 19 alias => "F" }, 20 pad => { help => "show the first PAD of a CODE", 21 alias => "P" }, 22); 23 24=head1 NAME 25 26C<Devel::MAT::Tool::Show> - show information about a given SV 27 28=head1 DESCRIPTION 29 30This C<Devel::MAT> tool provides a command that prints interesting information 31from within an SV. Its exact output will depend on the type of SV it is 32applied to. 33 34=cut 35 36=head1 COMMANDS 37 38=cut 39 40=head2 show 41 42 pmat> show 0x1bbf598 43 IO() at 0x1bbf598 with refcount 2 44 blessed as IO::File 45 ifileno=2 46 ofileno=2 47 48Prints information about the given SV. 49 50=cut 51 52use constant CMD_ARGS_SV => 1; 53 54sub run 55{ 56 my $self = shift; 57 my %opts = %{ +shift }; 58 my ( $sv ) = @_; 59 60 Devel::MAT::Cmd->printf( "%s with refcount %d\n", 61 Devel::MAT::Cmd->format_sv( $sv ), 62 $sv->refcnt, 63 ); 64 65 my $size = $sv->size; 66 if( $size < 1024 ) { 67 Devel::MAT::Cmd->printf( " size %d bytes\n", 68 $size, 69 ); 70 } 71 else { 72 Devel::MAT::Cmd->printf( " size %s (%d bytes)\n", 73 Devel::MAT::Cmd->format_bytes( $size ), 74 $size, 75 ); 76 } 77 78 if( my $stash = $sv->blessed ) { 79 Devel::MAT::Cmd->printf( " blessed as %s\n", $stash->stashname ); 80 } 81 82 if( my $symname = $sv->symname ) { 83 Devel::MAT::Cmd->printf( " named as %s\n", 84 Devel::MAT::Cmd->format_symbol( $symname ) 85 ); 86 } 87 88 foreach my $magic ( $sv->magic ) { 89 my $type = $magic->type; 90 $type = "^" . chr( 0x40 + ord $type ) if ord $type < 0x20; 91 92 Devel::MAT::Cmd->printf( " has %s magic", 93 Devel::MAT::Cmd->format_note( $type, 1 ), 94 ); 95 96 Devel::MAT::Cmd->printf( " with object at %s", 97 Devel::MAT::Cmd->format_sv( $magic->obj ) 98 ) if $magic->obj; 99 100 Devel::MAT::Cmd->printf( " with pointer at %s", 101 Devel::MAT::Cmd->format_sv( $magic->ptr ) 102 ) if $magic->ptr; 103 104 Devel::MAT::Cmd->printf( "\n" ); 105 } 106 107 if( defined( my $serial = $sv->debug_serial ) ) { 108 Devel::MAT::Cmd->printf( " debug serial %d\n", $serial ); 109 110 my $file = $sv->debug_file; 111 Devel::MAT::Cmd->printf( " created at %s:%d\n", $file, $sv->debug_line ) 112 if defined $file; 113 } 114 115 my $type = ref $sv; $type =~ s/^Devel::MAT::SV:://; 116 my $method = "show_$type"; 117 $self->$method( $sv, \%opts ); 118} 119 120sub say_with_sv 121{ 122 my ( $str, @args ) = @_; 123 my $sv = pop @args; 124 125 Devel::MAT::Cmd->printf( $str . "%s\n", 126 @args, 127 Devel::MAT::Cmd->format_sv( $sv ), 128 ); 129} 130 131sub show_GLOB 132{ 133 my $self = shift; 134 my ( $gv ) = @_; 135 136 Devel::MAT::Cmd->printf( " name=%s\n", $gv->name ) if $gv->name; 137 138 say_with_sv ' stash=', $gv->stash if $gv->stash; 139 140 say_with_sv ' SCALAR=', $gv->scalar if $gv->scalar; 141 say_with_sv ' ARRAY=', $gv->array if $gv->array; 142 say_with_sv ' HASH=', $gv->hash if $gv->hash; 143 say_with_sv ' CODE=', $gv->code if $gv->code; 144 say_with_sv ' EGV=', $gv->egv if $gv->egv; 145 say_with_sv ' IO=', $gv->io if $gv->io; 146 say_with_sv ' FORM=', $gv->form if $gv->form; 147} 148 149sub show_SCALAR 150{ 151 my $self = shift; 152 my ( $sv, $opts ) = @_; 153 154 Devel::MAT::Cmd->printf( " UV=%s\n", 155 Devel::MAT::Cmd->format_value( $sv->uv, nv => 1 ), 156 ) if defined $sv->uv; 157 Devel::MAT::Cmd->printf( " IV=%s\n", 158 Devel::MAT::Cmd->format_value( $sv->iv, nv => 1 ), 159 ) if defined $sv->iv; 160 Devel::MAT::Cmd->printf( " NV=%s\n", 161 Devel::MAT::Cmd->format_value( $sv->nv, nv => 1 ), 162 ) if defined $sv->nv; 163 164 if( defined( my $pv = $sv->pv ) ) { 165 Devel::MAT::Cmd->printf( " PV=%s\n", 166 Devel::MAT::Cmd->format_value( $pv, pv => 1, 167 ( $opts->{full_pv} ? ( maxlen => 0 ) : () ), 168 ), 169 ); 170 Devel::MAT::Cmd->printf( " PVLEN %d\n", $sv->pvlen ); 171 } 172} 173 174sub show_REF 175{ 176 my $self = shift; 177 my ( $sv ) = @_; 178 179 say_with_sv ' RV=', $sv->rv if $sv->rv; 180} 181 182sub show_ARRAY 183{ 184 my $self = shift; 185 my ( $av ) = @_; 186 187 Devel::MAT::Cmd->printf( " %d elements (use 'elems' command to show)\n", 188 $av->n_elems, 189 ); 190} 191 192sub show_STASH 193{ 194 my $self = shift; 195 my ( $hv ) = @_; 196 197 Devel::MAT::Cmd->printf( " stashname=%s\n", $hv->stashname ); 198 $self->show_HASH( $hv ); 199} 200 201sub show_HASH 202{ 203 my $self = shift; 204 my ( $hv ) = @_; 205 206 Devel::MAT::Cmd->printf( " %d values (use 'values' command to show)\n", 207 $hv->n_values, 208 ); 209} 210 211sub show_CODE 212{ 213 my $self = shift; 214 my ( $cv, $opts ) = @_; 215 216 $cv->hekname ? Devel::MAT::Cmd->printf( " hekname=%s\n", $cv->hekname ) 217 : Devel::MAT::Cmd->printf( " no hekname\n" ); 218 219 $cv->stash ? say_with_sv( " stash=", $cv->stash ) 220 : Devel::MAT::Cmd->printf( " no stash\n" ); 221 222 $cv->glob ? say_with_sv( " glob=", $cv->glob ) 223 : Devel::MAT::Cmd->printf( " no glob\n" ); 224 225 $cv->location ? Devel::MAT::Cmd->printf( " location=%s\n", $cv->location ) 226 : Devel::MAT::Cmd->printf( " no location\n" ); 227 228 $cv->scope ? say_with_sv( " scope=", $cv->scope ) 229 : Devel::MAT::Cmd->printf( " no scope\n" ); 230 231 $cv->padlist ? say_with_sv( " padlist=", $cv->padlist ) 232 : (); 233 234 $cv->padnames_av ? say_with_sv( " padnames_av=", $cv->padnames_av ) 235 : (); 236 237 $cv->protosub ? say_with_sv( " protosub=", $cv->protosub ) 238 : (); 239 240 my @pads = $cv->pads; 241 foreach my $depth ( 0 .. $#pads ) { 242 next unless $pads[$depth]; 243 say_with_sv( " pad[$depth]=", $pads[$depth] ); 244 } 245 246 if( $opts->{pad} and my $pad0 = ( $cv->pads )[0] ) { 247 Devel::MAT::Cmd->printf( "PAD[0]:\n" ); 248 $self->show_PAD_contents( $pad0 ); 249 } 250 251 if( my @globs = $cv->globrefs ) { 252 Devel::MAT::Cmd->printf( "Referenced globs:\n " ); 253 Devel::MAT::Cmd->printf( "%s, ", Devel::MAT::Cmd->format_sv( $_ ) ) for @globs; 254 Devel::MAT::Cmd->printf( "\n" ); 255 } 256} 257 258sub show_PAD 259{ 260 my $self = shift; 261 my ( $pad ) = @_; 262 263 my $padcv = $pad->padcv; 264 $padcv ? say_with_sv( " padcv=", $padcv ) 265 : Devel::MAT::Cmd->printf( " no padcv\n" ); 266 267 $self->show_PAD_contents( $pad ); 268} 269 270sub _join 271{ 272 # Like CORE::join but respects string concat operator 273 my ( $sep, @elems ) = @_; 274 my $ret = shift @elems; 275 $ret = $ret . $sep . $_ for @elems; 276 return $ret; 277} 278 279sub show_PAD_contents 280{ 281 my $self = shift; 282 my ( $pad ) = @_; 283 284 my $padcv = $pad->padcv; 285 286 my @elems = $pad->elems; 287 my @padnames = map { 288 my $padname = $padcv->padname( $_ ); 289 # is_outer is always set for is_our; it's only interesting without is_our 290 my $is_just_outer = $padname && $padname->is_outer && !$padname->is_our; 291 292 $padname ? _join( " ", 293 ( $padname->is_state ? Devel::MAT::Cmd->format_note( "state" ) : () ), 294 ( $padname->is_our ? Devel::MAT::Cmd->format_note( "our" ) : () ), 295 Devel::MAT::Cmd->format_note( $padname->name, 1 ), 296 ( $is_just_outer ? Devel::MAT::Cmd->format_note( "*OUTER", 2 ) : () ), 297 # is_typed and is_lvalue not indicated 298 ) : undef 299 } 0 .. $#elems; 300 my $idxlen = length $#elems; 301 my $namelen = max map { defined $_ ? length $_ : 0 } @padnames; 302 303 my %padtype; 304 if( my $gvix = $padcv->{gvix} ) { 305 $padtype{$_} = "GLOB" for @$gvix; 306 } 307 if( my $constix = $padcv->{constix} ) { 308 $padtype{$_} = "CONST" for @$constix; 309 } 310 311 Devel::MAT::Cmd->printf( " [%*d/%-*s]=%s\n", 312 $idxlen, 0, 313 $namelen, Devel::MAT::Cmd->format_note( '@_', 1 ), 314 ( $elems[0] ? Devel::MAT::Cmd->format_sv_with_value( $elems[0] ) : "NULL" ), 315 ); 316 317 foreach my $padix ( 1 .. $#elems ) { 318 my $sv = $elems[$padix]; 319 if( $padnames[$padix] ) { 320 Devel::MAT::Cmd->printf( " [%*d/%-*s]=%s\n", 321 $idxlen, $padix, 322 $namelen, $padnames[$padix], 323 ( $sv ? Devel::MAT::Cmd->format_sv_with_value( $sv ) : "NULL" ), 324 ); 325 } 326 else { 327 Devel::MAT::Cmd->printf( " [%*d %-*s]=%s\n", 328 $idxlen, $padix, 329 $namelen, $padtype{$padix} // "", 330 ( $sv ? Devel::MAT::Cmd->format_sv( $sv ) : "NULL" ), 331 ); 332 } 333 } 334} 335 336# TODO: PADLIST 337 338sub show_PADNAMES 339{ 340 my $self = shift; 341 my ( $padnames ) = @_; 342 343 $padnames->padcv ? say_with_sv( " padcv=", $padnames->padcv ) 344 : Devel::MAT::Cmd->printf( " no padcv\n" ); 345 346 my @elems = $padnames->elems; 347 # Every PADNAMES element is either NULL or a SCALAR(PV) 348 # PADIX 0 is always @_ 349 foreach my $padix ( 1 .. $#elems ) { 350 my $slot = $elems[$padix]; 351 if( $slot and $slot->type eq "SCALAR" ) { 352 Devel::MAT::Cmd->printf( " [%d] is %s\n", $padix, Devel::MAT::Cmd->format_note( $slot->pv, 1 ) ); 353 } 354 } 355} 356 357sub show_IO 358{ 359 my $self = shift; 360 my ( $io ) = @_; 361 362 Devel::MAT::Cmd->printf( " ifileno=%d\n", $io->ifileno ) if defined $io->ifileno; 363 Devel::MAT::Cmd->printf( " ofileno=%d\n", $io->ofileno ) if defined $io->ofileno; 364} 365 366package # hide 367 Devel::MAT::Tool::Show::_elems; 368use base qw( Devel::MAT::Tool ); 369 370use List::Util qw( min ); 371 372use constant CMD => "elems"; 373use constant CMD_DESC => "List the elements of an ARRAY SV"; 374 375=head2 elems 376 377 pmat> elems endav 378 [0] CODE(PP) at 0x562e93222dc8 379 380Prints elements of an ARRAY SV. 381 382Takes the following named options: 383 384=over 4 385 386=item --count, -c MAX 387 388Show at most this number of elements (default 50). 389 390=back 391 392Takes the following positional arguments: 393 394=over 4 395 396=item * 397 398Optional start index (default 0). 399 400=back 401 402=cut 403 404use constant CMD_OPTS => ( 405 count => { help => "maximum count of elements to print", 406 type => "i", 407 alias => "c", 408 default => 50 }, 409); 410 411use constant CMD_ARGS_SV => 1; 412use constant CMD_ARGS => ( 413 { name => "startidx", help => "starting index" }, 414); 415 416sub run 417{ 418 my $self = shift; 419 my %opts = %{ +shift }; 420 my ( $av, $startidx ) = @_; 421 422 my $type = $av->type; 423 if( $type eq "HASH" or $type eq "STASH" ) { 424 die "Cannot 'elems' of a $type - maybe you wanted 'values'?\n"; 425 } 426 elsif( $type ne "ARRAY" ) { 427 die "Cannot 'elems' of a non-ARRAY\n"; 428 } 429 430 $startidx //= 0; 431 my $stopidx = min( $startidx + $opts{count}, $av->n_elems ); 432 433 my @rows; 434 foreach my $idx ( $startidx .. $stopidx-1 ) { 435 my $sv = $av->elem( $idx ); 436 push @rows, [ 437 Devel::MAT::Cmd->format_value( $idx, index => 1 ), 438 $sv ? Devel::MAT::Cmd->format_sv_with_value( $sv ) : "NULL", 439 ]; 440 } 441 442 Devel::MAT::Cmd->print_table( \@rows, indent => 2 ); 443 444 my $morecount = $av->n_elems - $stopidx; 445 Devel::MAT::Cmd->printf( " ... (%d more)\n", $morecount ) if $morecount; 446} 447 448package # hide 449 Devel::MAT::Tool::Show::_values; 450use base qw( Devel::MAT::Tool ); 451 452use constant CMD => "values"; 453use constant CMD_DESC => "List the values of a HASH-like SV"; 454 455=head2 values 456 457 pmat> values defstash 458 {"\b"} GLOB($%*) at 0x562e93114eb8 459 {"\017"} GLOB($*) at 0x562e9315a428 460 ... 461 462Prints values of a HASH or STASH SV. 463 464Takes the following named options: 465 466=over 4 467 468=item --count, -c MAX 469 470Show at most this number of values (default 50). 471 472=back 473 474Takes the following positional arguments: 475 476=over 4 477 478=item * 479 480Optional skip count (default 0). If present, will skip over this number of 481keys initially to show more of them. 482 483=back 484 485=cut 486 487use constant CMD_OPTS => ( 488 count => { help => "maximum count of values to print", 489 type => "i", 490 alias => "c", 491 default => 50 }, 492); 493 494use constant CMD_ARGS_SV => 1; 495use constant CMD_ARGS => ( 496 { name => "skipcount", help => "skip over this many keys initially" }, 497); 498 499sub run 500{ 501 my $self = shift; 502 my %opts = %{ +shift }; 503 my ( $hv, $skipcount ) = @_; 504 505 my $type = $hv->type; 506 if( $type eq "ARRAY" ) { 507 die "Cannot 'values' of a $type - maybe you wanted 'elems'?\n"; 508 } 509 elsif( $type ne "HASH" and $type ne "STASH" ) { 510 die "Cannot 'elems' of a non-HASHlike\n"; 511 } 512 513 # TODO: control of sorting, start at, filtering 514 my @keys = sort $hv->keys; 515 splice @keys, 0, $skipcount if $skipcount; 516 517 Devel::MAT::Tool::more->paginate( { pagesize => $opts{count} }, sub { 518 my ( $count ) = @_; 519 my @rows; 520 foreach my $key ( splice @keys, 0, $count ) { 521 my $sv = $hv->value( $key ); 522 push @rows, [ 523 Devel::MAT::Cmd->format_value( $key, key => 1, 524 stash => ( $type eq "STASH" ) ), 525 $sv ? Devel::MAT::Cmd->format_sv_with_value( $sv ) : "NULL", 526 ]; 527 } 528 529 Devel::MAT::Cmd->print_table( \@rows, indent => 2 ); 530 531 my $morecount = @keys; 532 Devel::MAT::Cmd->printf( " ... (%d more)\n", $morecount ) if $morecount; 533 return $morecount; 534 } ); 535} 536 537=head1 AUTHOR 538 539Paul Evans <leonerd@leonerd.org.uk> 540 541=cut 542 5430x55AA; 544