That looks alright to me, the second version avoids repetition and is very clear, since that's done only once there's no need to worry about optimisation. You can do this with a for loop instead of the map (for two reasons: first, using map for turning a list into another and for for doing something with every element of a list makes the intent clearer, the second reason is that map in a void context will trigger the same kind of reactions as goto). I guess something with closures (I like closures :) ) could work, but I gave it a try and only ended up with something harder to read than your code. But here is another way to do it, in the spirit of TIMTOWTDI.

  {
    no strict 'refs';
    *$_ = eval "sub { &main::trigger; shift()->SUPER::$_(\@_) }" for q
+w(STORE CLEAR PUSH POP SHIFT UNSHIFT);
 }
[download]

Notice that I didn't use the "$self" scalar twice (well, I didn't use it at all actually), because $var->method(@params) already adds $var as the first parameter.

Your problem made me think of Python's decorators, so I ended up on this thread which could be of interest to you. The thing is, you may not want to modify the subs in Tie::StdArray, in case you use another module that uses this module, so you have to define your own methods anyway.

Edit : and I think you'll need to tie the contained scalars too if you want to call your trigger function only when your elements are modified. Your tied array should actually just tie any scalar pushed into it.

No need for string eval:

    for (qw(STORE CLEAR PUSH POP SHIFT UNSHIFT)) {
        my $s = "SUPER::$_";
        no strict 'refs';
        *$_ = sub { &main::trigger; shift()->$s(@_) };
    }
[download]

Update: fixed error (removed the reference from \@_).

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Here's what I did when trying to use closures (I hadn't seen the issue with the double $self at the time):

 {
  no strict;
  for my $method (qw(STORE CLEAR PUSH POP SHIFT UNSHIFT))
  {
    my $sub = "SUPER::$method";
    *$method = sub { &main::trigger; my $self = shift; $self->$sub($se
+lf, @_) };
  }
 }
[download]

So I felt that with all the lexicals and the use of many "advanced" features (anonymous sub, closing over a lexical, globs, scalar as a method, SUPER::) it was harder to read than a string eval which is often better understood. Your version is light enough that I like it more though.

It's up to Discipulus to choose whatever he thinks he'll be able to understand the best :)

very nice, thanks choroba
anyway i like string eval for his extreme power: the compiler walk with you during the program execution. is just a matter of not abuse as i do sometimes.
L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

Thanks Eily, for suggestions, links and (never understood) to explain me the inutility of $self explicitally set, as i've done.
because $var->method(@params) already adds $var as the first parameter. was something i never realized.

