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

Closure JAPH No replies — Read more \| Post response	by aitap on Feb 06, 2013 at 13:46

Just thought that a sub returning itself would be a funny thing to write. Well, here it is, a dragon eating its own tail, even if it's not looking like the original one: `#!/usr/bin/perl use warnings; use strict; my ($j,$ a,$p,$h);$ j=sub{print( chr($p+=$a->[$ h++]));$j};;;$a =[0, split "[: \n]+", q/43 -002:1 -084 065:13 0001 000005 -0012 -00003 000013 -82 00048 21:13:-6.00:-76:72 -007.:02:00008.00 :::-6.00:::013 -70:3::-70:.64 /];$p=0x4a ;;$h=0; $j->()->()->()->()->()->()->()->()->()->()->()->()->()->()->()->()->() +->()->()->()->()->()->()->()->();` [download]
PERL hackers bank! can you get into the safe 1 direct reply — Read more / Contribute	by perlaintdead on Jan 10, 2013 at 00:04

any NSFWshow fans in obfu? also bonus points if you can crack the hash #!/usr/bin/perl print "Welcome to the Internation PERL Hackers Bank\n"; print "Pin: ";my$Pin =<> ;my$fapper;chomp $Pin;$Brian=crypt$Pin, "";goto l;i:if($Brian eq$fapper xor-!1){ print "successfull. you leet!";}else{print "you no leet yet."}; exit;f:w:n:n:n:nin:nnhz:ng:gh:l:Ls:b:w:; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!000;!!!!!!!!!!!!!!!!!!!!!!! +!!!!!1; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +!!!!!1; my@c;my@e=( "E","g","k","n","K", "s","w","R","a","B", "v","S","a","C","g", "a","O","g","s","a", "8","f","A","s","A"); local@a;push(@a,sort ord 80 );unshift(@a, sort'c');sort@a;my$r =!!defined$Pin ;1xor 1or 0;my$D=(not(not( not(not(not(not(not( not($#a)))))))));for (++$D;delete$e[($r)] ;$#e==$e[$r]){$~;$ r =$ r+$ D;::;}map{11; 1;$fapper=join undef, ${_},$fapper;()*8}@e; goto i;I:I:I:I:I:I:I: [download]
an ocean of perl creatures No replies — Read more \| Post response	by perlaintdead on Jan 04, 2013 at 02:01

