File: thread.t

package info (click to toggle)
libdbd-sybase-perl 1.24-3
  • links: PTS
  • area: main
  • in suites: forky, sid, trixie
  • size: 712 kB
  • sloc: ansic: 5,629; perl: 2,216; makefile: 4
file content (127 lines) | stat: -rw-r--r-- 2,560 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
#!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:$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;
}