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

Char Count 2 direct replies — Read more / Contribute	by Anonymous Monk on May 03, 2009 at 01:13

Count chars from STDIN, takes 1 command line argument that lists all characters to be counted. RegExp does all of the work `use re 'eval';$#ARGV<0&&exit 1;$s.=$_ while<STDIN>;$s=~/(?{$z=quotemeta shift@ARGV})((??{"[$z]"})(?{$c++})\|.)*(?{print$c})/m;`
Self printing code 2 direct replies — Read more / Contribute	by ccn on Apr 29, 2009 at 12:20

No digits, no backslashes, no dollar signs, no quotes... `s bbq oprint q cs c and print grep !m w[a\|c]w, a..c, a..c and print q +rq r and print grep m r[^np]r, n..p and print and print grep m i[^np] +i, n..p and print grep !m y[a\|c]y, a..c and print q re and r and prin +tobe and print q cs c and print grep !m w[a\|c]w, a..c, a..c and print + q rq r and print grep m r[^np]r, n..p and print and print grep m i[^ +np]i, n..p and print grep !m y[a\|c]y, a..c and print q re and r and p +rint` [download] I wonder is it possible to get rid of square brackets, pipes and '^'? Update: Yes, it is possible! Update2: use ellipses and reformat the code s bbq oprint q as a and print grep! m aca, grep! m cac, a... c, a... c and print q aq a and print grep! m pnp, grep! m npn, n... p and print and print grep! m pnp, grep! m npn, n... p and print grep! m cac, grep! m aca, a... c and print q qe and q and printobe and print q as a and print grep! m aca, grep! m cac, a... c, a... c and print q aq a and print grep! m pnp, grep! m npn, n... p and print and print grep! m pnp, grep! m npn, n... p and print grep! m cac, grep! m aca, a... c and print q qe and q and print [download]
(Golf) Next second Tuesday 4 direct replies — Read more / Contribute	by shmem on Apr 07, 2009 at 18:20

There has been some debate at our local perl mongers group about when to meet this month, given that we meet on the second Tuesday of the month. From: Oliver Paukstadt <**> Reply-To: Stuttgart Perl Mongers <stuttgart-pm@pm.org> To: Stuttgart Perl Mongers <stuttgart-pm@pm.org> Subject: Re: [Stuttgart-PM] Treffen DIESE Woche On Mon, 2009-04-06 at 18:59 +0200, Rolf Schaufelberger wrote: > > > > Um das mal dauerhaft und stilgerecht zu lösen : > > > > perl -MDateTime -e ' for (1..20 ) { my $d=DateTime- > > >new(year=>2009,month=>4,day=>$_); if ( $d->weekday_of_month ==2 +&& > > $d->day_of_week ==2 ) { print "$_\n"; last; }}' > > 14 > > Couldn't resist: perl -MDate::Calc=:all -le 'print Date_to_Text(Nth_Weekday_of_Month_Year(2009,4,2,2))' Gruss Oliver [download] Modules? Not for golf. I came up with this: `perl -le'{@l=localtime($t-=((localtime$t)[3]-1)86400);$t+=(($l[6]<3?7 +:14)-$l[6]+2)86400;$t<time?($t+=2592000,redo):print$..localtime$t}'` [download] 128 chars not counting `perl -le` and not counting the surrounding single quotes. I am sure you can do better ;-) Rules: no modules; if the second Tuesday of the current month has passed, give the second Tuesday of the next month. No requirements on the output format except it must show the correct year, month and day (in any unambiguous order). update: using gmtime instead of localtime gives 119 chars: `perl -le '{@l=gmtime($t-=((gmtime$t)[3]-1)86400);$t+=(($l[6]<3?7:14)- +$l[6]+2)86400;$t<time?($t+=2592000,redo):print$..gmtime$t}'` [download] update 2: joint result of #perlgolf (mtve,shmem), 92 chars: `perl -le 'sub f{gmtime$_86400}$_+=30while($_+=9+7(($x=(f$_-=(f)[3]-1 +)[6])>2)-$x)86400<time;print~~f'` [download]
Learn Python 1 direct reply — Read more / Contribute	by dbw on Mar 31, 2009 at 11:36

Someone suggested to me that I learn Python. So I cooked up a quick English-to-Pythonese translator in Perl, and I'm all set. `ssss+s.s.S.g+s.[^S\\s].s.g+s.sss.sSs.g+ssss` [download] And look, the perl happens to be valid Pythonese as well. SssSSss. If you need help figuring this one out, here's some documentation as well as a demonstration: `$ alias python='perl -lpe ssss+s.s.S.g+s.[^S\\s].s.g+s.sss.sSs.g+ssss' $ perldoc -f s \| python SsSs sSs SssSsSssSsss sSssSssSs Sss sSssSss $` [download] If anyone can figure out a way to get rid of the "g"s that would be great. Later --D /usr/bin/perl '-nemap$.%$_\|\|redo,2..$.++;print$.--'
thar she blows No replies — Read more \| Post response	by Anonymous Monk on Mar 31, 2009 at 10:04

