mm_vms.pm

ARM上的如果你对底层感兴趣

	    $quals =~ s/ -$type$def\s*//;
	    $def =~ s/"/""/g;
	    if    ($type eq 'D') { $definestr .= qq["$def",]; }
	    elsif ($type eq 'I') { $flagincstr .= ',' . $self->fixpath($def,1); }
	    else                 { $undefstr  .= qq["$def",]; }
	}
    }
    if (length $quals and $quals !~ m!/!) {
	warn "MM_VMS: Ignoring unrecognized CCFLAGS elements \"$quals\"\n";
	$quals = '';
    }
    if (length $definestr) { chop($definestr); $quals .= "/Define=($definestr)"; }
    if (length $undefstr)  { chop($undefstr);  $quals .= "/Undef=($undefstr)";   }
    # Deal with $self->{DEFINE} here since some C compilers pay attention
    # to only one /Define clause on command line, so we have to
    # conflate the ones from $Config{'ccflags'} and $self->{DEFINE}
    if ($quals =~ m:(.*)/define=\(?([^\(\/\)\s]+)\)?(.*)?:i) {
	$quals = "$1/Define=($2," . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
	         "\$(DEFINE_VERSION),\$(XS_DEFINE_VERSION))$3";
    }
    else {
	$quals .= '/Define=(' . ($self->{DEFINE} ? "$self->{DEFINE}," : '') .
	          '$(DEFINE_VERSION),$(XS_DEFINE_VERSION))';
    }

    $libperl or $libperl = $self->{LIBPERL_A} || "libperl.olb";
# This whole section is commented out, since I don't think it's necessary (or applicable)
#    if ($libperl =~ s/^$Config{'dbgprefix'}//) { $libperl =~ s/perl([^Dd]*)\./perld$1./; }
#    if ($libperl =~ /libperl(\w+)\./i) {
#	my($type) = uc $1;
#	my(%map) = ( 'D'  => 'DEBUGGING', 'E' => 'EMBED', 'M' => 'MULTIPLICITY',
#	             'DE' => 'DEBUGGING,EMBED', 'DM' => 'DEBUGGING,MULTIPLICITY',
#	             'EM' => 'EMBED,MULTIPLICITY', 'DEM' => 'DEBUGGING,EMBED,MULTIPLICITY' );
#	my($add) = join(',', grep { $quals !~ /\b$_\b/ } split(/,/,$map{$type}));
#	$quals =~ s:/define=\(([^\)]+)\):/Define=($1,$add):i if $add;
#	$self->{PERLTYPE} ||= $type;
#    }

    # Likewise with $self->{INC} and /Include
    if ($self->{'INC'}) {
	my(@includes) = split(/\s+/,$self->{INC});
	foreach (@includes) {
	    s/^-I//;
	    $incstr .= ', '.$self->fixpath($_,1);
	}
    }
    $quals .= "$incstr)";
    $self->{CCFLAGS} = $quals;

    $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'};
    if ($self->{OPTIMIZE} !~ m!/!) {
	if    ($self->{OPTIMIZE} =~ m!\b-g\b!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' }
	elsif ($self->{OPTIMIZE} =~ /-O(\d*)/) {
	    $self->{OPTIMIZE} = '/Optimize' . (defined($1) ? "=$1" : '');
	}
	else {
	    warn "MM_VMS: Can't parse OPTIMIZE \"$self->{OPTIMIZE}\"; using default\n" if length $self->{OPTIMIZE};
	    $self->{OPTIMIZE} = '/Optimize';
	}
    }

    return $self->{CFLAGS} = qq{
CCFLAGS = $self->{CCFLAGS}
OPTIMIZE = $self->{OPTIMIZE}
PERLTYPE = $self->{PERLTYPE}
SPLIT =
LARGE =
};
}

=item const_cccmd (override)

Adds directives to point C preprocessor to the right place when
handling #include E<lt>sys/foo.hE<gt> directives.  Also constructs CC
command line a bit differently than MM_Unix method.

=cut

sub const_cccmd {
    my($self,$libperl) = @_;
    my(@m);

    return $self->{CONST_CCCMD} if $self->{CONST_CCCMD};
    return '' unless $self->needs_linking();
    if ($Config{'vms_cc_type'} eq 'gcc') {
        push @m,'
.FIRST
	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" Then Define/NoLog SYS GNU_CC_Include:[VMS]';
    }
    elsif ($Config{'vms_cc_type'} eq 'vaxc') {
        push @m,'
.FIRST
	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").eqs."" Then Define/NoLog SYS Sys$Library
	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("VAXC$Include").nes."" Then Define/NoLog SYS VAXC$Include';
    }
    else {
        push @m,'
.FIRST
	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").eqs."" Then Define/NoLog SYS ',
		($Config{'arch'} eq 'VMS_AXP' ? 'Sys$Library' : 'DECC$Library_Include'),'
	',$self->{NOECHO},'If F$TrnLnm("Sys").eqs."" .and. F$TrnLnm("DECC$System_Include").nes."" Then Define/NoLog SYS DECC$System_Include';
    }

    push(@m, "\n\nCCCMD = $Config{'cc'} \$(CCFLAGS)\$(OPTIMIZE)\n");

    $self->{CONST_CCCMD} = join('',@m);
}

=item pm_to_blib (override)

DCL I<still> accepts a maximum of 255 characters on a command
line, so we write the (potentially) long list of file names
to a temp file, then persuade Perl to read it instead of the
command line to find args.

=cut

sub pm_to_blib {
    my($self) = @_;
    my($line,$from,$to,@m);
    my($autodir) = $self->catdir('$(INST_LIB)','auto');
    my(@files) = @{$self->{PM_TO_BLIB}};

    push @m, q{

# Dummy target to match Unix target name; we use pm_to_blib.ts as
# timestamp file to avoid repeated invocations under VMS
pm_to_blib : pm_to_blib.ts
	$(NOECHO) $(NOOP)

# As always, keep under DCL's 255-char limit
pm_to_blib.ts : $(TO_INST_PM)
	$(NOECHO) $(PERL) -e "print '},shift(@files),q{ },shift(@files),q{'" >.MM_tmp
};

    $line = '';  # avoid uninitialized var warning
    while ($from = shift(@files),$to = shift(@files)) {
	$line .= " $from $to";
	if (length($line) > 128) {
	    push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n");
	    $line = '';
	}
    }
    push(@m,"\t\$(NOECHO) \$(PERL) -e \"print '$line'\" >>.MM_tmp\n") if $line;

    push(@m,q[	$(PERL) "-I$(PERL_LIB)" "-MExtUtils::Install" -e "pm_to_blib({split(' ',<STDIN>)},'].$autodir.q[')" <.MM_tmp]);
    push(@m,qq[
	\$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;
	\$(NOECHO) \$(TOUCH) pm_to_blib.ts
]);

    join('',@m);
}

=item tool_autosplit (override)

Use VMS-style quoting on command line.

=cut

sub tool_autosplit{
    my($self, %attribs) = @_;
    my($asl) = "";
    $asl = "\$AutoSplit::Maxlen=$attribs{MAXLEN};" if $attribs{MAXLEN};
    q{
# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use AutoSplit;}.$asl.q{ AutoSplit::autosplit($ARGV[0], $ARGV[1], 0, 1, 1) ;"
};
}

=item tool_sxubpp (override)

Use VMS-style quoting on xsubpp command line.

=cut

