lib/ExtUtils/MM_Win32.pm

package ExtUtils::MM_Win32;

use strict;


=head1 NAME

ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker

=head1 SYNOPSIS

 use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed

=head1 DESCRIPTION

See ExtUtils::MM_Unix for a documentation of the methods provided
there. This package overrides the implementation of these methods, not
the semantics.

=cut 

use Config;
use File::Basename;
use File::Spec;
use ExtUtils::MakeMaker qw( neatvalue );

use vars qw(@ISA $VERSION $BORLAND $GCC $DMAKE $NMAKE);

require ExtUtils::MM_Any;
require ExtUtils::MM_Unix;
@ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
$VERSION = '1.09';

$ENV{EMXSHELL} = 'sh'; # to run `commands`

$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
$GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;


=head2 Overridden methods

=over 4

=item B<dlsyms>

=cut

sub dlsyms {
    my($self,%attribs) = @_;

    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
    my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
    my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
    my(@m);

    if (not $self->{SKIPHASH}{'dynamic'}) {
        push(@m,"
$self->{BASEEXT}.def: Makefile.PL
",
     q! $(PERLRUN) -MExtUtils::Mksymlists \\
     -e "Mksymlists('NAME'=>\"!, $self->{NAME},
     q!\", 'DLBASE' => '!,$self->{DLBASE},
     # The above two lines quoted differently to work around
     # a bug in the 4DOS/4NT command line interpreter.  The visible
     # result of the bug was files named q('extension_name',) *with the
     # single quotes and the comma* in the extension build directories.
     q!', 'DL_FUNCS' => !,neatvalue($funcs),
     q!, 'FUNCLIST' => !,neatvalue($funclist),
     q!, 'IMPORTS' => !,neatvalue($imports),
     q!, 'DL_VARS' => !, neatvalue($vars), q!);"
!);
    }
    join('',@m);
}

=item replace_manpage_separator

Changes the path separator with .

=cut

sub replace_manpage_separator {
    my($self,$man) = @_;
    $man =~ s,/+,.,g;
    $man;
}


=item B<maybe_command>

Since Windows has nothing as simple as an executable bit, we check the
file extension.

The PATHEXT env variable will be used to get a list of extensions that
might indicate a command, otherwise .com, .exe, .bat and .cmd will be
used by default.

=cut

sub maybe_command {
    my($self,$file) = @_;
    my @e = exists($ENV{'PATHEXT'})
          ? split(/;/, $ENV{PATHEXT})
          : qw(.com .exe .bat .cmd);
    my $e = '';
    for (@e) { $e .= "\Q$_\E|" }
    chop $e;
    # see if file ends in one of the known extensions
    if ($file =~ /($e)$/i) {
        return $file if -e $file;
    }
    else {
        for (@e) {
            return "$file$_" if -e "$file$_";
        }
    }
    return;
}


=item B<find_tests>

The Win9x shell does not expand globs and I'll play it safe and assume
other Windows variants don't either.

So we do it for them.

=cut

sub find_tests {
    return join(' ', <t\\*.t>);
}


=item B<init_DIRFILESEP>

Using \ for Windows.

=cut

sub init_DIRFILESEP {
    my($self) = shift;

    # The ^ makes sure its not interpreted as an escape in nmake
    $self->{DIRFILESEP} = $NMAKE ? '^\\' :
                          $DMAKE ? '\\\\'
                                 : '\\';
}

=item B<init_others>

Override some of the Unix specific commands with portable
ExtUtils::Command ones.

Also provide defaults for LD and AR in case the %Config values aren't
set.

LDLOADLIBS's default is changed to $Config{libs}.

Adjustments are made for Borland's quirks needing -L to come first.

=cut

