File Coverage

blib/lib/Collectd/Plugins/Common.pm
Criterion Covered Total %
statement 33 34 97.0
branch 5 6 83.3
condition 1 3 33.3
subroutine 6 6 100.0
pod 1 1 100.0
total 46 50 92.0


line stmt bran cond sub pod time code
1             package Collectd::Plugins::Common;
2              
3 2     2   34978 use 5.006;
  2         6  
  2         59  
4 2     2   7 use strict;
  2         3  
  2         63  
5 2     2   14 use warnings;
  2         13  
  2         103  
6              
7 2     2   8 use vars qw/@ISA @EXPORT_OK/;
  2         3  
  2         109  
8 2     2   9 use Exporter;
  2         2  
  2         477  
9             push @ISA, qw/Exporter/;
10              
11             @EXPORT_OK = qw/recurse_config/;
12              
13             =head1 NAME
14              
15             Collectd::Plugins::Common - Common functions to be used by plugins
16              
17             =cut
18              
19             our $VERSION = '0.1001';
20              
21             =head1 SYNOPSIS
22              
23             package Collectd::Plugins::Mine;
24             use Collectd qw/:all/;
25             use Collectd::Plugins::Common qw/recurse_config/;
26              
27             =head1 FUNCTIONS
28              
29             None are exported by default.
30              
31             =head2 recurse_config
32              
33             Args: $config
34              
35             Traverses config hash as returned by the L plugin recursively.
36             This will return a nested data structure, similarly to L.
37              
38             =cut
39              
40             sub recurse_config {
41 22     22 1 141 my $config = shift;
42 22         22 my $key = $config -> {key};
43 22         15 my %inter;
44 22         18 my @children = @{$config -> {children}};
  22         34  
45 22 100       31 if (@children) {
46 5         7 for my $child (@children) {
47 21         38 my @next = recurse_config ($child);
48 21         29 $key =~ s/__/./; # collectd liboconfig won't allow dots in key names
49 21 50 33     59 if (defined $inter{$key}->{$next[0]} && ref $inter{$key}->{$next[0]}) {
50 0         0 $inter{$key}->{$next[0]} = [$inter{$key}->{$next[0]},$next[1]];
51             } else {
52 21         46 $inter{$key}->{$next[0]} = $next[1];
53             }
54             }
55 5         20 return %inter;
56             } else {
57 17         17 my $key = $config -> {key};
58 17         51 $key =~ s/__/./; # collectd liboconfig won't allow dots in key names
59 17 100       13 if (@{$config -> {values}} > 1) {
  17         29  
60 1         3 return ($key, $config -> {values});
61             } else {
62 16         44 return ($key, $config -> {values} -> [0]);
63             }
64             }
65             }
66              
67             =head1 AUTHOR
68              
69             Fabien Wernli, C<< >>
70              
71             =head1 BUGS
72              
73             Please report any bugs or feature requests to C, or through
74             the web interface at L. I will be notified, and then you'll
75             automatically be notified of progress on your bug as I make changes.
76              
77              
78              
79              
80             =head1 SUPPORT
81              
82             You can find documentation for this module with the perldoc command.
83              
84             perldoc Collectd::Plugins::Common
85              
86              
87             You can also look for information at:
88              
89             =over 4
90              
91             =item * RT: CPAN's request tracker (report bugs here)
92              
93             L
94              
95             =item * AnnoCPAN: Annotated CPAN documentation
96              
97             L
98              
99             =item * CPAN Ratings
100              
101             L
102              
103             =item * Search CPAN
104              
105             L
106              
107             =back
108              
109              
110             =head1 ACKNOWLEDGEMENTS
111              
112              
113             =head1 LICENSE AND COPYRIGHT
114              
115             Copyright 2012 Fabien Wernli.
116              
117             This program is free software; you can redistribute it and/or modify it
118             under the terms of either: the GNU General Public License as published
119             by the Free Software Foundation; or the Artistic License.
120              
121             See http://dev.perl.org/licenses/ for more information.
122              
123              
124             =cut
125              
126             1; # End of Collectd::Plugins::Common