my @threads = map threads->create( \&thread, $Q, shared_clone( $dbh ) ), 1 .. $T;
#............................................^1, ^^^^^^^^^ 2 ^^^^^^^^
####
sub thread {
my $tid = threads->tid;
my( $Q ) = @_;
####
#! perl -slw
use strict;
use threads;
use threads::shared;
use threads::Q;
use Time::HiRes qw[ time ];
use DBI;
use constant {
CONNECT=> 'dbi:SQLite:dbname=file:memdb2?mode=memory&cache=shared',
# CONNECT=> 'dbi:SQLite:dbname=mydb',
CREATE => 'create table if not exists DB ( ID integer(8),'
. join(',', map "F$_ text(15)", 1..9) . ')',
INSERT => 'insert into DB ( ID , '
. join( ',', map "F$_", 1..9 ) . ') values (' . '?,' x 9 . '?)',
INDEX => 'create index if not exists I1 on DB ( ID )',
QUERY => 'select * from DB where ID = ?',
};
sub timeit (&@) {
my $code = shift;
my $start = time;
$code->();
sprintf "Took %f seconds %s\n", time()-$start, @_ ? "(for @_)" : '';
}
sub thread {
my $tid = threads->tid;
my( $Q ) = @_;
my $dbh = DBI->connect( CONNECT, '', '' ) or die DBI::errstr;
my $sth = $dbh->prepare( QUERY ) or die DBI->errstr;
while( my $id = $Q->dq ) {
$sth->execute( $id ) or die DBI::errstr;
my $r = $sth->fetch or warn( "No data for $id" ) and next;
## do something with record.
printf "[$tid] %5u %s %s %s %s %s %s %s %s %s\n", @{ $r };
}
$sth->finish;
$dbh->disconnect;
}
my @chars = ( 'a'..'z' );
sub dummy {
my $n = shift;
join '', @chars[ map int( rand @chars ), 1 .. $n ];
}
our $T //= 4;
our $N //= 100;
my $dbh = DBI->connect( CONNECT, '', '', { AutoCommit =>0 } ) or die DBI::errstr;
$dbh->do( 'PRAGMA synchronous = off' );
$dbh->do( 'PRAGMA cache_size = 800000' );
$dbh->do( CREATE ) or die DBI::errstr;
print timeit {
my $ins = $dbh->prepare( INSERT ) or die DBI->errstr;
for my $n ( 1 .. $N ) {
my @fields = ( $n, map dummy( 15 ), 1 .. 9 );
$ins->execute( @fields )or die $ins->errstr;
# $n % 10 or $dbh->commit
}
$ins->finish;
$dbh->commit;
} "Populate DB with $N records";
print timeit {
$dbh->do( INDEX ) or die DBI::errstr;
} "Create primary index";
print timeit {
my $sth = $dbh->prepare( QUERY ) or die DBI->errstr;
for my $id ( 1 .. $N ) {
$sth->execute( $id ) or die DBI::errstr;
my $r = $sth->fetch() or warn( "No data for $id" ) and next;
## do something with record.
}
$sth->finish;
} "Retrieve the whole lot";
print $dbh->selectrow_array( 'SELECT count(*) from DB' );
$dbh->disconnect;
my $Q = threads::Q->new( 10 );
my @threads = map threads->create( \&thread, $Q ), 1 .. $T;
$Q->nq( $_ ) for 1 .. $N;
$Q->nq( (undef) x $T );
$_->join for @threads;
$dbh->disconnect;
unlink 'file';