Obfuscated code

Got some code which would take a Perl grand master to understand without running it? Post it in this section so we can stare at it in awe.

Word of warning, though: Don't be too cocky with your post — almost inevitably someone will post a reply that does the exact same thing in even fewer characters!

New Less than Readable Code

JAPH Made Entirely of Colons 3 direct replies — Read more / Contribute	by ColonelPanic on Nov 28, 2012 at 03:31

Inspired by tobyink's recent post... `use warnings; use strict; package :::::::::: {$_=q:!:;$:::::::::: =q;:;;sub :::::::::: {s::@_:}}&:::::::::: ($ :::::::::: . ':::::::::: ',$ :::::::::: x10);$ :::::::::: =q;::;;s. :::::::::: .$ :::::::::: \.$ :::::::::: \.' '\.$ :::::::::: \.$ :::::::::: \.$:::::::::: .gex;s: \n::gx;print` [download] When's the last time you used duct tape on a duct? --Larry Wall
Perl allows package names consisting entirely of colons 4 direct replies — Read more / Contribute	by tobyink on Nov 27, 2012 at 07:43

It seems quite bizarre that this works... `use v5.14; use strict; use warnings FATAL => qw(all); package :::::::: { sub x { printf "(%s)\n", __PACKAGE__ }; } ::::::::::x ();` [download] `perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'`
Just another Perl JAPH, No replies — Read more \| Post response	by tobyink on Nov 16, 2012 at 12:00

`use 5.016;use strict;$_+=$^F;1980=~/(..)(..)/;@$=('a'..'z')x($_**$_);$ +"=q[];say map qq(@$_ ),[map$$[$_+ord($;)],-$1,-8,-$1/2,$1=~s/1/-/r]=>[$$[0],$$[o +rd q$'$], chr(!!$^F x 3),"@{[@$[1985=~/(..)(..)/i]]}",$.=reverse're']=>[$$[-1+or +d($.)/6], $.,q@l@]=>[$$[ord($.)/3],$$[$-],$$[--$^F+!!$=],$$[$_+$=].$..q.,.] # qw +(tobyink)` [download] `perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'`
meta JAPH No replies — Read more \| Post response	by ColonelPanic on Nov 15, 2012 at 10:05

I am having too much fun, but here is another one: #!/usr/bin/perl $_=q\|trdKVO99Rhlokd:trdGSLK99O`qrdq:#o<GSLK99O` qrdq,=mdv'cde`tks^g<=Zrtaz#^<rghes:#^%%'r.[Zcnv mkn`c[\..+du`k(\\|+&csdws&\(:fds'!gsso9..vvv-odq klnmjr-nqf.>mncd^hc<#^Z/\!(<}.;oqdbk`rr<!bncd!= '-)>(;[.oqd=.r:#o,=o`qrd'#0(\|;sub AUTOLOAD{@_?( $_=~s/(.)\n?/chr(ord($1)+1)/egx,eval):AUTOLOAD( $AUTOLOAD=~s/\D//gr);}&split5and5and5chop6chop6 [download] Ok, string mangling is rather unoriginal, but observe how small changes can lead to a very different result: #!/usr/bin/perl $_=q\|trdKVO99Rhlokd:trdGSLK99O`qrdq:#o<GSLK99O` qrdq,=mdv'cde`tks^g<=Zrtaz#^<rghes:#^%%'r.[Zcnv mkn`c[\..+du`k(\\|+&csdws&\(:fds'!gsso9..vvv-odq klnmjr-nqf.>mncd^hc<#^Z/\!(<}.;oqdbk`rr<!bncd!= '-)>(;[.oqd=.r:#o,=o`qrd'#0(\|;sub AUTOLOAD{@_?( $_=~s/(.)\n?/chr(ord($1)+1)/egx,eval):AUTOLOAD( $AUTOLOAD=~s/\D//gr);}&split9join9chop75chop88; [download] And there are many other possibilities, too. I have to credit Athanasius for his help on this one. When's the last time you used duct tape on a duct? --Larry Wall
Too Obvious? No replies — Read more \| Post response	by ColonelPanic on Nov 08, 2012 at 07:48

It's been eight years since I've posted anything on this site. Here is one just for old times' sake: `$_=q chop ($b,$r);$/--#ac.'';y$near) h.g($_+ 0;e;0en$.' Perl';my $w="Another$/Just ".qq g q qq g;$d='3.l4159!=Hacker';$d=~s/[\d l ]/./gix;$e.=' eva'.($d=~s/[a-i]//gi\|$d=~y/=!rn/.()J/?'l;':'s/t// ').' '.($d=~s/k//+eval '$d=~y/P/H/'? '$_= <$b>;s a$da$1ags':new); eval$e;print;#my Japh done?` [download] When's the last time you used duct tape on a duct? --Larry Wall
JPEG Zig-Zag No replies — Read more \| Post response	by blackle on Oct 29, 2012 at 13:07

