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
Golf: Cabbage, Goat, Wolf
3 direct replies — Read more / Contribute 		by educated_foo
on Dec 27, 2013 at 21:00
    I was reminded by a recent Reddit thread of the classic "get a goat, wolf, and cabbage across a river" problem (spazzy kittens version, painfully verbose Haskell version). You're on the left side of a river with a cabbage, goat, and wolf, and want to get them to the right side. The wolf will eat the goat, and the goat the cabbage, but only if you leave them alone. You can only fit one of them in your boat at a time.

    The problem can be solved by computer with some backtracking, or by hand with some thought. Being a Perl programmer, I naturally thought to golf it, and thought that the best solution would involve a clever regex or substitution. Here's a terse, but un-obfuscated version: 

    sub wgc {
    return if $seen{"@_"}++;
    my%x=@_;
    if ($x{b} && $x{c} && $x{g} && $x{w}) {
        print+(sort keys%$_),"\n" for @h;
        exit;
    } elsif ((!$x{b} && ($x{c} && $x{g} || $x{g} && $x{w})) || 
                 ($x{b} && (!$x{c} && !$x{g} || !$x{g} && !$x{w}))) {
        return;
    } else {
        if ($x{b}) {
            delete $x{b};
            for ('xx', keys %x) {
                my %y=%x;
                delete $y{$_};
                local @h=(@h, \%y);
                wgc(%y);
            }
        } else {
            $x{b}=1; {
                local (@h) = (@h, \%x);
                wgc(%x);
            }
            for my $k (qw(c g w)) {
                if (!$x{$k}) {
                    my %y=(%x,$k,1);
                    local (@h) = (@h, \%y);
                    wgc(%y);
                };
            }
        }
    }
}

wgc

    [download]
    And here's the output, where "b", "c", "g", and "w" represent the boat, cabbage, goat, and wolf being on the right bank: 
    bg
g
bcg
c
bcw
cw
bcgw

    [download]
    I wasn't clever enough to come up with the regex solution, but here's a compressed version of the above, weighing in at 382379 strokes: 
    sub w{return if$s{"@_"}++;my%x=@_;if($x{b}&$x{c}&$x{g}&$x{w}){print+(s
+ort keys%$_),"\n"for@h;exit;}elsif(($x{b}||!($x{c}&&$x{g}||$x{g}&&$x{
+w}))&&(!$x{b}||!(!$x{c}&&!$x{g}||!$x{g}&&!$x{w}))){if($x{b}){delete$x
+{b};for(A,keys%x){my%y=%x;delete$y{$_};local@h=(@h,\%y);w(%y)}}else{$
+x{b}=1;{local@h=(@h,\%x);w(%x);}for(qw(c g w)){if(!$x{$_}){my%y=(%x,$
+_,1);local@h=(@h,\%y);w(%y)}}}}}w

    [download]
    Have at it!
Christmas Eve Obfu
No replies — Read more | Post response 		by tobyink
on Dec 24, 2013 at 08:18 
    use v5.14;
use strict;
use warnings FATAL => 'all';

