Mercurial > hg > egg-tcls
changeset 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 | 7c4cef80f826 |
| children | fdd1f0b83685 |
| files | create_feeds_db.tcl create_quotedb.tcl create_urllog_db.tcl utilcreate.tcl utillib.tcl |
| diffstat | 5 files changed, 133 insertions(+), 135 deletions(-) [+] |
line wrap: on
line diff
--- a/create_feeds_db.tcl Thu Jan 23 06:14:06 2020 +0200 +++ b/create_feeds_db.tcl Thu Jan 23 08:01:40 2020 +0200 @@ -7,39 +7,21 @@ package require sqlite3 source [file dirname [info script]]/utillib.tcl -### Check commandline arguments -if {$argc < 1} { - puts "Creates tables for Feeds target SQLite3 file" - puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]" - puts "" - puts "-drop option will drop any existing Feeds tables." - exit 0 -} +set db_create_desc "Creates tables for Feeds.tcl in target SQLite3 file" +set db_table_list {feeds} -set db_drop 0 -set db_output [lindex $argv 0] -if {$argc >= 2 && [lindex $argv 1] == "-drop"} { - set db_drop 1 + +proc db_create_table { dbh utable } { + utl_create_table dbh "$utable" "id INTEGER PRIMARY KEY AUTOINCREMENT, utime INT, utext VARCHAR(2048), user VARCHAR(32), host VARCHAR(256), chan VARCHAR(32)" } -### Open database -open_db $db_output - -if {$db_drop} { - puts "WARNING! Dropping old tables Feeds requested!" - puts "All data in those tables will be permanently lost!" - - if {![confirm_yesno "Proceed"]} { - puts "Aborting procedure." - dbh close - exit 0 - } - - drop_table_feeds +proc db_drop_table { dbh utable } { + utl_drop_table dbh "$utable" } -create_table_feeds +proc db_get_table_list { utable } { + return [list $utable] +} -dbh close -puts "DONE." +source [file dirname [info script]]/utilcreate.tcl
--- a/create_quotedb.tcl Thu Jan 23 06:14:06 2020 +0200 +++ b/create_quotedb.tcl Thu Jan 23 08:01:40 2020 +0200 @@ -7,47 +7,23 @@ package require sqlite3 source [file dirname [info script]]/utillib.tcl -set db_list {quotedb} +set db_create_desc "Creates tables for QuoteDB in target SQLite3 file" +set db_table_list {quotedb} + -### Check commandline arguments -set db_str [join $db_list ", "] -if {$argc < 1} { - puts "Creates tables for QuoteDB in target SQLite3 file" - puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]" - puts "" - puts "-drop option will drop any existing '$db_str' table of same name." - exit 0 -} - -set db_drop 0 -set db_output [lindex $argv 0] -if {$argc >= 2 && [lindex $argv 1] == "-drop"} { - set db_drop 1 +proc db_create_table { dbh utable } { + utl_create_table_or_fail dbh "$utable" "id INTEGER PRIMARY KEY AUTOINCREMENT, utime INT, utext VARCHAR(2048), user VARCHAR(32), host VARCHAR(256), chan VARCHAR(32)" + utl_create_table_or_fail dbh "${utable}_votes" "id INTEGER PRIMARY KEY AUTOINCREMENT, user VARCHAR(32), urlid INTEGER, vote INTEGER" } -### Open database -open_db $db_output - -if {$db_drop} { - puts "WARNING! Dropping of old table(s) '$db_str' requested!" - puts "All data in those tables will be permanently lost!" - - if {![confirm_yesno "Proceed"]} { - puts "Aborting procedure." - dbh close - exit 0 - } - - foreach i $db_list { - drop_table $i - } +proc db_drop_table { dbh utable } { + utl_drop_table dbh "$utable" + utl_drop_table dbh "${utable}_votes" } -puts "Creating tables $db_str ..." -foreach i $db_list { - create_table_quotes_votes $i 0 +proc db_get_table_list { utable } { + return [list "$utable" "${utable}_votes"] } -dbh close -puts "DONE." +source [file dirname [info script]]/utilcreate.tcl
--- a/create_urllog_db.tcl Thu Jan 23 06:14:06 2020 +0200 +++ b/create_urllog_db.tcl Thu Jan 23 08:01:40 2020 +0200 @@ -7,39 +7,21 @@ package require sqlite3 source [file dirname [info script]]/utillib.tcl -### Check commandline arguments -if {$argc < 1} { - puts "Creates tables for URLLog target SQLite3 file" - puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]" - puts "" - puts "-drop option will drop any existing URLLog tables." - exit 0 -} +set db_create_desc "Creates tables for URLLog in target SQLite3 file" +set db_table_list {urls} -set db_drop 0 -set db_output [lindex $argv 0] -if {$argc >= 2 && [lindex $argv 1] == "-drop"} { - set db_drop 1 + +proc db_create_table { dbh utable } { + utl_create_table_or_fail dbh "$utable" "id INTEGER PRIMARY KEY AUTOINCREMENT, utime INT, url VARCHAR(2048), user VARCHAR(32), host VARCHAR(256), chan VARCHAR(32), title VARCHAR(256)" } -### Open database -open_db $db_output - -if {$db_drop} { - puts "WARNING! Dropping old tables URLLog requested!" - puts "All data in those tables will be permanently lost!" - - if {![confirm_yesno "Proceed"]} { - puts "Aborting procedure." - dbh close - exit 0 - } - - drop_table "urls" +proc db_drop_table { dbh utable } { + utl_drop_table dbh "$utable" } -create_table_urls +proc db_get_table_list { utable } { + return [list "$utable"] +} -dbh close -puts "DONE." +source [file dirname [info script]]/utilcreate.tcl
--- /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."
--- a/utillib.tcl Thu Jan 23 06:14:06 2020 +0200 +++ b/utillib.tcl Thu Jan 23 08:01:40 2020 +0200 @@ -1,7 +1,7 @@ ########################################################################## # # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org> -# (C) Copyright 2015-2017 Tecnic Software productions (TNSP) +# (C) Copyright 2015-2020 Tecnic Software productions (TNSP) # # This script is freely distributable under GNU GPL (version 2) license. # @@ -157,43 +157,3 @@ proc utl_escape {str} { return [string map {' ''} $str] } - - -### -### Functions for certain scripts -### -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 - } -}