simplest as possible

$t = int rand(14) + 6;
$t = $t % 2 ? $t + 1 : $t;

for $l (1..$t) {
    print ' ' x ((int(($t + 1) / 2 )) + 1) . "*\n" if $l == 1;

    print ' ' x (int(($t + 1) / 2 )) .  '/'
        .  (int rand(2) ? "#" : '&') . "\\\n"
        if $l == 2
    ;

    print ' ' x ((($t + 1) - ($l + ($l % 2 ? 0 : 1))) / 2) . '/'
        . (int rand(2) ? "#" : '&') x ($l + ($l % 2 ? 0 : 1))
        . "\\\n"
        if $l >= 3
    ;
}

print '^' x ($t + 3) . "\n";
print ' ' x ($t / 2) . '|H|' . "\n";
[download]

perl -e'*MERRY=*\;*XMAS=*/;' -F: -nae'$,=join q,,,map{chr$_+@{[(1)x un
+pack q C\CC,q q \q \q q]}}q 1007769828289001 =~/.{2}/g;BEGIN{*SANTA =
+ *ARGV}$MERRY=$XMAS;print$F[0],join q,,,map{chr}q;0991041141051151161
+09097115;=~/(.{3})/g;BEGIN{push@SANTA,join q,,,map{chr}q 304710111609
+90471120971151151191003 =~/(.{3})/g}'
[download]

This isn't really obfuscation, it's even vaguely useful, but see if you can figure out what Pipes.pm must be doing, given that this prints o-l-l-e-H

use strict;
use warnings;
use Pipes;

print "hello" |
fn { ucfirst($_[0]) } |
fn { [ split('', $_[0]) ] } |
fn { [ reverse(@{$_[0]}) ] } |
fn { join('-', @{$_[0]}) } |
fn { $_[0] . "\n" };
[download]

perl -e 'print sub { "Hello @{[shift->()]}!\n" }->(sub{"World"})'
[download]

Here's a solution that does it all with command line switches:

    ls -1|perl -054lp012e1
[download]

Few variants of no-digits obfu:

#!perl -l
print map chr oct oct oct oct hex,debf,fbbcf,hex hex eaff,adfff;
print map chr oct oct oct oct oct hex,abadf,hex cd,hex ec,ffaef;
print map chr oct oct oct hex,hex hex oct hex bfd,dbbf,fbbbd,ea;
[download]

Update: finally, more fun

The vet's first diagnosis: The poor kitten seems to be erudite, but it should probably try a diet of less theory, and instead actively some play rounds of golf. Cautious use of source filtering may also provide support in refactoring into a lean beast. @_@

Couldn't figure out how to get the #! to work, but it's not really necessary. Uses the open 0 trick, so save it to a file before running

use strict ;my@f; use warnings ;
open 0;$/= \11;my $i= 0; while (
<0>){chop; push@{$f [ $i]},$_;$i
=($i+1)%3} close 0;$~ ="it"; my(
$l,$m,$r)= map{$f[$_] }(0 .. 2);
for(0..$#{ $l}){$m->[ $_]||= '';
$r-> [$_ ] ||=''; #$l }){ $m ->[
format it=                      
@<<<<<<<<< @<<<<<<<<< @<<<<<<<<<
$l-> [$_], $m-> [$_], $r-> [$_],
.                               
write;}
[download]

perl -le'$;=3;$;=~s/./$&?30:3/eg for 3..pop;print length$;' 12
[download]

Can you see how it works?

-- Frank