package File::Cache::Parsed;
use strict;
use warnings;
use List::Util qw(first);
use List::MoreUtils qw(firstidx);
use Cwd 'abs_path';
use Path::Class;
use Carp;
use Try::Tiny;

sub new {
    my ($class,%opts)=@_;

    return bless {
        parsers=>[],
        writers=>[],
        cache=>{},
        follow=>$opts{follow},
    }=>$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];
    }

    $self->invalidate($rx);

    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 del_writer {
    my ($self,$rx)=@_;

    my $i=firstidx {$_->[0] eq $rx} @{$self->{writers}};
    return if $i<0;

    splice @{$self->{writers}},$i,1;

    return;
}

sub get {
    my ($self,$filename)=@_;

    if ($self->{follow}) {
        $filename=abs_path($filename);
    }

    return unless $filename;

    return $self->{cache}{$filename} if exists $self->{cache}{$filename};

    my $contents=try {file($filename)->slurp} catch {return};

    return unless defined $contents;

    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 stat {
    my ($self,$filename)=@_;

    if ($self->{follow}) {
        $filename=abs_path($filename);
    }
    return file($filename)->stat;
}

sub put {
    my ($self,$filename,$contents)=@_;

    my $err;
    my $ww=first {$filename =~ m{$_->[0]}} @{$self->{writers}};
    if ($ww) {
        my $ret=try {$ww->[1]->($filename,$contents)} catch {$err=$_};
        unless ($err) {
            $self->{cache}{$filename}=$contents;
            return $ret;
        }
    }
    if (!ref($contents)) {
        my $pp=first {$filename =~ m{$_->[0]}} @{$self->{parsers}};
        if ($pp) {
            $self->{cache}{$filename}=$pp->[1]->($filename,$contents);
        }
        else {
            $self->{cache}{$filename}=$contents;
        }
        return print {file($filename)->openw} $contents;
    }
    else {
        if ($err) {
            croak "'$contents' is not a scalar, and the writer for the name '$filename' died with: $err";
        }
        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;