File Coverage

blib/lib/ExtUtils/Depends.pm
Criterion Covered Total %
statement 171 214 79.9
branch 20 60 33.3
condition 8 27 29.6
subroutine 31 38 81.5
pod 16 21 76.1
total 246 360 68.3


line stmt bran cond sub pod time code
1             #
2             # $Id$
3             #
4              
5             package ExtUtils::Depends;
6              
7 4     4   167789 use strict;
  4         8  
  4         112  
8 4     4   19 use warnings;
  4         6  
  4         130  
9 4     4   26 use Carp;
  4         8  
  4         224  
10 4     4   19 use Config;
  4         13  
  4         152  
11 4     4   20 use File::Find;
  4         5  
  4         226  
12 4     4   19 use File::Spec;
  4         5  
  4         118  
13 4     4   3896 use Data::Dumper;
  4         29856  
  4         2829  
14              
15             our $VERSION = '0.405';
16              
17             sub import {
18 4     4   36 my $class = shift;
19 4 50       3776 return unless @_;
20 0 0       0 die "$class version $_[0] is required--this is only version $VERSION"
21             if $VERSION < $_[0];
22             }
23              
24             sub new {
25 4     4 1 2496 my ($class, $name, @deps) = @_;
26 4         38 my $self = bless {
27             name => $name,
28             deps => {},
29             inc => [],
30             libs => '',
31              
32             pm => {},
33             typemaps => [],
34             xs => [],
35             c => [],
36             }, $class;
37              
38 4         17 $self->add_deps (@deps);
39              
40             # attempt to load these now, so we'll find out as soon as possible
41             # whether the dependencies are valid. we'll load them again in
42             # get_makefile_vars to catch any added between now and then.
43 4         13 $self->load_deps;
44              
45 4         11 return $self;
46             }
47              
48             sub add_deps {
49 5     5 1 18 my $self = shift;
50 5         14 foreach my $d (@_) {
51             $self->{deps}{$d} = undef
52 2 50       12 unless $self->{deps}{$d};
53             }
54             }
55              
56             sub get_deps {
57 2     2 1 9 my $self = shift;
58 2         5 $self->load_deps; # just in case
59              
60 2         3 return %{$self->{deps}};
  2         11  
61             }
62              
63             sub set_inc {
64 1     1 1 6 my $self = shift;
65 1         2 push @{ $self->{inc} }, @_;
  1         4  
66             }
67              
68             sub set_libs {
69 1     1 1 6 my ($self, $newlibs) = @_;
70 1         3 $self->{libs} = $newlibs;
71             }
72              
73             sub add_pm {
74 7     7 1 31 my ($self, %pm) = @_;
75 7         29 while (my ($key, $value) = each %pm) {
76 8         52 $self->{pm}{$key} = $value;
77             }
78             }
79              
80             sub _listkey_add_list {
81 3     3   7 my ($self, $key, @list) = @_;
82 3 50       33 $self->{$key} = [] unless $self->{$key};
83 3         5 push @{ $self->{$key} }, @list;
  3         10  
84             }
85              
86 1     1 1 10 sub add_xs { shift->_listkey_add_list ('xs', @_) }
87 1     1 1 8 sub add_c { shift->_listkey_add_list ('c', @_) }
88             sub add_typemaps {
89 1     1 1 6 my $self = shift;
90 1         4 $self->_listkey_add_list ('typemaps', @_);
91 1         3 $self->install (@_);
92             }
93              
94             # no-op, only used for source back-compat
95 0     0 1 0 sub add_headers { carp "add_headers() is a no-op" }
96              
97             ####### PRIVATE
98 8     8 0 66 sub basename { (File::Spec->splitdir ($_[0]))[-1] }
99             # get the name in Makefile syntax.
100             sub installed_filename {
101 6     6 0 9 my $self = shift;
102 6         18 return '$(INST_ARCHLIB)/$(FULLEXT)/Install/'.basename ($_[0]);
103             }
104              
105             sub install {
106             # install things by adding them to the hash of pm files that gets
107             # passed through WriteMakefile's PM key.
108 2     2 1 8 my $self = shift;
109 2         4 foreach my $f (@_) {
110 4         10 $self->add_pm ($f, $self->installed_filename ($f));
111             }
112             }
113              
114             sub save_config {
115 4     4   32 use Data::Dumper;
  4         11  
  4         221  
116 2     2 1 23 local $Data::Dumper::Terse = 0;
117 2         5 local $Data::Dumper::Sortkeys = 1;
118 4     4   3100 use IO::File;
  4         13318  
  4         2255  
119              
120 2         5 my ($self, $filename) = @_;
121              
122 2 50       18 my $file = IO::File->new (">".$filename)
123             or croak "can't open '$filename' for writing: $!\n";
124              
125 2         282 print $file "package $self->{name}\::Install::Files;\n\n";
126             print $file "".Data::Dumper->Dump([{
127 2         9 inc => join (" ", @{ $self->{inc} }),
128             libs => $self->{libs},
129 2         5 typemaps => [ map { basename $_ } @{ $self->{typemaps} } ],
  2         6  
130 2         5 deps => [sort keys %{ $self->{deps} }],
  2         28  
131             }], ['self']);
132 2         273 print $file <<'EOF';
133              
134             @deps = @{ $self->{deps} };
135             @typemaps = @{ $self->{typemaps} };
136             $libs = $self->{libs};
137             $inc = $self->{inc};
138             EOF
139             # this is ridiculous, but old versions of ExtUtils::Depends take
140             # first $loadedmodule::CORE and then $INC{$file} --- the fallback
141             # includes the Filename.pm, which is not useful. so we must add
142             # this crappy code. we don't worry about portable pathnames,
143             # as the old code didn't either.
144 2         31 (my $mdir = $self->{name}) =~ s{::}{/}g;
145 2         12 print $file <<"EOT";
146              
147             \$CORE = undef;
148             foreach (\@INC) {
149             if ( -f \$_ . "/$mdir/Install/Files.pm") {
150             \$CORE = \$_ . "/$mdir/Install/";
151             last;
152             }
153             }
154              
155             sub deps { \@{ \$self->{deps} }; }
156              
157             sub Inline {
158             my (\$class, \$lang) = \@_;
159             if (\$lang ne 'C') {
160             warn "Warning: Inline hints not available for \$lang language\n";
161             return;
162             }
163             +{ map { (uc(\$_) => \$self->{\$_}) } qw(inc libs typemaps) };
164             }
165             EOT
166              
167 2         4 print $file "\n1;\n";
168              
169 2         89 close $file;
170              
171             # we need to ensure that the file we just created gets put into
172             # the install dir with everything else.
173             #$self->install ($filename);
174 2         11 $self->add_pm ($filename, $self->installed_filename ('Files.pm'));
175             }
176              
177             sub load {
178 5     5 1 6497 my $dep = shift;
179 5         18 my @pieces = split /::/, $dep;
180 5         11 my @suffix = qw/ Install Files /;
181             # not File::Spec - see perldoc -f require
182 5         15 my $relpath = join('/', @pieces, @suffix) . '.pm';
183 5         11 my $depinstallfiles = join "::", @pieces, @suffix;
184 5 50       9 eval {
185 5         2544 require $relpath
186             } or die " *** Can't load dependency information for $dep:\n $@\n";
187             #print Dumper(\%INC);
188              
189             # effectively $instpath = dirname($INC{$relpath})
190 5         58 @pieces = File::Spec->splitdir ($INC{$relpath});
191 5         9 pop @pieces;
192 5         35 my $instpath = File::Spec->catdir (@pieces);
193              
194 4     4   47 no strict;
  4         8  
  4         6309  
195              
196 5 50       16 croak "No dependency information found for $dep"
197             unless $instpath;
198              
199 5 50       36 if (not File::Spec->file_name_is_absolute ($instpath)) {
200 0         0 $instpath = File::Spec->rel2abs ($instpath);
201             }
202              
203 5         10 my (@typemaps, $inc, $libs, @deps);
204              
205             # this will not exist when loading files from old versions
206             # of ExtUtils::Depends.
207 5         7 @deps = eval { $depinstallfiles->deps };
  5         37  
208 1         5 @deps = @{"$depinstallfiles\::deps"}
209 5 50 66     18 if $@ and exists ${"$depinstallfiles\::"}{deps};
  1         5  
210              
211 5         8 my $inline = eval { $depinstallfiles->Inline('C') };
  5         21  
212 5 100       19 if (!$@) {
213 4   100     18 $inc = $inline->{INC} || '';
214 4   100     20 $libs = $inline->{LIBS} || '';
215 4 100       6 @typemaps = @{ $inline->{TYPEMAPS} || [] };
  4         104  
216             } else {
217 1   50     2 $inc = ${"$depinstallfiles\::inc"} || '';
218 1   50     2 $libs = ${"$depinstallfiles\::libs"} || '';
219 1         2 @typemaps = @{"$depinstallfiles\::typemaps"};
  1         5  
220             }
221 5         11 @typemaps = map { File::Spec->rel2abs ($_, $instpath) } @typemaps;
  2         41  
222              
223             {
224 5         51 instpath => $instpath,
225             typemaps => \@typemaps,
226             inc => "-I$instpath $inc",
227             libs => $libs,
228             deps => \@deps,
229             }
230             }
231              
232             sub load_deps {
233 8     8 1 15 my $self = shift;
234 8         12 my @load = grep { not $self->{deps}{$_} } keys %{ $self->{deps} };
  4         15  
  8         34  
235 8         21 foreach my $d (@load) {
236 2         5 my $dep = load ($d);
237 2         6 $self->{deps}{$d} = $dep;
238 2 50       7 if ($dep->{deps}) {
239 2         3 foreach my $childdep (@{ $dep->{deps} }) {
  2         10  
240             push @load, $childdep
241             unless
242             $self->{deps}{$childdep}
243             or
244 0 0 0     0 grep {$_ eq $childdep} @load;
  0         0  
245             }
246             }
247             }
248             }
249              
250             sub uniquify {
251 2     2 0 3 my %seen;
252             # we use a seen hash, but also keep indices to preserve
253             # first-seen order.
254 2         3 my $i = 0;
255 2         4 foreach (@_) {
256             $seen{$_} = ++$i
257 8 50       28 unless exists $seen{$_};
258             }
259             #warn "stripped ".(@_ - (keys %seen))." redundant elements\n";
260 2         8 sort { $seen{$a} <=> $seen{$b} } keys %seen;
  11         28  
261             }
262              
263              
264             sub get_makefile_vars {
265 1     1 1 71 my $self = shift;
266              
267             # collect and uniquify things from the dependencies.
268             # first, ensure they are completely loaded.
269 1         3 $self->load_deps;
270              
271             ##my @defbits = map { split } @{ $self->{defines} };
272 1         2 my @incbits = map { split } @{ $self->{inc} };
  1         6  
  1         4  
273 1         8 my @libsbits = split /\s+/, $self->{libs};
274 1         2 my @typemaps = @{ $self->{typemaps} };
  1         3  
275 1         2 foreach my $d (sort keys %{ $self->{deps} }) {
  1         3  
276 0         0 my $dep = $self->{deps}{$d};
277             #push @defbits, @{ $dep->{defines} };
278 0 0       0 push @incbits, @{ $dep->{defines} } if $dep->{defines};
  0         0  
279 0 0       0 push @incbits, split /\s+/, $dep->{inc} if $dep->{inc};
280 0 0       0 push @libsbits, split /\s+/, $dep->{libs} if $dep->{libs};
281 0 0       0 push @typemaps, @{ $dep->{typemaps} } if $dep->{typemaps};
  0         0  
282             }
283              
284             # we have a fair bit of work to do for the xs files...
285 1         2 my @clean = ();
286 1         2 my @OBJECT = ();
287 1         2 my %XS = ();
288 1         2 foreach my $xs (@{ $self->{xs} }) {
  1         3  
289 2         7 (my $c = $xs) =~ s/\.xs$/\.c/i;
290 2         6 (my $o = $xs) =~ s/\.xs$/\$(OBJ_EXT)/i;
291 2         5 $XS{$xs} = $c;
292 2         3 push @OBJECT, $o;
293             # according to the MakeMaker manpage, the C files listed in
294             # XS will be added automatically to the list of cleanfiles.
295 2         5 push @clean, $o;
296             }
297              
298             # we may have C files, as well:
299 1         1 foreach my $c (@{ $self->{c} }) {
  1         3  
300 2         8 (my $o = $c) =~ s/\.c$/\$(OBJ_EXT)/i;
301 2         3 push @OBJECT, $o;
302 2         4 push @clean, $o;
303             }
304              
305 1         4 my %vars = (
306             INC => join (' ', uniquify @incbits),
307             LIBS => join (' ', uniquify $self->find_extra_libs, @libsbits),
308             TYPEMAPS => [@typemaps],
309             );
310              
311 1 50       6 $self->build_dll_lib(\%vars) if $^O =~ /MSWin32/;
312              
313             # we don't want to provide these if there is no data in them;
314             # that way, the caller can still get default behavior out of
315             # MakeMaker when INC, LIBS and TYPEMAPS are all that are required.
316             $vars{PM} = $self->{pm}
317 1 50       2 if %{ $self->{pm} };
  1         5  
318 1 50       6 $vars{clean} = { FILES => join (" ", @clean), }
319             if @clean;
320 1 50       5 $vars{OBJECT} = join (" ", @OBJECT)
321             if @OBJECT;
322 1 50       3 $vars{XS} = \%XS
323             if %XS;
324              
325 1         12 %vars;
326             }
327              
328             sub build_dll_lib {
329 0     0 0 0 my ($self, $vars) = @_;
330 0   0     0 $vars->{macro} ||= {};
331 0         0 $vars->{macro}{'INST_DYNAMIC_LIB'} =
332             '$(INST_ARCHAUTODIR)/$(DLBASE)$(LIB_EXT)';
333             }
334              
335             # Search for extra library files to link against on Windows (either native
336             # Windows library # files, or Cygwin library files)
337             # NOTE: not meant to be called publicly, so no POD documentation
338             sub find_extra_libs {
339 1     1 0 2 my $self = shift;
340              
341             my %mappers = (
342 0     0   0 MSWin32 => sub { $_[0] . '\.(?:lib|a)' },
343 0     0   0 cygwin => sub { $_[0] . '\.dll'},
344 0     0   0 android => sub { $_[0] . '\.' . $Config{dlext} },
345 1         11 );
346 1         3 my $mapper = $mappers{$^O};
347 1 50       10 return () unless defined $mapper;
348              
349 0           my @found_libs = ();
350 0           foreach my $name (keys %{ $self->{deps} }) {
  0            
351 0           (my $stem = $name) =~ s/^.*:://;
352 0 0         if ( defined &DynaLoader::mod2fname ) {
353 0           my @parts = split /::/, $name;
354 0           $stem = DynaLoader::mod2fname([@parts]);
355             }
356 0           my $lib = $mapper->($stem);
357 0           my $pattern = qr/$lib$/;
358              
359 0           my $matching_dir;
360             my $matching_file;
361             find (sub {
362 0 0 0 0     if ((not $matching_file) && /$pattern/) {;
363 0           $matching_dir = $File::Find::dir;
364 0           $matching_file = $File::Find::name;
365             }
366 0 0         }, map { -d $_ ? ($_) : () } @INC); # only extant dirs
  0            
367              
368 0 0 0       if ($matching_file && -f $matching_file) {
369 0           push @found_libs, ('-L' . $matching_dir, '-l' . $stem);
370             # Android's linker ignores the RTLD_GLOBAL flag
371             # and loads everything as if under RTLD_LOCAL.
372             # What this means in practice is that modules need
373             # to explicitly link to their dependencies,
374             # because otherwise they won't be able to locate any
375             # functions they define.
376             # We use the -l:foo.so flag to indicate that the
377             # actual library name to look for is foo.so, not
378             # libfoo.so
379 0 0         if ( $^O eq 'android' ) {
380 0           $found_libs[-1] = "-l:$stem.$Config{dlext}";
381             }
382 0           next;
383             }
384             }
385              
386 0           return @found_libs;
387             }
388              
389             # Hook into ExtUtils::MakeMaker to create an import library on MSWin32 when gcc
390             # is used. FIXME: Ideally, this should be done in EU::MM itself.
391             package # wrap to fool the CPAN indexer
392             ExtUtils::MM;
393 4     4   25 use Config;
  4         6  
  4         605  
394             sub static_lib {
395 0     0 1   my $base = shift->SUPER::static_lib(@_);
396              
397 0 0 0       return $base unless $^O =~ /MSWin32/ && $Config{cc} =~ /\bgcc\b/i;
398              
399 0   0       my $DLLTOOL = $Config{'dlltool'} || 'dlltool';
400              
401             return <<"__EOM__"
402             # This isn't actually a static lib, it just has the same name on Win32.
403             \$(INST_DYNAMIC_LIB): \$(INST_DYNAMIC)
404             $DLLTOOL --def \$(EXPORT_LIST) --output-lib \$\@ --dllname \$(DLBASE).\$(DLEXT) \$(INST_DYNAMIC)
405              
406             dynamic:: \$(INST_DYNAMIC_LIB)
407             __EOM__
408 0           }
409              
410             1;
411              
412             __END__