view release on metacpan or  search on metacpan

lib/App/Basis/Config.pm  view on Meta::CPAN

# ----------------------------------------------------------------------------
# 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 "