At 12:17 PM 9/18/00, Glenn Cole wrote:
>Jeff Woods writes:
>
> >The last several months I've been working on one of the BSD unix clones
> >(not my choice FWIW) writing an application in TCL.
>
>Tcl alone? Not with the Toolkit (Tk) extension?
Yes. Just TCL (with a couple of small extensions, like MPEXPR which
handles very long precision math). I haven't even bothered to read much of
the Tk sections of my TCL/Tk books. And the only C code we're using in
this application is some helper functions that do a few utility things we
can't do in C, in much the same way someone might write an SPL or Pascal or
C routine to call from COBOL on MPE.
> >If and when I get to work on MPE systems on a regular
> >basis again, I'm going to try to finish the port of TCL that Mark Bixby
> >started quite some time back. In the meanwhile, if you're looking for
> >something as quick, extensible and easy to write in as Perl but you prefer
> >COBOL, BASIC or Pascal over C then perhaps TCL would be worth your time to
> >have ported to MPE.
>
>That's why I ask the question above. While I know that Tcl can be used
>without the Tk extension (just as Java can be used without the Swing stuff),
>particularly as a macro-type language within a C program, I had not heard
>of non-Tk non-macro usage being common.
We're writing an application from scratch using something like 98% plain
vanilla TCL. It's command line and cron driven and automates the
production of the service business we have. TCL has proven to be
versatile, fast to code, reasonably fast to execute, and has provided very
high developer productivity on this project.
>If you find Tcl genuinely useful without Tk, then sure, the port would
>be interesting (and we look forward to your intro to it at a future
>HPWorld ;) .
Sounds like a great idea. :)
>I wonder if this is why Mark did not finish the port. That is, since
>Perl handles the non-GUI stuff well, and Tcl on MPE means no Tk, then
>why bother?
>
>This is not a rhetorical question, though I suppose the answer was the part
>I snipped from Jeff's original post, that Perl's (syntactic) complexity
>appears on the order of C or APL. In fact, for quite awhile, I referred to
>Perl as "APL with a standard keyboard." ;) Since then, I've come to
>grok the language a bit better, so it doesn't feel quite that way any
>longer. Still, as with C, the opportunity for obfuscation remains.
And that's the big advantage of TCL over Perl, IMO. TCL is (or at least
can be) very legible and doesn't do a lot of things that are terse but
obfuscated.
> >P.S. Someone mentioned the TK extension to Perl to do GUI stuff...
>
>That was me. :) There's a small O'Reilly book on it as well.
>
> >It's my understanding the TK was initially a TCL extension. In fact, many
> >references to TCL actually call it TCL/TK or simply TCLTK.
>
>That's my understanding as well, though I've seen the spelling written
>only as "Tcl/Tk."
I stand corrected. I don't use Tk enough to even be able to spell it
properly. ;)
Then at 12:32 PM 9/18/00, Mark Bixby replied:
>My need for Tcl was to be able to run the test suite for the Berkeley DB
>implementation from www.sleepycat.com.
>
>While the sleepycat tests seems to run OK with my version of Tcl, many of
>Tcl's
>own selftests fail. Since I myself don't know the Tcl language, I have no
>plans to debug these failures to make the port more complete.
As it happens the BerkeleyDB from SleepyCat is exactly the database that
we're using on this project as well. It's certainly not Image, but it's a
heck of a lot less complex than SQL. The combination of TCL calling BerkDB
routines for database access is what has made this project feasible to get
from initial design to initial production runs (with limited volumes of
data and a lot of fleshing out of features left to be done) in roughly
three months.
FWIW, the BerkDB system is written in C with APIs designed for C, C++, Java
and TCL. It's my understanding that Sleepycat Software uses TCL as the
language for their internal QA test suites.
BTW, TCL/Tk is available for most unixes (open source naturally), Windows
and the Macintosh. BerkeleyDB is available for most unixes (also open
source) and Windows.
>If Jeff W. wants to pick up Tcl where I left off, great, that's what open
>source is all about!
Love to.. if and when I'm back on MPE. Depends on time and availability,
of course.
P.S. For those of you who want to see what TCL calling BerkDB code really
looks like, here's one of the test scripts Sleepycat ships with BerkeleyDB
that's written in TCL:
-----------cut-here-----------------------------
# See the file LICENSE for redistribution information.
#
# Copyright (c) 1996, 1997, 1998, 1999, 2000
# Sleepycat Software. All rights reserved.
#
# $Id: sysscript.tcl,v 11.12 2000/05/22 12:51:38 bostic Exp $
#
# System integration test script.
# This script runs a single process that tests the full functionality of
# the system. The database under test contains nfiles files. Each process
# randomly generates a key and some data. Both keys and data are bimodally
# distributed between small keys (1-10 characters) and large keys (the avg
# length is indicated via the command line parameter.
# The process then decides on a replication factor between 1 and nfiles.
# It writes the key and data to that many files and tacks on the file ids
# of the files it writes to the data string. For example, let's say that
# I randomly generate the key dog and data cat. Then I pick a replication
# factor of 3. I pick 3 files from the set of n (say 1, 3, and 5). I then
# rewrite the data as 1:3:5:cat. I begin a transaction, add the key/data
# pair to each file and then commit. Notice that I may generate replication
# of the form 1:3:3:cat in which case I simply add a duplicate to file 3.
#
# Usage: sysscript dir nfiles key_avg data_avg
#
# dir: DB_HOME directory
# nfiles: number of files in the set
# key_avg: average big key size
# data_avg: average big data size
source ./include.tcl
source $test_path/test.tcl
source $test_path/testutils.tcl
set alphabet "abcdefghijklmnopqrstuvwxyz"
set mypid [pid]
set usage "sysscript dir nfiles key_avg data_avg method"
# Verify usage
if { $argc != 5 } {
puts stderr "FAIL:[timestamp] Usage: $usage"
exit
}
puts [concat "Argc: " $argc " Argv: " $argv]
# Initialize arguments
set dir [lindex $argv 0]
set nfiles [ lindex $argv 1 ]
set key_avg [ lindex $argv 2 ]
set data_avg [ lindex $argv 3 ]
set method [ lindex $argv 4 ]
# Initialize seed
global rand_init
berkdb srand $rand_init
puts "Beginning execution for $mypid"
puts "$dir DB_HOME"
puts "$nfiles files"
puts "$key_avg average key length"
puts "$data_avg average data length"
flush stdout
# Create local environment
set dbenv [berkdb env -txn -home $dir]
set err [catch {error_check_good $mypid:dbenv [is_substr $dbenv env] 1} ret]
if {$err != 0} {
puts $ret
return
}
# Now open the files
for { set i 0 } { $i < $nfiles } { incr i } {
set file test044.$i.db
set db($i) [berkdb open -env $dbenv $method $file]
set err [catch {error_check_bad $mypid:dbopen $db($i) NULL} ret]
if {$err != 0} {
puts $ret
return
}
set err [catch {error_check_bad $mypid:dbopen [is_substr $db($i) \
error] 1} ret]
if {$err != 0} {
puts $ret
return
}
}
set record_based [is_record_based $method]
while { 1 } {
# Decide if we're going to create a big key or a small key
# We give small keys a 70% chance.
if { [berkdb random_int 1 10] < 8 } {
set k [random_data 5 0 0 $record_based]
} else {
set k [random_data $key_avg 0 0 $record_based]
}
set data [chop_data $method [random_data $data_avg 0 0]]
set txn [$dbenv txn]
set err [catch {error_check_good $mypid:txn_begin [is_substr $txn \
$dbenv.txn] 1} ret]
if {$err != 0} {
puts $ret
return
}
# Open cursors
for { set f 0 } {$f < $nfiles} {incr f} {
set cursors($f) [$db($f) cursor -txn $txn]
set err [catch {error_check_good $mypid:cursor_open \
[is_substr $cursors($f) $db($f)] 1} ret]
if {$err != 0} {
puts $ret
return
}
}
set aborted 0
# Check to see if key is already in database
set found 0
for { set i 0 } { $i < $nfiles } { incr i } {
set r [$db($i) get -txn $txn $k]
set r [$db($i) get -txn $txn $k]
if { $r == "-1" } {
for {set f 0 } {$f < $nfiles} {incr f} {
set err [catch {error_check_good \
$mypid:cursor_close \
[$cursors($f) close] 0} ret]
if {$err != 0} {
puts $ret
return
}
}
set err [catch {error_check_good $mypid:txn_abort \
[$txn abort] 0} ret]
if {$err != 0} {
puts $ret
return
}
set aborted 1
set found 2
break
} elseif { $r != "Key $k not found." } {
set found 1
break
}
}
switch $found {
2 {
# Transaction aborted, no need to do anything.
}
0 {
# Key was not found, decide how much to replicate
# and then create a list of that many file IDs.
set repl [berkdb random_int 1 $nfiles]
set fset ""
for { set i 0 } { $i < $repl } {incr i} {
set f [berkdb random_int 0 [expr $nfiles - 1]]
lappend fset $f
set data [chop_data $method $f:$data]
}
foreach i $fset {
set r [$db($i) put -txn $txn $k $data]
if {$r == "-1"} {
for {set f 0 } {$f < $nfiles} {incr f} {
set err [catch {error_check_good \
$mypid:cursor_close \
[$cursors($f) close] 0} ret]
if {$err != 0} {
puts $ret
return
}
}
set err [catch {error_check_good \
$mypid:txn_abort [$txn abort] 0} ret]
if {$err != 0} {
puts $ret
return
}
set aborted 1
break
}
}
}
1 {
# Key was found. Make sure that all the data values
# look good.
set f [zero_list $nfiles]
set data $r
while { [set ndx [string first : $r]] != -1 } {
set fnum [string range $r 0 [expr $ndx - 1]]
if { [lindex $f $fnum] == 0 } {
#set flag -set
set full [record $cursors($fnum) get -set $k]
} else {
#set flag -next
set full [record $cursors($fnum) get -next]
}
if {[llength $full] == 0} {
for {set f 0 } {$f < $nfiles} {incr f} {
set err [catch {error_check_good \
$mypid:cursor_close \
[$cursors($f) close] 0} ret]
if {$err != 0} {
puts $ret
return
}
}
set err [catch {error_check_good \
$mypid:txn_abort [$txn abort] 0} ret]
if {$err != 0} {
puts $ret
return
}
set aborted 1
break
}
set err [catch {error_check_bad \
$mypid:curs_get($k,$data,$fnum,$flag) \
[string length $full] 0} ret]
if {$err != 0} {
puts $ret
return
}
set key [lindex [lindex $full 0] 0]
set rec [pad_data $method [lindex [lindex $full 0] 1]]
set err [catch {error_check_good \
$mypid:dbget_$fnum:key $key $k} ret]
if {$err != 0} {
puts $ret
return
}
set err [catch {error_check_good \
$mypid:dbget_$fnum:data($k) $rec $data} ret]
if {$err != 0} {
puts $ret
return
}
set f [lreplace $f $fnum $fnum 1]
incr ndx
set r [string range $r $ndx end]
}
}
}
if { $aborted == 0 } {
for {set f 0 } {$f < $nfiles} {incr f} {
set err [catch {error_check_good $mypid:cursor_close \
[$cursors($f) close] 0} ret]
if {$err != 0} {
puts $ret
return
}
}
set err [catch {error_check_good $mypid:commit [$txn commit] \
0} ret]
if {$err != 0} {
puts $ret
return
}
}
}
# Close files
for { set i 0 } { $i < $nfiles} { incr i } {
set r [$db($i) close]
set err [catch {error_check_good $mypid:db_close:$i $r 0} ret]
if {$err != 0} {
puts $ret
return
}
}
# Close tm and environment
$dbenv close
puts "[timestamp] [pid] Complete"
flush stdout
filecheck $file 0
-----------cut-here-----------------------------
--
Jeff Woods
"The great thing about Open Source software is that you can
have any color screen of death that you want." -- Gavin Scott
__________________________________________________
Do You Yahoo!?
Talk to your friends online with Yahoo! Messenger.
http://im.yahoo.com
|
