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	dpavlin	237	#!/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