http://qs1969.pair.com?node_id=705579

The following is my attempt at some benchmarking code for DAGolden's pairwise list-reduction question. I've updated it to include calling as opposed to ‘inlining’ a function; the version called my in my comment is what is called inline_kvmap here.
```use Benchmark qw/cmpthese/;
use List::Util qw/reduce/;

sub kvmap (&@) {
my ( \$f, @kv ) = @_;
my \$key = 0;
local ( \$a, \$b );
return map {
( \$key ^= 1 ) ? do { \$a = \$_; () } : do { \$b = \$_; \$f->(\$a, \$b
+) }
} @kv;
}

my @data = my %data = (
action => 'submit',
type => 'comment',
message => 'Hello'
);

cmpthese -5, {
ex1 => sub {
my @output;
while ( my (\$k,\$v) = splice(@data,0,2) ) {
push @output, "\$k=\$v"
}
join( "&", @output );
},
ex2 => sub {
my @output;
my @copy = @data;
while ( my (\$k,\$v) = splice(@copy,0,2) ) {
push @output, "\$k=\$v"
}
join( "&", @output );
},
ex3 => sub {
my @output;
while ( my (\$k,\$v) = each %data ) {
push @output, "\$k=\$v"
}
join( "&", @output );
},
ex4 => sub {
join "&", map { "\$_->[0]=\$_->[1]" } map { @\$_ } reduce {
! @\$a || ref \$a->[-1] ? push @\$a, \$b : push @\$a, [pop @\$a,
+ \$b]; \$a
} [], @data;
},
ex5 => sub {
join "&", map { @{\$_->[0]} } reduce {
ref \$a->[-1] ? push @\$a, \$b : push @{\$a->[0]}, pop(@\$a) .
+"=\$b"; \$a
} [[]], @data;
},
inline_kvmap => sub {
my \$key = 0;
local ( \$a, \$b );
join '&', map {
( \$key ^= 1 ) ? do { \$a = \$_; () } : do { "\$a=\$_" }
} @data;
},
call_kvmap => sub {
join '&', kvmap { "\$a=\$b" } @data;
}
};

```sub TIESCALAR { bless \my \$o => \$_[0] }
sub STORE { \$_[1] = "Touched by STORE\n" }
tie my \$a => 'main';
my \$b = "Untouched by STORE\n";
\$a = \$b;
print \$b; # => Untouched by STORE
tied(\$a)->STORE(\$b);
print \$b; # => Touched by STORE
When invoked ‘automatically’, does STORE receive as its second argument a copy of the right-hand side of the assignment that invoked it? Is this documented anywhere?
What follows is ancient. I keep it for sentimental value.
hacker asked for a way to walk an arbitrarily nested data structure, stringifying all blessed objects along the way. Here's a stab at it.
```sub walk {
my ( \$ref ) = @_;
return "\$ref" if blessed \$ref;
given ( ref \$ref ) {
when ( '' ) { return \$ref; }
when ( 'ARRAY' ) { return map { walk(\$_) } @\$ref; }
when ( 'HASH' ) { return map { \$_ => walk(\$ref->{\$_}) } keys
+ %\$ref; }
default { carp "I'm confused by \$ref" }
}
}
A more general version would be
```{
my ( \$test, \$modify );
sub walk {
my \$ref;
( \$test, \$modify, \$ref ) = @_;
ref \$modify eq 'CODE' and ref \$test eq 'CODE' or croak 'First 2 a
+rguments must be coderefs';
return _walk(\$ref);
}

sub _walk {
my ( \$ref ) = @_;
return \$modify->(\$ref) if \$test->(\$ref);
given ( ref \$ref ) {
when ( '' ) { return \$ref; }
when ( 'ARRAY' ) { return map { _walk(\$_) } @\$ref; }
when ( 'HASH' ) { return map { \$_ => _walk(\$ref->{\$_}) } key
+s %\$ref; }
default { carp "I'm confused by \$ref" }
}
}
}
You could then get the original functionality by calling walk(sub { blessed \$_[0] }, sub { "\$_[0]" }, \$ref).
Limbic~Region asked an interesting question in the Chatterbox today: If I only get to pass in the regex in \$rx to some code that contains the command
```my ( \$gold ) = \$data =~ /\$rx/
—in particular, if I have no access to \$gold or \$data—then how can I pretend that every occurrence of 'foo' in \$data is actually 'bar'? The following scary regex (which relies on the literal strings 'foo' and 'bar' being of the same length) seems to work, if you're trying to match qr/(bar).*(bar)/:
```qr/(foo).*(foo)(?{ \$_ =~ s+foo+bar+g })/
. In general, one can write something like
```use re 'eval';
my \$rx = qr/\$rx_with_foo(?{ \$_ =~ s+foo+bar+g })/
We happen to be so lucky that we only need re 'eval' to make the regex \$rx—once that's done, we can pass it into the faulty code, which itself need not use re 'eval'.

UPDATE: Oops, the code below works. Now I'm trying to break it again.

I'm trying to understand exactly what kind of object is returned by fields::new. The following code doesn't do what I expect:

```{
package A;
use fields qw/a/;

sub new {
return fields::new(shift);
}

sub legal_keys {
my ( \$self ) = @_;
print \$self, "\n";
return Hash::Util::legal_keys \$self;
}
}

my \$a = A->new;
print \$a->legal_keys, "\n";
print \$a, "\n";
print Hash::Util::legal_keys(\$a), "\n";