PREVIOUS  TABLE OF CONTENTS  NEXT 

The Fourth Annual Obfuscated Perl Contest Results

Felix Gallo

Obfuscated Perl Contest Fifty-seven contest entries hemorrhaged forth into our FTP directory. Previous contests have been perhaps more synapse-curdlingly intense; the hallmark of this year was sheer volume. Of course, we in the judging committee are all very relieved that the collective obfuscatory powers of the Perl community have plateaued and are now declining - some of us are even slated to eat solid food again soon! Next year promises to be trivial! This is getting so easy!

The First Circle

Print a human-readable "The Perl Journal".

Third place: Tramm Hudson's steganography entry, cleverly done (albeit misspelled) - but the very last abuse of whitespace ever to be permitted in this category, ever ever ever.

Second place: John Keating's monolithically forbidding block of old-skool obfuscated code. Extra points for assigning to $!.

First place: Keith Winstein's optical character recognition engine. both judges almost figured this one out after Keith blew his cover by naming a subroutine ocr. Clever code, however!

#!/usr/bin/perl -l

print ocr(<<TPJ);
 #  # # ## ##  ## ##  #    #  #  # # ##  #  #  #  #
### # # #  # # #  # # #    # # # # # # # ## # # # #
 #  ### ## ##  ## ##  #    # # # # # ##  # ## ### #
 #  # # #  #   #  # # #  # # # # # # # # #  # # # #
 #  # # ## #   ## # # ## ###  #  ### # # #  # # # ##
TPJ

sub ocr{@{$-[$@++]}=split$,for(split'\n',shift);for$@(0..4){for(0..51){++$_{$_
 }if($-[$@][$_]=~$")}}@&=(-1);for(sort{$a<=>$b}keys%_){push@&,$_ if($_{$_}>4)
  }push@&,52;for$@(0..13){@{$|[$@][$_]}=@{$-[$_]}[$&[$@]+1..$&[$@+1]-1]for(0..
   4)}for(@|){**=$_;$w=@{$*[$^=$$=0]}-1;for$@(0..4){for(1..$w){$^++if$*[$@][$_
    ]ne$*[$@][$_-1]}}for(0..$w){for$@(1..4){$$++ if$*[$@][$_]ne$*[$@-1][$_]}}
     for(0..20){push@},chr$_+65if(7*(8,4,2,9,2,3,7,8,1,$@,5,4,9,10,10,6,3,8,4,
      8,8)[$_]+(5,8,3,3,4,2,1,2,8,2,7,1,5,4,6,$@,3,6,8,4,1)[$_]==7*$^+$$)}}@}} 

Dishonorable mention: Sven Neuhaus' .signature-sized entry, and Les Peters' nicely formatted periodic table of elements.

The Second Circle

Do something powerful.

Third place: Eugene's sweetly concise self-printing program. Not very powerful, but pound-for-pound a contender.

 $_=q(s%(.*)%$_=qq(\$_=q($1),$1),print%e),s%(.*)%$_=qq(\$_=q($1),$1),print%e 

Second place: Mike Guidero's string permuter, useful for making your screen look like something from Wargames!

#!/usr/bin/perl 
G:  *S=sub{goto shift};*T=sub{exit shift};*U=sub{print shift}; 
H:  my $A="";my $C=0;my $D=0;my $E=0;my $F=0;my $G=0;my $H=0;my @I; 
I:  if(!defined($A=$ARGV[0])){U(qw(ARGV[0]?));U("\n");T(1)}$C=length($A);
    U("-$A-\n");$D=0; 
J:  $F=0;$I[$D]=0;if($D!=$C){S(K)}for($G=0;$G<$C;$G++){U(substr($A,$I[$G],1))
    }$H++;U("\t");$H%8||U("\n");S(M); 
K:  $F=$D;if($F!=0){S(N)}$E=$I[0];if($E==$C){U("\n---\n$H\n");T(0)} 
L:  $D++;S(J); 
M:  $D--;$I[$D]++;S(K); 
N:  $F=$I[$D];if($F==$C){S(M)}$E=$D-1; 
O:  if($F==$I[$E]){S(P)}$E--;if($E!=-1){S(O)}S(L); 
P:  $I[$D]++;S(N); 

