[FWP] Fun with lvalue subs

[Piers Cawley <pdcawley@bofh.org.uk>]

So, there I am trying to get my head 'round the lvalue stuff in
perl 5.6.0 when I find myself thinking "But this is useless, I want
to be able to write subs that work like substr, or splice and I can't
do that with Lvalues.

Then I saw how Class::Contract works, and I present, for your
entertainment 'substr in pure perl'.

Note, if you are so inclined, the complete lack of commentary, note
too the fact that it doesn't fail correctly if you try to assign to
the four argument version of the function. But what the hey, I'm still
rather pleased with myself for working out how to do more complex
stuff with lvalue subs...

#!/usr/bin/perl -w

use strict;

package Lval;

sub TIESCALAR {
    my $class = shift;
    my $self = {};
    $self->{orig_var} = shift;
    $self->{offset} = shift;
    $self->{'length'} = shift;
    return bless $self, $class;
}

sub FETCH {
    my $self = shift;
    my @val_array = split //, $ {$self->{orig_var}};
    return join '',
    @val_array[$self->{offset} ..
               (defined($self->{'length'}) ?
                    $self->{offset} + $self->{'length'} - 1 :
                        $#val_array)];
}

sub STORE {
    my $self = shift;
    my $new_val = shift;
    my @val_array = split //, $ {$self->{orig_var}};
    @val_array[$self->{offset} ..
               (defined($self->{'length'}) ?
                    $self->{offset} + $self->{'length'} -1 :
                        $#val_array)] = split '', $new_val;
    $ {$self->{orig_var}} = join '', @val_array;
    return $new_val;
}

package main;

sub my_substr ( $$;$$ ) : lvalue {
    my $retval;
    tie $retval, 'Lval', \ $_[0], @_[1,2] or die;
    $retval = $_[3] if exists $_[3];
    $retval;
}


==== Want to unsubscribe from Fun With Perl?  Well, if you insist...
==== Send email to <fwp-request@technofile.org> with message _body_
====   unsubscribe