join eval tell rand reverse ord chr eval split xor
uc prototype eval lcfirst join chmod kill eval ref
split sprintf reverse times xor not eval and srand
tell sqrt formline eval ord lcfirst ucfirst length
 glob gmtime exp defined caller or binmode log ord
abs lc sqrt study alarm split time or formline cos
ne rewinddir kill chdir reset prototype split sqrt
ord int localtime abs oct pack pop eq scalar print
telldir open unpack return and unlink write chroot
hex bless utime split chown split close rmdir join
exp fileno getc sleep redo glob mkdir stat ne pack
reverse getpwnam next lstat gethostent and getpgrp
 eq log ord time xor chr undef and eval caller and
printf srand lstat chown chdir syscall open select
eq -w closedir sleep chr split and quotemeta reset
require ne closedir sleep chr undef or pack unpack
length study length umask readpipe pos xor defined
 join system and die or do exit if defined require
hex defined undef or sprintf localtime cmp time or
abs time and undef and open exp getc fileno system
caller eof rewinddir readpipe return study defined
kill die wantarray and readlink eof readpipe split
eval warn join study abs localtime oct log time or
reverse xor open 0; print chr ord while readline 0
,;print chr abs length time for cos length defined
[download]

$_='my($w,$h,$x,$y,$z,$b,$v,$q,@s,@u,@a,@d)=(200,350,1,0,1,32000,chr(3
+9),65521,"
2582500861661521092082371081121531251811863301540361932582502020800771
+0624914813
6182133125230167124168161144241159090126154180197177188164129112226165
+1041421741
5419817714816414713424715507812817116320815809016217615419418718021414
+7111233224
172120142189","1734941700001632042184103200220081061764941740001632042
+2541031202
2011103213411176080051105147303310216047160213390060134162067278329162
+1141621443
1429918612011712529031715009015116230328116813214712729031729412603409
+7");map{@d
=map$_-144,/.{3}/g;while(my($a,$b,$c,$d,$e,$f)=splice@d,0,6){for(my$t=
+0;$t<=1;$t
+=.005){$u[$b+$t*($f*$t+$d)][$a+$t*($e*$t+$c)]=$z}}$z++}@s;sub{while(m
+y$n=pop){$
u[$n/$w][$n%$w]&&next;$u[$n/$w][$n%$w]=$z;push@_,$n+1,$n-1,$n-$w,$n<$w
+*$h?$n+$w:
$n}$z<5&&$z++}->(10*$_)for(1228,550,4005,2816,6943);$h+=10;for(1..$h){
+@d=(1,@{$u
[$_]||[]});push@a,map{$y=($y+($x=($x+($z=($d[$_]||1)-1))%$q))%$q;$z}0.
+.$w}@u=@a;
$h=pack"N2C5",$w,$h,8,3;$w="x\1";while($z=@d=splice@u,0,$b){$w.=pack"C
+SSC*",!!($
b-$z),$z,~$z,@d};$w.=pack"N",$x+($y<<16);for$b(0..255){$b=(($b&1)*0xED
+B88320)^($
b>>1)for 0..7;push@u,$b}open(F,">rose.png");binmode F;print F pack("H*
+","89504e4
70d0a1a0a");print F pack("N",-4+length).$_.pack"N",sub{$w=$h=0xFFFFFFF
+F;$w=$u[($
w^$_)&0xff]^($w>>8)for unpack"C*",$_;$w^$h}->()for"IHDR$h",pack("H38",
+"504c54450
00000003000b200006f0000004"),"tEXtComment\0".join($/,unpack("(a80)*","
+\$_=$v$_$v
;s#\$/##g;eval")),"IDAT$w","IEND"';s#$/##g;eval
[download]

(generates rose.png)
Updated to work in 5.8 & golfed some

This is my first attempt at obfuscated code. It's not incredibly obfuscated, tbh, but I was satisfied with it the way it turned out. Note that while it doesn't run "in place" in a DOS/Windows environment (and maybe others), you should at least be able to see what it's doing

@s=split//,'Just another Perl hacker,   ';@t=(.1);while(t){$"="";@l=(&
+s
(2)."@s[2..5]   "."@s[19,18,17,16]",' '.$s[1].&s(4).$s[6].&s(1).$s[20]
+.
&s(4).$s[15],$s[0].&s(6).$s[7].&s(6).$s[14],' '.$s[27].&s(4).$s[22].' 
+'
.$s[8].&s(4).$s[13],&s(2)."@s[26,25,24,23]".&s(3)."@s[9..12]");$"="\n"
+;
print"@l\n\e[5A\r";select$t,$t,$t,$t[0];push@s,shift@s}sub s{' 'x$_[0]
+}
[download]

Hope you enjoy!

