File Coverage

blib/lib/Config/Trivial/JSON.pm

Criterion	Covered	Total	%
statement	75	77	97.4
branch	34	40	85.0
condition	36	45	80.0
subroutine	10	10	100.0
pod	3	3	100.0
total	158	175	90.2

#   $Id: JSON.pm 12 2014-06-04 22:14:15Z adam $

package Config::Trivial::JSON;

use base qw( Config::Trivial );

use 5.010;
use strict;
use Carp;
use warnings;
use JSON::MaybeXS;

our $VERSION = '0.02_01';
my ( $_package, $_file ) = caller;

#
#   STORE
#

sub store {
    my $self = shift;
    my %args = @_;

    my $file = $args{'config_file'}
        || $self->{_json_file}
        || $self->{_config_file};

    if ( (   ( $self->{_self} )
          && ( ( $file =~ '\(eval ' ) || ( $file =~ 'base.pm' ) ) )
        || ( $_file eq $file )
        || ( $0     eq $file ) )
    {
        return $self->_raise_error(
            'Not allowed to store to the calling file.');
    }

    if ( -e $file ) {
        croak "ERROR: Insufficient permissions to write to: $file"
            unless ( -w $file );
        rename $file, $file . $self->{_backup_char}
            or croak "ERROR: Unable to rename $file.";
    }

    my $settings = $args{'configuration'} || $self->{_configuration};

    if ( ! ( $settings && ref $settings eq 'HASH') ) {
        return $self->_raise_error(
            q{Configuration object isn't a HASH reference.})
    };

    my $json_text = encode_json( $settings );
    if ( $json_text ) {
        open my $json_file, '>', $file or croak "Unable to store to $file";
        print $json_file $json_text;
        close $json_file;
    }
    else {
        croak 'Unable to encode Per structure into JSON';
    }

    return 1;
}

#
#   RETRIEVE
#

sub retrieve {
    my $self = shift;
    my $key  = shift;    # If there is a key, return only it's value
    my $retrieved_hash_ref;
    my $file;

    if ( $self->{_config_file} && $self->{_json_file} ) {
        if ( $self->{_config_file} eq $self->{_json_file} ) {
            $file = $self->{_config_file};
        }
        elsif ( ( stat $self->{_config_file} )[9]
            > ( stat $self->{_json_file} )[9] )
        {
            return $self->read($key) if $key;
            return $self->read;
        }
        else {
            $file = $self->{_json_file};
        }
    }
    else {
        if ( $self->{_json_file} ) {
            $file = $self->{_json_file};
        }
        else {
            no warnings qw( uninitialized );
            if ((      ( $self->{_self} )
                    && ( defined $self->{_config_file} )
                    && (  ( $self->{_config_file} =~ '\(eval ' )
                       || ( $self->{_config_file} =~ 'base.pm' ) )
                )
                || ( $_file eq $self->{_config_file} )
                || ( $0     eq $self->{_config_file} )
                )
            {
                return $self->_raise_error(
                    q{Can't retrieve store from the calling file.});
            }
            $file = $self->{_config_file};
        }
    }

    return unless $self->_check_file( $file );

    open my $json_file, '<', $file
        or croak "ERROR: Unable to open JSON file: $file";
    my $json_lines;
    while ( <$json_file> ) {
        $json_lines .= $_;
     };
    close $json_file;

    eval { $retrieved_hash_ref = decode_json( $json_lines ); };

    if ( $@ ) {
        return $self->_raise_error(
            qq{$@} )
    }

    if ( ! ( $retrieved_hash_ref && ref $retrieved_hash_ref eq 'HASH') ) {
        return $self->_raise_error(
            q{Retrieved object isn't a HASH reference.})
    };

    $self->{_configuration} = $retrieved_hash_ref;

    return $self->{_configuration}->{$key} if $key;
    return $self->{_configuration};
}

#
#   SET JSON FILE
#

sub set_json_file {
    my $self               = shift;
    my $configuration_file = shift;

    if ( $self->_check_file( $configuration_file ) ) {
        $self->{_json_file} = $configuration_file;
        $self->{_self}          = 0;
        if ( ( $self->{_config_file} =~ '\(eval ' )
                ||  ($self->{_config_file} =~ 'base.pm' ) ) {
            delete $self->{_config_file};
        }
        return $self;
    }
    else {
        return;
    }
}

1;

__END__