Linux

CPAN 使用舊版 perl 安裝模組

  • December 17, 2015

我本週末早些時候安裝了 Ubuntu,並且必須為我正在使用的腳本安裝更新版本的 perl(5.22.0)。然而,當我使用 CPAN 安裝我需要的模組時,我發現它們安裝在 Ubuntu 的預設 perl(5.18.2) 中。我已經跑了perl -l,它顯示了更新的 perl5,但出於某種原因,CPAN 拒絕使用它。

我確定這是一個配置問題,或者我誤解了 CPAN 的工作原理。無論哪種方式,我都瀏覽了Google的頁面和頁面,試圖找到無濟於事的解決方案。我希望這裡有人可以指導我朝著正確的方向前進,也許這可能對其他有類似問題的人有所幫助。

我有完全相同的問題。 警告:我正在使用 Fedora。 但是,fc22 破壞了我的 perl 腳本

$$ the perl 5.20.3 interpreter would segfault $$,所以我不得不安裝5.22.0,所以我對此有一些直接的經驗。


了解新解釋器的配置

首先,你是如何安裝的。我猜您使用安裝程序安裝了 5.22.0 的二進制包。這是否覆蓋/usr/bin/perl?我假設是這樣。或者,它是否被安裝為 (eg) /usr/bin/perl-5.22.0

/usr/lib64/perl/Config.pm中,查看底部以找到已綁定的雜湊。這將具有配置。其他

$$ perhaps better $$得到這個的方法@INCuse Config;Config一個$$ of course–perl $$腳本。 特別感興趣的是privlibexpsitearchexpsitelibexparchlibexp變數。

傾銷@INC是最確定的。

要注意/回答的問題是:5.22.0 perl 解釋器是否使用 5.22.0 目錄,或者某些配置是否仍指向 5.18.2?

這些目錄下的一個或多個應CPAN.pm與子目錄一起CPAN。我猜你只能在 5.18.2 相關目錄下找到它。

事實上,通過一些調查,您可能會發現您現在有一個既不是 5.18.2 也不是 5.22.0的*“混合”安裝。*如果你

$$ decide to $$遵循我的“推薦的最佳實踐”$$ see below $$,您可能希望解除安裝 5.22.0,以便您安裝庫存/標準 5.18.2。如果 Ubuntu 確實發布了更新檔,這可以最大限度地減少頭痛。


關於 CPAN

當發行版安裝的 perl 包與您可以從 CPAN 獲得的包*重疊時,它可以正常工作。*但是,實際上,它們經常發生衝突。此外,針對發行版使用非標準 perl 版本需要更加小心。

您可能必須使用新的解釋器在 5.22.0 目錄下安裝 CPAN。這可能是簡短的答案。

因此,這首先提出瞭如何安裝 CPAN 的問題。它是來自發行版還是被手動拉出和安裝?如果來自發行版,則“升級”可能會起作用。否則,從新的 perl 解釋器手動安裝它——應該發送它

$$ and anything it installs $$到正確的地方。 另外,在$HOME你應該找到一個.cpan目錄

$$ if you’ve run it $$. 特別感興趣的是$HOME/.cpan/CPANsubdir。它應該有一個 cpan 配置文件(例如$HOME/.cpan/CPAN/MyConfig.pm)。有許多變數,但make_install_make_command可能有一些用處


我所做的——推薦的最佳實踐

$$ Side note: I’ve been doing perl for 20+–my current script repo has 250,000 lines in it $$. 我不得不處理這種問題

$$ more than a few $$次。坦率地說,我不再“與”發行版“戰鬥”了,因為像你遇到的問題一樣。儘管在紙面上,發行版聲稱能夠同時安裝多個軟體包版本,但我總是運氣不好——尤其是 perl。 IMO,根據我的經驗,您遇到的問題只是冰山一角。即使你解決了,以後可能還會有更多類似的問題。

如果我需要一個備用的 perl 版本,我會去 perl 網站,下載tarball 並重新建構它。注意:推薦的建議

