Mercurial > hg > egg-tcls

annotate utilcreate.tcl @ 698:6ba9f961e463 default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
quotedb: Bump version and copyright.
author Matti Hamalainen <ccr@tnsp.org>
date Mon, 18 Sep 2023 11:38:41 +0300
parents 14dfb925a64a
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
502
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
1 ##########################################################################
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
2 #
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
3 # TCL functions library by Matti 'ccr' Hamalainen <ccr@tnsp.org>
578
14dfb925a64a Bump copyright years.
Matti Hamalainen <ccr@tnsp.org>
parents: 502
diff changeset
4 # (C) Copyright 2015-2021 Tecnic Software productions (TNSP)
502
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
5 #
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
6 # This script is freely distributable under GNU GPL (version 2) license.
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
7 #
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
8 ##########################################################################
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
9
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
10 proc utl_confirm_yesno { uprompt } {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
11 puts -nonewline "$uprompt \[y/N\]? "
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
12 flush stdout
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
13 set response [gets stdin]
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
14 if {[string tolower $response] == "y"} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
15 return 1
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
16 } else {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
17 return 0
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
18 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
19 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
20
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
21
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
22 proc utl_drop_table { dbh utable } {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
23 puts "Dropping current table '$utable'."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
24 if {[catch {dbh eval "DROP TABLE $utable"} uerrmsg]} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
25 puts "Dropping table resulted in error (ignored): $uerrmsg."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
26 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
27 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
28
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
29
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
30 proc utl_create_table { dbh utable usql } {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
31 puts "Creating new table '$utable'."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
32 if {[catch {dbh eval "CREATE TABLE $utable ($usql)"} uerrmsg]} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
33 puts "Error creating table: $uerrmsg."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
34 return 0
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
35 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
36 return 1
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
37 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
38
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
39
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
40 proc utl_create_table_or_fail { dbh utable usql } {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
41 if {![utl_create_table $dbh $utable $usql]} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
42 exit 3
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
43 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
44 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
45
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
46
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
47 ###
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
48 ### Check commandline arguments
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
49 ###
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
50 if {$argc < 1} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
51 puts "$db_create_desc"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
52 puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
53 puts ""
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
54 puts "-drop option will drop any existing tables named:"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
55 set tstr [join [lmap i $db_table_list {db_get_table_list $i}] ", "]
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
56 puts " $tstr"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
57 puts ""
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
58 exit 0
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
59 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
60
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
61 set db_drop 0
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
62 set db_file [lindex $argv 0]
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
63 if {$argc >= 2 && [lindex $argv 1] == "-drop"} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
64 set db_drop 1
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
65 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
66
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
67 ### Open database
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
68 if {[catch {sqlite3 dbh $db_file} uerrmsg]} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
69 putlog "Could not open SQLite3 database '$db_file': $uerrmsg"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
70 exit 2
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
71 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
72
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
73 if {$db_drop} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
74 puts "WARNING! Dropping of old table(s) requested!"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
75 puts "All data in these tables will be permanently lost!"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
76 set tstr [join [lmap i $db_table_list {db_get_table_list $i}] ", "]
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
77 puts " $tstr"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
78 puts ""
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
79
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
80 if {![utl_confirm_yesno "Proceed"]} {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
81 puts "Aborting procedure."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
82 dbh close
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
83 exit 0
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
84 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
85
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
86 foreach i $db_table_list {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
87 db_drop_table dbh "$i"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
88 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
89 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
90
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
91 puts "Creating tables ..."
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
92 foreach i $db_table_list {
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
93 db_create_table dbh "$i"
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
94 }
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
95
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
96 dbh close
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
97
1255d524a919 Fix create_*.tcl database creation scripts after long period of being broken.
Matti Hamalainen <ccr@tnsp.org>
parents:
diff changeset
98 puts "DONE."