LINUX.ORG.RU

История изменений

Исправление Olegymous, (текущая версия) :

Там про uninitialized warning и не совсем подошло. Но что-то я подчерпнул оттуда и набросал вот такой весьма хрупкий костыль:

use strict;
use Data::Dumper;
use B::Deparse;
use PPI::Tokenizer;

$SIG{__DIE__} = sub {
    my ($err) = @_;
    my ($file,$line) = (caller(0))[1,2];
    my $subname      = (caller(1))[3];

    my ($before_code, $problem_code) = split_code( $subname, $file, $line, $err );

    my $tokenizer = PPI::Tokenizer->new( \$problem_code );

    my @problem_variables;
    my ( $start_braces, $end_braces );

    while ( my $token = $tokenizer->get_token ) {
        if ( $start_braces == $end_braces && index($token, '$') == 0 ) {
            push @problem_variables, $token;
            next;
        }

        if (index($token, '$') == 0) {
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $token eq '{' ) {
            $start_braces++;
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $token eq '}' ) {
            $end_braces++;
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $start_braces != $end_braces ) {
            $problem_variables[-1] .= $token;
        }
    }

    for my $var (@problem_variables) {
        $before_code .= qq!\neval { my \$t = $var; 1 } or warn q~has problems with $var~, "\\n";!;
    }

    $before_code .= "}";
    eval $before_code or die $@;
};

sub split_code {
    my ($name, $file, $line, $err) =@_;

    my $subref = \&{$name};

    my $subbody = B::Deparse->new('-q','-l','-x0')->coderef2text($subref);

    my $start = "#line \Q$line\E \"\Q$file\E\"\n";
    my $end   = "\n(#line|})";

    my ($before, $problem) =
      $subbody =~ m/^(.+?)$start\s+(.*?);$end/s;

    return ($before, $problem);
}

sub test {
    my %a = (
        a => 12,
        b => '',
        x => { z => 22 },
        l => 'sd'
    );

    my %c = (
        f => 'test',
        b => $a{b}{c},
        g => $a{a},
        d => $a{x}{z},
    );
}

test();

Результат теперь такой:

has problems with $a{'b'}{'c'}
Can't use string ("") as a HASH ref while "strict refs" in use at /tmp/t.pl line 83.

В целом это уже можно улучшать и развивать.

Исходная версия Olegymous, :

Там про uninitialized warning и не совсем подошло. Но что-то я подчерпнул оттуда и набросал вот такой весьма хрупкий костыль:

use strict;
use Data::Dumper;
use B::Deparse;
use PPI::Tokenizer;

$SIG{__DIE__} = sub {
    my ($err) = @_;
    my ($file,$line) = (caller(0))[1,2];
    my $subname      = (caller(1))[3];

    my ($before_code, $problem_code) = split_code( $subname, $file, $line, $err );

    my $tokenizer = PPI::Tokenizer->new( \$problem_code );

    my @problem_variables;
    my ( $start_braces, $end_braces );

    while ( my $token = $tokenizer->get_token ) {
        if ( $start_braces == $end_braces && index($token, '$') == 0 ) {
            push @problem_variables, $token;
            next;
        }

        if (index($token, '$') == 0) {
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $token eq '{' ) {
            $start_braces++;
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $token eq '}' ) {
            $end_braces++;
            $problem_variables[-1] .= $token;
            next;
        }

        if ( $start_braces != $end_braces ) {
            $problem_variables[-1] .= $token;
        }
    }

    for my $var (@problem_variables) {
        $before_code .= qq!\neval { my \$t = $var; 1 } or warn q~has problems with $var~, "\\n";!;
    }

    $before_code .= "}";
    eval $before_code or die $@;
};

sub split_code {
    my ($name, $file, $line, $err) =@_;

    my $subref = \&{$name};

    my $subbody = B::Deparse->new('-q','-l','-x0')->coderef2text($subref);

    my $start = "#line \Q$line\E \"\Q$file\E\"\n";
    my $end   = "\n(#line|})";

    my ($before, $problem) =
      $subbody =~ m/^(.+?)$start\s+(.*?);$end/s;

    return ($before, $problem);
}

sub test {
    my %a = (
        a => 12,
        b => '',
        x => { z => 22 },
        l => 'sd'
    );

    my %c = (
        f => 'test',
        b => $a{b}{c},
        g => $a{a},
        d => $a{x}{z},
    );
}

test();

Результат теперь такой:

has problems with $a{'b'}{'c'}
Can't use string ("") as a HASH ref while "strict refs" in use at /tmp/t.pl line 83.

В целом это уже можно улучшать и развивать.