in reply to Re^11: Assignable Subroutines
in thread Assignable Subroutines

Please show me which parameters you need access to.

#!/usr/bin/perl use strict; use warnings; package UglyTie; use Data::Dumper; sub TIESCALAR { my $class = shift; bless [ @_ ], $class; } sub STORE { warn Dumper @_; } sub FETCH { warn Dumper @_; 1; } package main; sub lv : lvalue { tie my $response, 'UglyTie', @_; $response; } lv( "foobarbazquux" x 2, 10, 5 ) =~ /whatever/;

Makeshifts last the longest.

Replies are listed 'Best First'.
Re^13: Assignable Subroutines
by BrowserUk (Patriarch) on Jan 26, 2005 at 22:22 UTC

    Your sample code does not address the problem.

    The arguments are those passed to the lvalue sub that define what lvalue is returned by the sub, and therefore what gets modified by the assignment.

    In order to validate that part of the data that was modified, you need to know those arguments. So, show me how you can avail the FETCH and STORE methods of the tie of those arguments, so that they can achieve the same validation as is shown in the commented out code in the sub modifySubstring()?

    #!/usr/bin/perl use strict; use warnings; package UglyTie; use Data::Dumper; sub TIESCALAR { my $class = shift; bless [ @_ ], $class; } sub STORE { warn Dumper @_; } sub FETCH { warn Dumper @_; 1; } package SillyClass; sub new { bless \$_[ 1 ], $_[ 0 ]; } sub modifySubstring: lvalue { my( $self, $start, $length ) = @_; substr( $$self, $start, $length ); ## Validate that part of the string that was modified # die 'Bad value' # unless substr( $$self, $start, $length ) =~ m[^[a-z]+$]; } 1; package main; my $silly = SillyClass->new( 'a teststring' ); $silly->modifySubstring( 3, 3 ) = 'ABC';

    Same problem here. How can I perform the validation of the values assigned to the slice, as shown commented out, through a tie, or traits, or a type definition?

    #!/usr/bin/perl use strict; use warnings; package SillyClass2; sub new { my $class = shift; bless \@_, $class; } sub modifySubset: lvalue { my( $self, $start, $end ) = @_; @{ $self }[ $start .. $end ] ## Validate that all values in the slice being assigned are ## non-zero, even and uniq # my %uniq; # die 'Bad value' # unless $end - $start == grep{ # $_ && !( $_ & 1 ) && not ++$seen{ $_ } #} @{ $self }[ $start .. $end ]; } 1; package main; my $silly = SillyClass2->new( map $_ * 2, 1 .. 50 ); $silly->modifySubset( 15, 35 ) = ( 1 .. 20 ); ## should cause an error +!

    Examine what is said, not who speaks.
    Silence betokens consent.
    Love the truth but pardon error.

      I feel silly having to demonstrate such trivial solutions to someone who otherwise seems quite knowledgable, but here goes:

      #!/usr/bin/perl use strict; use warnings; package Tie::EnsureLowercaseSubstr; use Carp; sub TIESCALAR { my $class = shift; my %self; @self{ qw( strref offs len ) } = @_; bless \%self, $class; } sub STORE { my $self = shift; my ( $value ) = @_; croak 'Bad value' unless $value =~ /^[a-z]+$/; substr( ${ $self->{ strref } }, $self->{ offs }, $self->{ len }, $ +value ); } sub FETCH { my $self = shift; substr( ${ $self->{ strref } }, $self->{ offs }, $self->{ len } ); } package SillyClass; sub new { my $class = shift; my ( $value ) = @_; bless \$value, $class; } sub modifySubstring: lvalue { my( $self, $start, $length ) = @_; tie my $response, 'Tie::EnsureLowercaseSubstr', \$$self, $start, $ +length; $response; } package main; my $silly = SillyClass->new( 'a teststring' ); $silly->modifySubstring( 3, 3 ) = 'ABC';

      Part two:

      #!/usr/bin/perl use strict; use warnings; package Tie::EvenUniqueTrueArray; use Tie::Array; use base qw( Tie::StdArray ); use Carp; my( %Array, %Start, %End ); sub TIEARRAY { my $class = shift; my ( $array, $start, $end ) = @_; my $self = [ @{ $array }[ $start .. $end ] ]; ( $Array{ 0 + $self }, $Start{ 0 + $self }, $End{ 0 + $self } ) = +( $array, $start, $end ); bless $self, $class; } sub STORE { my $self = shift; my ( $idx, $value ) = @_; $self->[ $idx ] = $value; my %seen; croak 'Bad value' if !$value or ( $value & 1 ) or grep $seen{ $_ }++, @$self; } sub DESTROY { my $self = shift; @{ $Array{ 0 + $self } }[ $Start{ 0 + $self } .. $End{ 0 + $self } + ] = @$self; delete $_->{ 0 + $self } for \( %Array, %Start, %End ); } package SillyClass2; sub new { my $class = shift; bless \@_, $class; } sub modifySubset: lvalue { my( $self, $start, $end ) = @_; tie my @response, 'Tie::EvenUniqueTrueArray', \@$self, $start, $en +d; @response; } package main; my $silly = SillyClass2->new( map $_ * 2, 1 .. 50 ); ( $silly->modifySubset( 15, 16 ) ) = ( 20, 22 ); ( $silly->modifySubset( 15, 35 ) ) = ( 1 .. 20 );

      All of that was all there in my previous reply.

      Goes to show why it's nice that Perl6 will only require a fraction of the red tape, though.

      Makeshifts last the longest.

        Now imagine that the LVALUE sub below (with better syntax) was a builtin and the TIESCALAR was invisible--generated automatically by the compiler.

        #! perl -slw use strict; package Sensible; sub TIESCALAR { my( $class, $fetch, $store ) = @_; no warnings 'redefine'; *FETCH = *FETCH = $fetch; *STORE = *STORE = $store; bless [], $class; } sub LVALUE (&&) : lvalue { my( $fetch, $validate ) = @_; tie my $lvalue, 'Sensible', $fetch, $validate; $lvalue; } sub new { my( $class, $init ) = @_; return bless \$init, $class; } sub attr : lvalue { my( $self, $start, $len ) = @_; $start ||= 0; $len ||= length ${ $_[ 0 ] }; LVALUE { substr( $$self, $start, $len ) } sub{ warn( 'Bad value' ), return unless $_[ 1 ] =~ m[^[a-z ]+$]; substr( $$self, $start, $len ) = $_[ 1 ]; }; } package main; my $sensible = Sensible->new( 'The quick brown fox jumps over the lazy + dog' ); print $sensible->attr; $sensible->attr( 10, 5 ) = 'green'; print $sensible->attr; $sensible->attr( 20 ) = 'did not see the paint tin'; print $sensible->attr; $sensible->attr( 10, 5 ) = 'ORANGE'; print $sensible->attr; __END__ [ 2:03:26.03] P:\test>425402-2 The quick brown fox jumps over the lazy dog The quick green fox jumps over the lazy dog The quick green fox did not see the paint tin Bad value at P:\test\425402-2.pl line 31. The quick green fox did not see the paint tin

        Note how there is no need for a separate tie class for every different validation routine. Just one for scalars, one for arrays, and one for hashes.

        Note how all the code is in a single place. And how the validation code has full access to the entire environment of the original sub. No need to pass everything required, it is all available via closure.

        One additional keyword and some (a little) extra code generated--by the compiler, not the programmer.

        As you can see, you needn't feel silly. I was there a long time ago.


        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.

        And you would trade all that for the simplicity of the commented out code?

        I rest my case!


        Examine what is said, not who speaks.
        Silence betokens consent.
        Love the truth but pardon error.