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