[OpenSPARC-T2-DV] / tools / perl-5.8.0 / lib / 5.8.0 / 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.10';

$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}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
    $self->{CHMOD}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e chmod'; 
    $self->{CP}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
    $self->{RM_F}     ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
    $self->{RM_RF}    ||= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
    $self->{MV}       ||= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
    $self->{NOOP}     ||= 'rem';
    $self->{TEST_F}   ||= '$(ABSPERLRUN) -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) blibdirs.ts
	$(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

    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) blibdirs.ts $(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) $@
';

    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{\$(ABSPERLRUN) $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
Commit	Line	Data
86530b38 AT	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.10';
	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} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e touch';
175	$self->{CHMOD} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e chmod';
176	$self->{CP} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e cp';
177	$self->{RM_F} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e rm_f';
178	$self->{RM_RF} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e rm_rf';
179	$self->{MV} \|\|= '$(ABSPERLRUN) -MExtUtils::Command -e mv';
180	$self->{NOOP} \|\|= 'rem';
181	$self->{TEST_F} \|\|= '$(ABSPERLRUN) -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) blibdirs.ts
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	join('', @m);
296	}
297
298
299	=item dynamic_lib (o)
300
301	Complicated stuff for Win32 that I don't understand. :(
302
303	=cut
304
305	sub dynamic_lib {
306	my($self, %attribs) = @_;
307	return '' unless $self->needs_linking(); #might be because of a subdir
308
309	return '' unless $self->has_link_code;
310
311	my($otherldflags) = $attribs{OTHERLDFLAGS} \|\| ($BORLAND ? 'c0d32.obj': '');
312	my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} \|\| "";
313	my($ldfrom) = '$(LDFROM)';
314	my(@m);
315
316	# one thing for GCC/Mingw32:
317	# we try to overcome non-relocateable-DLL problems by generating
318	# a (hopefully unique) image-base from the dll's name
319	# -- BKS, 10-19-1999
320	if ($GCC) {
321	my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
322	$dllname =~ /(....)(.{0,4})/;
323	my $baseaddr = unpack("n", $1 ^ $2);
324	$otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
325	}
326
327	push(@m,'
328	# This section creates the dynamically loadable $(INST_DYNAMIC)
329	# from $(OBJECT) and possibly $(MYEXTLIB).
330	OTHERLDFLAGS = '.$otherldflags.'
331	INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
332
333	$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) blibdirs.ts $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
334	');
335	if ($GCC) {
336	push(@m,
337	q{ dlltool --def $(EXPORT_LIST) --output-exp dll.exp
338	$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
339	dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
340	$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
341	} elsif ($BORLAND) {
342	push(@m,
343	q{ $(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
344	.($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
345	.q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
346	: q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
347	.q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
348	.q{,$(RESFILES)});
349	} else { # VC
350	push(@m,
351	q{ $(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
352	.q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
353	}
354	push @m, '
355	$(CHMOD) $(PERM_RWX) $@
356	';
357
358	join('',@m);
359	}
360
361	=item clean
362
363	Clean out some extra dll.{base,exp} files which might be generated by
364	gcc. Otherwise, take out all *.pdb files.
365
366	=cut
367
368	sub clean
369	{
370	my ($self) = shift;
371	my $s = $self->SUPER::clean(@_);
372	my $clean = $GCC ? 'dll.base dll.exp' : '*.pdb';
373	$s .= <<END;
374	clean ::
375	-\$(RM_F) $clean
376
377	END
378	return $s;
379	}
380
381	=item init_linker
382
383	=cut
384
385	sub init_linker {
386	my $self = shift;
387
388	$self->{PERL_ARCHIVE} = "\$(PERL_INC)\\$Config{libperl}";
389	$self->{PERL_ARCHIVE_AFTER} = '';
390	$self->{EXPORT_LIST} = '$(BASEEXT).def';
391	}
392
393
394	=item perl_script
395
396	Checks for the perl program under several common perl extensions.
397
398	=cut
399
400	sub perl_script {
401	my($self,$file) = @_;
402	return $file if -r $file && -f _;
403	return "$file.pl" if -r "$file.pl" && -f _;
404	return "$file.plx" if -r "$file.plx" && -f _;
405	return "$file.bat" if -r "$file.bat" && -f _;
406	return;
407	}
408
409
410	=item xs_o (o)
411
412	This target is stubbed out. Not sure why.
413
414	=cut
415
416	sub xs_o {
417	return ''
418	}
419
420
421	=item pasthru (o)
422
423	All we send is -nologo to nmake to prevent it from printing its damned
424	banner.
425
426	=cut
427
428	sub pasthru {
429	my($self) = shift;
430	return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
431	}
432
433
434	=item oneliner (o)
435
436	These are based on what command.com does on Win98. They may be wrong
437	for other Windows shells, I don't know.
438
439	=cut
440
441	sub oneliner {
442	my($self, $cmd, $switches) = @_;
443	$switches = [] unless defined $switches;
444
445	# Strip leading and trailing newlines
446	$cmd =~ s{^\n+}{};
447	$cmd =~ s{\n+$}{};
448
449	$cmd = $self->quote_literal($cmd);
450	$cmd = $self->escape_newlines($cmd);
451
452	$switches = join ' ', @$switches;
453
454	return qq{\$(ABSPERLRUN) $switches -e $cmd};
455	}
456
457
458	sub quote_literal {
459	my($self, $text) = @_;
460
461	# I don't know if this is correct, but it seems to work on
462	# Win98's command.com
463	$text =~ s{"}{\\"}g;
464
465	# dmake eats '{' inside double quotes and leaves alone { outside double
466	# quotes; however it transforms {{ into { either inside and outside double
467	# quotes. It also translates }} into }. The escaping below is not
468	# 100% correct.
469	if( $DMAKE ) {
470	$text =~ s/{/{{/g;
471	$text =~ s/}}/}}}/g;
472	}
473
474	return qq{"$text"};
475	}
476
477
478	sub escape_newlines {
479	my($self, $text) = @_;
480
481	# Escape newlines
482	$text =~ s{\n}{\\\n}g;
483
484	return $text;
485	}
486
487
488	=item max_exec_len
489
490	nmake 1.50 limits command length to 2048 characters.
491
492	=cut
493
494	sub max_exec_len {
495	my $self = shift;
496
497	return $self->{_MAX_EXEC_LEN} \|\|= 2 * 1024;
498	}
499
500
501	=item os_flavor
502
503	Windows is Win32.
504
505	=cut
506
507	sub os_flavor {
508	return('Win32');
509	}
510
511
512	1;
513	__END__
514
515	=back
516
517	=cut
518
519