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;
    }
};

##</code><code>##

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

##</code><code>##

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" }
     }
}

##</code><code>##

{
my ( $test, $modify );
sub walk {
     my $ref;
     ( $test, $modify, $ref ) = @_;
     ref $modify eq 'CODE' and ref $test eq 'CODE' or croak 'First 2 arguments 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->{$_}) } keys %$ref; }
          default { carp "I'm confused by $ref" }
     }
}
}

##</code><code>##

my ( $gold ) = $data =~ /$rx/

##</code><code>##

qr/(foo).*(foo)(?{ $_ =~ s+foo+bar+g })/

##</code><code>##

use re 'eval';
my $rx = qr/$rx_with_foo(?{ $_ =~ s+foo+bar+g })/

##</code><code>##

{
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";