package TestArray; use Tie::Array; use parent -norequire, 'Tie::StdArray'; use strict; use warnings; use Carp qw/cluck/; $| = 1; our %STASH; sub TIEARRAY { my $o = bless [], $_[0]; $STASH{$o} = { DEBUG => 0}; return $o; } sub DESTROY { my $o = shift; if( $STASH{$o}{DEBUG} ) { cluck "Called DESTROY."; } delete $STASH{$o}; } sub debug { my $self = shift; my $newstate = shift; if( defined $newstate ) { $STASH{$self}{DEBUG} = $newstate; } return $STASH{$self}{DEBUG}; } sub STORE { if( $STASH{$_[0]}{DEBUG} ) { cluck "Called STORE on element [$_[1]] with value '$_[2]'"; } $_[0]->[$_[1]] = $_[2] } sub POP { if( $STASH{$_[0]}{DEBUG} ) { cluck "Called POP: Returned '$_[0][-1]'."; } pop( @{$_[0]} ); } sub SHIFT { if( $STASH{$_[0]}{DEBUG} ) { cluck "Called SHIFT: Returned '$_[0][0]'."; } shift( @{$_[0]} ); } sub PUSH { local $" = "', '"; my $o = shift; if( $STASH{$o}{DEBUG} ) { cluck "Called PUSH with args '@_'"; } push( @$o, @_ ); } sub UNSHIFT { local $" = "', '"; my $o = shift; if( $STASH{$o}{DEBUG} ) { cluck "Called UNSHIFT with args '@_'"; } unshift( @$o, @_ ); } sub CLEAR { if( $STASH{$_[0]}{DEBUG} ) { cluck "Called CLEAR."; } @{$_[0]} = (); } sub DELETE { if( $STASH{$_[0]}{DEBUG} ) { cluck "Called DELETE with arg $_[1]"; } delete $_[0]->[$_[1]]; } package main; use strict; use warnings; use v5.12; our $o; # Tied array object. BEGIN { @ARGV = ( 'A' .. 'Z' ); my @temp = @ARGV; $o = tie @ARGV, 'TestArray'; @ARGV = @temp; $o->debug(1); } say "@ARGV"; say "pop() test."; my $test = pop( @ARGV ); say "push() test."; push @ARGV, 'ZZ'; say "shift() test."; $test = shift( @ARGV ); say "unshift() test."; unshift( @ARGV, $test ); say "delete() test."; delete( $ARGV[-1] ); say "Assignment test."; $ARGV[0] = 'AA'; say "CLEAR() test."; @ARGV = (); #### A B C D E F G H I J K L M N O P Q R S T U V W X Y Z pop() test. Called POP: Returned 'Z'. at mytest.pl line 43 TestArray::POP('TestArray=ARRAY(0x250e91c)') called at mytest.pl line 110 push() test. Called PUSH with args 'ZZ' at mytest.pl line 59 TestArray::PUSH('TestArray=ARRAY(0x250e91c)', 'ZZ') called at mytest.pl line 113 shift() test. Called SHIFT: Returned 'A'. at mytest.pl line 50 TestArray::SHIFT('TestArray=ARRAY(0x250e91c)') called at mytest.pl line 116 unshift() test. Called UNSHIFT with args 'A' at mytest.pl line 68 TestArray::UNSHIFT('TestArray=ARRAY(0x250e91c)', 'A') called at mytest.pl line 119 delete() test. Called DELETE with arg 25 at mytest.pl line 82 TestArray::DELETE('TestArray=ARRAY(0x250e91c)', 25) called at mytest.pl line 122 Assignment test. Called STORE on element [0] with value 'AA' at mytest.pl line 36 TestArray::STORE('TestArray=ARRAY(0x250e91c)', 0, 'AA') called at mytest.pl line 125 CLEAR() test. Called CLEAR. at mytest.pl line 75 TestArray::CLEAR('TestArray=ARRAY(0x250e91c)') called at mytest.pl line 128 Called DESTROY. at mytest.pl line 20 TestArray::DESTROY('TestArray=ARRAY(0x250e91c)') called at mytest.pl line 0 eval {...} called at mytest.pl line 0