Which modern (post-5.10) trickery can be leveraged to make a Data::Dumper::Simple work-alike work?

Question

Several dumpers exist that can show the names of variables without requiring the programmer to explicitely repeat the name.

› perl -MData::Dumper::Simple -e'my $foo = 42; print Dumper($foo)'
$foo = 42;

The trickery is a source filter (breaks often).

› perl -MDDS -e'my $foo = 42; DumpLex $foo'
$foo = 42;

The trickery is PadWalker.

They also work to some extent with variables of other types, but slices or other complex expressions are problematic.

Which modern (post-5.10) trickery can be leveraged to make the following example dumper (as in: data structure viewer, not eval-able code producer) work? The point of emphasis is to always print nice names, to accept multiple expressions, and no need for changing expressions with an extra reference level.

use 5.020; use Syntax::Construct qw(%slice);
use strictures;
use Acme::Hypothetical::Dumper 'd';

my %foo = (
    Me => 'person',
    You => 'beloved one',
    Them => 'space aliens',
);

d %foo, $foo{'Me'}, @foo{qw(You Me)}, %foo{qw(You Me)};
# %foo = ('Me' => 'person', 'Them' => 'space aliens', 'You' => 'beloved one');
# $foo{'Me'} = 'person';
# @foo{qw(You Me)} = ('beloved one', 'person');
# %foo{qw(You Me)} = ('Me' => 'person', 'You' => 'beloved one');

my @bar = qw(Me You Them);

d @bar, $bar[0], @bar[2, 1], %bar[2, 1];
# @bar = ('Me', 'You', 'Them');
# $bar[0] = 'Me';
# @bar[2, 1] = ('Them', 'You');
# %bar[2, 1] = (2 => 'Them', 1 => 'You');

use LWP::UserAgent qw();
my $ua = LWP::UserAgent->new;
d $ua->{ssl_opts}{verify_hostname};
# $ua->{ssl_opts}{verify_hostname} = 1;

Henry

This smells like an XY problem to me. What are you actually trying to accomplish? – Craquelure

How about reading your own source code, much like the error screen of a Mojolicious app does. – Supervene

Isn't that Data::Printer? – Snow

@briandfoy nope, Data::Printer does not know variable names. – Supervene

and what about Data::TreeDumper but I suppose that is just a "newer" Data::Dumper – Syntactics

Yes this feature would be nice to have. I started implementing something like this for Data::Printer using PPI two years ago. Damian has recently come up with a more efficient Perl parser in his PPR module, see Data::Dx. See also Getting all arguments passed to a subroutine as a string in Perl for some other links. – Mollescent

This is similar to this question, but not quite. – Cantle

Best way might be to get subroutine call opcode (using perlapi func caller_cx???), locate the argument opcodes (through standard opcode tree navigation), and somehow pass them to B::Deparse. – Cantle

Answer 1

Whitespace in the output doesn't perfectly match your examples, but this is pretty close...

use v5.14;
use strict;
use warnings;

BEGIN {
    package Acme::Hypothetical::Dumper;
    use Keyword::Simple;
    use PPR;
    use Data::Dumper;
    use B 'perlstring';
    
    sub import {
        my ( $class, $fname ) = ( shift, @_ );
        $fname ||= 'd';
        
        Keyword::Simple::define $fname => sub {
            my $code = shift;
            my ( @ws, @vars, @ws2 );
            while ( $$code =~ / ^ ((?&PerlOWS)) ((?&PerlTerm)) ((?&PerlOWS)) $PPR::GRAMMAR /x ) {
                my $len = length( $1 . $2 . $3 );
                push @ws, $1;
                push @vars, $2;
                push @ws2, $3;
                substr( $$code, 0, $len ) = '';
                $$code =~ s/ ^ (?&PerlComma) $PPR::GRAMMAR //x;
            }
            my $newcode = perlstring( $class ) . '->d(';
            while ( @vars ) {
                my $var = shift @vars;
                $newcode .= sprintf(
                    '%s%s,[%s],%s',
                    shift( @ws ),
                    perlstring( $var ),
                    $var,
                    shift( @ws2 ),
                );
            }
            $newcode .= ');';
            substr( $$code, 0, 0 ) = $newcode;
            return;
        };
    }
    
    our $OUTPUT = \*STDERR;
    
    sub d {
        my ( $class, @args ) = ( shift, @_ );
        while ( @args ) {
            my ( $label, $value ) = splice( @args, 0, 2 );
            
            my $method = 'dump_list';
            if ( $label =~ /^\$/ ) {
                $method = 'dump_scalar';
                $value  = $value->[0];
            }
            elsif ( $label =~ /^\%/ ) {
                $method = 'dump_hash';
            }
            
            printf { $OUTPUT } "%s = %s;\n", $label, $class->$method( $value );
        }
    }
    
    sub dump_scalar {
        my ( $class, $value ) = ( shift, @_ );
        local $Data::Dumper::Terse  = 1;
        local $Data::Dumper::Indent = 0;
        return Dumper( $value );
    }
    
    sub dump_list {
        my ( $class, $value ) = ( shift, @_ );
        my $dumped = $class->dump_scalar( $value );
        $dumped =~ s/\[/(/;
        $dumped =~ s/\]/)/;
        return $dumped;
    }

    sub dump_hash {
        my ( $class, $value ) = ( shift, @_ );
        my $dumped = $class->dump_scalar( { @$value } );
        $dumped =~ s/\{/(/;
        $dumped =~ s/\}/)/;
        return $dumped;
    }

    $INC{'Acme/Hypothetical/Dumper.pm'} = __FILE__;
};

use Acme::Hypothetical::Dumper 'd';

my %foo = (
    Me => 'person',
    You => 'beloved one',
    Them => 'space aliens',
);

d %foo, $foo{'Me'}, @foo{qw(You Me)}, %foo{qw(You Me)};

my @bar = qw(Me You Them);

d @bar, $bar[0], @bar[2, 1], %bar[2, 1];

use LWP::UserAgent qw();
my $ua = LWP::UserAgent->new;

d $ua->{ssl_opts}{verify_hostname};

Vin

PS: if you wonder why I save whitespace into @ws and @ws2 and then carefully insert it back into the generated code, it's because whitespace can include linebreaks, and I'm trying to avoid breaking line numbers in error messages. – Vin