Subject: | unlimited memory accumulation |
As data is INSERTed, memory usage grows without limit. Using "pragma
cache_size" seems to have no effect. Attaching smallish self-contained
program to reproduce. Not certain problem is in DBD::SQLite module,
could be in SQLite itself, or Perl, but seems unlikely. Noticed in 1.12,
upgraded to 1.14, still happens.
To reproduce, run program BugReport.pl without arguments; observe memory
used grows without apparent limit (e.g., use 'ps' command).
uname -a output:
Linux lux8 2.4.21-50.ELsmp #1 SMP Tue May 8 17:18:29 EDT 2007 i686 i686
i386 GNU/Linux
Perl version, etc. (via Module::Versions::Report):
Perl v5.8.8 under linux
Modules in memory:
attributes;
AutoLoader v5.60;
Carp v1.04;
Config;
DBD::_::common;
DBD::_::db;
DBD::_::dr;
DBD::_::st;
DBD::_mem::common;
DBD::_mem::db;
DBD::_mem::dr;
DBD::_mem::st;
DBD::SQLite v1.14;
DBD::SQLite::db;
DBD::SQLite::db_mem;
DBD::SQLite::dr;
DBD::SQLite::dr_mem;
DBD::SQLite::st;
DBD::SQLite::st_mem;
DBD::Switch::db;
DBD::Switch::db_mem;
DBD::Switch::dr;
DBD::Switch::dr_mem;
DBD::Switch::st;
DBD::Switch::st_mem;
DBI v1.51;
DBI::common;
DBI::db;
DBI::DBI_tie;
DBI::dr;
DBI::st;
DBI::var;
DynaLoader v1.05;
Exporter v5.58;
Exporter::Heavy v5.58;
Internals;
List::Util v1.18;
Module::Versions::Report v1.03;
PerlIO;
PerlIO::Layer;
Regexp;
Scalar::Util v1.18;
strict v1.03;
UNIVERSAL;
utf8;
vars v1.01;
warnings v1.05;
warnings::register v1.01;
XSLoader v0.06;
Subject: | BugReport.pl |
#!/usr/bin/env perl
use strict;
use warnings;
use Carp;
use DBI;
#use Module::Versions::Report;
sub stampedMsg {
#print $_[0], " ", `ps --no-headers -o time,size -p $$`;
print $_[0], " ", `date`;
}
# Default values for command line arguments.
my $maxItems = 1000000000;
#my $maxItems = 100;
my $dbFnameRoot = "tokenDB";
my ($tzr, $iDoc, $id_doc, $i, $ofst, $len, $tok);
my $id_lxm = 0; # used by declareMention
$tzr = createTokenDB($dbFnameRoot);
for ($iDoc = 1; $iDoc <= $maxItems; ++$iDoc) {
$id_doc = $iDoc;
$i = 1000;
while ($i) {
$ofst = 0;
$len = 0;
$tok = 'ab';
declareMention($tzr, "TERM", $tok, $id_doc, $ofst, $len);
--$i;
}
stampedMsg "Loaded Doc $iDoc," if $iDoc % 100 == 0;
}
closeTokenDB($tzr);
exit(0);
###############################################################################
sub createTokenDB {
my ($fNameRoot) = @_;
my $tzrState = {};
my $dbFname = $fNameRoot . ".SQLite";
my $dbh = createDB($dbFname);
dbCmd($dbh, "begin");
$tzrState->{"dbh"} = $dbh;
# nTransact < 0 signifies safe to issue "begin" statement.
$tzrState->{"nTransact"} = -1;
$tzrState->{"nTransactCommit"} = 10000;
my $type = 'TERM';
my $menTblName = "mentions_$type";
dbCmd($dbh, "create table $menTblName (id_mtn integer primary key,
id_lxm int, id_doc int, ofst int, len int)");
dbCmd($dbh, "commit");
return $tzrState;
}
sub closeTokenDB {
my ($tzrState) = @_;
my $dbh = $tzrState->{"dbh"};
if($tzrState->{"nTransact"} >= 0) {dbCmd($tzrState->{"dbh"}, "commit");}
$tzrState->{"dbh"}->disconnect;
}
sub declareMention {
my ($tzrState, $type, $nm, $id_doc, $ofst, $len) = @_;
my $dbh = $tzrState->{"dbh"};
if($tzrState->{"nTransact"} < 0) {
dbCmd0($dbh, "begin");
$tzrState->{"nTransact"} = 0;
}
if(++$tzrState->{"nTransact"} > $tzrState->{"nTransactCommit"}) {
dbCmd($dbh, "commit"); $tzrState->{"nTransact"} = -1;
}
$id_lxm++;
dbCmd0($dbh, "insert into mentions_". $type ."(id_doc,id_lxm,ofst,len) ".
"values($id_doc, $id_lxm, $ofst, $len)");
}
###############################################################################
# Open DB (deleting old file if any). Set pragmas for speed.
sub createDB {
my ($dbName) = @_;
if(-e($dbName)) {print("Deleting $dbName\n");}
if(-e($dbName)) {unlink $dbName;}
if(-e($dbName ."-journal")) {unlink($dbName ."-journal");}
print("Creating $dbName\n");
my $dbh = DBI->connect("dbi:SQLite:dbname=$dbName", '', '');
confess "Failed to create to DB '$dbName'" unless $dbh;
$dbh->{RaiseError} = 1;
print("Created $dbName\n");
# Performance enhancements:
dbCmd($dbh, "pragma synchronous=OFF");
# This should make the process size about 150M. Default was 2K==> 3M.
#dbCmd($dbh, "pragma cache_size=100000");
return $dbh;
}
# Print SQL command and execute it.
sub dbCmd {
my ($dbh, $cmd) = @_;
print($cmd, "\n");
my $sth = $dbh->prepare($cmd);
$sth->execute;
return;
}
# Execute SQL command without printing it.
sub dbCmd0 {
my ($dbh, $cmd) = @_;
my $sth = $dbh->prepare($cmd);
$sth->execute;
return;
}
###############################################################################