Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

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

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;
like image 612
daxim Avatar asked Sep 29 '17 12:09

daxim


1 Answers

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};
like image 151
tobyink Avatar answered Oct 18 '22 10:10

tobyink