sub init_others {
    my ($self) = @_;

    # Used in favor of echo because echo won't strip quotes. :(
    $self->{ECHO}     ||= $self->oneliner('print qq{@ARGV}', ['-l']);
    $self->{ECHO_N}   ||= $self->oneliner('print qq{@ARGV}');

    $self->{TOUCH}    ||= '$(PERLRUN) -MExtUtils::Command -e touch';
    $self->{CHMOD}    ||= '$(PERLRUN) -MExtUtils::Command -e chmod'; 
    $self->{CP}       ||= '$(PERLRUN) -MExtUtils::Command -e cp';
    $self->{RM_F}     ||= '$(PERLRUN) -MExtUtils::Command -e rm_f';
    $self->{RM_RF}    ||= '$(PERLRUN) -MExtUtils::Command -e rm_rf';
    $self->{MV}       ||= '$(PERLRUN) -MExtUtils::Command -e mv';
    $self->{NOOP}     ||= 'rem';
    $self->{TEST_F}   ||= '$(PERLRUN) -MExtUtils::Command -e test_f';
    $self->{DEV_NULL} ||= '> NUL';

    $self->{LD}     ||= $Config{ld} || 'link';
    $self->{AR}     ||= $Config{ar} || 'lib';

    $self->SUPER::init_others;

    # Setting SHELL from $Config{sh} can break dmake.  Its ok without it.
    delete $self->{SHELL};

    $self->{LDLOADLIBS} ||= $Config{libs};
    # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
    if ($BORLAND) {
        my $libs = $self->{LDLOADLIBS};
        my $libpath = '';
        while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
            $libpath .= ' ' if length $libpath;
            $libpath .= $1;
        }
        $self->{LDLOADLIBS} = $libs;
        $self->{LDDLFLAGS} ||= $Config{lddlflags};
        $self->{LDDLFLAGS} .= " $libpath";
    }

    return 1;
}


=item init_platform (o)

Add MM_Win32_VERSION.

=item platform_constants (o)

=cut

sub init_platform {
    my($self) = shift;

    $self->{MM_Win32_VERSION} = $VERSION;
}

sub platform_constants {
    my($self) = shift;
    my $make_frag = '';

    foreach my $macro (qw(MM_Win32_VERSION))
    {
        next unless defined $self->{$macro};
        $make_frag .= "$macro = $self->{$macro}\n";
    }

    return $make_frag;
}


=item special_targets (o)

Add .USESHELL target for dmake.

=cut

sub special_targets {
    my($self) = @_;

    my $make_frag = $self->SUPER::special_targets;

    $make_frag .= <<'MAKE_FRAG' if $DMAKE;
.USESHELL :
MAKE_FRAG

    return $make_frag;
}


=item static_lib (o)

Changes how to run the linker.

The rest is duplicate code from MM_Unix.  Should move the linker code
to its own method.

=cut

