File Coverage

blib/lib/Test/Collectd/Plugins.pm
Criterion Covered Total %
statement 171 190 90.0
branch 43 74 58.1
condition 5 9 55.5
subroutine 26 26 100.0
pod 5 5 100.0
total 250 304 82.2


line stmt bran cond sub pod time code
1             package Test::Collectd::Plugins;
2              
3 5     5   154073 use 5.006;
  5         14  
  5         128  
4 5     5   15 use strict;
  5         7  
  5         123  
5 5     5   22 use warnings;
  5         8  
  5         113  
6 5     5   22 use Carp qw(croak cluck);
  5         5  
  5         276  
7 5     5   2140 use POSIX qw/isdigit/;
  5         23204  
  5         26  
8 5     5   5717 use namespace::autoclean;
  5         61116  
  5         26  
9 5     5   2228 use Test::Collectd::Config qw(parse);
  5         17  
  5         372  
10              
11 5     5   2864 BEGIN {use Package::Alias Collectd => "FakeCollectd"}
  5     5   1830  
  5         22  
  5         1237  
12              
13             =head1 NAME
14              
15             Test::Collectd::Plugins - Common out-of-band collectd plugin test suite
16              
17             =head1 VERSION
18              
19             Version 0.1008
20              
21             =cut
22              
23             our $VERSION = '0.1008';
24              
25 5     5   25 use base 'Test::Builder::Module';
  5         4  
  5         1078  
26 5     5   15703 use IO::File;
  5         6  
  5         3140  
