It seems to spin ad infinitum sucking up 80%+ CPU. (I let it go about 5 minutes before I sent a SIGINT.)

A quick run through the debugger seems to indicate it gets stuck on

 DB<1> 
main::(./japh3.pl:20):  @t=unpack"C*",do{local($/);&lt;DATA&gt;}){my$t
+=0;{$t[0]==126
  DB<1> 
main::(./japh3.pl:20):  @t=unpack"C*",do{local($/);&lt;DATA&gt;}){my$t
+=0;{$t[0]==126
  DB<1> 
etc. etc. etc.
[download]

Follow-up: I was being daft. Make sure there are no blank lines after __END__. Doh!

Edit: chipmunk 2001-05-28

Truly a monster, here it is with whitespace

use strict;
my@l=(1);
my($c,$d)=(75,0);
push@l,q|-84|;
sub t{
    my$o=shift;
    print$o @_
}
push@l,qw{-1 43 -2};
unshift@l,@l[$#l-2..$#l];
pop@l;
pop@l;
pop@l;
sub c{
    my$f=pop;
    open M,$f;
    my @l=<M>;
    chomp@l;
    pop@l while$l[$#l]ne'__END__';
    open M,">$f";
    t *M,(join"\n",@l),$/
}
push@l,qw-33 45 1 5-;
push @l,qw @-12 -3@;
sub i{
    my(@a,$n)=@_;
    $n+=shift@a while$n++,@a&&!--$a[0];
    {
        @a||last;
        @a=($a[0]<$n?$a[0]:$n,@a);
        ($n-=$a[0])&&redo
    }
    @a
}
unshift@l,qw[13-82];
push@l,@l[0,1];
shift@l;
shift@l;
sub P{
    my($P,$p)=@_;
    $P<$p? 0 :  $P==1   ||
                $p==1   ||
                $P-$p==1 ?  1 : P($P-1,$p-1)+P($P-$p,$p)
}
push@l,qw-48 21  13-,q;-6;;
$l[$#l+1]=-76;
push@l,qw/40 25 2  8/,q#-6#;
sub p{
    my$e;
    my@r=[];
    $e=$_,@r=map{my@a=@$_;map[@a[0..$_-1],$e,@a[$_..$#a]],0..@a}@r for
+@_;
    @r
}
push@l,qw@13-104@;
if(my@t=unpack"C*",do{local($/);<DATA>}) {
    my$t=0;
    {
        $t[0]==126 ?((t *STDERR,chr$t),last): ($t+=shift@t)and redo
    }
    c $0;
    $d=$t[$#t];
    $c+=$l[$_]for 0..$d
}
else 
{
    $c+=$l[0];
    $d=0
}
if($d<@l){
    open M,">>$0";
    my@p=$c;
    my$r;
    do{$r=int(rand&P($c,int(rand($c-($c/3))+1)+int(2*$c/3)))+1}while$r
+==1;
    @p=i@pwhile$r--;
    (@p<1<<3)?(@p=p(@p)and t(*M,(map{chr}@{$p[int(rand(0+@p))+1]}),'~'
+,chr($d+1))):(t(*M,(map{chr}@p),'~',chr($d+1);
    exec"perl $0"
}
__END__
[download]

Hmm, that's heaps clearer now! This may take longer than I thought.....

tachyon

SPOILER!

It's been a couple of days, so i thought i would post the spoiler, there has been at least some request for it, so here goes:

Firstly, look at the post that i replied this to, that post has the monster written out with white space. We'll start at that incarnation (because it saves me from typing).

@l: This is a list of numbers that determines what the next letter of 'Just Another Perl Hacker' will be. If we put everything together, @l becomes the following:

@l = qw(
-1 43 -2 1 -84 33 45 1 5
 -12 -3 13 -82 48 21 13
 -6 -76 40 25 2 8 -6 13 -104);
[download]

If we take the starting number ($c at 75) and start adding numbers sequentially we get the following list of numbers:

74 117 115 116 32
65 110 111 116 104 101 114 32
80 101 114 108 32
72 97 99 107 101 114 10
[download]

These just happen to be the ordinal values of the letters 'Just Another Perl Hacker' (32 is space and 10 is newline). So, that was the easy part. What do all those subroutines do? Many may find the code familiar as i used this japh to test the results of some of the golf contests. In order:
t: prints to the filehandle passed in.
c: reformats a file, making it only have the lines above the __END__ token.
i: tye's context insensitive number partitioner.
P: returns the number of partitions for a given number of a given size.
p: tilly's non-recursive permutation finder.

Now we have to use those. The if block

if(my@t=unpack"C*",do{local($/);<DATA>}) {
    my$t=0;
    {
        $t[0]==126 ?
        ((t *STDERR,chr$t),last):
        ($t+=shift@t)and redo
    }
    c $0;
    $d=$t[$#t];
    $c+=$l[$_]for 0..$d
} else {
    $c+=$l[0];
    $d=0
}
[download]

checks to see if there is already a value set under the __END__ tag. If there is, It takes the numbers before the ord value 126 (tilde or '~') and adds them together, to receive the ordinal value of the character to print. Then the number after the tilde becomes the spot in the array (@l) where we currently belong. Also we clean up the file at this point, to remove anything after the __END__ token. At this point we set the current letter ($c) to the next letter in the series, and the pointer ($d) to the position of that letter in the array.

If there is nothing after the __END__ token, we simply set $c to 74 (ordinal 'J') and $d to 0 (beginning of array).

Now, if our spot in the array is equivalent to the size of the array, we're done, there's no more. Note that because of the placement, when we're done, there will be nothing after the __END__ token, so we can run the program again.

if($d<@l){
    open M,">>$0";
    my@p=$c;
    my$r;
   do{
      $r=int(rand
          &P($c,int(rand($c-($c/3))+1)+int(2*$c/3))
         )+1
   } while $r==1;
   @p=i@pwhile$r--;
   (@p<1<<3) ?
   (@p=p(@p)and t(*M,(map{chr}@{$p[int(rand(0+@p))+1]}),'~',chr($d+1))
+):
   (t(*M,(map{chr}@p),'~',chr($d+1);
   exec"perl $0"
}
[download]

If we are not done, we open ourself for appending and get down to business. $r is the number of times that we will loop through the partition finder. In order to find $r we want to know how many times we can take partitions of $r, and i use a random value for the size that i want the final partition to be to make things interesting. In order to not have the program run toward infinite however, i have to bound how big $r can be. Also, if i wanted to remove the nifty missing letter feature, i could further restrict $r to do so. But i like that feature, i'm not perfect, why should my japh be?

Anyway, After finding a reasonable $r, we run through the iterations of i. Then, if there are less than 8 things in our partition, we randomize the locations of the numbers by running the permutation finder, and select one of those permutations to print. If there are more than 8 things in the list, than we don't permute them because it will take far too bloody long to find the permutation of more than 7 things (with any of the algorithms suggested by the golf contest).

During printing, we also print out a tilde to seperate the letter from the pointer, and print out the pointer.

After we've printed out the characters, we run the program again. This will close the file for us, and since we are 'exec'ing the file, the current script goes away.

And there's the spoiler,
jynx