tcl/test/test1.tcl

#!/opt/openisis/tcl/bin/isish
#
#       openisis - an open implementation of the ISIS database
#       Version 0.8.x (microversion see file Version)
#       Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
#
#       This library is free software; you can redistribute it and/or
#       modify it under the terms of the GNU Lesser General Public
#       License as published by the Free Software Foundation; either
#       version 2.1 of the License, or (at your option) any later version.
#
#       This library is distributed in the hope that it will be useful,
#       but WITHOUT ANY WARRANTY; without even the implied warranty of
#       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#       Lesser General Public License for more details.
#
#       You should have received a copy of the GNU Lesser General Public
#       License along with this library; if not, write to the Free Software
#       Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#       This software is dedicated to the memory of Eckart Dietrich.
#
#       This software is inspired by (but contains no code of) the iAPI
#       Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
#       See iAPI.txt for what it contains.
#
#       $Id: test1.tcl,v 1.21 2003/05/29 18:06:32 kripke Exp $
#       test script for (re)opening db, maxrow, read, query requests to
#       cds demo db

proc putt msg {
        global prnout
        if $prnout {
                puts $msg
        }
}

proc prnres {msg stb {ex 1}} {
        if [$stb .res] {
                set res [$stb .res get sid ser error error2]
                set tms ""
                set dta ""
                catch { set tms [$stb .res get tms] }
                catch { set dta [$stb .res get rec] }
                set err [lindex $res 2]
                set err2 [lindex $res 3]
                if {$ex && ($err || $err2)} {
                        puts "ERR \[$stb/[lindex $res 0]] $msg:\
                                ser [lindex $res 1],\
                                err $err/$err2,\
                                tms $tms,\
                                dta $dta"
                        exit 1
                }
                putt "\[$stb/[lindex $res 0]] $msg:\
                        ser [lindex $res 1],\
                        err $err/$err2,\
                        tms $tms,\
                        dta $dta"
        } else {
                puts "\[$stb] $msg: no response available"
                exit 1
        }
}

proc maxrow {stb db wrn} {
        $stb .req delete
        $stb req type maxrow db $db
        prnres "maxrow $db" $stb $wrn
        set row 0
        if [catch {
                set row [$stb .res get rowid]
        }] {
                if $wrn {
                        global errorInfo
                        putt $errorInfo
                }
        } {
                putt "maxrow = $row"
        }
        if {$wrn && 154 != $row && 151 != $row} {
                puts "ERR maxrow = $row"
                exit 1
        }
        return $row
}

set nn 3
set mm 1
set prnout 0
if {$argc} {
        set nn [lindex $argv 0]
        if {1 < $argc} {
                set mm [lindex $argv 1]
                if {2 < $argc} {
                        set prnout [lindex $argv 2]
                }
        }
}

for {set n $nn} {0 != $n} {incr n -1} {
        set stb0 [openIsis]
        putt "$stb0 created."

        switch [expr $n % 3] {
        0 {
                $stb0 add \
                        syspath /opt/openisis/db \
                        dbpath cds \
                        defaultdb cds
        }
        1 {
                $stb0 add \
                        dbpath /opt/openisis/db/cds
        }
        }

        set flds [ $stb0 get ]
        putt "$stb0 fields = $flds"

        if [catch {
                set stb1 [$stb0 new schema nonno -host tonno -port 2929]
                putt $stb1
                $stb1 done
                if [catch $stb1] {
                        putt "$stb1 done"
                } {
                        puts "ERROR: $stb1 still alive"
                        exit 1
                }
        }] {
                global errorInfo
                putt $errorInfo
        }
        set stb1 ""

        set dbn cds
        $stb0 .req set type open
        switch [expr $n % 3] {
        0 {
                $stb0 req 
        }
        1 {
                $stb0 req db $dbn
        }
        2 {
                set dbn /opt/openisis/db/cds/
                for {set k 0} {75 > $k} {incr k} { # PATH_MAX >= 1024 ?
                        set dbn "$dbn../../db/cds/"
                }
                set dbn "${dbn}cds"
                $stb0 req db $dbn
        }
        }
        prnres "open cds" $stb0

        maxrow $stb0 cds 1

        $stb0 .req delete
        $stb0 req type close db cds
        prnres "close cds" $stb0

        maxrow $stb0 cds 0

        $stb0 .req delete
        $stb0 req type open db $dbn
        prnres "open cds" $stb0

        maxrow $stb0 cds 1

        $stb0 .req delete
        $stb0 req type close db cds
        prnres "close cds" $stb0

        $stb0 .req delete
        $stb0 req type open db $dbn
        prnres "open cds" $stb0

        for {set m $mm} {0 != $m} {incr m -1} {

                set row [maxrow $stb0 cds 1]

                for {set j 1} {$j <= $row} {incr j} {
                        $stb0 .req delete
                        $stb0 req type read db cds rowid $j
                        set ttl ""
                        catch { set ttl [$stb0 .res .rec get 24] }
                        if {60 < [string length $ttl]} {
                                set ttl "[string range $ttl 0 57] ..."
                        }
                        putt "row [$stb0 .res get "rowid $j"] $ttl"
                }

                for {set k 0} {2 > $k} {incr k} {
                        $stb0 .req delete
                        if $k {
                                $stb0 .req set flags 2
                        }
                        $stb0 req typ query db cds key Africa\$ mode 2
                        prnres "query cds" $stb0
                        set numr [$stb0 .res get size]
                        for {set j 0} {$j < $numr} {incr j} {
                                set ttl ""
                                catch { set ttl [$stb0 .res .rec\[$j\] get 24] }
                                if {60 < [string length $ttl]} {
                                        set ttl "[string range $ttl 0 57] ..."
                                }
                                putt "rec $j [$stb0 .res get rowid\[$j\]] $ttl"
                        }
                }

                # set flds [ $stb0 .res get ]
                # puts $flds

                if {! $prnout && 0 == [expr $m % 50]} {
                        puts "$n $m ..."
                }

        } ;# for m

        $stb0 .req delete
        $stb0 req type close db cds
        prnres "close cds" $stb0

        $stb0 dele
        putt "$stb0 deleted."

        if {! $prnout && 0 == [expr $n % 50]} {
                puts "$n ..."
        }

} ;# for n

puts "ok."

