diff options
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_pass.tcl')
| -rw-r--r-- | tools/cvs2fossil/lib/c2f_pass.tcl | 243 |
1 files changed, 243 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/c2f_pass.tcl b/tools/cvs2fossil/lib/c2f_pass.tcl new file mode 100644 index 0000000..bd8b54a --- /dev/null +++ b/tools/cvs2fossil/lib/c2f_pass.tcl @@ -0,0 +1,243 @@ +## -*- tcl -*- +# # ## ### ##### ######## ############# ##################### +## Copyright (c) 2007 Andreas Kupries. +# +# This software is licensed as described in the file LICENSE, which +# you should have received as part of this distribution. +# +# This software consists of voluntary contributions made by many +# individuals. For exact contribution history, see the revision +# history and logs, available at http://fossil-scm.hwaci.com/fossil +# # ## ### ##### ######## ############# ##################### + +## Pass manager. All passes register here, with code, description, and +## callbacks (... setup, run, finalize). Option processing and help +## query this manager to dynamically create the relevant texts. + +# # ## ### ##### ######## ############# ##################### +## Requirements + +package require Tcl 8.4 ; # Required runtime. +package require snit ; # OO system. +package require vc::fossil::import::cvs::state ; # State storage +package require vc::fossil::import::cvs::integrity ; # State integrity checks. +package require vc::tools::misc ; # Text formatting +package require vc::tools::trouble ; # Error reporting. +package require vc::tools::log ; # User feedback. +package require struct::list ; # Portable lassign + +# # ## ### ##### ######## ############# ##################### +## + +snit::type ::vc::fossil::import::cvs::pass { + # # ## ### ##### ######## ############# + ## Public API, Methods (Setup, query) + + typemethod define {name description command} { + integrity assert { + ![info exists mydesc($name)] + } {Multiple definitions for pass code '$name'} + lappend mypasses $name + set mydesc($name) $description + set mycmd($name) $command + return + } + + typemethod help {} { + trouble info "" + trouble info "Conversion passes:" + trouble info "" + set n 0 + + set clen [max [struct::list map $mypasses {string length}]] + set cfmt %-${clen}s + set nfmt %[string length [llength $mypasses]]s + + foreach code $mypasses { + trouble info " [format $nfmt $n]: [format $cfmt $code] : $mydesc($code)" + incr n + } + trouble info "" + return + } + + # # ## ### ##### ######## ############# + ## Public API, Methods (Execution) + + typemethod select {passdef} { + set pl [split $passdef :] + if {[llength $pl] > 2} { + trouble fatal "Bad pass definition '$passdef'" + trouble fatal "Expected at most one ':'" + } elseif {[llength $pl] == 2} { + struct::list assign $pl start end + + if {($start eq "") && ($end eq "")} { + trouble fatal "Specify at least one of start- or end-pass" + set ok 0 + } else { + set ok 1 + Ok? $start start ok + Ok? $end end ok + } + + if {$ok} { + set mystart [Convert $start 0] + set myend [Convert $end [expr {[llength $mypasses] - 1}]] + if {$mystart > $myend} { + trouble fatal "Start pass is after end pass" + } + } + } elseif {[llength $pl] < 2} { + set start [lindex $pl 0] + Ok? $start "" __dummy__ 0 + set mystart [Id $start] + set myend $mystart + } + } + + typemethod run {} { + if {$mystart < 0} {set mystart 0} + if {$myend < 0} {set myend [expr {[llength $mypasses] - 1}]} + + set skipped [lrange $mypasses 0 [expr {$mystart - 1}]] + set run [lrange $mypasses $mystart $myend] + set defered [lrange $mypasses [expr {$myend + 1}] end] + + foreach p $skipped { + log write 0 pass "Skip $p" + Call $p load + } + foreach p $run { + log write 0 pass "Setup $p" + Call $p setup + } + foreach p $run { + log write 0 pass "Begin $p" + set secbegin [clock seconds] + Call $p run + set secstop [clock seconds] + log write 0 pass "Done $p" + Time $p [expr {$secstop - $secbegin}] + trouble abort? + } + foreach p $defered { + log write 0 pass "Defer $p" + Call $p discard + } + + state release + ShowTimes + return + } + + typemethod current {} { return $mycurrentpass } + + # # ## ### ##### ######## ############# + ## Internal methods + + proc Time {pass seconds} { + ::variable mytime + lappend mytime $pass $seconds + ShowTime $pass $seconds + return + } + + proc ShowTimes {} { + ::variable mytime + set total 0 + foreach {pass seconds} $mytime { + ShowTime $pass $seconds + incr total $seconds + } + ShowTime Total $total + return + } + + proc ShowTime {pass seconds} { + if {$seconds > 3600} { + set hr [expr {$seconds / 3600}] + set min [expr {$seconds % 3600}] + set sec [expr {$min % 60}] + set min [expr {$min / 60}] + + log write 0 pass "[format %8d $seconds] sec/$pass ([nsp $hr hour] [nsp $min minute] [nsp $sec second])" + } elseif {$seconds > 60} { + set min [expr {$seconds / 60}] + set sec [expr {$seconds % 60}] + + log write 0 pass "[format %8d $seconds] sec/$pass ([nsp $min minute] [nsp $sec second])" + } else { + log write 0 pass "[format %8d $seconds] sec/$pass" + } + return + } + + proc Ok? {code label ov {emptyok 1}} { + upvar 1 $ov ok + ::variable mydesc + if {$emptyok && ($code eq "")} return + if {[info exists mydesc($code)]} return + if {$label ne ""} {append label " "} + trouble fatal "Bad ${label}pass code $code" + set ok 0 + return + } + + proc Convert {code default} { + ::variable mypasses + return [expr {($code eq "") ? $default : [Id $code]}] + } + + proc Id {code} { + ::variable mypasses + return [lsearch -exact $mypasses $code] + } + + proc Call {code args} { + ::variable mycmd + set cmd $mycmd($code) + foreach a $args { lappend cmd $a } + eval $cmd + return + } + + # # ## ### ##### ######## ############# + ## Internal, state + + typevariable mypasses {} ; # List of registered passes (codes). + typevariable mydesc -array {} ; # Pass descriptions (one line). + typevariable mycmd -array {} ; # Pass callback command. + + typevariable mystart -1 + typevariable myend -1 + typevariable mytime {} ; # Timing data for each executed pass. + typevariable mycurrentpass {} ; # Pass currently running. + + # # ## ### ##### ######## ############# + ## Configuration + + pragma -hasinstances no ; # singleton + pragma -hastypeinfo no ; # no introspection + pragma -hastypedestroy no ; # immortal + + # # ## ### ##### ######## ############# +} + +namespace eval ::vc::fossil::import::cvs { + namespace export pass + namespace eval pass { + namespace import ::vc::fossil::import::cvs::state + namespace import ::vc::fossil::import::cvs::integrity + namespace import ::vc::tools::misc::* + namespace import ::vc::tools::trouble + namespace import ::vc::tools::log + log register pass + } +} + +# # ## ### ##### ######## ############# ##################### +## Ready + +package provide vc::fossil::import::cvs::pass 1.0 +return |