$$ from the perl website $$是從 perl 網站下載原始碼,而不是嘗試從發行版源包重新建構。 我為腳本指定了一個備用前綴,./Configure以便將所有內容放在一個新位置。然後,做一個makemake install

例如,我的 5.22.0 perl 是 under/home/alt/perl/perl-5.22.0並且 has bin/perl, lib/CPAN.pm, and lib/CPANunder it。我可以根據需要維護盡可能多的不同版本,因為它們每個都可以/home/alt/perl/<version>

之後,我可以做(例如):ln -sf /home/alt/perl/perl-5.22.0/bin/perl /usr/bin/perl22並更改我想使用它的腳本#!/usr/bin/perl22

以下是我用來配置 perl 的選項。前三個是最重要的

$$ * $$:

-Dprefix=/home/alt/perl/perl-5.22.0
-Dstartperl=/home/alt/perl/perl-5.22.0/bin/perl
-Dusethreads=y
-DEBUGGING=both
-Doptimize=-gdwarf-2
-Dman1dir=none
-Dcf_email=anybody@gmail.com
-Dpager=/usr/bin/less
'-Dstatic_ext=threads threads/shared'
-d
-e
-s

請注意,因為我在使用 fedora 的 5.20.3 時遇到了問題,所以我可能添加了一些您不需要的額外調試選項。

另一個地方是/home/myself/perl/perl-5.22.0如果你想要一個私人/實驗副本。

注意:因為我用了完全不同的地方安裝5.22.0,所以5.22.0和5.20.3完全和諧共存。他們不以任何方式乾涉

$$ AFAICT $$. 您甚至可以在干擾已安裝的 5.22.0 的情況下嘗試此操作。


我的實際重建腳本

$$ * $$PS 當然,我有一個完全自動化的 perl 腳本來完成所有這些配置、建構、安裝$$ and pull tarball from website $$ 這些將無法按原樣執行,因為它們需要/假設我現有的很多基礎設施。它們僅供參考。如果您願意看,請忽略大約 99.44% 的您無法立即辨識的內容。

這是 perl 特定的腳本:

#!/usr/bin/perl
# altbld/qprlmkx -- connect to CPAN
#
# xperl -- execute script with alternate perl interpreter
#   "-b" -- use base script name (e.g. skip XBIN)
#   "-ddd" -- run ddd on perl
#   "-db" -- run perl script debugger (perl's -d)
#   "-D" -- perl -D options (see perlrun manpage)
#   "-E" -- environment variables
#   "-Lc" -- use alternate glibc (BROKEN)
#   "-Ld" -- set up PERLIO_DEBUG
#   "-Le" -- force glibc to use stderr for fatal errors
#   "-S" -- do vxshazam (recommended for debug on vxshazam programs)
#
# pathx -- dump the path
#
# qprlmkc -- configure perl interpreter
# qprlmkx -- remake perl interpreter

use qslib::qsinit;
use qpile::qpchk;
use qsnet::rshlib;
use pjx::pjxlib;
use qpile::qploc;
use altbld::altlib;
use gtx::gtxlib;

master(@ARGV);
exit(0);

# master -- master control
sub master
{
   my(@argv) = @_;
   my($proc);
   my(@opts);

   unshift(@argv,"-ddd")
       if ($pgmtail eq "qprlgdb");

   while (1) {
       vbqdash(\@argv);
       vbqnumdcd($_,"-S",1,\$keyS);

       vbqnumdcd($_,"-go",1,\$keygo);

       if (($pgmtail eq "xperl") || ($pgmtail =~ /^tskdir/)) {
           vbqnumdcd($_,"-b",1,\$keyb);
           vbqnumdcd($_,"-db",1,\$keydb);
           vbqvstrdcd($_,"-D","tlsRSD",\@keyD);
           vbqvstrdcd($_,"-E",undef,\@keyE);

           vbqnumdcd($_,"-Le",1,\$keyLe);
           vbqnumdcd($_,"-Lc",1,\$keyLc);
           vbqnumdcd($_,"-Ld",1,\$keyLd);

           pjxdddopt($_);
           vbqnumdcd($_,"-help",1,\$keyhelp);
           vbqnumdcd($_,"-Q",1,\$keyQ);
           vbqnumdcd($_,"-S",1,\$keyS);
       }

       if ($pgmtail eq "qprlmkc") {
           vbqvstrdcd($_,"-D",undef,\@keyD);
           vbqnumdcd($_,"-publish",1,\$keypublish);
       }

       vbqnumdcd($_,"-ask",1,\$keyask);
       vbqnumdcd($_,"-sh",1,\$keysh);

       altoptdcd($_);

       sysusage($_);
   }

   vxshazam()
       if ($keyS);

   push(@opts,"-V$keyV")
       if ($keyV ne "");
   $APL = altverget(@opts,"perl");
   $ALTPERL = $APL->{alt_xfile};

   $APL->{alt_bld} = $APL->{alt_src};

   $APL->{alt_remhost} = "ftp.cpan.org";
   $APL->{alt_remtop} = "pub/CPAN/src";
   ###$APL->{alt_remdir} = "/gcc-" . $APL->{alt_revuse};
   $APL->{alt_remsuf} = ".tar.gz";

   $proc = "cmd_" . $pgmtail;
   &$proc(@argv);
}

# cmd_qprlwget -- pull perl
sub cmd_qprlwget
{

   altwget($APL);
}

# cmd_qmetacfg -- pull perl
sub cmd_qmetacfg
{
   my($sdir);
   my($tail);

   $sdir = $APL->{alt_top};
   msg("$pgmtail: chdir %s ...\n",$sdir);
   xchdir($sdir);

   # get metaconfig
   {
       if (-d $tail) {
           msg("$pgmtail: project dir already exists\n");
           last;
       }

       last;

       vxsystem("git","clone",
           "git://perl5.git.perl.org/$tail.git",
           $tail);
   }
}

# cmd_qprlver -- show versions
sub cmd_qprlver
{
}

# cmd_qprldis -- disassemble executable
sub cmd_qprldis
{

   vxsystem("-x","asmdis",$APL->{alt_xfile});
}

# cmd_qprlmkc -- configure perl
sub cmd_qprlmkc
{
   my(@opts);
   my(@shopts);
   push(@lnklist);
   my($src,$ins,$bld,$xfile);
   my($tail,$lnkto);

   $keygo = 0
       if ($keypublish);

   $src = $APL->{alt_src};
   $ins = $APL->{alt_ins};
   $bld = $APL->{alt_bld};
   $xfile = $APL->{alt_xfile};

   xchdir($src);
   ###sysrmdir($bld);
   ###xmkdir($bld);
   ###xchdir($bld);

   # make depend fails [due to bug] without some symlinks
   ###push(@lnklist,qw(makedepend.SH Makefile.SH perl_exp.SH config_h.SH));
   foreach $tail (@lnklist) {
       $lnkto = "$src/$tail";
       symlink($lnkto,$tail) ||
           sysfault("qprlmkc: unable to symlink to '%s' -- $!\n",$lnkto);
   }

   # save us some complaints
   if ($keygo) {
       xmkdir($ins);
       xmkdir("$ins/bin");
   }

   push(@opts,"-Dprefix=$ins");
   push(@opts,"-Dstartperl=$xfile");

   push(@opts,"-Dusethreads=y");
   ###push(@opts,"-Duseithreads=y");
   ###push(@opts,"-Duselargefiles");
   ###push(@opts,"-Duse64bitall=y");

   ###push(@opts,"-Dusedevel");
   push(@opts,"-DEBUGGING=both");
   push(@opts,"-Doptimize=-gdwarf-2");

   ###push(@keyD,"DEBUG_LEAKING_SCALARS");

   foreach $opt (@keyD) {
       push(@opts,"-A","ccflags=-D$opt");
   }

   # hard to breakpoint on dynamically loaded stuff
   if (1) {
       push(@sext,"threads");
       push(@sext,"threads/shared");
   }

   push(@opts,"-Dman1dir=none");
   $env = gtxconfig("user");
   $email = $env->{email};
   $email = "anybody\@gmail.com"
       if ($keypublish);
   push(@opts,"-Dcf_email=" . $email);

   if (0) {
       push(@opts,"-Dnetdb_host_type=const void *");
       push(@opts,"-Dnetdb_hlen_type=socklen_t");
   }

   push(@opts,"-Dpager=/usr/bin/less");

   if (@sext > 0) {
       $opt = join(" ",@sext);
       push(@opts,"-Dstatic_ext=$opt");
   }

   # NOTE: to use threads, one must also use perlio :-(
   ###push(@opts,"-Duseperlio=n");

   ###push(@opts,$APL->{alt_src});

   # whip through defaults
   push(@opts,"-d","-e","-s")
       unless ($keyask);

   msgv("$pgmtail: OPTS",@opts);

   if ($keypublish) {
       foreach $opt (@opts) {
           $opt = $quo_1 . $opt . $quo_1
                if ($opt =~ /\s/);
           printf("%s\n",$opt);
       }
   }

   unless ($keygo) {
       sysfault("$pgmtail: rerun with -go to actually do it\n");
   }

   sleep(5)
       if (sysisatty(1));

   push(@shopts,"-x")
       if ($keysh);

   {

       last unless ($keygo);

       vxsystem("sh",@shopts,"$APL->{alt_src}/Configure",@opts);
   }

   # complains on the second round
   {
       last unless ($keygo);

       last if (-e "$src/MANIFEST_NOT");

       msg("$pgmtail: renaming manifest ...\n");
       rename("$src/MANIFEST","$src/MANIFEST_NOT");

       $xfdst = xfopen(">$src/MANIFEST","qprlmkc");
       $xfdst = xfclose($xfdst,"qprlmkc");
   }
}

# cmd_qprlmkx -- make perl executable
sub cmd_qprlmkx
{
   my(@opts);

   xchdir($APL->{alt_bld});

   vxsystem("-x","make");
}

# cmd_xperl -- invoke alternate perl
sub cmd_xperl
{
   my(@argv) = @_;
   my(@opts);

   unshift(@argv,"-V")
       if ($keyQ);

   @opts = altperl(@argv);

   enveval("ALTPERL",$ALTPERL);

   {
       last if (defined($keyddd));
       xperlenv();
       exec($ALTPERL,@opts);
       sysfault("$pgmtail: exec of '%s' failed -- $!\n",$ALTPERL);
   }

   pjxgdbinit("-alien=$APL->{alt_src}",@opts);
   pjxdddloc();

   xperlenv();
   vxsystem("-x",@ddd,$ALTPERL);
}

# xperlenv -- set up environment
sub xperlenv
{
   my($opt);

   foreach $opt (@keyE) {
       if ($opt =~ /$keyval_rgx/o) {
           enveval($1,$2);
       }
   }
}

# altperl -- get alternate perl
sub altperl
{
   my(@argv) = @_;
   my(@keyD);
   local(@opts);
   my($tail,$file);
   my($logf);

   zprt(ZPXHOWEXEC,"altperl: ENTER\n");

   zprtlist(ZPXHOWEXEC,"altperl/ARGV",\@argv);

   envchk(qw(XLBIN));

   # turn on perl's internal tracing
   # NOTE: perl must be compiled with -DEBUGGING for this to work
   foreach $opt (@keyD) {
       push(@opts,"-D$opt");
       $keyLe = 1;
   }

   # run the script debugger
   push(@opts,"-dt")
       if ($keydb);

   while (1) {
       vbqdash(\@argv);
       push(@opts,$_);
       zprt(ZPXHOWEXEC,"altperl: PUSHOPT '%s'\n",$_);
   }

   # locate the script
   {
       $tail = shift(@argv);

       $file = tstloc($tail);
       last if (defined($file));

       if ($tail =~ m,^[./],) {
           $file = $tail;
           last;
       }

       # skip the XBIN entries and go direct to the final script
       if ($keyb) {
           $file = basescan($tail);
           last;
       }

       $file = "$XLBIN/$tail";
   }
   push(@opts,$file);

   # tell tskdirbug to _not_ fork/exec
   {
       last unless ($keyddd || $keydb);
       last unless (defined($tst_xfile));
       push(@opts,"-d");
   }

   enveval("LIBC_FATAL_STDERR_",1)
       if ($keyLe);

   $keyLd = 1
       if (zprtok(ZPXHOWGDB));

   if ($keyLd) {
       $logf = logfile("qprldbg");
       msg("altperl: PERLIO_DEBUG %s ...\n",$logf);
       unlink($logf);
       enveval("PERLIO_DEBUG",$logf);
   }

   # FIXME/CAE -- this needs work
   ###$glibc_ins = "/home/libc";
   ###$dir = "$glibc_ins/lib";
   ###enveval("LD_LIBRARY_PATH",$dir)
       ###if ($keyLc);

   push(@opts,@argv);
   msgv("altperl: OPTS",@opts,"...");

   zprt(ZPXHOWEXEC,"altperl: EXIT\n");

   @opts;
}

# basescan -- run perl debugger on base script
sub basescan
{
   my($basetail) = @_;
   my($topdir);
   my($basefile);
   my($bindir,@binpath);
   my($lnkfile);

   $topdir = syshome("altperl");
   sysrmdir($topdir);
   xmkdir($topdir);

   @binpath = qpbinpath();
   foreach $bindir (@binpath) {
       push(@opts,"-I$bindir");
   }

   $basefile = qplocate($basetail);
   sysfault("basescan: unable to locate '%s'\n",$basetail)
       unless (-e $basefile);
   msg("basescan: %s --> %s ...\n",$basetail,$basefile);

   # we have to create a link with the correct command name in it
   $lnkfile = "$topdir/$basetail";
   symlink($basefile,$lnkfile) ||
       sysfault("basescan: unable to symlink '%s' to '%s' -- $!\n",
           $lnkfile,$basefile);

   $lnkfile;
}

# cmd_pathx -- show path
sub cmd_pathx
{
   my(@argv) = @_;

   # execute ourself with the alternate interpreter -- we will _not_
   # recurse further because we're leaving off the -P
   {
       last if ($keyV eq "");
       exec($ALTPERL,$0);
       sysfault("$pgmtail: exec failure -- $!\n");
   }

   showpath("INC",\@INC);
   showpath("PATH");
   showpath("LD_LIBRARY_PATH");
}

# showpath -- show a path
sub showpath
{
   my($sym,$path) = @_;
   my(@path);

   printf("%s:\n",$sym);

   {
       if (ref($path)) {
           @path = @$path;
           last;
       }

       $path = $ENV{$sym};
       @path = syspathsplit($path);
   }

   foreach $path (@path) {
       printf("  %s\n",$path);
   }
}

# cmd_tskdirbug -- wrapper for tskdirbug
sub cmd_tskdirbug
{
   my($xfile);

   $xfile = tstloc();

   if ($keyhelp) {
       sysusage_less(pgmbase(),$xfile);
   }
}

# tstloc -- locate script
sub tstloc
{
   my($tail) = @_;
   my($code);
   my($xfile);

   $tail //= "tskdirbug";

   $tst_top = cdxgo("cdt");

   {
       if ($tail =~ /^tskdir/) {
           $tst_dir = "$tst_top/tskdirbug";
           last;
       }

       $tst_dir = "$tst_top/$tail";
   }

   $xfile = "$tst_dir/$tail";
   undef($xfile)
       unless (-e $xfile);

   $tst_xfile = $xfile;

   {
       last if ($keyhelp);

       last unless (defined($xfile));

       $code = qpchkgo($xfile);
       exit(1) if ($code);
   }

   $xfile;
}

這是它的主要圖書館

$$ which is the basis to build other things, such as glibc, gcc, etc $$:

# altbld/altlib.pm -- common alternate make control
#
#@+
#   "-a" -- push all versions
#   "-go" -- actually do it (install)
#   "-j" -- suppress parallel build
#   "-url" -- output top url
#   "-V" -- target version to build (DEFAULT: highest)
#   "-x" -- extractable versions
#@-

_altsetup();

# _altsetup -- passive setup
sub _altsetup
{

   $altsuf{".tar.gz"} = "z";
   $altsuf{".tgz"} = "z";

   $altsuf{".tar.bz"} = "j";
   $altsuf{".tbz"} = "j";

   @altsuf = reverse(sort(keys(%altsuf)));
}

# altoptdcd -- decode options
sub altoptdcd
{
   my($arg) = @_;

   vbqnumdcd($arg,"-a",1,\$keya);
   vbqnumdcd($arg,"-go",1,\$keygo);
   vbqstrdcd($arg,"-install","",\$keyinstall);
   vbqnumdcd($arg,"-j",1,\$keyj);
   vbqstrdcd($arg,"-V","",\$keyV);
   vbqnumdcd($arg,"-x",1,\$keyx);
   vbqnumdcd($arg,"-url",1,\$keyurl);
}

# altwget -- get versions
sub altwget
{
   local($alt) = @_;
   local($remtop);
   local($foundcnt);
   my($rev,@revlist);

   sysfault("!altwget: bad pointer\n")
       unless (ref($alt));

   # most sites allow ftp with some exceptions (e.g. python.org)
   $remtop = $alt->{alt_remproto};
   $remtop //= "ftp";

   $remtop .= "://" . $alt->{alt_remhost} . "/" . $alt->{alt_remtop};

   {
       if ($keyurl) {
           printf("%s\n",$remtop);
           last;
       }

       if ($keya) {
           @revlist = @{$alt->{alt_revlist}};
           last;
       }

       push(@revlist,$alt->{alt_revuse});
   }

   foreach $rev (@revlist) {
       _altwget($rev);
   }
}

# _altwget -- pull version from website
sub _altwget
{
   my($rev) = @_;
   my($remurl,$remtail);
   my($tgzfile);
   my($dir,@dirs);
   my($subdir);
   my($cmd);

   $remurl .= $remtop;
   $remurl .= $alt->{alt_remdir};
   $remtail = $alt->{alt_name} . "-$rev" . $alt->{alt_remsuf};
   $remurl .= "/$remtail";

   xchdir($alt->{alt_netsave});
   $tgzfile = $alt->{alt_netsave} . "/$remtail";

   {
       $cmd = $altsuf{$alt->{alt_remsuf}};

       if (defined($cmd)) {
           $cmd .= "xf";
           last;
       }

       sysfault("_altwget: unknown suffix -- %s\n",$remurl);
   }

   {
       # pull the file
       unless (-e $tgzfile) {
           msgv("altwget:",NOGO("pulling"),$remurl,"...");
           if ($keygo) {
               $code = vxsystem("wget",$remurl);
               last if ($code);
           }
       }

       {
           ($dir) = homesrc("-d",$alt->{alt_name});

           unless (defined($dir)) {
               msgv("altwget: no directory found --",@dirs);
               last;
           }

           zprtx("\n")
               if ($keya);

           $subdir = "$dir/" . $alt->{alt_name} . "-$rev";
           if (-d $subdir) {
               msgv("altwget:",NOGO("removing"),$subdir);
               sysrmdir($subdir)
                   if ($keygo);
           }

           msgv("altwget:",NOGO("extracting"),$rev,"in",$dir,"...");
           $code = vxsystem("-C$dir","tar",$cmd,$tgzfile)
               if ($keygo);

           $foundcnt++;
       }

       unless ($keygo) {
           msg("altwget: rerun with -go to actually do it\n");
           last;
       }
   }

   msg("altwget: %s\n",$code ? "errors" : "complete");
}

# altverget -- get version
sub altverget
# "-ins" -- scan install directories
# "-q" -- quiet mode
{
   my(@argv) = @_;
   my($keyins,$keyq) = (0,0);
   my($keyV);
   my($svmsg);
   my($pjname);
   my($tail,@tails);
   my($dir,@dirs);
   my(@revlist);
   my($revfound);
   my($revuse);
   my($sym,$val);
   my($suf);
   my($alt);

   while (1) {
       vbqdash(\@argv);
       vbqnumdcd($_,"-ins",1,\$keyins);
       vbqstrdcd($_,"-V","",\$keyV);
       vbqnumdcd($_,"-q",1,\$keyq);
       vbqusage($_,"altverget");
   }

   $svmsg = msgqtpush($keyq);

   $pjname = shift(@argv);
   msg("altverget: project %s ...\n",$pjname);
   $alt = {};
   $alt->{alt_name} = $pjname;

   envchk(qw(NETSAVE));
   $alt->{alt_netsave} = filejoin($NETSAVE,$pjname);
   msg("altverget: netsave %s ...\n",$alt->{alt_netsave});

   $alt->{alt_ins} = "/home/alt/$pjname";

   $revlist = [];
   $alt->{alt_revlist} = $revlist;

   {
       if ($keyins) {
           @dirs = ($alt->{alt_ins});
           msg("altverget: from install ...\n");
           last;
       }

       if ($keya) {
           $keyx = 1;
       }
       else {
           last if ($pgmtail =~ /wget/);
       }

       if ($keyx) {
           msg("altverget: from netsave ...\n");
           @dirs = ($alt->{alt_netsave});
           last;
       }

       msg("altverget: from src ...\n");
       @dirs = homesrc($pjname);
   }

   foreach $dir (@dirs) {
       $alt->{alt_top} = $dir;
       $alt->{alt_src} = $dir;

       # get known versions
       if (-e $alt->{alt_src}) {
           @tails = xfdirload($alt->{alt_src},"altverget");

           foreach $tail (@tails) {
               next unless ($tail =~ s/^$pjname-//);
               foreach $suf (@altsuf) {
                   last if ($tail =~ s,$suf$,,);
               }
               push(@$revlist,$tail);
           }

           @$revlist = revsort(@$revlist);
           msgv("altverget: versions",@$revlist);

           $revfound = $revlist->[$#$revlist];

           last;
       }
   }

   # do final selection on revision
   {
       {
           # explicit command line override
           if ($keyV ne "") {
               $revuse = $keyV;
               last;
           }

           # grab an override from the environment
           $sym = "ALTREV_" . $pjname;
           $val = $ENV{$sym};
           if ($val ne "") {
               $revuse = $val;
               last;
           }

           $sym = "PJNAME";
           $val = $ENV{$sym};
           if ($val =~ s/^$pjname-//) {
               $revuse = $val;
               last;
           }

           # use searched for value
           $revuse = $revfound;
       }

       if ($revuse eq "") {
           $revuse = "unknown";
           $alt->{alt_revuse} = $revuse;
           last if ($keyins);
           last if ($keyurl);
           sysfault("altverget: no version specified\n");
       }

       msg("altverget: VERSION %s ...\n",$revuse);
       $alt->{alt_revuse} = $revuse;
   }

   $alt->{alt_src} .= "/$pjname-$revuse";
   msg("altverget: source %s ...\n",$alt->{alt_src});

   $alt->{alt_bld} = syshome("-xt","alt/build/$pjname/$pjname-$revuse");
   msg("altverget: build %s ...\n",$alt->{alt_bld});

   $alt->{alt_ins} .= "/$pjname-$revuse";
   ###$alt->{alt_ins} .= "/$pjname";
   msg("altverget: install %s ...\n",$alt->{alt_ins});

   {
       if ($revuse eq "std") {
           $alt->{alt_xfile} = "/usr/bin/$pjname";
           $alt->{alt_std} = 1;
           last;
       }

       $pjname =~ s/-.+$//;
       $alt->{alt_xfile} = $alt->{alt_ins} . "/bin/$pjname";
   }
   msg("altverget: xfile %s ...\n",$alt->{alt_xfile});

   msgqtpop($svmsg);

   $alt;
}

1;

引用自:https://serverfault.com/questions/741186