File Coverage

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

Criterion	Covered	Total	%
statement	48	50	96.0
branch	5	6	83.3
condition	3	5	60.0
subroutine	13	13	100.0
pod	3	3	100.0
total	72	77	93.5

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

use strict;
use warnings;
use Carp;

our $VERSION = '0.07';

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

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

__PACKAGE__->mk_accessors(qw/ dir /);

our $DEFAULT_DIR = 't/.methodfixtures';

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

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

    croak "Unable to access "
        . $args->{dir}
        . " (do you need to create the storage directory?)"
        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};

    my $storage = $self->_directory($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 = $self->_directory($method)->child( $self->_filename($key) );
    return unless $storage->is_file;

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

    return $data;
}

# TODO test (and escape?) invalid characters
sub _directory {
    my ( $self, $method ) = @_;
    $method =~ s/(::|')/-/g;
    return path( $self->dir, $method );
}

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

1;

__END__