Re: [FWP] Fun with lvalue subs

[sthoenna@efn.org (Yitzchak Scott-Thoennes)]

In article <m13dkhukfy.fsf@rt158.private.realtime.co.uk>,
Piers Cawley <pdcawley@bofh.org.uk> wrote:
> 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...

Something like this gets you an assignment failure for the 4-arg case,
though the warning is not all that it could be:

sub my_substr ( $$;$$ ) : lvalue {
    my $tiedval;
    tie $tiedval, 'Lval', \ $_[0], @_[1,2] or die;

    if (@_ >= 4) {
	$tiedval = $_[3];
	my $retval = $tiedval; # someday, we'll be able to say my $x:const = $y
	"$retval";  de-lvalue it
    } else {
	$tiedval;
    }
}

It also correctly returns the previous value of the substr range when
there are 4 args.

Some other comments:

> #!/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;

= shift || 0 so you don't have to worry about defined later.
You may also want to convert these to numbers (with a warning) at this point.
$self->{offset} = 0+shift;
$self->{'length'} = defined $_[0] ? 0+shift : shift||0;

(Is there a better way to do that in one fell swoop?  = 0+(shift||0) works
except for not warning if it is ''.  0+(shift ?? 0) would of course do it.)

It is interesting to note that the real substr works with stuff like:
substr($x, 0.5, 1.5);

>     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)];

But a length of (e.g.) -1 means keep 3 chars on the end.
So something like:
                 ($self->{'length'} > 0 ?
                      $self->{offset} + $self->{'length'} - 1 :
                          $#val_array + $self->{'length'})];

Or I suppose you could change the length to the positive in TIESCALAR.
(Just tried, and thats what the real substr seems to do...that is to
say taking a ref to a substr with negative length resolves the length
right then.  If the string grows, assigning to the ref uses the old
length value.)

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

Doesn't work if $new_val is shorter or longer than length.
(Shorter leaves undefs from join to complain about, longer gets
truncated.)
Something like:
      splice(@val_array, $self->{offset}, $self->{'length'}, $new_val);

Or is using splice cheating?
      @val_array = (@val_array[0..$self->{offset}-1], $new_val,
                    @val_array[($self->{offset}+$self->{'length'})..$#val_array])

or just what you had before with = $new_val instead of = split '', $new_val
and then join '', grep defined, @val_array;

>     $ {$self->{orig_var}} = join '', @val_array;
>     return $new_val;

Hmm, I wasn't completely sure that a substr assignment would return the value
assigned, so I tried it and it looks buggy:

[D:\home\sthoenna]perl -Wlne "eval;print$@if$@"
$x = 'abcdefg'
$z = substr($x, 2, -2) = 'wxyz'
print $x
abwxyzfg
print $z
wxy

But that's ok, you needn't emulate substr's bugs :)

> }

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