#!/usr/bin/perl

use strict;
use warnings;
use feature qw( say switch );
no if $] >= 5.017011, warnings => 'experimental::smartmatch';

use Devel::MAT;
use List::Util qw( max );

sub show_sv
{
   my $sv = shift;

   say $sv->desc_addr . " with refcount " . $sv->refcnt;
   say "  blessed as " . $sv->blessed->stashname if $sv->blessed;

   my $type = ref $sv; $type =~ s/^Devel::MAT::SV:://;
   given( $type ) {
      when( "GLOB" ) {
         say '  stash=' . $sv->stash->desc_addr if $sv->stash;

         say '  SCALAR=' . $sv->scalar->desc_addr if $sv->scalar;
         say '  ARRAY='  . $sv->array->desc_addr  if $sv->array;
         say '  HASH='   . $sv->hash->desc_addr   if $sv->hash;
         say '  CODE='   . $sv->code->desc_addr   if $sv->code;
         say '  EGV='    . $sv->egv->desc_addr    if $sv->egv;
         say '  IO='     . $sv->io->desc_addr     if $sv->io;
         say '  FORM='   . $sv->form->desc_addr   if $sv->form;
      }
      when( "SCALAR" ) {
         say '  UV=' . $sv->uv if defined $sv->uv;
         say '  IV=' . $sv->iv if defined $sv->iv;
         say '  NV=' . $sv->nv if defined $sv->nv;
         if( defined( my $pv = $sv->pv ) ) {
            say '  PV=' . $pv if length $pv < 40 and $pv !~ m/[\0-\x1f\x80-\x9f]/;
            say '  PVLEN ' . $sv->pvlen;
         }
      }
      when( "REF" ) {
         say '  RV=' . $sv->rv->desc_addr if $sv->rv;
      }
      when( "ARRAY" ) {
         my @elems = $sv->elems;
         say "  [$_]=" . ( $elems[$_] ? $elems[$_]->desc_addr : "NULL" ) for 0 .. $#elems;
      }
      when([ "HASH", "STASH" ]) {
         if( $type eq "STASH" ) {
            say '  stashname=' . $sv->stashname;
         }
         foreach my $key ( sort $sv->keys ) {
            my $v = $sv->value($key);
            say $v ?  "  {$key}=" . $v->desc_addr : "  {$key} undef";
         }
      }
      when( "CODE" ) {
         say $sv->name    ? "  name=" . $sv->name : "  no name";
         say $sv->stash   ? "  stash=" . $sv->stash->desc_addr : "  no stash";
         say $sv->glob    ? "  glob="  . $sv->glob->desc_addr  : "  no glob";
         say                "  location=" . $sv->location;
         say $sv->scope   ? "  scope=" . $sv->scope->desc_addr : "  no scope";
         say $sv->padlist ? "  padlist=" . $sv->padlist->desc_addr : "  no padlist";
         say $sv->padnames ? "  padnames=" . $sv->padnames->desc_addr : "  no padnames";

         my @pads = $sv->pads;
         foreach my $depth ( 0 .. $#pads ) {
            next unless $pads[$depth];
            say "  pad[$depth]=" . $pads[$depth]->desc_addr;
         }

         if( my @globs = $sv->globrefs ) {
            say "Referenced globs:";
            say "  " . join( ", ", map { $_->desc_addr } @globs );
         }
      }
      when( "PADNAMES" ) {
         say $sv->padcv ? "  padcv=" . $sv->padcv->desc_addr : "  no padcv";

         my @elems = $sv->elems;
         # Every PADNAMES element is either NULL or a SCALAR(PV)
         # PADIX 0 is always @_
         foreach my $padix ( 1 .. $#elems ) {
            my $slot = $elems[$padix];
            if( $slot and $slot->type eq "SCALAR" ) {
               say "  [$padix] is " . $slot->pv;
            }
            else {
               say "  [$padix] unused";
            }
         }
      }
      when( "PAD" ) {
         my $padcv = $sv->padcv;
         say $padcv ? "  padcv=" . $padcv->desc_addr : "  no padcv";

         my @elems = $sv->elems;
         my @padnames = map { $padcv->padname( $_ ) } 0 .. $#elems;
         my $maxname = max map { defined $_ ? length $_ : 0 } @padnames;

         my %padtype;
         if( my $gvix = $padcv->{gvix} ) {
            $padtype{$_} = "GLOB" for @$gvix;
         }
         if( my $constix = $padcv->{constix} ) {
            $padtype{$_} = "CONST" for @$constix;
         }

         foreach my $padix ( 1 .. $#elems ) {
            my $padsv = $elems[$padix];
            if( $padnames[$padix] ) {
               printf "  [%3d/%*s]=%s\n", $padix, $maxname, $padnames[$padix],
                  $padsv ? $padsv->desc_addr : "NULL";
            }
            else {
               printf "  [%3d %*s]=%s\n", $padix, $maxname,
                  $padtype{$padix} // "",
                  $padsv ? $padsv->desc_addr : "NULL";
            }
         }
      }
   }
}

my $df = Devel::MAT->load( $ARGV[0] // die "Need dumpfile\n" )->dumpfile;

my $addr = $ARGV[1] // die "Need addr\n";
$addr = $df->defstash->addr if $addr eq "defstash";
$addr = hex $addr if $addr =~ m/^0x/;

my $sv = $df->sv_at( $addr );
$sv or die sprintf "No SV at %#x\n", $addr;

show_sv( $sv );