our $days_until_christmas = 1

            *
           map
          s([+]
         )( )gix
        &&printf(
          '%5s'
         .'%-4s'
        .'%s',$_,
       substr(~~~~
      reverse,!$^C)
         =~y[/(]
        [\\)]r,$/
       ),my@ xmas=
      qw 1 +.- _(+"
     (_++: /+' +(_/^
           1;1
           ;1;

    [download]

    Update: I've posted the Technicolor™ version to blogs.perl.org.

    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
Slightly Srandom JAPH
1 direct reply — Read more / Contribute 		by BenGoldberg
on Dec 23, 2013 at 19:50
    This isn't super obfuscated, but it's got some coolness to it, nonetheless :) 
    print sort {4-rand 9} split //, HnlcrhJsre_Pt_aeAeuot_kr if srand JAPH
+;

    [download]
oh for y///e
2 direct replies — Read more / Contribute 		by bhildred
on Dec 10, 2013 at 15:54

    too bad this doesn't work.

    while(<DATA>){y/a-zA-Z/b-zaZA-Y/e}
asccii modern art obfu
1 direct reply — Read more / Contribute 		by perlaintdead
on Nov 29, 2013 at 22:39

    Trying to step my game up and brake my bad habit of putting cyphered text in an array every obfu. Enjoy my ASCII modern art and the Easter eggs.

    WARNING:This program is resource heavy!!!

    Built with v5.16.3 

            no warnings;no strict;           while(perl_is_not_dead){     
+           goto ghs;sub jerry{v3}gns:$ b=~s/^.{3}//;our
     @change=((9,65),23);$ feld       =gn::n;package gn 4.242{sub n{sr
+and          $ VERSION}package queen;
    sub boxxy{pop @change and $       boxxy="love, light, joy, and hap
+pyness"}}        ;goto g.n.S;ghs:sub dx{$i=2e-2
  ;@a=queen'boxxy;$i+=1while$a[0]=~s[(?#\x89\x90*{,23}).(?#%?\x59)+?(\
+W{1})][];@a          ,$i}sub q{&^>=9*&^+$^%$^^}
  package split{sub b{@change[eof fileno     *STACKFRAME],@change}}$ b
+=~q((?{$b=substr         lc$~,0,-2,}));goto gns;gnS:;sub n{
  return $_ >> dx}sub _:{sub(;){(      "\x3c".(sqrt(.218_01330_1491_73
+7)/rand+oct+1e2+4x~~2)       .chr.chr 0x.99=>)[${(}].$ b.(
   (chr(-(&dx)*-25.5).chr(&dx*25.5)      .chr((ord reverse split$]=>$~
+,jerry sin$feld)
     - -(__METAL__)-"\m/"-_-"\m/"-(__METAL__)- -($!+qw^1 *&9$# @^[quot
+emeta${!}
       ]^((int exp(v6 cmp v5))              **gn::n)))x2 .$/)=>(ref*a+
+%gin).[*62
         ,*41])[$#b+3%2+hex(                   gns)],(prototype ge rea
+dpipe)[tell]}}}                           continue{printf(::_([])->((
+)),)}+cream and sugar

    [download]
JAPH with a smiley
1 direct reply — Read more / Contribute 		by choroba
on Sep 03, 2013 at 18:20
    I think the idea is not bad, but the JAPH phrase is a bit long for that, so it gets boring quickly. 
    sub e{sub _{-72} er}eval($/='sub J{map{substr$/,ref('.q:)?pop@$_\:$_,$
+$_[0]||1}
@_}sub f{uc join "system",J(@_)}print J 4=>1,[2,13],-1,010-1,[ _ ],42-
+020,hex"e
";print+h,e,$",f(__LINE__*2+2),e,qw,l,,J(-1,-hex 20),q{ack},e,J hex or
+d(0)/4 :)

    [download]
    A variant that is a bit profane:
    Read more... (677 Bytes)
    لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Felling a tree JAPH
2 direct replies — Read more / Contribute 		by MidLifeXis
on Aug 30, 2013 at 10:28

    Still not a great JAPH, and it exceeds 4x79, but it is more obfuscated than yesterday's. 

    # Cutting down a tree
$t=t->p;$t->g;$t->f;sub t::p{@n=map{x($_)}'Just another Perl hacker,'=
+~m/(.)/g;
bless{n=>\@n},$_[0]}sub t::g{$_[0]->{t}=$_[0]->f(0,$#{$_[0]->{n}});$_[
+0]->{n}=1
;$_[0]}sub t::f{($a,$b,$e)=@_;$m=int(($b+$e)/2);$f=$_[0]->{n}[$m];$l=$
+_[0]->f(
$b,$m-1)if$b<$m;$r=$_[0]->f($m+1,$e)if$m<$e;bless [$l,$f,$r],'f'}sub t
+::f{$_[0]
->{t}=1}sub x{bless \$_[0],"x"}sub x::DESTROY{print${$_[0]}}sub f::DES
+TROY{$_[0
]->[$_]=1 for(0..2)}

    [download]
    <Reveal this spoiler or all in this thread>

    --MidLifeXis
