Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
use strict;
use warnings;
use Test::More;
# lvalue method
{
package Foo;
sub new { bless {}, shift }
sub attr :lvalue { $_[0]->{bar} }
}
{
my $f = Foo->new;
$f->attr = 5;
is $f->attr, 5;
}
# wrapping an lvalue method, adding an after
#
# We can take a reference to the inner sub return value, call our afters, then
# return a dereference of the the stored reference (reftype LVALUE). This will
# propogate changes to the wrapped sub's return.
{
package Foo;
sub after { $_[0]->{after} }
sub attr_wrap :lvalue {
my $self = shift;
my $ret = \($self->attr);
$self->{after}++;
$$ret;
}
}
{
my $f = Foo->new;
$f->attr_wrap = 5;
is $f->attr, 5;
is $f->after, 1;
}
# array lvalue method
{
package Bar;
sub new { bless {}, shift }
sub attr :lvalue {
my $self = shift;
@{$self->{attr} ||= []};
}
sub attr_as_list :lvalue {
my $self = shift;
$self->{attr} ||= [];
($self->{attr}[0], $self->{attr}[1]);
}
}
{
my $f = Bar->new;
($f->attr) = (1, 2);
is_deeply [$f->attr], [1, 2];
($f->attr_as_list) = (3, 4);
is_deeply [$f->attr], [3, 4];
}
# wrapping an array lvalue method, adding an after
{
package Bar;
sub after { $_[0]->{after} }
sub attr_wrap :lvalue {
my $self = shift;
# no answer that works consistently for any inner method
#my $ret = \($self->attr); # ref to last entry
#my $ret = \($self->attr_as_list); # ref to last entry
#my @ret = \($self->attr); # nothing
my @ret = \($self->attr_as_list); # ref to each working
$self->{after}++;
# have to hard code number of elements. not generalizable.
(${$ret[0]}, ${$ret[1]});
}
}
{
my $f = Bar->new;
($f->attr_wrap) = (1, 2);
is_deeply [$f->attr], [1, 2];
is $f->after, 1;
}
# wrapping an array lvalue method using a tie hack, adding an after
#
# taking a reference to an array lvalue method doesn't work. this is what
# necessitates this implementation, but also means we don't need most of what
# would be needed for most ties. Also, the array will be destroyed immediately
# after the assignment or read.
#
# When a read operation is being performed, we can run the wrapped sub directly,
# storing its result in the tied hash. Then the afters can be run, and the
# appropriate result returned for the operation.
#
# When a lvalue write is being performed, it calls CLEAR, then EXTEND, then does
# multiple STOREs. If an empty list is assigned, no EXTEND or STOREs are
# performed. Because of this, the only reliable opportunity we will have to run
# the wrapped sub is by being DESTROYed. Assignment of the full array is the
# only operation supported by perl for lvalue subs, so we don't need to
# implement PUSH, POP, UNSHIFT, SHIFT, SPLICE, EXISTS, or DELETE.
{
package LvalueArray;
sub TIEARRAY {
my ($class, $sub, $params, $afters) = @_;
my $self = bless [ $sub, $params, $afters ], $class;
}
sub STORE {
$_[0]->[4][$_[1]] = $_[2];
}
sub CLEAR {
$_[0]->[4] = [];
}
sub EXTEND {
$#{$_[0]->[4]} = $_[1]-1;
}
sub FETCH {
$_[0]->run;
$_[0]->[3][$_[1]];
}
sub FETCHSIZE {
$_[0]->run;
scalar @{$_[0]->[3]};
}
sub run {
my ($sub, $params, $afters, $result, $store) = @{$_[0]};
return if $result;
if ($store) {
$_[0]->[3] = [($sub->(@$params)) = @$store];
}
else {
$_[0]->[3] = [($sub->(@$params))];
}
for my $after (@$afters) {
$after->(@$params);
}
}
sub DESTROY {
$_[0]->run;
}
}
{
package Bar;
sub attr_wrap_tie :lvalue {
tie my @array, 'LvalueArray', \&attr, \@_, [sub { $_[0]->{after}++ }];
@array;
}
sub attr_as_list_wrap_tie :lvalue {
tie my @array, 'LvalueArray', \&attr_as_list, \@_, [sub { $_[0]->{after}++ }];
@array;
}
}
{
my $f = Bar->new;
($f->attr_wrap_tie) = (1, 2);
is_deeply [$f->attr], [1, 2];
is $f->after, 1;
my $out = [($f->attr_as_list_wrap_tie) = (3, 4)];
is_deeply [$f->attr], [3, 4];
is $f->after, 2;
is_deeply $out, [3, 4];
$out = [$f->attr_wrap_tie];
is_deeply $out, [3, 4];
is $f->after, 3;
$out = [($f->attr_wrap_tie) = ()];
is_deeply [$f->attr], [];
is $f->after, 4;
is_deeply $out, [];
}
done_testing;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment