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."