File Coverage

blib/lib/FFI/ExtractSymbols/PosixNm.pm
Criterion Covered Total %
statement 28 28 100.0
branch 5 6 83.3
condition 3 5 60.0
subroutine 8 9 88.8
pod n/a
total 44 48 91.6


line stmt bran cond sub pod time code
1             package FFI::ExtractSymbols::PosixNm;
2              
3 4     4   26 use strict;
  4         10  
  4         112  
4 4     4   19 use warnings;
  4         8  
  4         109  
5 4     4   1801 use File::Which qw( which );
  4         4185  
  4         205  
6 4     4   27 use File::ShareDir::Dist ();
  4         11  
  4         53  
7 4     4   19 use constant ();
  4         8  
  4         1910  
8              
9             my $config = File::ShareDir::Dist::dist_config('FFI-ExtractSymbols');
10              
11             # ABSTRACT: Posix nm implementation for FFI::ExtractSymbols
12             our $VERSION = '0.06'; # VERSION
13              
14              
15             return 1 if FFI::ExtractSymbols->can('extract_symbols');
16              
17             my $nm = which('nm');
18             $nm = $config->{'exe'}->{nm}
19             unless defined $nm;
20              
21             if(my $prefix = $config->{'function_prefix'})
22             {
23             my $re = qr{^$prefix};
24             *_remove_code_prefix = sub {
25             my $symbol = shift;
26             $symbol =~ s{$re}{};
27             $symbol;
28             }
29             }
30             else
31 12     12   76 { *_remove_code_prefix = sub { $_[0] } }
32              
33             if(my $prefix = $config->{'data_prefix'})
34             {
35             my $re = qr{^$prefix};
36             *_remove_data_prefix = sub {
37             my $symbol = shift;
38             $symbol =~ s{$re}{};
39             $symbol;
40             }
41             }
42             else
43 12     12   118 { *_remove_data_prefix = sub { $_[0] } }
44              
45             *FFI::ExtractSymbols::extract_symbols = sub
46             {
47 2     2   20847 my($libpath, %callbacks) = @_;
48              
49 2   50 0   20 $callbacks{$_} ||= sub {} for qw( export code data );
50              
51 2         11733 foreach my $line (`$nm -g -P -D $libpath`)
52             {
53 24 50       6267 next if $line =~ /^\s/;
54 24         225 my($symbol, $type) = split /\s+/, $line;
55 24 100 66     241 if($type eq $config->{function_code} || $type eq 'W')
    100          
56             {
57 6         36 $callbacks{export}->(_remove_code_prefix($symbol), $symbol);
58 6         3721 $callbacks{code}-> (_remove_code_prefix($symbol), $symbol);
59             }
60             elsif($type eq $config->{data_code})
61             {
62 6         50 $callbacks{export}->(_remove_data_prefix($symbol), $symbol);
63 6         5576 $callbacks{data}-> (_remove_data_prefix($symbol), $symbol);
64             }
65             }
66 2         1065 ();
67             };
68              
69             1;
70              
71             __END__