#!perl -w # $Id: thread.t,v 1.5 2005/10/01 13:05:13 mpeppler Exp $ # Test support for threads in DBD::Sybase. use strict; use Config qw(%Config); BEGIN { if (!$Config{useithreads} || $] < 5.008) { print "1..0 # Skipped: this perl $] not configured to support iThreads\n"; exit 0; } } use threads; use DBI; use DBD::Sybase; # REQUIRED!!! BEGIN { if (!DBD::Sybase::thread_enabled()) { print "1..0 # Skipped: this DBD::Sybase not configured to support iThreads\n"; exit 0; } } use Test::More tests => 10; use Thread::Queue; use lib 't'; use _test; use vars qw($Pwd $Uid $Srv $Db); ($Uid, $Pwd, $Srv, $Db) = _test::get_info(); my $database = getDatabase(); print "Using database $database\n"; my $queue = Thread::Queue->new; my $rdr = threads->create(\&reader, $queue, $database); my @thr; foreach (1 .. 3) { push(@thr, threads->create(\&test_it, $queue, $database)); } my $count = $rdr->join; my $total = 0; foreach (@thr) { $total += $_->join; } is($count, $total); sub reader { my $queue = shift; my $db = shift; my $dbh = getDbh($db); ok(defined($dbh)); my $sth = $dbh->prepare("select id from sysobjects"); ok(defined($sth)); my $rc = $sth->execute; ok($rc); my $count = 0; while(my $row = $sth->fetch) { $queue->enqueue($row->[0]); ++$count; } return $count; } sub test_it { my $queue = shift; my $db = shift; my $dbh = getDbh($db); ok(defined($dbh)); my $sth = $dbh->prepare("select name, crdate, instrig, deltrig, type, uid, sysstat, updtrig from sysobjects where id = ?"); ok(defined($sth)); my $count = 0; my $rc; my $tid = threads->tid(); while(1) { my $id = $queue->dequeue_nb; last unless(defined($id)); $rc = $sth->execute($id); # ok($rc); while(my $row = $sth->fetch) { print "$tid - fetched($id) == $row->[0]\n"; ++$count; } } return $count; } sub getDbh { my $dbname = shift || 'master'; my $dbh = DBI->connect("dbi:Sybase:server=$Srv;database=$dbname;timeout=60;loginTimeout=20", $Uid, $Pwd, {PrintError => 1}); if(!$dbh) { warn "No connection - did you set the user, password and server name correctly in PWD?\n"; for (4 .. 10) { ok(0); } exit(0); } return $dbh; } sub getDatabase { my $dbh = getDbh(); my $sth = $dbh->prepare("select 1 from master..sysdatabases where name = 'sybsystemprocs'"); $sth->execute; my $database = 'master'; while(my $row = $sth->fetch) { $database = 'sybsystemprocs'; } return $database; }