For the last week I've been trying to figure out an algorithm for JPEG's zig-zag spacefilling curve. Specifically, I wanted an algorithm that maps all elements in an NxN matrix to a NN array given their x and y values. I finally figured it out with the help of my analysis 101 TA. He's not a computer scientist, but he knows what pairing functions are. Anyway, after a few hours messing with perl, I made this subroutine: `sub getPos{ ($x,$y,$s)=@_;($d=$x+$y)($d++)/2 +($d%2?$y:$x)-($d>$s)($d-$s)2 }` [download] To use it, you do something like this: `for(my $x = 0; $x < $size; $x++){ for(my $y = 0; $y < $size; $y++){ print getPos($x, $y, $size)." "; } print "\n"; }` [download] For `$size = 10` the loop will yield: `0 1 5 6 14 15 27 28 44 45 2 4 7 13 16 26 29 43 46 63 3 8 12 17 25 30 42 47 62 64 9 11 18 24 31 41 48 61 65 78 10 19 23 32 40 49 60 66 77 79 20 22 33 39 50 59 67 76 80 89 21 34 38 51 58 68 75 81 88 90 35 37 52 57 69 74 82 87 91 96 36 53 56 70 73 83 86 92 95 97 54 55 71 72 84 85 93 94 98 99` [download] The body of getPos has 65 (non-whitespace) characters, any ideas on how to get it even smaller? <Reveal this spoiler or all in this thread> UPDATE: This prints a JPEG zig-zag when $ARGV[0] is the size of the matrix: `$==pop;print map{$y=$_;map(($d=$y+$_)$d++/2-($d>$=)($d-$=)*2+($d&1? +$_:$y).$",@m),$/}@m=0..$=-1` [download] 97 characters! I started at 125!
Progressive JAPH 4 direct replies — Read more / Contribute	by Athanasius on Oct 06, 2012 at 02:41

OK, I’m sure this sort of thing must have been done before. But — well, it was a lot more fun to code it myself than to search for someone else’s implementation `;-)` `#! perl -w use strict;use Time::HiRes"usleep";sub o ($){hex$_[0]}++$\|;my@t=(q,4a75737420,.qq ;616E6f74686572205065726c206861636B65;.q ,722c,)=~m,(..),xg;our($0,@c)=qq;%X;;sub _{print(qq,\r,,join('',map{chr hex}@c)); usleep(274*2)}sub r{sprintf($0,int(rand 0x5e)+040);}$c[$_]=r for+0..$#t;_;my@z=( -0..$#c);sub n{my($O)=@z;do{$O++if(o$c[$ _]==o$t[$_])}for@z;$O}do{for(@z){$c[$_]= r unless(o$c[$_]==o$t[$_])}},_ while@t>n` [download] Enjoy! Athanasius <°(((>< contra mundum*
Dual language 4 direct replies — Read more / Contribute	by smeezekitty on Sep 22, 2012 at 01:26

I hope this is the right place for this. I have been messing with perl a bunch today a managed to take advantage of how Perl and C use different comment characters. Here are two methods to write a program that runs as either C or Perl: #include <stdio.h> // prints 99 Bottles of beer on the wall. Works as +either a C or a Perl program. #define PERL C /* "/ int main(){//"; { int $bottles; $bottles=99; while($bottles){ printf("%d bottle%s of beer on the wall, %d bottle%s of beer.\ +n", $bottles, $bottles==1?"":"s", $bottles, $bottles==1?"":"s"); printf("Take one down and pass it around, "); if($bottles==1){ printf("no more bottles of beer on the wall.\n\n"); } else{ printf("%d bottle%s of beer on the wall.\n\n", $bottles-1, + $bottles==2?"":"s"); } $bottles--; } printf("No more bottles of beer on the wall, no more bottles of be +er.\n"); printf("Go to the store and buy some more, 99 bottles of beer of t +he wall."); } [download] and using a bit different method: `#include <stdio.h> #define sub void #define $x char $t #define chomp gets sub main(){ $x; printf("Please enter your name: "); #if 0 $t = <>; #endif chomp($t); printf("Hello, %s!", $t); } #if 0 main(); #endif` [download]
My first JAPH 1 direct reply — Read more / Contribute	by smeezekitty on Sep 21, 2012 at 01:36

I don't know if something like this has been done before but: `no warnings;@N=(0..9,'a'..'z');%N=map{$N[$_]=>$_}0..$#N;sub esabot{ $b=6*6;$n=shift;$R="";while($n>0){$R=$N[$n%$b].$R;$n=int($n/$b);}retur +n$R;} $SWNFZVDCVL=0xE22AD;$BVWEIQUHMO=0x566D77163;$NSANMOBGBP=0x121701;$GSPB +PGWHWT=0x3E4E2053; $TXHU=esabot($SWNFZVDCVL);$TXHU=~s/j/J/g;$XZFG=esabot($NSANMOBGBP);$XZ +FG=~s/p/P/g; print$TXHU.' '.esabot($BVWEIQUHMO).' '.$XZFG.' '.esabot($GSPBPGWHWT)." +,";` [download]
BEGIN {} No replies — Read more \| Post response	by GlitchMr on Aug 20, 2012 at 14:39

Nothing special, but I thought I will post really simple JAPH just to do anything :). BEGIN{''=~('RQKkCx0KF=/:^V/q_($I:&bl)ga<[H6!dqEkI]eiQ&s3+dW&::ra8CE' .'0kpdA]?Lk.CZDT]n4:jDn!kpilJBWgx\|I5$fJS"ULkwImV>lmwsmR,(x\|Lc9wAGT'. 'W;/BVGr42.hVnwk(sC<jv3QPP=]Q_nT!/!?BgRq8.K-)60Ag1wA-L!+A,HRV*:$r_E^' .'xXSH;BRyGb'^'zn0LdENcaoMnlev"lELwpn$Rk.&rcvpM<(n5cp;Byg.MgX=yZb@L'. ']XsmFUFOicXd1~%uiwhDxr4n/f<QUB.kf2fO^~kcB#;S>~[>n3qD1B52]okgZ7u__(m' .'agqfc$jzYsLl$k.:XYQalZ>krt)Mr#6T5GLHR`2mP~R2ONHGjUtEcZ>IAjP-<yqw`'. 'I82cTlj(v"uP:K') }sort print die q tie use require reverse scalar uc [download]

	For:		Use:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`