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