Let's elminate the most gratuitous of the code bloat:
 1) log(!!$$)
    $$ is always true, so !!$$ is always 1.  log(1) == 0
 2) oct("$^W$^D")
    $^W is 1, because warnings are on.  $^D is 0, because debug is off.
    oct(10) == 8
 3) -B$0?1:0
    $0 is us.  We're never binary, so this == 0
 4) $\!~m{q}
    $\ has no 'q' in it, so this == 1
 5) sin(0)x2
    sin(0) == 0.  0x2 == '00'
 6) (1<<1)
    It's 2.  No brainer.

Substitute these in to get:
#!/usr/bin/perl -w
use Socket;
socket(R, PF_INET, SOCK_STREAM, getprotobyname("tcp"));

$,=' ';$\="\n";
%a=("0\0340",119,"0\0341",-1.5,"0\0342",-2.5,"1\0340",99,"1\0341",19,"1\0342",-7,);
for$l(0..1){for$q(0..2){$r=0;for$a(0..2){$r+=$a{$l,$a}*$q**$a;}$l[$l].=chr($r);}}@_=unpack("a*",scalar(reverse$l[$#l]));++$_[$#_];
for$l(0..1){connect(R,(unpack"u*",join('8',join('`','0',($l?'@`':'`('),"*\\"),'I``','`'x(hex(chr(('1'.'00')))))[0])&&last;}
send(R,join("",$q=scalar(reverse(pack"a*",@_)),$,,join(".",@l),"$\\"),0);

while(<R>){s|$,\($l[$[]-$q\)$||i||next;chomp;close(R);open(W,"<$0");<W>=~/\W(\w+)\s/;close(W);@_=split$,,$_;splice@_,$^W,int$]/2,"\u\L$1";print(@_)&&last;}
---------------------------------------------------------------------------
Second verse, same as the first:

 7) hex(chr(('1'.'00')))
    hex(chr(100)) == hex('d') == 13
 8) '`'x13
    '`````````````'
 9) ($l?'@`':'`('),"*\\")
    Depending on the endianness of the machine, (this to be explained later),
    what we need can be different.  We're in a for loop, 0 to 1, so l will
    try one, then the other.  One should work (i386 works on the first pass,
    Sparc and HPUX second).  When we get one, bomb out with last.
    For the rest of the way, we'll assume we got it on the first pass.
10) join('`','0','@`',"*\\")
    '0`@``*\\'
11) join('8','0`@``*\\','I``','`````````````')
    '0`@``*\8I``8`````````````'

Substituting in, and spacing out 1 section:
#!/usr/bin/perl -w
use Socket;
socket(R, PF_INET, SOCK_STREAM, getprotobyname("tcp"));