print("#####  #   #    ###  #####       #    #   #    #    #####  #   
+#  #####  ###       ####   #####  ###    #         #   #    #      ##
+#  #   #\n  #    #   #   #       #        # #   ##  #   # #     #    
+#   #  #      #   #     #   #  #      #   #  #         #   #   # #   
+ #     # #\n  #    #   #    ##     #       #   #  # # #  #   #    #  
+  #####  ###    # #       ####   ###    ###    #         #####  #   #
+  #      ##\n# #     # #       #    #       #####  #  ##   # #     # 
+   #   #  #      # #       #      #      # #    #         #   #  ####
+#   #     # #\n #       #     ###     #       #   #  #   #    #      
+#    #   #  #####  #   #     #      #####  #   #  #####     #   #  # 
+  #    ###  #   #\n");
[download]

download the code and run it

sub f{my%D;@D{@_}=();for(@_){if(-d){next if${_}eq'.';my@g;opendir(D,${
+_})||next;
while(defined(my$d=readdir(D))){unless(${d}eq'.'or${d}eq'..'){push@g,"
+${_}/$d"}}
closedir(D);push@f,grep({-f}@g);f(grep((!exists($D{$_})),grep({-d}@g))
+)}elsif(-f
){push@f,$_}}return@f}my$q=qr/["']\w[^\W\d]{3}\h\w{5}([[:alpha:]])\S\b
+\N\D\1\w+?
\s\p{PosixAlpha}\B.[\x63-\x72]{4,},?(?:\\n)?["']/six;do{-T||next;open(
+_,'<',$_);
sysread _,$_,-s;if(/$q/o){$_=eval$&;chomp;local$\=$/;print;exit}}forea
+ch(f@INC);
[download]

print unpack "(C/(xx)X220a)26", pack "a366", 
"qsoultoJk ontalPykvhscktkol,r few ues\nrenrnlhaarchkrb"
[download]

Update 2013-05-24: see Re: how to unpack a C struct with length array preceding data array.

eval {                                       hacker
                                        Perl
                                another
                           Just
$,=$"};
eval {                     Just
                                another
                                        Perl
                                             hacker
};
package                         another
;sub                       Just
{print qw;                              Perl
                                             hacker
;}
package                                      hacker
;sub                                    Perl
{print qw;                 Just
                                another
;,''}
[download]

Just another Perl hacker

local+$,=$";package another;sub Just{print(substr((caller(0))[3],3**2)
+,@_)}
package hacker;sub Perl{Just another((split/:./,(caller(0))[3])[1,0]),
+exit}
[download]

I had an idea, and as I worked on it, two forms emerged.

Blessed Objects:

$"='|';$|=$d=1;@b=map{bless{t,"$_  ",r,$d*=-1}}qw/Just another Perl
hacker,/;sub v{$s=shift;my$_=$$s{t};$r=int y===c*$$s{a}/360;$$s{a}=
($$s{a}+$$s{r})%360;s%(.{$r})(.*)%$2$1%;$_}{print"\r@{[map{v$_}@b]
}";select$x,$y,$z,2e-3;redo}
[download]

Functional Objects:

$"='|';$|=$d=1;@b=map{my($t,$h,$a)=("$_  ",$d*=-1);sub{my$_=$t;$r=int
y===c*$a/360;$a=($a+$h)%360;s%(.{$r})(.*)%$2$1%;$_}}qw/Just another
Perl hacker,/;{print"\r@{[map{&$_}@b]}";select$x,$y,$z,2e-3;redo}
[download]

The extra discussion may be unconventional for this sort of post, but I just enjoyed the process and felt like sharing a little about it.

Enjoy!

Just for my amusement... It's been awhile since I've done one of these, but a little idea came to me this morning that I played with this evening before turning in. Maybe others will find some amusement in it too.

Enjoy!

$s=q;Just another Perl hacker,;;sub u{;lc pop}for my$i(0..24){push@s,
sub{[(r()>.98)?(\&u,\&l)[&r+.5]->((split//,${substr($s,2,1,)})[$i]):(
split//,$s)[$i],r()*1.3+$i-.65]}}sub l{uc pop}$|++;for(1..500){;@o=([
"\r"],sort{$a->[1]<=>$b->[-1]}map{;$_->()}@s);print$_->[0x00]for@{[@o
]};select$_->[2],$_->[3],$_->[4],r()*.2;}sub r{rand}sub s{$f->[0]=$s}
[download]

open _=>">$0";print _+'print chr length for split"\5"=>qq;';print _+qq
"\0"x+ord($_)=>"\5"for(split//=>join''=>'Vioh<}rshtyn<Lynp<t}'^$;x(ord
($/)*(++$-*$-++)),'iaox,'^$/x($-**$-),$/);print _ ';';close _;do"./$0"
[download]