mm_vms.pm

UNIX下perl实现代码

sub dynamic_bs {
    my($self, %attribs) = @_;
    return '
BOOTSTRAP =
' unless $self->has_link_code();
    '
BOOTSTRAP = '."$self->{BASEEXT}.bs".'

# As MakeMaker mkbootstrap might not write a file (if none is required)
# we use touch to prevent make continually trying to remake it.
# The DynaLoader only reads a non-empty file.
$(BOOTSTRAP) : $(MAKEFILE) '."$self->{BOOTDEP}".' $(INST_ARCHAUTODIR).exists
	$(NOECHO) $(SAY) "Running mkbootstrap for $(NAME) ($(BSLOADLIBS))"
	$(NOECHO) $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -
	-e "use ExtUtils::Mkbootstrap; Mkbootstrap(\'$(BASEEXT)\',\'$(BSLOADLIBS)\');"
	$(NOECHO) $(TOUCH) $(MMS$TARGET)

$(INST_BOOT) : $(BOOTSTRAP) $(INST_ARCHAUTODIR).exists
	$(NOECHO) $(RM_RF) $(INST_BOOT)
	- $(CP) $(BOOTSTRAP) $(INST_BOOT)
';
}

=item static_lib (override)

Use VMS commands to manipulate object library.

=cut

sub static_lib {
    my($self) = @_;
    return '' unless $self->needs_linking();

    return '
$(INST_STATIC) :
	$(NOECHO) $(NOOP)
' unless ($self->{OBJECT} or @{$self->{C} || []} or $self->{MYEXTLIB});

    my(@m,$lib);
    push @m,'
# Rely on suffix rule for update action
$(OBJECT) : $(INST_ARCHAUTODIR).exists

$(INST_STATIC) : $(OBJECT) $(MYEXTLIB)
';
    # If this extension has it's own library (eg SDBM_File)
    # then copy that to $(INST_STATIC) and add $(OBJECT) into it.
    push(@m, "\t",'$(CP) $(MYEXTLIB) $(MMS$TARGET)',"\n") if $self->{MYEXTLIB};

    push(@m,"\t",'If F$Search("$(MMS$TARGET)").eqs."" Then Library/Object/Create $(MMS$TARGET)',"\n");

    # if there was a library to copy, then we can't use MMS$SOURCE_LIST,
    # 'cause it's a library and you can't stick them in other libraries.
    # In that case, we use $OBJECT instead and hope for the best
    if ($self->{MYEXTLIB}) {
      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(OBJECT)',"\n"); 
    } else {
      push(@m,"\t",'Library/Object/Replace $(MMS$TARGET) $(MMS$SOURCE_LIST)',"\n");
    }
    
    push @m, "\t\$(NOECHO) \$(PERL) -e 1 >\$(INST_ARCHAUTODIR)extralibs.ld\n";
    foreach $lib (split ' ', $self->{EXTRALIBS}) {
      push(@m,"\t",'$(NOECHO) $(PERL) -e "print qq{',$lib,'\n}" >>$(INST_ARCHAUTODIR)extralibs.ld',"\n");
    }
    push @m, $self->dir_target('$(INST_ARCHAUTODIR)');
    join('',@m);
}


=item manifypods (override)

Use VMS-style quoting on command line, and VMS logical name
to specify fallback location at build time if we can't find pod2man.

=cut


