【问题标题】:Which modern (post-5.10) trickery can be leveraged to make a Data::Dumper::Simple work-alike work?可以利用哪种现代(5.10 后)技巧来制作 Data::Dumper::Simple 类似工作的工作?
【发布时间】:2017-09-29 12:37:13
【问题描述】:

有几个转储程序可以显示变量的名称,而无需程序员明确地重复名称。

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

诡计是源过滤器(经常中断)。

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

诡计是PadWalker

它们在某种程度上也适用于其他类型的变量,但切片或其他复杂的表达式是有问题的。

可以利用哪种现代(5.10 后)技巧来使以下示例转储程序(如:数据结构查看器,而不是 eval-able 代码生成器)工作?重点是始终打印好名称,接受多个表达式,并且无需使用额外的引用级别更改表达式。

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;

【问题讨论】:

  • 这对我来说就像一个 XY 问题。你到底想完成什么?
  • 如何阅读自己的源代码,就像 Mojolicious 应用程序的错误屏幕一样。
  • 那不是Data::Printer吗?
  • @briandfoy nope,Data::Printer 不知道变量名。
  • 是的,如果有这个功能就好了。我在两年前使用PPI started implementingData::Printer 做类似的事情。 Damian 最近在他的 PPR 模块中提出了一个更高效的 Perl 解析器,请参阅 Data::Dx。另请参阅 Getting all arguments passed to a subroutine as a string in Perl 了解其他链接。

标签: perl metaprogramming


【解决方案1】:

输出中的空格与您的示例不完全匹配,但这非常接近...

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};

【讨论】:

  • PS:如果你想知道为什么我将空格保存到@ws@ws2 然后小心地将其插入到生成的代码中,这是因为空格可以包含换行符,我试图避免错误消息中的断行号。
猜你喜欢
  • 2011-06-04
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 1970-01-01
  • 2011-02-05
相关资源
最近更新 更多