# dbstress: A program to stress test the database engine 'Bbuuzzb'.
# Program picks a random number which represents a command type and
# then executes that command. Program is an infinite loop and will
# have to be killed to terminate. Command numbers are taken from
# 'dbcomm.tcl'. Rick Smereka, Copyright (C) 2006.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program 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 General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# You can contact the author via email at rsmereka@future-lab.com

# This program will not process all commands as some are just too dangerous. 
# The following commands will be ignored:

#    DBCOM_SET_POS               set file position
#    DBCOM_CONFIG_SET_TMP_PATH   set config path for temporary files
#    DBCOM_CONFIG_SET_LOG        set config error log file
#    DBCOM_CONFIG_SET_SESSION    set config session table (multi only)
#    DBCOM_CONFIG_SET_CATALOG    set config catalog table (multi only)

# When these commands are chosen, an 'unknown command' message will
# appear in the output log. Aug/99, Rick Smereka
   
# In addition, the following commands:
   
#    DBCOM_CONFIG_SET_LOG_FLAG
#    DBCOM_CONFIG_SET_SESSION_FLAG
#    DBCOM_CONFIG_SET_CATALOG_FLAG

# are assumed to be already set on the database server prior to running this
# program and the values will not be changed during the course of this
# program run.

# Program syntax:

#    dbstress|dbstresm [-p primary_table] [-a alternate_table] [-l log_file]
   
# Where '-p primary_table' is the optional name of the Bbuuzzb primary
# table to use, '-a alternate_table' is the alternate table and
# '-l log_file' is the log file to use. Any of these three items
# will default to their defined values if not present on the command
# line. Note that the switch character ('-') is based on the platform
# (see include file 'stdhead.tcl').
   
# The program will use system catalog to resolve the primary and alternate
# table names. The system catalog is always on by default in the
# client/server version and will be turned on in the single user version
# if a catalog has been specified in the 'catalog' entry of the database
# configuration file. This program will use the following logical table
# names:

#    test.primary
#    test.alternate

# When supplying table names on the command line, use logical names
# if the server catalog is operational.
 
# Initial tcl version. May/2006, Rick Smereka

# required path to library modules
set TCLDIR /home/rick/gpl/tcl

source $TCLDIR/lib/stdhead.tcl
source $TCLDIR/lib/comcode.tcl
source $TCLDIR/lib/appinit.tcl
const MULTIUSER 0
source $TCLDIR/dbeng/dbmess.tcl
source $TCLDIR/dbeng/dbiocode.tcl
source $TCLDIR/dbeng/dbeng.tcl
source $TCLDIR/dbeng/dbengcfg.tcl
source $TCLDIR/dbeng/dbengcat.tcl
source $TCLDIR/dbeng/dbfxp.tcl
source $TCLDIR/dbeng/dbengsrt.tcl
source $TCLDIR/dbeng/dbcomm.tcl

const VERSION "1.49.02-2006.05.12"

if {$MULTIUSER} {
   const APNAME "dbstresm"
} else {
   const APNAME "dbstress"
}

# default logical table names

const DS_PRIM "test.primary"
const DS_ALT "test.alternate"

# default log file names that depend on platform

if {$tcl_platform(platform) == "unix"} {
   const DS_LOG "/work/logs/dbstres"
} else {
   const DS_LOG "C:/LOGS/DBSTRES"
}

# global data
set data ""
set ds_log ""
set ds_prim ""
set ds_alt ""
set tid 0
set trans_no 0

proc parse_comline {c_count c_parm} {
   # Parse the command line for parameters. Returns 1 if no error was
   #  detected, 0 otherwise.
   global ds_log ds_prim ds_alt SWITCH_CHAR APNAME
   set parms 0
   set done 0
      
   while {!$done} {
      set prm [lindex $c_parm $parms]

      if {[string index $prm 0] == $SWITCH_CHAR} {
         set sw [string toupper [string index $prm 1]]
         
         switch $sw {
            L {                       
               if {[string length $prm] > 2} {
                  puts "$APNAME:extraneous input with log file switch,ignoring"
               }
                         
               incr parms
            
               if {$parms >= $c_count} {
                  puts "$APNAME:log file switch with no file name,program\
                       abort"
                  return 0
               }
               
               set ds_log [lindex $c_parm $parms]
               incr parms
            }
         
            P {
               if {[string length $prm] > 2} {
                  puts "$APNAME:extraneous input with primary table\
                        switch,ignoring"
               }
               
               incr parms
            
               if {$parms >= $c_count} {
                  puts "$APNAME:primary table switch with no file\
                        name,program abort"
                  return 0
               }
               
               set ds_prim [lindex $c_parm $parms]
               incr parms
            }

            A {
               if {[string length $prm] > 2} {
                  puts "$APNAME:extraneous input with alternate table\
                        switch,ignoring"
               }
               
               incr parms
            
               if {$parms >= $c_count} {
                  puts "$APNAME:alternate table switch with no file\
                        name,program abort"
                  return 0
               }
               
               set ds_alt [lindex $c_parm $parms]
               incr parms
            }

            default {
               puts "$APNAME:unknown switch($prm), program abort"
               return 0
            }
         }
      } else {
         puts "$APNAME:unknown parameter($prm), program abort"
         return 0
      }
         
      if {$parms >= $c_count} {
         set done 1
      }
   }

   return 1
}

proc c_initialize {} {
   # Start the 'dbeng' local engine, read the config file and
   # display the result settings. Returns 1 upon success, 0
   # otherwise.
   global DBENG_OK DBENG_CONFIG_UNABLE_TO_OPEN
   set mname "c_initialize"

   set ret [db_initialize]

   # interpret code from init which may be a
   # fatal config error
   switch $ret \
      $DBENG_OK {log_file_date "$mname:read config file successfully"} \
      $DBENG_CONFIG_UNABLE_TO_OPEN \
                {log_file_date "$mname:config file not found,loaded defaults"} \
      default {log_file_date "$mname:fatal config\
                              error([db_io_code_string $ret])"; \
                              log_file_date "$mname:terminating";return 0}

   db_config_get_tmp_path mes
   log_file_date "$mname:tmp path is '$mes'"
   db_config_get_log mes
   log_file_date "$mname:log is '$mes'"
   set ret [db_config_get_catalog mes]

   if {$ret == $DBENG_OK} {
      log_file_date "$mname:catalog is '$mes'"
   } else {
      log_file_date "$mname:catalog name not loaded"
   }

   db_config_get_catalog_flag flag

   if {[flag_2_logic_string $flag mes]} {
      log_file_date "$mname:catalog is $mes"
   }

   return 1
}

proc check_files {} {
   # Check the resolved primary table and alternate table.
   # Returns 1 if the files are valid, 0 otherwise.
   global APNAME DBENG_OK ds_prim ds_alt tid
   set a_tid 0

   # open the primary test table (this will stay open)
   set ret [db_open $ds_prim tid]

   if {$ret != $DBENG_OK} {
      log_file_date "$APNAME:primary table($ds_prim) open\
                     failed,rc($ret)=[db_io_code_string $ret],abort"
      return 0
   }

   # check alternate table
   set ret [db_open $ds_alt a_tid]

   if {$ret != $DBENG_OK} {
      log_file_date "$APNAME:alternate table($ds_alt) open\
                     failed,rc($ret)=[db_io_code_string $ret],abort"
      return 0
   }

   db_close $a_tid
   return 1
}

proc pick_com {} {
   # Get a random command number in range
   global DBCOM_MAXCOM tid trans_no

   set final [rnd 1 $DBCOM_MAXCOM]
   db_get_rec_num $tid rec_num
   db_get_pos $tid pos
   db_get_rec_count $tid active_rec_count deleted_rec_count
   log_file_date "pick_com:c=$final,arc=$active_rec_count,\
                  drc=$deleted_rec_count,rn=$rec_num,\
                  pos=$pos,t=$trans_no"
   return $final
}

proc do_com {com_num} {
   # Dispatch command.
   global DBCOM_OPEN DBCOM_CLOSE DBCOM_NEXT DBCOM_TOP DBCOM_GET_REC
   global DBCOM_GET_FIELD DBCOM_GOTO DBCOM_COUNT DBCOM_PUT_FIELD DBCOM_WRITE
   global DBCOM_DELETE DBCOM_GET_DELETE_FLAG DBCOM_SET_DELETE_FLAG DBCOM_PACK
   global DBCOM_GET_NFIELDS DBCOM_GET_REC_SIZE DBCOM_GET_FIELD_SIZE DBCOM_NEW
   global DBCOM_GET_REC_NUM DBCOM_GET_POS DBCOM_GET_CHANGE_REC_FLAG DBCOM_FIND
   global DBCOM_SET_CHANGE_REC_FLAG DBCOM_FIND_FIELD DBCOM_FIND_PART DBCOM_EXIST
   global DBCOM_FIND_FIELD_PART DBCOM_GET_REC_COUNT DBCOM_NEW_TABLE
   global DBCOM_GET_ENF_CHANGE_REC_FLAG DBCOM_SET_ENF_CHANGE_REC_FLAG DBCOM_SORT
   global DBCOM_GET_IS_TABLE_LOCKED DBCOM_SET_IS_TABLE_LOCKED DBCOM_PUT_SUBFIELD   global DBCOM_CONFIG_GET_TMP_PATH DBCOM_CONFIG_GET_LOG DBCOM_GET_NSUBSUBFIELDS
   global DBCOM_CONFIG_GET_SESSION DBCOM_CONFIG_GET_CATALOG DBCOM_GET_NSUBFIELDS
   global DBCOM_CONFIG_GET_LOG_FLAG DBCOM_CONFIG_GET_SESSION_FLAG DBCOM_VERSION
   global DBCOM_CONFIG_GET_CATALOG_FLAG DBCOM_CONFIG_GET_REPLICATE_FLAG
   global DBCOM_CONFIG_GET_VERSION DBCOM_GET_OPEN_TABLE_LIST DBCOM_GET_SORT_MEM
   global DBCOM_PUT_SUBSUBFIELD DBCOM_GET_CATALOG_LIST DBCOM_SET_SORT_MEM
   global DBCOM_GET_SORT_OPEN_BIN DBCOM_SET_SORT_OPEN_BIN DBCOM_DELETE_FIELD
   global DBCOM_DELETE_SUBFIELD DBCOM_DELETE_SUBSUBFIELD DBCOM_TRANS_NUM
   global DBCOM_CONNECT_NUM DBCOM_GET_AUTOPACK DBCOM_SET_AUTOPACK
   global DBCOM_CONFIG_CLIENT_GET_LOG DBCOM_CONFIG_CLIENT_GET_LOG_FLAG

   switch -- $com_num \
      $DBCOM_OPEN {c_open} \
      $DBCOM_CLOSE {c_close} \
      $DBCOM_NEXT {c_next} \
      $DBCOM_TOP {c_top} \
      $DBCOM_GET_REC {c_get_rec} \
      $DBCOM_GET_FIELD {c_get_field} \
      $DBCOM_GOTO {c_goto} \
      $DBCOM_COUNT {c_count} \
      $DBCOM_PUT_FIELD {c_put_field} \
      $DBCOM_WRITE {c_write} \
      $DBCOM_DELETE {c_delete} \
      $DBCOM_GET_DELETE_FLAG {c_get_delete_flag} \
      $DBCOM_SET_DELETE_FLAG {c_set_delete_flag} \
      $DBCOM_GET_NFIELDS {c_get_nfields} \
      $DBCOM_GET_REC_SIZE {c_get_rec_size} \
      $DBCOM_GET_FIELD_SIZE {c_get_field_size} \
      $DBCOM_GET_REC_NUM {c_get_rec_num} \
      $DBCOM_GET_POS {c_get_pos} \
      $DBCOM_GET_CHANGE_REC_FLAG {c_get_change_rec_flag} \
      $DBCOM_SET_CHANGE_REC_FLAG {c_set_change_rec_flag} \
      $DBCOM_PACK {c_pack} \
      $DBCOM_NEW {c_new} \
      $DBCOM_FIND {c_find} \
      $DBCOM_FIND_FIELD {c_find_field} \
      $DBCOM_FIND_PART {c_find_part} \
      $DBCOM_FIND_FIELD_PART {c_find_field_part} \
      $DBCOM_GET_REC_COUNT {c_get_rec_count} \
      $DBCOM_GET_ENF_CHANGE_REC_FLAG {c_get_enf_change_rec_flag} \
      $DBCOM_SET_ENF_CHANGE_REC_FLAG {c_set_enf_change_rec_flag} \
      $DBCOM_GET_IS_TABLE_LOCKED {c_get_is_table_locked} \
      $DBCOM_SET_IS_TABLE_LOCKED {c_set_is_table_locked} \
      $DBCOM_NEW_TABLE {c_new_table} \
      $DBCOM_CONFIG_GET_TMP_PATH {c_config_get_tmp_path} \
      $DBCOM_CONFIG_GET_LOG {c_config_get_log} \
      $DBCOM_CONFIG_GET_SESSION {c_config_get_session} \
      $DBCOM_CONFIG_GET_CATALOG {c_config_get_catalog} \
      $DBCOM_CONFIG_GET_LOG_FLAG {c_config_get_log_flag} \
      $DBCOM_CONFIG_GET_SESSION_FLAG {c_config_get_session_flag} \
      $DBCOM_CONFIG_GET_CATALOG_FLAG {c_config_get_catalog_flag} \
      $DBCOM_CONFIG_GET_REPLICATE_FLAG {c_config_get_replicate_flag} \
      $DBCOM_CONFIG_GET_VERSION {c_config_get_version} \
      $DBCOM_GET_OPEN_TABLE_LIST {c_get_open_table_list} \
      $DBCOM_GET_NSUBFIELDS {c_get_nsubfields} \
      $DBCOM_GET_NSUBSUBFIELDS {c_get_nsubsubfields} \
      $DBCOM_PUT_SUBFIELD {c_put_subfield} \
      $DBCOM_PUT_SUBSUBFIELD {c_put_subsubfield} \
      $DBCOM_VERSION {c_version} \
      $DBCOM_EXIST {c_exist} \
      $DBCOM_GET_CATALOG_LIST {c_get_catalog_list} \
      $DBCOM_SORT {c_sort} \
      $DBCOM_GET_SORT_MEM {c_get_sort_mem} \
      $DBCOM_SET_SORT_MEM {c_set_sort_mem} \
      $DBCOM_GET_SORT_OPEN_BIN {c_get_sort_open_bin} \
      $DBCOM_SET_SORT_OPEN_BIN {c_set_sort_open_bin} \
      $DBCOM_DELETE_FIELD {c_delete_field} \
      $DBCOM_DELETE_SUBFIELD {c_delete_subfield} \
      $DBCOM_DELETE_SUBSUBFIELD {c_delete_subsubfield} \
      $DBCOM_TRANS_NUM {c_trans_num} \
      $DBCOM_CONNECT_NUM {c_connect_num} \
      $DBCOM_GET_AUTOPACK {c_get_autopack} \
      $DBCOM_SET_AUTOPACK {c_set_autopack} \
      $DBCOM_CONFIG_CLIENT_GET_LOG {c_config_client_get_log} \
      $DBCOM_CONFIG_CLIENT_GET_LOG_FLAG {c_config_client_get_log_flag} \
      default {log_file_date "do_com:unknown com($com_num),ignoring"}
}

proc c_open {} {
   # Test 'open' command by open and then closing the alternate table.
   global ds_alt
   set mname "c_open"

   set ret [db_open $ds_alt atid]
   log_file_date "$mname:open,rc=[db_io_code_string $ret]"
   set ret [db_close $atid]
   log_file_date "$mname:close,rc=[db_io_code_string $ret]"
}

proc c_close {} {
   # Test 'close' command by open and then closing the alternate table.
   global ds_alt
   set mname "c_close"

   set ret [db_open $ds_alt atid]
   log_file_date "$mname:open,rc=[db_io_code_string $ret]"
   set ret [db_close $atid]
   log_file_date "$mname:close,rc=[db_io_code_string $ret]"
}

proc c_next {} {
   # Text 'next' command by going to the next record. If 'eof' is
   # detected, go to the top of the table and get the first record.
   global DBENG_EOF tid
   set mname "c_next"

   set ret [db_next $tid]

   if {$ret == $DBENG_EOF} {
      log_file_date "$mname:eof detected,getting first record"
      db_top $tid
      set ret [db_next $tid]
   }

   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_top {} {
   # Test 'top' command by going to the top of the table and getting the
   # first record.
   global tid DBENG_OK
   set mname "c_top"

   set ret [db_top $tid]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:bad rc=[db_io_code_string $ret]"
      return
   }

   set ret [db_next $tid]
   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_get_rec {} {
   # Test 'get.rec' command by getting the contents of the current record.
   global tid
   set mname "c_get_rec"

   set ret [db_get_rec $tid rec]
   log_file_date "$mname:l=[string length $rec],rc=[db_io_code_string $ret]"
}

proc c_get_field {} {
   # Test 'get.field' command by getting the contents of a randomly
   # selected field.
   global tid DBENG_OK
   set mname "c_get_field"

   set ret [db_get_nfields $tid nfields]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:nfields,rc=[db_io_code_string $ret]"
      return
   }

   if {$nfields > 1} {
      set which [rnd 1 $nfields]
   } else {
      set which 1
   }

   set ret [db_get_field $tid $which field]
   log_file_date "$mname:f=$which,d=$field,l=[string length $field],\
                  rc=[db_io_code_string $ret]"
}

proc c_goto {} {
   # Test 'goto' command by going to a rondomly selected record.
   global tid
   set mname "c_goto"

   db_get_rec_count $tid active_rec_count deleted_rec_count
   set which [rnd 0 [expr $active_rec_count + 10]]
   set ret [db_goto $tid $which]
   log_file_date "$mname:r=$which,rc=[db_io_code_string $ret]"
}

proc c_count {} {
   # Test 'count' command.
   global tid
   set mname "c_count"

   set ret [db_count $tid active_rec_count deleted_rec_count]
   log_file_date "$mname:ac=$active_rec_count,dc=$deleted_rec_count,\
                  rc=[db_io_code_string $ret]"
}

proc c_put_field {} {
   # Test 'put.field' command by writing a random field with
   # a random number of digits.
   global tid data
   set mname "c_put_field"

   # pick a field between zero and 254 for the field
   set fnum [rnd 0 254]

   # build field
   c_put_data      
   set ret [db_put_field $tid $fnum $data]
   log_file_date "$mname:f=$fnum,d=$data,l=[string length $data],\
                  rc=[db_io_code_string $ret]"
}
   
