Bug#337792: Memory leak in Debbugs::MIME::parse
Package: debbugs
Version: 2.4.1
Severity: normal
There's a memory leak in Debbugs::MIME::parse() as you can see by
running the attached script for a while.
6536 tbm 24 0 9344 6696 4056 R 46.8 1.7 0:26.79 test-mem-leak.p
6536 tbm 24 0 50116 46m 4056 R 42.6 12.3 10:20.87 test-mem-leak.p
Tested with CVS as the end of ~2003 and with current CVS.
-- System Information:
Debian Release: testing/unstable
APT prefers unstable
APT policy: (500, 'unstable')
Architecture: i386 (i686)
Shell: /bin/sh linked to /bin/bash
Kernel: Linux 2.6.12-1-686
Locale: LANG=en_US.UTF-8, LC_CTYPE=en_US.UTF-8 (charmap=UTF-8)
--
Martin Michlmayr
http://www.cyrius.com/
#!/usr/bin/perl -w
use strict;
use Debbugs::Log;
use Debbugs::MIME;
my $spool = "/org/bugs.debian.org/spool";
sub read_log($) {
my $log_filename = shift;
open LOG, "< $log_filename" or die "Can't open $log_filename: $!";
my @records = Debbugs::Log::read_log_records(*LOG);
close LOG;
for my $record (@records) {
if ($record->{type} eq "incoming-recv") {
my $decoded = Debbugs::MIME::parse($record->{text});
}
}
}
sub process_dir($) {
my $db = shift;
opendir DB, $db or die "Can't opendir $db: $!";
while (defined(my $dir = readdir DB)) {
next if $dir =~ /^\.\.?$/ or not -d "$db/$dir";
opendir HASH, "$db/$dir" or die "Can't opendir $db/$dir: $!";
print "Processing dir $dir ...\n";
while (defined(my $file = readdir HASH)) {
next unless $file =~ /\.log$/;
my $bug = $file;
$bug =~ s/\.log$//;
my $log = "$db/$dir/$file";
next if -z $log;
read_log($log);
}
closedir HASH;
}
closedir DB;
}
for my $db ("archive", "db-h") {
process_dir("$spool/$db");
}
# vim: ts=4:expandtab:shiftwidth=4:
Reply to: