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
Short quines
4 direct replies — Read more / Contribute
by ambrus
on Jan 11, 2008 at 12:45

    This node contains a couple of short non-empty non-cheating perl quines. I've had most of this collection for ages, but have apparently never posted them on perlmonks.

    One of these quines (323e) is the shortest non-empty one I know, but it has the disadvantage that it only works in perl 5.6.0 or later.

    323a: 44 40

    print<DATA>x2 __END__ print<DATA>x2 __END__

    323b: 35 32

    print<<''x2,"\n" print<<''x2,"\n"

    323c: 44 44

    $a=q(;print"\$a=q($a)$a");print"\$a=q($a)$a"

    323d: 50 48

    $\="\47";print,print for'$\="\47";print,print for'

    323e: 31 26

    print<< x2,v10 print<< x2,v10

    323f: 46 44

    $\=v39;print,print for'$\=v39;print,print for'

    323g: 58 57

    print"$_\Q$_\E\"\n"for"print\"\$_\\Q\$_\\E\\\"\\n\"for\""

    323h: 52 52

    print"$_\Q$_\E\""for"print\"\$_\\Q\$_\\E\\\"\"for\""


    Update 2012-12-12: see also General quine, How I Learned About Quines, Quine Whine, Is there a non-empty error quine in perl?.

Season greetings
5 direct replies — Read more / Contribute
by olus
on Jan 03, 2008 at 19:55
    Well, until Jan 6th the tree still stands, so here are my (late) season greetings.
    Not a great obfu, just having some fun :)
    perl -e ' # ### $OoO= "\e[H"; 00;$oOo = "\e[1J";sub o {print @_;} o $oOo ; sub x{ ($o , $O ) = @_ ; sprintf("% 13s%s\n" , $o, $O )} sub O { o $OoO ; $c = "*" ; map {$o = $c x$_;$O=$c x($_-1 );$d="@";sub k {$Q = shift; map{ substr($Q,rand(length($Q ) ), 1) = $d }( 1..length($Q) - 1);return$Q;} $o=k($o); $_>1?$O=k ($O):"";$d="/"; $o=k($o); $_>1?$O=k ( $O ) : "" ; $a [ $_ ] =x($o, $O ); }(1 ..12);o@a;o x"||";o x"||";sleep 1;o ;;O() ;}O;; '

    For Linux and MacOSX [and Windows (thanks CountZero for letting me know)].
TETRA CTYS
1 direct reply — Read more / Contribute
by llll
on Jan 03, 2008 at 05:11
    #!/usr/bin/perl#? #3rdeyeperls# # #hllllp# # ### # # #0# $a = 1; $b = 1 + 2; $c = 1 + 2 + 3; $d = 1 + 2 + 3 + 4; $e = $a + $b + $c + $d; $x=$e/5;$y=$x;print$x;print$y; #who/what?? is snowing my window #
JAPH to commemorate the release of Perl 5.10.0
1 direct reply — Read more / Contribute
by ambrus
on Dec 19, 2007 at 07:11
    use 5.010_000; use warnings; use strict; for my $l (map [unpack "(A)*", $_], qw" \" |*'!~ |%+:( >|(+: }~|:*( |!:( ;(!:^| ;='*( \"") { for (map { {unpack "(A.)*"} } qw"^ = = = | [ ] ( ~ ~ ~ (-: [ ] !( ~ ~ ~ + [ ] %>* * * * ! [ ] ; ; [ ] %= |= = [ ] : ' ' ' : [ ] '( } } } *(") { when ($l) { print "@" } print " " } say ""; }
Hilbert + Dragon = Obfu
No replies — Read more | Post response
by benizi
on Dec 19, 2007 at 04:38

    The Hilbert Dragon

    By default, this adds PerlTk graphics to Hilbert Curve. But, as penance for irritating the math gods (Math >> XKCD, even in my book), this one allows you to input any L-system you want.

    Update: Forgot to explain that the obfu's pattern is in the (negative) shape of the Penrose dragon, but it makes the Hilbert curve by default. (hence "the Hilbert Dragon").

    #!/usr/bin/perl use strict; use warnings; ;$_=q~&6P+H;M`4K]N!L$5@QtDLBO1`4#]AKC(mdfFkDqXF$1dEc+D>$3uAA[>Fm9@P&QN +[CZ>BJ X:"*2Bf@Rj)h(@ZIXvH`P6DR0zHAJR#@admir{JKMP,NBZ8IC`*NB$xDHXPJ^DhAH;TVB( +.kbyTJ X>J"HbMBX&D!`al{ ]^m)NXnBhYd+ZCpC MVEA0`H"8(JbX$L"PjDv`H +'C,lOg Y:MC,2EB@FT]m*CC tFAD G@9.%]p@PlPbEPqX D"G1 E;eY=M@VdD$dx[q<bD|k`4 +OD8"rT OBL`$yMELDDHc!tO DHfD DadnZ@4+sRF1\\9$ `b3z Jq\\D2X#%Hd$PD@tieRZ@J +TE\\)` HD!hHA.H@4NaMZB@ iFL,"@&6HP D>sOdDPY{ELj$H@E +Tm`P)P T^`l!d<i`Q\\7P]aF;%NOw 0ne| B$Yd@IF`r7DJy$5B @PP% tF@HEf?Fx>.YKJ@H +]9bwem !,a!`p]71aEH^`'NcwPXyT K&0L \\PEl(D<hLLn9PSS SL%A OD`PECT`p*!.0A4j +yPV{;P |gev 67`A XPDm /PJ`)TC<OADOmP8a +pHA|HA (x:0 `dJX ALF! XE@P $T\\ H`3k AHF> fX^{ 8@ws%tI@XB`n,Z@@&KfGxN +h>J`G@ "AX8 `@Hp 'bdD @_+> aXJA zV!T E>"@ xB2N @\\C`GKZA>CXiBJJ`*b$I0 +BBldpa qLHH jBJA @uIP g1[`IC0BQ@@`\\#& +q@OCP) P'B(HpA@F@ hH@$KDdrWI(,C^FQVE\\J4L`HF08 BFX9 TA2? $]Ap?`lGmDtTQU@d +MP?DHx Q0KLi`HH[1 G.R<k`|<Y*Ch+P[@:?DkqKD|T"]L ;y13 M\\5 Q7Mp[@}O`!gnLT+0 +ZFs>TY B@)H `VrE4N.Y<AwCPO(`|tvchG mNKiSp,oMLUQ@zGX +YPqGKH bf{Q W/D<`M@"^1WlbFuH@ZYMZOJBS724 w]J@ @R([ @P>YU,^_Sj'@kK$+V[I;MF +K8PB*C ka&Q Z!|"gBHjKfHPNI<\\r@`HI{Sa>G+ >B[] JDFt BKdKUSXHMVK@IJ>D9$A6M@ +5CXMyn !&\\ @;`D aB@`P_hF@eS@)F0G %k'l JxdBRI$Y(B + D@8f DDxDbvRhd6 2D|< @HIHFi9"^JyF@pC@Bv(BAN48$!:V[`B&xR 9y_dXE,@r#+WzMXA + @D0h 2f:NJGce&) Vbi% .\\Y"V]J@QbB9"M@pn)LAD7Zg(hMeZU@[X yi=8Xxo%wGt.(8az + Unq{ NCr?[NkU4[ Olm7[S,u5[Y.EuB:@`*DHx[$B![X n6t> + lFb1 VRA[O]e4`L0@D`_SX8|YfPHHVx\\<X%"dY.G#`&@@[V_BF H+af vBbm BPP` J\\^ +Y_AVqj ;]$meQLd6@RNh>E`'mpTvnFzHP.8xJD!")X02b6HX$B%(S \\83 ">Lx pI0M bJK@ +5"{8DD `Q`xDJRHh(^Z|>U@DAPAFZ@P@D\\<8x@^AMJ^\\~;s{\s} {}g; s/(. +)/join "",map{ord$1&2**(5-$_)?1:0}0..5/ge;my(%d,%r);sub p{sprintf"%b",0+keys% +d};$d{ chr$_}=p for 32..126;sub r{$;=1+int log(1+keys%d)/log(2);$_="0"x($;-le +ngth). $_ for values%d;%r=reverse%d;s/(.{$;})//?$1:0}$a=$^=$r{r()};while($"=r +){$^=~ /(.)/;$.=exists$r{$"}?$r{$"}:$^.$1;$a.=$.;$.=~/(.)/;$d{$^.$1}=p;$^=$.} +eval$a

    (See the readmore for TONS more.)

    Sources

    This wouldn't have been possible without several incredible sources:

    Shameless plug

    I made a gallery of fractals that this program (plus ImageMagick) created. (Page also has some of the same background that this node has -- and I haven't yet given proper credit to the L-systems' "inventors"/"transcribers".)

