Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number

Obfuscated code

( #1597=superdoc: print w/ replies, xml ) Need Help??

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
No replies — Read more | Post response
by BenGoldberg
on Apr 18, 2014 at 22:51
    binmode STDOUT, ":utf8"; my @o = ("\x{202d}", "\x{202e}"); print "$o[--$|]$_" for split //, 'J,ursetk cAanHo tIhDeIrB /Pler';

    The actual output will be:

    J‮,‭u‮r‭s‮e‭t‮k‭ ‮c‭A‮a‭n‮H‭o‮ ‭t‮I‭h‮D‭e‮I‭r‮B‭ ‮/‭P‮l‭e‮r

    If your terminal has proper unicode bidi support, it should look the same as:

    Just Another Perl/BIDI Hacker,

Is there a non-empty error quine in perl?
3 direct replies — Read more / Contribute
by ambrus
on Mar 08, 2014 at 19:59

    Can you give a non-empty error quine for perl? By an error quine, I mean a perl script that, when ran perl, prints exactly the same bytes to its standard error as its source code and nothing on its stdout. The printout shall be an error message coming from the perl core (or maybe a core module), not eg. something explicitly printed with a die or print statement in the source code. The program shall be ran by redirecting it to the stdin of perl, invoked without any switches.

    If there is such an error quine, please give one, preferably an elegant one which doesn't seem like cheating. Please tell what version of perl the script works with.

    As an example that doesn't work, take the following script:

    Number found where operator expected at - line 1, near "line 1" (Do you need to predeclare line?)
    If you run this with perl 5.16.3, you get the same error message as the source, but then get other error messages too, so this isn't an error quine.

    Update: asked for perl version.

    Update: ais523 says these are called “Kimian quines”

Perl Python Partial Polyglot
1 direct reply — Read more / Contribute
by kschwab
on Jan 22, 2014 at 14:38
    Runs under perl and/or python and produces *almost* the same output...
    0 and chr <<1; '''#' 1 use strict;use warnings; sub perl{ map{m&${\uc(q,m,)}&&&($,.=$_,)=~s,[^A-z0-6],,xg}@_;($_=$,) =~tr$A-Za-z0-9+,$ -_$;for(unpack("u",join('',map(chr(32+ length($_)*3/4).$_,m$(.{1,60})$gs)))){$.='$_'.'="';map {$..="\\$_"}unpack('(a3)*',$_.'012');$..='"';eval(${\$.}), s;\x50++\S{5}+;\u${\substr((caller(0e0))[0b11],-4) };;print}}${{}={<<'1<<1'=>1} #''' l=('137137151155160157162164137137''050047142141163145066064047051', '161056142066064144145143157144''145050143051', 'MTEyMTY1MTYzMTY0MDQwMTQxMTU2MTU3MTY0' 'MTUwMTQ1MTYyMDQwMTIwMTcxMTY0MTUwMTU3' 'MTU2MDQwMTUwMTQxMTQzMTUzMTQ1MTYyMDU0' ) def l1(l):[(yield'\\'+l[i:i+(2|1)])for i in xrange(0,len(l),(2|1))] i,I=lambda l:eval('"'+''.join(list(l1(l)))+'"'),lambda l:eval(i(l)) c,q=l[0o0+-0o1],I(l[0o1&0o2]);print(i(I(l[-(0o3^0o1)],))) ''' 1<<1 and 1; perl(split/\n/,(keys(${{}))[0]) #'''
Strict;ly Awful q's
No replies — Read more | Post response
by kschwab
on Jan 17, 2014 at 18:26
    use warnings; complains, but use strict; is happy.
    #!/usr/bin/perl use strict; package q; sub ::_{ $,{q;,;}=q,35787677-758717277656275-741627569-76558606862755', ;$;;$,.=pack(q,c*,,,map ($_-42+unpack(q,c,,,uc(q;q;)), unpack('(A2)*',($,{','}))));{{},print(q//,$/);q}}}}q; q-main::q--;>_(@_,q,,,);q} }
$|-- rocks.
1 direct reply — Read more / Contribute
by BenGoldberg
on Jan 03, 2014 at 22:30
    sub _{@_<2&&return print@_;my@a;push@{$a[$|--]},$_ for @_;_(@$_)for@a};_ split//,"huroP cels,tetah Jen akrr";
2014 Code Golf Challenge
6 direct replies — Read more / Contribute
by tobyink
on Jan 01, 2014 at 06:46

    There's a 2014 themed golf competition on Stack Exchange. The challenge is to print the characters "2014" without using any digits in your source code.

    Sadly using the N'Ko letter "ka" is ruled out because it would require use utf8 (which includes the digit "8").

    My solution is 17 characters. If you swap print for die you can reduce it by two characters, but I consider that to be a cheat.

    print RPQT^'````'

    Can anyone improve upon it?

    Update: a one character improvement:

    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
Better random magic
No replies — Read more | Post response
by BenGoldberg
on Dec 29, 2013 at 15:11

    Although the text of the japh is plainly readable in the code, what exactly happens to the split up letters that are passed to _ and __ is... a secret!

    sub r{srand$^T; @_}sub b{do{@b=map.5<rand,@_}until grep($_,@b)&&grep( !$_,@b);@b}sub _{print(@_),return if@_<2;my(@L,@R);push@{$_?\@L:\@R}, shift for&b;_(@L);_(@R)};sub __{1<@_ or return@_;my@b=&b;my$c=grep$_, @b;my@L=__(@_[0..$c-1]);my@R=__(@_[$c..$#_]);map shift@{$_?\@L:\@R}, @b}_ r __ r split//,"Just Another Perl Hacker,\n";

    If you aren't confused yet, run the code in a debugger, and note the list that __ returns, then try to figure out how _ magically prints the letters in the correct order.

    Also... I'm fairly sure that this code (unlike my previous randomized JAPH) should be run ok on any perl, even though I've only tested it on 5.12.1

fork/wait JAPH
No replies — Read more | Post response
by BenGoldberg
on Dec 27, 2013 at 22:33
    sub _{fork?wait:return$_ for@_} print _(split //,qq{Just another Perl Hacker,});
    This is mostly inspired by my first implementation of the "amb" operator for the RosettaCode project, but also partly by mjd's amazing japh Mine is obviously much simpler... but still moderately cool.
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
    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
    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
    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;

    Update: I've posted the Technicolor™ version to

    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name

Set the new obfuscation standard
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!
  • 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, 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, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • Outside of code tags, you may need to use entities for some characters:
            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.
  • Log In?

    What's my password?
    Create A New User
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others avoiding work at the Monastery: (10)
    As of 2015-05-23 09:48 GMT
    Find Nodes?
      Voting Booth?

      In my home, the TV remote control is ...

      Results (466 votes), past polls