Credit: https://en.wikipedia.org/wiki/Observer_effect_(physics)

In physics there is the concept of the observer effect whereby the act of observing something alters the measurement. Recently, I’ve had the pleasure of experiencing that firsthand.

The evils of tied variables are well documented and frowned upon by our friendly(?) mentor perlcritic, but let’s suppose we want to be clever…another frowned upon attribute of Perl scripts :-( . But let’s forge ahead anyway…

We’ll create a class that we can use to benchmark our scripts. We want this to be easy, so we’ll create a class that allow us to name benchmarks and simply access a hash element when we want to stop and report the time…sort of like this:

 #!/usr/bin/env perl

 use feature 'say';

 use Easy::Benchmark;
 use Data::Dumper;

 my $benchmark = Easy::Benchmark->new( 'begin', 'start' );

 sleep 2;

 say $benchmark->stop('start');

 $benchmark->start('next');

 sleep 1;

 # print {*STDERR} Dumper $benchmark

 say $benchmark->stop('next');

 say $benchmark->stop;

Here’s the class that implements our easy benchmark.

 package Easy::Benchmark;

 use strict;
 use warnings;

 use Benchmark;

 use constant ANON_BENCHMARK => '__anon_benchmark__';

 ########################################################################
 sub new {
 ########################################################################
   my ( $proto, @args ) = @_;

   my $class = ref $proto || $proto;

   my $self = bless {}, $class;

   tie %{$self}, $class, @args;

   return $self;
 }

 ########################################################################
 sub TIEHASH {
 ########################################################################
   my ( $class, @args ) = @_;

   my $self = bless {}, $class;

   # start the clock on an anonymous benchmark
   $self->start(ANON_BENCHMARK);

   for (@args) {
     # and any additional ones requested.
     $self->start($_);
   }

   return $self;
 }

 ########################################################################
 sub FETCH {
 ########################################################################
   my ( $self, $name ) = @_;

   die "$self: Unknown benchmark named `$name'\n"
     if !exists $self->{$name};

   if ( !ref( $self->{$name} ) || ref $self->{$name} ne 'ARRAY' ) {
     $self->{$name} = [ Benchmark->new, $self->{$name} ];
   }

   return timestr( timediff( @{ $self->{$name} } ) );
 }

 ########################################################################
 sub DELETE   { return delete $_[0]->{ $_[1] }; }
 sub FIRSTKEY { my $a = scalar CORE::keys %{ $_[0] }; each %{ $_[0] } }
 sub NEXTKEY  { each %{ $_[0] } }
 sub STORE    { $_[0]->{ $_[1] } = $_[2] }
 ########################################################################

 ########################################################################
 sub start {
 ########################################################################
   my ( $self, $name ) = @_;

   die "must specify name of counter\n"
     if !$name;

   my $start = Benchmark->new;

   $self->{$name} = $start;

   return $start;
 }

 ########################################################################
 sub stop {
 ########################################################################
   my ( $self, @args ) = @_;

   if ( @args > 0 ) {
     return $self->{ $args[0] };
   }
   else {
     my $name = ANON_BENCHMARK;

     my $value = $self->{$name};

     delete $self->{$name};

     return $value;
   }
 }

 1;

Running our script produces the expect output…

perl -I . foo.pl
 2 wallclock secs ( 0.01 usr +  0.00 sys =  0.01 CPU)
 1 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)
 3 wallclock secs ( 0.01 usr +  0.00 sys =  0.01 CPU)

Let’s remove the comment on the line that dumps our $benchmark object…and see what happens

perl -I . foo.pl
 2 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)
$VAR1 = bless( {
                 '__anon_benchmark__' => ' 2 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)',
                 'begin' => ' 2 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)',
                 'next' => ' 0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)',
                 'start' => ' 2 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)'
               }, 'Easy::Benchmark' );
 0 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)
 2 wallclock secs ( 0.00 usr +  0.00 sys =  0.00 CPU)

Hmmm…I expected our last benchmark to be 3 wall seconds…that wasn’t what I expected. By now you probably know the problem. The class uses the FETCH method to stop a timer. So, when Dumper fetches the keys of the $benchmark object, the timer is restarted. The act of observing the hash triggered an action that resulted in upsetting our experiment.

I am embarassed to say it took me an hour or so to piece it all together since I didn’t know who (or what) was accessing the hash in an effort to provide some useful log messages.

Generalizing, any time you create a class that triggers actions when fetching values from hash, be aware of the observer effect.

Thanks for reading…