PageRenderTime 111ms CodeModel.GetById 17ms app.highlight 86ms RepoModel.GetById 1ms app.codeStats 1ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/lib/ExtUtils/MM_Win32.pm

#
Perl | 957 lines | 859 code | 69 blank | 29 comment | 48 complexity | ddfbdc560c228ecd3beb4aae754523b9 MD5 | raw file
  1package ExtUtils::MM_Win32;
  2
  3=head1 NAME
  4
  5ExtUtils::MM_Win32 - methods to override UN*X behaviour in ExtUtils::MakeMaker
  6
  7=head1 SYNOPSIS
  8
  9 use ExtUtils::MM_Win32; # Done internally by ExtUtils::MakeMaker if needed
 10
 11=head1 DESCRIPTION
 12
 13See ExtUtils::MM_Unix for a documentation of the methods provided
 14there. This package overrides the implementation of these methods, not
 15the semantics.
 16
 17=over
 18
 19=cut 
 20
 21use Config;
 22#use Cwd;
 23use File::Basename;
 24require Exporter;
 25
 26Exporter::import('ExtUtils::MakeMaker',
 27       qw( $Verbose &neatvalue));
 28
 29$ENV{EMXSHELL} = 'sh'; # to run `commands`
 30unshift @MM::ISA, 'ExtUtils::MM_Win32';
 31
 32$BORLAND = 1 if $Config{'cc'} =~ /^bcc/i;
 33$GCC     = 1 if $Config{'cc'} =~ /^gcc/i;
 34$DMAKE = 1 if $Config{'make'} =~ /^dmake/i;
 35$NMAKE = 1 if $Config{'make'} =~ /^nmake/i;
 36$PERLMAKE = 1 if $Config{'make'} =~ /^pmake/i;
 37$OBJ   = 1 if $Config{'ccflags'} =~ /PERL_OBJECT/i;
 38
 39# a few workarounds for command.com (very basic)
 40{
 41    package ExtUtils::MM_Win95;
 42
 43    # the $^O test may be overkill, but we want to be sure Win32::IsWin95()
 44    # exists before we try it
 45
 46    unshift @MM::ISA, 'ExtUtils::MM_Win95'
 47	if ($^O =~ /Win32/ && Win32::IsWin95());
 48
 49    sub xs_c {
 50	my($self) = shift;
 51	return '' unless $self->needs_linking();
 52	'
 53.xs.c:
 54	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\
 55	    $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c
 56	'
 57    }
 58
 59    sub xs_cpp {
 60	my($self) = shift;
 61	return '' unless $self->needs_linking();
 62	'
 63.xs.cpp:
 64	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\
 65	    $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.cpp
 66	';
 67    }
 68
 69    # many makes are too dumb to use xs_c then c_o
 70    sub xs_o {
 71	my($self) = shift;
 72	return '' unless $self->needs_linking();
 73	'
 74.xs$(OBJ_EXT):
 75	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) \\
 76	    $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.c
 77	$(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
 78	';
 79    }
 80}	# end of command.com workarounds
 81
 82sub dlsyms {
 83    my($self,%attribs) = @_;
 84
 85    my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
 86    my($vars)  = $attribs{DL_VARS} || $self->{DL_VARS} || [];
 87    my($funclist) = $attribs{FUNCLIST} || $self->{FUNCLIST} || [];
 88    my($imports)  = $attribs{IMPORTS} || $self->{IMPORTS} || {};
 89    my(@m);
 90    (my $boot = $self->{NAME}) =~ s/:/_/g;
 91
 92    if (not $self->{SKIPHASH}{'dynamic'}) {
 93	push(@m,"
 94$self->{BASEEXT}.def: Makefile.PL
 95",
 96     q!	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Mksymlists \\
 97     -e "Mksymlists('NAME' => '!, $self->{NAME},
 98     q!', 'DLBASE' => '!,$self->{DLBASE},
 99     q!', 'DL_FUNCS' => !,neatvalue($funcs),
100     q!, 'FUNCLIST' => !,neatvalue($funclist),
101     q!, 'IMPORTS' => !,neatvalue($imports),
102     q!, 'DL_VARS' => !, neatvalue($vars), q!);"
103!);
104    }
105    join('',@m);
106}
107
108sub replace_manpage_separator {
109    my($self,$man) = @_;
110    $man =~ s,/+,.,g;
111    $man;
112}
113
114sub maybe_command {
115    my($self,$file) = @_;
116    my @e = exists($ENV{'PATHEXT'})
117          ? split(/;/, $ENV{PATHEXT})
118	  : qw(.com .exe .bat .cmd);
119    my $e = '';
120    for (@e) { $e .= "\Q$_\E|" }
121    chop $e;
122    # see if file ends in one of the known extensions
123    if ($file =~ /($e)$/i) {
124	return $file if -e $file;
125    }
126    else {
127	for (@e) {
128	    return "$file$_" if -e "$file$_";
129	}
130    }
131    return;
132}
133
134sub file_name_is_absolute {
135    my($self,$file) = @_;
136    $file =~ m{^([a-z]:)?[\\/]}i ;
137}
138
139sub find_perl {
140    my($self, $ver, $names, $dirs, $trace) = @_;
141    my($name, $dir);
142    if ($trace >= 2){
143	print "Looking for perl $ver by these names:
144@$names
145in these dirs:
146@$dirs
147";
148    }
149    foreach $dir (@$dirs){
150	next unless defined $dir; # $self->{PERL_SRC} may be undefined
151	foreach $name (@$names){
152	    my ($abs, $val);
153	    if ($self->file_name_is_absolute($name)) { # /foo/bar
154		$abs = $name;
155	    } elsif ($self->canonpath($name) eq $self->canonpath(basename($name))) { # foo
156		$abs = $self->catfile($dir, $name);
157	    } else { # foo/bar
158		$abs = $self->canonpath($self->catfile($self->curdir, $name));
159	    }
160	    print "Checking $abs\n" if ($trace >= 2);
161	    next unless $self->maybe_command($abs);
162	    print "Executing $abs\n" if ($trace >= 2);
163	    $val = `$abs -e "require $ver;" 2>&1`;
164	    if ($? == 0) {
165	        print "Using PERL=$abs\n" if $trace;
166	        return $abs;
167	    } elsif ($trace >= 2) {
168		print "Result: `$val'\n";
169	    }
170	}
171    }
172    print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
173    0; # false and not empty
174}
175
176sub catdir {
177    my $self = shift;
178    my @args = @_;
179    for (@args) {
180	# append a slash to each argument unless it has one there
181	$_ .= "\\" if $_ eq '' or substr($_,-1) ne "\\";
182    }
183    my $result = $self->canonpath(join('', @args));
184    $result;
185}
186
187=item catfile
188
189Concatenate one or more directory names and a filename to form a
190complete path ending with a filename
191
192=cut
193
194sub catfile {
195    my $self = shift @_;
196    my $file = pop @_;
197    return $file unless @_;
198    my $dir = $self->catdir(@_);
199    $dir =~ s/(\\\.)$//;
200    $dir .= "\\" unless substr($dir,length($dir)-1,1) eq "\\";
201    return $dir.$file;
202}
203
204sub init_others
205{
206 my ($self) = @_;
207 &ExtUtils::MM_Unix::init_others;
208 $self->{'TOUCH'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e touch';
209 $self->{'CHMOD'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e chmod'; 
210 $self->{'CP'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e cp';
211 $self->{'RM_F'}   = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_f';
212 $self->{'RM_RF'}  = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e rm_rf';
213 $self->{'MV'}     = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mv';
214 $self->{'NOOP'}   = 'rem';
215 $self->{'TEST_F'} = '$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e test_f';
216 $self->{'LD'}     = $Config{'ld'} || 'link';
217 $self->{'AR'}     = $Config{'ar'} || 'lib';
218 $self->{'LDLOADLIBS'} ||= $Config{'libs'};
219 # -Lfoo must come first for Borland, so we put it in LDDLFLAGS
220 if ($BORLAND) {
221     my $libs = $self->{'LDLOADLIBS'};
222     my $libpath = '';
223     while ($libs =~ s/(?:^|\s)(("?)-L.+?\2)(?:\s|$)/ /) {
224         $libpath .= ' ' if length $libpath;
225         $libpath .= $1;
226     }
227     $self->{'LDLOADLIBS'} = $libs;
228     $self->{'LDDLFLAGS'} ||= $Config{'lddlflags'};
229     $self->{'LDDLFLAGS'} .= " $libpath";
230 }
231 $self->{'DEV_NULL'} = '> NUL';
232 # $self->{'NOECHO'} = ''; # till we have it working
233}
234
235
236=item constants (o)
237
238Initializes lots of constants and .SUFFIXES and .PHONY
239
240=cut
241
242sub constants {
243    my($self) = @_;
244    my(@m,$tmp);
245
246    for $tmp (qw/
247
248	      AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION
249	      VERSION_SYM XS_VERSION INST_BIN INST_EXE INST_LIB
250	      INST_ARCHLIB INST_SCRIPT PREFIX  INSTALLDIRS
251	      INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB
252	      INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB
253	      PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB
254	      FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC
255	      PERL_INC PERL FULLPERL
256
257	      / ) {
258	next unless defined $self->{$tmp};
259	push @m, "$tmp = $self->{$tmp}\n";
260    }
261
262    push @m, qq{
263VERSION_MACRO = VERSION
264DEFINE_VERSION = -D\$(VERSION_MACRO)=\\\"\$(VERSION)\\\"
265XS_VERSION_MACRO = XS_VERSION
266XS_DEFINE_VERSION = -D\$(XS_VERSION_MACRO)=\\\"\$(XS_VERSION)\\\"
267};
268
269    push @m, qq{
270MAKEMAKER = $INC{'ExtUtils\MakeMaker.pm'}
271MM_VERSION = $ExtUtils::MakeMaker::VERSION
272};
273
274    push @m, q{
275# FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle).
276# BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle)
277# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD)  !!! Deprecated from MM 5.32  !!!
278# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
279# DLBASE  = Basename part of dynamic library. May be just equal BASEEXT.
280};
281
282    for $tmp (qw/
283	      FULLEXT BASEEXT PARENT_NAME DLBASE VERSION_FROM INC DEFINE OBJECT
284	      LDFROM LINKTYPE
285	      /	) {
286	next unless defined $self->{$tmp};
287	push @m, "$tmp = $self->{$tmp}\n";
288    }
289
290    push @m, "
291# Handy lists of source code files:
292XS_FILES= ".join(" \\\n\t", sort keys %{$self->{XS}})."
293C_FILES = ".join(" \\\n\t", @{$self->{C}})."
294O_FILES = ".join(" \\\n\t", @{$self->{O_FILES}})."
295H_FILES = ".join(" \\\n\t", @{$self->{H}})."
296HTMLLIBPODS    = ".join(" \\\n\t", sort keys %{$self->{HTMLLIBPODS}})."
297HTMLSCRIPTPODS = ".join(" \\\n\t", sort keys %{$self->{HTMLSCRIPTPODS}})."
298MAN1PODS = ".join(" \\\n\t", sort keys %{$self->{MAN1PODS}})."
299MAN3PODS = ".join(" \\\n\t", sort keys %{$self->{MAN3PODS}})."
300";
301
302    for $tmp (qw/
303	      INST_HTMLPRIVLIBDIR INSTALLHTMLPRIVLIBDIR
304	      INST_HTMLSITELIBDIR INSTALLHTMLSITELIBDIR
305	      INST_HTMLSCRIPTDIR  INSTALLHTMLSCRIPTDIR
306	      INST_HTMLLIBDIR                    HTMLEXT
307	      INST_MAN1DIR        INSTALLMAN1DIR MAN1EXT
308	      INST_MAN3DIR        INSTALLMAN3DIR MAN3EXT
309	      /) {
310	next unless defined $self->{$tmp};
311	push @m, "$tmp = $self->{$tmp}\n";
312    }
313
314    push @m, qq{
315.USESHELL :
316} if $DMAKE;
317
318    push @m, q{
319.NO_CONFIG_REC: Makefile
320} if $ENV{CLEARCASE_ROOT};
321
322    # why not q{} ? -- emacs
323    push @m, qq{
324# work around a famous dec-osf make(1) feature(?):
325makemakerdflt: all
326
327.SUFFIXES: .xs .c .C .cpp .cxx .cc \$(OBJ_EXT)
328
329# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
330# some make implementations will delete the Makefile when we rebuild it. Because
331# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
332# does so. Our milage may vary.
333# .PRECIOUS: Makefile    # seems to be not necessary anymore
334
335.PHONY: all config static dynamic test linkext manifest
336
337# Where is the Config information that we are using/depend on
338CONFIGDEP = \$(PERL_ARCHLIB)\\Config.pm \$(PERL_INC)\\config.h
339};
340
341    my @parentdir = split(/::/, $self->{PARENT_NAME});
342    push @m, q{
343# Where to put things:
344INST_LIBDIR      = }. $self->catdir('$(INST_LIB)',@parentdir)        .q{
345INST_ARCHLIBDIR  = }. $self->catdir('$(INST_ARCHLIB)',@parentdir)    .q{
346
347INST_AUTODIR     = }. $self->catdir('$(INST_LIB)','auto','$(FULLEXT)')       .q{
348INST_ARCHAUTODIR = }. $self->catdir('$(INST_ARCHLIB)','auto','$(FULLEXT)')   .q{
349};
350
351    if ($self->has_link_code()) {
352	push @m, '
353INST_STATIC  = $(INST_ARCHAUTODIR)\$(BASEEXT)$(LIB_EXT)
354INST_DYNAMIC = $(INST_ARCHAUTODIR)\$(DLBASE).$(DLEXT)
355INST_BOOT    = $(INST_ARCHAUTODIR)\$(BASEEXT).bs
356';
357    } else {
358	push @m, '
359INST_STATIC  =
360INST_DYNAMIC =
361INST_BOOT    =
362';
363    }
364
365    $tmp = $self->export_list;
366    push @m, "
367EXPORT_LIST = $tmp
368";
369    $tmp = $self->perl_archive;
370    push @m, "
371PERL_ARCHIVE = $tmp
372";
373
374#    push @m, q{
375#INST_PM = }.join(" \\\n\t", sort values %{$self->{PM}}).q{
376#
377#PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
378#};
379
380    push @m, q{
381TO_INST_PM = }.join(" \\\n\t", sort keys %{$self->{PM}}).q{
382
383PM_TO_BLIB = }.join(" \\\n\t", %{$self->{PM}}).q{
384};
385
386    join('',@m);
387}
388
389
390sub path {
391    my($self) = @_;
392    my $path = $ENV{'PATH'} || $ENV{'Path'} || $ENV{'path'};
393    my @path = split(';',$path);
394    foreach(@path) { $_ = '.' if $_ eq '' }
395    @path;
396}
397
398=item static_lib (o)
399
400Defines how to produce the *.a (or equivalent) files.
401
402=cut
403
404sub static_lib {
405    my($self) = @_;
406# Come to think of it, if there are subdirs with linkcode, we still have no INST_STATIC
407#    return '' unless $self->needs_linking(); #might be because of a subdir
408
409    return '' unless $self->has_link_code;
410
411    my(@m);
412    push(@m, <<'END');
413$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)\.exists
414	$(RM_RF) $@
415END
416    # If this extension has it's own library (eg SDBM_File)
417    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
418    push(@m, "\t$self->{CP} \$(MYEXTLIB) \$\@\n") if $self->{MYEXTLIB};
419
420    push @m,
421q{	$(AR) }.($BORLAND ? '$@ $(OBJECT:^"+")'
422			  : ($GCC ? '-ru $@ $(OBJECT)'
423			          : '-out:$@ $(OBJECT)')).q{
424	}.$self->{NOECHO}.q{echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)\extralibs.ld
425	$(CHMOD) 755 $@
426};
427
428# Old mechanism - still available:
429
430    push @m, "\t$self->{NOECHO}".q{echo "$(EXTRALIBS)" >> $(PERL_SRC)\ext.libs}."\n\n"
431	if $self->{PERL_SRC};
432
433    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
434    join('', "\n",@m);
435}
436
437=item dynamic_bs (o)
438
439Defines targets for bootstrap files.
440
441=cut
442
443sub dynamic_bs {
444    my($self, %attribs) = @_;
445    return '
446BOOTSTRAP =
447' unless $self->has_link_code();
448
449    return '
450BOOTSTRAP = '."$self->{BASEEXT}.bs".'
451
452# As Mkbootstrap might not write a file (if none is required)
453# we use touch to prevent make continually trying to remake it.
454# The DynaLoader only reads a non-empty file.
455$(BOOTSTRAP): '."$self->{MAKEFILE} $self->{BOOTDEP}".' $(INST_ARCHAUTODIR)\.exists
456	'.$self->{NOECHO}.'echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
457	'.$self->{NOECHO}.'$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
458		-MExtUtils::Mkbootstrap \
459		-e "Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
460	'.$self->{NOECHO}.'$(TOUCH) $(BOOTSTRAP)
461	$(CHMOD) 644 $@
462
463$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists
464	'."$self->{NOECHO}$self->{RM_RF}".' $(INST_BOOT)
465	-'.$self->{CP}.' $(BOOTSTRAP) $(INST_BOOT)
466	$(CHMOD) 644 $@
467';
468}
469
470=item dynamic_lib (o)
471
472Defines how to produce the *.so (or equivalent) files.
473
474=cut
475
476sub dynamic_lib {
477    my($self, %attribs) = @_;
478    return '' unless $self->needs_linking(); #might be because of a subdir
479
480    return '' unless $self->has_link_code;
481
482    my($otherldflags) = $attribs{OTHERLDFLAGS} || ($BORLAND ? 'c0d32.obj': '');
483    my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
484    my($ldfrom) = '$(LDFROM)';
485    my(@m);
486
487# one thing for GCC/Mingw32:
488# we try to overcome non-relocateable-DLL problems by generating
489#    a (hopefully unique) image-base from the dll's name
490# -- BKS, 10-19-1999
491    if ($GCC) { 
492	my $dllname = $self->{BASEEXT} . "." . $self->{DLEXT};
493	$dllname =~ /(....)(.{0,4})/;
494	my $baseaddr = unpack("n", $1 ^ $2);
495	$otherldflags .= sprintf("-Wl,--image-base,0x%x0000 ", $baseaddr);
496    }
497
498    push(@m,'
499# This section creates the dynamically loadable $(INST_DYNAMIC)
500# from $(OBJECT) and possibly $(MYEXTLIB).
501OTHERLDFLAGS = '.$otherldflags.'
502INST_DYNAMIC_DEP = '.$inst_dynamic_dep.'
503
504$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)\.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
505');
506    if ($GCC) {
507      push(@m,  
508       q{	dlltool --def $(EXPORT_LIST) --output-exp dll.exp
509	$(LD) -o $@ -Wl,--base-file -Wl,dll.base $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp
510	dlltool --def $(EXPORT_LIST) --base-file dll.base --output-exp dll.exp
511	$(LD) -o $@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) dll.exp });
512    } elsif ($BORLAND) {
513      push(@m,
514       q{	$(LD) $(LDDLFLAGS) $(OTHERLDFLAGS) }.$ldfrom.q{,$@,,}
515       .($DMAKE ? q{$(PERL_ARCHIVE:s,/,\,) $(LDLOADLIBS:s,/,\,) }
516		 .q{$(MYEXTLIB:s,/,\,),$(EXPORT_LIST:s,/,\,)}
517		: q{$(subst /,\,$(PERL_ARCHIVE)) $(subst /,\,$(LDLOADLIBS)) }
518		 .q{$(subst /,\,$(MYEXTLIB)),$(subst /,\,$(EXPORT_LIST))})
519       .q{,$(RESFILES)});
520    } else {	# VC
521      push(@m,
522       q{	$(LD) -out:$@ $(LDDLFLAGS) }.$ldfrom.q{ $(OTHERLDFLAGS) }
523      .q{$(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) -def:$(EXPORT_LIST)});
524    }
525    push @m, '
526	$(CHMOD) 755 $@
527';
528
529    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
530    join('',@m);
531}
532
533sub perl_archive
534{
535    my ($self) = @_;
536    return '$(PERL_INC)\\'.$Config{'libperl'};
537}
538
539sub export_list
540{
541 my ($self) = @_;
542 return "$self->{BASEEXT}.def";
543}
544
545=item canonpath
546
547No physical check on the filesystem, but a logical cleanup of a
548path. On UNIX eliminated successive slashes and successive "/.".
549
550=cut
551
552sub canonpath {
553    my($self,$path) = @_;
554    $path =~ s/^([a-z]:)/\u$1/;
555    $path =~ s|/|\\|g;
556    $path =~ s|(.)\\+|$1\\|g ;                     # xx////xx  -> xx/xx
557    $path =~ s|(\\\.)+\\|\\|g ;                    # xx/././xx -> xx/xx
558    $path =~ s|^(\.\\)+|| unless $path eq ".\\";   # ./xx      -> xx
559    $path =~ s|\\$|| 
560             unless $path =~ m#^([a-z]:)?\\#;      # xx/       -> xx
561    $path .= '.' if $path =~ m#\\$#;
562    $path;
563}
564
565=item perl_script
566
567Takes one argument, a file name, and returns the file name, if the
568argument is likely to be a perl script. On MM_Unix this is true for
569any ordinary, readable file.
570
571=cut
572
573sub perl_script {
574    my($self,$file) = @_;
575    return $file if -r $file && -f _;
576    return "$file.pl" if -r "$file.pl" && -f _;
577    return "$file.bat" if -r "$file.bat" && -f _;
578    return;
579}
580
581=item pm_to_blib
582
583Defines target that copies all files in the hash PM to their
584destination and autosplits them. See L<ExtUtils::Install/DESCRIPTION>
585
586=cut
587
588sub pm_to_blib {
589    my $self = shift;
590    my($autodir) = $self->catdir('$(INST_LIB)','auto');
591    return q{
592pm_to_blib: $(TO_INST_PM)
593	}.$self->{NOECHO}.q{$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
594	"-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
595        -e "pm_to_blib(}.
596	($NMAKE ? 'qw[ <<pmfiles.dat ],'
597	        : $DMAKE ? 'qw[ $(mktmp,pmfiles.dat $(PM_TO_BLIB:s,\\,\\\\,)\n) ],'
598			 : '{ qw[$(PM_TO_BLIB)] },'
599	 ).q{'}.$autodir.q{','$(PM_FILTER)')"
600	}. ($NMAKE ? q{
601$(PM_TO_BLIB)
602<<
603	} : '') . $self->{NOECHO}.q{$(TOUCH) $@
604};
605}
606
607=item test_via_harness (o)
608
609Helper method to write the test targets
610
611=cut
612
613sub test_via_harness {
614    my($self, $perl, $tests) = @_;
615    "\t$perl".q! -Mblib -I$(PERL_ARCHLIB) -I$(PERL_LIB) -e "use Test::Harness qw(&runtests $$verbose); $$verbose=$(TEST_VERBOSE); runtests @ARGV;" !."$tests\n";
616}
617
618
619=item tool_autosplit (override)
620
621Use Win32 quoting on command line.
622
623=cut
624
625sub tool_autosplit{
626    my($self, %attribs) = @_;
627    my($asl) = "";
628    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
629    q{
630# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
631AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MAutoSplit }.$asl.q{ -e "autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1);"
632};
633}
634
635=item tools_other (o)
636
637Win32 overrides.
638
639Defines SHELL, LD, TOUCH, CP, MV, RM_F, RM_RF, CHMOD, UMASK_NULL in
640the Makefile. Also defines the perl programs MKPATH,
641WARN_IF_OLD_PACKLIST, MOD_INSTALL. DOC_INSTALL, and UNINSTALL.
642
643=cut
644
645sub tools_other {
646    my($self) = shift;
647    my @m;
648    my $bin_sh = $Config{sh} || 'cmd /c';
649    push @m, qq{
650SHELL = $bin_sh
651} unless $DMAKE;  # dmake determines its own shell 
652
653    for (qw/ CHMOD CP LD MV NOOP RM_F RM_RF TEST_F TOUCH UMASK_NULL DEV_NULL/ ) {
654	push @m, "$_ = $self->{$_}\n";
655    }
656
657    push @m, q{
658# The following is a portable way to say mkdir -p
659# To see which directories are created, change the if 0 to if 1
660MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
661
662# This helps us to minimize the effect of the .exists files A yet
663# better solution would be to have a stable file in the perl
664# distribution with a timestamp of zero. But this solution doesn't
665# need any changes to the core distribution and works with older perls
666EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
667};
668
669
670    return join "", @m if $self->{PARENT};
671
672    push @m, q{
673# Here we warn users that an old packlist file was found somewhere,
674# and that they should call some uninstall routine
675WARN_IF_OLD_PACKLIST = $(PERL) -lwe "exit unless -f $$ARGV[0];" \\
676-e "print 'WARNING: I have found an old package in';" \\
677-e "print '	', $$ARGV[0], '.';" \\
678-e "print 'Please make sure the two installations are not conflicting';"
679
680UNINST=0
681VERBINST=1
682
683MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
684-e "install({ @ARGV },'$(VERBINST)',0,'$(UNINST)');"
685
686DOC_INSTALL = $(PERL) -e "$$\=\"\n\n\";" \
687-e "print '=head2 ', scalar(localtime), ': C<', shift, '>', ' L<', $$arg=shift, '|', $$arg, '>';" \
688-e "print '=over 4';" \
689-e "while (defined($$key = shift) and defined($$val = shift)) { print '=item *';print 'C<', \"$$key: $$val\", '>'; }" \
690-e "print '=back';"
691
692UNINSTALL =   $(PERL) -MExtUtils::Install \
693-e "uninstall($$ARGV[0],1,1); print \"\nUninstall is deprecated. Please check the";" \
694-e "print \" packlist above carefully.\n  There may be errors. Remove the\";" \
695-e "print \" appropriate files manually.\n  Sorry for the inconveniences.\n\""
696};
697
698    return join "", @m;
699}
700
701=item xs_o (o)
702
703Defines suffix rules to go from XS to object files directly. This is
704only intended for broken make implementations.
705
706=cut
707
708sub xs_o {	# many makes are too dumb to use xs_c then c_o
709    my($self) = shift;
710    return ''
711}
712
713=item top_targets (o)
714
715Defines the targets all, subdirs, config, and O_FILES
716
717=cut
718
719sub top_targets {
720# --- Target Sections ---
721
722    my($self) = shift;
723    my(@m);
724    push @m, '
725#all ::	config $(INST_PM) subdirs linkext manifypods
726';
727
728    push @m, '
729all :: pure_all htmlifypods manifypods
730	'.$self->{NOECHO}.'$(NOOP)
731' 
732	  unless $self->{SKIPHASH}{'all'};
733    
734    push @m, '
735pure_all :: config pm_to_blib subdirs linkext
736	'.$self->{NOECHO}.'$(NOOP)
737
738subdirs :: $(MYEXTLIB)
739	'.$self->{NOECHO}.'$(NOOP)
740
741config :: '.$self->{MAKEFILE}.' $(INST_LIBDIR)\.exists
742	'.$self->{NOECHO}.'$(NOOP)
743
744config :: $(INST_ARCHAUTODIR)\.exists
745	'.$self->{NOECHO}.'$(NOOP)
746
747config :: $(INST_AUTODIR)\.exists
748	'.$self->{NOECHO}.'$(NOOP)
749';
750
751    push @m, $self->dir_target(qw[$(INST_AUTODIR) $(INST_LIBDIR) $(INST_ARCHAUTODIR)]);
752
753    if (%{$self->{HTMLLIBPODS}}) {
754	push @m, qq[
755config :: \$(INST_HTMLLIBDIR)/.exists
756	$self->{NOECHO}\$(NOOP)
757
758];
759	push @m, $self->dir_target(qw[$(INST_HTMLLIBDIR)]);
760    }
761
762    if (%{$self->{HTMLSCRIPTPODS}}) {
763	push @m, qq[
764config :: \$(INST_HTMLSCRIPTDIR)/.exists
765	$self->{NOECHO}\$(NOOP)
766
767];
768	push @m, $self->dir_target(qw[$(INST_HTMLSCRIPTDIR)]);
769    }
770
771    if (%{$self->{MAN1PODS}}) {
772	push @m, qq[
773config :: \$(INST_MAN1DIR)\\.exists
774	$self->{NOECHO}\$(NOOP)
775
776];
777	push @m, $self->dir_target(qw[$(INST_MAN1DIR)]);
778    }
779    if (%{$self->{MAN3PODS}}) {
780	push @m, qq[
781config :: \$(INST_MAN3DIR)\\.exists
782	$self->{NOECHO}\$(NOOP)
783
784];
785	push @m, $self->dir_target(qw[$(INST_MAN3DIR)]);
786    }
787
788    push @m, '
789$(O_FILES): $(H_FILES)
790' if @{$self->{O_FILES} || []} && @{$self->{H} || []};
791
792    push @m, q{
793help:
794	perldoc ExtUtils::MakeMaker
795};
796
797    push @m, q{
798Version_check:
799	}.$self->{NOECHO}.q{$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
800		-MExtUtils::MakeMaker=Version_check \
801		-e "Version_check('$(MM_VERSION)')"
802};
803
804    join('',@m);
805}
806
807=item htmlifypods (o)
808
809Defines targets and routines to translate the pods into HTML manpages
810and put them into the INST_HTMLLIBDIR and INST_HTMLSCRIPTDIR
811directories.
812
813Same as MM_Unix version (changes command-line quoting).
814
815=cut
816
817sub htmlifypods {
818    my($self, %attribs) = @_;
819    return "\nhtmlifypods : pure_all\n\t$self->{NOECHO}\$(NOOP)\n" unless
820	%{$self->{HTMLLIBPODS}} || %{$self->{HTMLSCRIPTPODS}};
821    my($dist);
822    my($pod2html_exe);
823    if (defined $self->{PERL_SRC}) {
824	$pod2html_exe = $self->catfile($self->{PERL_SRC},'pod','pod2html');
825    } else {
826	$pod2html_exe = $self->catfile($Config{scriptdirexp},'pod2html');
827    }
828    unless ($pod2html_exe = $self->perl_script($pod2html_exe)) {
829	# No pod2html but some HTMLxxxPODS to be installed
830	print <<END;
831
832Warning: I could not locate your pod2html program. Please make sure,
833         your pod2html program is in your PATH before you execute 'make'
834
835END
836        $pod2html_exe = "-S pod2html";
837    }
838    my(@m);
839    push @m,
840qq[POD2HTML_EXE = $pod2html_exe\n],
841qq[POD2HTML = \$(PERL) -we "use File::Basename; use File::Path qw(mkpath); %m=\@ARGV;for (keys %m){" \\\n],
842q[-e "next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M '],
843 $self->{MAKEFILE}, q[';" \\
844-e "print qq(Htmlifying $$m{$$_}\n);" \\
845-e "$$dir = dirname($$m{$$_}); mkpath($$dir) unless -d $$dir;" \\
846-e "system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2HTML_EXE) ].qq[$$_>$$m{$$_}])==0 or warn qq(Couldn\\047t install $$m{$$_}\n);" \\
847-e "chmod(oct($(PERM_RW))), $$m{$$_} or warn qq(chmod $(PERM_RW) $$m{$$_}: $$!\n);}"
848];
849    push @m, "\nhtmlifypods : pure_all ";
850    push @m, join " \\\n\t", keys %{$self->{HTMLLIBPODS}}, keys %{$self->{HTMLSCRIPTPODS}};
851
852    push(@m,"\n");
853    if (%{$self->{HTMLLIBPODS}} || %{$self->{HTMLSCRIPTPODS}}) {
854	push @m, "\t$self->{NOECHO}\$(POD2HTML) \\\n\t";
855	push @m, join " \\\n\t", %{$self->{HTMLLIBPODS}}, %{$self->{HTMLSCRIPTPODS}};
856    }
857    join('', @m);
858}
859
860=item manifypods (o)
861
862We don't want manpage process.
863
864=cut
865
866sub manifypods {
867    my($self) = shift;
868    return "\nmanifypods :\n\t$self->{NOECHO}\$(NOOP)\n";
869}
870
871=item dist_ci (o)
872
873Same as MM_Unix version (changes command-line quoting).
874
875=cut
876
877sub dist_ci {
878    my($self) = shift;
879    my @m;
880    push @m, q{
881ci :
882	$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \\
883		-e "@all = keys %{ maniread() };" \\
884		-e "print(\"Executing $(CI) @all\n\"); system(\"$(CI) @all\");" \\
885		-e "print(\"Executing $(RCS_LABEL) ...\n\"); system(\"$(RCS_LABEL) @all\");"
886};
887    join "", @m;
888}
889
890=item dist_core (o)
891
892Same as MM_Unix version (changes command-line quoting).
893
894=cut
895
896sub dist_core {
897    my($self) = shift;
898    my @m;
899    push @m, q{
900dist : $(DIST_DEFAULT)
901	}.$self->{NOECHO}.q{$(PERL) -le "print \"Warning: Makefile possibly out of date with $$vf\" if " \
902	    -e "-e ($$vf=\"$(VERSION_FROM)\") and -M $$vf < -M \"}.$self->{MAKEFILE}.q{\";"
903
904tardist : $(DISTVNAME).tar$(SUFFIX)
905
906zipdist : $(DISTVNAME).zip
907
908$(DISTVNAME).tar$(SUFFIX) : distdir
909	$(PREOP)
910	$(TO_UNIX)
911	$(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
912	$(RM_RF) $(DISTVNAME)
913	$(COMPRESS) $(DISTVNAME).tar
914	$(POSTOP)
915
916$(DISTVNAME).zip : distdir
917	$(PREOP)
918	$(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
919	$(RM_RF) $(DISTVNAME)
920	$(POSTOP)
921
922uutardist : $(DISTVNAME).tar$(SUFFIX)
923	uuencode $(DISTVNAME).tar$(SUFFIX) \\
924		$(DISTVNAME).tar$(SUFFIX) > \\
925		$(DISTVNAME).tar$(SUFFIX)_uu
926
927shdist : distdir
928	$(PREOP)
929	$(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
930	$(RM_RF) $(DISTVNAME)
931	$(POSTOP)
932};
933    join "", @m;
934}
935
936=item pasthru (o)
937
938Defines the string that is passed to recursive make calls in
939subdirectories.
940
941=cut
942
943sub pasthru {
944    my($self) = shift;
945    return "PASTHRU = " . ($NMAKE ? "-nologo" : "");
946}
947
948
949
9501;
951__END__
952
953=back
954
955=cut 
956
957