作者：    文章来源：
发布日期：2007年03月06日

献给linux下的perl黑客们-JAPH
提交人： 爬爬虫　所属分类： 系统应用　提交日期：2005-04-21 10:24:57　 转载自： http://www.linuxkit.com/articleedit.php?newsid=291 　
已被浏览 192 次　现有回复 0 个


Perl 文化的支柱 JAPH 就是一小段输出“Just another Perl hacker”的脚本。尽管 Teodor Zlatanov 的这篇文章是为 Perl 的初级或中级程序员撰写的，本文分析的几个 JAPH 风格的简单示例却能让即使经验最丰富的 Perl 爱好者也感到惊讶，并吸引他们参与。本文的作者 Teodor Zlatanov 是一位Perl 专家，他从 1992年起就开始在社区中工作了，除了其他一些工作，他专门研究有关文本解析的开放源代码工作。
本质上，JAPH 用四行或不到四行的代码（每行 80 个或者更少的字符）来输出字符串“Just another Perl hacker”，这样一来 JAPH 就可以放在一个 USENET 签名中。USENET 签名远远早于 Perl，这就使 JAPH 成了一个由长期存在的传统和 Perl 的魔力结合在一起的奇异的混合体。

JAPH：“Just another Perl hacker”
据我们所知，JAPH 格式是在二十世纪九十年代由 Randal Schwartz 推广的（好几处信息来源都同意这个说法）。今天，JAPH 到处可见，它们是由该流派的那些不知疲倦的艺术家们制作的，比如 comp.lang.lang.perl.misc 新闻组的 Abigail。

下面的讨论中我们将分析 CPAN （请参阅 参考资料）上的规范列表中的一些 JAPH，它们适合初级到中级 Perl 程序员。我在这里会对各种技巧作简单的说明，但是有兴趣的读者还是应该参阅 Programming Perl，第三版（请参阅 参考资料）来进一步学习。

为了精确地支持这里所给的示例，您的系统中必须安装有 Perl 5.6.0。最好您还安装了最新的（2000 或者更新版本）主流 UNIX 系统（Linux、Solaris、BSD）。尽管这些示例也许能在老一点的 Perl 和 UNIX 版本甚至是其它操作系统上运行，您还是应该考虑一下如果它们运行失败这样需要解决的问题。每个 JAPH 都以规范列表的格式显示，带有一个日期和作者属性。

优良的
在开始讨论更丰富的内容之前，我们先来看看 Randal Schwartz 在 JAPH 的早些时期编写的四段简单有趣的代码。我们下面的第一个示例证明了并不是所有的 JAPH 都是要晦涩难懂的，有一些甚至是很容易看懂的。

清单 1. 一个简单的 true 条件句
Date: 18 Jun 90 15:53:11 GMT
From: merlyn@iwarp.intel.com (Randal Schwartz)
print "Just another Perl hacker," if "you can´t think of anything better..."


在清单 1 中，既然字符串不为空， if() 语句的值就始终为 true（只有空字符串“”、字符串“0”，数字 0 或其等价的表达形式，或者不定义时其值才为 false）。因而，将一直执行打印语句。

清单 2. 使用 Printf
Date: 15 Jun 90 22:06:24 GMT
From: merlyn@iwarp.intel.com (Randal Schwartz)
printf "%s %s %s %s%c", ´Just´, ´another´, ´Perl´, ´hacker´, 44



清单 2 是另一个早期的样本，它使用 printf() 的函数来产生所需的输出，这也证明了如果您愿意的话，Perl 看起来也可以象 C 语言一样。

在清单 3 中 Schwartz 开始玩花招了。现在我们给 print() 一个重新排列过的数组，然后将这个数组打印出来，单词之间有空格（$ 是一个变量，它告诉 Perl 在一次打印所有数组元素时在元素之间应该放什么东西）。

清单 3. 重新排列数组
Date: 5 Jun 90 19:07:58 GMT
From: merlyn@iwarp.intel.com (Randal Schwartz)
$,=" "; print +("hacker,","Just","Perl","another")[1,3,2,0];



