File Coverage

blib/lib/Net/Prometheus/ProcessCollector.pm
Criterion Covered Total %
statement 26 27 96.3
branch 3 4 75.0
condition 4 4 100.0
subroutine 7 7 100.0
pod 2 2 100.0
total 42 44 95.4


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016 -- leonerd@leonerd.org.uk
5              
6             package Net::Prometheus::ProcessCollector;
7              
8 12     12   69499 use strict;
  12         36  
  12         389  
9 12     12   67 use warnings;
  12         24  
  12         657  
10              
11             our $VERSION = '0.12';
12              
13 12     12   916 use Net::Prometheus::Types qw( MetricSamples Sample );
  12         27  
  12         4919  
14              
15             =head1 NAME
16              
17             C - obtain a process collector for the OS
18              
19             =head1 SYNOPSIS
20              
21             use Net::Prometheus::ProcessCollector;
22              
23             my $collector = Net::Prometheus::ProcessCollector->new;
24              
25             =head1 DESCRIPTION
26              
27             This module-loading package provides a method that attempts to load a process
28             collector appropriate for the host OS it is running on.
29              
30             The following OS-specific modules are provided with this distribution:
31              
32             =over 2
33              
34             =item *
35              
36             L
37              
38             =back
39              
40             Other OSes may be supported by 3rd-party CPAN modules by following this naming
41             pattern based on the value of the C<$^O> variable on the OS concerned.
42              
43             =cut
44              
45             =head1 MAGIC CONSTRUCTORS
46              
47             =cut
48              
49             =head2 new
50              
51             $collector = Net::Prometheus::ProcessCollector->new( %args )
52              
53             Attempts to construct a new process collector for the OS named by C<$^O>,
54             passing in any extra arguments into the C constructor for the specific
55             class.
56              
57             If no perl module is found under the appropriate file name, C is
58             returned. If any other error occurs while loading or constructing the
59             instance, the exception is thrown as normal.
60              
61             Typically a process exporter should support the following named arguments:
62              
63             =over
64              
65             =item prefix => STR
66              
67             A prefix to prepend on all the exported variable names. If not provided, the
68             default should be C<"process">.
69              
70             =item labels => ARRAY
71              
72             Additional labels to set on exported variables. If not provided, no extra
73             labels will be set.
74              
75             =back
76              
77             =cut
78              
79             sub new
80             {
81 4     4 1 12 my $class = shift;
82 4         20 $class->for_OS( $^O, @_ );
83             }
84              
85             =head2 for_OS
86              
87             $collector = Net::Prometheus::ProcessCollector->for_OS( $os, @args )
88              
89             Attempts to construct a new process collector for the named OS. Except under
90             especially-exceptional circumstances, you don't want to call this method.
91             Call L instead.
92              
93             =cut
94              
95             sub for_OS
96             {
97 5     5 1 94 shift; # class
98 5         22 my ( $os, @args ) = @_;
99              
100 5         21 my $pkg = __PACKAGE__ . "::$os";
101              
102 5         33 ( my $file = "$pkg.pm" ) =~ s{::}{/}g;
103 5 100       16 if( !eval { require $file } ) {
  5         2197  
104 1 50       30 return if $@ =~ m/^Can't locate \Q$file\E in \@INC/;
105 0         0 die $@;
106             }
107              
108 4         28 return $pkg->new( @args );
109             }
110              
111             # Methods for subclasses
112              
113             sub __new
114             {
115 6     6   18 my $class = shift;
116 6         17 my %args = @_;
117              
118             return bless {
119             prefix => $args{prefix} || "process",
120 6   100     78 labels => $args{labels} || [],
      100        
121             }, $class;
122             }
123              
124             sub _make_metric
125             {
126 72     72   725 my $self = shift;
127 72         160 my ( $varname, $value, $type, $help ) = @_;
128              
129 72         119 my $prefix = $self->{prefix};
130              
131             return MetricSamples( "${prefix}_$varname", $type, $help,
132 72         268 [ Sample( "${prefix}_$varname", $self->{labels}, $value ) ] );
133             }
134              
135             0x55AA;