Hilbert Curve
3 direct replies — Read more / Contribute
by benizi
on Dec 05, 2007 at 02:37

    Mandelbrot set inspired me to write my first obfu. I used the Hilbert Curve (as featured in XKCD). It takes an optional numeric argument on the command line (should be a positive integer less than ten, with a default of 5). There's no error checking on the argument, but the rest of the code is warningless under strict+warnings. I might write more about it when I need to procrastinate further. :-) Hint:

    #!/usr/bin/perl use strict; use warnings; ;$ "=q%ef%;$_ =q~my($i,$ x,$y,$p)=( 0,0,0,pop| |5);my$r=2 << $p ;m y@ i= ma p[ (1 )x $r ,2 ],1..$ r;subi {$i[$x ][$y]- -}i;su bp{((1 <$_[0] ?$y:$x )- =1 -( $_ [0 ]&1)*2 ,i)for -1,1}s ubf{my ($ p,$f)= @_ ;$p--; my@m=( $f ,3 -$ f, 1- $f ); my @o =( 3- $f ,$ f, $f,$f-2)if $p>0;($_&= 3) for@o, @m;@o& &f ($p,pop@o) ,@ m& &p (pop@m )while(@o||@m) }f$p,( $p&1)* 2;subb {y ,y4102,b#\ n, ;p ri nt }m ap {b fo r@ $_ }@ i~;y~ \n~~d; ;s&b&b &g;$;= 1; eval;# %$ _+28;$ x-=$y; my ($ pi )= '3 .1 41 59 26535' ;$ ,= 2*2**$ [; ;my@b= map[5x $pi],1 ..$[;s {} {q %S {$ b[ $x ][ $y ]= 0} S; su bp {($_[0 ]>1?$y :$x+=- 1+$_[0 ]^2*2, S)for(0,1) }suba{($l, $d )=@_;$ l--;@m =map$_ *4,5-$ d,3-$d ,$d;@h=map $_*4,$d+2, $d ,$ d, 3- $d if $l >0 ;{ a( $l ,s hi ft @h)if@ h; @m &&p(sh if t@m);( @m+@h) &&redo }}a$l, $l ^2 *2 ;p ri nt @$ _,$/fo r@b($x ,$y,$c )=qw/0 0* /;$l=s hi ft||4; $r=$s* 2* *$ l; @b =m ap [( '' )x $r ], 1..$r; for(0,1){eval[ qw/$x- -$x++$ y--$y+ +/ ]->[i$_[0] ]; $b [$ x] [$y]=$c;}@ m=split//, [q w/rdll urdruu ld /]->[i$d]; @h =s pl it // ,[ qw /u ll dd rr ul uu rrddl/ ]->[i$ d]if$l >0;@m= sp lit//, {q w/lrdl rlurud ru du ld /} -> {$d};@ m=spli t//,su bstr'r dllurd ruuld' ,3*i$d ,3;@h= sp li t/ ,{ qw /l ul ld rd rr uu lu urdrddl/}- >{$d}if$l< 7;@m=split //,substr' ulldd'%}e;
Mandelbrot set
6 direct replies — Read more / Contribute
by Anonymous Monk
on Nov 26, 2007 at 17:24
    #!/usr/bin/perl $_=' lx)L %j-%h-%k-% s-%y-%x(:gns%x)X ,04//05(zgns%y)1//6 8(zqshou#]dZ#-%j\'04 ?6>0;1-# :2#-%j$6-#l/#:gns)%h<% j<%s<1:%k<%s+%s,%h+%h,3*%y.34-%h <3+%s+%h*%x.01-%k+REKCAHX%k*%h+%h= 00\'JUST\'ANOTHER%jPERL**=000:%s <%k(zqs houHACKER##:|||qshou# ]dZ1l#:';s/\s{1,}//gm; s/[\x41-\x58]//gm; s/(.)/chr(ord($1) ^0x1)/ge; eval ;qaa
    Requirements: about 80x30 terminal
