Beefy Boxes and Bandwidth Generously Provided by pair Networks
Perl-Sensitive Sunglasses

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
1 direct reply — Read more / Contribute
by Grimy
on Jul 14, 2014 at 15:48
    While dusting off my files on an old XP box, I stumbled upon a JAPH I wrote a few years ago, but never shared. After trying to puzzle it out for nearly an hour, I reluctantly broke out perl -d, which gave me the solution—as well as the insight that my former self is a sly bastard. Here is the JAPH:
    @ARGV = ${$-=$.}, s<#<>q#>#q<<>> #exegesis=>print, hacker=>unless $/=q=echo q/Just another Perl /| $/=!~>die
    This code needs to be stored in a file to work. Tested on Strawberry Perl 5.12 (WinXP) and Perl 5.20 (Arch Linux). Strictures and warnings will give some clues.
First JAPH
4 direct replies — Read more / Contribute
by Feland
on Jun 17, 2014 at 10:32

    This is my (oh !!) first JAPH. I'm a little newbie at this place, but I hope that is not too bad :) Please, comment !

    &p(qw(Ju));$x= $/;$|=$$;$,=$/;$\=$!; sub T{eval$_[0]};sub su{T q%sel%.q +ect *a,* a,*+.'a, .06';}sub p{T(q;p;. q 5ri5.q qntq)for @_}map{p ('u');& su;}(1.. 17);sub s{+$_[0] };&s(&su );$a='rl' ;$\=$x;&s(&p("st"));$\=$!;&s (&su);sub r($;){+p($_[0] )};p(q-A-);sub z{$\=$/?$;: $,;$,=$;;su();map{&s(p('a'));& s(su);}@_};z((1..7));$,=$x;$\=$, ;$"=$\;$,=$/; $_=q!!;s;;;; p(q qnoq.q rthe\rr);$\ =$/?$;:$,;$ ,=$;;;;su(); r "P";map{r "e";&s||&su; }(1..42);$\ =$;;&s(p($a) );T(T(su())); r $/;r "H";$\ =$/?$;:$,;$/=$,;z(1..12);$,=$\;$\ =$/;$a=~s/(.)l//;p(q tcket.$1 );&s(p($"));$e='Felicien'; #MYFIRSTJAPH
use warnings qw( japh );
3 direct replies — Read more / Contribute
by tobyink
on Jun 06, 2014 at 18:33
    use strict; use warnings; use overload; my %D; sub quux { +undef }; su +b quuuux { goto \&overload::constant } sub quuux { my $x = close STDIN; +# overload::constant J => sub { 1 }; print quux; *quux = sub { "Hello" } +; $x="William".tell STDIN and select($x+=1,undef,undef,0.1);%D=(q=>quux( +) ,$x);$x=''.!!delete $D{$x};telldir(\*STDIN)or quuuux%D;%D=bless({},$x) +; printf STDIN "%d",$x;last}sub quuuuux{quuux for 1;rewinddir$_ or liste +n ($_,1)for\*STDIN;my$z=\(quux);substr($z,0,1)=quuuux integer=>$$z;quuuu +x pack("C",-1)&"\x4B",sub{42};last}quuuuux for 1;%D = {};use Carp;carp", +"
    use Moops; class Cow :rw { has name => (default => 'Ermintrude') }; say Cow->new->name
My first JAPH
No replies — Read more | Post response
by Zarabozo
on Jun 06, 2014 at 07:13

    This is my first JAPH. I'm very passionate about Perl and I thought I had to make at least one in my life. It's probably not a very good one and will seem very rookie for many - but then again, it's my first one and it's a start for me. :-)

    BEGIN{*{0}=sub{print@ _};*{1}=sub{& #@_=__; 0 # print ord sqrt(e) (chr 32)};my$v=chr 97 ;* #$%&&oo11||s/\e\// {'::'.++$v}=do{my$ #? v=$ #v?a:b?v:a?:v:a?c v;sub{&0($v)};}until$ ::{v};}($_=q;kvtu1bop uifs1qfsm1ibdlfs;)=~s /(.)/&$1/xeg;eval for $ # while(1){::{___}} _ =~ /.{2}/g;__END__;
Fork Sort
1 direct reply — Read more / Contribute
by BenGoldberg
on May 31, 2014 at 17:35
    Put the following in a file,
    defined(my $v = <>) or exit; my ($c,@c) = 1; open($_, "|-", "$^X $0") for @c[0,1]; $_ eq $v ? ++$c : print { $c[ $_ lt $v ] } $_ while <>; pop @c; print $v x $c;
    , and run it with an unsorted text file either on stdin, or as a command line argument. The output will be sorted.
I love Perl to bits
No replies — Read more | Post response
by FloydATC
on May 09, 2014 at 08:58
    #!/usr/bin/perl use strict; use warnings; my$pq=$[;my$qp=!$_;$"='@';for$/(split//,".,., ,,..,,,, .....,, '.,,, .,.,., .,.,, '.,..,,,, ...., ,.,,...,. ,,, ...,.,, ',.,,, .,.,.., ..,,, '.,,..,., .,'...,,, '..,,,, .,...,, .,,'...., ..,..,., ., '..., '.,,, ',,,., .',,,,*"){print$/eq'.'?foo(!$pq):($/eq'\''?bar(!$"):($/eq ','?baz(!$qp):$"));}sub foo{$pq+=$qp+sqrt($=+4);$pq%=($=+4)/2**3;$!; }sub bar{$qp*=-1;$!;}sub baz{my@s=split//,unpack'b8',$";$s[$pq]=1-$s[ $pq];$"=pack'b8',join'',@s;$pq+=$qp;$pq%=$=/7.5;$!;}
    -- FloydATC

    Time flies when you don't know what you're doing

Stumbled upon Inline::C
No replies — Read more | Post response
by sealingcat
on May 02, 2014 at 01:45
    I recently discovered that OSX 10.7+ with Xcode has Perl configured with Inline::C. To celebrate I wrote this.
    #!/usr/bin/perl use Inline C=>q{const r[]={451418730,74<<24,544502645,1953459809, 544367976,1819436368,1667328032,745694571,1086337290,193204112,53 <<25,1342484481,3296952525,828293904,1523056639,1208,3271888642}; int g(){((int(*)())r)();}};g
    This isn't really all that obfuscated. (Un)Fortunately it only runs on OSX 10.7+ with Xcode (x86 or amd64).
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.

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]) #'''

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 surveying the Monastery: (6)
    As of 2014-08-20 23:33 GMT
    Find Nodes?
      Voting Booth?

      The best computer themed movie is:

      Results (125 votes), past polls