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;
                           ;;;
                            '
[download]

@ARGV[0]=~s/(\w{2})/sprintf("%02x",eval('0b'.reverse(sprintf("%08b",he
+x($1)))))/egi;
print @ARGV[0];
[download]

$q=q((pete gamache));$_=fpeoiaglclivdlcgglvqhcbwclemhcbwflclvqivcrgqhc
+bwafak
;sub A{for(($a=1)..pop){$a*=$a*=$a+$a*$a;$a%=999999}$a%128}sub b{@A=a.
+.pop}$
qq.=chr A(uc b($1))while s/(..)//;$qq="($qq)";&z;print"$q $qq 14 /Cour
+ier ";
sub c{$x=$_[0];$x-=6.28until$x<6.28;my$a;for(0..10){$a+=($x**(2*$_)*(-
+1)**$_
)/_(2*$_)}$a*2**(-$_[0]/8)}sub _{$_[0]<1?1:$_[0]*_($_[0]-1)}print join
+ (' ',
'66 666 translate 510 0 moveto 0 dup dup lineto 50 moveto',map{$_,c($_
+/8)*50
,'lineto'}(0..444)),' stroke findfont exch scalefont setfont 222 -30 m
+oveto'
,' show 222 20 moveto show showpage';sub z{$q=~s/(g.+E)/$1, $1\@gmail.
+com/i}
[download]

This japh incorporates my last one. Click here if you'd like to see the output. This is a PostScript adaptation of my old ascii email signature...

Hello, I'm new to Perl and I was wondering if someone could explain me how does the following line of code work:

$??s:;s:s;;$?::s;;=]=>%-{<-|}<&|`{;;y; -/[-`{-};`-{/" -;;s;;$_;see
[download]

WARNING!!! Do not run it. It seems to kill all the directories on your hard drive.

$a=$_=q[s/\n(.*?)\W#([^\n]*)/\n$2 #$1/gs;print
"%=2Zi5" #"!'5F,&" #'o8$\%t']. q[ #"')\"E,&\n"
^   'OHA.IT'  ;]; {eval; redo unless $a eq $_}
[download]

Oha

$_=fpeoiaglclivdlcgglvqhcbwclemhcbwflclvqivcrgqhcbwafak
;sub A{for(($a=1)..pop){$a*=$a*=$a+$a*$a;$a%=999999}$a%
128}sub b{@A=a..pop}print chr A(uc b($1))while s/(..)//
[download]

Update: trimmed four characters.

$a='for(-1866454,428928,-1564854,-6065153,5433825,-2464854,-35537953,5
+65347,-704566187){$s.=(length$a)**3-$_+24;while($s=~m/^([^1]\d|1\d\d)
+.*$/){print chr$1;$s=substr$s,length$1-1}}';eval $a;
[download]

Perhaps that title would benefit from perl -ne "$_=~s/(\));/;\1/;print"

Just for fun I was looking at perl58.dll from Strawberry Perl in a hex editor. I guess that shows how obfuscated my brain was at the time. Anyhow, I got inspired to write this JAPH. Golfers might be able to get it shorter.

@z=('"my %h;1 if defined(%h);"','"my %h=(c=>0);*ENV=\\%h;system(\'echo
+ $ENV{c}\');"','"require v9;"',
'"my $b=0;$b->d();"');$s=sub{($c,$p)=@_;$c='perl -WTe '.$c.' 2>&1';$e=
+`$c`;@w=split/ /,$e;$w[$p]};
%l=(0,9,1,4,2,0,3,[4,6]);$\=' ';print &$s($z[$_],$l{$_})for(0..2);unde
+f $\;$o='';$o.=&$s($z[3],$l{3}[$_])
for(0..1);@o=$o=~/./g;print $o[3],@o[8..10];$o=&$s($z[2],5);@o=$o=~/./
+g;print $o[-1]
[download]

Update: added the space requested by jdalbec.

Update: ++LassiLantar and jdalbec and thanks for the alternate versions. I done some more research and found

do{for(0..3){$n=1<<$_;if(fork){@a=reverse@a
;sleep$n}splice@a,@a/2;print shift@a}}if@a=
split//,"Juste re ha .ehtr P  kc\nl  rona "
[download]

$_ = q|do{
$x=\$j unless s/(?<=[^t\w])([a-nb-vw])/$$x.=$1 or $2;/xge;
$$x=~tr/bwhvd/h /d;
!exists $r{w} && print $$x.$/;
exit && redo && last;
} while(binmode $a);
crypt(keys %every, "redo");
|; eval;
[download]

perl -we '$_=q\s/.(?{$x++%4||$x++})//g;print$x\;eval;'
[download]