Lvalue
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Lvalue.pm view on Meta::CPAN
this module does not export anything by default but can export the functions
below (which can all also be called as methods of Lvalue)
use Lvalue qw/lvalue/; # or 'wrap', also 'unwrap'/'rvalue'
lvalue my $obj = SomePackage->new;
$obj->value = 5;
Lvalue->unwrap( $obj );
$obj->value = 6; # dies
=head1 FUNCTIONS
=over 4
=cut
sub overload {
my ($object, $proxy) = @_;
my $pkg = ref $object;
my $overloader = sub {
my $op = shift;
sub {
if (my $sub = overload::Method($pkg, $op)) {
@_ = ($object, @_[1, 2]);
goto &$sub;
}
Carp::croak "no overload method '$op' in $pkg";
}
};
no strict 'refs';
my $fallback = ${$pkg.'::()'};
my $overload = join ', ' =>
defined $fallback ? 'fallback => $fallback' : (),
map "'$_' => \$overloader->('$_')" =>
grep s/^\((?=..)// => keys %{$pkg.'::'};
eval qq {package $proxy;
our \@ISA = 'Lvalue::Loader';
use overload $overload;
} or Carp::carp "Lvalue: overloading not preserved for $pkg, "
. "bug reports or patches welcome.\n $@";
}
=item C<wrap OBJECT>
=item C<lvalue OBJECT>
wrap an object with lvalue getters / setters
my $obj = Lvalue->wrap( SomePackage->new );
or in a constructor:
sub new {
my $class = shift;
my $self = {@_};
Lvalue->wrap( bless $self => $class );
}
in void context, an in-place modification is done:
my $obj = SomePackage->new;
Lvalue->wrap( $obj );
$obj->value = 5;
the alias C< lvalue > is provided for C< wrap > which when you export it as a
function, can lead to some nice code:
use NormalObject;
use Lvalue 'lvalue';
lvalue my $obj = NormalObject->new;
$obj->value = 5;
=cut
{my $num = 0;
sub wrap {
my ($object, $proxy) = ($_[$#_], 'Lvalue::Loader');
if (overload::Overloaded $object) {
overload $object
=> $proxy = 'Lvalue::Loader::_' . $num++
}
bless my $wrapped = \$object => $proxy;
defined wantarray
? $wrapped
: $_[$#_] = $wrapped
}}
=item C<unwrap LVALUE_OBJECT>
=item C<rvalue LVALUE_OBJECT>
returns the original object
=cut
sub unwrap {
my $wrapped = $_[$#_];
croak "unwrap only takes objects wrapped by this module"
unless (ref $wrapped) =~ /^Lvalue::Loader (?: ::_\d )? $/x;
defined wantarray
? $$wrapped
: $_[$#_] = $$wrapped
}
BEGIN {
*lvalue = \&wrap;
*rvalue = \&unwrap;
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 1.269 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )