eb656de7d9 2007-10-05 aku: ## -*- tcl -*- eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# ##################### eb656de7d9 2007-10-05 aku: ## Copyright (c) 2007 Andreas Kupries. eb656de7d9 2007-10-05 aku: # eb656de7d9 2007-10-05 aku: # This software is licensed as described in the file LICENSE, which eb656de7d9 2007-10-05 aku: # you should have received as part of this distribution. eb656de7d9 2007-10-05 aku: # eb656de7d9 2007-10-05 aku: # This software consists of voluntary contributions made by many eb656de7d9 2007-10-05 aku: # individuals. For exact contribution history, see the revision eb656de7d9 2007-10-05 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# ##################### eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: ## State manager. Maintains the sqlite database used by all the other eb656de7d9 2007-10-05 aku: ## parts of the system, especially the passes and their support code, eb656de7d9 2007-10-05 aku: ## to persist and restore their state across invokations. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# ##################### eb656de7d9 2007-10-05 aku: ## Requirements eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: package require Tcl 8.4 ; # Required runtime. eb656de7d9 2007-10-05 aku: package require snit ; # OO system. eb656de7d9 2007-10-05 aku: package require fileutil ; # File operations. eb656de7d9 2007-10-05 aku: package require sqlite3 ; # Database access. eb656de7d9 2007-10-05 aku: package require vc::tools::trouble ; # Error reporting. eb656de7d9 2007-10-05 aku: package require vc::tools::log ; # User feedback. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# ##################### eb656de7d9 2007-10-05 aku: ## eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: snit::type ::vc::fossil::import::cvs::state { eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# eb656de7d9 2007-10-05 aku: ## Public API eb656de7d9 2007-10-05 aku: e288af3995 2007-12-02 aku: typemethod usedb {path} { eb656de7d9 2007-10-05 aku: # Immediate validation. There are are two possibilities to eb656de7d9 2007-10-05 aku: # consider. The path exists or it doesn't. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # In the first case it has to be a readable and writable file, eb656de7d9 2007-10-05 aku: # and it has to be a proper sqlite database. Further checks eb656de7d9 2007-10-05 aku: # regarding the required tables will be done later, by the eb656de7d9 2007-10-05 aku: # passes, during their setup. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # In the second case we have to be able to create the file, eb656de7d9 2007-10-05 aku: # and check that. This is done by opening it, sqlite will then eb656de7d9 2007-10-05 aku: # try to create it, and may fail. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: if {[file exists $path]} { eb656de7d9 2007-10-05 aku: if {![fileutil::test $path frw msg {cvs2fossil state}]} { eb656de7d9 2007-10-05 aku: trouble fatal $msg eb656de7d9 2007-10-05 aku: return eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: if {[catch { eb656de7d9 2007-10-05 aku: sqlite3 ${type}::TEMP $path eb656de7d9 2007-10-05 aku: } res]} { eb656de7d9 2007-10-05 aku: trouble fatal $res eb656de7d9 2007-10-05 aku: return eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # A previously defined state database is closed before eb656de7d9 2007-10-05 aku: # committing to the new definition. We do not store the path eb656de7d9 2007-10-05 aku: # itself, this ensures that the file is _not_ cleaned up after eb656de7d9 2007-10-05 aku: # a run. eb656de7d9 2007-10-05 aku: fb1e36d290 2007-10-05 aku: set mystate ${type}::STATE fb1e36d290 2007-10-05 aku: set mypath {} fb1e36d290 2007-10-05 aku: fb1e36d290 2007-10-05 aku: catch { $mystate close } fb1e36d290 2007-10-05 aku: rename ${type}::TEMP $mystate fb1e36d290 2007-10-05 aku: fb1e36d290 2007-10-05 aku: log write 2 state "is $path" eb656de7d9 2007-10-05 aku: return eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: typemethod setup {} { eb656de7d9 2007-10-05 aku: # If, and only if no state database was defined by the user eb656de7d9 2007-10-05 aku: # then it is now the time to create our own using a tempfile. eb656de7d9 2007-10-05 aku: fb1e36d290 2007-10-05 aku: if {$mystate ne ""} return eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: set mypath [fileutil::tempfile cvs2fossil_state_] fb1e36d290 2007-10-05 aku: set mystate ${type}::STATE fb1e36d290 2007-10-05 aku: sqlite3 $mystate $mypath eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: log write 2 state "using $mypath" eb656de7d9 2007-10-05 aku: return eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: typemethod release {} { eb656de7d9 2007-10-05 aku: log write 2 state release eb656de7d9 2007-10-05 aku: ${type}::STATE close eb656de7d9 2007-10-05 aku: if {$mypath eq ""} return eb656de7d9 2007-10-05 aku: file delete $mypath eb656de7d9 2007-10-05 aku: return eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: e288af3995 2007-12-02 aku: # Declare a table needed for the storing of persistent state, and e288af3995 2007-12-02 aku: # its structure. A possibly previously existing definition is e288af3995 2007-12-02 aku: # dropped. To be used when a table is needed and not assumed to e288af3995 2007-12-02 aku: # exist from previous passes. e288af3995 2007-12-02 aku: e288af3995 2007-12-02 aku: typemethod extend {name definition {indices {}}} { e288af3995 2007-12-02 aku: log write 5 state "extend $name" e288af3995 2007-12-02 aku: Save "extend $name ================================" fb1e36d290 2007-10-05 aku: fb1e36d290 2007-10-05 aku: $mystate transaction { fb1e36d290 2007-10-05 aku: catch { $mystate eval "DROP TABLE $name" } fb1e36d290 2007-10-05 aku: $mystate eval "CREATE TABLE $name ( $definition )" 74854a30b8 2007-12-02 aku: 74854a30b8 2007-12-02 aku: set id 0 74854a30b8 2007-12-02 aku: foreach columns $indices { e288af3995 2007-12-02 aku: log write 5 state "index $name$id" 74854a30b8 2007-12-02 aku: 74854a30b8 2007-12-02 aku: $mystate eval "CREATE INDEX ${name}$id ON ${name} ( [join $columns ,] )" 74854a30b8 2007-12-02 aku: incr id 74854a30b8 2007-12-02 aku: } fb1e36d290 2007-10-05 aku: } fb1e36d290 2007-10-05 aku: return fb1e36d290 2007-10-05 aku: } fb1e36d290 2007-10-05 aku: e288af3995 2007-12-02 aku: # Declare that a table is needed for reading from and/or storing e288af3995 2007-12-02 aku: # to persistent state, and is assumed to already exist. A missing e288af3995 2007-12-02 aku: # table is an internal error causing an immediate exit. e288af3995 2007-12-02 aku: e288af3995 2007-12-02 aku: typemethod use {name} { e288af3995 2007-12-02 aku: log write 5 state "use $name" e288af3995 2007-12-02 aku: Save "use $name ===================================" fb1e36d290 2007-10-05 aku: fb1e36d290 2007-10-05 aku: set found [llength [$mystate eval { fb1e36d290 2007-10-05 aku: SELECT name fb1e36d290 2007-10-05 aku: FROM sqlite_master fb1e36d290 2007-10-05 aku: WHERE type = 'table' fb1e36d290 2007-10-05 aku: AND name = $name fb1e36d290 2007-10-05 aku: ; fb1e36d290 2007-10-05 aku: }]] fb1e36d290 2007-10-05 aku: 47d52d1efd 2007-11-28 aku: # No assert, would cause cycle in package dependencies 47d52d1efd 2007-11-28 aku: if {$found} return fb1e36d290 2007-10-05 aku: trouble internal "The required table \"$name\" is not defined." fb1e36d290 2007-10-05 aku: # Not reached fb1e36d290 2007-10-05 aku: return fb1e36d290 2007-10-05 aku: } fb1e36d290 2007-10-05 aku: ae19c0fcb4 2007-10-13 aku: typemethod discard {name} { ae19c0fcb4 2007-10-13 aku: # Method for a user to remove outdated information from the ae19c0fcb4 2007-10-13 aku: # persistent state, table by table. ae19c0fcb4 2007-10-13 aku: e288af3995 2007-12-02 aku: log write 5 state "discard $name" ae19c0fcb4 2007-10-13 aku: ae19c0fcb4 2007-10-13 aku: $mystate transaction { ae19c0fcb4 2007-10-13 aku: catch { $mystate eval "DROP TABLE $name" } ae19c0fcb4 2007-10-13 aku: } ae19c0fcb4 2007-10-13 aku: return ae19c0fcb4 2007-10-13 aku: } ae19c0fcb4 2007-10-13 aku: fb1e36d290 2007-10-05 aku: typemethod run {args} { e288af3995 2007-12-02 aku: Save $args fb1e36d290 2007-10-05 aku: return [uplevel 1 [linsert $args 0 $mystate eval]] 96b7bfb834 2007-11-16 aku: } 96b7bfb834 2007-11-16 aku: 96b7bfb834 2007-11-16 aku: typemethod one {args} { e288af3995 2007-12-02 aku: Save $args e288af3995 2007-12-02 aku: return [uplevel 1 [linsert $args 0 $mystate onecolumn]] 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 042d54bae5 2007-10-05 aku: typemethod transaction {script} { 042d54bae5 2007-10-05 aku: return [uplevel 1 [list $mystate transaction $script]] 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 042d54bae5 2007-10-05 aku: typemethod id {} { 042d54bae5 2007-10-05 aku: return [$mystate last_insert_rowid] 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: e288af3995 2007-12-02 aku: typemethod savequeriesto {path} { e288af3995 2007-12-02 aku: set mysavepath $path e288af3995 2007-12-02 aku: return e288af3995 2007-12-02 aku: } e288af3995 2007-12-02 aku: e288af3995 2007-12-02 aku: # # ## ### ##### ######## ############# e288af3995 2007-12-02 aku: e288af3995 2007-12-02 aku: proc Save {text} { e288af3995 2007-12-02 aku: ::variable mysavepath e288af3995 2007-12-02 aku: if {$mysavepath eq ""} return e288af3995 2007-12-02 aku: fileutil::appendToFile $mysavepath $text\n\n e288af3995 2007-12-02 aku: return fb1e36d290 2007-10-05 aku: } fb1e36d290 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# eb656de7d9 2007-10-05 aku: ## State eb656de7d9 2007-10-05 aku: e288af3995 2007-12-02 aku: typevariable mystate {} ; # Sqlite database (command) holding the converter state. e288af3995 2007-12-02 aku: typevariable mypath {} ; # Path to the database, for cleanup of a temp database. e288af3995 2007-12-02 aku: typevariable mysavepath {} ; # Path where to save queries for introspection. eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# eb656de7d9 2007-10-05 aku: ## Internal methods eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# eb656de7d9 2007-10-05 aku: ## Configuration eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: pragma -hasinstances no ; # singleton eb656de7d9 2007-10-05 aku: pragma -hastypeinfo no ; # no introspection eb656de7d9 2007-10-05 aku: pragma -hastypedestroy no ; # immortal eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: namespace eval ::vc::fossil::import::cvs { eb656de7d9 2007-10-05 aku: namespace export state eb656de7d9 2007-10-05 aku: namespace eval state { eb656de7d9 2007-10-05 aku: namespace import ::vc::tools::trouble eb656de7d9 2007-10-05 aku: namespace import ::vc::tools::log eb656de7d9 2007-10-05 aku: log register state eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: } eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: # # ## ### ##### ######## ############# ##################### eb656de7d9 2007-10-05 aku: ## Ready eb656de7d9 2007-10-05 aku: eb656de7d9 2007-10-05 aku: package provide vc::fossil::import::cvs::state 1.0 eb656de7d9 2007-10-05 aku: return
File Annotation