Re: DBI и threads

From

Peter B. Shalimoff (2:5020/400)

To

Maxim Yemelyanov (2:5054/37.63)

Date

2005-05-18T17:20:38Z

Area

RU.PERL

From: "Peter B. Shalimoff" <vshalim@home.ru>

Maxim Yemelyanov wrote:
> Еще можно написать письмо авторам DBD::mysql с соответствующей просьбой
> (добавить CLONE). Я так сделал для DBD::InterBase.

Обновил с CVS-a. По-прежнему не работает. Что я делаю не так?

X:\MYDOCS\Perl>perl -version

This is perl, v5.8.4 built for MSWin32-x86-multi-thread
(with 3 registered patches, see perl -V for more detail)

Copyright 1987-2004, Larry Wall

Binary build 810 provided by ActiveState Corp.
http://www.ActiveState.com
ActiveState is a division of Sophos.
Built Jun  1 2004 11:52:21


=== ib_thread_test.pl ===
use strict;
use warnings;

use DBI;
use threads;

my $g_dbh;

sub getDSN() {
  return <<DSN
dbi:InterBase:database=D:\\TEMP\\test.gdb;
host=localhost;
ib_dialect=3;
DSN
}

sub getUsername() { return "sysdba"; }
sub getPassword() { return "masterkey"; }

sub getDBConnection() {
  if ( defined($g_dbh) ) {
    printf("getDBConnection: returning existing connection\n");
    return $g_dbh;
  }
  my %attrs = (PrintError => 0, RaiseError => 1, AutoCommit => 0,
    ib_timestampformat => "%d.%m.%Y %H:%M",
    ib_dateformat => "%d.%m.%Y",
    ib_timeformat => "%H:%M"
  );
  $g_dbh = DBI->connect(getDSN(), getUsername(), getPassword(),
\%attrs);
}

sub thread_func {
  printf("thread_func: getting DB connection\n");
  my ($dbh, $sth);
  eval {
    $dbh = getDBConnection();
    $sth = $dbh->prepare("select count(*) from Q"); // line 38
  };
  if ( $@ ) {
    printf("Fuck: %s\n", $@);
  }
  if ( defined($sth) ) {
    $sth->finish();
  }
  printf("thread_func: we're OUT\n");
}

sub main() {
  my $dbh = getDBConnection();
  my $sth = $dbh->prepare("select count(*) from Q");
  $sth->finish();

  my $t = threads->create(\&thread_func);
  $t->join();
  
  printf("main: we're OUT\n");
}

main();


Выхлоп:

X:\MYDOCS\Perl>ib_thread_test.pl
thread_func: getting DB connection
getDBConnection: returning existing connection
Fuck: DBD::InterBase::db prepare failed: handle 2 is owned by thread
15d4a34 not current thread 1c1f2a4 (handles can't be shared between
threads and your driver may need a CLONE method added) at
X:\MYDOCS\Perl\ib_thread_test.pl line 38.

thread_func: we're OUT
main: we're OUT

-- 
0xdeadbeef


--- ifmail v.2.15dev5.3
 * Origin: Sweet Home (2:5020/400)
SEEN-BY: 50/203 520 400/462 450/159 186 208 451/30 452/25 100 454/9 455/15
SEEN-BY: 461/33 43 74 106 132 640 464/34 465/204 467/24 469/125 200 999 478/44
SEEN-BY: 478/65 550/5068 4600/126 4614/9 4616/3 4623/56 4625/8 9 4626/100
SEEN-BY: 4627/10 4632/10 4635/4 99 1024 4641/444 4642/27 48 4657/50 5000/76
SEEN-BY: 5001/50 5001 5002/76 5002 5003/34 5006/1 5007/1 5010/53 70 146
SEEN-BY: 5011/13 5012/8 5015/4 28 214 5019/5 5020/52 115 118 128 133 150 154
SEEN-BY: 5020/175 194 400 486 545 549 600 642 715 744 758 794 830 921 958 968
SEEN-BY: 5020/982 1057 1100 1169 1212 1234 1523 1604 1626 1642 1653 1665 1826
SEEN-BY: 5020/1829 1922 1930 2013 2020 2044 2142 2200 2238 2345 2590 2908 4400
SEEN-BY: 5020/4441 5021/2 3 5022/128 5023/11 5024/1 73 5025/19 750 5026/14 49
SEEN-BY: 5030/49 69 195 382 436 556 611 920 966 1016 1039 1063 1339 1520 1688
SEEN-BY: 5030/1900 5031/7 47 63 70 5032/11 20 5033/21 35 5034/8 5035/3 38 63
SEEN-BY: 5036/1 13 5037/21 36 5038/4 5040/33 47 5041/4 5042/13 5045/7 42
SEEN-BY: 5047/47 5049/1 6 157 5050/9 41 5051/15 35 5053/16 38 5054/1 8 9 35 36
SEEN-BY: 5054/37 45 50 66 67 81 85 5055/177 5056/16 5057/1 5058/77 5059/2 9 20
SEEN-BY: 5060/88 90 5061/15 5062/1 4 7 5063/51 5064/7 35 39 5066/18 5070/26 66
SEEN-BY: 5070/1222 5071/22 5075/5 37 5077/70 80 5079/23 49 5080/80 1003 5081/2
SEEN-BY: 5082/6 5083/13 21 5090/23 105 108 113 5093/4 27 33 5096/18 5100/113
SEEN-BY: 6001/3 6023/1 6033/2727 6035/9 6070/5 6083/11

PATH: 5020/400 4441 52 5054/1 37