#!/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'; #### #!/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, $end; @response; } package main; my $silly = SillyClass2->new( map $_ * 2, 1 .. 50 ); ( $silly->modifySubset( 15, 16 ) ) = ( 20, 22 ); ( $silly->modifySubset( 15, 35 ) ) = ( 1 .. 20 );