File Coverage

blib/lib/Dir/Manifest.pm

Criterion	Covered	Total	%
statement	69	71	97.1
branch	10	12	83.3
condition			n/a
subroutine	17	17	100.0
pod	8	8	100.0
total	104	108	96.3

package Dir::Manifest;
$Dir::Manifest::VERSION = '0.6.1';
use strict;
use warnings;

use 5.014;

use Path::Tiny qw/ path /;
use Dir::Manifest::Key   ();
use Dir::Manifest::Slurp ();

use Moo;

has 'manifest_fn' => ( is => 'ro', required => 1 );
has 'dir'         => ( is => 'ro', required => 1 );

my $ALLOWED = qr/[a-zA-Z0-9_\-\.=]/;
my $ALPHAN  = qr/[a-zA-Z0-9_]/;

sub _is_valid_key
{
    my ( $self, $key ) = @_;
    if ( $key !~ /\A(?:$ALLOWED)+\z/ )
    {
        die
"Invalid characters in key \"$key\"! We only allow A-Z, a-z, 0-9, _, dashes and equal signs.";
    }
    if ( $key !~ /\A$ALPHAN/ )
    {
        die qq#Key does not start with an alphanumeric - "$key"!#;
    }
    if ( $key !~ /$ALPHAN\z/ )
    {
        die qq#Key does not end with an alphanumeric - "$key"!#;
    }

    return;
}

has '_keys' => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $self = shift;

        my @lines = path( $self->manifest_fn )->lines( { chomp => 1 } );
        my $ret   = +{};

        foreach my $l (@lines)
        {
            $self->_is_valid_key($l);
            $ret->{$l} = 1;
        }
        return $ret;
    }
);

has '_dh' => (
    is      => 'ro',
    lazy    => 1,
    default => sub {
        my $self = shift;
        return path( $self->dir );
    },
);

sub get_keys
{
    my ($self) = @_;

    return [ sort { $a cmp $b } keys %{ $self->_keys } ];
}

sub get_obj
{
    my ( $self, $key ) = @_;

    if ( not exists $self->_keys->{$key} )
    {
        die "No such key \"$key\"! Perhaps add it to the manifest.";
    }
    return Dir::Manifest::Key->new(
        { key => $key, fh => $self->_dh->child($key) } );
}

sub fh
{
    my ( $self, $key ) = @_;

    return $self->get_obj($key)->fh;
}

sub text
{
    my ( $self, $key, $opts ) = @_;

    return Dir::Manifest::Slurp::slurp( $self->fh($key), $opts );
}

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

    my $opts = $args->{slurp_opts};

    return +{ map { $_ => $self->text( $_, $opts ) } @{ $self->get_keys } };
}

sub _update_disk_manifest
{
    my $self = shift;

    path( $self->manifest_fn )->spew_raw( map { "$_\n" } @{ $self->get_keys } );

    return;
}

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

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

    if ( exists $self->_keys->{$key} )
    {
        die "Key \"$key\" already exists in the dictionary!";
    }

    $self->_is_valid_key($key);

    $self->_keys->{$key} = 1;

    $self->_update_disk_manifest;
    $self->fh($key)->spew_utf8($utf8_val);

    return;
}

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

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

    if ( not exists $self->_keys->{$key} )
    {
        die "Key \"$key\" does not exist in the dictionary!";
    }

    $self->fh($key)->remove;
    delete $self->_keys->{$key};
    $self->_update_disk_manifest;

    return;
}

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

    my $base = path( $args->{base} );

    return $class->new(
        {
            manifest_fn => $base->child("list.txt"),
            dir         => $base->child("texts"),
        }
    );
}

1;

__END__