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


line stmt bran cond sub pod time code
1             package Clustericious::Config::Helpers;
2              
3 16     16   91 use strict;
  16         35  
  16         654  
4 16     16   89 use warnings;
  16         30  
  16         471  
5 16     16   326 use v5.10;
  16         55  
  16         982  
6 16     16   14743 use Hash::Merge qw/merge/;
  16         52324  
  16         1068  
7 16     16   7635 use Data::Dumper;
  16         13353  
  16         797  
8 16     16   107 use Carp qw( croak );
  16         37  
  16         667  
9 16     16   85 use base qw( Exporter );
  16         30  
  16         1245  
10 16     16   1892 use JSON::XS qw( encode_json );
  16         7646  
  16         11601  
11              
12             # ABSTRACT: Helpers for clustericious config files.
13             our $VERSION = '0.29'; # VERSION
14              
15              
16             our @mergeStack;
17             our @EXPORT = qw( extends_config get_password home file dir hostname hostname_full json yaml );
18              
19              
20             sub extends_config {
21 3     3 1 2119 my $filename = shift;
22 3         6 my @args = @_;
23 3         34 push @mergeStack, Clustericious::Config->new($filename, \@args);
24 3         12 return '';
25             }
26              
27             #
28             #
29             # do_merges:
30             #
31             # Called after reading all config files, to process extends_config
32             # directives.
33             #
34             sub _do_merges {
35 25     25   47 my $class = shift;
36 25         42 my $conf_data = shift; # Last one; Has highest precedence.
37              
38 25 100       116 return $conf_data unless @mergeStack;
39              
40             # Nested extends_config's form a tree which we traverse depth first.
41 3         15 Hash::Merge::set_behavior( 'RIGHT_PRECEDENT' );
42 3         64 my %so_far = %{ shift @mergeStack };
  3         24  
43 3         29 while (my $c = shift @mergeStack) {
44 0         0 my %h = %$c;
45 0         0 %so_far = %{ merge( \%so_far, \%h ) };
  0         0  
46             }
47 3         4 %$conf_data = %{ merge( \%so_far, $conf_data ) };
  3         13  
48             }
49              
50              
51             sub get_password {
52 0     0 1 0 return Clustericious::Config::Password->sentinel;
53             }
54              
55              
56             sub home (;$)
57             {
58 4     4 1 20 require File::HomeDir;
59 4 100       39 $_[0] ? File::HomeDir->users_home($_[0]) : File::HomeDir->my_home;
60             }
61              
62              
63             sub file
64             {
65 1     1 1 20 eval { require Path::Class::File };
  1         5  
66 1 50       5 croak "file helper requires Path::Class" if $@;
67 1         7 Path::Class::File->new(@_);
68             }
69              
70              
71             sub dir
72             {
73 1     1 1 32 require Path::Class::Dir;
74 1 50       4 croak "dir helper requires Path::Class" if $@;
75 1         8 Path::Class::Dir->new(@_);
76             }
77              
78              
79             sub hostname
80             {
81 1     1 1 2 state $hostname;
82            
83 1 50       4 unless(defined $hostname)
84             {
85 1         5 require Sys::Hostname;
86 1         9 $hostname = Sys::Hostname::hostname();
87 1         8 $hostname =~ s/\..*$//;
88             }
89            
90 1         2 $hostname;
91             }
92              
93              
94             sub hostname_full
95             {
96 1     1 1 4 require Sys::Hostname;
97 1         10 Sys::Hostname::hostname();
98             }
99              
100              
101             sub json ($)
102             {
103 1     1 1 25 encode_json($_[0]);
104             }
105              
106              
107             sub yaml ($)
108             {
109 1     1 1 5 require YAML::XS;
110 1         1 local $YAML::UseHeader = 0;
111 1         128 my $str = YAML::XS::Dump($_[0]);
112 1         7 $str =~ s{^---\n}{};
113 1         3 $str;
114             }
115              
116              
117             1;
118              
119             __END__