package TieTest; sub TIESCALAR { my $class = shift @_; die "Incorrect # of arguments" if @_ % 2; my $self = bless {}, $class; $self->_init(@_); return $self; } sub FETCH { my $self = shift @_; my $work_around = sub { my $tgt = shift @_; if (exists $self->{$tgt}) { print "Fetching value from cache\n"; return $self->{$tgt}; } print "Calculating and caching value for $tgt\n"; return $self->{$tgt} = $self->{subref}->($tgt); }; return $work_around; } sub _init { my $self = shift @_; my %arg = @_; for (qw/subref/) { # All valid args $self->{$_} = delete $arg{$_}; } if (keys %arg) { my $bad = join ' ', keys %arg; die "The following args are invalid: $bad"; } return; } package main; tie my $tied_func, 'TieTest', subref => sub {$_[0] * 2}; # Calculate the function values for 1 .. 100 print $tied_func->($_), "\n" for 1 .. 10; # Retrieve cached values print $tied_func->($_), "\n" for 1 .. 10; #### sub FETCH { my $self = shift @_; my $work_around = sub { my $tgt = shift @_; print "Checking for pause\n"; return $self->{subref}->($tgt); }; return $work_around; }