数组前面的 + 使 print() 把紧随其后的东西当做一个单独的参数（在本例中因为有圆括号，所以是数组），而不是把圆括号当做是函数调用。换句话说，我们避免了以下情况： print (´a´, ´b´)[1]； 其中， print() 把‘a’和‘b’当做它的第一个和第二个要打印的参数，然后 Perl 就不知道 [1] 是用来做什么的了。

清单 4 是最早的有记录可查的 JAPH，还有点别出心裁，使用了 split() 、 sort() 和 grep() ：

清单 4. Sort 然后 grep
Date: 6 Feb 90 22:31:17 GMT
From: merlyn@iwarp.intel.com (Randal Schwartz)
print grep(s/^d+(.*)/$1 /, sort(split(/ /,"8hacker, 4Perl 1Just 2another")));



首先，我们把起始字符串分割成四个元素： “8hacker,” “4Perl” “1Just” “2another” 。
然后我们排序 ?D 缺省情况下是按字母数字顺序 ?D 得到： “1Just” “2another” “4Perl” “8hacker,” 。

注意 “10Just” 也应该排在 "8hacker" 的前面 ?D 这不是数字排序。

排序后的列表被传递到 grep() ，它将每个元素开头的所有数字都去掉，并在剩下的部分后面加上一个空格。结果是： “Just ” “another ” “Perl ” “hacker, ” 。

最后，在这个列表上调用 print() ，逐字逐元素打印。

糟糕的
看够了 JAPH 的优点后，现在让我们来看看它真正“糟糕到极点”的地方。良好的 JAPH 还有循序渐进的教学作用，糟糕的 JAPH 却让您的思维混乱得象椒盐卷饼一样。当您盯着一段 JAPH 冥思苦想十分钟却只能头疼时，您就知道这个 JAPH 是糟糕的了。

清单 5. 代替和计算
Date: 26 Mar 90 16:20:37 GMT
From: raymond@sunkist.berkeley.edu (Raymond Chen)
$_=´x"Not ";"x"another ";´x"perl ";x"hacker,"´"´;s/x/print/g;eval eval eval;



这里举例说明的一个普通的技巧是用另外的单词来代替原有的一个单词，然后再计算输出（实际上，在您进行这个步骤时正在建立 Perl 代码）。上面的示例中，每一个 "x" 都被换成了 "print" 。您还应该懂得 Perl 中的引用规则。Perl 在那个字符串中计算之后看到的是： x"Not ";"x"another ";´x"perl ";x"hacker,"´" （在 s/// 命令前面加上一个 print() 来察看这一点。）

字符串以一个单引号开头，所以它也必须以一个单引号结束。如果您往前面找单引号，就会发现有两个单引号转义了（带一个反斜杠），第三个才是真的。

现在，运行替换（在 s/// 命令后面加上一个 print() 自己去看结果）： print"Not ";"print"another ";´print"perl ";print"hacker,"´"

接下来是我们的命令了。为什么在这里要运行三个 eval() 命令，而不是仅仅一个呢？仔细看一下。第二个 print() 是在字符串里面的，并不会被第一个 eval() 计算。但第一个 eval() 会返回计算过的第一级字符串： print"another ";´print"perl ";print"hacker,"´ 。它将打印出“Not”。为什么第一个 eval() 不返回字符串的第一部分？因为 eval() 只返回计算过的最后的东西。用“print eval”代替“eval eval eval”作为最后的语句，看看这样操作的效果如何。

第二个 eval 是做什么的呢？它是用来计算第二个，而不是第三个或第四个 print() 语句的。如果您观察一下就会发现它们两个都是在一对单引号内的字符串里的。第二个 eval 会返回含有第三个和第四个 print() 语句的字符串，留下刚刚打印了“another ”的那个语句。所以第二个 eval 将返回： print"perl ";print"hacker,"

第三个 eval 会运行那两个 print() 语句来结束这段 JAPH（奇怪的是，它会打印出“Not another perl hacker,”）。

正如您所看到的，分解一段糟糕的 JAPH 是要花一点时间的。即使是象我们刚才解译的那么简单的东西，最后都有好几个复杂的层次。

让我们来分析另一个糟糕到极点的 JAPH ：

清单 6. Abigail 的天书
#Abigail
$_ = "x3Cx3Cx45x4Fx54"; s/<<EOT/<<EOT/e; print;
Just another Perl Hacker
EOT



清单 6 看起来也象是一段简单的 JAPH。为什么？字符串就在那里 ?D 有什么神秘的地方？其实，Abigail 风格就是以一种新的方式来使用您以前所见过的东西。例如，在这里，给操作符 s/// 加上了修饰符“e”。这样就让它在进行替换之前计算右边的表达式。这样一来，“<<EOT”就被自己替换成下一行到 EOT 行之间的所有字符 ?D 在这个示例中为“Just another Perl Hacker”。

编码的 $_字符串最后包含“<<EOT”，所以操作符 s/// 进行的替换最后会将 字符串 “<<EOT”替换成计算“<<EOT”的结果，即字符串“Just another Perl Hacker”。 print() 语句负责打印该字符串。

编码过的字符串和看似简单的替换是 JAPH 的支柱。尤其是替换，它可以用新的令人惊奇的方式进行，您会发现在您自己的代码中这些方式很有用。

下面是 Abigail 的另一段如恶魔般让您绞尽脑汁的 JAPH：

清单 7. Abigail 解释的原型
#Abigail
perl -wle ´sub _ "Just another Perl Hacker"; print prototype &_´



理解这段 JAPH 需要一定的使用原型的知识。请参阅“perldoc -f sub”和“perldoc -f prototype”文档来了解这是怎么一回事。基本上，这建立了一个新的函数，它名为“_”，没有函数体，但带有一个“Just another Perl Hacker”的原型。

如果您看了 Programming Perl，第三版（请参阅 参考资料）关于原型的实际章节，您会发现原型不能是字符串。Abigail 很随便地忽略了这个事实（因为这个函数永远都不会用到），然后打印出了无效的原型。

这样合法吗？可能吧，因为它并不引起程序崩溃。这样疯狂吗？只有一点点。还有很多更疯狂的方法，但这一种至少还证明了在定义函数时原型的合法性不会受到检查。它还示范了我们可以定义一个名为“_”的函数 ?D 这种方法您不应该经常使用，因为它会和内建的“_”操作符冲突。

难看的
我们看过了良好的和糟糕的 JAPH，所剩下的就是难看的 JAPH 了。这些怪兽被精心打造，就是为了让人们畏惧然后到处找药吃，它们定义得太丑陋了。

下面这一段 Kickstart 编写的 JAPH 您应该送给对您非常重要的另一半（不包括家里的宠物）。注意，称其为一段难看的 JAPH 是不止一个原因的 ?D 四行的限制被远远的抛在一边。

清单 8. 燃烧的心
#Kickstart from http://www.perlmonks.com/
#note: a slight valentine variation :)
$LOVE= AMOUR.
true.cards. ecstacy.crush
.hon.promise.de .votion.partners.
tender.truelovers. treasure.affection.
devotion.care.woo.baby.ardor.romancing.
enthusiasm.fealty.fondness.turtledoves.
lovers.sentiment.worship.sweetling.pure
attachment.flowers.roses.promise.poem;
$LOVE=~ s/AMOUR/adore/g; @a=split(//,
$LOVE); $o.= chr (ord($a[1])+6). chr
(ord($a[3])+3). $a[16]. $a[5]. chr
(32). $a[0]. $a[(26+2)]. $a[27].
$a[5].$a[25]. $a[8].$a[3].chr
(32).$a[29]. $a[8].$a[3].
$a[62].chr(32).$a[62].
$a[2].$a[38].$a[4].
$a[3].´.´;
print
$o;



信不信由你，这种代码也能运行。但是它能做什么呢？

变量 $LOVE 是揭示其神秘之处的第一把钥匙。我们分解这段脚本以便看清 $LOVE 变量，我们把它放到一个可执行文件中，这样我们就可以随意进行调试。

输出显示（不带插入的换行符），$LOVE 是：“ AMOURtruecardsecstacycrushhonpromisedevotionpartnerstendertrueloverstreasureaffection
devotioncarewoobabyardorromancingenthusiasmfealtyfondnessturtledovesloverssentiment
worshipsweetlingpureattachmentflowersrosespromisepoem ”，
它告诉我们所有这些不加修饰的单词都被 Perl 作为字符串来解释。

清单 9. 倾倒爱情
#!/usr/bin/perl
use Data::Dumper;
$LOVE= AMOUR.
true.cards. ecstacy.crush
.hon.promise.de .votion.partners.
tender.truelovers. treasure.affection.
devotion.care.woo.baby.ardor.romancing.
enthusiasm.fealty.fondness.turtledoves.
lovers.sentiment.worship.sweetling.pure
attachment.flowers.roses.promise.poem;
print Dumper $LOVE;
$LOVE=~ s/AMOUR/adore/g; @a=split(//,
$LOVE); $o.= chr (ord($a[1])+6). chr
(ord($a[3])+3). $a[16]. $a[5]. chr
(32). $a[0]. $a[(26+2)]. $a[27].
$a[5].$a[25]. $a[8].$a[3].chr
(32).$a[29]. $a[8].$a[3].
$a[62].chr(32).$a[62].
$a[2].$a[38].$a[4].
$a[3].´.´;
print
$o;



现在，我们把“AMOUR”替换成“adore”，然后将 $LOVE 分解成名为 @a 的单个字符的数组。数组 @a 中第一个元素是 “a”，第二个是“d”，依此类推组成：“ adoretruecards
ecstacycrushhonpromisedevotionpartnerstendertrueloverstreasureaffectiondevotion
carewoobabyardorromancingenthusiasmfealtyfondnessturtledovesloverssentimentworship
sweetlingpureattachmentflowersrosespromisepoem ”

最后，我们通过从 @a 数组中选取字母组成了字符串 $o。有时候我们还需要修改它们 ?D 只是为了让事情变得有趣 ?D 但最终爱情会胜利。

拆解后的脚本是：

