File Coverage

blib/lib/Log/Saftpresse/Config.pm
Criterion Covered Total %
statement 9 49 18.3
branch 0 16 0.0
condition 0 9 0.0
subroutine 3 9 33.3
pod 0 4 0.0
total 12 87 13.7


line stmt bran cond sub pod time code
1             package Log::Saftpresse::Config;
2              
3 1     1   5 use Moose;
  1         2  
  1         12  
4              
5             # ABSTRACT: configuration option parser for Log::Saftpresse
6             our $VERSION = '1.6'; # VERSION
7              
8 1     1   10933 use Tie::IxHash;
  1         7198  
  1         66  
9 1     1   1432 use Config::General qw(ParseConfig);
  1         39934  
  1         988  
10              
11             sub ordered_hash_ref {
12 0     0 0   tie my %hash, 'Tie::IxHash', @_;
13 0           return \%hash;
14             }
15              
16             has 'defaults' => (
17             is => 'rw', lazy => 1,
18             default => sub {
19             tie my %defaults, "Tie::IxHash";
20             %defaults = (
21             'counters' => {
22             'flush_interval' => '0',
23             },
24             'logging' => {
25             level => 'INFO',
26             file => undef, # log to syslog
27             },
28             Input => ordered_hash_ref(
29             stdin => {
30             module => 'Stdin',
31             },
32             ),
33             Plugin => ordered_hash_ref(
34             syslog => {
35             module => 'SyslogFile',
36             },
37             ),
38             CounterOutput => ordered_hash_ref (
39             dump_counters => {
40             module => 'Dump',
41             },
42             ),
43             Output => ordered_hash_ref (
44             dump_json => {
45             module => 'JSON',
46             },
47             ),
48             );
49             return \%defaults;
50             },
51             );
52              
53             has 'config' => ( is => 'rw' );
54              
55             sub load_config {
56 0     0 0   my ( $self, $file ) = @_;
57 0 0         if( ! -f $file ) {
58 0           die('configuration file '.$file.' does not exist!');
59             }
60              
61 0           tie my %config_hash, "Tie::IxHash";
62 0           %config_hash = ParseConfig(
63             -AllowMultiOptions => 'no',
64             -ConfigFile => $file,
65             -Tie => "Tie::IxHash"
66             );
67 0           $self->config( \%config_hash );
68              
69 0           return;
70             }
71              
72             sub _get_hash_node {
73 0     0     my $hash = shift;
74 0           my @path = @_;
75 0           my $cur = $hash;
76              
77 0 0         if( ! defined $hash ) { return; }
  0            
78              
79 0           while( my $element = shift @path ) {
80 0 0 0       if( defined $cur->{$element}
81             && ref $cur->{$element} eq 'HASH' ) {
82 0           $cur = $cur->{$element};
83 0           } else { return; }
84             }
85              
86 0           return $cur;
87             }
88              
89             sub _get_hash_value {
90 0     0     my $hash = shift;
91 0           my $key = pop;
92 0           my @path = @_;
93              
94 0           my $cur = _get_hash_node( $hash, @path );
95              
96 0 0 0       if( defined $cur
      0        
97             && defined $cur->{$key}
98             && ! ref($cur->{$key}) ) {
99 0           return $cur->{$key};
100             }
101 0           return;
102             }
103              
104             sub get_node {
105 0     0 0   my $self = shift;
106 0           my $node;
107 0 0         if( $node = _get_hash_node( $self->config, @_ ) ) {
108 0           return $node;
109             }
110 0 0         if( $node = _get_hash_node( $self->defaults, @_ ) ) {
111 0           return $node;
112             }
113 0           return;
114             }
115              
116             sub get {
117 0     0 0   my $self = shift;
118 0           my $value;
119              
120 0 0         if( $value = _get_hash_value( $self->config, @_ ) ) {
121 0           return $value;
122             }
123 0 0         if( $value = _get_hash_value( $self->defaults, @_ ) ) {
124 0           return $value;
125             }
126 0           return;
127             }
128              
129             1;
130              
131             __END__
132              
133             =pod
134              
135             =encoding UTF-8
136              
137             =head1 NAME
138              
139             Log::Saftpresse::Config - configuration option parser for Log::Saftpresse
140              
141             =head1 VERSION
142              
143             version 1.6
144              
145             =head1 AUTHOR
146              
147             Markus Benning <ich@markusbenning.de>
148              
149             =head1 COPYRIGHT AND LICENSE
150              
151             This software is Copyright (c) 1998 by James S. Seymour, 2015 by Markus Benning.
152              
153             This is free software, licensed under:
154              
155             The GNU General Public License, Version 2, June 1991
156              
157             =cut