[Pdx-pm] each within eval

[Marvin Humphrey]

Greets,

Some reference acrobatics I'm doing seem to be causing bizarre behavior 
inside an eval.  I have a $hashref that's ricocheted all over the 
innards of a large object.  There are multiple copies hanging around 
pointing at the same anonymous hash.  That might be where the problem 
originates, though I'm not sure why.

For performance reasons, I'm constructing a tight loop using 
conditionals to build a scalar full of $code to be eval'd.

I can iterate through the key-value pairs in the hash using each, so 
long as I do it inside the main body of the module:

while (my ($k, $v) = each %$hashref) {
	print "$k => $v\n";
}

But if I put that same each loop inside $code and eval it, the loop 
doesn't execute.  each doesn't iterate, and the assignment expression 
returns 0.  Other code works fine inside the eval, I've got strict and 
warnings turned on, and I'm checking $@.

This works inside the eval:

foreach my $k (keys %$hashref) {
	my $v = $hashref->{$k};
	print "$k => $v\n";
}

... But that's not as efficient, and this loop may be executed millions 
of times.  I can also unroll and reroll the hash...

my %copy = %$hashref;
while (my ($k, $v) = each %copy) {
	print "$k => $v\n";
}
... but again, that's wasteful.

When I print Dumper($hashref), it looks normal.

And of course, when I write a sanity check test script to perform the 
same function, it works as expected.  It might take me quite some time 
to write test scripts to isolate the problem.

Any ideas on where I go next to troubleshoot this?

Cheers,

--
Marvin Humphrey
Rectangular Research
http://www.rectangular.com/


### The relevant code, snipped from the module:

### Build a routine for deriving a result set from an undetermined
### number of productions, each of which may be required, negated, or
### neither, and which must be sorted either by accumulated score or
### by date.
### TODO Is it possible to make this less tortured?
my $routine_part1 = q(
     my $merged = { '' => undef };
     while (my ($doc_num, $score_or_timestamp)
         = each %{ $production->{result_set} })
     {
     );
my $routine_part2 = $self->{-sort_by} eq 'timestamp' ?
     q(
     $result_set->{$doc_num} = $score_or_timestamp;)  :
     q(
     $result_set->{$doc_num} += $score_or_timestamp;);
$routine_part2 .= q(
     });

if (%$neglist) {
     $routine_part1 .= q(
         next if exists $neglist->{$doc_num};);
}

if (%$reqlist) {
     $routine_part1 .= q(
         next unless exists $reqlist->{$doc_num};);
}

if (%$reqlist and $production->{required}) {
     $routine_part1 .= q(
         $merged->{$doc_num} = undef;);
     $routine_part2 .= q(
         foreach (keys %$result_set) {
             delete $result_set->{$_} unless exists $merged->{$_};
         }
         $reqlist = $merged;
         $merged = { '' => undef };);
}
elsif ($production->{required}) {
     $routine_part2 .= q(
         $reqlist = $production->{result_set};
         ### Make %$reqlist evaluate to true, even if it contains no
         ### docs -- because if you require a term, and it doesn't exist
         ### in any documents, your query shouldn't return anything.
         $reqlist->{''} = undef;);
}

eval "$routine_part1 $routine_part2";
die $@ if $@;