jelly fish anyone? see download code below for proper formatting sub z{$i = pop;for($\|=1;&i;1){ c:x:k: n:e:r:} sub i{ foreach ( split( m!!, "just another perl hacker\n")){ unshift @I,$_ if ############################### +#### !! !!not $_ eq undef }}sub _ {$H_{ 'n'}=$int ######################### +######################## =+0;; return $H_{'n'}; sub __{ $_=~ m~(??{sub s{pop}; &s($_ );})~;return######################### +########## (($&, 'just ','another', 'perl', 'hack er'));}}}BEGIN #################### +###################### {&z(q~c~ );my@ g,%H_;$H_{'n'}=0;@m=__($_)and unshift @g,$m [(&_&&&_&&$#_)] ################# +######### foreach @I;map {print unless $_=~m/(\x0A\|\x0D)/;}@g;}; [download]
new to obfu JAPH 1 direct reply — Read more / Contribute	by perlaintdead on Jan 02, 2013 at 06:06

fairly new to obfu. but hears my 3rd attempt at it. see "download code" link for proper formatting $i= abs sqrt 1;$\|=1;for(my @s;$grove=~m; ;;$i=+"\x31"){caller;$grove=c +hr"\x$i".0}$o=1;$O=0;local@a =( # NAME: U.S.S. perl hacker # SPACE COMMANDER: perlaintdead # MISSION: To gaurd and protect the logic of this code 1,1 .$O. 5+1,$o.$o. 6+1,31+1,114+1,115+1, ' ',96+1,1 .$O. 9+1,112+1,115+1,# # \ /------------- 1 .$O. 3+1,1 .$O.$O +1,113+1,31+1,111+1,# * ===== +==\ 1 .$O.$O+1,1 .$o. 3+1, 1 .$O. 7+1,31+1,1 .$O. 3+1,# * *== + ==-====- 96+1,98+1,1 .$O. 6+1,1 .$O.$O+1,113+1# / \#_________ * ===== +==/ #27,123,136,2,,63,25,24,45,2435,235,# );map{push@s,chr}@a;my$R=(eval{1/(eval{0/0})})if shift@s;goto mi;; mi:rand$a. cos$grove; for($n=0;$n<5;++$n){uc "j";push@g,'8';}++$R+(eval{1**&x})until $R=$#g; +--$R-1 ;delete@s[(--$R)]; foreach(@s){s//o/ if$_=~m~q~;;;;;;;syswrite$~,$_}sub x{$six=+abs 1;$six=~m/$six/ while$& + lt abs sqrt 100;} [download]
/r JAPH 1 direct reply — Read more / Contribute	by trizen on Dec 29, 2012 at 03:41

Just for fun :P `print$/=~s~~r~r=~s~~e~r=~s~~k~r=~s~~c~r=~s~~a~r=~s~~h~r=~s~~ ~r=~s<> ~l~r=~s~~r~r=~s~~e~r=~s~~P~r=~s~~ ~r=~s~~r~r=~s~~e~r=~s~~h~r=~s~~t~r =~s~~o~r=~s~~n~r=~s~~a~r=~s~~ ~r=~s~~t~r=~s~~s~r=~s~~u~r=~s~~J~r////` [download] Bonus: \&~=~'\(';print+s{\x42}{$"}r,for($`..-$`)[4889245,650731,2540044,8375064,1505137],$/;
Snow flake 3 direct replies — Read more / Contribute	by eyepopslikeamosquito on Dec 18, 2012 at 06:06

⛄ ❄️ Feeling nostalgic, and just reminded by LanX of the time of the year, here's an old obfu I wrote ten years ago for the 2002 cam.pm Christmas programming contest: $_= q~v ZvZ&%(' $&"'"&( &"& $&"' "&$Z$#$$$#$%$& "'"& (&# %$&"'"&#Z#$$ $#%# %$%$%$%(%%%# %$%$%#Z"%#$ %$%$ %$%(%%%#%$%$ %# Z"%, ($% $% $%( %%%# %$ %$% #Z" %%" %$ %$%$ %(% %%# %$%$%# Z#%%"#%#%$ %$ %$%$##&#%$ %$%$%# Z$ &""$%"&$%$%$%#%"%"&%%$%$%#Z%&% &# %"'"'"'###%'"'"'"ZT%?ZT%?ZS'>Zv~;s;\s;;g;$~=q~ZZZJ_ #_ZH /'\\ZG\|#o #o#\|ZG\|$ <%\|ZH\\" \\!_!_!/" /ZG/ )\\ ZF/+\\Z E\|-\|ZE \|-\|ZE\| -\|ZF\\+ /ZG \\)/ ~;;@x=@,= +map{$.= $";;join "",map((( $.^= O)x(-33+ord)),/./g)}split+Z;$~=~s~\s~~g;;s;.;(rand)< .2 ?"o":$";egx for@;=(5x84)x30;map {# system $^O=~W?CLS :+ "clear";;; ;print $_. $/, ,for $_ -18? @;: ### (( map{ $\|= 1; ;;; join "" ,map($\|--?$" x(-3 11+ord):$_, /./g)}split+ Z,$~ ),@x);splice @;, -$_, 2,pop@,;@;=("" ,@;) ;;; ;sleep! $%}+2.. 18# /-\ [download] Update 2021: changed `egxfor` to `egx for` to work with later version of Perl v5.32.
Game of life ran by unpack function 4 direct replies — Read more / Contribute	by ambrus on Dec 11, 2012 at 15:41

The language designer said to the programmer: �Thank you for freeing me from my prejudices. I understand now that a language must not try to force the programmers to follow any single paradigm, but should instead offer all the features the programmer may want to use. As a reward, you may wish for any three features and I will add them to the language.� The programmer replied: �I'd like a powerful domain-specific language for blowing up binary strings to small parts.� The language designer granted the programmer's wish, and the programmer promptly tried it, saying #!perl use warnings; use strict; use 5.010; use Time::HiRes "sleep"; our $DELAY = 0.05; # determine size of terminal my $w = pack "S4", 24, 79; ioctl STDIN, $_, $w for 0x40087468, 0x5413; our($R, $C) = unpack "S2", $w; $R--; our $b; if (rand 3 < 1) { # glider gun pattern $b = pack "(A$C)[Lx$R]", ("")x3, split /^/, " 1 1 1 11 11 11 1 1 11 11 11 1 1 11 11 1 1 11 1 1 1 1 1 1 1 11 "; } else { # generate random bitmap as starting state $b = pack "(A)", map { rand 3 < 1 } 0 .. 2$R$C; } system qw"tput clear"; while () { # display game board system qw"tput home"; say for unpack "xx$C(a$C)$R", $b; sleep $DELAY; # game of life evolution step no warnings "numeric"; $b = pack "xx$C(A)xx$C", unpack "(x7a/(x13)X4Ax!18)[(A$R)$C]", pack "((a)17xx!18)x3", unpack "((AAAX3AAA\@$C AXAAAXAx$C (X3AAA)2\@)$C)$R", $b; } __END__ [download] The programmer watched the pretty patterns appearing in his terminal. After a while, the language designer asked �And your other wishes?� The programmer's reply was �Why would I need other wishes?� Read more... Remarks (2 kB)
Determining if a rational number terminates 3 direct replies — Read more / Contribute	by blackle on Nov 29, 2012 at 10:56

Hello all. A friend of mine had participated in a programming competition for his school. He did pretty well, but he couldn't get one question. The question was, given the numerator and denominator of a rational number, determine if the decimal expansion terminates. This is to say, if I gave you 1/3, you would say it doesn't because the expansion is "0.3333..." Likewise, if I gave you 1/10, you would say it does terminate because the expansion is "0.1" My friend had tried to solve this problem with string operations, but I found a better way. According to the Wikipedia article for repeating decimals, rational numbers that terminate are in the form `a/b -> b = 2^c5^d` where c and d are natural numbers. Given this identity, I developed the following (obfu) one-liner: `print"N",(map{"\rY"if(unpack"b52",pack"d",$=/5*$_)<1}0..log($==pop)), +$/` [download] Given `$ARGV[0] = a; $ARGV[1] = b` the program will say "Y" if the decimal terminates and "N" if it doesn't. The spoiler below reveals how the program works: <Reveal this spoiler or all in this thread>
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'`

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