sub tool_xsubpp {
    my($self) = @_;
    return '' unless $self->needs_linking;
    my($xsdir) = $self->catdir($self->{PERL_LIB},'ExtUtils');
    # drop back to old location if xsubpp is not in new location yet
    $xsdir = $self->catdir($self->{PERL_SRC},'ext') unless (-f $self->catfile($xsdir,'xsubpp'));
    my(@tmdeps) = '$(XSUBPPDIR)typemap';
    if( $self->{TYPEMAPS} ){
	my $typemap;
	foreach $typemap (@{$self->{TYPEMAPS}}){
		if( ! -f  $typemap ){
			warn "Typemap $typemap not found.\n";
		}
		else{
			push(@tmdeps, $self->fixpath($typemap,0));
		}
	}
    }
    push(@tmdeps, "typemap") if -f "typemap";
    my(@tmargs) = map("-typemap $_", @tmdeps);
    if( exists $self->{XSOPT} ){
	unshift( @tmargs, $self->{XSOPT} );
    }

    my $xsubpp_version = $self->xsubpp_version($self->catfile($xsdir,'xsubpp'));

    # What are the correct thresholds for version 1 && 2 Paul?
    if ( $xsubpp_version > 1.923 ){
	$self->{XSPROTOARG} = '' unless defined $self->{XSPROTOARG};
    } else {
	if (defined $self->{XSPROTOARG} && $self->{XSPROTOARG} =~ /\-prototypes/) {
	    print STDOUT qq{Warning: This extension wants to pass the switch "-prototypes" to xsubpp.
	Your version of xsubpp is $xsubpp_version and cannot handle this.
	Please upgrade to a more recent version of xsubpp.
};
	} else {
	    $self->{XSPROTOARG} = "";
	}
    }

    "
XSUBPPDIR = $xsdir
XSUBPP = \$(PERL) \"-I\$(PERL_ARCHLIB)\" \"-I\$(PERL_LIB)\" \$(XSUBPPDIR)xsubpp
XSPROTOARG = $self->{XSPROTOARG}
XSUBPPDEPS = @tmdeps
XSUBPPARGS = @tmargs
";
}

=item xsubpp_version (override)

Test xsubpp exit status according to VMS rules ($sts & 1 ==E<gt> good)
rather than Unix rules ($sts == 0 ==E<gt> good).

=cut

sub xsubpp_version
{
    my($self,$xsubpp) = @_;
    my ($version) ;
    return '' unless $self->needs_linking;

    # try to figure out the version number of the xsubpp on the system

    # first try the -v flag, introduced in 1.921 & 2.000a2

    my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v";
    print "Running: $command\n" if $Verbose;
    $version = `$command` ;
    if ($?) {
	use vmsish 'status';
	warn "Running '$command' exits with status $?";
    }
    chop $version ;

    return $1 if $version =~ /^xsubpp version (.*)/ ;

    # nope, then try something else

    my $counter = '000';
    my ($file) = 'temp' ;
    $counter++ while -e "$file$counter"; # don't overwrite anything
    $file .= $counter;

    local(*F);
    open(F, ">$file") or die "Cannot open file '$file': $!\n" ;
    print F <<EOM ;
MODULE = fred PACKAGE = fred

int
fred(a)
	int	a;
EOM

    close F ;

    $command = "$self->{PERL} $xsubpp $file";
    print "Running: $command\n" if $Verbose;
    my $text = `$command` ;
    if ($?) {
	use vmsish 'status';
	warn "Running '$command' exits with status $?";
    }
    unlink $file ;

    # gets 1.2 -> 1.92 and 2.000a1
    return $1 if $text =~ /automatically by xsubpp version ([\S]+)\s*/  ;

    # it is either 1.0 or 1.1
    return 1.1 if $text =~ /^Warning: ignored semicolon/ ;

    # none of the above, so 1.0
    return "1.0" ;
}

=item tools_other (override)

Adds a few MM[SK] macros, and shortens some the installatin commands,
in order to stay under DCL's 255-character limit.  Also changes
EQUALIZE_TIMESTAMP to set revision date of target file to one second
later than source file, since MMK interprets precisely equal revision
dates for a source and target file as a sign that the target needs
to be updated.

