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, 2018-2020 -- leonerd@leonerd.org.uk |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
package Net::Prometheus::PerlCollector; |
7
|
|
|
|
|
|
|
|
8
|
3
|
|
|
3
|
|
184626
|
use strict; |
|
3
|
|
|
|
|
27
|
|
|
3
|
|
|
|
|
88
|
|
9
|
3
|
|
|
3
|
|
17
|
use warnings; |
|
3
|
|
|
|
|
12
|
|
|
3
|
|
|
|
|
208
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require XSLoader; |
14
|
|
|
|
|
|
|
XSLoader::load( __PACKAGE__, $VERSION ); |
15
|
|
|
|
|
|
|
|
16
|
3
|
|
|
3
|
|
662
|
use Net::Prometheus::Types qw( MetricSamples Sample ); |
|
3
|
|
|
|
|
3411
|
|
|
3
|
|
|
|
|
438
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $DETAIL = 0; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 NAME |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
C - obtain statistics about the perl interpreter |
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
=head1 SYNOPSIS |
25
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
use Net::Prometheus; |
27
|
|
|
|
|
|
|
use Net::Prometheus::PerlCollector; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
my $client = Net::Prometheus->new; |
30
|
|
|
|
|
|
|
$client->register( Net::Prometheus::PerlCollector->new ); |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
=head1 DESCRIPTION |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
This module provides a class that collects metrics about the perl interpreter |
35
|
|
|
|
|
|
|
itself. |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=head2 Metrics |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
The following metrics are collected: |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
=over 2 |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
=item * C |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
A gauge giving the number of arenas the heap is split into. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
=item * C |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
A gauge giving the total number of SVs allocated on the heap. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=back |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
# HELP perl_heap_arenas Number of arenas in the Perl heap |
54
|
|
|
|
|
|
|
# TYPE perl_heap_arenas gauge |
55
|
|
|
|
|
|
|
perl_heap_arenas 159 |
56
|
|
|
|
|
|
|
# HELP perl_heap_svs Number of SVs in the Perl heap |
57
|
|
|
|
|
|
|
# TYPE perl_heap_svs gauge |
58
|
|
|
|
|
|
|
perl_heap_svs 26732 |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
Note that the way these metrics are collected requires counting them all every |
61
|
|
|
|
|
|
|
time. While this code is relatively efficient, it is still a linear scan, and |
62
|
|
|
|
|
|
|
may itself cause some slowdown of the process at the time it is collected, if |
63
|
|
|
|
|
|
|
the heap has grown very large, containing a great number of SVs. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Extra detail can be obtained about the types of heap objects by setting |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
$Net::Prometheus::PerlCollector::DETAIL = 1; |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
This will be slightly more expensive to count, but will yield in addition a |
70
|
|
|
|
|
|
|
detailed breakdown by object type. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
# HELP perl_heap_svs_by_type Number of SVs classified by type |
73
|
|
|
|
|
|
|
# TYPE perl_heap_svs_by_type gauge |
74
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="ARRAY"} 2919 |
75
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="CODE"} 1735 |
76
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="GLOB"} 2647 |
77
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="HASH"} 470 |
78
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="INVLIST"} 68 |
79
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="IO"} 12 |
80
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="NULL"} 8752 |
81
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="REGEXP"} 171 |
82
|
|
|
|
|
|
|
perl_heap_svs_by_type{type="SCALAR"} 9958 |
83
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
This level of detail is unlikely to be useful for most generic production |
85
|
|
|
|
|
|
|
purposes but may be helpful to set in specific processes when investigating |
86
|
|
|
|
|
|
|
specific memory-related issues for a limited time. |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
For an even greater level of detail, set the value to 2 to additionally obtain |
89
|
|
|
|
|
|
|
another breakdown of blessed objects by class: |
90
|
|
|
|
|
|
|
|
91
|
|
|
|
|
|
|
# HELP perl_heap_svs_by_class Number of SVs classified by class |
92
|
|
|
|
|
|
|
# TYPE perl_heap_svs_by_class gauge |
93
|
|
|
|
|
|
|
... |
94
|
|
|
|
|
|
|
perl_heap_svs_by_class{class="Net::Prometheus"} 1 |
95
|
|
|
|
|
|
|
perl_heap_svs_by_class{class="Net::Prometheus::PerlCollector"} 1 |
96
|
|
|
|
|
|
|
perl_heap_svs_by_class{class="Net::Prometheus::ProcessCollector::linux"} 1 |
97
|
|
|
|
|
|
|
|
98
|
|
|
|
|
|
|
Note that this will yield a large amount of output for any non-trivially sized |
99
|
|
|
|
|
|
|
program, so should only be enabled under carefully-controlled conditions. |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
The value of this variable can be overridden on a per-collection basis by |
102
|
|
|
|
|
|
|
passing the option |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
Net::Prometheus->render( { perl_collector_detail => 1 } ); # or 2 |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
This may be more convenient for short-term traces from exporters that parse |
107
|
|
|
|
|
|
|
HTTP query parameters into collector options. |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
GET .../metrics?perl_collector_detail=1 |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
=cut |
112
|
|
|
|
|
|
|
|
113
|
|
|
|
|
|
|
sub new |
114
|
|
|
|
|
|
|
{ |
115
|
2
|
|
|
2
|
0
|
4018
|
my $class = shift; |
116
|
|
|
|
|
|
|
|
117
|
2
|
|
|
|
|
8
|
return bless {}, $class; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
# Might as well keep these as constants |
121
|
|
|
|
|
|
|
use constant |
122
|
3
|
|
|
3
|
|
26
|
PERL_VERSION => ( $^V =~ m/^v(.*)$/ )[0]; |
|
3
|
|
|
|
|
10
|
|
|
3
|
|
|
|
|
1042
|
|
123
|
|
|
|
|
|
|
|
124
|
|
|
|
|
|
|
sub collect |
125
|
|
|
|
|
|
|
{ |
126
|
5
|
|
|
5
|
0
|
8380
|
shift; |
127
|
5
|
|
|
|
|
13
|
my ( $opts ) = @_; |
128
|
|
|
|
|
|
|
|
129
|
5
|
50
|
33
|
|
|
37
|
local $DETAIL = $opts->{perl_collector_detail} if $opts and exists $opts->{perl_collector_detail}; |
130
|
|
|
|
|
|
|
|
131
|
5
|
|
|
|
|
10812
|
my ( $arenas, $svs, $svs_by_type, $svs_by_class ) = count_heap( $DETAIL ); |
132
|
|
|
|
|
|
|
|
133
|
5
|
|
|
|
|
39
|
my @ret = ( |
134
|
|
|
|
|
|
|
MetricSamples( "perl_info", gauge => "Information about the Perl interpreter", |
135
|
|
|
|
|
|
|
[ Sample( "perl_info", [ version => PERL_VERSION ], 1 ) ] ), |
136
|
|
|
|
|
|
|
MetricSamples( "perl_heap_arenas", gauge => "Number of arenas in the Perl heap", |
137
|
|
|
|
|
|
|
[ Sample( "perl_heap_arenas", [], $arenas ) ] ), |
138
|
|
|
|
|
|
|
MetricSamples( "perl_heap_svs", gauge => "Number of SVs in the Perl heap", |
139
|
|
|
|
|
|
|
[ Sample( "perl_heap_svs", [], $svs ) ] ), |
140
|
|
|
|
|
|
|
); |
141
|
|
|
|
|
|
|
|
142
|
5
|
100
|
|
|
|
131
|
if( $svs_by_type ) { |
143
|
|
|
|
|
|
|
push @ret, MetricSamples( "perl_heap_svs_by_type", gauge => "Number of SVs classified by type", |
144
|
2
|
|
|
|
|
25
|
[ map { Sample( "perl_heap_svs_by_type", [ type => $_ ], $svs_by_type->{$_} ) } sort keys %$svs_by_type ] ); |
|
18
|
|
|
|
|
96
|
|
145
|
|
|
|
|
|
|
} |
146
|
|
|
|
|
|
|
|
147
|
5
|
100
|
|
|
|
31
|
if( $svs_by_class ) { |
148
|
|
|
|
|
|
|
push @ret, MetricSamples( "perl_heap_svs_by_class", gauge => "Number of SVs classified by class", |
149
|
1
|
|
|
|
|
22
|
[ map { Sample( "perl_heap_svs_by_class", [ class => $_ ], $svs_by_class->{$_} ) } sort keys %$svs_by_class ] ); |
|
23
|
|
|
|
|
120
|
|
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
5
|
|
|
|
|
31
|
return @ret; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
|
|
|
|
|
|
=head1 AUTHOR |
156
|
|
|
|
|
|
|
|
157
|
|
|
|
|
|
|
Paul Evans |
158
|
|
|
|
|
|
|
|
159
|
|
|
|
|
|
|
=cut |
160
|
|
|
|
|
|
|
|
161
|
|
|
|
|
|
|
0x55AA; |