Just another HART (Hospelian Arabic to Roman Transform) JAPH
1 direct reply — Read more / Contribute
by o0lit3
on Nov 26, 2007 at 16:45
    $@=29628;s/./y$ IIVCXL426 (-:V$XIVX LMCDIVX$dfor$$_ .=5x$&*8% $@;$$$_=$ _/egfor-4e3..0; $;=qq/LXX IV+CXVII+ CXV +CX VI+ XXX II+ XCV II+ CX+ CXI +CX VI+ CIV +CI +CX IV+ XXX II+ LXX X+C I+C XIV +CV III +XX XII +CI V+X CVI I+X CIX +CV II+ CI+ CXI V+X LIV +X+ XLV III C+C MII XV+ DXI M+I MCC MCM +XXIII DCI MMV+II C+I MMVIII /;$;=~s/\s+//g; print+ eval(join+q/./, map-${ $_},+split/\+/, ~~$;);
    Inspired by Erudil's, There can be only one!, My 2 cents worth, my own The Power of Three, and (of course) thospel's original magic formula.

    For those of you who prefer signatures and want (at least a little) more insight into what's going on:
    s/./y$IVCXL426(-:$XLMCDIVX$dfor$$_.=5x$&*8%29628;$$$_=$_/egfor-4e3..0; print+eval(join+qq/./,+map-${$_},split/\+|\n/,+qq/LXXIV+CXVII+CXV+CXVI XXXII+XCVII+CX+CXI+CXVI+CIV+CI+CXIV+XXXII+LXXX+CI+CXIV+CVIII+XXXII+CIV XCVII+XCIX+CVII+CI+CXIV+XLIV+X/)
next power of two
5 direct replies — Read more / Contribute
by dk
on Nov 26, 2007 at 06:57
    As seen today on fun-with-perl, the code that calculates the next power of two:

    sub next_power_of_two { my %s; @s{1..shift} = (); local $_ = %s; return m{/(.*)}; }

    (I've changed the original code a bit to pass "use warnings"), -- so the annual Perl Code Joke prize goes to shmem!

cheap japh
No replies — Read more | Post response
by m0ve
on Nov 23, 2007 at 07:31
    had to waste some time today, this is how i did it ;)

    use warnings; use strict; use Tk;eval '$.=q $25,25 ,25,30,35,30, 35,10|40,20 ,40,30,50,30 ,50, 20|65 ,20, 55, 20, 55, 25, 65,25 ,65,30 ,55, 30| 70, 10, 70, 30,75 ,30|67 ,15, 73,15|95,30, 97,30|100,30, 100,20,110,20, 110, 30|130,10,130 ,30,135,30| 127,15,133,15| 140, 10, 140 ,30| 140, 20,150 ,20, 150 ,30 |155 ,25, 165,25 ,165 ,20, 155 ,20, 155, 30, 165, 30|170,30,170 ,20 ,180 ,20| 25,60 ,25,40 ,35,40,35,50, 25, 50|50 ,60, 40,60 ,40,50 ,50,50,50,55,40,55|55,60,55,50,65,50|68,40,68,60,71,60|81,60,81, 40|81,50,90,50,90,60|105,60,107,60|120,60,110,60,110,50 ,120,50|125,60,125,40|135,60,125,52,135,46|150 ,60,140,60,140,50,150,50,150,55,140,55 |155,60,155,50,165,50|85,20, 95,20,95,30,85,30, 85,20|115, 20,125,20,125,30,115,30,115,20|95,50,95,60,105 ,60,105,50,95,50$;$,=join("",map(chr, (99,114,101,97,116,101,76, 105,110,101)));$;= MainWindow -> new->Canvas(-width=>200,-height=>80) ->pack;for(split(/\|/,$.)) {$;->$,(split( /,/,$_))} MainLoop; ;;; '
    obviously requires Tk...

Set the new obfuscation standard
Title:
code@?#!:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.