File Coverage

lib/Net/Prometheus/PerlCollector.xs
Criterion Covered Total %
statement 36 38 94.7
branch 35 46 76.0
condition n/a
subroutine n/a
pod n/a
total 71 84 84.5


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 111947           static char *sv_typename(U8 svt)
12             {
13 111947           switch(svt) {
14             case SVt_NULL:
15             return "NULL";
16             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 47142           return "SCALAR";
27             #if PERL_VERSION >= 12
28             /* SVt_REGEXP was added in perl 5.12 */
29             case SVt_REGEXP:
30 1246           return "REGEXP";
31             #endif
32             case SVt_PVGV:
33 9366           return "GLOB";
34             case SVt_PVAV:
35 11082           return "ARRAY";
36             case SVt_PVHV:
37 2321           return "HASH";
38             case SVt_PVCV:
39 7280           return "CODE";
40             case SVt_PVFM:
41 0           return "FORMAT";
42             case SVt_PVIO:
43 30           return "IO";
44             #if PERL_VERSION >= 20
45             /* SVt_INVLIST was added in perl 5.20 */
46             case SVt_INVLIST:
47 130           return "INVLIST";
48             #endif
49             default:
50 0           return "UNKNOWN";
51             }
52             }
53              
54             MODULE = Net::Prometheus::PerlCollector PACKAGE = Net::Prometheus::PerlCollector
55              
56             void
57             count_heap(detail)
58             int detail
59             INIT:
60             SV *arena;
61             STRLEN arenas = 0, svs = 0;
62             HV *svs_by_type = NULL, *svs_by_class = NULL;
63             PPCODE:
64 4 100         if(detail)
65 2           svs_by_type = newHV();
66 4 100         if(detail > 1)
67 1           svs_by_class = newHV();
68              
69 1331 100         for(arena = PL_sv_arenaroot; arena; arena = (SV *)SvANY(arena)) {
70 1327           const SV *arenaend = &arena[SvREFCNT(arena)];
71             SV *sv;
72              
73 1327           arenas++;
74              
75 225590 100         for(sv = arena + 1; sv < arenaend; sv++)
76 224263 100         if(SvTYPE(sv) != 0xFF && SvREFCNT(sv)) {
    50          
77 223768           svs++;
78              
79 223768 100         if(svs_by_type) {
80 111947           char *type = sv_typename(SvTYPE(sv));
81 111947           SV **countp = hv_fetch(svs_by_type, type, strlen(type), 1);
82 111947 100         sv_setiv(*countp, SvIOK(*countp) ? SvIV(*countp) + 1 : 1);
    50          
83              
84 111947 100         if(svs_by_class && SvOBJECT(sv)) {
    100          
85 274 50         char *class = HvNAME(SvSTASH(sv));
    50          
    50          
    0          
    50          
    50          
86 274           SV **countp = hv_fetch(svs_by_class, class, strlen(class), 1);
87 274 100         sv_setiv(*countp, SvIOK(*countp) ? SvIV(*countp) + 1 : 1);
    50          
88             }
89             }
90             }
91             }
92              
93 4 50         EXTEND(SP, 3);
94 4           mPUSHu(arenas);
95 4           mPUSHu(svs);
96 4 100         if(svs_by_type)
97 2           mPUSHs(newRV_noinc((SV *)svs_by_type));
98 4 100         if(svs_by_class)
99 1           mPUSHs(newRV_noinc((SV *)svs_by_class));
100 4 100         XSRETURN(2 + !!svs_by_type + !!svs_by_class);