sub manifypods {
    my($self, %attribs) = @_;
    return "\nmanifypods :\n\t\$(NOECHO) \$(NOOP)\n" unless %{$self->{MAN3PODS}} or %{$self->{MAN1PODS}};
    my($dist);
    my($pod2man_exe);
    if (defined $self->{PERL_SRC}) {
	$pod2man_exe = $self->catfile($self->{PERL_SRC},'pod','pod2man');
    } else {
	$pod2man_exe = $self->catfile($Config{scriptdirexp},'pod2man');
    }
    if (not ($pod2man_exe = $self->perl_script($pod2man_exe))) {
	# No pod2man but some MAN3PODS to be installed
	print <<END;

Warning: I could not locate your pod2man program.  As a last choice,
         I will look for the file to which the logical name POD2MAN
         points when MMK is invoked.

END
        $pod2man_exe = "pod2man";
    }
    my(@m);
    push @m,
qq[POD2MAN_EXE = $pod2man_exe\n],
q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" -
-e "system(""MCR $^X $(POD2MAN_EXE) $_ >$m{$_}"");}"
];
    push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n";
    if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) {
	my($pod);
	foreach $pod (sort keys %{$self->{MAN1PODS}}) {
	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
	    push @m, "$pod $self->{MAN1PODS}{$pod}\n";
	}
	foreach $pod (sort keys %{$self->{MAN3PODS}}) {
	    push @m, qq[\t\@- If F\$Search("\$(POD2MAN_EXE)").nes."" Then \$(POD2MAN) ];
	    push @m, "$pod $self->{MAN3PODS}{$pod}\n";
	}
    }
    join('', @m);
}

=item processPL (override)

Use VMS-style quoting on command line.

=cut

sub processPL {
    my($self) = @_;
    return "" unless $self->{PL_FILES};
    my(@m, $plfile);
    foreach $plfile (sort keys %{$self->{PL_FILES}}) {
        my $list = ref($self->{PL_FILES}->{$plfile})
		? $self->{PL_FILES}->{$plfile}
		: [$self->{PL_FILES}->{$plfile}];
	foreach $target (@$list) {
	    my $vmsplfile = vmsify($plfile);
	    my $vmsfile = vmsify($target);
	    push @m, "
all :: $vmsfile
	\$(NOECHO) \$(NOOP)

$vmsfile :: $vmsplfile
",'	$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" '," $vmsplfile $vmsfile
";
	}
    }
    join "", @m;
}

=item installbin (override)

Stay under DCL's 255 character command line limit once again by
splitting potentially long list of files across multiple lines
in C<realclean> target.

=cut

