SPUG: Introspective parameters... Can a parameter know it's argument's name from the caller's perspective?

Will Mengarini seldon at eskimo.com
Sat Jun 28 04:54:44 PDT 2008


* Michael R. Wolf <MichaelRWolf at att.net> [2008-06-27 17:22]:
> [...] I'd like to do something like this: [...]
> foreach $variable ($first_name, $last_name, $favorite_language) {
>    debug_blather($variable);
> }
> 
> And get output like this...
> 
> $first_name			(in namespace 'main::') has a value of
> 'Michael'
> [...]

Here's how I do it.  First I'll show the
result, then the code that implements it.

I can code
  eval show qw/$options{c} @foo/ if dbg;
in a script, and get a display of the values of $options{c} and @foo,
each identified by name, if C<dbg> returns true (which depends on whether
there's a -D in the script's invocation).  Another example:
  eval show if dbg 2;
displays $_ if -DD was on the command line.

Eval is used so lexicals work.

Here's the code, brutally ripped from an ancient script.
I haven't done any retesting to be sure it still works.
I think this was developed for Perl 5.6.1.

use Dumpvalue;
sub show (@) { # e.g. C<eval show '$n @n'>; need eval to access lexicals
  # <rant>Even *FORTRAN IV* had this capability (called it NAMELIST)!</rant>
  my $line = (caller)[2];
  my $items = '';
  for my $item( split(' ', @_ ? join(' ', at _) : '$_') ){
    my $funnyChar = substr $item, 0, 1;
    if( $funnyChar eq '$' ){
      $items .= <<"      code";
        print 'line $line $item: ';
        \$show__Object->dumpValue($item);
      code
    }elsif( $funnyChar eq '@' || $funnyChar eq '%' ){
      $items .= <<"      code";
        print 'line $line $item:',\"\\n\";
        \$show__Object->dumpValue(\\$item);
      code
    }elsif( $funnyChar =~ /[~!^&-+=\\|\/]/ ){ # construe as expression
      $items .= <<"      code";
        print 'line $line $item: ',$item,\"\\n\";
      code
    }else{
      $items .= <<"      code";
        print 'line $line $item',\"\\n\";
      code
    }
  }
  chop $items;
  return <<"  code";
    select((
      select(STDERR),
      do {
        my \$show__Object = new Dumpvalue or die;
        local \$\\;\n$items
      }
    )[0]);
  code
}

sub dbg (;$) { # E.g "foo if dbg; bar if dbg 2" means foo if -D, both if -DD
  defined $main::op{D} && $main::op{D} >= ($_[0] || 1)
}

-- 
                 Will Mengarini  <seldon at eskimo.com>
         Free software: the Source will be with you, always.
         perl -le "print eval join '+',unpack 'C*',MENGARINI"


More information about the spug-list mailing list