gosa-si/tests/sqlite-check-concurrency.pl

   1 #!/usr/bin/perl -W
   2
   3 package GOSA::DBsqlite;
   4 use strict;
   5 use warnings;
   6
   7 use DBI;
   8 use Time::HiRes qw(usleep);
   9 use Fcntl ':flock';
  10 use threads;
  11
  12 my %threads;
  13 # Count of threads, if > 1 it corrupts the db
  14 my $count= 1;
  15 my $db_name= "./test.sqlite";
  16
  17 unlink $db_name;
  18 unlink $db_name.".si.lock";
  19
  20 for(my $i=0;$i<$count;$i++) {
  21         $threads{$i}= threads->create(\&check_database);
  22 }
  23
  24 foreach my $thread (threads->list()) {
  25         print $thread->tid()."\n";
  26 }
  27
  28 sub check_database {
  29         $threads{threads->self->tid()}= GOSA::DBsqlite->new($db_name);
  30         threads->yield();
  31         $threads{threads->self->tid()}->run_test("test");
  32
  33         return;
  34 }
  35
  36
  37 sub new {
  38     my $class = shift;
  39     my $db_name = shift;
  40
  41     my $lock = $db_name.".si.lock";
  42     # delete existing lock - instance should be running only once
  43     if(stat($lock)) {
  44         print STDERR "DEBUG: Removed existing lock file $lock.";
  45         unlink($lock);
  46     }
  47     my $self = {dbh=>undef,db_name=>undef,db_lock=>undef,db_lock_handle=>undef};
  48     my $dbh = DBI->connect("dbi:SQLite:dbname=$db_name", "", "", {RaiseError => 0, AutoCommit => 0});
  49     $self->{dbh} = $dbh;
  50     $self->{db_name} = $db_name;
  51     $self->{db_lock} = $lock;
  52     bless($self,$class);
  53     return($self);
  54 }
  55
  56 sub lock {
  57     my $self = shift;
  58     open($self->{db_lock_handle}, ">>".($self->{db_lock})) unless ref $self->{db_lock_handle};
  59     flock($self->{db_lock_handle},LOCK_EX);
  60     seek($self->{db_lock_handle}, 0, 2);
  61 }
  62
  63
  64 sub unlock {
  65     my $self = shift;
  66     flock($self->{db_lock_handle},LOCK_UN);
  67 }
  68
  69 sub run_test {
  70         my $self= shift;
  71         my $table_name= shift;
  72         my $sql= "CREATE TABLE IF NOT EXISTS $table_name (id INTEGER, value VARCHAR(255))";
  73         $self->lock();
  74     $self->{dbh}->do($sql);
  75         $self->unlock();
  76
  77         for(my $i=0;$i<10000;$i++) {
  78        $sql= "INSERT INTO $table_name VALUES ($i, 'test $i')";
  79            $self->lock();
  80            $self->{dbh}->do($sql);
  81            $self->unlock();
  82         }
  83 }