File Coverage

blib/lib/File/Cache/Persistent.pm

Criterion	Covered	Total	%
statement	65	70	92.8
branch	22	26	84.6
condition	10	12	83.3
subroutine	9	11	81.8
pod	3	5	60.0
total	109	124	87.9

package File::Cache::Persistent;

use strict;

use vars qw($VERSION $CACHE $TIME_CACHE $NO_FILE $NOT_MODIFIED $FILE $PROLONG $TIMEOUT);
$VERSION = 0.3;

$NO_FILE      = 1;
$NOT_MODIFIED = $NO_FILE << 1;
$FILE         = $NOT_MODIFIED << 1;
$PROLONG      = $FILE << 1;
$TIMEOUT      = $PROLONG << 1;
$CACHE        = $TIMEOUT << 1;
$TIME_CACHE   = $CACHE << 1;

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

    my $this = {
        prefix => $args{prefix} || undef,
        timeout => $args{timeout} || 0,
        reader => $args{reader} || undef,
	reader_error => undef,
        data => {},
        status => undef,
    };
    bless $this, $class;

    return $this;
}

sub get {
    my ($this, $path) = @_;

    $path = $this->{prefix} . '/' . $path if $this->{prefix};

    my $data;
    my $havecache = defined $this->{data}{$path};

    $this->{status} = undef;
    unless ($this->{timeout}) {
        # Time caching mode is off.

        unless (-e $path) {
            # Did not find the file, make an attempt to use cache.
            unless ($havecache) {
                # Nope, failed completely.
                die "Neither file '$path' nor its cache exists\n";
            }
            else {
                # OK, using cache but no file still exists.
                $data = $this->{data}{$path}[0];
                $this->{status} = $CACHE + $NO_FILE;
            }
        }
        else {
            # There is a file. Before using it should test if there is a cached version of it.
            if ($havecache && !$this->_is_modified($path)) {
                # File was not modified, using cache.
                $data = $this->{data}{$path}[0];
                $this->{status} = $CACHE + $NOT_MODIFIED;
            }
            else {
                # No cache found or file was modified. Reading it from disk and saving in cache.
                $data = $this->_read_file($path);
                $this->{status} = $FILE;
            }
        }
    }
    else {
        # Time caching mode is on. No attempts to check whether the file was changed if cache is new enough.

        unless ($havecache) {
            # No cache available. Read the file from disk.
            die "Neither file '$path' nor its cache exists\n" unless -e $path;
            $data = $this->_read_file($path);
            $this->{status} = $FILE;
        }
        elsif (time - $this->{data}{$path}[3] <= $this->{timeout}) {
            # Good cache. Using it.
            $data = $this->{data}{$path}[0];
            $this->{status} = $CACHE + $TIME_CACHE;
        }
        else {
            # Cache is outdated.
            if (-e $path) {
                # There is a file.
                if (!$this->_is_modified($path)) {
                    # No changes in file. Thus just prolongating cache time life.
                    $this->{data}{$path}[3] = time;
                    $data = $this->{data}{$path}[0];
                    $this->{status} = $CACHE + $TIME_CACHE + $NOT_MODIFIED + $PROLONG + $TIMEOUT;
                }
                else {
                    # Both cache expired and file changed. Reload.
                    $data = $this->_read_file($path);
                    $this->{status} = $FILE + $TIMEOUT;
                }
            }
            else {
                # No file. No panic but using outdated cached document.
                $data = $this->{data}{$path}[0];
                $this->{status} = $CACHE + $TIME_CACHE + $NO_FILE + $TIMEOUT;
            }
        }
    }
    # Too many elses? Do it yourself otherwise :-)

    return $data;
}

sub remove {
    my ($this, $path) = @_;

    $path = $this->{prefix} . '/' . $path if $this->{prefix};

    $this->{status} = undef;
    delete $this->{data}{$path};
}

sub status {
    my $this = shift;

    return $this->{status};
}

sub _timeout {
    my ($this, $path) = @_;

    return $this->{data}{$path}[1] - (stat $path)[9];
}

sub _is_modified {
    my ($this, $path) = @_;

    return
        $this->{data}{$path}[1] != (stat $path)[9] || # mtime
        $this->{data}{$path}[2] != (stat _)[7];       # size
}

sub _update_cache {
    my ($this, $data, $path) = @_;

    $this->{data}{$path} = [
        $data,
        (stat $path)[9],
        (stat _)[7],
        time
    ];
}

sub _read_file {
    my ($this, $path) = @_;

    my $data;
    if (defined $this->{reader}) {
	$this->{reader_error} = undef;
	eval {
            $data = $this->{reader}($path);
	};
	$this->{reader_error} = $@ if $@;
    }
    else {
        local $/;
        undef $/;
        open my $file, '<', $path;
        $data = <$file>;
        close $file;
    }

    $this->_update_cache($data, $path);

    return $data;
}

sub reader_error {
    my $this = shift;

    return $this->{reader_error};
}

1;

__END__