File Coverage

/home/pjcj/g/Test-Smoke/perl-current-gcov/win32/FindExt.pm
Criterion Covered Total %
statement 50 63 79.4
branch 26 46 56.5
condition 8 27 29.6
subroutine 10 12 83.3
total 94 148 63.5


line stmt bran cond sub time code
1           package FindExt;
2            
3           our $VERSION = '1.02';
4            
5 1     1 7 use strict;
  1       2  
  1       46  
6 1     1 5 use warnings;
  1       2  
  1       1562  
7            
8           my $no = join('|',qw(GDBM_File ODBM_File NDBM_File DB_File
9           VMS.* Sys-Syslog IPC-SysV I18N-Langinfo));
10           $no = qr/^(?:$no)$/i;
11            
12           sub apply_config {
13 1     1 3 my ($config) = @_;
14 1       3 my @no;
15            
16 1 50     7 push @no, 'Sys-Syslog' if $^O eq 'MSWin32';
17            
18           # duplicates logic from Configure (mostly)
19 1 50     21 push @no, "DB_File" unless $config->{i_db};
20 1 50     10 push @no, "GDBM_File" unless $config->{i_gdbm};
21 1 50 33   8 push @no, "I18N-Langinfo" unless $config->{i_langinfo} && $config->{d_nl_langinfo};
22 1 0 33   9 push @no, "IPC-SysV" unless $config->{d_msg} || $config->{d_sem} || $config->{d_shm};
      33      
23 1 50     8 push @no, "NDBM_File" unless $config->{d_ndbm};
24 1 50 33   9 push @no, "ODBM_File"
      33      
25           unless ($config->{i_dbm} || $config->{i_rpcsvcdbm}) && !$config->{d_cplusplus};
26 1 50     6 push @no, "VMS.*" unless $^O eq "VMS";
27 1 50 33   11 push @no, "Win32.*" unless $^O eq "MSWin32" || $^O eq "cygwin";
28            
29 1       5 $no = join('|', @no);
30 1       53 $no = qr/^(?:$no)$/i;
31           }
32            
33           my %ext;
34           my %static;
35            
36           sub set_static_extensions {
37           # adjust results of scan_ext, and also save
38           # statics in case scan_ext hasn't been called yet.
39           # if '*' is passed then all XS extensions are static
40           # (with possible exclusions)
41 1     1 8 %static = ();
42 1       8 my @list = @_;
43 1 50 33   13 if (@_ and $_[0] eq '*') {
44 0       0 my %excl = map {$_=>1} map {m/^!(.*)$/} @_[1 .. $#_];
  0       0  
  0       0  
45 0       0 @list = grep {!exists $excl{$_}} keys %ext;
  0       0  
46           }
47 1       8 for (@list) {
48 0       0 $static{$_} = 1;
49 0 0 0   0 $ext{$_} = 'static' if $ext{$_} && $ext{$_} eq 'dynamic';
50           }
51            
52           # Encode is a special case. If we are building Encode as a static
53           # extension, we need to explicitly list its subextensions as well.
54           # For other nested extensions, this is handled automatically by
55           # the appropriate Makefile.PL.
56 1 50 33   28 if ($ext{Encode} && $ext{Encode} eq 'static') {
57 0       0 require File::Find;
58           File::Find::find({
59           no_chdir => 1,
60           wanted => sub {
61 0 0   0 0 return unless m!\b(Encode/.+)/Makefile\.PL!;
62 0       0 $static{$1} = 1;
63 0       0 $ext{$1} = 'static';
64           },
65 0       0 }, "../cpan/Encode");
66           }
67           }
68            
69           sub _ext_eq {
70 3     3 6 my $key = shift;
71           sub {
72 3     3 568 sort grep $ext{$_} eq $key, keys %ext;
73           }
74 3       21 }
75            
76           *dynamic_ext = _ext_eq('dynamic');
77           *static_ext = _ext_eq('static');
78           *nonxs_ext = _ext_eq('nonxs');
79            
80           sub extensions {
81 2     2 637 sort grep $ext{$_} ne 'known', keys %ext;
82           }
83            
84           sub known_extensions {
85 1     1 231 sort keys %ext;
86           }
87            
88           sub is_static
89           {
90 0     0 0 return $ext{$_[0]} eq 'static'
91           }
92            
93           sub has_xs_or_c {
94 159     159 475 my $dir = shift;
95 159 50     3358 opendir my $dh, $dir or die "opendir $dir: $!";
96 159       108060 while (defined (my $item = readdir $dh)) {
97 1203 100     6109 return 1 if $item =~ /\.xs$/;
98 1173 100     10158 return 1 if $item =~ /\.c$/;
99           }
100 104       1775 return 0;
101           }
102            
103           # Function to find available extensions, ignoring DynaLoader
104           sub scan_ext
105           {
106 3     3 11 my $ext_dir = shift;
107 3       68 opendir my $dh, "$ext_dir";
108 3       185 while (defined (my $item = readdir $dh)) {
109 166 100     972 next if $item =~ /^\.\.?$/;
110 160 100     667 next if $item eq "DynaLoader";
111 159 50     81824 next unless -d "$ext_dir/$item";
112 159       614 my $this_ext = $item;
113 159       456 my $leaf = $item;
114            
115 159       1164 $this_ext =~ s!-!/!g;
116 159       1223 $leaf =~ s/.*-//;
117            
118           # Temporary hack to cope with smokers that are not clearing directories:
119 159 50     867 next if $ext{$this_ext};
120            
121 159 100     1094 if (has_xs_or_c("$ext_dir/$item")) {
122 55 50     496 $ext{$this_ext} = $static{$this_ext} ? 'static' : 'dynamic';
123           } else {
124 104       680 $ext{$this_ext} = 'nonxs';
125           }
126 159 100     2996 $ext{$this_ext} = 'known' if $item =~ $no;
127           }
128           }
129            
130           1;
131           # Local variables:
132           # cperl-indent-level: 4
133           # indent-tabs-mode: nil
134           # End:
135           #
136           # ex: set ts=8 sts=4 sw=4 et: