package File::Cache::Parsed;
use strict;
use warnings;
use List::Util qw(first);
use List::MoreUtils qw(firstidx);
use Path::Class;
use Carp;
sub new {
my ($class)=@_;
return bless {
parsers=>[],
writers=>[],
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 add_writer {
my ($self,$rx,$writer)=@_;
my $old_writer=first {$_->[0] eq $rx} @{$self->{writers}};
if ($old_writer) {
$old_writer->[1]=$writer;
}
else {
push @{$self->{writers}},[$rx,$writer];
}
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 put {
my ($self,$filename,$contents)=@_;
my $ww=first {$filename =~ m{$_->[0]}} @{$self->{writers}};
if ($ww) {
return $ww->[1]->($filename,$contents);
}
elsif (!ref($contents)) {
return print {file($filename)->openw} $contents;
}
else {
croak "'$contents' is not a scalar, and no writer defined for the name '$filename'";
}
}
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;