When you run this with any argument, for example:

    % perl blocks x
[download]

the program simply displays itself using all '#' characters (which makes it easier to read the letters depicted in the blocks in the ascii picture).

When run without arguments, the output gets REALLY interesting!

Warning -- this program is fairly memory intensive, so it's not recommended that you run it on a system with lots of other processes running concurrently.

Update:  Note, too, that the program creates/overwrites a file called 'x' in the current directory.  (Thanks shmem!)

Update 2:  Also note (especially for Linux users) that the Tk module must be installed.

Update 3:  A hint about deconstructing the program is this -- try running Deparse on the temporary file "x" which is created:  perl -MO=Deparse x

                                                               
if(pop){undef$/;open$x,$0;$_=<$x>;s/\S/#/g;die$_}              
                                                               
                                                               
                           s''                                 
                          useQTk;                              
                         P($M=newQMa                           
                        inWindow);$M->g                        
                       eometry("0x0");subQ                     
                      J{sprintf"#%02x%02x%02                   
                     x",randQ256,randQ256,r a                  
                    ndQ256}subQA{$m->geome tr                  
                      y(sprintf"%dx%d+%d+ %d"                  
                    ,$   s,$s,$x-$s/2,$y -$s/                  
                    2)}su   bQP{$_[0]-> overr                  
                    ideredir   ect(1)} subQH{                  
                    ($G,$H,$I)=   ($_ [0]->ge                  
                    ometr    y=~/(   \d+)\+(.                  
                    +)\+       (.+)/ );($H+$G                  
                    /2,   $I+   $G/2 )}subQ_{                  
                    @C=  (J,J,   J,J )}_;$A=p                  
                    op;     $M-  >af ter(50,                   
                    sub  {m      ap{ ($o,$p                    
                    )=/  4|5/?   (7* $_-27  ,1)                
                   :  (2+((ord)  -54 )/7,  1+((ord             
                  )-54   )%7);$  J.= "#"  x$o.   $"x$          
                 p}split    //,  q[5 77  EUE7      7ER76       
                KL576RTR77E    R76KV 8  7678   :76   =67887    
               697:877;:76=678    87   697:     878@   :RR788  
              REV87:8:RR788REP87;     7:76   6=   788   769F 7 
             87687:766=78876967UEZ:  7677   G876K       77H FM 
            :7677G876K88SKM<78GE96 K   PYKS<77SR87KV86977< 777 
           7847897:86977<7777:699 7: YE   S<SS:HEVSEM<SS: HEP; 
             9G<7777:699J;968<77 778 47896   ;;K77N7777R 87K7: 
           ;K   86N7778E96K86]; ($s, $d)=($A%   2)?(37, -8):(4 
           ,3);w   hile($q=sub str$J ,0,  80,"")   {++ $r;$j=0 
           ;_QifQ$A   >1;map{ $x=30+ 12*  ++$j;$y=1   2*(11+$r 
           +2*  ($r>10   )); if(!/Q/ ){P  ($m=$M->Top level);_ 
           Qif    $A>3;$m   ->config ure    (-hi  ghl ightt=>1 
           ,-hig    hlightb =>"black ",-      bg  =>$ C[($j<31 
           )+2*($     r<11) ]);push@ A,$  m;      &A} }split/  
           /,$q;$   m   ->u pdate}wh ile  (13!    =$s ){$s+=   
           $d  ;@   B=  @A; while(@  B){  $_=spl  ice @B,ra    
           nd   @   B,1,(); ($m,$s     ,$x,$y)=(  $_, $s,H     
           ($_      ));&A;$ _->up         date}}  sle epQ      
             3;ma   p{$b=sp lice             @A,  ran d@       
                A,1,();$b-> wit                 hdraw }        
                   @A;exit} );                     Ma          
                      inLoo p                                  
                         ';s        /\s//gx;                   
                                   s/Q/$"/gx;                  
                                  open$X,">x";                 
                                  print $X $_;                 
                                  map{ system(                 
                                   "perl x $_                  
                                    ")} 0..5
[download]

print pack"C*",map 2*("p"le$_&&$_ cmp"q")-$#++ord,eval{$SIG{__WARN__}=
+sub{die@_};open my$f,"<:x)",$^W++}||(lc$@)=~m, (.)(.)(.)(.),,0
[download]

@d=split /\W/,"14-(5+(248<=>27)*0^b-7+(3.4.8))7b+1/27-1";$s="   r\n";
foreach $w (a..z){map{substr $s, hex, 0, $w;} split //,shift @d;}
print $s;
[download]

Update: i'm not sure if i should put some "explanation" on what's above, and how "spoiler" works (which tag?)

#!/usr/bin/perl
do shift;{($t[$h],$*,$m)=@{$b{$m}{$t[$h]||0}};$h+=$*;$m?redo:die@t,$/}
[download]

• <Reveal this spoiler or all spoilers in this node or all in this thread>
• <Reveal this spoiler>

sub _{ srand shift;push@a,map{chr 97+rand 21}0..shift||5};
_ 4971054;_ 2123966;_ 2922908,4;_ 306345,3;$_=join "",@a; 
s#(?=[ap][en]|ha)# #g;print
[download]

Somehow I couldn't resist the seduction of the random numbers ;-)

open$h,chr${$/}*30,\q/200036443006022244385048300450485630380608105048
+18/if$/=\2;print substr q/unpack"C",join" ",shift(readlink) $/,$_/${$
+/},${$/}/2for<$h>
[download]

I haven't done one of these in a while, but got the idea for this while I was tracking down some misbehaving code that I had to replace - having seen this presentation at YAPC::NA helped.

Apologies for the non-standard form.

*{"    |$ /    |$ /|___|"}=sub{ust};*{qq%.|   $/ |--.$/ |  |%}=sub{q@a
+cker,@};
*{qq*  __.$ /  --|$ / |__|*}=sub{q.nother.};*{qq#.---$/ |__)$/ |  #}=s
+ub{erl};
print $  _ ,$  _ ->  (), $ / for grep {m  { ^[ .|]  }x } sort keys % {
+*  :: };
[download]

s**lil*;  $*=join'',sort split q**;  s;.*;grr; &&s+(.(.)).+$2$1+; $; =
qq-$_-;s,.*,ahc,;$,.=chop for split q,,,reverse;print for($,,$;,$*,$/)
[download]

                                                       my $f="^("
                                                     ;my $r = '"';my$c
                                                 = 1; my $i; my $t;sub
                                                  llama{my $n=shift;my
                                                    $r=""; for
                                                    (1..11){$r
                                                    .=($n>=(2
                                                    **(11-$_))
                                                     )?1:0;if(
                                                    rindex($r,
                                                    "1")==$_-1
                                                   ){$n-=(2**(
  11-$_));}} return $r;}$_ = "0";$_.=llama(1855) ; $_ .=llama(
188);$_.=llama(935); my   @i= split(//,$_);foreach(@i){#;+++''
$_+=2;$f.='.'x$_.')('; $r.='$'.$c++.' ';}$r .= '"';#';+++;++'
$f.=')';my $string = "";foreach(<DATA>){$string.=$_;}#'+#++;:
$string =~ s/[ \n]//g;my@g=unpack("C*",$string);#;';:;##+'#
  my $st="";for(1..44){$st .= (($t=(($i=shift(@g))==#';###':
   38)?$i+shift(@g):$i-shift(@g))<=9)?#,.+'';'';';+'''++@#,
    "0".$t:$t;}$_=$st ."4";#++'##+;',::',;;+#;+##,;;@#@#+,
    /$f/;###';##';;;;++#+@++@#+#@+'',:'';'''+##+@;#:+@#:;
    my $s = eval $r;#`'+@@@@##@@@+###@#;,''#@@+@''++#+',
     my @p = split(/ /, $s);#@@@@+#@'@'+##+##@+#@++#@,`
      print pack("C*",@p). "\n";###@#@+#;@##+@######'`
       #@@#'';:+'''+#++`    '@@@#@#@@@###@@####@#+',.
         #@@+;##;'+;+#`      ,:+####@@@+#@#+#@#+@#
          #@@#++#;+##           ..+#+''#'@@@@#;+@#
           #@@##++'''             ` ,.` #@@@@#;#;.
           __DATA__                     #@@@@@@#+'
            &$.#&!                      :+.#{<?"&
            !.$.#                       .#:*.$O&%$
           .#O$<                        $.%&!.%&;
            .#_"                        %$.   #&!
            :,O&                        O/     }-
             .$.                        #<     ..
              $}                        *<     '+
              '&;                       &=     .$
               &!                        %$     .#
[download]

$_                       # Side Comment Japh -- by liverpole
= q ? @                  # = qw
                         # --Just-another-Perl-hacker,-- # ;
map { print "$_-" } @    # ?; y|-\n | |d; eval
[download]

This command line works on Windows and *nix, UTF8 enabled or not.

perl -e  "map {s/Z/\x24/g;eval()}map{m/(.*)/}q{map{Z\.=chr(96+(Zb|Z_>>
+4&63||0xc0)&255);Zb=Z_<<8>>4&0xf0 }map{ord}map{utf8::decode(Z_);m/([^
+Â])/g}qq(¡Q1@\0\cPàñ@\xc2\x80Q \cA\0Q À\0\xc2\x80\cP0°Q );Z\.=qq[,\n]
+,print''}"
[download]

I'd be interested to see how you could do this with pack/unpack.

Clint

Update - now with the trailing comma, as pointed out by agianni