i can't remember whether \ec works on windows... `$l=' @a=m ap{s #\ S# # g;$_=($"x10).$_ }split($/,$l);f or(0..$#a){@b=("")x20;sp lice@b,20-$_,$_,@a[0..$_]; select$q,$q,$q,.2print"\ec" .join"\n",@b,("-"x50),""}' ;$_=$l;s#\s##g;eval` [download]
Joined And Packed Hash! 1 direct reply — Read more / Contribute	by hbm on Mar 02, 2009 at 09:37

This should be my last one for awhile. It follows a healthy walk through perlsyn, perlfunc, perldata, and perlop. It started life as Joined And Packed Hack, but I decided the "H" would be better served by a hash. `use strict;;use integer;;use constant E=>4;;$-= join$\|=>pack+q{Z},E<<untie my$noose or die;$/= join$\|=>pack"AA",exp,!untie my$shoe;@@=split$!, join$\|=>pack("A",(fileno$~)x(E)),($^E)x(E);@[= @@,@@[0,-~0]=@@[-~0,$[],@&=@@, $&[~1]=$&[exp],%%=map{local$_= join$!=>$/,@$_; pack+qq{\Ub$-},$[x($--length). $_}[@&],[reverse@[],[@[],[@@],[ reverse splice@@,1,$#{@}],[$/]; die%%` [download] Update: I just saw http://www.cpan.org/misc/japh for the first time, and noticed that abigail used `tie my $shoe` many years ago. Sigh. Please grant me that `tie` and `untie` are fairly suggestive, and accept that the similarity was innocent...
Happy JAPH No replies — Read more \| Post response	by bellaire on Feb 27, 2009 at 15:00

Below is my humble JAPH. It's not the most obfuscated in the world, and the art is decidedly crude, but it was definitely fun to implement. I made a conscious effort to avoid alphanumeric characters, even in variable names, except those required for the builtins: chr, int, length, log, ord, print, sqrt, and the while statement. Also a couple of uses inside regexes. ($/)=$~=~/..(.).$/, $_=$/.$`; $_=chr(ord ($&)+ length ($~) ).$_ ;$/= ord ($_); $_.=chr (length ($_ .$~. $&.$~)); $_.=chr (( $/- int ( sqrt( $/) ))- //). chr ($/ +int (log ($/ ))); ($;,$, )=$~ =~ /.(.).(.)/ ,$_.=$,.$;; $/ -= //,$/-=//;$_.=chr( $/ );$/ -=// +//+ //;$_ .=chr($/). chr(ord($~ )-//).chr((ord($~) +// )/(( length ($~ .$_ )+//+// +// ) / //+ //) );( $;, $/ ,$,,$",$\ )=/(.) .(. ).( .)( .. )(. )$/x ,$_ .= ++ $/. $" ;$/ =$;; $ ;++ while( /\G./g &&$"!~/ $&/x );$_ .=++$;; $_ .= $\ .$ ,.$/;++ $/ ;$_.= ++ $/ ;++ $, ,++$, ,++ $, , $_ .= $, . $"; print (($_)); $' ; $% == // ; $$ == $\ ++ ;; $\| =//+//i ; ; $' ,$\ ;$!/$$; [download]
TILDE COWS COME HOME? 1 direct reply — Read more / Contribute	by hbm on Feb 24, 2009 at 10:51

Tildes abused. Surprised? Amused? `use strict; die'TILDE',@~; sub CHECK{@~=$~=~m~(.)~g,unshift@~, splice@~,2,3;unshift@~,pop@~,{H},; push@~,{PAR}=>;($~[$#{~}],$~[$#{~} +-1])=($~[$#{~}+-1].$/=>$~[$#{~}]); for(@{~}){s~.:~~;s~$~ ~ if$?++%2}}` [download] Update:*Tiny change to fix problem on Windows... Per request, commented version below. And actually, it was a BrowserUK post last Friday that got me reading perlvar and perlmod, so thanks! <Reveal this spoiler or all in this thread>
warn("japh!\n"); # ??? 3 direct replies — Read more / Contribute	by hbm on Feb 18, 2009 at 00:18

This has an OS dependency; I've tested on Solaris, XP, and cygwin, and would be curious to hear if it works on others. `use strict;use warnings;close STDERR&&open STDERR,">",\$_; if($-=(map{++$\|,warn$!?$!\|=$_:$!=$_,$/}66,55,25,67)?$\|:$() {@_=map{substr($_,++$-,++$\|)}split$/;print((($^O=~/win/i)? join(undef,@_)^'!/ ?':@_)=>"\!",$/)}` [download] Update: Thank you for the replies! Relying on the error codes was a bad idea. Capturing STDERR was my main point of interest, and below is a better (?) attempt: `use strict;use warnings; {close STDERR&&open STDERR,'>',\$_} print,print[split/\0/,uc^'?25HnL ']->[$\|]` [download]
Perl FAQ 1 direct reply — Read more / Contribute	by setebos on Feb 06, 2009 at 02:14

`perldoc perlfaq1 \| perl -ne '/((?<=")(.+hack...(?:OR)?))/&&die$2.$/' -` [download]

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