File Coverage

blib/lib/Devel/Memo.pm

Criterion	Covered	Total	%
statement	3	26	11.5
branch	0	12	0.0
condition			n/a
subroutine	1	3	33.3
pod	0	1	0.0
total	4	42	9.5

# $Id: Memo.pm 1.11 Wed, 10 Dec 1997 17:58:09 -0500 jesse $

package Devel::Memo;
require 5.004;
use FreezeThaw qw(safeFreeze);

sub new($$@) {
  my ($class, $subr, @styles)=@_;
  my %cache;
  my $proto=prototype $subr;
  $proto="($proto)" if defined $proto;
  bless eval qq{
    sub $proto {$class->_exec(\$subr, \\\@styles, \\%cache, [\@_])}
  }, $class;
}

sub _exec($$$$;) {
  my ($class, $subr, $styles, $cache, $args)=@_;
  my @styles=@$styles;
  my @virtargs=@$args;
  if ($styles[-1] eq '-rest') {
    $styles[-1]='-equal';
    my $rest=[splice @virtargs, $#styles];
    push @virtargs, $rest;
  }
  die "Bad matchup of arguments: @{[scalar @virtargs]} vs. @{[scalar @styles]}"
    unless @styles==@virtargs;
  my $i; for ($i=0; $i<@virtargs; $i++) {
    $virtargs[$i]=safeFreeze($virtargs[$i]) if $styles[$i] eq '-equal';
  }
  my $key=join '', map {length($_) . ":$_"} @virtargs;
  my $val=$cache->{$key};
  $val=$cache->{$key}=[&$subr(@$args)] unless defined $val;
  wantarray ? @$val : $val->[-1];
}

1;
__END__