File Coverage

blib/lib/Clustericious/Config.pm

Criterion	Covered	Total	%
statement	154	174	88.5
branch	59	74	79.7
condition	20	31	64.5
subroutine	27	32	84.3
pod	3	5	60.0
total	263	316	83.2

package Clustericious::Config;

use strict;
use warnings;
use v5.10;

# ABSTRACT: Configuration files for Clustericious nodes.
our $VERSION = '0.30'; # VERSION


use Clustericious::Config::Password;
use List::Util;
use JSON::XS;
use YAML::XS ();
use Mojo::Template;
use Log::Log4perl qw/:easy/;
use Storable;
use Clustericious::Config::Helpers ();
use Data::Dumper;
use Cwd ();
use Module::Build;
use File::HomeDir ();

our %Singletons;

sub _is_subdir {
    my ($child,$parent) = @_;
    my $p = Cwd::abs_path($parent);
    my $c = Cwd::abs_path($child);
    return ($c =~ m[^\Q$p\E]) ? 1 : 0;
}

my $is_test = 0;
sub _testing {
  my($class, $new) = @_;
  $is_test = $new if defined $new;
  $is_test;
}

our $class_suffix = {};
sub _uncache {
    my($class, $name) = @_;
    delete $Clustericious::Config::Singletons{$name};
    $class_suffix->{$name} //= 1;
    $class_suffix->{$name}++;
}

sub pre_rendered { }
sub rendered { }


sub new {
    my $class = shift;
    my %t_args = (ref $_[-1] eq 'ARRAY' ? @{( pop )} : () );
    my $arg = $_[0];
    ($arg = caller) =~ s/:.*$// unless $arg; # Determine from caller's class
    return $Singletons{$arg} if exists($Singletons{$arg});


    my $we_are_testing_this_module = 0;
    if(__PACKAGE__->_testing) {
        $we_are_testing_this_module = 0;
    }

    my $conf_data;

    my $json = JSON::XS->new;

    state $package_counter = 0;
    my $namespace = "Clustericious::Config::TemplatePackage::Package$package_counter";
    eval qq{ package $namespace; use Clustericious::Config::Helpers; };
    die $@ if $@;
    $package_counter++;

    my $mt = Mojo::Template->new(namespace => $namespace)->auto_escape(0);
    $mt->prepend( join "\n", map " my \$$_ = q{$t_args{$_}};", sort keys %t_args );

    my $filename;
    if (ref $arg eq 'SCALAR') {
        $class->pre_rendered( $$arg );
        my $rendered = $mt->render($$arg);
        $class->rendered( SCALAR => $rendered );
        die $rendered if ( (ref($rendered)) =~ /Exception/ );
        my $type = $rendered =~ /^---/ ? 'yaml' : 'json';
        $conf_data = $type eq 'yaml' ?
           eval { YAML::XS::Load( $rendered ); }
         : eval { $json->decode( $rendered ); };
        LOGDIE "Could not parse $type \n-------\n$rendered\n---------\n$@\n" if $@;
    } elsif (ref $arg eq 'HASH') {
        $conf_data = Storable::dclone $arg;
    } elsif (
          $we_are_testing_this_module
          && !(
              $ENV{CLUSTERICIOUS_CONF_DIR}
              && _is_subdir( $ENV{CLUSTERICIOUS_CONF_DIR}, Cwd::getcwd() )
          )) {
          $conf_data = {};
    } else {
        my @conf_dirs;

        @conf_dirs = $ENV{CLUSTERICIOUS_CONF_DIR} if defined( $ENV{CLUSTERICIOUS_CONF_DIR} );

        push @conf_dirs, ( File::HomeDir->my_home . "/etc", "/util/etc", "/etc" ) unless $we_are_testing_this_module || __PACKAGE__->_testing;
        my $conf_file = "$arg.conf";
        $conf_file =~ s/::/-/g;
        my ($dir) = List::Util::first { -e "$_/$conf_file" } @conf_dirs;
        if ($dir) {
            TRACE "reading from config file $dir/$conf_file";
            $filename = "$dir/$conf_file";
            $class->pre_rendered( $filename );
            my $rendered = $mt->render_file($filename);
            $class->rendered( $filename => $rendered );
            die $rendered if ( (ref $rendered) =~ /Exception/ );
            my $type = $rendered =~ /^---/ ? 'yaml' : 'json';
            if ($ENV{CL_CONF_TRACE}) {
                warn "configuration ($type) : \n";
                warn $rendered;
            }
            $conf_data =
              $type eq 'yaml'
              ? eval { YAML::XS::Load($rendered) }
              : eval { $json->decode($rendered) };
            LOGDIE "Could not parse $type\n-------\n$rendered\n---------\n$@\n" if $@;
        } else {
            TRACE "could not find $conf_file file in: @conf_dirs" unless $dir;
            $conf_data = {};
        }
    }
    $conf_data ||= {};
    Clustericious::Config::Helpers->_do_merges($conf_data);
    _add_heuristics($filename,$conf_data);
    # Use derived classes so that AUTOLOADING keeps namespaces separate
    # for various apps.
    if ($class eq __PACKAGE__) {
        if (ref $arg) {
            $arg = "$arg";
            $arg =~ tr/a-zA-Z0-9//cd;
        }
        $class = join '::', $class, 'App', $arg;
        $class .= $class_suffix->{$arg} if $class_suffix->{$arg};
        my $dome = '@'."$class"."::ISA = ('".__PACKAGE__. "')";
        eval $dome;
        die "error setting ISA : $@" if $@;
    }
    bless $conf_data, $class;
}

