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';