1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
#***
# [manpage_begin migrate_core tclircc 0.0.1]
# [titledesc {Script migrate_core.tcl}]
# [description]
# TODO: make this more robust maybe
namespace eval db {
variable log [logger::init tclircc::db]
variable logc [logger::init tclircc::db::cleanup]
variable autocleanup_dbs {}
variable autocleanup_steps {}
variable autocleanup_task {}
}
proc db::cleanup {} {
variable autocleanup_dbs
variable autocleanup_steps
variable logc
foreach db $autocleanup_dbs {
${logc}::debug "cleaning up \"$db\"..."
if [dict exists $autocleanup_steps $db] {
${logc}::debug "executing additional script on \"$db\"..."
$db eval [dict get $autocleanup_steps $db]
}
$db eval { VACUUM; }
${logc}::debug "cleaned up \"$db\"!"
}
}
proc db::autocleanup {interval} {
variable autocleanup_task
db::cleanup
set autocleanup_task [after $interval [list db::autocleanup $interval]]
}
proc db::init_core {data_dir} {
variable autocleanup_dbs
sqlite3 core_db [file join $data_dir core.db]
lappend autocleanup_dbs core_db
interp create migrator
migrator eval {
lappend migrations 0 {init networks} {
CREATE TABLE networks (name TEXT NOT NULL,
servers TEXT NOT NULL,
autoconnect BOOL NOT NULL DEFAULT 0,
creds TEXT NOT NULL DEFAULT '');
}
}
migrator alias core_db core_db
migrator eval {
package require logger
package require Tk
wm withdraw .
set log [logger::init tclircc::db::migrate]
${log}::debug "starting migrations"
if ![core_db eval {
SELECT count(*) FROM sqlite_master WHERE name="_migrations"}] {
${log}::info "initializing core db!"
core_db eval {CREATE TABLE _migrations (id INTEGER PRIMARY KEY, date TEXT)}
}
foreach {id name contents} $migrations {
# TODO: debug interpolation?
if ![core_db eval "SELECT count(*) FROM _migrations WHERE id=$id"] {
${log}::info "performing migration $id: $name"
core_db eval BEGIN
set migrationdate [clock seconds]
core_db eval $contents
core_db eval "INSERT INTO _migrations (id, date) VALUES ($id, $migrationdate)"
set last $id
core_db eval COMMIT
} elseif [info exists last] {
${log}::warn "completed migrations exist after incomplete migration $last, core database may be corrupted!"
}
}
${log}::info "core db migrated!"
}
interp delete migrator
}
#***
# [manpage_end]