История изменений
Исправление 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.
В целом это уже можно улучшать и развивать.