File Coverage

blib/lib/HiPi/Utils/Config.pm

Criterion	Covered	Total	%
statement	24	90	26.6
branch	0	24	0.0
condition	0	3	0.0
subroutine	8	16	50.0
pod	0	3	0.0
total	32	136	23.5

#########################################################################################
# Package        HiPi::Utils::Config
# Description  : Config File Wrapper
# Copyright    : Copyright (c) 2017 Mark Dootson
# License      : This is free software; you can redistribute it and/or modify it under
#                the same terms as the Perl 5 programming language system itself.
#########################################################################################

package HiPi::Utils::Config;

#########################################################################################

use strict;
use warnings;
use parent qw( HiPi::Class );
use File::Path ( );

use JSON;
use Try::Tiny;
use Storable;
use Carp;

__PACKAGE__->create_ro_accessors( qw( configclass filepath default ) );
__PACKAGE__->create_accessors( qw( config _configkey ) );

our $VERSION ='0.81';

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

    my %params = (
        configclass => 'hipi',
        default    => {},
    );

    # get user params
    foreach my $key( keys (%userparams) ) {
        $params{$key} = $userparams{$key};
    }

    $params{'_configkey'} = '';

    $params{default}->{'hipi-config-version'} = $VERSION;

    my $fileroot = ( $> ) ? qq($ENV{HOME}/.hipi-perl) : '/etc/hipi-perl';
    my $filename = ( $> ) ? 'user.conf' : 'global.conf';

    my $dirpath = qq($fileroot/$params{configclass});

    File::Path::make_path($dirpath , { mode => 0700 } ) unless( -d $dirpath );

    $params{filepath} = $dirpath . '/' . $filename;

    my $self = $class->SUPER::new( %params );

    if( -f $self->filepath ) {
        $self->read_config;
        # update any new defaults
        my $conf = $self->config;
        my $updatedefaults = 0;
        for my $itemname ( keys %{ $params{default} } ) {
            if( !exists( $conf->{$itemname} ) || !defined($conf->{$itemname}) ) {
                $conf->{$itemname} = $params{default}->{$itemname};
                $updatedefaults = 1;
            }
        }
        $self->write_config if $updatedefaults;

    } else {
        $self->config( $self->default );
        $self->write_config;
    }

    return $self;
}

sub read_config {
    my $self = shift;
    open ( my $fh, '<:encoding(UTF-8)',  $self->filepath ) or croak( qq(failed to open config file : $!) );
    read( $fh, my $input, -s $fh);
    close( $fh );
    my $json = JSON->new;
    my $conf = try {
        my $decoded = $json->decode( $input );
        return $decoded;
    } catch {
        carp q(failed to decode configuration ) . $_;
        return { config_ok => 0 };
    };

    $Storable::canonical = 1;
    my $ckey = Storable::nfreeze( $conf );
    $Storable::canonical = 0;
    $self->_configkey( $ckey );
    $self->config( $conf );
    return 1;
}

sub write_config {
    my $self = shift;

    $Storable::canonical = 1;

    my $ckey = Storable::nfreeze( $self->config );
    $Storable::canonical = 0;
    if($ckey eq $self->_configkey) {
        # no need to write an unchanged config
        return 1;
    }

    $self->config->{epoch} = time();
    $ckey = Storable::nfreeze( $self->config );
    $self->_configkey( $ckey );

    open ( my $fh, '>:encoding(UTF-8)',  $self->filepath ) or croak( qq(failed to open config file : $!) );
    my $json = JSON->new;
    my $output = try {
        my $encoded = $json->pretty->canonical->encode( $self->config );
        return $encoded;
    } catch {
        carp q(failed to encode configuration ) . $_;
        return '';
    };
    if( $output ) {
        print $fh $output;
    }
    close( $fh );
    return 1;
}

sub DESTROY {
    # don't call super
    my $self = shift;
    if( $threads::threads ) {
        if( threads->tid == 0 )  {
            $self->write_config;
        }
    } else {
       $self->write_config;
    }
}


1;

__END__