File Coverage

lib/Net/Prometheus/PerlCollector.xs
Criterion Covered Total %
statement 46 50 92.0
branch 32 40 80.0
condition n/a
subroutine n/a
pod n/a
total 78 90 86.6


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 -- leonerd@leonerd.org.uk
5             */
6              
7             #include "EXTERN.h"
8             #include "perl.h"
9             #include "XSUB.h"
10              
11 188352           static char *sv_typename(U8 svt)
12             {
13 188352           switch(svt) {
14             case SVt_NULL:
15             return "NULL";
16 70986           case SVt_IV:
17             case SVt_NV:
18             case SVt_PV:
19             case SVt_PVIV:
20             case SVt_PVNV:
21             case SVt_PVMG:
22             #if PERL_VERSION < 12
23             /* SVt_RV was removed after 5.10 */
24             case SVt_RV:
25             #endif
26 70986           return "SCALAR";
27             #if PERL_VERSION >= 12
28             /* SVt_REGEXP was added in perl 5.12 */
29 1792           case SVt_REGEXP:
30 1792           return "REGEXP";
31             #endif
32 15461           case SVt_PVGV:
33 15461           return "GLOB";
34 20891           case SVt_PVAV:
35 20891           return "ARRAY";
36 3952           case SVt_PVHV:
37 3952           return "HASH";
38 12425           case SVt_PVCV:
39 12425           return "CODE";
40 0           case SVt_PVFM:
41 0           return "FORMAT";
42 32           case SVt_PVIO:
43 32           return "IO";
44             #if PERL_VERSION >= 20
45             /* SVt_INVLIST was added in perl 5.20 */
46 204           case SVt_INVLIST:
47 204           return "INVLIST";
48             #endif
49             #if PERL_VERSION >= 38
50 52           case SVt_PVOBJ:
51 52           return "OBJECT";
52             #endif
53 0           default:
54 0           return "UNKNOWN";
55             }
56             }
57              
58             MODULE = Net::Prometheus::PerlCollector PACKAGE = Net::Prometheus::PerlCollector
59              
60             void
61             count_heap(detail)
62             int detail
63             INIT:
64             SV *arena;
65             STRLEN arenas = 0, svs = 0;
66             HV *svs_by_type = NULL, *svs_by_class = NULL;
67             PPCODE:
68 7 100         if(detail)
69 2           svs_by_type = newHV();
70 2 100         if(detail > 1)
71 1           svs_by_class = newHV();
72              
73 3959 100         for(arena = PL_sv_arenaroot; arena; arena = (SV *)SvANY(arena)) {
74 3952           const SV *arenaend = &arena[SvREFCNT(arena)];
75             SV *sv;
76              
77 3952           arenas++;
78              
79 671840 100         for(sv = arena + 1; sv < arenaend; sv++)
80 667888 100         if(SvTYPE(sv) != 0xFF && SvREFCNT(sv)) {
    50          
81 667108           svs++;
82              
83 667108 100         if(svs_by_type) {
84 188352           char *type = sv_typename(SvTYPE(sv));
85 188352           SV **countp = hv_fetch(svs_by_type, type, strlen(type), 1);
86 188352 100         sv_setiv(*countp, SvIOK(*countp) ? SvIV(*countp) + 1 : 1);
87              
88 188352 100         if(svs_by_class && SvOBJECT(sv)) {
    100          
89 299 50         char *class = HvNAME(SvSTASH(sv));
    50          
    50          
    0          
    50          
90 299           SV **countp = hv_fetch(svs_by_class, class, strlen(class), 1);
91 299 100         sv_setiv(*countp, SvIOK(*countp) ? SvIV(*countp) + 1 : 1);
92             }
93             }
94             }
95             }
96              
97 7 50         EXTEND(SP, 4);
98 7           mPUSHu(arenas);
99 7           mPUSHu(svs);
100 7 100         if(svs_by_type)
101 2           mPUSHs(newRV_noinc((SV *)svs_by_type));
102 7 100         if(svs_by_class)
103 1           mPUSHs(newRV_noinc((SV *)svs_by_class));
104 7 100         XSRETURN(2 + !!svs_by_type + !!svs_by_class);