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