File Coverage

blib/lib/App/Basis/Config.pm

Criterion	Covered	Total	%
statement	94	109	86.2
branch	21	34	61.7
condition	3	9	33.3
subroutine	17	21	80.9
pod	4	5	80.0
total	139	178	78.0

# ABSTRACT: Manage config YAML files in a simple manner



package App::Basis::Config;
$App::Basis::Config::VERSION = '1.0';
use 5.010;
use warnings;
use strict;
use Moo;
use YAML::XS qw( Load Dump);
use Path::Tiny;
use Try::Tiny;
use App::Basis;



# ----------------------------------------------------------------------------
# the raw config data hash
has raw => (
    is   => 'ro',
    lazy => 1,

    # builder  => '_load',
    init_arg => undef,        # dont allow setting in constructor
    default  => sub { {} },
    writer   => '_set_raw'
);

has filename => (
    is       => 'ro',
    required => 0,
    writer   => '_set_filename'
);

has nostore => (
    is      => 'ro',
    default => sub {0}
);

has die_on_error => (
    is      => 'ro',
    default => sub {0}
);


has has_data => (
    is       => 'ro',
    default  => sub {0},
    init_arg => undef,            # dont allow setting in constructor
    writer   => '_set_has_data'
);


has changed => (
    is       => 'rw',
    default  => sub {0},
    init_arg => undef,     # dont allow setting in constructor
                           # writer   => '_set_changed'
);


has error => (
    is       => 'ro',
    default  => sub {undef},
    init_arg => undef,         # dont allow setting in constructor
    writer   => '_set_error'
);

# ----------------------------------------------------------------------------


sub BUILD {
    my $self = shift;

    $self->_set_error(undef);

    # make sure that the we expand home
    my $fname = fix_filename( $self->filename );

    if ( !$fname ) {
        $fname = $ENV{APP_BASIS_CFG} || fix_filename( "~/." . get_program() . ".cfg" );
    }
    if ( $fname && -f $fname ) {
        $self->_set_filename($fname);

        my $config;
        try {
            $config = Load( path($fname)->slurp_utf8 );
        }
        catch {
            $self->_set_error(
                "Could not read/processs config file $fname. $_");
        };

        # if there was a file to read from and we had an issue then we should
        # report it back to the caller somehow and make sure its seen.
        if ( $self->error ) {
            die $self->error if ( $self->die_on_error );
            warn $self->error;
        }

        # if we loaded some config
        if ( keys %$config ) {
            $self->_set_has_data(1);
            $self->_set_raw($config);
        }
    }
    else {
        $self->_set_error("could not establish a config filename");
        die $self->error if ( $self->die_on_error );
    }
}

# ----------------------------------------------------------------------------


sub store {
    my $self      = shift;
    my $filename  = shift;
    my $need_save = 0;
    my $status    = 0;

    local $YAML::Indent = 4;

    $self->_set_error(undef);
    if ( !$filename ) {
        $filename = $self->filename;
        $need_save = 1 if ( $self->changed );
    }
    else {
        $need_save = 1;
    }

    # only save if we need to
    if ($need_save) {
        if ( $self->nostore ) {
            warn "Attempt to save config file "
                . $self->filename
                . " when nostore has been used";
            return 0;
        }

        # do the save
        my $cfg = $self->raw;
        try {
            # do we need to create the directory to hold the file
            if ( !-d path($filename)->dirname ) {
                path($filename)->dirname->mkpath;
            }
            path($filename)->spew_utf8( Dump($cfg) );
        }
        catch {
            $self->_set_error(
                "Could not save config file " . $self->filename() );
            $status = 0;
        };
        die $self->error if ( $self->error && $self->die_on_error );
        $self->changed(0);
        $status = 1;
    }

    return $status;
}

# ----------------------------------------------------------------------------
# return a ref to a item in the config or undef
# if $value is true then a path will be established and the value stored as the
# final node

sub _split_path {
    my $self = shift;
    my ( $path, $value ) = @_;
    my $done            = 0;
    my $path_separators = '/:\.';

    # remove any leading/trailing path separators
    $path =~ s|^[$path_separators]?(.*)[$path_separators]?$|$1|;

    my $ref = $self->raw;
    my @items = split( /[$path_separators]/, $path );
    try {
        for ( my $i = 0; $i < scalar(@items); $i++ ) {
            my $item = $items[$i];
            if ( $ref->{$item} ) {
                $ref  = $ref->{$item};
                $done = 1;
            }
            else {
                if ($value) {

                    # is this the last thing?
                    if ( ( $i + 1 ) == scalar(@items) ) {

                        # save the value in the last node
                        $ref->{$item} = $value;
                    }
                    else {
                        $ref->{$item} = {};
                    }
                    $ref  = $ref->{$item};
                    $done = 1;
                }
                else {

                    # missed item
                    $done = 0;
                }
            }
        }
    }
    catch {};

    return $done ? $ref : undef;
}

# ----------------------------------------------------------------------------


sub get {
    my $self = shift;
    my $path = shift;

    $self->_set_error(undef);

    my $ref = $self->_split_path($path);

    return $ref;
}

# ----------------------------------------------------------------------------


sub set {
    my $self = shift;
    my ( $path, $value ) = @_;

    $self->_set_error(undef);

    # create the path to the item
    my $ref = $self->_split_path( $path, $value );

    # if we loaded some config
    $self->_set_has_data(1) if ( keys %{ $self->raw() } );

    # something has changed so we may need to save it later
    $self->changed(1);
}

# ----------------------------------------------------------------------------


sub clear {
    my $self = shift;
    my ( $path, $value ) = @_;

    $self->_set_error(undef);

    $self->raw = {};
    $self->_set_has_data(0);

    # something has changed so we may need to save it later
    $self->changed(1);
}

# ----------------------------------------------------------------------------
# make sure we do any cleanup required

END {
}


# ----------------------------------------------------------------------------

1;

__END__