sub static_lib {
    my($self) = @_;
    return '' unless $self->has_link_code;

    my(@m);
    push(@m, <<'END');
$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists
        $(RM_RF) $@
END

    # If this extension has its own library (eg SDBM_File)
    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
    push @m, <<'MAKE_FRAG' if $self->{MYEXTLIB};
        $(CP) $(MYEXTLIB) $@
MAKE_FRAG

    push @m,
q{      $(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
                          : ($GCC ? '-ru $@ $(OBJECT)'
                                  : '-out:$@ $(OBJECT)')).q{
        $(CHMOD) $(PERM_RWX) $@
        $(NOECHO) $(ECHO) "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
};

    # Old mechanism - still available:
    push @m, <<'MAKE_FRAG' if $self->{PERL_SRC} && $self->{EXTRALIBS};
        $(NOECHO) $(ECHO) "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs
MAKE_FRAG

    push @m, "\n", $self->dir_target('$(INST_ARCHAUTODIR)');
    join('', @m);
}


=item dynamic_lib (o)

Complicated stuff for Win32 that I don't understand. :(

=cut

sub dynamic_lib {
    my($self, %attribs) = @_;
    return '' unless $self->needs_linking(); #might be because of a subdir

    return '' unless $self->has_link_code;

    my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
    my($ldfrom) = '$(LDFROM)';
    my(@m);

# one thing for GCC/Mingw32:
# we try to overcome non-relocateable-DLL problems by generating
#    a (hopefully unique) image-base from the dll's name
# -- BKS, 10-19-1999
    if ($GCC) { 
        my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
        $dllname =~ /(....)(.{0,4})/;
        my $baseaddr = unpack("n", $1 ^ $2);
        $otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
    }

    push(@m,'
# This section creates the dynamically loadable $(INST_DYNAMIC)
# from $(OBJECT) and possibly $(MYEXTLIB).
OTHERLDFLAGS = '.$otherldflags.'
INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'

$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)$(DIRFILESEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
');
    if ($GCC) {
      push(@m,  
       q{       dlltool --def $(EXPORT_LIST) --output-exp dll.exp
        $(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
        dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
        $(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
    } elsif ($BORLAND) {
      push(@m,
       q{       $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
       .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
                 .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
                : q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
                 .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
       .q{,$(RESFILES)});
    } else {    # VC
      push(@m,
       q{       $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
      .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
    }
    push @m, '
        $(CHMOD) $(PERM_RWX) $@
';

    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
    join('',@m);
}

=item clean

Clean out some extra dll.{base,exp} files which might be generated by
gcc.  Otherwise, take out all *.pdb files.

=cut

sub clean
{
    my ($self) = shift;
    my $s = $self->SUPER::clean(@_);
    my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
    $s .= <<END;
clean ::
        -\$(RM_F) $clean

END
    return $s;
}

=item init_linker

=cut

sub init_linker {
    my $self = shift;

    $self->{PERL_ARCHIVE}       = "\$(PERL_INC)\\$Config{libperl}";
    $self->{PERL_ARCHIVE_AFTER} = '';
    $self->{EXPORT_LIST}        = '$(BASEEXT).def';
}


=item perl_script

Checks for the perl program under several common perl extensions.

=cut

sub perl_script {
    my($self,$file) = @_;
    return $file if -r $file && -f _;
    return "$file.pl"  if -r "$file.pl" && -f _;
    return "$file.plx" if -r "$file.plx" && -f _;
    return "$file.bat" if -r "$file.bat" && -f _;
    return;
}


=item xs_o (o)

This target is stubbed out.  Not sure why.

=cut

sub xs_o {
    return ''
}


=item pasthru (o)

All we send is -nologo to nmake to prevent it from printing its damned
banner.

=cut

sub pasthru {
    my($self) = shift;
    return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
}


=item oneliner (o)

These are based on what command.com does on Win98.  They may be wrong
for other Windows shells, I don't know.

=cut

sub oneliner {
    my($self, $cmd, $switches) = @_;
    $switches = [] unless defined $switches;

    # Strip leading and trailing newlines
    $cmd =~ s{^\n+}{};
    $cmd =~ s{\n+$}{};

    $cmd = $self->quote_literal($cmd);
    $cmd = $self->escape_newlines($cmd);

    $switches = join ' ', @$switches;

    return qq{\$(PERLRUN) $switches -e $cmd};
}


sub quote_literal {
    my($self, $text) = @_;

    # I don't know if this is correct, but it seems to work on
    # Win98's command.com
    $text =~ s{"}{\\"}g;

    # dmake eats '{' inside double quotes and leaves alone { outside double
    # quotes; however it transforms {{ into { either inside and outside double
    # quotes.  It also translates }} into }.  The escaping below is not
    # 100% correct.
    if( $DMAKE ) {
        $text =~ s/{/{{/g;
        $text =~ s/}}/}}}/g;
    }

    return qq{"$text"};
}


sub escape_newlines {
    my($self, $text) = @_;

    # Escape newlines
    $text =~ s{\n}{\\\n}g;

    return $text;
}


=item max_exec_len

nmake 1.50 limits command length to 2048 characters.

=cut

sub max_exec_len {
    my $self = shift;

    return $self->{_MAX_EXEC_LEN} ||= 2 * 1024;
}


=item os_flavor

Windows is Win32.

=cut

sub os_flavor {
    return('Win32');
}


1;
__END__

=back

=cut 


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