| 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 invokation 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 | |