27              
28             our @EXPORT = qw(load_ok read_ok read_config_ok read_values $typesdb);
29              
30             our $typesdb;
31              
32             sub import_extra {
33 4     4 1 149 my $class = shift;
34 4         7 my $list = shift;
35 4         6 my $args;
36 4 50       13 $args = @$list == 1 ? $list->[0] : {@$list};
37 4         7 @$list = ();
38 4 50 33     26 croak __PACKAGE__." can receive either a hash or a hash reference."
39             unless ref $args and ref $args eq "HASH";
40 4         12 for (keys %$args) {
41 0 0       0 if (/^typesdb$/i) {
42 0         0 $typesdb = $args->{$_};
43             } else {
44 0         0 push @$list, $_ => $args->{$_};
45             }
46             }
47 4         67 return;
48             }
49              
50             =head1 SYNOPSIS
51              
52             use Test::More;
53             use Test::Collectd::Plugins typesdb => ["/usr/share/collectd/types.db"];
54              
55             plan tests => 4;
56              
57             load_ok ("Collectd::Plugins::Some::Plugin");
58             read_ok ("Collectd::Plugins::Some::Plugin", "plugin_name_as_returned_by_dispatch");
59             read_config_ok ("My::Plugin", "my_plugin", "/path/to/my_plugin.conf");
60              
61             my $expected = [[{{ plugin => "my_plugin", type => "gauge", values => [ 42 ] }}]];
62             my $got = read_values_config ("My::Plugin", "my_plugin", "/path/to/my_plugin.conf");
63              
64             is_deeply ($got, $expected);
65              
66             done_testing;
67              
68             Testing collectd modules outside of collectd's perl interpreter is tedious, as you cannot
69             simply 'use' them. In fact you can't even 'use Collectd', try it and come back.
70             This module lets you test collectd plugins outside of the collectd daemon. It is supposed
71             to be the first step in testing plugins, detecting syntax errors and common mistakes.
72             There are some caveats (see dedicated section), and you should use the usual collectd testing
73             steps afterwards e.g. enabling debug at compile time, then running the collectd binary in
74             the foreground while using some logging plugin, plus some write plugin. I usually use logfile
75             to STDOUT and csv plugin.
76              
77             =head1 MODULE vs. PLUGIN
78              
79             Most methods will accept either $plugin or $module or both. They correspond to C's C and C respectively. It's easy to mistake one for the other. While $module is as its name suggests the perl module's name, $plugin corresponds to the collectd plugin's name, as called by plugin_dispatch_values. This difference makes it possible for a plugin to dispatch values on behalf of another, or to register multiple plugins. Make sure you ask the methods the right information.
80              
81             =head1 SUBROUTINES/METHODS
82              
83             =head2 load_ok <$module> <$message>
84              
85             Tries to load the plugin module. As collectd-perl plugin modules contain direct calls (upon loading) to L, the former are intercepted by L which is part of this distribution. This has the effect of populating the %FakeCollectd hash. See L for more info.
86              
87             =cut
88              
89             sub load_ok ($;$) {
90 16     16 1 8448 my $module = shift;
91 16   100     53 my $msg = shift || "load OK";
92 16         24 _load_module($module);
93 16         255 __PACKAGE__->builder->is_eq($@, "", $msg);
94             }
95              
96             sub _load_module ($) {
97 40     40   38 my $module = shift;
98 40         2223 eval "require $module";
99             }
100              
101             sub _init_plugin ($) {
102 22 50   22   78 my $plugin = shift or die "_init_plugin needs plugin name";
103 22         59 my $init = $FakeCollectd{$plugin}->{Callback}->{Init};
104 22 100       43 if (defined $init) {
105 4         195 eval "$init()";
106             } else {
107 18         26 return 1;
108             }
109 4 50       32 if ($@) {
110 0         0 return undef;
111             } else {
112 4         8 return $init;
113             }
114             }
115              
116             sub _read ($) {
117 4 50   4   13 my $plugin = shift or die "_read needs plugin name";
118 4         14 my $reader = $FakeCollectd{$plugin}->{Callback}->{Read};
119 4 50       12 if (defined $reader) {
120 4         274 eval "$reader()";
121 4         56 return $reader;
122             } else {
123 0         0 eval { die "_read: No reader defined for plugin `$plugin'" };
  0         0  
124 0         0 return undef;
125             }
126             }
127              
128             sub _reset_values ($) {
129 8     8   16 my $plugin = shift;
130 8 100       31 if (exists $FakeCollectd{$plugin}->{Values}) {
131 4         6 undef @{$FakeCollectd{$plugin}->{Values}};
  4         11  
132             }
133 8         25 return 1;
134             }
135              
136             sub _values ($) {
137 4 50   4   13 my $plugin = shift or die "_values needs plugin name";
138 4 50       17 if (exists $FakeCollectd{$plugin}->{Values}) {
139 4         7 return @{$FakeCollectd{$plugin}->{Values}}
  4         16  
140             } else {
141             return undef
142 0         0 }
143             }
144              
145             sub _config ($$) {
146 4 50   4   14 my $plugin = shift or die "_config(plugin,config)";
147 4 50       11 my $cfg = shift or die "_config(plugin,config)";
148              
149 4         13 my $cb = $FakeCollectd{$plugin}->{Callback}->{Config};
150 4 50       8 unless ($cb) {
151 0         0 eval {croak "plugin $plugin does not provide a config callback"};
  0         0  
152 0         0 return undef;
153             }
154 4 50       19 my $config = Test::Collectd::Config::parse($cfg) or croak "failed to parse config";
155             # this fires up the plugin's config callback with provided config
156 5     5   24 eval {no strict "refs"; &$cb($config)}; # or croak("config callback $cb failed: $@");
  5         6  
  5         5690  
  4         6  
  4         29  
157 4 50       51 if ($@) {
158 0         0 return undef;
159             } else {
160 4         16 return $config;
161             }
162             }
163              
164             =head2 plan tests => $num
165              
166             See L.
167              
168             =cut
169              
170             #sub plan { __PACKAGE__ -> builder -> plan (@_) }
171             #sub diag { __PACKAGE__ -> builder -> diag (@_) }
172              
173             =head2 read_ok <$module> <$plugin> [$message]
174              
175             Loads the plugin module identified by $module, then tries to fire up the registered read callback for this plugin ($plugin), while intercepting all calls to L, storing its arguments into the %FakeCollectd hash. The latter are checked against the following rules, which match the collectd guidelines:
176              
177             =over 2
178              
179             =cut
180              
181             sub read_ok ($$;$) {
182 4     4 1 824 my $module = shift;
183 4         6 my $plugin = shift;
184 4   50     11 my $msg = shift || "read OK";
185              
186 4         22 my $tb = __PACKAGE__->builder;
187              
188             $tb -> subtest($msg, sub {
189              
190 4 50   4   1669 $tb -> ok (_load_module($module), "load plugin module") or $tb -> diag ($@);
191 4 50       919 $tb -> ok (_reset_values($module), "reset values") or $tb -> diag ($@);
192 4 50       902 $tb -> ok (_init_plugin($plugin),"init plugin"); $tb -> diag ($@) if $@;
  4         929  
193 4 50       15 $tb -> ok (_read($plugin),"read plugin") or $tb -> diag ($@);
194 4         1135 my @values = _values ($module);
195 4 50       14 $tb -> ok(@values, "read callback returned some values") or $tb -> diag ($@);
196 4         1137 $tb -> ok(scalar @values, "dispatch called");
197 4         870 for (@values) {
198 5         353 $tb->is_eq(ref $_,"ARRAY","value is array");
199              
200             =item * There shall be only one and only one hashref argument
201              
202             =cut
203              
204 5         1563 $tb -> ok(scalar @$_, "plugin called dispatch with arguments");
205 5         1107 $tb -> cmp_ok (@$_, '>', 1, "only one value_list expected");
206 5         1484 my $ref = ref $_->[0];
207 5         25 $tb -> is_eq($ref, "HASH", "value is HASH"); # this should be handled already earlier
208 5         1540 my %dispatch = %{$_->[0]};
  5         35  
209              
210             =item * The following keys are mandatory: plugin, type, values
211              
212             =cut
213              
214 5         14 for (qw(plugin type values)) {
215 15 50       2217 $tb -> ok(exists $dispatch{$_}, "mandatory key '$_' exists") or return;
216             }
217              
218             =item * Only the following keys are valid: plugin, type, values, time, interval, host, plugin_instance, type_instance.
219              
220             =cut
221              
222 5         1158 for (keys %dispatch) {
223 35         9201 $tb -> like ($_, qr/^(plugin|type|values|time|interval|host|plugin_instance|type_instance)$/, "key $_ is valid");
224             }
225              
226             =item * The key C must be present in the C file.
227              
228             =cut
229              
230 5         1520 my @type = _get_type($dispatch{type});
231 5         33 $tb -> ok (scalar @type, "type $dispatch{type} found in " . join (", ", @$typesdb));
232              
233             =item * The key C must be an array reference and the number of elements must match its data type in module's configuration option C.
234              
235             =cut
236              
237 5         1076 my $vref = ref $dispatch{values};
238 5         19 $tb -> is_eq ($vref, "ARRAY", "values is ARRAY");
239 5         1588 $tb -> is_eq(scalar @{$dispatch{values}}, scalar @type, "number of dispatched 'values' matches type spec for '$dispatch{type}'");
  5         31  
240              
241 5         1604 my $i=0;
242 5         8 for (@{$dispatch{values}}) {
  5         17  
243 9         73 $tb -> ok (defined $_, "value $i for $dispatch{plugin} ($dispatch{type}) is defined");
244 9         1909 $i++;
245             }
246              
247             =item * All other keys must be scalar strings with at most 63 characters: C, C, C, C and C.
248              
249             =cut
250              
251 5         16 for (qw(plugin type host plugin_instance type_instance)) {
252 25 50       5658 if (exists $dispatch{$_}) {
253 25         33 my $ref = ref $dispatch{$_};
254 25         66 $tb -> is_eq ($ref, "", "$_ is SCALAR");
255 25 50       7085 $tb -> cmp_ok(length $dispatch{$_}, '<', 63, "$_ is valid") if $dispatch{$_};
256             }
257             }
258              
259             =item * The keys C
260              
261             =cut
262              
263 5         1356 for (qw(time interval)) {
264 10 100       26 if (exists $dispatch{$_}) {
265 5         21 $tb -> cmp_ok($dispatch{$_},'>',0,"$_ is valid");
266             }
267             }
268              
269             =item * The keys C, C and C may use all ASCII characters except "/".
270              
271             =cut
272              
273 5         1457 for (qw/host plugin_instance type_instance/) {
274 15 50       3304 if (exists $dispatch{$_}) {
275 15         82 $tb -> unlike($dispatch{$_}, qr/\//, "$_ valid");
276             }
277             }
278              
279             =item * The keys C and C may use all ASCII characters except "/" and "-".
280              
281             =cut
282              
283 5         1543 for (qw/plugin type/) {
284 10 50       1430 if (exists $dispatch{$_}) {
285 10         48 $tb -> unlike($dispatch{$_}, qr/[\/-]/, "$_ valid");
286             }
287             }
288              
289             =back
290              
291             =cut
292              
293             }
294 4         71 }); # end subtest
295             }
296              
297             =head2 read_config_ok <$module> <$plugin> <$config> [$message]
298              
299             Same as L but also reads configuration from $plugin_config and fires up the configuration callback of plugin $plugin_module. L will kindly format a configuration file or handle to suit this subroutine.
300              
301             =cut
302              
303             sub read_config_ok ($$$;$) {
304 2     2 1 16 my $module = shift;
305 2         3 my $plugin = shift;
306 2         4 my $config = shift;
307 2   50     7 my $msg = shift || "read with config OK";
308              
309 2         20 my $tb = __PACKAGE__->builder;
310             $tb -> subtest($msg, sub {
311 2     2   982 $tb -> plan ( tests => 3 );
312 2         141 $tb -> ok (_load_module($module), "load plugin module");
313 2 50       456 $tb -> ok (_config($plugin,$config),"config ok") or $tb -> diag ($@);
314 2         445 read_ok ($module,$plugin,$msg);
315             }
316 2         32 );
317             }
318              
319              
320             =head2 read_values (module, plugin, [ config ])
321              
322             Returns arrayref containing the list of arguments passed to L. Example:
323              
324             [
325             # first call to L
326             [
327             { plugin => "myplugin", type => "gauge", values => [ 1 ] },
328             ],
329             # second call to L
330             [
331             { plugin => "myplugin", type => "gauge", values => [ 2 ] },
332             ],
333             ]
334              
335             A config hash can be provided for plugins with a config callback. The format of this hash must be the same as the one described in C's manpage (grep for "Config-Item").
336             Use L for conveniently yielding such a hash from a collectd configuration file. Only the section concerning the plugin should be provided, e.g. without all global collectd config sections.
337              
338             =cut
339              
340             sub read_values ($$;$) {
341 18     18 1 8952 my $module = shift;
342 18         21 my $plugin = shift;
343 18         17 my $config = shift;
344 18         36 _load_module($module);
345 18         55 _init_plugin($plugin);
346             # plugin with config callback
347 18 100       31 if ($config) {
348 2         7 _config($plugin,$config);
349             #unless (ref $config eq "HASH") {
350             #croak "third param to read_values must be a valid config hash";
351             #}
352             #my $cb = $FakeCollectd{$plugin}->{Callback}->{Config};
353             #unless ($cb) {
354             #croak "plugin $plugin does not provide a config callback";
355             #}
356             ## this fires up the plugin's config callback with provided config
357             #eval {no strict "refs"; &$cb($config)} or croak("config callback $cb failed: $@");
358             }
359             #
360 18         31 my $reader = $FakeCollectd{$plugin}->{Callback}->{Read};
361 18 100       71 return unless $reader;
362 4         12 _reset_values($plugin);
363 4         185 eval "$reader()";
364 4 50       42 return if $@;
365 4 50       14 if (exists $FakeCollectd{$plugin}->{Values}) {
366 4         5 @{$FakeCollectd{$plugin}->{Values}};
  4         20  
367             } else {
368 0         0 return;
369             }
370             }
371              
372             sub _get_type {
373 5     5   11 my $type = shift;
374 5 100       15 if ($typesdb) {
375 3         7 my $ref = ref $typesdb;
376 3 50       16 if ($ref eq "HASH") {
    50          
377 0         0 warn "typesdb is a hash, discarding its keys";
378 0         0 $typesdb = [values %$typesdb];
379             } elsif ($ref eq "") {
380 0         0 $typesdb = [ $typesdb ];
381             }
382             } else {
383 2         19 require File::ShareDir;
384 2         12 $typesdb = [ File::ShareDir::module_file(__PACKAGE__, "types.db") ];
385 2         597 warn "no typesdb - using builtin ", join ", ", @$typesdb;
386             }
387 5         17 for my $file (@$typesdb) {
388 5         45 my $fh = IO::File -> new($file, "r");
389 5 50       565 unless ($fh) {
390 0         0 cluck "Error opening types.db: $!";
391 0         0 return undef;
392             }
393 5         107 while (<$fh>) {
394 377         468 my ($t, @ds) = split /\s+/, $_;
395 377 100       702 if ($t eq $type) {
396 5         6 my @ret;
397 5         14 for (@ds) {
398 9         23 my @stuff = split /:/;
399 9         38 push @ret, {
400             ds => $stuff[0],
401             type => $stuff[1],
402             min => $stuff[2],
403             max => $stuff[3],
404             };
405             }
406 5         67 return @ret;
407             }
408             }
409             }
410 0           return ();
411             }
412              
413             =head1 CAVEATS
414              
415             =head2 FakeCollectd
416              
417             This module tricks the tested collectd plugins into loading L instead of L, and replaces calls thereof by simple functions which populate the %FakeCollectd:: hash in order to store its arguments. As it uses the name of the calling plugin module for its symbols, subsequent calls to the test subs are not really independant, which is suboptimal especially for a test module. If you have a saner solution to do this, please let me know.
418              
419             =head2 methods
420              
421             Replacements for most common L methods are implemented, as well as constants. We may have missed some or many, and as new ones are added to the main collectd tree, we will have to keep up to date.
422              
423             =head2 config
424              
425             Although L has been a straight port of C (which itself is using C) to L/L, you might get different results in edge cases.
426              
427             =head2 types.db
428              
429             If no types.db list is being specified during construction, the object will try to use the shipped version.
430             Also, if a list is given, the first appearance of the type will be used; this may differ from collectd's mechanism.
431              
432             =head2 SEE ALSO
433              
434             L, L
435              
436             =head1 AUTHOR
437              
438             Fabien Wernli, C<< >>
439              
440             =head1 BUGS
441              
442             Please report any bugs or feature requests to L.
443              
444             =head1 SUPPORT
445              
446             You can find documentation for this module with the perldoc command.
447              
448             perldoc Test::Collectd::Plugins
449              
450             You can also look for information at:
451              
452             =over 4
453              
454             =item * Github: https://github.com/faxm0dem/Test-Collectd-Plugins
455              
456             =item * RT: CPAN's request tracker (report bugs here)
457              
458             L
459              
460             =item * AnnoCPAN: Annotated CPAN documentation
461              
462             L
463              
464             =item * CPAN Ratings
465              
466             L
467              
468             =item * Search CPAN
469              
470             L
471              
472             =back
473              
474              
475             =head1 LICENSE AND COPYRIGHT
476              
477             Copyright 2012 Fabien Wernli.
478              
479             This program is free software; you can redistribute it and/or modify it
480             under the terms of either: the GNU General Public License as published
481             by the Free Software Foundation; or the Artistic License.
482              
483             See http://dev.perl.org/licenses/ for more information.
484              
485              
486             =cut
487              
488             1; # End of Test::Collectd::Plugins
489