diff options
-rw-r--r-- | lib/File/Cache/Parsed.pm | 67 | ||||
-rw-r--r-- | t/fcp-01.t | 3 |
2 files changed, 70 insertions, 0 deletions
diff --git a/lib/File/Cache/Parsed.pm b/lib/File/Cache/Parsed.pm index 0d0a52c..9e980ef 100644 --- a/lib/File/Cache/Parsed.pm +++ b/lib/File/Cache/Parsed.pm @@ -1,5 +1,72 @@ package File::Cache::Parsed; use strict; use warnings; +use List::Util qw(first); +use List::MoreUtils qw(firstidx); +use Path::Class; + +sub new { + my ($class)=@_; + + return bless { + parsers=>[], + cache=>{}, + }=>$class; +} + +sub add_parser { + my ($self,$rx,$parser)=@_; + + my $old_parser=first {$_->[0] eq $rx} @{$self->{parsers}}; + if ($old_parser) { + $old_parser->[1]=$parser; + } + else { + push @{$self->{parsers}},[$rx,$parser]; + } + return; +} + +sub del_parser { + my ($self,$rx)=@_; + + my $i=firstidx {$_->[0] eq $rx} @{$self->{parsers}}; + return if $i<0; + + splice @{$self->{parsers}},$i,1; + + $self->invalidate($rx); + + return; +} + +sub get { + my ($self,$filename)=@_; + + return $self->{cache}{$filename} if exists $self->{cache}{$filename}; + + my $contents=file($filename)->slurp; + + my $pp=first {$filename =~ m{$_->[0]}} @{$self->{parsers}}; + if ($pp) { + return $self->{cache}{$filename}=$pp->[1]->($filename,$contents); + } + else { + return $self->{cache}{$filename}=$contents; + } +} + +sub invalidate { + my ($self,$rx)=@_; + + my $count=0; + for my $filename (keys %{$self->{cache}}) { + if ($filename =~ m{$rx}) { + delete $self->{cache}{$filename}; + ++$count; + } + } + return $count; +} 1; @@ -27,3 +27,6 @@ is_deeply($fc->get($test_file->stringify), ['t',$test_file->stringify,$test_contents]); is($calls{t},1); is($calls{pm},1); +$fc->del_parser(qr{\.t$}); +is($fc->get($test_file->stringify), + $test_contents); |