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.
In reply to Re^14: Assignable Subroutines
by Aristotle
in thread Assignable Subroutines
by dragonchild
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |