Ah, I know where you're coming from. When I was new to Perl, I was trying to write exactly such a thing. Just like you I found lexical scoping to be a show-stopper. Years later I learned about a way around that and wrote a utility module
Report.pm, exporting
report() which works much like your proposed
display_init(), except that it doesn't prepend a "
$" to the given items.
Fact of the matter is that I never use it. Inserting normal print/warn/die statements just comes more natural after all this time. The code is essentially the first version that ran, I never bothered to clean it up. Anyway, here it is:
The core module
DB has the property that
eval(), when called from
DB, runs in the lexical context of its caller. That can be used to report values of expressions involving lexical variables in the caller's context.
Report.pm exploits that. It is used like this:
use Report 'report';
my ( $i, $j) = ( 42, 'freeBSD');
my %h = ( one => [ 4, 5, 6], two => 'gaga');
report qw( $i $j $h{one} $h{two} $h{three});
That prints
$i = 42;
$j = 'freeBSD';
$h{one} = [
4,
5,
6
];
$h{two} = 'gaga';
$h{three} = undef;
Here is the module
Report.pm
package Report;
use strict; use warnings; # @^~`
use base 'Exporter';
our @EXPORT = qw( report);
{
# DB evaluates in caller context
package DB;
sub DB::_report_report {
for my $expr ( @_ ) {
print Report::answer( $expr, eval $expr);
}
}
}
*Report::report = \ &DB::_report_report;
use Data::Dumper ();
use Scalar::Util ();
sub answer {
my ( $expr, @val) = @_;
my $ans;
if ( $@ ) {
$ans = "$expr: $@" if $@;
$ans =~ s/ at \(eval .*$//;
} else {
if ( @val == 1 ) {
$ans = answer_scalar( $expr, @val);
} else {
$ans =join ', ' => map answer_scalar( $expr, $_), @val;
$ans = "($ans)";
}
}
$ans;
}
sub answer_scalar {
my ( $expr, $val) = @_;
my $ans;
if ( !defined $val ) {
$ans = "$expr = undef;\n";
} elsif ( ref $val ) {
( $ans = Data::Dumper::Dumper $val) =~ s/\$VAR1\b/$expr/g;
my $indent = ' ' x ( 8 + length( $expr) - length( '$VAR'));
$ans =~ s/^ {8}/$indent/mg;
} elsif (
Scalar::Util::looks_like_number( $val) or
ref( \ $val) eq 'GLOB'
) {
$ans = "$expr = $val;\n";
} else {
$ans = "$expr = '$val';\n";
}
$ans;
}
1;
Anno