X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FExtUtils%2FMM_VMS.pm;h=d3c9ede1a6d40ff688129affb4fea23bb4890974;hb=3ced61113f9085f589ca2d7c37e33eee7d8f51b9;hp=6cbb6529df17a757579e4825746edbdc07fa467a;hpb=f6d6199cd6711f5e8a8e6c1a57445fa6f848c822;p=p5sagit%2Fp5-mst-13.2.git diff --git a/lib/ExtUtils/MM_VMS.pm b/lib/ExtUtils/MM_VMS.pm index 6cbb652..d3c9ede 100644 --- a/lib/ExtUtils/MM_VMS.pm +++ b/lib/ExtUtils/MM_VMS.pm @@ -14,7 +14,7 @@ use VMS::Filespec; use File::Basename; use File::Spec; use vars qw($Revision @ISA $VERSION); -($VERSION) = $Revision = '5.61_01'; +($VERSION) = $Revision = '5.63_01'; require ExtUtils::MM_Any; require ExtUtils::MM_Unix; @@ -332,6 +332,20 @@ sub replace_manpage_separator { $man; } +=item init_main (override) + +Override DISTVNAME so it uses VERSION_SYM to avoid getting too many +dots in the name. + +=cut + +sub init_main { + my($self) = shift; + + $self->SUPER::init_main; + $self->{DISTVNAME} = "$self->{DISTNAME}-$self->{VERSION_SYM}"; +} + =item init_others (override) Provide VMS-specific forms of various utility commands, then hand @@ -348,7 +362,7 @@ sub init_others { $self->{MAKEFILE} ||= $self->{FIRST_MAKEFILE}; $self->{NOECHO} ||= '@ '; $self->{RM_F} = '$(PERL) -e "foreach (@ARGV) { 1 while ( -d $_ ? rmdir $_ : unlink $_)}"'; - $self->{RM_RF} = '$(PERL) "-I$(PERL_LIB)" -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"'; + $self->{RM_RF} = '$(PERLRUN) -e "use File::Path; @dirs = map(VMS::Filespec::unixify($_),@ARGV); rmtree(\@dirs,0,0)"'; $self->{TOUCH} = '$(PERL) -e "$t=time; foreach (@ARGV) { -e $_ ? utime($t,$t,@ARGV) : (open(F,qq(>$_)),close F)}"'; $self->{CHMOD} = '$(PERL) -e "chmod @ARGV"'; # expect Unix syntax from MakeMaker $self->{CP} = 'Copy/NoConfirm'; @@ -373,6 +387,7 @@ sub constants { # Be kind about case for pollution for (@ARGV) { $_ = uc($_) if /POLLUTE/i; } + $self->{DEFINE} ||= ''; if ($self->{DEFINE} ne '') { my(@terms) = split(/\s+/,$self->{DEFINE}); my(@defs,@udefs); @@ -391,8 +406,12 @@ sub constants { push @$targ, $def; } $self->{DEFINE} = ''; - if (@defs) { $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; } - if (@udefs) { $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; } + if (@defs) { + $self->{DEFINE} = '/Define=(' . join(',',@defs) . ')'; + } + if (@udefs) { + $self->{DEFINE} .= '/Undef=(' . join(',',@udefs) . ')'; + } } if ($self->{OBJECT} =~ /\s/) { @@ -403,12 +422,16 @@ sub constants { foreach $macro ( qw [ - INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB INST_EXE INSTALLPRIVLIB - INSTALLARCHLIB INSTALLSCRIPT INSTALLBIN PERL_LIB PERL_ARCHLIB - PERL_INC PERL_SRC FULLEXT INST_MAN1DIR INSTALLMAN1DIR - INST_MAN3DIR INSTALLMAN3DIR INSTALLSITELIB INSTALLSITEARCH - SITELIBEXP SITEARCHEXP ] ) { + INST_BIN INST_SCRIPT INST_LIB INST_ARCHLIB + INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB + INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH + INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT + INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR + INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR + PERL_LIB PERL_ARCHLIB + PERL_INC PERL_SRC FULLEXT ] ) { next unless defined $self->{$macro}; + next if $macro =~ /MAN/ && $self->{$macro} eq 'none'; $self->{$macro} = $self->fixpath($self->{$macro},1); } $self->{PERL_VMS} = File::Spec->catdir($self->{PERL_SRC},q(VMS)) @@ -423,14 +446,21 @@ sub constants { } foreach $macro (qw/ - AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM XS_VERSION - INST_BIN INST_EXE INST_LIB INST_ARCHLIB INST_SCRIPT PREFIX - INSTALLDIRS INSTALLPRIVLIB INSTALLARCHLIB INSTALLSITELIB - INSTALLSITEARCH INSTALLBIN INSTALLSCRIPT PERL_LIB - PERL_ARCHLIB SITELIBEXP SITEARCHEXP LIBPERL_A MYEXTLIB + AR_STATIC_ARGS NAME DISTNAME NAME_SYM VERSION VERSION_SYM + XS_VERSION + INST_BIN INST_LIB INST_ARCHLIB INST_SCRIPT + INSTALLDIRS + PREFIX SITEPREFIX VENDORPREFIX + INSTALLPRIVLIB INSTALLSITELIB INSTALLVENDORLIB + INSTALLARCHLIB INSTALLSITEARCH INSTALLVENDORARCH + INSTALLBIN INSTALLSITEBIN INSTALLVENDORBIN INSTALLSCRIPT + PERL_LIB PERL_ARCHLIB + SITELIBEXP SITEARCHEXP + LIBPERL_A MYEXTLIB FIRST_MAKEFILE MAKE_APERL_FILE PERLMAINCC PERL_SRC PERL_VMS - PERL_INC PERL FULLPERL PERLRUN PERLRUNINST TEST_LIBS - PERL_CORE NOECHO NOOP + PERL_INC PERL FULLPERL PERLRUN FULLPERLRUN PERLRUNINST + FULLPERLRUNINST ABSPERL ABSPERLRUN ABSPERLRUNINST + PERL_CORE NOECHO NOOP / ) { next unless defined $self->{$macro}; push @m, "$macro = $self->{$macro}\n"; @@ -500,7 +530,10 @@ MAN3PODS = ',$self->wraplist(sort keys %{$self->{MAN3PODS}}),' '; for my $tmp (qw/ - INST_MAN1DIR INSTALLMAN1DIR MAN1EXT INST_MAN3DIR INSTALLMAN3DIR MAN3EXT + INST_MAN1DIR MAN1EXT + INSTALLMAN1DIR INSTALLSITEMAN1DIR INSTALLVENDORMAN1DIR + INST_MAN3DIR MAN3EXT + INSTALLMAN3DIR INSTALLSITEMAN3DIR INSTALLVENDORMAN3DIR /) { next unless defined $self->{$tmp}; push @m, "$tmp = $self->{$tmp}\n"; @@ -631,6 +664,8 @@ sub cflags { # $quals =~ s/,,/,/g; $quals =~ s/\(,/(/g; $self->{CCFLAGS} = $quals; + $self->{PERLTYPE} ||= ''; + $self->{OPTIMIZE} ||= $flagoptstr || $Config{'optimize'}; if ($self->{OPTIMIZE} !~ m!/!) { if ($self->{OPTIMIZE} =~ m!-g!) { $self->{OPTIMIZE} = '/Debug/NoOptimize' } @@ -647,8 +682,6 @@ sub cflags { CCFLAGS = $self->{CCFLAGS} OPTIMIZE = $self->{OPTIMIZE} PERLTYPE = $self->{PERLTYPE} -SPLIT = -LARGE = }; } @@ -681,7 +714,7 @@ sub const_cccmd { 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'),' + ($Config{'archname'} 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'; } @@ -714,24 +747,26 @@ pm_to_blib : pm_to_blib.ts # 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)) { + if (scalar(@files) > 0) { # protect ourselves from empty PM_TO_BLIB + + push(@m,qq[\t\$(NOECHO) \$(RM_F) .MM_tmp\n]); + $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,"\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(' ',)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]); - push(@m,qq[ - \$(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; - \$(NOECHO) \$(TOUCH) pm_to_blib.ts -]); + push(@m,q[ $(PERLRUN) "-MExtUtils::Install" -e "pm_to_blib({split(' ',)},'].$autodir.q[','$(PM_FILTER)')" <.MM_tmp]); + push(@m,qq[\n\t\$(NOECHO) \$(RM_F) .MM_tmp\n]); + + } + push(@m,qq[\t\$(NOECHO) \$(TOUCH) pm_to_blib.ts]); join('',@m); } @@ -829,7 +864,7 @@ sub xsubpp_version # first try the -v flag, introduced in 1.921 & 2.000a2 - my $command = "$self->{PERL} \"-I$self->{PERL_LIB}\" $xsubpp -v"; + my $command = qq{$self->{PERL} "-I$self->{PERL_LIB}" $xsubpp -v}; print "Running: $command\n" if $Verbose; $version = `$command` ; if ($?) { @@ -859,7 +894,7 @@ EOM close F ; - $command = "$self->{PERL} $xsubpp $file"; + $command = "$self->{PERLRUN} $xsubpp $file"; print "Running: $command\n" if $Verbose; my $text = `$command` ; if ($?) { @@ -912,9 +947,9 @@ 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(' ',)},1);" +MOD_INSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "install({split(' ',)},1);" DOC_INSTALL = \$(PERL) -e "\@ARGV=split(/\\|/,);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);" +UNINSTALL = \$(PERLRUN) "-MExtUtils::Install" -e "uninstall(\$ARGV[0],1,1);" !); } @@ -939,6 +974,8 @@ sub dist { $attribs{VERSION} =~ s/[^\w\$]/_/g; $attribs{NAME} =~ s/[^\w\$]/-/g; + $attribs{DISTVNAME} ||= '$(DISTNAME)-$(VERSION_SYM)'; + return $self->SUPER::dist(%attribs); } @@ -1275,8 +1312,8 @@ END my(@m); push @m, qq[POD2MAN_EXE = $pod2man_exe\n], -q[POD2MAN = $(PERL) -we "%m=@ARGV;for (keys %m){" - --e "system(qq/MCR $^X ""-I$(PERL_ARCHLIB)"" ""-I$(PERL_LIB)"" $(POD2MAN_EXE) $_ >$m{$_}/);}" +q[POD2MAN = $(PERLRUN) "-MPod::Man" -we "%m=@ARGV;for(keys %m){" - +-e "Pod::Man->new->parse_from_file($_,$m{$_}) }" ]; push @m, "\nmanifypods : \$(MAN1PODS) \$(MAN3PODS)\n"; if (%{$self->{MAN1PODS}} || %{$self->{MAN3PODS}}) { @@ -1578,7 +1615,7 @@ q{ disttest : distdir startdir = F$Environment("Default") Set Default [.$(DISTVNAME)] - $(PERLRUN) Makefile.PL + $(ABSPERLRUN) Makefile.PL $(MMS)$(MMSQUALIFIERS) $(MMS)$(MMSQUALIFIERS) test Set Default 'startdir' @@ -1620,9 +1657,6 @@ install_perl :: all pure_perl_install doc_perl_install install_site :: all pure_site_install doc_site_install $(NOECHO) $(NOOP) -install_ :: install_site - $(NOECHO) $(SAY) "INSTALLDIRS not defined, defaulting to INSTALLDIRS=site" - pure_install :: pure_$(INSTALLDIRS)_install $(NOECHO) $(NOOP) @@ -1637,8 +1671,8 @@ doc__install : doc_site_install # This hack brought to you by DCL's 255-character command line limit pure_perl_install :: - $(NOECHO) $(PERL) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist') " >.MM_tmp - $(NOECHO) $(PERL) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist') " >>.MM_tmp + $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(PERL_ARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp + $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLARCHLIB)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLPRIVLIB) '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLARCHLIB) '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp @@ -1651,18 +1685,28 @@ pure_perl_install :: # Likewise pure_site_install :: - $(NOECHO) $(PERL) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist') " >.MM_tmp - $(NOECHO) $(PERL) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist') " >>.MM_tmp + $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'read '.File::Spec->catfile('$(SITEARCHEXP)','auto','$(FULLEXT)','.packlist').' '" >.MM_tmp + $(NOECHO) $(PERLRUN) "-MFile::Spec" -e "print 'write '.File::Spec->catfile('$(INSTALLSITEARCH)','auto','$(FULLEXT)','.packlist').' '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLSITELIB) '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLSITEARCH) '" >>.MM_tmp - $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLBIN) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLSITEBIN) '" >>.MM_tmp $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp - $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLMAN1DIR) '" >>.MM_tmp - $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLMAN3DIR) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLSITEMAN1DIR) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLSITEMAN3DIR) '" >>.MM_tmp $(MOD_INSTALL) <.MM_tmp $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; $(NOECHO) $(WARN_IF_OLD_PACKLIST) ].File::Spec->catfile($self->{PERL_ARCHLIB},'auto',$self->{FULLEXT},'.packlist').q[ +pure_vendor_install :: + $(NOECHO) $(PERL) -e "print '$(INST_LIB) $(INSTALLVENDORLIB) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_ARCHLIB) $(INSTALLVENDORARCH) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_BIN) $(INSTALLVENDORBIN) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_SCRIPT) $(INSTALLSCRIPT) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN1DIR) $(INSTALLVENDORMAN1DIR) '" >>.MM_tmp + $(NOECHO) $(PERL) -e "print '$(INST_MAN3DIR) $(INSTALLVENDORMAN3DIR) '" >>.MM_tmp + $(MOD_INSTALL) <.MM_tmp + $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp; + # Ditto doc_perl_install :: $(NOECHO) $(PERL) -e "print 'Module $(NAME)|installed into|$(INSTALLPRIVLIB)|'" >.MM_tmp @@ -1687,6 +1731,8 @@ q% $(NOECHO) $(PERL) -e "print q[@ARGV=split(/\\|/,);]" >.MM2_tmp $(NOECHO) $(PERL) .MM2_tmp <.MM_tmp >>%.File::Spec->catfile($self->{INSTALLARCHLIB},'perllocal.pod').q[ $(NOECHO) Delete/NoLog/NoConfirm .MM_tmp;,.MM2_tmp; +doc_vendor_install :: + ]; push @m, q[ @@ -1743,7 +1789,7 @@ $(OBJECT) : $(PERL_INC)util.h, $(PERL_INC)vmsish.h, $(PERL_INC)warnings.h if ($self->{PERL_SRC}) { my(@macros); my($mmsquals) = '$(USEMAKEFILE)[.vms]$(MAKEFILE)'; - push(@macros,'__AXP__=1') if $Config{'arch'} eq 'VMS_AXP'; + push(@macros,'__AXP__=1') if $Config{'archname'} eq 'VMS_AXP'; push(@macros,'DECC=1') if $Config{'vms_cc_type'} eq 'decc'; push(@macros,'GNUC=1') if $Config{'vms_cc_type'} eq 'gcc'; push(@macros,'SOCKET=1') if $Config{'d_has_sockets'}; @@ -1810,6 +1856,15 @@ $(MAKEFILE) : Makefile.PL $(CONFIGDEP) join('',@m); } +=item find_tests (override) + +=cut + +sub find_tests { + my $self = shift; + return -d 't' ? 't/*.t' : ''; +} + =item test (override) Use VMS commands for handling subdirectories. @@ -1818,7 +1873,7 @@ Use VMS commands for handling subdirectories. sub test { my($self, %attribs) = @_; - my($tests) = $attribs{TESTS} || ( -d 't' ? 't/*.t' : ''); + my($tests) = $attribs{TESTS} || $self->find_tests; my(@m); push @m," TEST_VERBOSE = 0 @@ -1843,13 +1898,13 @@ testdb :: testdb_\$(LINKTYPE) push(@m, "\n"); push(@m, "test_dynamic :: pure_all\n"); - push(@m, $self->test_via_harness('$(PERLRUN)', $tests)) if $tests; - push(@m, $self->test_via_script('$(PERLRUN)', 'test.pl')) if -f "test.pl"; + push(@m, $self->test_via_harness('$(FULLPERLRUN)', $tests)) if $tests; + push(@m, $self->test_via_script('$(FULLPERLRUN)', 'test.pl')) if -f "test.pl"; push(@m, "\t\$(NOECHO) \$(NOOP)\n") if (!$tests && ! -f "test.pl"); push(@m, "\n"); push(@m, "testdb_dynamic :: pure_all\n"); - push(@m, $self->test_via_script('$(FULLPERL) "$(TESTDB_SW)"', '$(TEST_FILE)')); + push(@m, $self->test_via_script('$(FULLPERLRUN) "$(TESTDB_SW)"', '$(TEST_FILE)')); push(@m, "\n"); # Occasionally we may face this degenerate target: @@ -2130,17 +2185,103 @@ part of a filespec. =cut sub nicetext { - my($self,$text) = @_; + return $text if $text =~ m/^\w+\s*=/; # leave macro defs alone $text =~ s/([^\s:])(:+\s)/$1 $2/gs; $text; } -1; +=item prefixify (override) + +prefixifying on VMS is simple. Each should simply be: + + perl_root:[some.dir] + +which can just be converted to: + + volume:[your.prefix.some.dir] + +otherwise you get the default layout. + +In effect, your search prefix is ignored and $Config{vms_prefix} is +used instead. + +=cut + +sub prefixify { + my($self, $var, $sprefix, $rprefix, $default) = @_; + $default = VMS::Filespec::vmsify($default) + unless $default =~ /\[.*\]/; + + (my $var_no_install = $var) =~ s/^install//; + my $path = $self->{uc $var} || $Config{lc $var} || + $Config{lc $var_no_install}; + + if( !$path ) { + print STDERR " no Config found for $var.\n" if $Verbose >= 2; + $path = $self->_prefixify_default($rprefix, $default); + } + elsif( $sprefix eq $rprefix ) { + print STDERR " no new prefix.\n" if $Verbose >= 2; + } + else { + + print STDERR " prefixify $var => $path\n" if $Verbose >= 2; + print STDERR " from $sprefix to $rprefix\n" if $Verbose >= 2; + + my($path_vol, $path_dirs) = File::Spec->splitpath( $path ); + if( $path_vol eq $Config{vms_prefix}.':' ) { + print STDERR " $Config{vms_prefix}: seen\n" if $Verbose >= 2; + + $path_dirs =~ s{^\[}{\[.} unless $path_dirs =~ m{^\[\.}; + $path = $self->_catprefix($rprefix, $path_dirs); + } + else { + $path = $self->_prefixify_default($rprefix, $default); + } + } + + print " now $path\n" if $Verbose >= 2; + return $self->{uc $var} = $path; +} + + +sub _prefixify_default { + my($self, $rprefix, $default) = @_; + + print STDERR " cannot prefix, using default.\n" if $Verbose >= 2; + + if( !$default ) { + print STDERR "No default!\n" if $Verbose >= 1; + return; + } + if( !$rprefix ) { + print STDERR "No replacement prefix!\n" if $Verbose >= 1; + return ''; + } + + return $self->_catprefix($rprefix, $default); +} + +sub _catprefix { + my($self, $rprefix, $default) = @_; + + my($rvol, $rdirs) = File::Spec->splitpath($rprefix); + if( $rvol ) { + return File::Spec->catpath($rvol, + File::Spec->catdir($rdirs, $default), + '' + ) + } + else { + return File::Spec->catdir($rdirs, $default); + } +} + =back =cut -__END__ +1;