This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Time::HiRes: Do not create files in blib directories under core
[perl5.git] / lib / ExtUtils / MM_Win32.pm
CommitLineData
68dc0745
PP
1package ExtUtils::MM_Win32;
2
479d2113
MS
3use strict;
4
b75c8c73 5
68dc0745
PP
6=head1 NAME
7
8ExtUtils::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
16See ExtUtils::MM_Unix for a documentation of the methods provided
17there. This package overrides the implementation of these methods, not
18the semantics.
19
68dc0745
PP
20=cut
21
3e3baf6d 22use Config;
68dc0745 23use File::Basename;
ecf68df6 24use File::Spec;
f6d6199c 25use ExtUtils::MakeMaker qw( neatvalue );
68dc0745 26
479d2113 27use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE);
f6d6199c
MS
28
29require ExtUtils::MM_Any;
30require ExtUtils::MM_Unix;
31@ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
479d2113 32$VERSION = '1.06';
68dc0745
PP
33
34$ENV{EMXSHELL} = 'sh'; # to run `commands`
68dc0745 35
3e3baf6d 36$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
5b0d9cbe 37$GCC = 1 if $Config{'cc'} =~ /^gcc/i;
3e3baf6d
TB
38$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
39$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
479d2113
MS
40
41
42=head2 Overridden methods
43
44=over 4
45
46=item B<dlsyms>
47
48=cut
3e3baf6d 49
68dc0745
PP
50sub dlsyms {
51 my($self,%attribs) = @_;
52
53 my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
54 my($vars) = $attribs{DL_VARS} || $self->{DL_VARS} || [];
762efda7 55 my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
68dc0745
PP
56 my($imports) = $attribs{IMPORTS} || $self->{IMPORTS} || {};
57 my(@m);
68dc0745
PP
58
59 if (not $self->{SKIPHASH}{'dynamic'}) {
60 push(@m,"
61$self->{BASEEXT}.def: Makefile.PL
62",
f6d6199c 63 q! $(PERLRUN) -MExtUtils::Mksymlists \\
5e687e55
NK
64 -e "Mksymlists('NAME'=>\"!, $self->{NAME},
65 q!\", 'DLBASE' => '!,$self->{DLBASE},
66 # The above two lines quoted differently to work around
67 # a bug in the 4DOS/4NT command line interpreter. The visible
68 # result of the bug was files named q('extension_name',) *with the
69 # single quotes and the comma* in the extension build directories.
68dc0745 70 q!', 'DL_FUNCS' => !,neatvalue($funcs),
762efda7 71 q!, 'FUNCLIST' => !,neatvalue($funclist),
68dc0745
PP
72 q!, 'IMPORTS' => !,neatvalue($imports),
73 q!, 'DL_VARS' => !, neatvalue($vars), q!);"
74!);
75 }
76 join('',@m);
77}
78
479d2113
MS
79=item replace_manpage_separator
80
81Changes the path separator with .
82
83=cut
84
68dc0745
PP
85sub replace_manpage_separator {
86 my($self,$man) = @_;
87 $man =~ s,/+,.,g;
88 $man;
89}
90
479d2113
MS
91
92=item B<maybe_command>
93
94Since Windows has nothing as simple as an executable bit, we check the
95file extension.
96
97The PATHEXT env variable will be used to get a list of extensions that
98might indicate a command, otherwise .com, .exe, .bat and .cmd will be
99used by default.
100
101=cut
102
68dc0745
PP
103sub maybe_command {
104 my($self,$file) = @_;
846f184a
GS
105 my @e = exists($ENV{'PATHEXT'})
106 ? split(/;/, $ENV{PATHEXT})
107 : qw(.com .exe .bat .cmd);
108 my $e = '';
109 for (@e) { $e .= "\Q$_\E|" }
110 chop $e;
111 # see if file ends in one of the known extensions
2b2708c8 112 if ($file =~ /($e)$/i) {
846f184a
GS
113 return $file if -e $file;
114 }
115 else {
116 for (@e) {
117 return "$file$_" if -e "$file$_";
118 }
119 }
68dc0745
PP
120 return;
121}
122
68dc0745 123
479d2113 124=item B<find_tests>
39234879 125
479d2113
MS
126The Win9x shell does not expand globs and I'll play it safe and assume
127other Windows variants don't either.
128
129So we do it for them.
68dc0745 130
479d2113 131=cut
45bc4d3a 132
45bc4d3a
JH
133sub find_tests {
134 return join(' ', <t\\*.t>);
135}
136
137
479d2113
MS
138=item B<init_DIRFILESEP>
139
140Using \ for Windows.
141
142=cut
143
144sub init_DIRFILESEP {
145 my($self) = shift;
146
147 # gotta be careful this isn't interpreted as an escape.
148 $self->{DIRFILESEP} = '^\\';
68dc0745
PP
149}
150
479d2113
MS
151=item B<init_others>
152
153Override some of the Unix specific commands with portable
154ExtUtils::Command ones.
155
156Also provide defaults for LD and AR in case the %Config values aren't
157set.
3e3baf6d 158
479d2113 159LDLOADLIBS's default is changed to $Config{libs}.
3e3baf6d 160
479d2113 161Adjustments are made for Borland's quirks needing -L to come first.
3e3baf6d
TB
162
163=cut
164
479d2113
MS
165sub init_others {
166 my ($self) = @_;
167
168 # Used in favor of echo because echo won't strip quotes. :(
169 $self->{ECHO} ||= '$(PERLRUN) -le "print qq{@ARGV}"';
170 $self->{TOUCH} ||= '$(PERLRUN) -MExtUtils::Command -e touch';
171 $self->{CHMOD} ||= '$(PERLRUN) -MExtUtils::Command -e chmod';
172 $self->{CP} ||= '$(PERLRUN) -MExtUtils::Command -e cp';
173 $self->{RM_F} ||= '$(PERLRUN) -MExtUtils::Command -e rm_f';
174 $self->{RM_RF} ||= '$(PERLRUN) -MExtUtils::Command -e rm_rf';
175 $self->{MV} ||= '$(PERLRUN) -MExtUtils::Command -e mv';
176 $self->{NOOP} ||= 'rem';
177 $self->{TEST_F} ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
178 $self->{DEV_NULL} ||= '> NUL';
179
180 # technically speaking, these should be in init_main()
181 $self->{LD} ||= $Config{ld} || 'link';
182 $self->{AR} ||= $Config{ar} || 'lib';
183
184 $self->SUPER::init_others;
185
186 $self->{LDLOADLIBS} ||= $Config{libs};
187 # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
188 if ($BORLAND) {
189 my $libs = $self->{LDLOADLIBS};
190 my $libpath = '';
191 while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
192 $libpath .= ' ' if length $libpath;
193 $libpath .= $1;
194 }
195 $self->{LDLOADLIBS} = $libs;
196 $self->{LDDLFLAGS} ||= $Config{lddlflags};
197 $self->{LDDLFLAGS} .= " $libpath";
3e3baf6d
TB
198 }
199
479d2113
MS
200 return 1;
201}
3e3baf6d 202
3e3baf6d 203
479d2113 204=item init_platform (o)
3e3baf6d 205
479d2113 206Add MM_Win32_VERSION.
3e3baf6d 207
479d2113 208=item platform_constants (o)
3e3baf6d 209
479d2113 210=cut
3e3baf6d 211
479d2113
MS
212sub init_platform {
213 my($self) = shift;
3e3baf6d 214
479d2113
MS
215 $self->{MM_Win32_VERSION} = $VERSION;
216}
3e3baf6d 217
479d2113
MS
218sub platform_constants {
219 my($self) = shift;
220 my $make_frag = '';
3e3baf6d 221
479d2113
MS
222 foreach my $macro (qw(MM_Win32_VERSION))
223 {
224 next unless defined $self->{$macro};
225 $make_frag .= "$macro = $self->{$macro}\n";
226 }
3e3baf6d 227
479d2113
MS
228 return $make_frag;
229}
3e3baf6d 230
3e3baf6d 231
479d2113 232=item special_targets (o)
3e3baf6d 233
479d2113 234Add .USESHELL target for dmake.
3e3baf6d 235
479d2113 236=cut
3e3baf6d 237
479d2113
MS
238sub special_targets {
239 my($self) = @_;
3e3baf6d 240
479d2113 241 my $make_frag = $self->SUPER::special_targets;
3e3baf6d 242
479d2113
MS
243 $make_frag .= <<'MAKE_FRAG' if $DMAKE;
244.USESHELL :
245MAKE_FRAG
3e3baf6d 246
479d2113 247 return $make_frag;
3e3baf6d
TB
248}
249
250
68dc0745
PP
251=item static_lib (o)
252
479d2113
MS
253Changes how to run the linker.
254
255The rest is duplicate code from MM_Unix. Should move the linker code
256to its own method.
68dc0745
PP
257
258=cut
259
260sub static_lib {
261 my($self) = @_;
68dc0745
PP
262 return '' unless $self->has_link_code;
263
264 my(@m);
265 push(@m, <<'END');
479d2113 266$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
68dc0745
PP
267 $(RM_RF) $@
268END
479d2113 269
022735b4 270 # If this extension has its own library (eg SDBM_File)
68dc0745 271 # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
479d2113
MS
272 push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
273 $(CP) $(MYEXTLIB) $@
274MAKE_FRAG
68dc0745
PP
275
276 push @m,
910dfcc8
GS
277q{ $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
278 : ($GCC ? '-ru $@ $(OBJECT)'
279 : '-out:$@ $(OBJECT)')).q{
479d2113
MS
280 $(CHMOD) $(PERM_RWX) $@
281 $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
68dc0745
PP
282};
283
479d2113
MS
284 # Old mechanism - still available:
285 push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
286 $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
287MAKE_FRAG
68dc0745 288
479d2113
MS
289 push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
290 join('', @m);
68dc0745
PP
291}
292
68dc0745
PP
293
294=item dynamic_lib (o)
295
479d2113 296Complicated stuff for Win32 that I don't understand. :(
68dc0745
PP
297
298=cut
299
300sub dynamic_lib {
301 my($self, %attribs) = @_;
302 return '' unless $self->needs_linking(); #might be because of a subdir
303
304 return '' unless $self->has_link_code;
305
3e3baf6d 306 my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
68dc0745
PP
307 my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
308 my($ldfrom) = '$(LDFROM)';
309 my(@m);
7a958ec3 310
5db10396
GS
311# one thing for GCC/Mingw32:
312# we try to overcome non-relocateable-DLL problems by generating
7a958ec3
BS
313# a (hopefully unique) image-base from the dll's name
314# -- BKS, 10-19-1999
315 if ($GCC) {
7a958ec3
BS
316 my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
317 $dllname =~ /(....)(.{0,4})/;
318 my $baseaddr = unpack("n", $1 ^ $2);
319 $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
320 }
321
68dc0745
PP
322 push(@m,'
323# This section creates the dynamically loadable $(INST_DYNAMIC)
324# from $(OBJECT) and possibly $(MYEXTLIB).
325OTHERLDFLAGS = '.$otherldflags.'
326INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
327
479d2113 328$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
68dc0745 329');
5b0d9cbe
NIS
330 if ($GCC) {
331 push(@m,
910dfcc8
GS
332 q{ dlltool --def $(EXPORT_LIST) --output-exp dll.exp
333 $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
5b0d9cbe
NIS
334 dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
335 $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
dc0d354b
GS
336 } elsif ($BORLAND) {
337 push(@m,
338 q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
339 .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
340 .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
341 : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
342 .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
343 .q{,$(RESFILES)});
344 } else { # VC
345 push(@m,
346 q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
347 .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
5b0d9cbe 348 }
68dc0745 349 push @m, '
479d2113 350 $(CHMOD) $(PERM_RWX) $@
68dc0745
PP
351';
352
353 push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
354 join('',@m);
355}
356
479d2113
MS
357=item clean
358
359Clean out some extra dll.{base,exp} files which might be generated by
360gcc. Otherwise, take out all *.pdb files.
361
362=cut
363
562c1c19
NIS
364sub clean
365{
f6d6199c
MS
366 my ($self) = shift;
367 my $s = $self->SUPER::clean(@_);
1f50c5a9
GS
368 my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
369 $s .= <<END;
562c1c19 370clean ::
1f50c5a9 371 -\$(RM_F) $clean
562c1c19
NIS
372
373END
1f50c5a9 374 return $s;
562c1c19
NIS
375}
376
479d2113 377=item init_linker
562c1c19 378
479d2113 379=cut
562c1c19 380
479d2113
MS
381sub init_linker {
382 my $self = shift;
68dc0745 383
479d2113
MS
384 $self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}";
385 $self->{PERL_ARCHIVE_AFTER} = '';
386 $self->{EXPORT_LIST} = '$(BASEEXT).def';
68dc0745
PP
387}
388
45bc4d3a 389
68dc0745
PP
390=item perl_script
391
479d2113 392Checks for the perl program under several common perl extensions.
68dc0745
PP
393
394=cut
395
396sub perl_script {
397 my($self,$file) = @_;
cae6c631 398 return $file if -r $file && -f _;
479d2113
MS
399 return "$file.pl" if -r "$file.pl" && -f _;
400 return "$file.plx" if -r "$file.plx" && -f _;
cae6c631 401 return "$file.bat" if -r "$file.bat" && -f _;
68dc0745
PP
402 return;
403}
404
3e3baf6d 405
479d2113 406=item xs_o (o)
68dc0745 407
479d2113 408This target is stubbed out. Not sure why.
68dc0745
PP
409
410=cut
411
479d2113
MS
412sub xs_o {
413 return ''
68dc0745
PP
414}
415
68dc0745 416
479d2113 417=item pasthru (o)
68dc0745 418
479d2113
MS
419All we send is -nologo to nmake to prevent it from printing its damned
420banner.
68dc0745
PP
421
422=cut
423
479d2113 424sub pasthru {
68dc0745 425 my($self) = shift;
479d2113 426 return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
68dc0745
PP
427}
428
3e3baf6d 429
479d2113 430=item oneliner (o)
3e3baf6d 431
479d2113
MS
432These are based on what command.com does on Win98. They may be wrong
433for other Windows shells, I don't know.
3e3baf6d
TB
434
435=cut
436
479d2113
MS
437sub oneliner {
438 my($self, $cmd, $switches) = @_;
439 $switches = [] unless defined $switches;
3e3baf6d 440
479d2113
MS
441 # Strip leading and trailing newlines
442 $cmd =~ s{^\n+}{};
443 $cmd =~ s{\n+$}{};
3e3baf6d 444
479d2113
MS
445 $cmd = $self->quote_literal($cmd);
446 $cmd = $self->escape_newlines($cmd);
3e3baf6d 447
479d2113 448 $switches = join ' ', @$switches;
3e3baf6d 449
479d2113 450 return qq{\$(PERLRUN) $switches -e $cmd};
3e3baf6d
TB
451}
452
68dc0745 453
479d2113
MS
454sub quote_literal {
455 my($self, $text) = @_;
68dc0745 456
479d2113
MS
457 # I don't know if this is correct, but it seems to work on
458 # Win98's command.com
459 $text =~ s{"}{\\"}g;
68dc0745 460
479d2113 461 return qq{"$text"};
68dc0745
PP
462}
463
68dc0745 464
479d2113
MS
465sub escape_newlines {
466 my($self, $text) = @_;
68dc0745 467
479d2113
MS
468 # Escape newlines
469 $text =~ s{\n}{\\\n}g;
68dc0745 470
479d2113 471 return $text;
68dc0745
PP
472}
473
68dc0745 474
479d2113 475=item max_exec_len
68dc0745 476
479d2113 477Using 31K, a safe number gotten from Windows 2000.
68dc0745
PP
478
479=cut
480
479d2113
MS
481sub max_exec_len {
482 my $self = shift;
483
484 return $self->{_MAX_EXEC_LEN} ||= 31 * 1024;
68dc0745
PP
485}
486
487
68dc0745
PP
4881;
489__END__
490
491=back
492
493=cut
494
5b0d9cbe 495