komischer code

was meint ihr. wollte sich perl mit diesem code identifizieren?
  </font><blockquote><font size="1" face="Verdana, Helvetica, sans-serif">Code:</font><hr /><pre style="font-size:x-small; font-family: monospace;">
#!/usr/bin/perl -w

use Data::Dumper;

opendir DH, '.' or die "can't opendir $!";
@files = readdir DH;
closedir DH;
%prob = ('<' => 90, '>' => 90, '+' => 90, '-' => 90, '[' => 90, ']' => 90, '.' => 90, ',' => 90, '' => 151);
#@red = (0, -90, 40, 80, 90, 160, 320);
@red = (0, 40, 40, 40, 40, 40, 40);

my $len = 0;

for $f (@files) {
   next unless ($f =~ /.bf?$/i);
   open FH, $f or die "can't open $!";
   my $cont = '';
   while (<FH>) {
     for (my $i = 0; $i < length $_; $i++) {
       my $c = substr $_, $i, 1;
       ++$prob{$c}, $cont .= $c if exists $prob{$c};
     }
   }
   for (my $i = 0; $i < length $cont; $i++) {
     for (my $s = 2; $s < 7; $s++) {
       $prob{substr $cont, $i, $s}++;
     }
   }
   close FH;
}

for $key (keys %prob) {
   delete $prob{$key} unless (($prob{$key} -= $red[length $key]) > 0);
}

sub pair { [shift, shift]; }
@list = sort { $a->[1] <=> $b->[1]; } map { pair($_, $prob{$_}); } keys %prob;

our %type;

for my $x (@list) { $type{$x} = 0; }

while (scalar @list > 1) {
   my ($ma, $mb) = (shift @list, shift @list);
   unshift @list, pair(pair($ma, $mb), $ma->[1] + $mb->[1]);
   $type{$list[0]} = 1;
   @list = sort { $a->[1] <=> $b->[1]; } @list;
}

our %code;

sub traverse {
   my $node = shift;
   my $code = shift;
   if ($type{$node} == 1) { traverse($node->[0]->[0], $code . '0'); traverse($node->[0]->[1], $code . '1'); }
   else { $code{$node->[0]} = $code; }
}

traverse($list[0] , '');

@keys = sort {
    my $ld = length $b <=> length $a;
    return $ld unless $ld == 0;
    return length $code{$a} <=> length $code{$b};
} keys %code;

sub tonum {
   my $p = shift;
   my $n = 0;
   for (my $i = 0; $i < length $p; $i++) {
     $n = ($n << 1) | (substr($p, $i, 1) eq '1' ? 1 : 0);
   }
   $n;
}

print "#include "head.h"n";
print "extern const struct out_code ";
print "out_codes[] = {n";
my $count = 0;
for my $key ( @keys ) {
   my $m = tonum($code{$key});
   print "t{ "$key", " . length($key) . ", $m, " . length($code{$key}) . " },n";
   ++$count;
}
print "};n";
print "nextern const int count = $count;nn";

sub traverse2 {
   my $node = shift;
   my $l = shift;
   if ($type{$node} == 1) {
     $$l .= '&';
     traverse2($node->[0]->[0], $l);
     traverse2($node->[0]->[1], $l);
   } else {
     $$l .= "($node->[0])";
   }
}

$tree = ();
traverse2($list[0], $tree);

print "extern const char tree[] = n";
for (my $i = 0; $i < length $tree; $i += 70) {
   print "t"@{[ substr $tree, $i, 70 ]}"n";
}
print ";n";

  [/code]</blockquote><font size="2" face="Verdana, Helvetica, sans-serif">