File Coverage

blib/lib/Test/MethodFixtures/Storage/File.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	6	6	100.0
condition	3	5	60.0
subroutine	12	12	100.0
pod	3	3	100.0
total	71	73	97.2

package Test::MethodFixtures::Storage::File;

use strict;
use warnings;
use Carp;

our $VERSION = '0.06';

use Carp;
use Data::Dump qw( dump );
use Digest::MD5 qw( md5_hex );
use Path::Tiny;

use base 'Test::MethodFixtures::Storage';

__PACKAGE__->mk_accessors(qw/ dir /);

our $DEFAULT_DIR = 't/.methodfixtures';

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

    $args ||= {};
    unless ($args->{dir}) {
        mkdir $DEFAULT_DIR;
        $args->{dir} = $DEFAULT_DIR;
    }

    croak "Unable to access " . $args->{dir}
        unless -d $args->{dir} && -w $args->{dir};

    return $class->SUPER::new($args);
}

sub store {
    my ( $self, $args ) = @_;

    my $method = delete $args->{method};
    my $key    = delete $args->{key};

    # for now only store on disk
    my $storage = path( $self->dir, $method );
    $storage->mkpath;
    $storage->child( $self->_filename($key) )->spew_utf8( dump $args );

    return $self;
}

sub retrieve {
    my ( $self, $args ) = @_;

    my $method = $args->{method};
    my $key    = $args->{key};

    my $storage = path( $self->dir, $method )->child( $self->_filename($key) );
    return unless $storage->is_file;

    my $data = eval $storage->slurp_utf8();;

    return $data;
}

sub _filename {
    my $self = shift;
    return md5_hex dump shift;
}

1;

__END__