update: Stealing lexicals - best practice suggestions

"rebind the captured lexical variables" is probably better stated as "prepend another symbol-table/hash to the list of searched symbol-table/hashes". This is different to Perl's closure handling and scoping.

Abigail

Update 4. Now implemented at Rebinding closures.

Guts muckery. You have a reference to a CV object which has a pointer to the external lexical scope via PADLIST. Past perl 5.8.x the B module includes a object_2svref which should allow you to turn PADLIST back into a normal array. Now you just substitute in your replacement array assuming you know what parts to edit and with what. Otherwise this is cough easy.

Update 2. Here's some code that does exactly what you asked for. The mutate() function replace the closure's bound value with a random value.

use B qw(class svref_2object);
$\ = "\n";
my $rand = rand;
$bar = sub { print $rand };
while (1) {
    mutate( $bar );
    $bar->();
    sleep 1;
}
sub mutate {
    (svref_2object($_[0])->PADLIST->ARRAY)[1]->object_2svref->[1] = ra
+nd
}
[download]

Update 1. If you can follow this then you're puissant enough to write the code that will replace the bindings to the pad variables. My thought is that it'd be neat to take a list of pairs of strings/regex and replacement regexes. That way you could examine the list of current variable names, if you had an exact match or a regex match against ->PADLIST->ARRAY->[0][$ix] then you replace the reference in ->PADLIST->ARRAY->[1][$ix].

use B qw(class svref_2object);
use Data::Dumper;

@a = map {
    my $k = rand;
    sub { print $k }
    }
    0, 1;
@a =
    map
        map( [ map +( class($_) ne 'SPECIAL'
                      ? $_->object_2svref
                      : $_ ),
                   $_->ARRAY ],
             svref_2object($_)->PADLIST->ARRAY ),
    @a;

print Dumper( @a );
[download]

Results in:

$VAR1 = [
          bless( do{\(my $o = 1)}, 'B::SPECIAL' ),
          \'$k'
        ];
$VAR2 = [
          [],
          \'0.681204496723698'
        ];
$VAR3 = [
          bless( do{\(my $o = 1)}, 'B::SPECIAL' ),
          $VAR1->[1]
        ];
$VAR4 = [
          [],
          \'0.716383141555951'
        ];
[download]

Is there a way to do this or something similar in Perl?

Not to the best of my knowledge. Perl doesn't have the concept of the "scope" objects in JavaScript. With the odd way that block scoped lexicals are handled I think it would be tricky to add/fake one (although I'm not an expert on the Perl internals so I could be wrong there).

Is this just a curiosity question or do you have a goal in mind? If so it might be useful to describe what you're trying to do since there is almost certainly way of doing it that doesn't involve rebinding closures :-)

Is this just a curiosity question or do you have a goal in mind?

Just curiousity. Reading about Javascript, I tried to translate the idea to Perl. There's been moments when I thought it would be a good idea, but I've invariably been wrong.

Re: "scope objects", the nearest Perl equivalent would be "local". If you were to put a localizing wrapper around a sub that used global names you'd be getting close to what JavaScript 1.2 does (I guess). But then the sub isn't a proper closure, the process is manual and any another subs called would also get the dynamic scope.

If however you are not asking about the general case, but already know at closure creation time you will need this, you can return both the target closure and an updater closure:

#!/usr/bin/perl -wl
sub gen_counter {
    my $a = shift;
    return sub { ++$a }, sub { $a = shift };
}

my ($counter, $modifier) = gen_counter(3);
print $counter->();
print $counter->();

$modifier->(8);

print $counter->();
print $counter->();

# which prints:
4
5
9
10
[download]

#!/usr/bin/perl -wl
sub gen_counter {
    my $a = shift;
    return sub { @_ ? $a = shift : ++$a };
}

my $counter = gen_counter(3);
print $counter->();
print $counter->();
$counter->(8);
print $counter->();
print $counter->();
[download]

update:I realize my answer tells how to modify a closure, not how to clone it as was asked. For cloning I'd just call the generator again. This is cheap since all generated closures share the code, only the sets of lexicals differ. Or even combine the two (calling the generator as a special closure operation), getting something like:

sub gen_closure {
    my ($a, $b, $c) = @_;
    return sub {
        if ($some_trigger) {
            # Calculate new $a, $b, $c based on e.g. the
            # new @_ and the old $a, $b and $c. 
            return gen_closure($new_a, $new_b, $new_c);
        }
        # Do the normal closure action on $a, $b and $c here
     }
}
[download]

my $code = q{
   # some generic sub
   my ($param1,$param2) = @_;

   do_stuff($param1);
   do_more_stuff($param2);

   return whatever_you_return_from($param1,$param2);
};

# ...

my $closure_to_this_scope = eval "sub {$code}";

# ...

my $closure_to_this_other_scope = eval "sub {$code}";
[download]

------------
:Wq
Not an editor command: Wq
[download]

... # some scope
# pass coderef, returns coderef rebound to this scope
*rebind_here = sub {
   use B::Deparse ();
   ref $_[0] eq "CODE" or die "expected coderef";
   eval("sub ".B::Deparse->new->coderef2text($_[0]));
}
... # some other scope
$new_coderef = &rebind_here($old_coderef);
[download]

Also note that closed lexicals in the original sub may become globals and vice versa if the lexical environment isn't the same.

Update: hmm. negative votes. Perhaps it would help if I noted that you may wish to make sure certain lexicals are still available by adding ($x,$y,$z) if 0; after the use B::Deparse line.