Move ExtUtils::MakeMaker from ext/ to cpan/
[perl.git] / cpan / ExtUtils-MakeMaker / lib / ExtUtils / MM_Win32.pm
1 package ExtUtils::MM_Win32;
2
3 use strict;
4
5
6 =head1 NAME
7
8 ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
9
10 =head1 SYNOPSIS
11
12  use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
13
14 =head1 DESCRIPTION
15
16 See ExtUtils::MM_Unix for a documentation of the methods provided
17 there. This package overrides the implementation of these methods, not
18 the semantics.
19
20 =cut 
21
22 use ExtUtils::MakeMaker::Config;
23 use File::Basename;
24 use File::Spec;
25 use ExtUtils::MakeMaker qw( neatvalue );
26
27 require ExtUtils::MM_Any;
28 require ExtUtils::MM_Unix;
29 our @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
30 our $VERSION = '6.55_02';
31
32 $ENV{EMXSHELL} = 'sh'; # to run `commands`
33
34 my $BORLAND = $Config{'cc'} =~ /^bcc/i ? 1 : 0;
35 my $GCC     = $Config{'cc'} =~ /^gcc/i ? 1 : 0;
36
37
38 =head2 Overridden methods
39
40 =over 4
41
42 =item B<dlsyms>
43
44 =cut
45
46 sub dlsyms {
47     my($self,%attribs) = @_;
48
49     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
50     my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
51     my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
52     my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
53     my(@m);
54
55     if (not $self->{SKIPHASH}{'dynamic'}) {
56         push(@m,"
57 $self->{BASEEXT}.def: Makefile.PL
58 ",
59      q! $(PERLRUN) -MExtUtils::Mksymlists \\
60      -e "Mksymlists('NAME'=>\"!, $self->{NAME},
61      q!\", 'DLBASE' => '!,$self->{DLBASE},
62      # The above two lines quoted differently to work around
63      # a bug in the 4DOS/4NT command line interpreter.  The visible
64      # result of the bug was files named q('extension_name',) *with the
65      # single quotes and the comma* in the extension build directories.
66      q!', 'DL_FUNCS' => !,neatvalue($funcs),
67      q!, 'FUNCLIST' => !,neatvalue($funclist),
68      q!, 'IMPORTS' => !,neatvalue($imports),
69      q!, 'DL_VARS' => !, neatvalue($vars), q!);"
70 !);
71     }
72     join('',@m);
73 }
74
75 =item replace_manpage_separator
76
77 Changes the path separator with .
78
79 =cut
80
81 sub replace_manpage_separator {
82     my($self,$man) = @_;
83     $man =~ s,/+,.,g;
84     $man;
85 }
86
87
88 =item B<maybe_command>
89
90 Since Windows has nothing as simple as an executable bit, we check the
91 file extension.
92
93 The PATHEXT env variable will be used to get a list of extensions that
94 might indicate a command, otherwise .com, .exe, .bat and .cmd will be
95 used by default.
96
97 =cut
98
99 sub maybe_command {
100     my($self,$file) = @_;
101     my @e = exists($ENV{'PATHEXT'})
102           ? split(/;/, $ENV{PATHEXT})
103           : qw(.com .exe .bat .cmd);
104     my $e = '';
105     for (@e) { $e .= "\Q$_\E|" }
106     chop $e;
107     # see if file ends in one of the known extensions
108     if ($file =~ /($e)$/i) {
109         return $file if -e $file;
110     }
111     else {
112         for (@e) {
113             return "$file$_" if -e "$file$_";
114         }
115     }
116     return;
117 }
118
119
120 =item B<init_DIRFILESEP>
121
122 Using \ for Windows.
123
124 =cut
125
126 sub init_DIRFILESEP {
127     my($self) = shift;
128
129     # The ^ makes sure its not interpreted as an escape in nmake
130     $self->{DIRFILESEP} = $self->is_make_type('nmake') ? '^\\' :
131                           $self->is_make_type('dmake') ? '\\\\'
132                                                        : '\\';
133 }
134
135 =item B<init_others>
136
137 Override some of the Unix specific commands with portable
138 ExtUtils::Command ones.
139
140 Also provide defaults for LD and AR in case the %Config values aren't
141 set.
142
143 LDLOADLIBS's default is changed to $Config{libs}.
144
145 Adjustments are made for Borland's quirks needing -L to come first.
146
147 =cut
148
149 sub init_others {
150     my ($self) = @_;
151
152     $self->{NOOP}     ||= 'rem';
153     $self->{DEV_NULL} ||= '> NUL';
154
155     $self->{FIXIN}    ||= $self->{PERL_CORE} ? 
156       "\$(PERLRUN) $self->{PERL_SRC}/win32/bin/pl2bat.pl" : 
157       'pl2bat.bat';
158
159     $self->{LD}     ||= 'link';
160     $self->{AR}     ||= 'lib';
161
162     $self->SUPER::init_others;
163
164     # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
165     delete $self->{SHELL};
166
167     $self->{LDLOADLIBS} ||= $Config{libs};
168     # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
169     if ($BORLAND) {
170         my $libs = $self->{LDLOADLIBS};
171         my $libpath = '';
172         while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
173             $libpath .= ' ' if length $libpath;
174             $libpath .= $1;
175         }
176         $self->{LDLOADLIBS} = $libs;
177         $self->{LDDLFLAGS} ||= $Config{lddlflags};
178         $self->{LDDLFLAGS} .= " $libpath";
179     }
180
181     return 1;
182 }
183
184
185 =item init_platform
186
187 Add MM_Win32_VERSION.
188
189 =item platform_constants
190
191 =cut
192
193 sub init_platform {
194     my($self) = shift;
195
196     $self->{MM_Win32_VERSION} = $VERSION;
197 }
198
199 sub platform_constants {
200     my($self) = shift;
201     my $make_frag = '';
202
203     foreach my $macro (qw(MM_Win32_VERSION))
204     {
205         next unless defined $self->{$macro};
206         $make_frag .= "$macro = $self->{$macro}\n";
207     }
208
209     return $make_frag;
210 }
211
212
213 =item special_targets
214
215 Add .USESHELL target for dmake.
216
217 =cut
218
219 sub special_targets {
220     my($self) = @_;
221
222     my $make_frag = $self->SUPER::special_targets;
223
224     $make_frag .= <<'MAKE_FRAG' if $self->is_make_type('dmake');
225 .USESHELL :
226 MAKE_FRAG
227
228     return $make_frag;
229 }
230
231
232 =item static_lib
233
234 Changes how to run the linker.
235
236 The rest is duplicate code from MM_Unix.  Should move the linker code
237 to its own method.
238
239 =cut
240
241 sub static_lib {
242     my($self) = @_;
243     return '' unless $self->has_link_code;
244
245     my(@m);
246     push(@m, <<'END');
247 $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DFSEP).exists
248         $(RM_RF) $@
249 END
250
251     # If this extension has its own library (eg SDBM_File)
252     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
253     push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
254         $(CP) $(MYEXTLIB) $@
255 MAKE_FRAG
256
257     push @m,
258 q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
259                           : ($GCC ? '-ru $@ $(OBJECT)'
260                                   : '-out:$@ $(OBJECT)')).q{
261         $(CHMOD) $(PERM_RWX) $@
262         $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
263 };
264
265     # Old mechanism - still available:
266     push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
267         $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
268 MAKE_FRAG
269
270     join('', @m);
271 }
272
273
274 =item dynamic_lib
275
276 Complicated stuff for Win32 that I don't understand. :(
277
278 =cut
279
280 sub dynamic_lib {
281     my($self, %attribs) = @_;
282     return '' unless $self->needs_linking(); #might be because of a subdir
283
284     return '' unless $self->has_link_code;
285
286     my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
287     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
288     my($ldfrom) = '$(LDFROM)';
289     my(@m);
290
291 # one thing for GCC/Mingw32:
292 # we try to overcome non-relocateable-DLL problems by generating
293 #    a (hopefully unique) image-base from the dll's name
294 # -- BKS, 10-19-1999
295     if ($GCC) { 
296         my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
297         $dllname =~ /(....)(.{0,4})/;
298         my $baseaddr = unpack("n", $1 ^ $2);
299         $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
300     }
301
302     push(@m,'
303 # This section creates the dynamically loadable $(INST_DYNAMIC)
304 # from $(OBJECT) and possibly $(MYEXTLIB).
305 OTHERLDFLAGS = '.$otherldflags.'
306 INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
307
308 $(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
309 ');
310     if ($GCC) {
311       push(@m,  
312        q{       dlltool --def $(EXPORT_LIST) --output-exp dll.exp
313         $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
314         dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
315         $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
316     } elsif ($BORLAND) {
317       push(@m,
318        q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
319        .($self->is_make_type('dmake')
320                 ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
321                  .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
322                 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
323                  .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
324        .q{,$(RESFILES)});
325     } else {    # VC
326       push(@m,
327        q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
328       .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
329
330       # Embed the manifest file if it exists
331       push(@m, q{
332         if exist $@.manifest mt -nologo -manifest $@.manifest -outputresource:$@;2
333         if exist $@.manifest del $@.manifest});
334     }
335     push @m, '
336         $(CHMOD) $(PERM_RWX) $@
337 ';
338
339     join('',@m);
340 }
341
342 =item extra_clean_files
343
344 Clean out some extra dll.{base,exp} files which might be generated by
345 gcc.  Otherwise, take out all *.pdb files.
346
347 =cut
348
349 sub extra_clean_files {
350     my $self = shift;
351
352     return $GCC ? (qw(dll.base dll.exp)) : ('*.pdb');
353 }
354
355 =item init_linker
356
357 =cut
358
359 sub init_linker {
360     my $self = shift;
361
362     $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
363     $self->{PERL_ARCHIVE_AFTER} = '';
364     $self->{EXPORT_LIST}        = '$(BASEEXT).def';
365 }
366
367
368 =item perl_script
369
370 Checks for the perl program under several common perl extensions.
371
372 =cut
373
374 sub perl_script {
375     my($self,$file) = @_;
376     return $file if -r $file && -f _;
377     return "$file.pl"  if -r "$file.pl" && -f _;
378     return "$file.plx" if -r "$file.plx" && -f _;
379     return "$file.bat" if -r "$file.bat" && -f _;
380     return;
381 }
382
383
384 =item xs_o
385
386 This target is stubbed out.  Not sure why.
387
388 =cut
389
390 sub xs_o {
391     return ''
392 }
393
394
395 =item pasthru
396
397 All we send is -nologo to nmake to prevent it from printing its damned
398 banner.
399
400 =cut
401
402 sub pasthru {
403     my($self) = shift;
404     return "PASTHRU = " . ($self->is_make_type('nmake') ? "-nologo" : "");
405 }
406
407
408 =item arch_check (override)
409
410 Normalize all arguments for consistency of comparison.
411
412 =cut
413
414 sub arch_check {
415     my $self = shift;
416
417     # Win32 is an XS module, minperl won't have it.
418     # arch_check() is not critical, so just fake it.
419     return 1 unless $self->can_load_xs;
420     return $self->SUPER::arch_check( map { $self->_normalize_path_name($_) } @_);
421 }
422
423 sub _normalize_path_name {
424     my $self = shift;
425     my $file = shift;
426
427     require Win32;
428     my $short = Win32::GetShortPathName($file);
429     return defined $short ? lc $short : lc $file;
430 }
431
432
433 =item oneliner
434
435 These are based on what command.com does on Win98.  They may be wrong
436 for other Windows shells, I don't know.
437
438 =cut
439
440 sub oneliner {
441     my($self, $cmd, $switches) = @_;
442     $switches = [] unless defined $switches;
443
444     # Strip leading and trailing newlines
445     $cmd =~ s{^\n+}{};
446     $cmd =~ s{\n+$}{};
447
448     $cmd = $self->quote_literal($cmd);
449     $cmd = $self->escape_newlines($cmd);
450
451     $switches = join ' ', @$switches;
452
453     return qq{\$(ABSPERLRUN) $switches -e $cmd --};
454 }
455
456
457 sub quote_literal {
458     my($self, $text) = @_;
459
460     # I don't know if this is correct, but it seems to work on
461     # Win98's command.com
462     $text =~ s{"}{\\"}g;
463
464     # dmake eats '{' inside double quotes and leaves alone { outside double
465     # quotes; however it transforms {{ into { either inside and outside double
466     # quotes.  It also translates }} into }.  The escaping below is not
467     # 100% correct.
468     if( $self->is_make_type('dmake') ) {
469         $text =~ s/{/{{/g;
470         $text =~ s/}}/}}}/g;
471     }
472
473     return qq{"$text"};
474 }
475
476
477 sub escape_newlines {
478     my($self, $text) = @_;
479
480     # Escape newlines
481     $text =~ s{\n}{\\\n}g;
482
483     return $text;
484 }
485
486
487 =item cd
488
489 dmake can handle Unix style cd'ing but nmake (at least 1.5) cannot.  It
490 wants:
491
492     cd dir1\dir2
493     command
494     another_command
495     cd ..\..
496
497 =cut
498
499 sub cd {
500     my($self, $dir, @cmds) = @_;
501
502     return $self->SUPER::cd($dir, @cmds) unless $self->is_make_type('nmake');
503
504     my $cmd = join "\n\t", map "$_", @cmds;
505
506     my $updirs = $self->catdir(map { $self->updir } $self->splitdir($dir));
507
508     # No leading tab and no trailing newline makes for easier embedding.
509     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd, $updirs;
510 cd %s
511         %s
512         cd %s
513 MAKE_FRAG
514
515     chomp $make_frag;
516
517     return $make_frag;
518 }
519
520
521 =item max_exec_len
522
523 nmake 1.50 limits command length to 2048 characters.
524
525 =cut
526
527 sub max_exec_len {
528     my $self = shift;
529
530     return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
531 }
532
533
534 =item os_flavor
535
536 Windows is Win32.
537
538 =cut
539
540 sub os_flavor {
541     return('Win32');
542 }
543
544
545 =item cflags
546
547 Defines the PERLDLL symbol if we are configured for static building since all
548 code destined for the perl5xx.dll must be compiled with the PERLDLL symbol
549 defined.
550
551 =cut
552
553 sub cflags {
554     my($self,$libperl)=@_;
555     return $self->{CFLAGS} if $self->{CFLAGS};
556     return '' unless $self->needs_linking();
557
558     my $base = $self->SUPER::cflags($libperl);
559     foreach (split /\n/, $base) {
560         /^(\S*)\s*=\s*(\S*)$/ and $self->{$1} = $2;
561     };
562     $self->{CCFLAGS} .= " -DPERLDLL" if ($self->{LINKTYPE} eq 'static');
563
564     return $self->{CFLAGS} = qq{
565 CCFLAGS = $self->{CCFLAGS}
566 OPTIMIZE = $self->{OPTIMIZE}
567 PERLTYPE = $self->{PERLTYPE}
568 };
569
570 }
571
572 sub is_make_type {
573     my($self, $type) = @_;
574     return !! ($self->make =~ /\b$type(?:\.exe)?$/);
575 }
576
577 1;
578 __END__
579
580 =back
581
582 =cut 
583
584