File Coverage

blib/lib/Clustericious/Config/Helpers.pm

Criterion	Covered	Total	%
statement	60	64	93.7
branch	7	10	70.0
condition			n/a
subroutine	17	18	94.4
pod	9	9	100.0
total	93	101	92.0

package Clustericious::Config::Helpers;

use strict;
use warnings;
use v5.10;
use Hash::Merge qw/merge/;
use Data::Dumper;
use Carp qw( croak );
use base qw( Exporter );
use JSON::XS qw( encode_json );

# ABSTRACT: Helpers for clustericious config files.
our $VERSION = '0.30'; # VERSION


our @mergeStack;
our @EXPORT = qw( extends_config get_password home file dir hostname hostname_full json yaml );


sub extends_config {
    my $filename = shift;
    my @args = @_;
    push @mergeStack, Clustericious::Config->new($filename, \@args);
    return '';
}

#
#
# do_merges:
#
# Called after reading all config files, to process extends_config
# directives.
#
sub _do_merges {
    my $class = shift;
    my $conf_data = shift; # Last one; Has highest precedence.

    return $conf_data unless @mergeStack;

    # Nested extends_config's form a tree which we traverse depth first.
    Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
    my %so_far = %{ shift @mergeStack };
    while (my $c = shift @mergeStack) {
        my %h = %$c;
        %so_far = %{ merge( \%so_far, \%h ) };
    }
    %$conf_data = %{ merge( \%so_far, $conf_data ) };
}


sub get_password {
    return Clustericious::Config::Password->sentinel;
}


sub home (;$)
{
  require File::HomeDir;
  $_[0] ? File::HomeDir->users_home($_[0]) : File::HomeDir->my_home;
}


sub file
{
  eval { require Path::Class::File };
  croak "file helper requires Path::Class" if $@;
  Path::Class::File->new(@_);
}


sub dir
{
  require Path::Class::Dir;
  croak "dir helper requires Path::Class" if $@;
  Path::Class::Dir->new(@_);
}


sub hostname
{
  state $hostname;

  unless(defined $hostname)
  {
    require Sys::Hostname;
    $hostname = Sys::Hostname::hostname();
    $hostname =~ s/\..*$//;
  }

  $hostname;
}


sub hostname_full
{
  require Sys::Hostname;
  Sys::Hostname::hostname();
}


sub json ($)
{
  encode_json($_[0]);
}


sub yaml ($)
{
  require YAML::XS;
  local $YAML::UseHeader = 0;
  my $str = YAML::XS::Dump($_[0]);
  $str =~ s{^---\n}{};
  $str;
}


1;

__END__