Destructive JAPH
1 direct reply — Read more / Contribute 		by MidLifeXis
on Aug 29, 2013 at 10:48

    Starting my foray into JAPH to explore various aspects and corners of the language. Not necessarily obfuscated, but more using different aspects of Perl to accomplish the goals of a JAPH. 4x79 code max, Just another Perl hacker, output to stdout. I am hoping to explore a different technique each day, but it will probably devolve to one a week.

    This implementation is pretty obvious how it works, but it uses the DESTROY method of object destruction to output the characters of the output.

    @x = map{ x($_) } split('','Just another Perl hacker,');
shift(@x) while @x;
sub x{ bless \$_[0],"x"}
sub x::DESTROY{print ${$_[0]}}

    [download]

    --MidLifeXis
Undefined JAPH
5 direct replies — Read more / Contribute 		by ateague
on Aug 28, 2013 at 19:08

    It is simply amazing what Perl's undef can do if you just ask it nicely. I got mine to print JAPH.

    UPDATE! Spoiler available! 

    #!/usr/bin/perl 
{{{{THE:{{{{END:{{{{IS:{{{{THE:{{{BEGINNING:{{{{IS:{{{{THE:{{{{END{{{{
no strict; no warnings;# Where we're going, we won't need eyes to see.
undef->('J')->('u')
       ->('s')->('t')
         ->(' ')->('a')
           ->('n')->('o')
             ->('t')->('h')
               ->('e')->('r')
                 ->(' ')->('P')
                   ->('e')->('r')
                     ->('l')->(' ')
                       ->('h')->('a')
                         ->('c')->('k')
                           ->('e')->('r')
                             ->((qq(\n)));# ALONE CANNOT YOU IT RESIST
;};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};};}
use strict;use warnings FATAL=>'all';use utf8;use 5.014;# It begins...
eval((eval(join'',join'',map{unpack'C/(C.*/X/xa@)'}split/\n/,<<'MAGIC'
"BC8D%5/.31420-A69=(#:*$+<@;?)&',>7""$''((*,,;<=>AADTaaabchijkmnopsu{"
">DC95'A<?36;(%B&-#4*.=@8)$2+/0,17:$$''((())),,,1?_aacccdehknoppruuv{"
"?'=@:(#8)721*3%&CA><;B./-$9506+,D4$$''(()))),//046:;[]^__diloprrst}}"
MAGIC
))->(# LASCIATE OGNI SPERANZA VOI CH'ENTRATE. LIBERATE TUTAME EX JAPH!
<<'MORE MAGIC'
              $_='open(necromicon)and(seek(undef,undef))
              ((4SO)EPL(M)(6)(yv5((76aW((65(s&gxVH7Z(2f)
              (2)ud)b))J06)r7m(6i)oO)L)(MF)T6(yv(E(6a(((
              sgVxHZE(f)(!61P)u20d)b))J6)$76rm9(i7)So66(
              52O07))L9)6(FS75M)2(07((y5)7V0)v2((UCa(((W
              sg0TAxH4Z(fE)udW)65b))J!P76)rm65(i)oO)7L)(
              M)(22V)(yv0R67((a(6(F6(sEgxY6HZ(Ef)6(1)ud2
)Tb06))JC)rm(i              )o6O)L)5%(VTW7              U4VM2)(y0v((a(
(sgxH7Z(f)(R)9              6WFud)%bV)J)rm              (i7Q)o5VO2)06L
)#4(6FV7M)76E(              y0vA((a((S(Wsg              !4Ex6HZ5(Sf7)u
d)b6))6J)r!m(i              )S57oSO)L)(M2U              )2067(6yFv((6E
6aE6(VW((sgxH1              Z(f)ud2)b0)R7U              2)J7)56rm(E2iU
)o0TO)LQ)6(M)(              y1v((a(7T(2(6s              F7gxHZ(fT)u5Td
)b))&J6)rm(Ei)              o64O)L)(M)20(6              T1)6(y%v(E6(Ta
((#(T((oh.god.how.did.this.get.here.i.am.not.good.with.computer)4g2)(Y
xUH)Z(0f6)ud4)b)6)5J)rm7(i)oO)XL)3(M)(yR#Uv((6a((s57(gU27(x4HWZ))(2f0%
)(79)udVb6)F7T)50VJ)AUV4rE65m7(i)oO)L)V(MV6)#6(yv(572(a(2((sgxH0Z(f676
)(F6uEd6R))b)E)J)PrS6mY(i)oO)L)(M)(12yv((a((0(sgxHZ6RD"(f61)6(B6S)ud)b
52))J)rm(i)oOP)L0)(7M96)(F7)(yv((a(5((sRg(((x)H20)6ZU)(3W7f)(27)ud%V)9
b))JT)rVU2m(Ci0A)VV4oO)L)(VE$M)6(5)(yvS((aS7(((s6gx65HZ(f)W7(2)20u6d)b
U)76)J)rm(i)oWOR)FL6)(EM)6(yEv6((a(V((s"g(xH(W1Z))(20P7f)(W3)ud)b))RJ)
              6rm(i1)WoO)L)(              M7)Y(Vyv(9(2a(
              ((s0gx6HZ76%(f              )uFdV)T6bF)6)J
              4W)6rm(Ti279)o              O)6L)(50RMA4&E
              )U("6)U(y57v(P              6(Sa((sg$xUH65
              Z(f)7u22d0)67b              "6)FJ6)rEm(i)o
              O)L)(M)(6E)(6y              vS1((a(20(7((P
              RUsg)xH4Z(6fW)              5u6d%VTC6)b)CV
              U)J2)0r61m(i20              )o(VO)6VC)L6)(
              M)(9Vyv((a(6((              sg5xH2Z(f"0)61
              (u6(E6))d)bS))              J)rm(4i)$2Wo0O
6)"87L)(M5)(7)              (27y)Sv4(a((sg              xHZ(2f)07ud)b9
6)JF)rm750(iA)              ).seek..into..              the.abyss..now
;..to.invoke..              .the.hivemind.              .representing.
chaos;invoking              ..the.feeling.              of.chaos;with-
...out.order..              ...the.nezper-              dian.hivemind.
of.chaos;zalgo              ;he.who.waits.              ..behind.the..
.wall;ZaLGo;';              undef:japh:{s(              [^[:xdigit:]]|
[^([:upper:]((              )[:digit:]))])              ()xgos;print((
(chr((hex)))))              and(((select((              (undef),undef,
((((undef,))))              ,((0.01)))))))              for(/(..)/g)};
MORE MAGIC
));
__DATA__ _____________________________________________________________
,`````'X``````/\#`Toto, I've a feeling we aren't in Kansas anymore...`

    [download]

    I do not believe anyone has used this technique before.
    I do not believe anyone has used this technique before in a JAPH here on Perlmonks. Please let me know what you think.



    Spoilers 'n bits...

    Read more... (16 kB)
Just another JAPH
No replies — Read more | Post response 		by perlaintdead
on Aug 23, 2013 at 21:52

    My internet has been down for the past few days so i did this. difficulty: 6/10

    $|=1;b:my@j=(q(37b), q(b58), q(b57), q(58b), q(16b),
 q(b48), q(55b), q(b55), q(58b), q(52b), q(b50),
 q(57b), q(16b), q(40b), q(b34), q(41b), q(38b),
 q(16b), q(52b), q(b48), q(b49), q(b53), q(b50), 
 q(57b), q(23b));-x\@j;sub vv{return 0x3}sub G{return!NULL}sub q{-e b_
+;}
my$b=not-9674;sub B{return map{b_}split NULL,shift,oct 2}sub w{return 
+\0x2,}
foreach$bb(@j){unless($bb!=m-^b-){BEGIN{use MIME::Base64;*b_=\&pop and
+ *db=\&decode_base64}
sub U1RET1VU{caller undef,-w,&q;}$b=vv- w;vv-W;$bb=substr$bb,$|;}$bb=$
+bb/(q(.). 0b0101);
$bb=$bb+_+print m!!xg if!! B$b;syswrite db q;
 U1RET1VU; ,chr$bb;$b=G;}eof;

    [download]
<Newer entries  (91-100) of 300 Older entries> 

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.