File Coverage

blib/lib/File/Spec/Memoized.pm

Criterion	Covered	Total	%
statement	20	23	86.9
branch			n/a
condition	4	5	80.0
subroutine	7	9	77.7
pod	1	1	100.0
total	32	38	84.2

package File::Spec::Memoized;

use 5.006_002;
use strict;

our $VERSION = '1.00';

use File::Spec;

# constants:
#   curdir, updir, rootdir, devnull
#
# already memoized:
#   tmpdir
#
# no memoized (no performance drain):
#   file_name_is_absolute, case_tolerant

my %cache;

# features return a scalar
foreach my $feature(qw(
    canonpath
    catdir
    catfile
    catpath
    abs2rel
    rel2abs
)) {
    my $orig = File::Spec->can($feature) or die "Oops: $feature";

    my $fs   = '$' . $feature;

    my $memoized = sub :method {
        my $self = shift;
        return $cache{$fs, @_} ||=  $self->$orig(@_);
    };
    no strict 'refs';
    *{$feature} = $memoized;
}

# features return a list
foreach my $feature(qw(
    no_upwards
    path
    splitpath
    splitdir
)) {
    my $orig = File::Spec->can($feature) or die "Oops: $feature";

    my $fl   = '@' . $feature;

    my $memoized = sub :method {
        my $self = shift;
        return @{ $cache{$fl, @_} ||= [$self->$orig(@_)] };
    };
    no strict 'refs';
    *{$feature} = $memoized;
}

sub flush_cache {
    undef %cache;
    return;
}

sub __cache { \%cache }

# Organize the class hierarchy:
# File::Spec -> File::Spec::Memoized -> File::Spec::$OS
#               ^^^^^^^^^^^^^^^^^^^^
our @ISA = @File::Spec::ISA;
@File::Spec::ISA = (__PACKAGE__);

1;
__END__