Woohoo!

I am able to get the variable name on all but one. It just means that the optree for vec is different than that of substr or pos. I am sure that I'll figure out the last one soon enough.

#!/usr/bin/perl -w
use strict;
use B::Utils qw(opgrep walkallops_filtered);

my $foo = ' delicious';
my $stringy = "abcde";

my %metoo = (
  key => 3,
  foo => $foo,
  string => $stringy,
);

my $lvalue = \(vec($foo,  0, 32) = 0x5065726C);
ltype($lvalue);

$lvalue = \(keys %metoo = 8);
ltype($lvalue);

$lvalue = \(pos $stringy = 3);
ltype($lvalue);

$lvalue = \(pos $stringy = 5);
ltype($lvalue);

$lvalue = \substr($stringy, 2);
ltype($lvalue);

$lvalue = \substr($stringy, 1, 2);
ltype($lvalue);

sub lvalue {
  my $ref = shift;
  my $lref = B::svref_2object($ref);
  return undef if $lref !~ /PVLV/;
  my $value = $$ref;
  my $type = $lref->TYPE;
  my $targ = $lref->TARG;
  my $string = $lref->TARG->PV;
  my $offset = $lref->TARGOFF;
  my $length = $lref->TARGLEN;
  my $func;
  if ($type eq 'k') {
    my $hashname = getname($targ);
    my $val = $targ->MAX;
    ++$val;
    $func = "keys $hashname = $val;";
  }
  if ($type eq 'v') {
    #my $expr = getname($targ);
    $func = "vec('$string',$offset,$length) = $value;";
  }
  if ($type eq 'x') {
    my $expr = getname($targ);
    $func = "substr($expr,".$offset.','.$length.');';
  }
  if ($type eq '.') {
    my $scalar = getname($targ);
    $func = "pos $scalar = ".$value.';';
  }
  return $func;
}

sub ltype {
  my $lvalue = shift;
  print '$$lvalue = ',$$lvalue,"\n";
  print lvalue($lvalue),$/;
  print $/;
}


sub getname {
  my $targ = shift;
  my $class = B::class($targ);
  my $name;

  walkallops_filtered(
    sub {
      my $op = shift;
      
      if ($class =~ /PV/) {
        opgrep( {  name => "padsv",
                   next => {
                     name => [ "pos", "substr" ],
                   },
                 }, $op) or return;
      } elsif ($class =~ /HV/) {
        opgrep( {  name => "padhv",
                   next => {
                     name => "keys",
                   },
                 }, $op) or return;
      }
    },
    sub {
      my $op = shift; 
      my $padname = ((B::main_cv->PADLIST->ARRAY)[0]->ARRAY)[$op->targ
+];
      my $tempname = $padname->PV if $padname;
      return () unless $tempname;
      if ($class =~ /PV/) {
        my $temppv = $targ->PV;
        $name = $tempname if ($temppv eq eval($tempname));
      } elsif ($class =~ /HV/) {
        my %temphash = $targ->ARRAY;
        $name = $tempname if (%temphash eq eval($tempname));
      }
    }
  );
  return $name;
}
[download]

---

---

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

Read Where should I post X? if you're not absolutely sure you're posting in the right place.

Please read these before you post! —

• How do I compose an effective node title?
• How do I post a question effectively?
• Markup in the Monastery

Posts may use any of the Perl Monks Approved HTML tags:

a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr

You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)

	For:		Use:
	&		&
	<		&lt;
	>		&gt;
	[		&#91;
	]		&#93;

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.