sub installbin {
    my($self) = @_;
    return '' unless $self->{EXE_FILES} && ref $self->{EXE_FILES} eq "ARRAY";
    return '' unless @{$self->{EXE_FILES}};
    my(@m, $from, $to, %fromto, @to, $line);
    my(@exefiles) = map { vmsify($_) } @{$self->{EXE_FILES}};
    for $from (@exefiles) {
	my($path) = '$(INST_SCRIPT)' . basename($from);
	local($_) = $path;  # backward compatibility
	$to = $self->libscan($path);
	print "libscan($from) => '$to'\n" if ($Verbose >=2);
	$fromto{$from} = vmsify($to);
    }
    @to = values %fromto;
    push @m, "
EXE_FILES = @exefiles

all :: @to
	\$(NOECHO) \$(NOOP)

realclean ::
";
    $line = '';  #avoid unitialized var warning
    foreach $to (@to) {
	if (length($line) + length($to) > 80) {
	    push @m, "\t\$(RM_F) $line\n";
	    $line = $to;
	}
	else { $line .= " $to"; }
    }
    push @m, "\t\$(RM_F) $line\n\n" if $line;

    while (($from,$to) = each %fromto) {
	last unless defined $from;
	my $todir;
	if ($to =~ m#[/>:\]]#) { $todir = dirname($to); }
	else                   { ($todir = $to) =~ s/[^\)]+$//; }
	$todir = $self->fixpath($todir,1);
	push @m, "
$to : $from \$(MAKEFILE) ${todir}.exists
	\$(CP) $from $to

", $self->dir_target($todir);
    }
    join "", @m;
}

=item subdir_x (override)

Use VMS commands to change default directory.

=cut

sub subdir_x {
    my($self, $subdir) = @_;
    my(@m,$key);
    $subdir = $self->fixpath($subdir,1);
    push @m, '

subdirs ::
	olddef = F$Environment("Default")
	Set Default ',$subdir,'
	- $(MMS)$(MMSQUALIFIERS) all $(USEMACROS)$(PASTHRU)$(MACROEND)
	Set Default \'olddef\'
';
    join('',@m);
}

=item clean (override)

Split potentially long list of files across multiple commands (in
order to stay under the magic command line limit).  Also use MM[SK]
commands for handling subdirectories.

=cut

sub clean {
    my($self, %attribs) = @_;
    my(@m,$dir);
    push @m, '
# Delete temporary files but do not touch installed files. We don\'t delete
# the Descrip.MMS here so that a later make realclean still has it to use.
clean ::
';
    foreach $dir (@{$self->{DIR}}) { # clean subdirectories first
	my($vmsdir) = $self->fixpath($dir,1);
	push( @m, '	If F$Search("'.$vmsdir.'$(MAKEFILE)").nes."" Then \\',"\n\t",
	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) clean`;"',"\n");
    }
    push @m, '	$(RM_F) *.Map *.Dmp *.Lis *.cpp *.$(DLEXT) *$(OBJ_EXT) *$(LIB_EXT) *.Opt $(BOOTSTRAP) $(BASEEXT).bso .MM_Tmp
';

    my(@otherfiles) = values %{$self->{XS}}; # .c files from *.xs files
    # Unlink realclean, $attribs{FILES} is a string here; it may contain
    # a list or a macro that expands to a list.
    if ($attribs{FILES}) {
	my($word,$key,@filist);
	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
	else { @filist = split /\s+/, $attribs{FILES}; }
	foreach $word (@filist) {
	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
		push(@otherfiles, @{$self->{$key}});
	    }
	    else { push(@otherfiles, $word); }
	}
    }
    push(@otherfiles, qw[ blib $(MAKE_APERL_FILE) extralibs.ld perlmain.c pm_to_blib.ts ]);
    push(@otherfiles,$self->catfile('$(INST_ARCHAUTODIR)','extralibs.all'));
    my($file,$line);
    $line = '';  #avoid unitialized var warning
    # Occasionally files are repeated several times from different sources
    { my(%of) = map { ($_,1) } @otherfiles; @otherfiles = keys %of; }
    
    foreach $file (@otherfiles) {
	$file = $self->fixpath($file);
	if (length($line) + length($file) > 80) {
	    push @m, "\t\$(RM_RF) $line\n";
	    $line = "$file";
	}
	else { $line .= " $file"; }
    }
    push @m, "\t\$(RM_RF) $line\n" if $line;
    push(@m, "	$attribs{POSTOP}\n") if $attribs{POSTOP};
    join('', @m);
}

=item realclean (override)

Guess what we're working around?  Also, use MM[SK] for subdirectories.

=cut

sub realclean {
    my($self, %attribs) = @_;
    my(@m);
    push(@m,'
# Delete temporary files (via clean) and also delete installed files
realclean :: clean
');
    foreach(@{$self->{DIR}}){
	my($vmsdir) = $self->fixpath($_,1);
	push(@m, '	If F$Search("'."$vmsdir".'$(MAKEFILE)").nes."" Then \\',"\n\t",
	      '$(PERL) -e "chdir ',"'$vmsdir'",'; print `$(MMS)$(MMSQUALIFIERS) realclean`;"',"\n");
    }
    push @m,'	$(RM_RF) $(INST_AUTODIR) $(INST_ARCHAUTODIR)
';
    # We can't expand several of the MMS macros here, since they don't have
    # corresponding %$self keys (i.e. they're defined in Descrip.MMS as a
    # combination of macros).  In order to stay below DCL's 255 char limit,
    # we put only 2 on a line.
    my($file,$line,$fcnt);
    my(@files) = qw{ $(MAKEFILE) $(MAKEFILE)_old };
    if ($self->has_link_code) {
	push(@files,qw{ $(INST_DYNAMIC) $(INST_STATIC) $(INST_BOOT) $(OBJECT) });
    }
    push(@files, values %{$self->{PM}});
    $line = '';  #avoid unitialized var warning
    # Occasionally files are repeated several times from different sources
    { my(%f) = map { ($_,1) } @files; @files = keys %f; }
    foreach $file (@files) {
	$file = $self->fixpath($file);
	if (length($line) + length($file) > 80 || ++$fcnt >= 2) {
	    push @m, "\t\$(RM_F) $line\n";
	    $line = "$file";
	    $fcnt = 0;
	}
	else { $line .= " $file"; }
    }
    push @m, "\t\$(RM_F) $line\n" if $line;
    if ($attribs{FILES}) {
	my($word,$key,@filist,@allfiles);
	if (ref $attribs{FILES} eq 'ARRAY') { @filist = @{$attribs{FILES}}; }
	else { @filist = split /\s+/, $attribs{FILES}; }
	foreach $word (@filist) {
	    if (($key) = $word =~ m#^\$\((.*)\)$# and ref $self->{$key} eq 'ARRAY') {
		push(@allfiles, @{$self->{$key}});
	    }
	    else { push(@allfiles, $word); }
	}
	$line = '';
	# Occasionally files are repeated several times from different sources
	{ my(%af) = map { ($_,1) } @allfiles; @allfiles = keys %af; }
	foreach $file (@allfiles) {
	    $file = $self->fixpath($file);
	    if (length($line) + length($file) > 80) {
		push @m, "\t\$(RM_RF) $line\n";
		$line = "$file";
	    }
	    else { $line .= " $file"; }
	}
	push @m, "\t\$(RM_RF) $line\n" if $line;
    }
    push(@m, "	$attribs{POSTOP}\n")                     if $attribs{POSTOP};
    join('', @m);
}

=item dist_basics (override)

Use VMS-style quoting on command line.

=cut

sub dist_basics {
    my($self) = @_;
'
distclean :: realclean distcheck
	$(NOECHO) $(NOOP)

distcheck :
	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&fullcheck\'; fullcheck()"

skipcheck :
	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&skipcheck\'; skipcheck()"

manifest :
	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest \'&mkmanifest\'; mkmanifest()"
';
}

=item dist_core (override)

Syntax for invoking F<VMS_Share> differs from that for Unix F<shar>,
so C<shdist> target actions are VMS-specific.

=cut

sub dist_core {
    my($self) = @_;
q[
dist : $(DIST_DEFAULT)
	$(NOECHO) $(PERL) -le "print 'Warning: $m older than $vf' if -e ($vf = '$(VERSION_FROM)') && -M $vf < -M ($m = '$(MAKEFILE)')"

zipdist : $(DISTVNAME).zip
	$(NOECHO) $(NOOP)

tardist : $(DISTVNAME).tar$(SUFFIX)
	$(NOECHO) $(NOOP)

$(DISTVNAME).zip : distdir
	$(PREOP)
	$(ZIP) "$(ZIPFLAGS)" $(MMS$TARGET) [.$(DISTVNAME)...]*.*;
	$(RM_RF) $(DISTVNAME)
	$(POSTOP)

$(DISTVNAME).tar$(SUFFIX) : distdir
	$(PREOP)
	$(TO_UNIX)
        $(TAR) "$(TARFLAGS)" $(DISTVNAME).tar [.$(DISTVNAME)...]
	$(RM_RF) $(DISTVNAME)
	$(COMPRESS) $(DISTVNAME).tar
	$(POSTOP)

shdist : distdir
	$(PREOP)
	$(SHAR) [.$(DISTVNAME...]*.*; $(DISTVNAME).share
	$(RM_RF) $(DISTVNAME)
	$(POSTOP)
];
}

=item dist_dir (override)

Use VMS-style quoting on command line.

=cut

sub dist_dir {
    my($self) = @_;
q{
distdir :
	$(RM_RF) $(DISTVNAME)
	$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e "use ExtUtils::Manifest '/mani/';" \\