$,=' ';$\="\n";
%a=("0\0340",119,"0\0341",-1.5,"0\0342",-2.5,"1\0340",99,"1\0341",19,"1\0342",-7,);
for $l (0..1) {
   for $q (0..2) {
      $r = 0;
      for $a (0..2) {
         $r+=$a{$l,$a}*$q**$a;
      }
      $l[$l].=chr($r);
   }
}
@_=unpack("a*",scalar(reverse$l[$#l]));++$_[$#_];
connect(R,(unpack"u*",'0`@``*\\8I``8`````````````')[0]);
send(R,join("",$q=scalar(reverse(pack"a*",@_)),$,,join(".",@l),"$\\"),0);

while(<R>){s|$,\($l[$[]-$q\)$||i||next;chomp;close(R);open(W,"<$0");<W>=~/\W(\w+)\s/;close(W);@_=split$,,$_;splice@_,$^W,int$]/2,"\u\L$1";print(@_)&&last;}
---------------------------------------------------------------------------
12)  Go through the for loop: q goes from 0 to 2, and a goes from 0 to 2.
q is a base, a is an exponent.  So, we have q to the 0th, then 1st, then 2nd,
where q goes from 0 to 2.  Now, q**a is also multiplied by something, and
added to r.  Or, in a more generalized form, r = a*q**2 + b*q**1 + c*q**0.
The whole loop simply computes quadratics.  The a,b, and c come from %a.
"0 \034 0" is the key, 119 is its value.  The first 0 is for what loop of
'l' we're on, the second 0 is for what loop of 'a' we're on, or, what
exponent.  The 034 serves as a multidimension separator.  Reference $; in
perlvar if you've not seen it before.  After we calculate 'r', we append
the ASCII character of 'r' to @l, position 'l'.

The result of this is that "@l = ('wsj','com');"

So, let's substitute it in:

#!/usr/bin/perl -w
use Socket;
socket(R, PF_INET, SOCK_STREAM, getprotobyname("tcp"));

$,=' ';$\="\n";
@l = ('wsj','com');
@_=unpack("a*",scalar(reverse$l[$#l]));++$_[$#_];
connect(R,(unpack"u*",'0`@``*\8I``8`````````````')[0]);
send(R,join("",$q=scalar(reverse(pack"a*",@_)),$,,join(".",@l),"$\\"),0);

while(<R>){s|$,\($l[$[]-$q\)$||i||next;chomp;close(R);open(W,"<$0");<W>=~/\W(\w+)\s/;close(W);@_=split$,,$_;splice@_,$^W,int$]/2,"\u\L$1";print(@_)&&last;}
---------------------------------------------------------------------------

13) scalar(reverse$l[$#l])
    scalar(reverse ('wsj','com')[1]) == scalar reverse 'com' == 'moc'
14) @_=unpack("a*",'moc');
    @_ = ('m', 'o', 'c')
15) ++$_[$#_];
    The last element of @_ is 'c'.  Add one.  @_ = ('m', 'o', 'd')
16) $q=scalar(reverse(pack"a*",@_))
    $q = scalar reverse pack "a*",'m','o','d' == scalar reverse 'mod' == 'dom'
17) join(".",@l)
    'wsj.com'
18) join("",$q='dom',$,,'wsj.com',"$\\")
    'dom' . ' ' . 'wsj.com' . "\n" == "dom wsj.com\n"

Cleaning up again:
#!/usr/bin/perl -w
use Socket;
socket(R, PF_INET, SOCK_STREAM, getprotobyname("tcp"));

$,=' ';$\="\n";
@l = ('wsj','com');
$q='dom';
connect(R, (unpack"u*",'0`@``*\8I``8`````````````')[0] ) &&
send(   R, "$q wsj.com\n", 0);

while(<R>){s|$,\($l[$[]-$q\)$||i||next;chomp;close(R);open(W,"<$0");<W>=~/\W(\w+)\s/;close(W);@_=split$,,$_;splice@_,$^W,int$]/2,"\u\L$1";print(@_)&&last;}
---------------------------------------------------------------------------
19) Here's the magic.  The second argument to 'connect' is a sockaddr, which
is a nicely packed binary structure, and hence why the program has a
uuencoded line.  Sockaddrs are system dependent, depending on the endianness
of the bytes, hence the loop around the connect statement.  So, to analyze
the connect line, look at it with this:

#!perl
use Socket;
($hersockaddr)  = unpack "u*", '0`@``*\8I``8`````````````';
($port, $iaddr) = unpack_sockaddr_in($hersockaddr);
$herhostname    = gethostbyaddr($iaddr, AF_INET);
print "$herhostname $port\n";

You should get back "rs.internic.net 43".  43 is the 'whois' port,
and internic is the whois server.
So, we connect to rs.internic.net and say "dom wsj.com" over filehandle R.
We get a result back.  While there's lines in R....

20) s|$,\($l[$[]-$q\)$||i||next;
    s/ \(wsj-dom\)$//i || next
    Used pipes as confusing delimeters.
    So, we read lines off the response until we run into ' (WSJ-DOM)',
    which happens to be on the line that reads:
    'The Wall Street Journal (WSJ-DOM)\n'.  We strip that off and
    continue, with $_ == 'The Wall Street Journal\n'..

21) chomp; close(R);
    Once we have our match, we chomp the newline and close the socket,
    since the line has all we want.

22) open(W,"<$0"); <W>=~/\W(\w+)\s/; close(W);
    We open ourselves for reading.  Grabbing line 1, we match a word that
    comes after a nonword (the / in unix, the #! or \ in Win32) and before a
    space.  That's 'perl', and it gets put in $1.

23) @_=split$,,$_;
    @_ = split " ", 'The Wall Street Journal';
    @_ = ('The', 'Wall', 'Street', 'Journal');

24) splice@_,$^W,int$]/2,"\u\L$1";
    splice @_=('The', 'Wall', 'Street', 'Journal'), 1, int 5/2, "\u\Lperl";
    splice @_=('The', 'Wall', 'Street', 'Journal'), 1, 2, "Perl";
    @_ = ('The', 'Perl', 'Journal');

25) print(@_) && last;
    print ('The', 'Perl', 'Journal');
    $, provides the spaces, $\ provides the newlines.
    'last' out of the loop, and we exit.