First place: Claudio Calvelli's comp.lang.perl.announce newsreader, a monstrous piece of code which delves into 8-bit characters and still has 28 bytes of headroom.

Dishonorable mention: Robert Klep's implementation of just one software munition, which unfortunately didn't run on one of the judges' machines. Note to future contestants: the new bar for crypto consideration is three or more algorithms in one program, preferably all illegal, preferably all military-grade.

The Third Circle

Be creative.

Third place: There weren't enough quality entries to justify giving a third prize in this category. Maybe next year we'll give two.

Second place: Art Ramos's implementation of Windows Minesweeper. Cute, pretty clever - but...

First place: Andreas Hagelberg's implementation of Windows Minesweeper. It's fairly ironic that a Perl contest with a creativity category results in two implementations of a Microsoft timewaster; nevertheless, Andreas's entry has some nifty features.

srand;for(0..5){$r[$_]=chr 65+rand 8}sub d{print$/x6;for(0..335)
{print$_<27&$_>13?'-':$_%14>12?"\n":$_<6?$_[0]?$r[$_]:
'O': $_%14==6?'|':(split//,$b[int$_/14])[$_%14]||$"}print"$/Enter 
m/[A-Ha-h]{6}/\n"}sub c{return if/[^A-H]/||length()-6;@c=split//,
${$f=\($b[24-++$w]=uc.$")};$w>21&&return 1;for(-6..35){($p[$h]=1)
&($q[$h]=1)&($$f.="*")&$n++if$_<0&&$c[$h=$_+6]eq$r[$h];
!$p[$b]&&!$q[$d]&&($p[$b]=1)&($q[$d]=1)&($$f.="+")
if$c[$d=$_%6]eq$r[$b=$_/6]&&$_>-1}(d$])&die"Done$/"if$n>5;
$n=@p=@q=()}while(!c){d|chop($_=uc<>)}d$/;print"$/Looser!$/" 

The Fourth Circle

Make believe you're another language.

Third place: Claudio Calvelli's Intercal script. Intercal, Perl's mad aunt, is just the sort of beautiful language people accuse Perl of being.

Second place: Philippe Bruhat's wc (word count) script, which compiles both in C and in Perl, caused one judge to leap from his chair and go wash his hands obsessively.

#include <sys/types.h> 
#include <sys/stat.h> 
#include <stdio.h> 
#include <fcntl.h> 
#define open(a,b) open(b,a) 
#define $ARGV argv 
#define $i i 
#define x : /* aren't four #define way too much?
               unshift @ARGV, $_ = $ARGV[0]; "*/ 
main(int argc, char *argv[]) { // "; {
  int m=1, i[14]; char * pp; int p=-1;
  int q, F=3; char * qq = "Hello\, world!\n";
      i[12]=537463307; i[13]=3085; //,; $_ = "" if(length!=2);
  if(m+-p?(argc>1&&!strcmp(argv[1],"-p"))?p+i? 1 : 1 x 0 x 0) {
    printf(qq/*\bThe Perl Journal\n/#*/
          ); exit(0); }
  qq="=;#"; argv[0][0]='\0'; memset(i,0,48);
  $i[10]=($i[11]=(q/*\b/&&scalar@ARGV))-1;#*/=0) + argc)-1;
  do{
    if($i[11]<2) { $i[10]=1; q/*/&&*F=*STDIN;#*/=F=0;
    } else { open(O_RDONLY, $ARGV[$i[11]-$i[10]]);//; *F=*O_RDONLY;
    }
    while(read(F, $i, 1)>0) {
      ++$i[4]^(q=/*.=,$_=$i);#*/0); pp=i;
      $i[3]+=m=( *pp^0x0A)?/*\n=;#*/0:1; for(qq=&i[12];*qq;*pp^*qq++||(q=1));
      if(m=/*[ 	\n\f\r\xB]=#*/q
        ) { if($i[1]){$i[$i[1]]++; $i[1]=0; }} else { $i[1]=2;}
    }
    if($i[1]){$i[$i[1]]++;};
    printf("%7d %7d %7d %s\n",$i[3],$i[2],$i[4],$ARGV[$i[11]-$i[10]]);
    close(F);
    if($i[11]>2){for($i[1]=2;$i[$i[1]+4]+=$i[$i[1]];$i[1]++){$i[$i[1]]=0;};$i[1]=0;}
  } while(--$i[10]);
  if($i[11]>2) { printf("%7d %7d %7d total\n",$i[7],$i[6],$i[8]); } 
}

First place: Chris Howe's mad, bizarre Befunge interpreter. Befunge is the sort of thing they might hold a 'Comprehensible Befunge Contest' for. Quite brilliant really.

#  ^ 
#,_:@ 
BEGIN{$l="ub";$_='KN($){$d=$_[0]}KL(){$B[$R][$C]}KM{$a=@{$B[$R]};
$d==0&&($C++,$C>=$a&&($C=0));$d==2&&($C||($C=$a),$C--);
$d==3&&($R++,$R>=@B&&($R=0));$d==1&&($R||($R=@B),$R--);}
KP($){push@S,shift}KJ(){pop@S||0}KX(){@S[-1,-2]=@S[-2,-1]}KR() 
{push@S,$S[-1]}KW($$){"Z".$_[0]."Z,K{".$_[1]."},"}KG($){($_)=($a)=@_;
y/\`/>/;W$a," X;P(J$_ J)"}KD($){($a)=@_;W$a,ZP Z.$a}KE($){($_)=($a)
=@_;y/0123/>^<v/;W $_,"N $a"}';y/Z/\'/;s/K/s$l /g;my($R,$C,@S);
eval$_;}$_=$x=W '_','N(J?2:0)';y/_02/|31/;$x.=$_ 
#r^>\"J eg"1+T,,,,l# 
; $u=W '"','@T[0,1]=@T[1,0]';$_=$x.$u.W('!','P!J').W('?','P int 
rand(4)').W(':','R').W('\\\\','X').W("\$",'J').W(' ',"").W('#','M')
.W('.',"pIJ,chr(32)").W(',',"pIchr J").W('@',"pI'\n';exit").W('g','X 
;P ord$B[J][J]').W('p','X;$a=\\$B[J][J];$$a =chr J;');s/I/rint /g;@T=eval 
join"\n",'({',(map{D$_}(0..9)),(map{E$_}(0..3)) 
,(map{G$_}split//,'+-*%/`'),$_,'},{',$u,'})';for(@B=<>){$_= 
[split/\n*/]}while(1){$_=L;$_=" "if!defined$_;~y/\s/ /;exists$T[0]{$_}?$T[0]
{$_}->():P ord$_;M;} 

Befunge is a two-dimensional language. The instruction pointer, instead of moving from one line to the next in a comforting logical sequence like every other language, moves character by character - and not always from left to right. When the instruction pointer hits a v, it moves down whatever column it's in. When it hits a ^, it moves up. < and > move the pointer left and right. Befunge programs wend their way around the page, and the one created by Chris' program eventually prints "The Perl Journal". You can learn more about Befunge at http://www.loungelizard.com/pascal/befunge/beffaq.html.

Dishonorable mention: Clifford Adams' use of NO CARRIER was a welcome blast from the past. ?SYNTAX ERROR, anyone?

This year's Grand Prize goes to Chris Howe for the most creative, powerful, incomprehensible, and shapeshifty submission: his Befunge interpreter. Such attention to detail! Such painstaking mutilation! It is clear the authorities need to be made aware of Mr. Chris Howe.

Reading these entries and trying to figure them out for yourself is a great way to learn a lot about Perl very quickly (as long as you don't pick up all the bad habits!) We strongly recommend that anyone interested in getting really good at Perl go check them out at http://tpj.com/programs.html.

Thanks to everyone for making this year so simple to judge! For the relatively unscathed judging committee,
Felix Gallo

__END__


PREVIOUS  TABLE OF CONTENTS  NEXT