lib/ExtUtils/MM_VMS.pm

   1 package ExtUtils::MM_VMS;
   2
   3 use strict;
   4
   5 use ExtUtils::MakeMaker::Config;
   6 require Exporter;
   7
   8 BEGIN {
   9     # so we can compile the thing on non-VMS platforms.
  10     if( $^O eq 'VMS' ) {
  11         require VMS::Filespec;
  12         VMS::Filespec->import;
  13     }
  14 }
  15
  16 use File::Basename;
  17
  18 # $Revision can't be on the same line or SVN/K gets confused
  19 use vars qw($Revision
  20             $VERSION @ISA);
  21 $VERSION = '5.73';
  22
  23 require ExtUtils::MM_Any;
  24 require ExtUtils::MM_Unix;
  25 @ISA = qw( ExtUtils::MM_Any ExtUtils::MM_Unix );
  26
  27 use ExtUtils::MakeMaker qw($Verbose neatvalue);
  28 $Revision = $ExtUtils::MakeMaker::Revision;
  29
  30
  31 =head1 NAME
  32
  33 ExtUtils::MM_VMS - methods to override UN*X behaviour in ExtUtils::MakeMaker
  34
  35 =head1 SYNOPSIS
  36
  37   Do not use this directly.
  38   Instead, use ExtUtils::MM and it will figure out which MM_*
  39   class to use for you.
  40
  41 =head1 DESCRIPTION
  42
  43 See ExtUtils::MM_Unix for a documentation of the methods provided
  44 there. This package overrides the implementation of these methods, not
  45 the semantics.
  46
  47 =head2 Methods always loaded
  48
  49 =over 4
  50
  51 =item wraplist
  52
  53 Converts a list into a string wrapped at approximately 80 columns.
  54
  55 =cut
  56
  57 sub wraplist {
  58     my($self) = shift;
  59     my($line,$hlen) = ('',0);
  60
  61     foreach my $word (@_) {
  62       # Perl bug -- seems to occasionally insert extra elements when
  63       # traversing array (scalar(@array) doesn't show them, but
  64       # foreach(@array) does) (5.00307)
  65       next unless $word =~ /\w/;
  66       $line .= ' ' if length($line);
  67       if ($hlen > 80) { $line .= "\\\n\t"; $hlen = 0; }
  68       $line .= $word;
  69       $hlen += length($word) + 2;
  70     }
  71     $line;
  72 }
  73
  74
  75 # This isn't really an override.  It's just here because ExtUtils::MM_VMS
  76 # appears in @MM::ISA before ExtUtils::Liblist::Kid, so if there isn't an ext()
  77 # in MM_VMS, then AUTOLOAD is called, and bad things happen.  So, we just
  78 # mimic inheritance here and hand off to ExtUtils::Liblist::Kid.
  79 # XXX This hackery will die soon. --Schwern
  80 sub ext {
  81     require ExtUtils::Liblist::Kid;
  82     goto &ExtUtils::Liblist::Kid::ext;
  83 }
  84
  85 =back
  86
  87 =head2 Methods
  88
  89 Those methods which override default MM_Unix methods are marked
  90 "(override)", while methods unique to MM_VMS are marked "(specific)".
  91 For overridden methods, documentation is limited to an explanation
  92 of why this method overrides the MM_Unix method; see the ExtUtils::MM_Unix
  93 documentation for more details.
  94
  95 =over 4
  96
  97 =item guess_name (override)
  98
  99 Try to determine name of extension being built.  We begin with the name
 100 of the current directory.  Since VMS filenames are case-insensitive,
 101 however, we look for a F<.pm> file whose name matches that of the current
 102 directory (presumably the 'main' F<.pm> file for this extension), and try
 103 to find a C<package> statement from which to obtain the Mixed::Case
 104 package name.
 105
 106 =cut
 107
 108 sub guess_name {
 109     my($self) = @_;
 110     my($defname,$defpm,@pm,%xs,$pm);
 111     local *PM;
 112
 113     $defname = basename(fileify($ENV{'DEFAULT'}));
 114     $defname =~ s![\d\-_]*\.dir.*$!!;  # Clip off .dir;1 suffix, and package version
 115     $defpm = $defname;
 116     # Fallback in case for some reason a user has copied the files for an
 117     # extension into a working directory whose name doesn't reflect the
 118     # extension's name.  We'll use the name of a unique .pm file, or the
 119     # first .pm file with a matching .xs file.
 120     if (not -e "${defpm}.pm") {
 121       @pm = map { s/.pm$//; $_ } glob('*.pm');
 122       if (@pm == 1) { ($defpm = $pm[0]) =~ s/.pm$//; }
 123       elsif (@pm) {
 124         %xs = map { s/.xs$//; ($_,1) } glob('*.xs');
 125         if (keys %xs) {
 126             foreach $pm (@pm) {
 127                 $defpm = $pm, last if exists $xs{$pm};
 128             }
 129         }
 130       }
 131     }
 132     if (open(PM,"${defpm}.pm")){
 133         while (<PM>) {
 134             if (/^\s*package\s+([^;]+)/i) {
 135                 $defname = $1;
 136                 last;
 137             }
 138         }
 139         print STDOUT "Warning (non-fatal): Couldn't find package name in ${defpm}.pm;\n\t",
 140                      "defaulting package name to $defname\n"
 141             if eof(PM);
 142         close PM;
 143     }
 144     else {
 145         print STDOUT "Warning (non-fatal): Couldn't find ${defpm}.pm;\n\t",
 146                      "defaulting package name to $defname\n";
 147     }
 148     $defname =~ s#[\d.\-_]+$##;
 149     $defname;
 150 }
 151
 152 =item find_perl (override)
 153
 154 Use VMS file specification syntax and CLI commands to find and
 155 invoke Perl images.
 156
 157 =cut
 158
 159 sub find_perl {
 160     my($self, $ver, $names, $dirs, $trace) = @_;
 161     my($name,$dir,$vmsfile,@sdirs,@snames,@cand);
 162     my($rslt);
 163     my($inabs) = 0;
 164     local *TCF;
 165
 166     if( $self->{PERL_CORE} ) {
 167         # Check in relative directories first, so we pick up the current
 168         # version of Perl if we're running MakeMaker as part of the main build.
 169         @sdirs = sort { my($absa) = $self->file_name_is_absolute($a);
 170                         my($absb) = $self->file_name_is_absolute($b);
 171                         if ($absa && $absb) { return $a cmp $b }
 172                         else { return $absa ? 1 : ($absb ? -1 : ($a cmp $b)); }
 173                       } @$dirs;
 174         # Check miniperl before perl, and check names likely to contain
 175         # version numbers before "generic" names, so we pick up an
 176         # executable that's less likely to be from an old installation.
 177         @snames = sort { my($ba) = $a =~ m!([^:>\]/]+)$!;  # basename
 178                          my($bb) = $b =~ m!([^:>\]/]+)$!;
 179                          my($ahasdir) = (length($a) - length($ba) > 0);
 180                          my($bhasdir) = (length($b) - length($bb) > 0);
 181                          if    ($ahasdir and not $bhasdir) { return 1; }
 182                          elsif ($bhasdir and not $ahasdir) { return -1; }
 183                          else { $bb =~ /\d/ <=> $ba =~ /\d/
 184                                   or substr($ba,0,1) cmp substr($bb,0,1)
 185                                   or length($bb) <=> length($ba) } } @$names;
 186     }
 187     else {
 188         @sdirs  = @$dirs;
 189         @snames = @$names;
 190     }
 191
 192     # Image names containing Perl version use '_' instead of '.' under VMS
 193     foreach $name (@snames) { $name =~ s/\.(\d+)$/_$1/; }
 194     if ($trace >= 2){
 195         print "Looking for perl $ver by these names:\n";
 196         print "\t@snames,\n";
 197         print "in these dirs:\n";
 198         print "\t@sdirs\n";
 199     }
 200     foreach $dir (@sdirs){
 201         next unless defined $dir; # $self->{PERL_SRC} may be undefined
 202         $inabs++ if $self->file_name_is_absolute($dir);
 203         if ($inabs == 1) {
 204             # We've covered relative dirs; everything else is an absolute
 205             # dir (probably an installed location).  First, we'll try potential
 206             # command names, to see whether we can avoid a long MCR expression.
 207             foreach $name (@snames) { push(@cand,$name) if $name =~ /^[\w\-\$]+$/; }
 208             $inabs++; # Should happen above in next $dir, but just in case . . .
 209         }
 210         foreach $name (@snames){
 211             if ($name !~ m![/:>\]]!) { push(@cand,$self->catfile($dir,$name)); }
 212             else                     { push(@cand,$self->fixpath($name,0));    }
 213         }
 214     }
 215     foreach $name (@cand) {
 216         print "Checking $name\n" if ($trace >= 2);
 217         # If it looks like a potential command, try it without the MCR
 218         if ($name =~ /^[\w\-\$]+$/) {
 219             open(TCF,">temp_mmvms.com") || die('unable to open temp file');
 220             print TCF "\$ set message/nofacil/nosever/noident/notext\n";
 221             print TCF "\$ $name -e \"require $ver; print \"\"VER_OK\\n\"\"\"\n";
 222             close TCF;
 223             $rslt = `\@temp_mmvms.com` ;
 224             unlink('temp_mmvms.com');
 225             if ($rslt =~ /VER_OK/) {
 226                 print "Using PERL=$name\n" if $trace;
 227                 return $name;
 228             }
 229         }
 230         next unless $vmsfile = $self->maybe_command($name);
 231         $vmsfile =~ s/;[\d\-]*$//;  # Clip off version number; we can use a newer version as well
 232         print "Executing $vmsfile\n" if ($trace >= 2);
 233         open(TCF,">temp_mmvms.com") || die('unable to open temp file');
 234         print TCF "\$ set message/nofacil/nosever/noident/notext\n";
 235         print TCF "\$ mcr $vmsfile -e \"require $ver; print \"\"VER_OK\\n\"\"\" \n";
 236         close TCF;
 237         $rslt = `\@temp_mmvms.com`;
 238         unlink('temp_mmvms.com');
 239         if ($rslt =~ /VER_OK/) {
 240             print "Using PERL=MCR $vmsfile\n" if $trace;
 241             return "MCR $vmsfile";
 242         }
 243     }
 244     print STDOUT "Unable to find a perl $ver (by these names: @$names, in these dirs: @$dirs)\n";
 245     0; # false and not empty
 246 }
 247
 248 =item maybe_command (override)
 249
 250 Follows VMS naming conventions for executable files.
 251 If the name passed in doesn't exactly match an executable file,
 252 appends F<.Exe> (or equivalent) to check for executable image, and F<.Com>
 253 to check for DCL procedure.  If this fails, checks directories in DCL$PATH
 254 and finally F<Sys$System:> for an executable file having the name specified,
 255 with or without the F<.Exe>-equivalent suffix.
 256
 257 =cut
 258
 259 sub maybe_command {
 260     my($self,$file) = @_;
 261     return $file if -x $file && ! -d _;
 262     my(@dirs) = ('');
 263     my(@exts) = ('',$Config{'exe_ext'},'.exe','.com');
 264     my($dir,$ext);
 265     if ($file !~ m![/:>\]]!) {
 266         for (my $i = 0; defined $ENV{"DCL\$PATH;$i"}; $i++) {
 267             $dir = $ENV{"DCL\$PATH;$i"};
 268             $dir .= ':' unless $dir =~ m%[\]:]$%;
 269             push(@dirs,$dir);
 270         }
 271         push(@dirs,'Sys$System:');
 272         foreach $dir (@dirs) {
 273             my $sysfile = "$dir$file";
 274             foreach $ext (@exts) {
 275                 return $file if -x "$sysfile$ext" && ! -d _;
 276             }
 277         }
 278     }
 279     return 0;
 280 }
 281
 282
 283 =item pasthru (override)
 284
 285 VMS has $(MMSQUALIFIERS) which is a listing of all the original command line
 286 options.  This is used in every invocation of make in the VMS Makefile so
 287 PASTHRU should not be necessary.  Using PASTHRU tends to blow commands past
 288 the 256 character limit.
 289
 290 =cut
 291
 292 sub pasthru {
 293     return "PASTHRU=\n";
 294 }
 295
 296
 297 =item pm_to_blib (override)
 298
 299 VMS wants a dot in every file so we can't have one called 'pm_to_blib',
 300 it becomes 'pm_to_blib.' and MMS/K isn't smart enough to know that when
 301 you have a target called 'pm_to_blib' it should look for 'pm_to_blib.'.
 302
 303 So in VMS its pm_to_blib.ts.
 304
 305 =cut
 306
 307 sub pm_to_blib {
 308     my $self = shift;
 309
 310     my $make = $self->SUPER::pm_to_blib;
 311
 312     $make =~ s{^pm_to_blib :}{pm_to_blib.ts :}m;
 313     $make =~ s{\$\(TOUCH\) pm_to_blib}{\$(TOUCH) pm_to_blib.ts};
 314
 315     $make = <<'MAKE' . $make;
 316 # Dummy target to match Unix target name; we use pm_to_blib.ts as
 317 # timestamp file to avoid repeated invocations under VMS
 318 pm_to_blib : pm_to_blib.ts
 319         $(NOECHO) $(NOOP)
 320
 321 MAKE
 322
 323     return $make;
 324 }
 325
 326
 327 =item perl_script (override)
 328
 329 If name passed in doesn't specify a readable file, appends F<.com> or
 330 F<.pl> and tries again, since it's customary to have file types on all files
 331 under VMS.
 332
 333 =cut
 334
 335 sub perl_script {
 336     my($self,$file) = @_;
 337     return $file if -r $file && ! -d _;
 338     return "$file.com" if -r "$file.com";
 339     return "$file.pl" if -r "$file.pl";
 340     return '';
 341 }
 342
 343
 344 =item replace_manpage_separator
 345
 346 Use as separator a character which is legal in a VMS-syntax file name.
 347
 348 =cut
 349
 350 sub replace_manpage_separator {
 351     my($self,$man) = @_;
 352     $man = unixify($man);
 353     $man =~ s#/+#__#g;
 354     $man;
 355 }
 356
 357 =item init_DEST
 358
 359 (override) Because of the difficulty concatenating VMS filepaths we
 360 must pre-expand the DEST* variables.
 361
 362 =cut
 363
 364 sub init_DEST {
 365     my $self = shift;
 366
 367     $self->SUPER::init_DEST;
 368
 369     # Expand DEST variables.
 370     foreach my $var ($self->installvars) {
 371         my $destvar = 'DESTINSTALL'.$var;
 372         $self->{$destvar} = File::Spec->eliminate_macros($self->{$destvar});
 373     }
 374 }
 375
 376
 377 =item init_DIRFILESEP
 378
 379 No seperator between a directory path and a filename on VMS.
 380
 381 =cut
 382
 383 sub init_DIRFILESEP {
 384     my($self) = shift;
 385
 386     $self->{DIRFILESEP} = '';
 387     return 1;
 388 }
 389
 390
 391 =item init_main (override)
 392
 393
 394 =cut
 395
 396 sub init_main {
 397     my($self) = shift;
 398
 399     $self->SUPER::init_main;
 400
 401     $self->{DEFINE} ||= '';
 402     if ($self->{DEFINE} ne '') {
 403         my(@terms) = split(/\s+/,$self->{DEFINE});
 404         my(@defs,@udefs);
 405         foreach my $def (@terms) {
 406             next unless $def;
 407             my $targ = \@defs;
 408             if ($def =~ s/^-([DU])//) {    # If it was a Unix-style definition
 409                 $targ = \@udefs if $1 eq 'U';
 410                 $def =~ s/='(.*)'$/=$1/;  # then remove shell-protection ''
 411                 $def =~ s/^'(.*)'$/$1/;   # from entire term or argument
 412             }
 413             if ($def =~ /=/) {
 414                 $def =~ s/"/""/g;  # Protect existing " from DCL
 415                 $def = qq["$def"]; # and quote to prevent parsing of =
 416             }
 417             push @$targ, $def;
 418         }
 419
 420         $self->{DEFINE} = '';
 421         if (@defs)  {
 422             $self->{DEFINE}  = '/Define=(' . join(',',@defs)  . ')';
 423         }
 424         if (@udefs) {
 425             $self->{DEFINE} .= '/Undef=('  . join(',',@udefs) . ')';
 426         }
 427     }
 428 }
 429
 430 =item init_others (override)
 431
 432 Provide VMS-specific forms of various utility commands, then hand
 433 off to the default MM_Unix method.
 434
 435 DEV_NULL should probably be overriden with something.
 436
 437 Also changes EQUALIZE_TIMESTAMP to set revision date of target file to
 438 one second later than source file, since MMK interprets precisely
 439 equal revision dates for a source and target file as a sign that the
 440 target needs to be updated.
 441
 442 =cut
 443
 444 sub init_others {
 445     my($self) = @_;
 446
 447     $self->{NOOP}               = 'Continue';
 448     $self->{NOECHO}             ||= '@ ';
 449
 450     $self->{MAKEFILE}           ||= 'Descrip.MMS';
 451     $self->{FIRST_MAKEFILE}     ||= $self->{MAKEFILE};
 452     $self->{MAKE_APERL_FILE}    ||= 'Makeaperl.MMS';
 453     $self->{MAKEFILE_OLD}       ||= '$(FIRST_MAKEFILE)_old';
 454
 455     $self->{MACROSTART}         ||= '/Macro=(';
 456     $self->{MACROEND}           ||= ')';
 457     $self->{USEMAKEFILE}        ||= '/Descrip=';
 458
 459     $self->{ECHO}     ||= '$(ABSPERLRUN) -le "print qq{@ARGV}"';
 460     $self->{ECHO_N}   ||= '$(ABSPERLRUN) -e  "print qq{@ARGV}"';
 461     $self->{TOUCH}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e touch';
 462     $self->{CHMOD}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e chmod';
 463     $self->{RM_F}     ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_f';
 464     $self->{RM_RF}    ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e rm_rf';
 465     $self->{TEST_F}   ||= '$(ABSPERLRUN) "-MExtUtils::Command" -e test_f';
 466     $self->{EQUALIZE_TIMESTAMP} ||= '$(ABSPERLRUN) -we "open F,qq{>>$ARGV[1]};close F;utime(0,(stat($ARGV[0]))[9]+1,$ARGV[1])"';
 467
 468     $self->{MOD_INSTALL} ||=
 469       $self->oneliner(<<'CODE', ['-MExtUtils::Install']);
 470 install({split(' ',<STDIN>)}, '$(VERBINST)', 0, '$(UNINST)');
 471 CODE
 472
 473     $self->{SHELL}    ||= 'Posix';
 474
 475     $self->SUPER::init_others;
 476
 477     # So we can copy files into directories with less fuss
 478     $self->{CP}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e cp';
 479     $self->{MV}         = '$(ABSPERLRUN) "-MExtUtils::Command" -e mv';
 480
 481     $self->{UMASK_NULL} = '! ';
 482
 483     # Redirection on VMS goes before the command, not after as on Unix.
 484     # $(DEV_NULL) is used once and its not worth going nuts over making
 485     # it work.  However, Unix's DEV_NULL is quite wrong for VMS.
 486     $self->{DEV_NULL}   = '';
 487
 488     if ($self->{OBJECT} =~ /\s/) {
 489         $self->{OBJECT} =~ s/(\\)?\n+\s+/ /g;
 490         $self->{OBJECT} = $self->wraplist(
 491             map $self->fixpath($_,0), split /,?\s+/, $self->{OBJECT}
 492         );
 493     }
 494
 495     $self->{LDFROM} = $self->wraplist(
 496         map $self->fixpath($_,0), split /,?\s+/, $self->{LDFROM}
 497     );
 498 }
 499
 500
 501 =item init_platform (override)
 502
 503 Add PERL_VMS, MM_VMS_REVISION and MM_VMS_VERSION.
 504
 505 MM_VMS_REVISION is for backwards compatibility before MM_VMS had a
 506 $VERSION.
 507
 508 =cut
 509
 510 sub init_platform {
 511     my($self) = shift;
 512
 513     $self->{MM_VMS_REVISION} = $Revision;
 514     $self->{MM_VMS_VERSION}  = $VERSION;
 515     $self->{PERL_VMS} = $self->catdir($self->{PERL_SRC}, 'VMS')
 516       if $self->{PERL_SRC};
 517 }
 518
 519
 520 =item platform_constants
 521
 522 =cut
 523
 524 sub platform_constants {
 525     my($self) = shift;
 526     my $make_frag = '';
 527
 528     foreach my $macro (qw(PERL_VMS MM_VMS_REVISION MM_VMS_VERSION))
 529     {
 530         next unless defined $self->{$macro};
 531         $make_frag .= "$macro = $self->{$macro}\n";
 532     }
 533
 534     return $make_frag;
 535 }
 536
 537
 538 =item init_VERSION (override)
 539
 540 Override the *DEFINE_VERSION macros with VMS semantics.  Translate the
 541 MAKEMAKER filepath to VMS style.
 542
 543 =cut
 544
 545 sub init_VERSION {
 546     my $self = shift;
 547
 548     $self->SUPER::init_VERSION;
 549
 550     $self->{DEFINE_VERSION}    = '"$(VERSION_MACRO)=""$(VERSION)"""';
 551     $self->{XS_DEFINE_VERSION} = '"$(XS_VERSION_MACRO)=""$(XS_VERSION)"""';
 552     $self->{MAKEMAKER} = vmsify($INC{'ExtUtils/MakeMaker.pm'});
 553 }
 554
 555
 556 =item constants (override)
 557
 558 Fixes up numerous file and directory macros to insure VMS syntax
 559 regardless of input syntax.  Also makes lists of files
 560 comma-separated.
 561
 562 =cut
 563
 564 sub constants {
 565     my($self) = @_;
 566
 567     # Be kind about case for pollution
 568     for (@ARGV) { $_ = uc($_) if /POLLUTE/i; }
 569
 570     # Cleanup paths for directories in MMS macros.
 571     foreach my $macro ( qw [
 572             INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB
 573             PERL_LIB PERL_ARCHLIB
 574             PERL_INC PERL_SRC ],
 575                         (map { 'INSTALL'.$_ } $self->installvars)
 576                       )
 577     {
 578         next unless defined $self->{$macro};
 579         next if $macro =~ /MAN/ && $self->{$macro} eq 'none';
 580         $self->{$macro} = $self->fixpath($self->{$macro},1);
 581     }
 582
 583     # Cleanup paths for files in MMS macros.
 584     foreach my $macro ( qw[LIBPERL_A FIRST_MAKEFILE MAKEFILE_OLD
 585                            MAKE_APERL_FILE MYEXTLIB] )
 586     {
 587         next unless defined $self->{$macro};
 588         $self->{$macro} = $self->fixpath($self->{$macro},0);
 589     }
 590
 591     # Fixup files for MMS macros
 592     # XXX is this list complete?
 593     for my $macro (qw/
 594                    FULLEXT VERSION_FROM OBJECT LDFROM
 595               / ) {
 596         next unless defined $self->{$macro};
 597         $self->{$macro} = $self->fixpath($self->{$macro},0);
 598     }
 599
 600
 601     for my $macro (qw/ XS MAN1PODS MAN3PODS PM /) {
 602         # Where is the space coming from? --jhi
 603         next unless $self ne " " && defined $self->{$macro};
 604         my %tmp = ();
 605         for my $key (keys %{$self->{$macro}}) {
 606             $tmp{$self->fixpath($key,0)} =
 607                                      $self->fixpath($self->{$macro}{$key},0);
 608         }
 609         $self->{$macro} = \%tmp;
 610     }
 611
 612     for my $macro (qw/ C O_FILES H /) {
 613         next unless defined $self->{$macro};
 614         my @tmp = ();
 615         for my $val (@{$self->{$macro}}) {
 616             push(@tmp,$self->fixpath($val,0));
 617         }
 618         $self->{$macro} = \@tmp;
 619     }
 620
 621     # mms/k does not define a $(MAKE) macro.
 622     $self->{MAKE} = '$(MMS)$(MMSQUALIFIERS)';
 623
 624     return $self->SUPER::constants;
 625 }
 626
 627
 628 =item special_targets
 629
 630 Clear the default .SUFFIXES and put in our own list.
 631
 632 =cut
 633
 634 sub special_targets {
 635     my $self = shift;
 636
 637     my $make_frag .= <<'MAKE_FRAG';
 638 .SUFFIXES :
 639 .SUFFIXES : $(OBJ_EXT) .c .cpp .cxx .xs
 640
 641 MAKE_FRAG
 642
 643     return $make_frag;
 644 }
 645
 646 =item cflags (override)
 647
 648 Bypass shell script and produce qualifiers for CC directly (but warn
 649 user if a shell script for this extension exists).  Fold multiple
 650 /Defines into one, since some C compilers pay attention to only one
 651 instance of this qualifier on the command line.
 652
 653 =cut
 654
 655 sub cflags {
 656     my($self,$libperl) = @_;
 657     my($quals) = $self->{CCFLAGS} || $Config{'ccflags'};
 658     my($definestr,$undefstr,$flagoptstr) = ('','','');
 659     my($incstr) = '/Include=($(PERL_INC)';
 660     my($name,$sys,@m);
 661
 662     ( $name = $self->{NAME} . "_cflags" ) =~ s/:/_/g ;
 663     print STDOUT "Unix shell script ".$Config{"$self->{'BASEEXT'}_cflags"}.
 664          " required to modify CC command for $self->{'BASEEXT'}\n"
 665     if ($Config{$name});
 666
 667     if ($quals =~ / -[DIUOg]/) {
 668         while ($quals =~ / -([Og])(\d*)\b/) {
 669             my($type,$lvl) = ($1,$2);
 670             $quals =~ s/ -$type$lvl\b\s*//;
 671             if ($type eq 'g') { $flagoptstr = '/NoOptimize'; }
 672             else { $flagoptstr = '/Optimize' . (defined($lvl) ? "=$lvl" : ''); }
 673         }
 674         while ($quals =~ / -([DIU])(\S+)/) {
 675             my($type,$def) = ($1,$2);
 676             $quals =~ s/ -$type$def\s*//;
 677             $def =~ s/"/""/g;
 678             if    ($type eq 'D') { $definestr .= qq["$def",]; }
 679             elsif ($type eq 'I') { $incstr .= ',' . $self->fixpath($def,1); }
 680             else                 { $undefstr  .= qq["$def",]; }
 681         }
 682     }
 683     if (length $quals and $quals !~ m!/!) {
 684         warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
 685         $quals = '';
 686     }
 687     $definestr .= q["PERL_POLLUTE",] if $self->{POLLUTE};
 688     if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
 689     if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
 690     # Deal with $self->{DEFINE} here since some C compilers pay attention
 691     # to only one /Define clause on command line, so we have to
 692     # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
 693     # ($self->{DEFINE} has already been VMSified in constants() above)
 694     if ($self->{DEFINE}) { $quals .= $self->{DEFINE}; }
 695     for my $type (qw(Def Undef)) {
 696         my(@terms);
 697         while ($quals =~ m:/${type}i?n?e?=([^/]+):ig) {
 698                 my $term = $1;
 699                 $term =~ s:^\((.+)\)$:$1:;
 700                 push @terms, $term;
 701             }
 702         if ($type eq 'Def') {
 703             push @terms, qw[ $(DEFINE_VERSION) $(XS_DEFINE_VERSION) ];
 704         }
 705         if (@terms) {
 706             $quals =~ s:/${type}i?n?e?=[^/]+::ig;
 707             $quals .= "/${type}ine=(" . join(',',@terms) . ')';
 708         }
 709     }
 710
 711     $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
 712
 713     # Likewise with $self->{INC} and /Include
 714     if ($self->{'INC'}) {
 715         my(@includes) = split(/\s+/,$self->{INC});
 716         foreach (@includes) {
 717             s/^-I//;
 718             $incstr .= ','.$self->fixpath($_,1);
 719         }
 720     }
 721     $quals .= "$incstr)";
 722 #    $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g;
 723     $self->{CCFLAGS} = $quals;
 724
 725     $self->{PERLTYPE} ||= '';
 726
 727     $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
 728     if ($self->{OPTIMIZE} !~ m!/!) {
 729         if    ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
 730         elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
 731             $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
 732         }
 733         else {
 734             warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
 735             $self->{OPTIMIZE} = '/Optimize';
 736         }
 737     }
 738
 739     return $self->{CFLAGS} = qq{
 740 CCFLAGS = $self->{CCFLAGS}
 741 OPTIMIZE = $self->{OPTIMIZE}
 742 PERLTYPE = $self->{PERLTYPE}
 743 };
 744 }
 745
 746 =item const_cccmd (override)
 747
 748 Adds directives to point C preprocessor to the right place when
 749 handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
 750 command line a bit differently than MM_Unix method.
 751
 752 =cut
 753
 754 sub const_cccmd {
 755     my($self,$libperl) = @_;
 756     my(@m);
 757
 758     return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
 759     return '' unless $self->needs_linking();
 760     if ($Config{'vms_cc_type'} eq 'gcc') {
 761         push @m,'
 762 .FIRST
 763         ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
 764     }
 765     elsif ($Config{'vms_cc_type'} eq 'vaxc') {
 766         push @m,'
 767 .FIRST
 768         ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
 769         ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
 770     }
 771     else {
 772         push @m,'
 773 .FIRST
 774         ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
 775                 ($Config{'archname'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
 776         ',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
 777     }
 778
 779     push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");
 780
 781     $self->{CONST_CCCMD} = join('',@m);
 782 }
 783
 784
 785 =item tools_other (override)
 786
 787 Throw in some dubious extra macros for Makefile args.
 788
 789 Also keep around the old $(SAY) macro in case somebody's using it.
 790
 791 =cut
 792
 793 sub tools_other {
 794     my($self) = @_;
 795
 796     # XXX Are these necessary?  Does anyone override them?  They're longer
 797     # than just typing the literal string.
 798     my $extra_tools = <<'EXTRA_TOOLS';
 799
 800 # Just in case anyone is using the old macro.
 801 USEMACROS = $(MACROSTART)
 802 SAY = $(ECHO)
 803
 804 EXTRA_TOOLS
 805
 806     return $self->SUPER::tools_other . $extra_tools;
 807 }
 808
 809 =item init_dist (override)
 810
 811 VMSish defaults for some values.
 812
 813   macro         description                     default
 814
 815   ZIPFLAGS      flags to pass to ZIP            -Vu
 816
 817   COMPRESS      compression command to          gzip
 818                 use for tarfiles
 819   SUFFIX        suffix to put on                -gz
 820                 compressed files
 821
 822   SHAR          shar command to use             vms_share
 823
 824   DIST_DEFAULT  default target to use to        tardist
 825                 create a distribution
 826
 827   DISTVNAME     Use VERSION_SYM instead of      $(DISTNAME)-$(VERSION_SYM)
 828                 VERSION for the name
 829
 830 =cut
 831
 832 sub init_dist {
 833     my($self) = @_;
 834     $self->{ZIPFLAGS}     ||= '-Vu';
 835     $self->{COMPRESS}     ||= 'gzip';
 836     $self->{SUFFIX}       ||= '-gz';
 837     $self->{SHAR}         ||= 'vms_share';
 838     $self->{DIST_DEFAULT} ||= 'zipdist';
 839
 840     $self->SUPER::init_dist;
 841
 842     $self->{DISTVNAME}    = "$self->{DISTNAME}-$self->{VERSION_SYM}";
 843 }
 844
 845 =item c_o (override)
 846
 847 Use VMS syntax on command line.  In particular, $(DEFINE) and
 848 $(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.
 849
 850 =cut
 851
 852 sub c_o {
 853     my($self) = @_;
 854     return '' unless $self->needs_linking();
 855     '
 856 .c$(OBJ_EXT) :
 857         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
 858
 859 .cpp$(OBJ_EXT) :
 860         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp
 861
 862 .cxx$(OBJ_EXT) :
 863         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx
 864
 865 ';
 866 }
 867
 868 =item xs_c (override)
 869
 870 Use MM[SK] macros.
 871
 872 =cut
 873
 874 sub xs_c {
 875     my($self) = @_;
 876     return '' unless $self->needs_linking();
 877     '
 878 .xs.c :
 879         $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
 880 ';
 881 }
 882
 883 =item xs_o (override)
 884
 885 Use MM[SK] macros, and VMS command line for C compiler.
 886
 887 =cut
 888
 889 sub xs_o {      # many makes are too dumb to use xs_c then c_o
 890     my($self) = @_;
 891     return '' unless $self->needs_linking();
 892     '
 893 .xs$(OBJ_EXT) :
 894         $(XSUBPPRUN) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
 895         $(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
 896 ';
 897 }
 898
 899
 900 =item dlsyms (override)
 901
 902 Create VMS linker options files specifying universal symbols for this
 903 extension's shareable image, and listing other shareable images or
 904 libraries to which it should be linked.
 905
 906 =cut
 907
 908 sub dlsyms {
 909     my($self,%attribs) = @_;
 910
 911     return '' unless $self->needs_linking();
 912
 913     my($funcs) = $attribs{DL_FUNCS} || $self->{DL_FUNCS} || {};
 914     my($vars)  = $attribs{DL_VARS}  || $self->{DL_VARS}  || [];
 915     my($funclist)  = $attribs{FUNCLIST}  || $self->{FUNCLIST}  || [];
 916     my(@m);
 917
 918     unless ($self->{SKIPHASH}{'dynamic'}) {
 919         push(@m,'
 920 dynamic :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
 921         $(NOECHO) $(NOOP)
 922 ');
 923     }
 924
 925     push(@m,'
 926 static :: $(INST_ARCHAUTODIR)$(BASEEXT).opt
 927         $(NOECHO) $(NOOP)
 928 ') unless $self->{SKIPHASH}{'static'};
 929
 930     push @m,'
 931 $(INST_ARCHAUTODIR)$(BASEEXT).opt : $(BASEEXT).opt
 932         $(CP) $(MMS$SOURCE) $(MMS$TARGET)
 933
 934 $(BASEEXT).opt : Makefile.PL
 935         $(PERLRUN) -e "use ExtUtils::Mksymlists;" -
 936         ',qq[-e "Mksymlists('NAME' => '$self->{NAME}', 'DL_FUNCS' => ],
 937         neatvalue($funcs),q[, 'DL_VARS' => ],neatvalue($vars),
 938         q[, 'FUNCLIST' => ],neatvalue($funclist),qq[)"\n];
 939
 940     push @m, '  $(PERL) -e "print ""$(INST_STATIC)/Include=';
 941     if ($self->{OBJECT} =~ /\bBASEEXT\b/ or
 942         $self->{OBJECT} =~ /\b$self->{BASEEXT}\b/i) {
 943         push @m, ($Config{d_vms_case_sensitive_symbols}
 944                    ? uc($self->{BASEEXT}) :'$(BASEEXT)');
 945     }
 946     else {  # We don't have a "main" object file, so pull 'em all in
 947        # Upcase module names if linker is being case-sensitive
 948        my($upcase) = $Config{d_vms_case_sensitive_symbols};
 949         my(@omods) = map { s/\.[^.]*$//;         # Trim off file type
 950                            s[\$\(\w+_EXT\)][];   # even as a macro
 951                            s/.*[:>\/\]]//;       # Trim off dir spec
 952                            $upcase ? uc($_) : $_;
 953                          } split ' ', $self->eliminate_macros($self->{OBJECT});
 954         my($tmp,@lines,$elt) = '';
 955         $tmp = shift @omods;
 956         foreach $elt (@omods) {
 957             $tmp .= ",$elt";
 958                 if (length($tmp) > 80) { push @lines, $tmp;  $tmp = ''; }
 959         }
 960         push @lines, $tmp;
 961         push @m, '(', join( qq[, -\\n\\t"";" >>\$(MMS\$TARGET)\n\t\$(PERL) -e "print ""], @lines),')';
 962     }
 963         push @m, '\n$(INST_STATIC)/Library\n"";" >>$(MMS$TARGET)',"\n";
 964
 965     if (length $self->{LDLOADLIBS}) {
 966         my($lib); my($line) = '';
 967         foreach $lib (split ' ', $self->{LDLOADLIBS}) {
 968             $lib =~ s%\$%\\\$%g;  # Escape '$' in VMS filespecs
 969             if (length($line) + length($lib) > 160) {
 970                 push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n";
 971                 $line = $lib . '\n';
 972             }
 973             else { $line .= $lib . '\n'; }
 974         }
 975         push @m, "\t\$(PERL) -e \"print qq{$line}\" >>\$(MMS\$TARGET)\n" if $line;
 976     }
 977
 978     join('',@m);
 979
 980 }
 981
 982 =item dynamic_lib (override)
 983
 984 Use VMS Link command.
 985
 986 =cut
 987
 988 sub dynamic_lib {
 989     my($self, %attribs) = @_;
 990     return '' unless $self->needs_linking(); #might be because of a subdir
 991
 992     return '' unless $self->has_link_code();
 993
 994     my($otherldflags) = $attribs{OTHERLDFLAGS} || "";
 995     my($inst_dynamic_dep) = $attribs{INST_DYNAMIC_DEP} || "";
 996     my $shr = $Config{'dbgprefix'} . 'PerlShr';
 997     my(@m);
 998     push @m,"
 999
1000 OTHERLDFLAGS = $otherldflags
1001 INST_DYNAMIC_DEP = $inst_dynamic_dep
1002
1003 ";
1004     push @m, '
1005 $(INST_DYNAMIC) : $(INST_STATIC) $(PERL_INC)perlshr_attr.opt $(INST_ARCHAUTODIR)$(DFSEP).exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
1006         If F$TrnLNm("',$shr,'").eqs."" Then Define/NoLog/User ',"$shr Sys\$Share:$shr.$Config{'dlext'}",'
1007         Link $(LDFLAGS) /Shareable=$(MMS$TARGET)$(OTHERLDFLAGS) $(BASEEXT).opt/Option,$(PERL_INC)perlshr_attr.opt/Option
1008 ';
1009
1010     join('',@m);
1011 }
1012
1013
1014 =item static_lib (override)
1015
1016 Use VMS commands to manipulate object library.
1017
1018 =cut
1019
1020 sub static_lib {
1021     my($self) = @_;
1022     return '' unless $self->needs_linking();
1023
1024     return '
1025 $(INST_STATIC) :
1026         $(NOECHO) $(NOOP)
1027 ' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});
1028
1029     my(@m,$lib);
1030     push @m,'
1031 # Rely on suffix rule for update action
1032 $(OBJECT) : $(INST_ARCHAUTODIR)$(DFSEP).exists
1033
1034 $(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
1035 ';
1036     # If this extension has its own library (eg SDBM_File)
1037     # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
1038     push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};
1039
1040     push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");
1041
1042     # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
1043     # 'cause it's a library and you can't stick them in other libraries.
1044     # In that case, we use $OBJECT instead and hope for the best
1045     if ($self->{MYEXTLIB}) {
1046       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n");
1047     } else {
1048       push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
1049     }
1050
1051     push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
1052     foreach $lib (split ' ', $self->{EXTRALIBS}) {
1053       push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
1054     }
1055     join('',@m);
1056 }
1057
1058
1059 =item extra_clean_files
1060
1061 Clean up some OS specific files.  Plus the temp file used to shorten
1062 a lot of commands.
1063
1064 =cut
1065
1066 sub extra_clean_files {
1067     return qw(
1068               *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *.Opt $(BASEEXT).bso
1069               .MM_Tmp
1070              );
1071 }
1072
1073
1074 =item zipfile_target
1075
1076 =item tarfile_target
1077
1078 =item shdist_target
1079
1080 Syntax for invoking shar, tar and zip differs from that for Unix.
1081
1082 =cut
1083
1084 sub zipfile_target {
1085     my($self) = shift;
1086
1087     return <<'MAKE_FRAG';
1088 $(DISTVNAME).zip : distdir
1089         $(PREOP)
1090         $(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
1091         $(RM_RF) $(DISTVNAME)
1092         $(POSTOP)
1093 MAKE_FRAG
1094 }
1095
1096 sub tarfile_target {
1097     my($self) = shift;
1098
1099     return <<'MAKE_FRAG';
1100 $(DISTVNAME).tar$(SUFFIX) : distdir
1101         $(PREOP)
1102         $(TO_UNIX)
1103         $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
1104         $(RM_RF) $(DISTVNAME)
1105         $(COMPRESS) $(DISTVNAME).tar
1106         $(POSTOP)
1107 MAKE_FRAG
1108 }
1109
1110 sub shdist_target {
1111     my($self) = shift;
1112
1113     return <<'MAKE_FRAG';
1114 shdist : distdir
1115         $(PREOP)
1116         $(SHAR) [.$(DISTVNAME)...]*.*; $(DISTVNAME).share
1117         $(RM_RF) $(DISTVNAME)
1118         $(POSTOP)
1119 MAKE_FRAG
1120 }
1121
1122
1123 # --- Test and Installation Sections ---
1124
1125 =item install (override)
1126
1127 Work around DCL's 255 character limit several times,and use
1128 VMS-style command line quoting in a few cases.
1129
1130 =cut
1131
1132 sub install {
1133     my($self, %attribs) = @_;
1134     my(@m);
1135
1136     push @m, q[
1137 install :: all pure_install doc_install
1138         $(NOECHO) $(NOOP)
1139
1140 install_perl :: all pure_perl_install doc_perl_install
1141         $(NOECHO) $(NOOP)
1142
1143 install_site :: all pure_site_install doc_site_install
1144         $(NOECHO) $(NOOP)
1145
1146 pure_install :: pure_$(INSTALLDIRS)_install
1147         $(NOECHO) $(NOOP)
1148
1149 doc_install :: doc_$(INSTALLDIRS)_install
1150         $(NOECHO) $(NOOP)
1151
1152 pure__install : pure_site_install
1153         $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1154
1155 doc__install : doc_site_install
1156         $(NOECHO) $(ECHO) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site"
1157
1158 # This hack brought to you by DCL's 255-character command line limit
1159 pure_perl_install ::
1160         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1161         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1162         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLPRIVLIB) " >>.MM_tmp
1163         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLARCHLIB) " >>.MM_tmp
1164         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLBIN) " >>.MM_tmp
1165         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1166         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLMAN1DIR) " >>.MM_tmp
1167         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLMAN3DIR) " >>.MM_tmp
1168         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1169         $(NOECHO) $(RM_F) .MM_tmp
1170         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
1171
1172 # Likewise
1173 pure_site_install ::
1174         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1175         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1176         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLSITELIB) " >>.MM_tmp
1177         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLSITEARCH) " >>.MM_tmp
1178         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLSITEBIN) " >>.MM_tmp
1179         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1180         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLSITEMAN1DIR) " >>.MM_tmp
1181         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLSITEMAN3DIR) " >>.MM_tmp
1182         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1183         $(NOECHO) $(RM_F) .MM_tmp
1184         $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1185
1186 pure_vendor_install ::
1187         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(VENDORARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp
1188         $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(DESTINSTALLVENDORARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp
1189         $(NOECHO) $(ECHO_N) "$(INST_LIB) $(DESTINSTALLVENDORLIB) " >>.MM_tmp
1190         $(NOECHO) $(ECHO_N) "$(INST_ARCHLIB) $(DESTINSTALLVENDORARCH) " >>.MM_tmp
1191         $(NOECHO) $(ECHO_N) "$(INST_BIN) $(DESTINSTALLVENDORBIN) " >>.MM_tmp
1192         $(NOECHO) $(ECHO_N) "$(INST_SCRIPT) $(DESTINSTALLSCRIPT) " >>.MM_tmp
1193         $(NOECHO) $(ECHO_N) "$(INST_MAN1DIR) $(DESTINSTALLVENDORMAN1DIR) " >>.MM_tmp
1194         $(NOECHO) $(ECHO_N) "$(INST_MAN3DIR) $(DESTINSTALLVENDORMAN3DIR) " >>.MM_tmp
1195         $(NOECHO) $(MOD_INSTALL) <.MM_tmp
1196         $(NOECHO) $(RM_F) .MM_tmp
1197
1198 # Ditto
1199 doc_perl_install ::
1200         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1201         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1202         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLPRIVLIB)|" >.MM_tmp
1203         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1204         $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1205         $(NOECHO) $(RM_F) .MM_tmp
1206
1207 # And again
1208 doc_site_install ::
1209         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1210         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1211         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLSITELIB)|" >.MM_tmp
1212         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1213         $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1214         $(NOECHO) $(RM_F) .MM_tmp
1215
1216 doc_vendor_install ::
1217         $(NOECHO) $(ECHO) "Appending installation info to ].$self->catfile($self->{DESTINSTALLARCHLIB}, 'perllocal.pod').q["
1218         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1219         $(NOECHO) $(ECHO_N) "installed into|$(INSTALLVENDORLIB)|" >.MM_tmp
1220         $(NOECHO) $(ECHO_N) "LINKTYPE|$(LINKTYPE)|VERSION|$(VERSION)|EXE_FILES|$(EXE_FILES) " >>.MM_tmp
1221         $(NOECHO) $(DOC_INSTALL) "Module" "$(NAME)" <.MM_tmp >>].$self->catfile($self->{DESTINSTALLARCHLIB},'perllocal.pod').q[
1222         $(NOECHO) $(RM_F) .MM_tmp
1223
1224 ];
1225
1226     push @m, q[
1227 uninstall :: uninstall_from_$(INSTALLDIRS)dirs
1228         $(NOECHO) $(NOOP)
1229
1230 uninstall_from_perldirs ::
1231         $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[
1232         $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
1233         $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
1234         $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
1235
1236 uninstall_from_sitedirs ::
1237         $(NOECHO) $(UNINSTALL) ].$self->catfile($self->{SITEARCHEXP},'auto',$self->{FULLEXT},'.packlist').q[
1238         $(NOECHO) $(ECHO) "Uninstall is now deprecated and makes no actual changes."
1239         $(NOECHO) $(ECHO) "Please check the list above carefully for errors, and manually remove"
1240         $(NOECHO) $(ECHO) "the appropriate files.  Sorry for the inconvenience."
1241 ];
1242
1243     join('',@m);
1244 }
1245
1246 =item perldepend (override)
1247
1248 Use VMS-style syntax for files; it's cheaper to just do it directly here
1249 than to have the MM_Unix method call C<catfile> repeatedly.  Also, if
1250 we have to rebuild Config.pm, use MM[SK] to do it.
1251
1252 =cut
1253
1254 sub perldepend {
1255     my($self) = @_;
1256     my(@m);
1257
1258     push @m, '
1259 $(OBJECT) : $(PERL_INC)EXTERN.h, $(PERL_INC)INTERN.h, $(PERL_INC)XSUB.h
1260 $(OBJECT) : $(PERL_INC)av.h, $(PERL_INC)cc_runtime.h, $(PERL_INC)config.h
1261 $(OBJECT) : $(PERL_INC)cop.h, $(PERL_INC)cv.h, $(PERL_INC)embed.h
1262 $(OBJECT) : $(PERL_INC)embedvar.h, $(PERL_INC)form.h
1263 $(OBJECT) : $(PERL_INC)gv.h, $(PERL_INC)handy.h, $(PERL_INC)hv.h
1264 $(OBJECT) : $(PERL_INC)intrpvar.h, $(PERL_INC)iperlsys.h, $(PERL_INC)keywords.h
1265 $(OBJECT) : $(PERL_INC)mg.h, $(PERL_INC)nostdio.h, $(PERL_INC)op.h
1266 $(OBJECT) : $(PERL_INC)opcode.h, $(PERL_INC)patchlevel.h
1267 $(OBJECT) : $(PERL_INC)perl.h, $(PERL_INC)perlio.h
1268 $(OBJECT) : $(PERL_INC)perlsdio.h, $(PERL_INC)perlvars.h
1269 $(OBJECT) : $(PERL_INC)perly.h, $(PERL_INC)pp.h, $(PERL_INC)pp_proto.h
1270 $(OBJECT) : $(PERL_INC)proto.h, $(PERL_INC)regcomp.h, $(PERL_INC)regexp.h
1271 $(OBJECT) : $(PERL_INC)regnodes.h, $(PERL_INC)scope.h, $(PERL_INC)sv.h
1272 $(OBJECT) : $(PERL_INC)thrdvar.h, $(PERL_INC)thread.h
1273 $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h
1274
1275 ' if $self->{OBJECT};
1276
1277     if ($self->{PERL_SRC}) {
1278         my(@macros);
1279         my($mmsquals) = '$(USEMAKEFILE)[.vms]$(FIRST_MAKEFILE)';
1280         push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP';
1281         push(@macros,'DECC=1')    if $Config{'vms_cc_type'} eq 'decc';
1282         push(@macros,'GNUC=1')    if $Config{'vms_cc_type'} eq 'gcc';
1283         push(@macros,'SOCKET=1')  if $Config{'d_has_sockets'};
1284         push(@macros,qq["CC=$Config{'cc'}"])  if $Config{'cc'} =~ m!/!;
1285         $mmsquals .= '$(USEMACROS)' . join(',',@macros) . '$(MACROEND)' if @macros;
1286         push(@m,q[
1287 # Check for unpropagated config.sh changes. Should never happen.
1288 # We do NOT just update config.h because that is not sufficient.
1289 # An out of date config.h is not fatal but complains loudly!
1290 $(PERL_INC)config.h : $(PERL_SRC)config.sh
1291         $(NOOP)
1292
1293 $(PERL_ARCHLIB)Config.pm : $(PERL_SRC)config.sh
1294         $(NOECHO) Write Sys$Error "$(PERL_ARCHLIB)Config.pm may be out of date with config.h or genconfig.pl"
1295         olddef = F$Environment("Default")
1296         Set Default $(PERL_SRC)
1297         $(MMS)],$mmsquals,);
1298         if ($self->{PERL_ARCHLIB} =~ m|\[-| && $self->{PERL_SRC} =~ m|(\[-+)|) {
1299             my($prefix,$target) = ($1,$self->fixpath('$(PERL_ARCHLIB)Config.pm',0));
1300             $target =~ s/\Q$prefix/[/;
1301             push(@m," $target");
1302         }
1303         else { push(@m,' $(MMS$TARGET)'); }
1304         push(@m,q[
1305         Set Default 'olddef'
1306 ]);
1307     }
1308
1309     push(@m, join(" ", map($self->fixpath($_,0),values %{$self->{XS}}))." : \$(XSUBPPDEPS)\n")
1310       if %{$self->{XS}};
1311
1312     join('',@m);
1313 }
1314
1315
1316 =item makeaperl (override)
1317
1318 Undertake to build a new set of Perl images using VMS commands.  Since
1319 VMS does dynamic loading, it's not necessary to statically link each
1320 extension into the Perl image, so this isn't the normal build path.
1321 Consequently, it hasn't really been tested, and may well be incomplete.
1322
1323 =cut
1324
1325 use vars qw(%olbs);
1326
1327 sub makeaperl {
1328     my($self, %attribs) = @_;
1329     my($makefilename, $searchdirs, $static, $extra, $perlinc, $target, $tmpdir, $libperl) =
1330       @attribs{qw(MAKE DIRS STAT EXTRA INCL TARGET TMP LIBPERL)};
1331     my(@m);
1332     push @m, "
1333 # --- MakeMaker makeaperl section ---
1334 MAP_TARGET    = $target
1335 ";
1336     return join '', @m if $self->{PARENT};
1337
1338     my($dir) = join ":", @{$self->{DIR}};
1339
1340     unless ($self->{MAKEAPERL}) {
1341         push @m, q{
1342 $(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
1343         $(NOECHO) $(ECHO) "Writing ""$(MMS$TARGET)"" for this $(MAP_TARGET)"
1344         $(NOECHO) $(PERLRUNINST) \
1345                 Makefile.PL DIR=}, $dir, q{ \
1346                 FIRST_MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
1347                 MAKEAPERL=1 NORECURS=1 };
1348
1349         push @m, map(q[ \\\n\t\t"$_"], @ARGV),q{
1350
1351 $(MAP_TARGET) :: $(MAKE_APERL_FILE)
1352         $(MAKE)$(USEMAKEFILE)$(MAKE_APERL_FILE) static $(MMS$TARGET)
1353 };
1354         push @m, "\n";
1355
1356         return join '', @m;
1357     }
1358
1359
1360     my($linkcmd,@optlibs,@staticpkgs,$extralist,$targdir,$libperldir,%libseen);
1361     local($_);
1362
1363     # The front matter of the linkcommand...
1364     $linkcmd = join ' ', $Config{'ld'},
1365             grep($_, @Config{qw(large split ldflags ccdlflags)});
1366     $linkcmd =~ s/\s+/ /g;
1367
1368     # Which *.olb files could we make use of...
1369     local(%olbs);       # XXX can this be lexical?
1370     $olbs{$self->{INST_ARCHAUTODIR}} = "$self->{BASEEXT}\$(LIB_EXT)";
1371     require File::Find;
1372     File::Find::find(sub {
1373         return unless m/\Q$self->{LIB_EXT}\E$/;
1374         return if m/^libperl/;
1375
1376         if( exists $self->{INCLUDE_EXT} ){
1377                 my $found = 0;
1378                 my $incl;
1379                 my $xx;
1380
1381                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1382                 $xx =~ s,/?$_,,;
1383                 $xx =~ s,/,::,g;
1384
1385                 # Throw away anything not explicitly marked for inclusion.
1386                 # DynaLoader is implied.
1387                 foreach $incl ((@{$self->{INCLUDE_EXT}},'DynaLoader')){
1388                         if( $xx eq $incl ){
1389                                 $found++;
1390                                 last;
1391                         }
1392                 }
1393                 return unless $found;
1394         }
1395         elsif( exists $self->{EXCLUDE_EXT} ){
1396                 my $excl;
1397                 my $xx;
1398
1399                 ($xx = $File::Find::name) =~ s,.*?/auto/,,;
1400                 $xx =~ s,/?$_,,;
1401                 $xx =~ s,/,::,g;
1402
1403                 # Throw away anything explicitly marked for exclusion
1404                 foreach $excl (@{$self->{EXCLUDE_EXT}}){
1405                         return if( $xx eq $excl );
1406                 }
1407         }
1408
1409         $olbs{$ENV{DEFAULT}} = $_;
1410     }, grep( -d $_, @{$searchdirs || []}));
1411
1412     # We trust that what has been handed in as argument will be buildable
1413     $static = [] unless $static;
1414     @olbs{@{$static}} = (1) x @{$static};
1415
1416     $extra = [] unless $extra && ref $extra eq 'ARRAY';
1417     # Sort the object libraries in inverse order of
1418     # filespec length to try to insure that dependent extensions
1419     # will appear before their parents, so the linker will
1420     # search the parent library to resolve references.
1421     # (e.g. Intuit::DWIM will precede Intuit, so unresolved
1422     # references from [.intuit.dwim]dwim.obj can be found
1423     # in [.intuit]intuit.olb).
1424     for (sort { length($a) <=> length($b) } keys %olbs) {
1425         next unless $olbs{$_} =~ /\Q$self->{LIB_EXT}\E$/;
1426         my($dir) = $self->fixpath($_,1);
1427         my($extralibs) = $dir . "extralibs.ld";
1428         my($extopt) = $dir . $olbs{$_};
1429         $extopt =~ s/$self->{LIB_EXT}$/.opt/;
1430         push @optlibs, "$dir$olbs{$_}";
1431         # Get external libraries this extension will need
1432         if (-f $extralibs ) {
1433             my %seenthis;
1434             open LIST,$extralibs or warn $!,next;
1435             while (<LIST>) {
1436                 chomp;
1437                 # Include a library in the link only once, unless it's mentioned
1438                 # multiple times within a single extension's options file, in which
1439                 # case we assume the builder needed to search it again later in the
1440                 # link.
1441                 my $skip = exists($libseen{$_}) && !exists($seenthis{$_});
1442                 $libseen{$_}++;  $seenthis{$_}++;
1443                 next if $skip;
1444                 push @$extra,$_;
1445             }
1446             close LIST;
1447         }
1448         # Get full name of extension for ExtUtils::Miniperl
1449         if (-f $extopt) {
1450             open OPT,$extopt or die $!;
1451             while (<OPT>) {
1452                 next unless /(?:UNIVERSAL|VECTOR)=boot_([\w_]+)/;
1453                 my $pkg = $1;
1454                 $pkg =~ s#__*#::#g;
1455                 push @staticpkgs,$pkg;
1456             }
1457         }
1458     }
1459     # Place all of the external libraries after all of the Perl extension
1460     # libraries in the final link, in order to maximize the opportunity
1461     # for XS code from multiple extensions to resolve symbols against the
1462     # same external library while only including that library once.
1463     push @optlibs, @$extra;
1464
1465     $target = "Perl$Config{'exe_ext'}" unless $target;
1466     my $shrtarget;
1467     ($shrtarget,$targdir) = fileparse($target);
1468     $shrtarget =~ s/^([^.]*)/$1Shr/;
1469     $shrtarget = $targdir . $shrtarget;
1470     $target = "Perlshr.$Config{'dlext'}" unless $target;
1471     $tmpdir = "[]" unless $tmpdir;
1472     $tmpdir = $self->fixpath($tmpdir,1);
1473     if (@optlibs) { $extralist = join(' ',@optlibs); }
1474     else          { $extralist = ''; }
1475     # Let ExtUtils::Liblist find the necessary libs for us (but skip PerlShr)
1476     # that's what we're building here).
1477     push @optlibs, grep { !/PerlShr/i } split ' ', +($self->ext())[2];
1478     if ($libperl) {
1479         unless (-f $libperl || -f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',$libperl))) {
1480             print STDOUT "Warning: $libperl not found\n";
1481             undef $libperl;
1482         }
1483     }
1484     unless ($libperl) {
1485         if (defined $self->{PERL_SRC}) {
1486             $libperl = $self->catfile($self->{PERL_SRC},"libperl$self->{LIB_EXT}");
1487         } elsif (-f ($libperl = $self->catfile($Config{'installarchlib'},'CORE',"libperl$self->{LIB_EXT}")) ) {
1488         } else {
1489             print STDOUT "Warning: $libperl not found
1490     If you're going to build a static perl binary, make sure perl is installed
1491     otherwise ignore this warning\n";
1492         }
1493     }
1494     $libperldir = $self->fixpath((fileparse($libperl))[1],1);
1495
1496     push @m, '
1497 # Fill in the target you want to produce if it\'s not perl
1498 MAP_TARGET    = ',$self->fixpath($target,0),'
1499 MAP_SHRTARGET = ',$self->fixpath($shrtarget,0),"
1500 MAP_LINKCMD   = $linkcmd
1501 MAP_PERLINC   = ", $perlinc ? map('"$_" ',@{$perlinc}) : '',"
1502 MAP_EXTRA     = $extralist
1503 MAP_LIBPERL = ",$self->fixpath($libperl,0),'
1504 ';
1505
1506
1507     push @m,"\n${tmpdir}Makeaperl.Opt : \$(MAP_EXTRA)\n";
1508     foreach (@optlibs) {
1509         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,'}" >>$(MMS$TARGET)',"\n";
1510     }
1511     push @m,"\n${tmpdir}PerlShr.Opt :\n\t";
1512     push @m,'$(NOECHO) $(PERL) -e "print q{$(MAP_SHRTARGET)}" >$(MMS$TARGET)',"\n";
1513
1514     push @m,'
1515 $(MAP_SHRTARGET) : $(MAP_LIBPERL) Makeaperl.Opt ',"${libperldir}Perlshr_Attr.Opt",'
1516         $(MAP_LINKCMD)/Shareable=$(MMS$TARGET) $(MAP_LIBPERL), Makeaperl.Opt/Option ',"${libperldir}Perlshr_Attr.Opt/Option",'
1517 $(MAP_TARGET) : $(MAP_SHRTARGET) ',"${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}PerlShr.Opt",'
1518         $(MAP_LINKCMD) ',"${tmpdir}perlmain\$(OBJ_EXT)",', PerlShr.Opt/Option
1519         $(NOECHO) $(ECHO) "To install the new ""$(MAP_TARGET)"" binary, say"
1520         $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) inst_perl $(USEMACROS)MAP_TARGET=$(MAP_TARGET)$(ENDMACRO)"
1521         $(NOECHO) $(ECHO) "To remove the intermediate files, say
1522         $(NOECHO) $(ECHO) "    $(MAKE)$(USEMAKEFILE)$(FIRST_MAKEFILE) map_clean"
1523 ';
1524     push @m,"\n${tmpdir}perlmain.c : \$(FIRST_MAKEFILE)\n\t\$(NOECHO) \$(PERL) -e 1 >${tmpdir}Writemain.tmp\n";
1525     push @m, "# More from the 255-char line length limit\n";
1526     foreach (@staticpkgs) {
1527         push @m,'       $(NOECHO) $(PERL) -e "print q{',$_,qq[}" >>${tmpdir}Writemain.tmp\n];
1528     }
1529
1530     push @m, sprintf <<'MAKE_FRAG', $tmpdir, $tmpdir;
1531         $(NOECHO) $(PERL) $(MAP_PERLINC) -ane "use ExtUtils::Miniperl; writemain(@F)" %sWritemain.tmp >$(MMS$TARGET)
1532         $(NOECHO) $(RM_F) %sWritemain.tmp
1533 MAKE_FRAG
1534
1535     push @m, q[
1536 # Still more from the 255-char line length limit
1537 doc_inst_perl :
1538         $(NOECHO) $(MKPATH) $(DESTINSTALLARCHLIB)
1539         $(NOECHO) $(ECHO) "Perl binary $(MAP_TARGET)|" >.MM_tmp
1540         $(NOECHO) $(ECHO) "MAP_STATIC|$(MAP_STATIC)|" >>.MM_tmp
1541         $(NOECHO) $(PERL) -pl040 -e " " ].$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'),q[ >>.MM_tmp
1542         $(NOECHO) $(ECHO) -e "MAP_LIBPERL|$(MAP_LIBPERL)|" >>.MM_tmp
1543         $(NOECHO) $(DOC_INSTALL) <.MM_tmp >>].$self->catfile('$(DESTINSTALLARCHLIB)','perllocal.pod').q[
1544         $(NOECHO) $(RM_F) .MM_tmp
1545 ];
1546
1547     push @m, "
1548 inst_perl : pure_inst_perl doc_inst_perl
1549         \$(NOECHO) \$(NOOP)
1550
1551 pure_inst_perl : \$(MAP_TARGET)
1552         $self->{CP} \$(MAP_SHRTARGET) ",$self->fixpath($Config{'installbin'},1),"
1553         $self->{CP} \$(MAP_TARGET) ",$self->fixpath($Config{'installbin'},1),"
1554
1555 clean :: map_clean
1556         \$(NOECHO) \$(NOOP)
1557
1558 map_clean :
1559         \$(RM_F) ${tmpdir}perlmain\$(OBJ_EXT) ${tmpdir}perlmain.c \$(FIRST_MAKEFILE)
1560         \$(RM_F) ${tmpdir}Makeaperl.Opt ${tmpdir}PerlShr.Opt \$(MAP_TARGET)
1561 ";
1562
1563     join '', @m;
1564 }
1565
1566 # --- Output postprocessing section ---
1567
1568 =item nicetext (override)
1569
1570 Insure that colons marking targets are preceded by space, in order
1571 to distinguish the target delimiter from a colon appearing as
1572 part of a filespec.
1573
1574 =cut
1575
1576 sub nicetext {
1577     my($self,$text) = @_;
1578     return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone
1579     $text =~ s/([^\s:])(:+\s)/$1 $2/gs;
1580     $text;
1581 }
1582
1583 =item prefixify (override)
1584
1585 prefixifying on VMS is simple.  Each should simply be:
1586
1587     perl_root:[some.dir]
1588
1589 which can just be converted to:
1590
1591     volume:[your.prefix.some.dir]
1592
1593 otherwise you get the default layout.
1594
1595 In effect, your search prefix is ignored and $Config{vms_prefix} is
1596 used instead.
1597
1598 =cut
1599
1600 sub prefixify {
1601     my($self, $var, $sprefix, $rprefix, $default) = @_;
1602
1603     # Translate $(PERLPREFIX) to a real path.
1604     $rprefix = $self->eliminate_macros($rprefix);
1605     $rprefix = VMS::Filespec::vmspath($rprefix) if $rprefix;
1606     $sprefix = VMS::Filespec::vmspath($sprefix) if $sprefix;
1607
1608     $default = VMS::Filespec::vmsify($default)
1609       unless $default =~ /\[.*\]/;
1610
1611     (my $var_no_install = $var) =~ s/^install//;
1612     my $path = $self->{uc $var} ||
1613                $ExtUtils::MM_Unix::Config_Override{lc $var} ||
1614                $Config{lc $var} || $Config{lc $var_no_install};
1615
1616     if( !$path ) {
1617         print STDERR "  no Config found for $var.\n" if $Verbose >= 2;
1618         $path = $self->_prefixify_default($rprefix, $default);
1619     }
1620     elsif( !$self->{ARGS}{PREFIX} || !$self->file_name_is_absolute($path) ) {
1621         # do nothing if there's no prefix or if its relative
1622     }
1623     elsif( $sprefix eq $rprefix ) {
1624         print STDERR "  no new prefix.\n" if $Verbose >= 2;
1625     }
1626     else {
1627
1628         print STDERR "  prefixify $var => $path\n"     if $Verbose >= 2;
1629         print STDERR "    from $sprefix to $rprefix\n" if $Verbose >= 2;
1630
1631         my($path_vol, $path_dirs) = $self->splitpath( $path );
1632         if( $path_vol eq $Config{vms_prefix}.':' ) {
1633             print STDERR "  $Config{vms_prefix}: seen\n" if $Verbose >= 2;
1634
1635             $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.};
1636             $path = $self->_catprefix($rprefix, $path_dirs);
1637         }
1638         else {
1639             $path = $self->_prefixify_default($rprefix, $default);
1640         }
1641     }
1642
1643     print "    now $path\n" if $Verbose >= 2;
1644     return $self->{uc $var} = $path;
1645 }
1646
1647
1648 sub _prefixify_default {
1649     my($self, $rprefix, $default) = @_;
1650
1651     print STDERR "  cannot prefix, using default.\n" if $Verbose >= 2;
1652
1653     if( !$default ) {
1654         print STDERR "No default!\n" if $Verbose >= 1;
1655         return;
1656     }
1657     if( !$rprefix ) {
1658         print STDERR "No replacement prefix!\n" if $Verbose >= 1;
1659         return '';
1660     }
1661
1662     return $self->_catprefix($rprefix, $default);
1663 }
1664
1665 sub _catprefix {
1666     my($self, $rprefix, $default) = @_;
1667
1668     my($rvol, $rdirs) = $self->splitpath($rprefix);
1669     if( $rvol ) {
1670         return $self->catpath($rvol,
1671                                    $self->catdir($rdirs, $default),
1672                                    ''
1673                                   )
1674     }
1675     else {
1676         return $self->catdir($rdirs, $default);
1677     }
1678 }
1679
1680
1681 =item cd
1682
1683 =cut
1684
1685 sub cd {
1686     my($self, $dir, @cmds) = @_;
1687
1688     $dir = vmspath($dir);
1689
1690     my $cmd = join "\n\t", map "$_", @cmds;
1691
1692     # No leading tab makes it look right when embedded
1693     my $make_frag = sprintf <<'MAKE_FRAG', $dir, $cmd;
1694 startdir = F$Environment("Default")
1695         Set Default %s
1696         %s
1697         Set Default 'startdir'
1698 MAKE_FRAG
1699
1700     # No trailing newline makes this easier to embed
1701     chomp $make_frag;
1702
1703     return $make_frag;
1704 }
1705
1706
1707 =item oneliner
1708
1709 =cut
1710
1711 sub oneliner {
1712     my($self, $cmd, $switches) = @_;
1713     $switches = [] unless defined $switches;
1714
1715     # Strip leading and trailing newlines
1716     $cmd =~ s{^\n+}{};
1717     $cmd =~ s{\n+$}{};
1718
1719     $cmd = $self->quote_literal($cmd);
1720     $cmd = $self->escape_newlines($cmd);
1721
1722     # Switches must be quoted else they will be lowercased.
1723     $switches = join ' ', map { qq{"$_"} } @$switches;
1724
1725     return qq{\$(ABSPERLRUN) $switches -e $cmd};
1726 }
1727
1728
1729 =item B<echo>
1730
1731 perl trips up on "<foo>" thinking it's an input redirect.  So we use the
1732 native Write command instead.  Besides, its faster.
1733
1734 =cut
1735
1736 sub echo {
1737     my($self, $text, $file, $appending) = @_;
1738     $appending ||= 0;
1739
1740     my $opencmd = $appending ? 'Open/Append' : 'Open/Write';
1741
1742     my @cmds = ("\$(NOECHO) $opencmd MMECHOFILE $file ");
1743     push @cmds, map { '$(NOECHO) Write MMECHOFILE '.$self->quote_literal($_) }
1744                 split /\n/, $text;
1745     push @cmds, '$(NOECHO) Close MMECHOFILE';
1746     return @cmds;
1747 }
1748
1749
1750 =item quote_literal
1751
1752 =cut
1753
1754 sub quote_literal {
1755     my($self, $text) = @_;
1756
1757     # I believe this is all we should need.
1758     $text =~ s{"}{""}g;
1759
1760     return qq{"$text"};
1761 }
1762
1763 =item escape_newlines
1764
1765 =cut
1766
1767 sub escape_newlines {
1768     my($self, $text) = @_;
1769
1770     $text =~ s{\n}{-\n}g;
1771
1772     return $text;
1773 }
1774
1775 =item max_exec_len
1776
1777 256 characters.
1778
1779 =cut
1780
1781 sub max_exec_len {
1782     my $self = shift;
1783
1784     return $self->{_MAX_EXEC_LEN} ||= 256;
1785 }
1786
1787 =item init_linker
1788
1789 =cut
1790
1791 sub init_linker {
1792     my $self = shift;
1793     $self->{EXPORT_LIST} ||= '$(BASEEXT).opt';
1794
1795     my $shr = $Config{dbgprefix} . 'PERLSHR';
1796     if ($self->{PERL_SRC}) {
1797         $self->{PERL_ARCHIVE} ||=
1798           $self->catfile($self->{PERL_SRC}, "$shr.$Config{'dlext'}");
1799     }
1800     else {
1801         $self->{PERL_ARCHIVE} ||=
1802           $ENV{$shr} ? $ENV{$shr} : "Sys\$Share:$shr.$Config{'dlext'}";
1803     }
1804
1805     $self->{PERL_ARCHIVE_AFTER} ||= '';
1806 }
1807
1808 =item eliminate_macros
1809
1810 Expands MM[KS]/Make macros in a text string, using the contents of
1811 identically named elements of C<%$self>, and returns the result
1812 as a file specification in Unix syntax.
1813
1814 NOTE:  This is the canonical version of the method.  The version in
1815 File::Spec::VMS is deprecated.
1816
1817 =cut
1818
1819 sub eliminate_macros {
1820     my($self,$path) = @_;
1821     return '' unless $path;
1822     $self = {} unless ref $self;
1823
1824     if ($path =~ /\s/) {
1825       return join ' ', map { $self->eliminate_macros($_) } split /\s+/, $path;
1826     }
1827
1828     my($npath) = unixify($path);
1829     # sometimes unixify will return a string with an off-by-one trailing null
1830     $npath =~ s{\0$}{};
1831
1832     my($complex) = 0;
1833     my($head,$macro,$tail);
1834
1835     # perform m##g in scalar context so it acts as an iterator
1836     while ($npath =~ m#(.*?)\$\((\S+?)\)(.*)#gs) {
1837         if (defined $self->{$2}) {
1838             ($head,$macro,$tail) = ($1,$2,$3);
1839             if (ref $self->{$macro}) {
1840                 if (ref $self->{$macro} eq 'ARRAY') {
1841                     $macro = join ' ', @{$self->{$macro}};
1842                 }
1843                 else {
1844                     print "Note: can't expand macro \$($macro) containing ",ref($self->{$macro}),
1845                           "\n\t(using MMK-specific deferred substitutuon; MMS will break)\n";
1846                     $macro = "\cB$macro\cB";
1847                     $complex = 1;
1848                 }
1849             }
1850             else { ($macro = unixify($self->{$macro})) =~ s#/\Z(?!\n)##; }
1851             $npath = "$head$macro$tail";
1852         }
1853     }
1854     if ($complex) { $npath =~ s#\cB(.*?)\cB#\${$1}#gs; }
1855     $npath;
1856 }
1857
1858 =item fixpath
1859
1860    my $path = $mm->fixpath($path);
1861    my $path = $mm->fixpath($path, $is_dir);
1862
1863 Catchall routine to clean up problem MM[SK]/Make macros.  Expands macros
1864 in any directory specification, in order to avoid juxtaposing two
1865 VMS-syntax directories when MM[SK] is run.  Also expands expressions which
1866 are all macro, so that we can tell how long the expansion is, and avoid
1867 overrunning DCL's command buffer when MM[KS] is running.
1868
1869 fixpath() checks to see whether the result matches the name of a
1870 directory in the current default directory and returns a directory or
1871 file specification accordingly.  C<$is_dir> can be set to true to
1872 force fixpath() to consider the path to be a directory or false to force
1873 it to be a file.
1874
1875 NOTE:  This is the canonical version of the method.  The version in
1876 File::Spec::VMS is deprecated.
1877
1878 =cut
1879
1880 sub fixpath {
1881     my($self,$path,$force_path) = @_;
1882     return '' unless $path;
1883     $self = bless {} unless ref $self;
1884     my($fixedpath,$prefix,$name);
1885
1886     if ($path =~ /[ \t]/) {
1887       return join ' ',
1888              map { $self->fixpath($_,$force_path) }
1889              split /[ \t]+/, $path;
1890     }
1891
1892     if ($path =~ m#^\$\([^\)]+\)\Z(?!\n)#s || $path =~ m#[/:>\]]#) {
1893         if ($force_path or $path =~ /(?:DIR\)|\])\Z(?!\n)/) {
1894             $fixedpath = vmspath($self->eliminate_macros($path));
1895         }
1896         else {
1897             $fixedpath = vmsify($self->eliminate_macros($path));
1898         }
1899     }
1900     elsif ((($prefix,$name) = ($path =~ m#^\$\(([^\)]+)\)(.+)#s)) && $self->{$prefix}) {
1901         my($vmspre) = $self->eliminate_macros("\$($prefix)");
1902         # is it a dir or just a name?
1903         $vmspre = ($vmspre =~ m|/| or $prefix =~ /DIR\Z(?!\n)/) ? vmspath($vmspre) : '';
1904         $fixedpath = ($vmspre ? $vmspre : $self->{$prefix}) . $name;
1905         $fixedpath = vmspath($fixedpath) if $force_path;
1906     }
1907     else {
1908         $fixedpath = $path;
1909         $fixedpath = vmspath($fixedpath) if $force_path;
1910     }
1911     # No hints, so we try to guess
1912     if (!defined($force_path) and $fixedpath !~ /[:>(.\]]/) {
1913         $fixedpath = vmspath($fixedpath) if -d $fixedpath;
1914     }
1915
1916     # Trim off root dirname if it's had other dirs inserted in front of it.
1917     $fixedpath =~ s/\.000000([\]>])/$1/;
1918     # Special case for VMS absolute directory specs: these will have had device
1919     # prepended during trip through Unix syntax in eliminate_macros(), since
1920     # Unix syntax has no way to express "absolute from the top of this device's
1921     # directory tree".
1922     if ($path =~ /^[\[>][^.\-]/) { $fixedpath =~ s/^[^\[<]+//; }
1923
1924     return $fixedpath;
1925 }
1926
1927
1928 =item os_flavor
1929
1930 VMS is VMS.
1931
1932 =cut
1933
1934 sub os_flavor {
1935     return('VMS');
1936 }
1937
1938 =back
1939
1940
1941 =head1 AUTHOR
1942
1943 Original author Charles Bailey F<bailey@newman.upenn.edu>
1944
1945 Maintained by Michael G Schwern F<schwern@pobox.com>
1946
1947 See L<ExtUtils::MakeMaker> for patching and contact information.
1948
1949
1950 =cut
1951
1952 1;
1953