proc c_write {} {
   # Test 'write' command.
   global tid
   set mname "c_write"

   set ret [db_write $tid]
   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_delete {} {
   # Test 'delete' command.
   global tid
   set mname "c_delete"

   set ret [db_delete $tid]
   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_get_delete_flag {} {
   # Test 'get.delete.flag' command.
   global tid
   set mname "c_get_delete_flag"

   set ret [db_get_delete_flag $tid del_flag]
   log_file_date "$mname:f=$del_flag,rc=[db_io_code_string $ret]"
}

proc c_set_delete_flag {} {
   # Test 'set.delete.flag' command.
   global tid
   set mname "c_set_delete_flag"

   # generate illegal values on purpose
   set del_flag [rnd 0 2]
   set ret [db_set_delete_flag $tid $del_flag]
   log_file_date "$mname:f=$del_flag,rc=[db_io_code_string $ret]"
}

proc c_get_nfields {} {
   # Test 'get.nfields' command.
   global tid
   set mname "c_get_nfields"

   set ret [db_get_nfields $tid nfields]
   log_file_date "$mname:f=$nfields,rc=[db_io_code_string $ret]"
}

proc c_get_rec_size {} {
   # Test 'get.rec.size' command.
   global tid
   set mname "c_get_rec_size"

   set ret [db_get_rec_size $tid rsize]
   log_file_date "$mname:s=$rsize,rc=[db_io_code_string $ret]"
}

proc c_get_field_size {} {
   # Test 'get.field.size' command.
   global tid DBENG_OK
   set mname "c_get_field_size"

   set ret [db_get_nfields $tid nfields]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:nfields:rc=[db_io_code_string $ret]"
      return
   }

   if {$nfields > 1} {
      set which [rnd 1 $nfields]
   } else {
      set which 1
   }

   set ret [db_get_field_size $tid $which fsize]
   log_file_date "$mname:f=$which,l=$fsize,rc=[db_io_code_string $ret]"
}

proc c_get_rec_num {} {
   # Test 'get.rec.num' command.
   global tid
   set mname "c_get_rec_num"

   set ret [db_get_rec_num $tid rec_num]
   log_file_date "$mname:r=$rec_num,rc=[db_io_code_string $ret]"
}

proc c_get_pos {} {
   # Test 'get.pos' command.
   global tid
   set mname "c_get_pos"

   set ret [db_get_pos $tid pos]
   log_file_date "$mname:p=$pos,rc=[db_io_code_string $ret]"
}

proc c_get_change_rec_flag {} {
   # Test 'get.change.rec.flag' command.
   global tid
   set mname "c_get_change_rec_flag"

   set ret [db_get_change_rec_flag $tid flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_set_change_rec_flag {} {
   # Test 'set.change.rec.flag' command.
   global tid
   set mname "c_set_change_rec_flag"

   # generate illegal values on purpose
   set rec_flag [rnd 0 2]
   set ret [db_set_change_rec_flag $tid $rec_flag]
   log_file_date "$mname:f=$rec_flag,rc=[db_io_code_string $ret]"
}

proc c_pack {} {
   # Test 'pack' command.
   global tid
   set mname "c_pack"

   set ret [db_pack $tid]
   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_new {} {
   # Test 'new' command.
   global tid
   set mname "c_new"

   set ret [db_new $tid]
   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_find {} {
   # Test 'find' command.
   global tid
   set mname "c_find"

   # pick a random number between 0 and 399 for field data, we
   # intentionally have a maximum range too large
   set fdata [rnd 0 399]

   # decide whether to use case sensitivity, can also generate
   # illegal values (0-2)
   set cs_flag [rnd 0 2]
   set ret [db_find $tid $cs_flag $fdata fnum]
   log_file_date "$mname:cs=$cs_flag,fd=$fdata,fn=$fnum,\
                  rc=[db_io_code_string $ret]"
}

proc c_find_field {} {
   # Test 'find.field' command.
   global tid
   set mname "c_find_field"

   # pick a random number between 0 and 399 for field data, we
   # intentionally have a maximum range too large
   set fdata [rnd 0 399]

   # decide whether to use case sensitivity, can also generate
   # illegal values (0-2)
   set cs_flag [rnd 0 2]

   # decide on which field to search, can also generate illegal values
   set fnum [rnd 0 19]
   set ret [db_find_field $tid $cs_flag $fdata $fnum]
   log_file_date "$mname:cs=$cs_flag,fd=$fdata,fn=$fnum,\
                  rc=[db_io_code_string $ret]"
}

proc c_find_part {} {
   # Test 'find.part' command.
   global tid
   set mname "c_find_part"

   # pick a random number between 0 and 399 for field data, we
   # intentionally have a maximum range too large
   set fdata [rnd 0 399]

   # decide whether to use case sensitivity, can also generate
   # illegal values (0-2)
   set cs_flag [rnd 0 2]
   set ret [db_find_part $tid $cs_flag $fdata fnum]
   log_file_date "$mname:cs=$cs_flag,fd=$fdata,fn=$fnum,\
                  rc=[db_io_code_string $ret]"
}

proc c_find_field_part {} {
   # Test 'find.field.part' command.
   global tid
   set mname "c_find_field_part"

   # pick a random number between 0 and 399 for field data, we
   # intentionally have a maximum range too large
   set fdata [rnd 0 399]

   # decide whether to use case sensitivity, can also generate
   # illegal values (0-2)
   set cs_flag [rnd 0 2]

   # decide on which field to search, can also generate illegal values
   set fnum [rnd 0 20]
   set ret [db_find_field_part $tid $cs_flag $fdata $fnum]
   log_file_date "$mname:cs=$cs_flag,fd=$fdata,fn=$fnum,\
                  rc=[db_io_code_string $ret]"
}
   
proc c_get_rec_count {} {
   # Test 'get.rec.count' command.
   global tid
   set mname "c_get_rec_count"

   set ret [db_get_rec_count $tid active_rec_count deleted_rec_count]
   log_file_date "$mname:ac=$active_rec_count,dc=$deleted_rec_count,\
                  rc=[db_io_code_string $ret]"
}

proc c_get_enf_change_rec_flag {} {
   # Test 'get.enf.change.rec.flag' command.
   global tid
   set mname "c_get_enf_change_rec_flag"

   set ret [db_get_enf_change_rec_flag $tid flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_set_enf_change_rec_flag {} {
   # Test 'set.enf.change.rec.flag' command.
   global tid
   set mname "c_set_enf_change_rec_flag"

   # generate illegal values on purpose
   set rec_flag [rnd 0 2]
   set ret [db_set_enf_change_rec_flag $tid $rec_flag]
   log_file_date "$mname:f=$rec_flag,rc=[db_io_code_string $ret]"
}

proc c_get_is_table_locked {} {
   # Test 'get.is.table.locked' command.
   global tid
   set mname "c_get_is_table_locked"

   set ret [db_get_is_table_locked $tid flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_set_is_table_locked {} {
   # Test 'set.is.table.locked' command.
   global tid
   set mname "c_set_is_table_locked"

   # generate illegal values on purpose
   set flag [rnd 0 2]
   set ret [db_set_is_table_locked $tid $flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_new_table {} {
   # Test 'new.table' command. Available in single user mode only.
   global MULTIUSER DBENG_OK DBENG_CANNOT_CREATE_TABLE
   set mname "c_new_table"

   if {$MULTIUSER} {
      log_file_date "$mname:command not implemented in c/s mode"
      return
   } else {
      # get temporary path from config data
      set ret [db_config_get_tmp_path tmp_path]

      if {$ret != $DBENG_OK} {
         log_file_date "$mname:error getting config tmp path,\
                        rc=[db_io_code_string $ret]"
         return
      }

      # generate unique file name
      if {![unique $tmp_path rname]} {
         log_file_date "$mname:error generating unique file name,\
                        rc=[db_io_code_string $ret]"
         return
      }

      # build complete path and file name
      set dest_table_name "$tmp_path/$rname"
      set tidf [rnd 0 2]
      set ttid $tidf
      set ret [db_new_table $dest_table_name ttid]
      log_file_date "$mname:dtn=$dest_table_name,tf=$tidf,tid=$ttid,\
                     rc=[db_io_code_string $ret]"

      if {$tidf} {
         set ret [db_close $ttid]

         if {$ret != $DBENG_OK} {
            log_file_date "$mname:closed failed,rc=[db_io_code_string $ret]"
         }
      }

      file delete $dest_table_name
   }
}

proc c_config_get_tmp_path {} {
   # Test 'config.get.tmp.path' command.
   global DBENG_OK
   set mname "c_config_get_tmp_path"

   set ret [db_config_get_tmp_path tmp_path]
   log_file_date "$mname:path=$tmp_path,rc=[db_io_code_string $ret]"
}

proc c_config_get_log {} {
   # Test 'config.get.log' command.
   set mname "c_config_get_log"

   set ret [db_config_get_log slog]
   log_file_date "$mname:log=$slog,rc=[db_io_code_string $ret]"
}

proc c_config_get_session {} {
   # Test 'config.get.session' command.
   set mname "c_config_get_session"

   set ret [db_config_get_session sessiont]
   log_file_date "$mname:session table=$sessiont,rc=[db_io_code_string $ret]"
}

proc c_config_get_catalog {} {
   # Test 'config.get.catalog' command.
   set mname "c_config_get_catalog"

   set ret [db_config_get_catalog catalogt]
   log_file_date "$mname:catalog table=$catalogt,rc=[db_io_code_string $ret]"
}

proc c_config_get_log_flag {} {
   # Test 'config.get.log.flag' command.
   set mname "c_config_get_log_flag"

   set ret [db_config_get_log_flag flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_config_get_session_flag {} {
   # Test 'config.get.session.flag' command.
   set mname "c_config_get_session_flag"
 
   set ret [db_config_get_session_flag flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_config_get_catalog_flag {} {
   # Test 'config.get.catalog.flag' command.
   set mname "c_config_get_catalog_flag"
   
   set ret [db_config_get_catalog_flag flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_config_get_replicate_flag {} {
   # Test 'config.get.replicate.flag' command.
   set mname "c_config_get_replicate_flag"

   set ret [db_config_get_replicate_flag flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}

proc c_config_get_version {} {
   # Test 'config.get.version' command.
   set mname "c_config_get_version"

   set ret [db_config_get_version ver]
   log_file_date "$mname:v=$ver,rc=[db_io_code_string $ret]"
}

proc c_get_open_table_list {} {
   # Test 'get.open.table.list' command.
   global DBENG_OK DBENG_LIST_DELIM
   set mname "c_get_open_table_list"

   set ret [db_get_open_table_list "" tlist]
  
   if {$ret == $DBENG_OK} {
      set nwords [ll_words $tlist $DBENG_LIST_DELIM]
      log_file_date "$mname:$nwords open table(s)"
   }

   log_file_date "$mname:rc=[db_io_code_string $ret]"
}
   
proc c_get_nsubfields {} {
   # Test 'get.nsubfields' command.
   global tid DBENG_OK
   set mname "c_get_nsubfields"

   set ret [db_get_nfields $tid nfields]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:nfields,rc=[db_io_code_string $ret]"
      return
   }

   if {$nfields > 1} {
      set which [rnd 1 $nfields]
   } else {
     set which 1
   }

   set ret [db_get_nsubfields $tid $which nsubfields]
   log_file_date "$mname:f=$which,nsubfields=$nsubfields,\
                  rc=[db_io_code_string $ret]"
}

proc c_get_nsubsubfields {} {
   # Test 'get.nsubsubfields' command.
   global tid DBENG_OK
   set mname "c_get_nsubsubfields"

   set ret [db_get_nfields $tid nfields]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:nfields,rc=[db_io_code_string $ret]"
      return
   }

   if {$nfields > 1} {
      set which_field [rnd 1 $nfields]
   } else {
      set which_field 1
   }

   set ret [db_get_nsubfields $tid $which_field nsubfields]

   if {$ret != $DBENG_OK} {
      log_file_date "$mname:nsubfields,rc=[db_io_code_string $ret]"
      return
   }

   if {$nsubfields > 1} {
      set which_subfield [rnd 1 $nsubfields]
   } else {
      set which_subfield 1
   }

   set ret [db_get_nsubsubfields $tid $which_field $which_subfield \
            nsubsubfields]
   log_file_date "$mname:f=$which_field,sf=$which_subfield,\
                  nsubsubfields=$nsubsubfields,rc=[db_io_code_string $ret]"
}

proc c_put_subfield {} {
   # Test 'put.subfield' command.
   global tid data
   set mname "c_put_subfield"

   # pick a random number between 0 and 254 for the field number and
   # 0 to 9 for the subfield number
   set fnum [rnd 0 254]
   set sfnum [rnd 0 9]

   # build subfield
   c_put_data
   set ret [db_put_subfield $tid $fnum $sfnum $data]
   log_file_date "$mname:f=$fnum,sf=$sfnum,d=$data,l=[string length $data],\
                  rc=[db_io_code_string $ret]"
}
 
proc c_put_subsubfield {} {
   # Test 'put.subsubfield' command.
   global tid data
   set mname "c_put_subsubfield"

   # pick a random number between 0 and 254 for field number,
   # 0 to 9 for subfield number and subsubfield number
   set fnum [rnd 0 254]
   set sfnum [rnd 0 9]
   set ssfnum [rnd 0 9]

   # build subsubfield
   c_put_data
   set ret [db_put_subsubfield $tid $fnum $sfnum $ssfnum $data]
   log_file_date "$mname:f=$fnum,sf=$sfnum,ssf=$ssfnum,d=$data,\
                  l=[string length $data],rc=[db_io_code_string $ret]"
}

proc c_version {} {
   # Get the 'Bbuuzzb' server versuio ID. Applies to multiuser
   # only.
   global MULTIUSER
   set mname "c_version"

   if {!$MULTIUSER} {
      log_file_date "$mname:does not apply to single user"
      return
   }

   set ret [db_version ver]
   log_file_date "$mname:ver=$ver,rc=[db_io_code_string $ret]"
}
   
proc c_exist {} {
   # Test 'exist' command.
   global DS_PRIM
   set mname "c_exist"

   # pick a random number between 0 and 1
   set test_prim [rnd 0 1]

   if {$test_prim} {
      set fname $DS_PRIM
   } else {
      set fname "zzz"
   }

   set ret [db_exist $fname exist_flag]
   log_file_date "$mname:fname=$fname,exist_flag=$exist_flag,\
                  rc=[db_io_code_string $ret]"
}

proc c_get_catalog_list {} {
   # Test 'get.catalog.list' command.
   global DBENG_OK DBENG_LIST_DELIM
   set mname "c_get_catalog_list"

   set ret [db_get_catalog_list "" clist]

   if {$ret == $DBENG_OK} {
      set nwords [ll_words $clist $DBENG_LIST_DELIM]
      log_file_date "$mname:$nwords catalog entry/entries"
   }

   log_file_date "$mname:rc=[db_io_code_string $ret]"
}

proc c_sort {} {
   # Test 'sort' command.
   global tid
   set mname "c_sort"

   # pick a random number between 0 and 3
   set which_type [rnd 0 3]

   switch -- $which_type {
      0 {
         # just field 1 ascending
         set spec 1
      }

      1 {
         # field 1 descending
         set spec "1,d"
      }

      2 {
         # field 1 and field 2 both ascending
         set spec "1^2"
      }

      3 {
         # illegal
         set spec "1,z"
      }
   }

   set ret [db_sort $tid $spec]
   log_file_date "$mname:spec=$spec,rc=[db_io_code_string $ret]"
}

proc c_get_sort_mem {} {
   # Test 'get.sort.mem' command.
   global tid
   set mname "c_get_sort_mem"

   set ret [db_get_sort_max_mem $tid mem]
   log_file_date "$mname:sort mem=$mem,rc=[db_io_code_string $ret]"
}

proc c_set_sort_mem {} {
   # Test 'set.sort.mem' command.
   global tid
   set mname "c_set_sort_mem"

   # generate a random number in the range 1700-200000 (actual allowable
   # range is >= 2000)
   set mem [rnd 1700 200000]
   set ret [db_set_sort_max_mem $tid $mem]
   log_file_date "$mname:sort mem=$mem,rc=[db_io_code_string $ret]"
}

proc c_get_sort_open_bin {} {
   # Test 'get.sort.open.bin' command.
   global tid
   set mname "c_get_sort_open_bin"

   set ret [db_get_sort_max_open_bin $tid max_bin]
   log_file_date "$mname:open bin=$max_bin,rc=[db_io_code_string $ret]"
}
 
proc c_set_sort_open_bin {} {
   # Test 'set.sort.open.bin' command.
   global tid
   set mname "c_set_sort_open_bin"
 
   # generate a random number in the range 0-29 (actual allowable
   # range is >= 3)
   set max_bin [rnd 0 29]
   set ret [db_set_sort_max_open_bin $tid $max_bin]
   log_file_date "$mname:open_bin=$max_bin,rc=[db_io_code_string $ret]"
}

proc c_delete_field {} {
   # Test 'delete.field' command.
   global tid
   set mname "c_delete_field"

   # pick a random number between 0 and 254 for the field number
   set fnum [rnd 0 254]
   set ret [db_delete_field $tid $fnum]
   log_file_date "$mname:f=$fnum,rc=[db_io_code_string $ret]"
}

proc c_delete_subfield {} {
   # Test 'delete.subfield' command.
   global tid
   set mname "c_delete_subfield"

   # pick a random number between 0 and 254 for the field number
   # and 0 to 9 for the subfield number
   set fnum [rnd 0 254]
   set sfnum [rnd 0 9]
   set ret [db_delete_subfield $tid $fnum $sfnum]
   log_file_date "$mname:f=$fnum,sf=$sfnum,rc=[db_io_code_string $ret]"
}

proc c_delete_subsubfield {} {
   # Test 'delete.subsubfield' command.
   global tid
   set mname "c_delete_subsubfield"

   # pick a random number between 0 and 254 for the field number
   # and 0 to 9 for the subfield and subsubfield number
   set fnum [rnd 0 254]
   set sfnum [rnd 0 9]
   set ssfnum [rnd 0 9]
   set ret [db_delete_subsubfield $tid $fnum $sfnum $ssfnum]
   log_file_date "$mname:f=$fnum,sf=$sfnum,ssf=$ssfnum,\
                  rc=[db_io_code_string $ret]"
}

proc c_trans_num {} {
   # Test 'trans.num' command.
   global MULTIUSER
   set mname "c_trans_num"

   if {!$MULTIUSER} {
      log_file_date "$mname:does not apply to single user"
      return
   }

   set ret [db_trans_num trans_num]
   log_file_date "$mname:trans_num=$trans_num,rc=[db_io_code_string $ret]"
}

proc c_connect_num {} {
   # Test 'connect.num' command.
   global MULTIUSER
   set mname "c_connect_num"

   if {!$MULTIUSER} {
      log_file_date "$mname:does not apply to single user"
      return
   }

   set ret [db_connect_num connect_num]
   log_file_date "$mname:connect_num=$connect_num,rc=[db_io_code_string $ret]"
}

proc c_get_autopack {} {
   # Test 'get.autopack' command.
   global tid
   set mname "c_get_autopack"

   set ret [db_get_autopack $tid pval]
   log_file_date "$mname:p=$pval,rc=[db_io_code_string $ret]"
}

proc c_set_autopack {} {
   # Test 'set.autopack' command.
   global tid
   set mname "c_set_autopack"

   set pval [rnd 0 10]
   set ret [db_set_autopack $tid $pval]
   log_file_date "$mname:p=$pval,rc=[db_io_code_string $ret]"
}

proc c_config_client_get_log {} {
   # Test 'config.client.get.log' command.
   global MULTIUSER
   set mname "c_config_client_get_log"

   if {!$MULTIUSER} {
      log_file_date "$mname:does not apply to single user"
      return
   }

   set ret [db_config_client_get_log slog]
   log_file_date "$mname:log=$slog,rc=[db_io_code_log $ret]"
}

proc c_config_client_get_log_flag {} {
   # Test 'config.client.get.log.flag' command.
   global MULTIUSER
   set mname "c_config_client_get_log_flag"

   if {!$MULTIUSER} {
      log_file_date "$mname:does not apply to single user"
      return
   }

   set ret [db_config_client_get_log_flag flag]
   log_file_date "$mname:f=$flag,rc=[db_io_code_string $ret]"
}
   
proc c_put_data {} {
   # Place a random number of digits into the 'data' string.
   global data

   # generate between 1 and 100 digits
   set ndigits [rnd 1 100]
   set data ""

   # build
   for {set i 0} {$i < $ndigits} {incr i} {
      set ch [rnd 48 57]
      append data [format "%c" $ch]
   }
}

proc term_app {} {
   # Prepare to terminate the application. Shutdown all IPC API's.

   db_end
   appinit_remove_name

   if {[is_log_active]} {
      log_end
   }
}

# program main line
set ds_prim $DS_PRIM
set ds_alt $DS_ALT

# load default log name
      
if {$MULTIUSER} {
   set ds_log [format "%sm.log" $DS_LOG]
} else {
   set ds_log [format "%ss.log" $DS_LOG]
}

# parse command line (if parameters supplied)
if {$argc > 0} {
   if {![parse_comline $argc $argv]} {
      exit
   }
}

# register application name with 'appinit'
if {![appinit_register_name $APNAME]} {
   puts "$APNAME:fatal error registering app name with appinit"
   exit
}

if {![log_start $ds_log]} {
   puts "$APNAME:unable to open log file,abort"
   exit
}

log_console 1
expr srand([clock clicks])
set trans_no 1

# display logo
log_file_date "$APNAME for $tcl_platform(platform) Version $VERSION"
log_file_date "By Rick Smereka, Copyright (c) 2006"

# initialize local engine if we are running locally or
# startup the 'socloc' interface and connect to a
# Bbuuzzb database server if we are running in
# client/server mode
if {![c_initialize]} {
   term_app
   exit
}

db_config_set_log $ds_log
set ret [db_config_set_log_flag 1]

if {$ret != $DBENG_OK} {
   puts "$APNAME:unable to start log"
   term_app
   exit
}

# get and display 'dbeng' version
set ret [db_config_get_version mes]

if {$ret != $DBENG_OK} {
   log_file_date "$APNAME:error getting 'dbeng'\
                  version,rc=[db_io_code_string $ret]"
   term_app
   exit
}

log_file_date "based on version $mes of the 'Bbuuzzb' database engine"
log_file_date "$APNAME comes with ABSOLUTELY NO WARRANTY"
log_file_date "This is free software, and you are welcome to redistribute it"
log_file_date "under certain conditions; see 'gpl.txt' for information."

# check primary and alternate table names
if {![check_files]} {
   term_app
   exit
}

# display primary table, alternate table and log file names
log_file_date "$APNAME:primary table is $ds_prim,tid=$tid"
log_file_date "$APNAME:alternate table is $ds_alt"
log_file_date "$APNAME:log file is $ds_log"

# main loop, infinite
while {1} {
   set dbcom [pick_com]
   incr trans_no
   do_com $dbcom
}

term_app
exit
