File Coverage

blib/lib/Devel/NYTProf/Constants.pm
Criterion Covered Total %
statement 12 20 60.0
branch 0 6 0.0
condition n/a
subroutine 4 5 80.0
pod 0 1 0.0
total 16 32 50.0


line stmt bran cond sub pod time code
1             package Devel::NYTProf::Constants;
2              
3 49     49   1816 use strict;
  49         107  
  49         1482  
4              
5 49     49   269 use Devel::NYTProf::Core;
  49         110  
  49         1030  
6              
7 49     49   255 use base 'Exporter';
  49         213  
  49         6886  
8              
9             our @EXPORT_OK = qw(const_bits2names);
10              
11             my $const_bits2names_groups;
12              
13             do {
14 49     49   384 my $symbol_table = do { no strict; \%{"Devel::NYTProf::Constants::"} };
  49         116  
  49         15591  
15             my %consts = map { $_ => $symbol_table->{$_}() } grep { /^NYTP_/ } keys %$symbol_table;
16              
17             push @EXPORT_OK, keys %consts;
18              
19             for my $sym (keys %consts) {
20             $sym =~ /^(NYTP_[A-Z]+[a-z])_/ or next;
21             $const_bits2names_groups->{$1}{ $consts{$sym} } = $sym;
22             }
23             };
24              
25              
26             sub const_bits2names { # const_bits2names("NYTP_FIDf",$flags)
27 0     0 0   my ($group, $bits) = @_;
28 0 0         my $names = $const_bits2names_groups->{$group} or return;
29 0           my @names;
30 0           for my $bit (0..31) {
31 0           my $bitval = 1 << $bit;
32 0 0         push @names, $names->{$bitval}
33             if $bits & $bitval;
34             }
35 0 0         return @names if wantarray;
36 0           return join " | ", @names;
37             }
38              
39             # warn scalar const_bits2names("NYTP_FIDf", NYTP_FIDf_SAVE_SRC|NYTP_FIDf_IS_PMC);
40              
41              
42             #warn "Constants: ".join(" ", sort @EXPORT_OK);
43              
44             1;