Anyway is not clear to me what do you means with and I think you'll need to tie the contained scalars too if you want to call your trigger function only when your elements are modified. Your tied array should actually just tie any scalar pushed into it.
Are you refering in the case you change the value by reference (as i'll ask soon)? I have to tie the scalar values of each array elements?
L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

I thought that while cases like $array[42] = "Doky" would work fine, $array[42] =~ tr/y/i/ or even s/D/L/ for @array; would not call STORE, but I just tried and have been proven wrong, at least for v5.14 :

sub trigger{print "Triggered ".shift."(@_)\n"} #must go BEFORE the eva
+l is seen

{#bare block because package BLOCK appeared only 5.14
 package Arraytrigger;
 use Tie::Array;
 use vars qw(@ISA);
 @ISA = ('Tie::StdArray');

  for (qw(STORE CLEAR PUSH POP SHIFT UNSHIFT)) {
        my $s = "SUPER::$_";
        no strict 'refs';
        *$_ = sub { main::trigger($s, @_); shift()->$s(@_) };
    }
}

tie my @arr, 'Arraytrigger';

@arr = qw(Doky);
$arr[0] =~ tr/y/i/;
s/D/L/ for @arr;
[download]

sub trigger{print "Triggered: ",map {defined $_ ? " $_" : 'UNDEF'}@_,"
+\n"}
[download]

# rest of the code as before..
print "\tclearing with undef \@arr:\n"     and   undef @arr;
print "\tSetting list:\n" and @arr = qw(a);
print "\tclearing with \@arr=undef:\n"     and   @arr=undef;
print "\tSetting list:\n" and @arr = qw(a);
print "\tclearing with \@arr=():\n"     and   @arr=();

__OUT__
        clearing with undef @arr:
Triggered:  Arraytrigger=ARRAY(0x6ab224)
        Setting list:
Triggered:  Arraytrigger=ARRAY(0x6ab224)
Triggered:  Arraytrigger=ARRAY(0x6ab224) 0 a
        clearing with @arr=undef:
Triggered:  Arraytrigger=ARRAY(0x6ab224)
Triggered:  Arraytrigger=ARRAY(0x6ab224) 0UNDEF
        Setting list:
Triggered:  Arraytrigger=ARRAY(0x6ab224)
Triggered:  Arraytrigger=ARRAY(0x6ab224) 0 a
        clearing with @arr=():
Triggered:  Arraytrigger=ARRAY(0x6ab224)
[download]

my $ref = \$arr[0];
print "\tsetting by reference:\n"     and   $ref=11;

__OUT__
        setting by reference:
[download]

print "\@arr [@arr]\n";
[download]

1. @arr = undef;
   [download]

   is not the same as

   undef @arr;
   [download]

   It assigns undef to the first element of the array, i.e. it's equivalent to

   @arr = (undef);
   [download]

   Therefore, it calls CLEAR and STORE, which means two trigger calls.

2. If you store \$arr[0] in a $ref, then assigning $ref = 11 you just remove the reference from $ref. You have to assign to where it points to trigger the magic:

   $$ref = 11;
   [download]

3. You probably still do

   $self->SUPER::STORE($self, @_);
   [download]

   Remove the $self from the arguments and the problem is gone.

   Update: Here's what caused the problem: when a reference is used as a number, it returns its "address" (which is good for comparing references with ==). Therefore, when you supplied $self as the first argument to STORE, it was interpreted as the index where the actual index was stored. The number was probably very high, so the array become gargantuan.

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

thanks but even if the code below runs well with all your improvements, as soon as i add a simply print "\@arr [@arr]\n"; at the end, the program hangs, eating a lot of memory. I dont understand why.


use strict;
use warnings;

sub trigger{print "Triggered: ",map {defined $_ ? " $_" : 'UNDEF'}@_,"
+\n"}

{
 package Arraytrigger;
 use Tie::Array;
 use vars qw(@ISA);
 @ISA = ('Tie::StdArray');

 for (qw(STORE CLEAR PUSH POP SHIFT UNSHIFT)) {
        my $s = "SUPER::$_";
        no strict 'refs';
        *$_ = sub { &main::trigger; shift()->$s(\@_) };
    }
}

#package main..

tie my @arr, 'Arraytrigger';

print "\tSetting list:\n" and @arr = qw(a b c d e);
#print "\tSetting one:\n"  and $arr[0]=0;
#print "\tpushing:\n"      and push @arr,'f';
#print "\tpopping:\n"      and pop @arr;
#print "\tshifting:\n"     and shift @arr;
#print "\tunshifting:\n"   and unshift @arr, 'zero';
#print "\tclearing with undef \@arr:\n"     and   undef @arr;
#print "\tSetting list:\n" and @arr = qw(a);
#print "\tSetting list:\n" and @arr = qw(a);
#print "\tclearing with \@arr=():\n"     and   @arr=();
#my $ref = \$arr[0];
#print "\tsetting by reference:\n"     and   $$ref=11;
#print "\tclearing:\n"     and   @arr=();#undef @arr and @arr=undef se
+em no good..e


# print "\@arr [@arr]\n";
#use Data::Dump;print dd(@arr);
[download]

thanks
L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

thanks choroba,
1 and 2 ... prove that is not wise to code when you have fever above 38.. i'll try to remember.
3. thanks, now i understand

L*

There are no rules, there are no thumbs..
Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.