清单 10. 拆解后的爱情
#!/usr/bin/perl
$LOVE = "AMOURtruecardsecstacycrushhonpromisedevotionpartners".
"tendertrueloverstreasureaffectiondevotioncarewoobaby".
"ardorromancingenthusiasmfealtyfondnessturtledoveslovers".
"sentimentworshipsweetlingpureattachmentflowersroses".
"promisepoem";
$LOVE=~ s/AMOUR/adore/g;
@a=split(//, $LOVE);
$o.= chr (ord($a[1])+6). chr (ord($a[3])+3). $a[16]. $a[5] .
# j u s t
chr (32). $a[0]. $a[(26+2)]. $a[27]. $a[5].$a[25]. $a[8].
# space a n o t h e
$a[3].chr (32).$a[29]. $a[8].$a[3]. $a[62].chr(32).$a[62].
# r space p e r l space l
$a[2].$a[38].$a[4]. $a[3].´.´;
# o v e r
print $o;



真的，爱情是个谜题

自己探索 JAPH
我们已经看了各种有趣的微型脚本，还分析了很多有趣的 Perl 技巧。JAPH 肯定会是一种挑战，所以任何解释与您自己探索出它错综复杂的结构之后得到的快乐相比，都显得苍白无力。不过事先要警告的是，大多数 JAPH 都需要具有 Perl 方面的高级知识和一定的耐心。挑战就在前面 ?D 不要害怕用 JAPH 去检验自己（参见 参考资料部分，您可以找到这些 JAPH）。

不过鼓起勇气来，实践确实可以让理解 JAPH 变得更容易。简单的技巧，如用十六进制对字符串进行编码或改变变量 $, 都很容易上手（但是无论如何都要小心一点）。

我要感谢所有那些投入时间和精力设计 JAPH 的人们。每一个 JAPH 都会教您一些新的东西，而且可以看做是一种快乐。就我所知，没有任何其它的语言具有这样一种既简洁却又令人迷惑的形式（尽管没有人能确认是该为它感到骄傲还是惭愧）。在许多其它的语言中也都有一些类似的编写复杂、迷惑程序的竞赛。如果您有兴趣学习或者愿意参加这些竞赛，请参阅 参考资料寻找入手之处。其中关于C 语言的这个竞赛也是很值得关注的。

下面是一些有趣的JAPH

%%
#JoeCamel on http://www.perlmonks.com/
#note: requires Perl5.6.0 or better
#!/usr/bin/perl -w
use strict;

# A tribute to one of the greatest films of all time.
my(%primate, $monolith, $evolution, $contact);

$_=´primate-> throw
( "Bone" ) ; goto;
$$monolith ; bless
%primate;$evolution
=~m/?+*/; #/*+?/m~=
*humanIntellect ++;
$Discovery =~ m . [
[::]>>=<>=<>=<>=(-)
]. ; require 2001;
exists($malfunction
)#open $podBayDoors
or die ; HAL-> sing
("Daisy");sleep()*´
;my@universe= qw(15
1 6 4 35 1 12 2 23
2 14 1 8 2 0 5 25
1 39 3 7 2);my $God
;$monolith="******"
; my @spaceTime =
split/;/,$_ ; while
(my($space,$time )=
splice (@universe,0
,2) ) { my $journey
= shift @spaceTime;
eval " $journey; ";
$contact = substr (
$@, $space, $time )
; if ( $space != ((
" dimension " =~ //
) +1+4+9 ) ) {print
$contact; next; }my
$starChild=$contact
;print uc$starChild

}
%%
#!/usr/local/bin/perl

undef$/;$_=<DATA>;y/ODAn / /ds;@yoda=map{length}split;print chr
oct join(´´,splice(@yoda,0,3))-111 while@yoda;
__DATA__
00O00O000O00O0000 000O DD000000O0
0DO0000000O0000O00 O00000 00O00000O0O
0000 0O0 O00 O00 00D 0DO
00O0 0O0 00D 000 DO0D00000D
0O00 DOD 000000O00000 000 O00O
DD0000D000O0 000 0O00O0000D00DO 0OD D00O000D00O0
00000DO00O0 000 000O 00D0 O0D O00000O0DO0

0O000 OD0D O00O0 0000 DDDO000000 O00O000000
0O000 O00DDO 00000 0O0D00 00O0O00000O 0O00O000000
0O0O00OD00000DDD 00O 0D0 DDD D0O 00O0D
00000O00000000 O00 DO0 D00D00O000 00D00
D0O00 O0000 000O000O00DO 000 00O0 0OD00
O00 000 0O000D000O00O0 000 0D0O000000O00O00
0 0 0O0D 0000 0O0 0O0000000O000O

[editorial note: would the author of this JAPH *please* stand up? ]
%%
#Erudil from http://www.perlmonks.com/
#!/usr/bin/perl -w # camel code
use strict;

$_=´ev
al("seek40D
ATA,0, 0;");foreach(1..3)
{<DATA>;}my @camel1hump;my$camel;
my$Camel ;while( <DATA>){$_=sprintf("%-6
9s",$_);my@dromedary 1=split(//);if(defined($
_=<DATA>)){@camel1hum p=split(//);}while(@dromeda
ry1){my$camel1hump=0 ;my$CAMEL=3;if(defined($_=shif
t(@dromedary1 ))&&/S/){$camel1hump+=1<<$CAMEL;}
$CAMEL--;if(d efined($_=shift(@dromedary1))&&/S/){
$camel1hump+=1 <<$CAMEL;}$CAMEL--;if(defined($_=shift(
@camel1hump))&&/S/){$camel1hump+=1<<$CAMEL;}$CAMEL--;if(
defined($_=shift(@camel1hump))&&/S/){$camel1hump+=1<<$CAME
L;;}$camel.=(split(//,"40..m`{/J47134}L^7FX"))[$camel1h
ump];}$camel.="n";}@camel1hump=split(/n/,$camel);foreach(@
camel1hump){chomp;$Camel=$_;y/LJF7173175`47/616263
06465666770/;y/12345678/JL7F17517347`/;$_=reverse;
print"$_40$Cameln";}foreach(@camel1hump){chomp;$Camel=$_;y
/LJF7173175`47/12345678/;y/12345678/JL7F175173 47`/;
$_=reverse;print"40$_$Cameln";}´;;s/s*//g;;eval; eval
("seek40DATA,0,0;");undef$/;$_=<DATA>;s/s*//g;( );;s
;^.*_;;;map{eval"print"$_"";}/.{4}/g; __DATA__ 124
1 5014540165163145401571 46401 41
40143141 1551451 54401 51155 141
147145 40151156 40141 16316 3
157143 15114116 41511 57156
40167 1511641 5040 1201
45162 1544015 1163 04014
1401 641621 41144 145
15514 1162 1534 0157
146 04011 747 1221
4515 11541 54171 40
46 01210116 316
315 714315 114
116 4145163 54
40 11115614 356
40 12516314514 440
1671 511641 50 40160
145162 155151
163163 1511
5715656
%%
#MeowChow from http://www.perlmonks.com/

$ _=
qq
.CG
T--A
A---T
A----T
C----G
T----A
A---T
G--C
CG
CG
C--G
G---C
G----C
C----G
A----T
C---G
G--C
AT
CG
A--T
A---T
G----C
A----T
G----C
C---G
A--T
GC
CG
G--C
A---T
G----C
G----C
G----C
A---T
T--A
AT
CG
T--A
C---G
A----T
A----T
G----C
A---T
A--T
CG
TA
T--A
G---C
G----C
C----G
A----T
C---G
G--C
CG
TA
T--A
C---G
T----A
C----G
A----T
C---G
G--C
GC
TA
G--C
C---G
G----C
G----C
G----C
A---T
T--A
CG
AT
G--C
A---T
A----T
C----G
C----G
A---T
A--T
CG
CG
G--C
G---C
G----C
A----T
T----A
C---G
G--C
CG
TA
A--T
A---T
G----C
A----T
A----T
C---G
A--T
GC
TA
G--C
C---G
T----A
G----C
G----C
C---G
T--A
AT
CG
G--C
G---C
T----A
C----G
G----C
C---G
C--G
CG
AT
T--A
C---G
G----C
G----C
A----T
T---A
G--C
CG
TA
G--C
A---T
G----C
A----T
G----C
.;@_{A
=> C
=>
G=>
T=>}
=0..3
;s;. *
(w).*
(w).*
n;$_
{ $-
++
/9
%2?$
2:$ 1
};gex;
s;(.)(
.)(.)(.
);chr
64*$
1+
16
*$2+
4 *$
3 +$
4 ;gex
; eval

%%
#Clinton Pierce
#note: Requires 5.6.0 or better

´% * % % * % %<>
* % ~ * % % * % * * % * *
* % % * * % * % *<> * % ~ % % % * %
* * * % * % % % % * % % % % % % * % % * %
% * % % ^ * % % % % *[] % % * * % * * % % %
% * % % % % % % * * % * * @ * @ % * % %
% ^ % * % * % * * % % * % <> % % % % * % %() %
% % * * * % % * % % * * % * * * * % * * % % * * *
% * * * % % * % % *[]<> % % % % * % * * * % % *<>
% * * % % % * * % * * * * % * * * %/ # % * *
% % % * * / * *// % % <> // % %/ % // % * %
* * * || / / % %// * /<> %// %// % %<>
* % * % | | ||// % || // // % // * * * %
%{} % * ---- | / %||// / ---/ / * % % *
% * * ____ | | / / / /----/ * %
---- | / // /
/ /´
=~m/(.*)/s;$_=$1;
s![-|_/s]!!g
;%e=(´%´,0,
´^´,132918,
´~´=>18054,
´@´=>19630,
´*´ =>0b01,
´#´=>13099,
´[]´=>4278,
´<>´=>2307,
´{}´=>9814,
´()´,2076);
for $a(keys
%e){$e{$a}=
sprintf"%b"
, $e{$a};}
$y= qq{(}.join(
´|´,map "Q$_E"
,keys %e).qq{)};s/$y
/$e{$1}/gex;print pack"B*",$_;