#! 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:memdb?mode=memory&cache=shared',
    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 thread {
    my $tid = threads->tid;
    my( $Q ) = @_;
    $Q->dq; ## Wait for DB

    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;

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 %100 or $dbh->commit
}
$ins->finish;
$dbh->commit;
#$dbh->do( INDEX  ) or die DBI::errstr;

my $sth = $dbh->prepare( QUERY ) or die DBI->errstr;
for my $id ( 1 .. 5 ) {
    $sth->execute( $id ) or die DBI::errstr;
    my $r = $sth->fetch() or warn( "No data for $id" ) and next;
    ## do something with record.
    printf "[main] %5u %s %s %s %s %s %s %s %s %s\n", @{ $r };
}
$sth->finish;

print $dbh->selectrow_array( 'SELECT count(*) from DB' );

my $Q = threads::Q->new( 10 );
my @threads = map threads->create( \&thread, $Q, shared_clone( $dbh ) ), 1 .. $T;
$Q->nq( ('Wakey wakey') x $T );
$Q->nq( $_ ) for 1 .. 20; ## $N;
$Q->nq( (undef) x $T );
$_->join for @threads;
$dbh->disconnect;

unlink 'file'; ## without this, the memory db will persist in a apparently empty file????
## That might be turned into an advantage????