Mercurial > hg > egg-tcls
diff utilcreate.tcl @ 502:1255d524a919
Fix create_*.tcl database creation scripts after long period of being broken.
author | Matti Hamalainen <ccr@tnsp.org> |
---|---|
date | Thu, 23 Jan 2020 08:01:40 +0200 |
parents | |
children | 14dfb925a64a |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/utilcreate.tcl Thu Jan 23 08:01:40 2020 +0200 @@ -0,0 +1,98 @@ +########################################################################## +# +# TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> +# (C) Copyright 2015-2020 Tecnic Software productions (TNSP) +# +# This script is freely distributable under GNU GPL (version 2) license. +# +########################################################################## + +proc utl_confirm_yesno { uprompt } { + puts -nonewline "$uprompt \[y/N\]? " + flush stdout + set response [gets stdin] + if {[string tolower $response] == "y"} { + return 1 + } else { + return 0 + } +} + + +proc utl_drop_table { dbh utable } { + puts "Dropping current table '$utable'." + if {[catch {dbh eval "DROP TABLE $utable"} uerrmsg]} { + puts "Dropping table resulted in error (ignored): $uerrmsg." + } +} + + +proc utl_create_table { dbh utable usql } { + puts "Creating new table '$utable'." + if {[catch {dbh eval "CREATE TABLE $utable ($usql)"} uerrmsg]} { + puts "Error creating table: $uerrmsg." + return 0 + } + return 1 +} + + +proc utl_create_table_or_fail { dbh utable usql } { + if {![utl_create_table $dbh $utable $usql]} { + exit 3 + } +} + + +### +### Check commandline arguments +### +if {$argc < 1} { + puts "$db_create_desc" + puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]" + puts "" + puts "-drop option will drop any existing tables named:" + set tstr [join [lmap i $db_table_list {db_get_table_list $i}] ", "] + puts " $tstr" + puts "" + exit 0 +} + +set db_drop 0 +set db_file [lindex $argv 0] +if {$argc >= 2 && [lindex $argv 1] == "-drop"} { + set db_drop 1 +} + +### Open database +if {[catch {sqlite3 dbh $db_file} uerrmsg]} { + putlog "Could not open SQLite3 database '$db_file': $uerrmsg" + exit 2 +} + +if {$db_drop} { + puts "WARNING! Dropping of old table(s) requested!" + puts "All data in these tables will be permanently lost!" + set tstr [join [lmap i $db_table_list {db_get_table_list $i}] ", "] + puts " $tstr" + puts "" + + if {![utl_confirm_yesno "Proceed"]} { + puts "Aborting procedure." + dbh close + exit 0 + } + + foreach i $db_table_list { + db_drop_table dbh "$i" + } +} + +puts "Creating tables ..." +foreach i $db_table_list { + db_create_table dbh "$i" +} + +dbh close + +puts "DONE."