perl 内存问题
Windows平台。下面的代码,我开启一个线程来接收文件,但是运行几次,发现这个脚本耗用内存简直是疯长,但是线程执行完后没见内存被回收。这是个什么原因来着?各位帮参谋一下:
#!perl -w
use strict;
use IO::Socket;
my $dir = shift @ARGV;
if (!defined ($dir)) {
print "请指定一个目录存放接收的文件!\n";
exit (-1);
}
if (!-e $dir) {
mkdir $dir || die "无法创建目录,@!";
}
printf "已经启动了服务器,正等接收文件,并放在目录 \'%s\' 下。\n", $dir;
my $listen_socket = IO::Socket::INET->new (LocalPort => 9999,
Listen => 20,
Proto => 'tcp',
Reuse => 1);
if (!defined ($listen_socket)) {
die "未能启动接收服务器,$@";
}
use File::Path;
use threads;
while (1) {
my $connection = $listen_socket->accept ();
if (!defined ($connection)) {
next;
}
# 有新连接开启一个线程来处理
threads->create (\&receive_result_file, $connection);
}
sub receive_result_file
{
my $connection = shift (@_);
my $client = $connection->peerhost ();
my $file;
my $buf_len = 2048;
#
# 这里取得文件名。
#
sysread ($connection, $file, $buf_len) or die "无法读取数据。\n";
syswrite ($connection, "OK", 2);
my $buffer;
my $full_file = $dir;
if ($^O !~ /MSWin32/i) {
$full_file .= "/";
}
else {
$full_file .= "\\";
}
$full_file .= $file;
#
# 取得路径
#
my $full_dir;
if ($full_file =~ /(.+?)([\\\/]?[^\\\/]+)$/) {
$full_dir = $1;
}
if ((length ($full_dir) > 0) && ($full_dir ne '.' || $full_dir ne '..') && !-e $full_dir) {
mkpath ($full_dir) || next;
}
if (!open (THIS_FILE, "+>$full_file")) {
printf "无法打开文件 %s。\n", $full_file;
next;
}
binmode (THIS_FILE);
printf "接收来自机器 %s 的文件 %s ... \n", $client, $file;
#
# 下面读取文件的数据,当客户端完成传送一个文件时,会关掉连接,以此来判断一个文件是否传送完成。
#
my $data_len;
while ($data_len = sysread ($connection, $buffer, $buf_len)) {
syswrite ($connection, "OK", 2);
if (!defined (syswrite (THIS_FILE, $buffer, $data_len))) {
close (THIS_FILE);
next;
}
undef $buffer;
}
close (THIS_FILE);
$connection->shutdown (1);
return 0;
}