1	#!/opt/openisis/tcl/bin/isish
2	#
3	# openisis - an open implementation of the ISIS database
4	# Version 0.8.x (microversion see file Version)
5	# Copyright (C) 2003 by Erik Grziwotz, erik@openisis.org
6	#
7	# This library is free software; you can redistribute it and/or
8	# modify it under the terms of the GNU Lesser General Public
9	# License as published by the Free Software Foundation; either
10	# version 2.1 of the License, or (at your option) any later version.
11	#
12	# This library is distributed in the hope that it will be useful,
13	# but WITHOUT ANY WARRANTY; without even the implied warranty of
14	# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15	# Lesser General Public License for more details.
16	#
17	# You should have received a copy of the GNU Lesser General Public
18	# License along with this library; if not, write to the Free Software
19	# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
20	#
21	# This software is dedicated to the memory of Eckart Dietrich.
22	#
23	# This software is inspired by (but contains no code of) the iAPI
24	# Copyright (C) 2000 by Robert Janusz, rj@jezuici.krakow.pl.
25	# See iAPI.txt for what it contains.
26	#
27	# $Id: test1.tcl,v 1.21 2003/05/29 18:06:32 kripke Exp $
28	# test script for (re)opening db, maxrow, read, query requests to
29	# cds demo db
30
31	proc putt msg {
32	global prnout
33	if $prnout {
34	puts $msg
35	}
36	}
37
38	proc prnres {msg stb {ex 1}} {
39	if [$stb .res] {
40	set res [$stb .res get sid ser error error2]
41	set tms ""
42	set dta ""
43	catch { set tms [$stb .res get tms] }
44	catch { set dta [$stb .res get rec] }
45	set err [lindex $res 2]
46	set err2 [lindex $res 3]
47	if {$ex && ($err \|\| $err2)} {
48	puts "ERR \[$stb/[lindex $res 0]] $msg:\
49	ser [lindex $res 1],\
50	err $err/$err2,\
51	tms $tms,\
52	dta $dta"
53	exit 1
54	}
55	putt "\[$stb/[lindex $res 0]] $msg:\
56	ser [lindex $res 1],\
57	err $err/$err2,\
58	tms $tms,\
59	dta $dta"
60	} else {
61	puts "\[$stb] $msg: no response available"
62	exit 1
63	}
64	}
65
66	proc maxrow {stb db wrn} {
67	$stb .req delete
68	$stb req type maxrow db $db
69	prnres "maxrow $db" $stb $wrn
70	set row 0
71	if [catch {
72	set row [$stb .res get rowid]
73	}] {
74	if $wrn {
75	global errorInfo
76	putt $errorInfo
77	}
78	} {
79	putt "maxrow = $row"
80	}
81	if {$wrn && 154 != $row && 151 != $row} {
82	puts "ERR maxrow = $row"
83	exit 1
84	}
85	return $row
86	}
87
88	set nn 3
89	set mm 1
90	set prnout 0
91	if {$argc} {
92	set nn [lindex $argv 0]
93	if {1 < $argc} {
94	set mm [lindex $argv 1]
95	if {2 < $argc} {
96	set prnout [lindex $argv 2]
97	}
98	}
99	}
100
101	for {set n $nn} {0 != $n} {incr n -1} {
102	set stb0 [openIsis]
103	putt "$stb0 created."
104
105	switch [expr $n % 3] {
106	0 {
107	$stb0 add \
108	syspath /opt/openisis/db \
109	dbpath cds \
110	defaultdb cds
111	}
112	1 {
113	$stb0 add \
114	dbpath /opt/openisis/db/cds
115	}
116	}
117
118	set flds [ $stb0 get ]
119	putt "$stb0 fields = $flds"
120
121	if [catch {
122	set stb1 [$stb0 new schema nonno -host tonno -port 2929]
123	putt $stb1
124	$stb1 done
125	if [catch $stb1] {
126	putt "$stb1 done"
127	} {
128	puts "ERROR: $stb1 still alive"
129	exit 1
130	}
131	}] {
132	global errorInfo
133	putt $errorInfo
134	}
135	set stb1 ""
136
137	set dbn cds
138	$stb0 .req set type open
139	switch [expr $n % 3] {
140	0 {
141	$stb0 req
142	}
143	1 {
144	$stb0 req db $dbn
145	}
146	2 {
147	set dbn /opt/openisis/db/cds/
148	for {set k 0} {75 > $k} {incr k} { # PATH_MAX >= 1024 ?
149	set dbn "$dbn../../db/cds/"
150	}
151	set dbn "${dbn}cds"
152	$stb0 req db $dbn
153	}
154	}
155	prnres "open cds" $stb0
156
157	maxrow $stb0 cds 1
158
159	$stb0 .req delete
160	$stb0 req type close db cds
161	prnres "close cds" $stb0
162
163	maxrow $stb0 cds 0
164
165	$stb0 .req delete
166	$stb0 req type open db $dbn
167	prnres "open cds" $stb0
168
169	maxrow $stb0 cds 1
170
171	$stb0 .req delete
172	$stb0 req type close db cds
173	prnres "close cds" $stb0
174
175	$stb0 .req delete
176	$stb0 req type open db $dbn
177	prnres "open cds" $stb0
178
179	for {set m $mm} {0 != $m} {incr m -1} {
180
181	set row [maxrow $stb0 cds 1]
182
183	for {set j 1} {$j <= $row} {incr j} {
184	$stb0 .req delete
185	$stb0 req type read db cds rowid $j
186	set ttl ""
187	catch { set ttl [$stb0 .res .rec get 24] }
188	if {60 < [string length $ttl]} {
189	set ttl "[string range $ttl 0 57] ..."
190	}
191	putt "row [$stb0 .res get "rowid $j"] $ttl"
192	}
193
194	for {set k 0} {2 > $k} {incr k} {
195	$stb0 .req delete
196	if $k {
197	$stb0 .req set flags 2
198	}
199	$stb0 req typ query db cds key Africa\$ mode 2
200	prnres "query cds" $stb0
201	set numr [$stb0 .res get size]
202	for {set j 0} {$j < $numr} {incr j} {
203	set ttl ""
204	catch { set ttl [$stb0 .res .rec\[$j\] get 24] }
205	if {60 < [string length $ttl]} {
206	set ttl "[string range $ttl 0 57] ..."
207	}
208	putt "rec $j [$stb0 .res get rowid\[$j\]] $ttl"
209	}
210	}
211
212	# set flds [ $stb0 .res get ]
213	# puts $flds
214
215	if {! $prnout && 0 == [expr $m % 50]} {
216	puts "$n $m ..."
217	}
218
219	} ;# for m
220
221	$stb0 .req delete
222	$stb0 req type close db cds
223	prnres "close cds" $stb0
224
225	$stb0 dele
226	putt "$stb0 deleted."
227
228	if {! $prnout && 0 == [expr $n % 50]} {
229	puts "$n ..."
230	}
231
232	} ;# for n
233
234	puts "ok."
235