=cut

sub tools_other {
    my($self) = @_;
    qq!
# Assumes \$(MMS) invokes MMS or MMK
# (It is assumed in some cases later that the default makefile name
# (Descrip.MMS for MM[SK]) is used.)
USEMAKEFILE = /Descrip=
USEMACROS = /Macro=(
MACROEND = )
MAKEFILE = Descrip.MMS
SHELL = Posix
TOUCH = $self->{TOUCH}
CHMOD = $self->{CHMOD}
CP = $self->{CP}
MV = $self->{MV}
RM_F  = $self->{RM_F}
RM_RF = $self->{RM_RF}
SAY = Write Sys\$Output
UMASK_NULL = $self->{UMASK_NULL}
NOOP = $self->{NOOP}
NOECHO = $self->{NOECHO}
MKPATH = Create/Directory
EQUALIZE_TIMESTAMP = \$(PERL) -we "open F,qq{>\$ARGV[1]};close F;utime(0,(stat(\$ARGV[0]))[9]+1,\$ARGV[1])"
!. ($self->{PARENT} ? '' : 
qq!WARN_IF_OLD_PACKLIST = \$(PERL) -e "if (-f \$ARGV[0]){print qq[WARNING: Old package found (\$ARGV[0]); please check for collisions\\n]}"
MOD_INSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "install({split(' ',<STDIN>)},1);"
DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,<STDIN>);print '=head2 ',scalar(localtime),': C<',shift,qq[>\\n\\n=over 4\\n\\n];while(\$key=shift && \$val=shift){print qq[=item *\\n\\nC<\$key: \$val>\\n\\n];}print qq[=back\\n\\n]"
UNINSTALL = \$(PERL) "-I\$(PERL_LIB)" "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);"
!);
}

=item dist (override)

Provide VMSish defaults for some values, then hand off to
default MM_Unix method.

=cut

sub dist {
    my($self, %attribs) = @_;
    $attribs{VERSION}      ||= $self->{VERSION_SYM};
    $attribs{NAME}         ||= $self->{DISTNAME};
    $attribs{ZIPFLAGS}     ||= '-Vu';
    $attribs{COMPRESS}     ||= 'gzip';
    $attribs{SUFFIX}       ||= '-gz';
    $attribs{SHAR}         ||= 'vms_share';
    $attribs{DIST_DEFAULT} ||= 'zipdist';

    # Sanitize these for use in $(DISTVNAME) filespec
    $attribs{VERSION} =~ s/[^\w\$]/_/g;
    $attribs{NAME} =~ s/[^\w\$]/_/g;

    return ExtUtils::MM_Unix::dist($self,%attribs);
}

=item c_o (override)

Use VMS syntax on command line.  In particular, $(DEFINE) and
$(PERL_INC) have been pulled into $(CCCMD).  Also use MM[SK] macros.

=cut

sub c_o {
    my($self) = @_;
    return '' unless $self->needs_linking();
    '
.c$(OBJ_EXT) :
	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c

.cpp$(OBJ_EXT) :
	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cpp

.cxx$(OBJ_EXT) :
	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).cxx

';
}

=item xs_c (override)

Use MM[SK] macros.

=cut

sub xs_c {
    my($self) = @_;
    return '' unless $self->needs_linking();
    '
.xs.c :
	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET)
';
}

=item xs_o (override)

Use MM[SK] macros, and VMS command line for C compiler.

=cut

sub xs_o {	# many makes are too dumb to use xs_c then c_o
    my($self) = @_;
    return '' unless $self->needs_linking();
    '
.xs$(OBJ_EXT) :
	$(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $(MMS$TARGET_NAME).xs >$(MMS$TARGET_NAME).c
	$(CCCMD) $(CCCDLFLAGS) $(MMS$TARGET_NAME).c
';
}

=item top_targets (override)

Use VMS quoting on command line for Version_check.