#***
# [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]