My last Perl program - a Perl obfuscater that can eat its own tail

OK, I admit it. I used to program in Perl. And I liked it! My Perl programs were terse. If I could shave a line off, I did. In fact, I spent a non-trivial amount of time figuring the shortest possible programs that solved various problems. Often that meant resorting to various tricks and arcane features of Perl that nobody other than me would bother to understand. I took pride in that. The same kind of pride a mathematician might feel at coming up with an elegant but opaque formula only another mathematician of his calibre could possibly understand and appreciate.

Eventually I saw the light and figured out that readability was much more useful than terseness. I think a big part of that was frustration at not being able to easily understand programs I wrote a couple of years back. That made me feel stupid. And in a way I was, in the sense that previously I was being temporarily too clever for my own good.

The next step was to move on to Python, a high-level interpreted language with exactly the opposite philosophy of Perl. That actually encouraged readability.

But before I moved on, I finished my last old-school "masterpiece" of Perl programming - a highly unreadable Perl obfuscater that could eat its own tail. I know, I know, as if Perl needed any more obfuscation. It's meant to be ironic, and it's been powering my tongue-in-cheek Perl obfuscation web service for a few years now.

In tribute to eclectic programmers everywhere, I am hereby publishing the "source code" for the first time, obfuscated by itself of course. Once you get past the obfuscation, it's a rather interesting piece of code. I doubt you will ever come across a more pathological use of the regular expression engine:

$ perl ./my-perl-obfuscator ./my-perl-obfuscator
#!/usr/bin/perl -w
my $OO00O00;while(<>){$OO00O00 .=$_;}my
@OO00000=("\x45\x4e\x56","\x41\x52\x47\x56"); my
@OO0OO=("\x45\x4e\x56","\x53\x49\x47","\x73","\x64","\x78");my
@OO000O=("\x41\x52\x47\x56","\x49\x53\x41");
my @OO00OOO=("\x41\x55\x54\x4f\x4c\x4f\x41\x44",
"\x42\x45\x47\x49\x4e","\x45\x4e\x44"); $OO00O00=~ s/(^\s*\#.*)//;my
$OO0O00O00=$1;$OO00O00=OO000O0($OO00O00);$OO00O00=OO00000($OO00O00);
$OO00O00=OO00O($OO00O00);$OO00O00=OOOO($OO00O00);
$OO00O00=OO0($OO00O00);$OO00O00=OOOO00($OO00O00);
$OO00O00=OO0O000O($OO00O00);$OO00O00=OOOO00($OO00O00);
$OO00O00=OO00O00O($OO00O00); print "$OO0O00O00\x0a$OO00O00\x0a";
sub OOO0{my $OOO0=shift; if($OOO0=~ /^(q[wq])\s*\((.*?)\)$/s){
my($OO00O0O,$OO0O)=($1,$2); return OOOOO($OO00O0O,$OO0O);}elsif($OOO0=~
/^(q[wq])\s*\[(.*?)\]$/s){my($OO00O0O,$OO0O)=($1,$2); return
OOOOO($OO00O0O,$OO0O);}elsif($OOO0=~
/^(q[wq])\s*\{(.*?)\}$/s){my($OO00O0O,$OO0O)=($1,$2); return
OOOOO($OO00O0O,$OO0O);}elsif($OOO0=~
/^(q[wq])\s*(.)(.*?)\2$/s){my($OO00O0O,$OO0O)=($1,$3); return
OOOOO($OO00O0O,$OO0O);}else{
die "\x65\x72\x72\x6f\x72\x3a\x20\x62\x61\x64\x20\x6f\x70\x65\x72".
"\x61\x74\x6f\x72\x20\x74\x6f\x20\x73\x69\x6d\x70\x6c\x69\x66\x79";}
return undef;} sub OO0O000O{my $OO00O00=shift;$OO00O00=~
s/(\bq[wq]\s*\(.*?\))/OOO0($1)/ges; $OO00O00=~
s/(\bq[wq]\s*\[.*?\])/OOO0($1)/ges;$OO00O00=~
s/(\bq[wq]\s*\{.*?\})/OOO0($1)/ges; $OO00O00=~
s/(\bq[wq]\s*(.).*?\2)/OOO0($1)/ges;return $OO00O00;}sub OO0O0O{ my
$OOOO0O=shift;my $OO0O0=unpack("\x42\x2a",pack("\x6e",$OOOO0O));$OO0O0=~
s/^0+//;$OO0O0=~ s/1/O/g;return $OO0O0;}sub OOO{my $OO0O00=shift;my
$OO00OOO0=shift;my
$OO00OO;while(1){$OO00OO=1+int(rand()*($$OO00OOO0));if(exists
$OO0O00->{$OO00OO}){$$OO00OOO0+=10;}
else{$OO0O00->{$OO00OO}=1;last;}}my $OO0O0=OO0O0O($OO00OO);return
"\x4f$OO0O0";}sub OO0OOO{$OO0000=10 unless
defined($OO0000);%OOOOO=()unless %OOOOO;return
OOO(\%OOOOO,\$OO0000);}sub OO00O00{$OO0O0000=10 unless
defined($OO0O0000);%OOOO=()unless %OOOO;return
OOO(\%OOOO,\$OO0O0000);}sub OO0O000{$OO00=10 unless
defined($OO00);%OO00OO=()unless %OO00OO;return
OOO(\%OO00OO,\$OO00);}sub OO0O{$OO0OOO0=10 unless
defined($OO0OOO0);%OO0O0=()unless %OO0O0;return
OOO(\%OO0O0,\$OO0OOO0);}sub OO000O0{my $OO00O00=shift;$OO00O00=~
s/(?<!\\)\#.*$//mg;return $OO00O00;}sub OO00O00O{my
$OO00O00=shift;$OO00O00=~ s/\s+/ /sg;$OO00O00=~
s/\s*([\:\?\(\)\{\}=;\,><\-\+\|])\s*/$1/sg;return "$OO00O00";}sub
OO00000{my $OO00O00=shift;my %OOOO0;my @OO0O=($OO00O00=~
m/\$([[:alpha:]_](?:\w|::)*)(?![\[\{])/g);foreach my
$OO0(@OO0O){next if $OO0 eq "\x5f";next if $OO0=~ /::/;next if
grep($OO0 eq $_,@OO00000);$OOOO0{$OO0}++;}foreach my $OO0(keys
%OOOO0){if($OOOO0{$OO0}==1){delete
$OOOO0{$OO0};next;}$OOOO0{$OO0}=OO0OOO();}my
$OOOOOO0=join("\x7c",keys %OOOO0);if($OOOOOO0){$OO00O00=~
s/\$($OOOOOO0)(?!::|\[|\{)\b/\$$OOOO0{$1}/g;$OO00O00=~
s/\$\{($OOOOOO0)\}/\$\{$OOOO0{$1}\}/g;}return $OO00O00;}sub OO00O{my
$OO00O00=shift;my %OO00O;my @OO0O=($OO00O00=~
m{\@([[:alpha:]_](?:\w|::)*)}g);@OO0O=(@OO0O,$OO00O00=~
m{\$([[:alpha:]_](?:\w|::)*\s*)\[}g);@OO0O=(@OO0O,$OO00O00=~
m{\$\{\s*([[:alpha:]_](?:\w|::)*)\s*\[}g);foreach my
$OO0O(@OO0O){next if $OO0O eq "\x5f";next if $OO0O eq
"\x41\x52\x47\x56";next if $OO0O eq "\x49\x53\x41";next if $OO0O=~
/::/;next if grep($OO0O eq $_,@OO000O);$OO00O{$OO0O}++;}foreach
$OO0O00O(keys %OO00O){if($OO00O{$OO0O00O}==1){delete
$OO00O{$OO0O00O};next;}$OO00O{$OO0O00O}=OO00O00();}my
$OO0OOO00=join("\x7c",keys %OO00O);if($OO0OOO00){$OO00O00=~
s/\@($OO0OOO00)(?<!::)\b/\@$OO00O{$1}/g;$OO00O00=~
s/\$($OO0OOO00)\s*\[/\$$OO00O{$1}\[/g;
$OO00O00=~ s/\$\{\s*($OO0OOO00)\s*\[\s*(.*?)\s*\]\s*\}/\${$OO00O{$1}\[$2\]}/g;}return
$OO00O00;}sub OOOO{my $OO00O00=shift;my %OO00;my @OO0O=($OO00O00=~
m{(?<!\%)\%([[:alpha:]_](?:\w|::)*)}g);@OO0O=(@OO0O,$OO00O00=~
m{\$([[:alpha:]_](?:\w|::)*)\s*\{}g);@OO0O=(@OO0O,$OO00O00=~
m{\$\{\s*([[:alpha:]_](?:\w|::)*)\s*\{}g);foreach my
$OO0O(@OO0O){next if $OO0O eq "\x5f";next if $OO0O=~ /::/;next if
grep($OO0O eq $_,@OO0OO);$OO00{$OO0O}++;}foreach $OO000(keys
%OO00){if($OO00{$OO000}==1){delete
$OO00{$OO000};next;}$OO00{$OO000}=OO0O000();}my
$OO0OO00=join("\x7c",keys %OO00);if($OO0OO00){$OO00O00=~
s/(?<!\%)\%($OO0OO00)(?<!::)\b/\%$OO00{$1}/g;$OO00O00=~
s/\$($OO0OO00)\s*\{/\$$OO00{$1}\{/g;$OO00O00=~
s/\$\{\s*($OO0OO00)\s*\{\s*(.*?)\s*\}\s*\}/\${$OO00{$1}\{$2\}}/g;}return
$OO00O00;}sub OO0{my $OO00O00=shift;my %OO0;my @OO0O=($OO00O00=~
m/sub\s+([[:alpha:]_]\w*)(?:\(.*?\))?\s*\{/g);foreach my
$OO0OOOO00(@OO0O){next if $OO0OOOO00=~ /::/;next if grep($OO0OOOO00
eq $_,@OO00OOO);$OO0{$OO0OOOO00}++;}foreach $OO0OOOO00(keys
%OO0){$OO0{$OO0OOOO00}=OO0O();}my $OOOOO000=join("\x7c",keys
%OO0);if($OOOOO000){$OO00O00=~
s/\b(?<!\$)($OOOOO000)\s*\((.*?)\)\s*/$OO0{$1}($2)/sg;$OO00O00=~
s/sub\s($OOOOO000)\s*\{/sub $OO0{$1}\{/g;}return $OO00O00;}sub
OOOO00{my $OO00O00=shift;$OO00O00=OOO0OO($OO00O00);$OO00O00=~
s/(?<!\\)\'((\\\'|.)*?)\'/sprintf("\x22\x25\x73\x22",OOO0O0($1))/sge;return
$OO00O00;}sub OOO0OO{sub OOO000{my $OO0O0OO0=shift;my
$quotes=shift;if($OO0O0OO0=~ /__raw__/){return
$OO0O0OO0;}$OO0O0OO0=~
s/((?<!\\)\".*?(?<!\\)\"|(?<!\\)\'.*?(?<!\\)\')/OO0O0($1)/xges;return
$OO0O0OO0;}my $OO00O00=shift;my $OO0O0OO0="";my $OOOOOO="";my
$OOO0O0;my @OO=split(/\n/,$OO00O00);for(my
$OOOOOO00=0;$OOOOOO00<@OO;$OOOOOO00++){$OOO0O0=$OO[$OOOOOO00];again:next
if $OOO0O0=~ /^\s*$/||$OOO0O0=~ /^\s*\#/;if($OOO0O0=~
s/\\$//){chomp($OOO0O0);$OOO0O0 .="\x0a";$OOO0O0
.=$OO[++$OOOOOO00];$OOO0O0 .="\x0a";goto again;}$OO0O0OO0
.="$OOO0O0\x0a";my @OO00=();while($OO0O0OO0=~
m{((?<!\\)\".*?(?<!\\)\"|(?<!\\)\'.*?(?<!\\)\')}xsgc){my
$OO00OO0=$1;push @OO00,$OO00OO0;}my
$OOO00=substr($OO0O0OO0,defined(pos($OO0O0OO0))?pos($OO0O0OO0):0);next
if($OOO00=~ /[\"\']/);if(@OO00){next if($OOO00=~
/^\s*$/);}else{$OOOOOO .=$OO0O0OO0;$OO0O0OO0="";next;}$OOOOOO
.=OOO000($OO0O0OO0,\@OO00);$OO0O0OO0="";}$OOOOOO .=$OO0O0OO0;return
$OOOOOO;}sub OOO0O{my $OO000OO=shift;$OO000OO=~
s/\\([\"\@\$])/$1/g;$OO000OO=~
s/\\x([a-fA-F0-9][a-fA-F0-9])/chr(hex($1))/ge;$OO000OO=~
s/\\(\d\d?\d?)/chr(oct($1))/ge;$OO000OO=~ s/\\\\/\\/g;return
$OO000OO;}sub OOO0O0{my $OOOO0=shift;$OOOO0=~
s/(.)/sprintf("\x5c\x78\x25\x30\x32\x78",ord($1))/geso;return
$OOOO0;}sub OO0O00{my $OOOO0=OOO0O(shift);return OOO0O0($OOOO0);}sub
OO0O0{my $OO=shift;$OO=~ s/\\n/chr(10)/ge;$OO=~
s/\\r/chr(13)/ge;$OO=~ s/\\t/chr(9)/ge;if($OO=~
/^\'(.*)\'$/s){$OO=OOO0O0($1);return "\x22$OO\x22";}elsif($OO=~
/^\"(.*)\"$/s){$OO=$1;my $OOOO0OO0=0;if($OO=~
s/(.*?)((?<!\\)\$\w+(?:[\{\[].*?[\]\}])?|(?<!\\)\$\{\s*
\w+(?:\s*[\{\[].*?[\]\}]\s*)?\s*\})/ $OO000OO=OO0O00($1).
$2,$OOOO0OO0+=length($OO000OO),$OO000OO/sgex){my
$OO00O=substr($OO,$OOOO0OO0);$OO=substr($OO,0,$OOOO0OO0).
OO0O00($OO00O);}else{$OO=OO0O00($OO);}}else{
die "\x62\x61\x64\x20\x73\x74\x72\x69\x6e\x67\x20\x69\x6e\x70\x75".
"\x74\x3a\x20\x40\x40\x40\x20$OO\x20\x40\x40\x40\x0a";
}return "\x22$OO\x22";}sub OOO00O{my $OO000OO=shift;$OO000OO=~
s/([\\\.\[\]\*\+\^\$\{\}\(\)])/\\$1/g;return $OO000OO;}sub
OOOOO{my($OO00O0O,$OO0O)=@_;if($OO00O0O eq "\x71\x77"){my
@OO0O0=split(/\s+/,$OO0O);return sprintf("\x28\x25\x73\x29",
join("\x2c\x20",map("\x27$_\x27",@OO0O0)));}if($OO00O0O
eq "\x71\x71"){$OO0O=~ s/(?<!\\)\"/\\"/g;return
"\x22$OO0O\x22";}return undef;}1;

Don't hate the player. Hate the game.