Mercurial > hg > egg-tcls

comparison create_urllog_db.tcl @ 502:1255d524a919

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
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 416642f28d1e
children
comparison
equal deleted inserted replaced
501:7c4cef80f826 502:1255d524a919
5 # (C) Copyright 2011 Tecnic Software productions (TNSP) 5 # (C) Copyright 2011 Tecnic Software productions (TNSP)
6 # 6 #
7 package require sqlite3 7 package require sqlite3
8 source [file dirname [info script]]/utillib.tcl 8 source [file dirname [info script]]/utillib.tcl
9 9
10 ### Check commandline arguments 10 set db_create_desc "Creates tables for URLLog in target SQLite3 file"
11 if {$argc < 1} { 11 set db_table_list {urls}
12 puts "Creates tables for URLLog target SQLite3 file" 12
13 puts "Usage: $argv0 <output_sqlite3_db_file> \[-drop\]" 13
14 puts "" 14 proc db_create_table { dbh utable } {
15 puts "-drop option will drop any existing URLLog tables." 15 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)"
16 exit 0
17 } 16 }
18 17
19 set db_drop 0 18 proc db_drop_table { dbh utable } {
20 set db_output [lindex $argv 0] 19 utl_drop_table dbh "$utable"
21 if {$argc >= 2 && [lindex $argv 1] == "-drop"} {
22 set db_drop 1
23 } 20 }
24 21
25 ### Open database 22 proc db_get_table_list { utable } {
26 open_db $db_output 23 return [list "$utable"]
27
28 if {$db_drop} {
29 puts "WARNING! Dropping old tables URLLog requested!"
30 puts "All data in those tables will be permanently lost!"
31
32 if {![confirm_yesno "Proceed"]} {
33 puts "Aborting procedure."
34 dbh close
35 exit 0
36 }
37
38 drop_table "urls"
39 } 24 }
40 25
41 create_table_urls
42 26
43 dbh close 27 source [file dirname [info script]]/utilcreate.tcl
44
45 puts "DONE."