Perl & win32

А че так медлееено работают сокеты в Perl под win32 (ActivePerl)?

server <=> localhost <=> client

Red Hat ES 3 (2.4.21-20.EL), P3 500:   19,6 Mb/sec
Windows XP, Celeron 900:   5,1 Mb/sec

Почти в 7 раз уделал, что так плохо то?
Давайте свои цифры, код тестов ниже:


#srv.pl
#!/usr/bin/perl -w
use Socket;
use Time::HiRes qw(gettimeofday tv_interval);
use strict;

unless(defined $ARGV[0]) {
  print "Usage: ./srv.pl port\n";
  exit;
}

my $port     = $ARGV[0];
my $protocol = getprotobyname('tcp');

socket(SOCK, AF_INET, SOCK_STREAM, $protocol) or die "socket() failed: $!\n";
setsockopt(SOCK, SOL_SOCKET, SO_REUSEADDR, 1) or die "Can't set SO_REUSADDR: $!\n" ;

my $my_addr = sockaddr_in($port, INADDR_ANY);
bind(SOCK, $my_addr)    or die "bind() failed: $!\n";
listen(SOCK, SOMAXCONN) or die "listen() failed: $!\n";

print "Waiting for incoming connections on port $port...\n";

while (1) {
  next unless my $remote_addr = accept(SESSION,SOCK);
  my ($port, $hisaddr) = sockaddr_in($remote_addr);
  print "Connection from [",inet_ntoa($hisaddr),",$port]\n";

  my $t0 = [gettimeofday];
  
  my $bytes = 0;
  my $msg   = '';
  for(my $i=0; $i < 30000; $i++) {
    $msg = "$i"x1000;
    print SESSION "$msg\n";
    $bytes += length($msg);
    print $i,"\n" if($i && $i % 2000 == 0);
  }
  print "Connection from [",inet_ntoa($hisaddr),",$port] finished\n";
  close SESSION;
  
  my $t1 = [gettimeofday];
  my $elapsed = tv_interval $t0, $t1;
  
  print "bytes: $bytes, time: $elapsed, Speed: ".sprintf("%.3f", $elapsed ? $bytes/$elapsed : 0)."\n";
}

close SOCK;
exit;

#cli.pl
#!/usr/bin/perl -w
use Socket;
use Time::HiRes qw(usleep ualarm gettimeofday tv_interval);
use strict;

unless(defined $ARGV[0]) {
	print "Usage: ./cli.pl port\n";
	exit;
}

my $protocol = getprotobyname('tcp');
my $port     = $ARGV[0] or die "invalid port!\n";
my $host     = inet_aton("localhost") or die "unknown host!\n";

socket(SOCK, AF_INET, SOCK_STREAM, $protocol) or die "socket() failed: $!\n";
my $dest_addr = sockaddr_in($port, $host);
connect(SOCK, $dest_addr) or die "connect() failed: $!\n";

my $t0 = [gettimeofday];

my $i = 0;
my $bytes = 0;
while(<SOCK>) {
   $i++;
   print $i,"\n" if($i && $i % 2000 == 0);
   chomp;
   $bytes  += length($_);
}

close SOCK;

my $t1 = [gettimeofday];
my $elapsed = tv_interval $t0, $t1;

print "bytes: $bytes [$i], time: $elapsed, Speed: ".sprintf("%.3f", $elapsed ? $bytes/$elapsed : 0)."\n";