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