sub _add_heuristics {
    my $filename = shift;
    # Account for some mojo api changes
    my $conf_data = shift;
    if ($conf_data->{hypnotoad} && !ref($conf_data->{hypnotoad}{listen})) {
        warn "# hypnotoad->listen should be an arrayref in $filename\n";
        $conf_data->{hypnotoad}{listen} = [ $conf_data->{hypnotoad}{listen} ];
    }


}


sub dump_as_yaml {
    my $c = shift;
    return YAML::XS::Dump($c);
}

sub _stringify {
    my $self = shift;
    return join ' ', map { ($_, $self->{$_}) } sort keys %$self;
}

sub DESTROY {
}

sub AUTOLOAD {
    my $self = shift;
    my %args = @_;
    my $default = $args{default};
    my $default_exists = exists $args{default};
    our $AUTOLOAD;
    my $called = $AUTOLOAD;
    $called =~ s/.*:://g;
    if ($default_exists && !exists($self->{$called})) {
        $self->{$called} = $args{default};
    }
    Carp::cluck "config element '$called' not found for ".(ref $self)." (".(join ',',keys(%$self)).")"
        if $called =~ /^_/ || !exists($self->{$called});
    my $value = $self->{$called};
    my $obj;
    my $invocant = ref $self;
    if (ref $value eq 'HASH') {
        $obj = $invocant->new($value);
    }
    no strict 'refs';
    *{ $invocant . "::$called" } = sub {
          my $self = shift;
          $self->{$called} = $default if $default_exists && !exists($self->{$called});
          die "'$called' not found in ".join ',',keys(%$self)
              unless exists($self->{$called});
          my $value = $self->{$called};
          return wantarray && (ref $value eq 'HASH' ) ? %$value
          : wantarray && (ref $value eq 'ARRAY') ? @$value
          :                       defined($obj)  ? $obj
          : Clustericious::Config::Password->is_sentinel($value) ? Clustericious::Config::Password->get
          :                                        $value;
    };
    use strict 'refs';
    $self->$called;
}


sub set_singleton {
    my $class = shift;
    my $app = shift;
    my $obj = shift;
    our %Singletons;
    $Singletons{$app} = $obj;
}


1;


__END__