Fossil SCM

fossil-scm / tools / cvs2fossil / lib / c2f_pass.tcl
Source Blame History 243 lines
5911515… aku 1 ## -*- tcl -*-
5911515… aku 2 # # ## ### ##### ######## ############# #####################
5911515… aku 3 ## Copyright (c) 2007 Andreas Kupries.
5911515… aku 4 #
5911515… aku 5 # This software is licensed as described in the file LICENSE, which
5911515… aku 6 # you should have received as part of this distribution.
5911515… aku 7 #
5911515… aku 8 # This software consists of voluntary contributions made by many
5911515… aku 9 # individuals. For exact contribution history, see the revision
5911515… aku 10 # history and logs, available at http://fossil-scm.hwaci.com/fossil
5911515… aku 11 # # ## ### ##### ######## ############# #####################
5911515… aku 12
5911515… aku 13 ## Pass manager. All passes register here, with code, description, and
5911515… aku 14 ## callbacks (... setup, run, finalize). Option processing and help
5911515… aku 15 ## query this manager to dynamically create the relevant texts.
5911515… aku 16
5911515… aku 17 # # ## ### ##### ######## ############# #####################
5911515… aku 18 ## Requirements
5911515… aku 19
47d52d1… aku 20 package require Tcl 8.4 ; # Required runtime.
47d52d1… aku 21 package require snit ; # OO system.
47d52d1… aku 22 package require vc::fossil::import::cvs::state ; # State storage
47d52d1… aku 23 package require vc::fossil::import::cvs::integrity ; # State integrity checks.
47d52d1… aku 24 package require vc::tools::misc ; # Text formatting
47d52d1… aku 25 package require vc::tools::trouble ; # Error reporting.
47d52d1… aku 26 package require vc::tools::log ; # User feedback.
47d52d1… aku 27 package require struct::list ; # Portable lassign
5911515… aku 28
5911515… aku 29 # # ## ### ##### ######## ############# #####################
b679ca3… aku 30 ##
5911515… aku 31
5911515… aku 32 snit::type ::vc::fossil::import::cvs::pass {
5911515… aku 33 # # ## ### ##### ######## #############
5911515… aku 34 ## Public API, Methods (Setup, query)
5911515… aku 35
5911515… aku 36 typemethod define {name description command} {
47d52d1… aku 37 integrity assert {
47d52d1… aku 38 ![info exists mydesc($name)]
47d52d1… aku 39 } {Multiple definitions for pass code '$name'}
5911515… aku 40 lappend mypasses $name
5911515… aku 41 set mydesc($name) $description
5911515… aku 42 set mycmd($name) $command
5911515… aku 43 return
5911515… aku 44 }
5911515… aku 45
5911515… aku 46 typemethod help {} {
5911515… aku 47 trouble info ""
5911515… aku 48 trouble info "Conversion passes:"
5911515… aku 49 trouble info ""
5911515… aku 50 set n 0
43d72c6… aku 51
43d72c6… aku 52 set clen [max [struct::list map $mypasses {string length}]]
43d72c6… aku 53 set cfmt %-${clen}s
43d72c6… aku 54 set nfmt %[string length [llength $mypasses]]s
43d72c6… aku 55
5911515… aku 56 foreach code $mypasses {
43d72c6… aku 57 trouble info " [format $nfmt $n]: [format $cfmt $code] : $mydesc($code)"
5911515… aku 58 incr n
5911515… aku 59 }
5911515… aku 60 trouble info ""
5911515… aku 61 return
5911515… aku 62 }
5911515… aku 63
5911515… aku 64 # # ## ### ##### ######## #############
5911515… aku 65 ## Public API, Methods (Execution)
5911515… aku 66
5911515… aku 67 typemethod select {passdef} {
5911515… aku 68 set pl [split $passdef :]
5911515… aku 69 if {[llength $pl] > 2} {
5911515… aku 70 trouble fatal "Bad pass definition '$passdef'"
5911515… aku 71 trouble fatal "Expected at most one ':'"
5911515… aku 72 } elseif {[llength $pl] == 2} {
5911515… aku 73 struct::list assign $pl start end
5911515… aku 74
5911515… aku 75 if {($start eq "") && ($end eq "")} {
5911515… aku 76 trouble fatal "Specify at least one of start- or end-pass"
5911515… aku 77 set ok 0
5911515… aku 78 } else {
5911515… aku 79 set ok 1
5911515… aku 80 Ok? $start start ok
5911515… aku 81 Ok? $end end ok
5911515… aku 82 }
5911515… aku 83
5911515… aku 84 if {$ok} {
5911515… aku 85 set mystart [Convert $start 0]
9668b16… aku 86 set myend [Convert $end [expr {[llength $mypasses] - 1}]]
5911515… aku 87 if {$mystart > $myend} {
5911515… aku 88 trouble fatal "Start pass is after end pass"
5911515… aku 89 }
5911515… aku 90 }
5911515… aku 91 } elseif {[llength $pl] < 2} {
5911515… aku 92 set start [lindex $pl 0]
5911515… aku 93 Ok? $start "" __dummy__ 0
5911515… aku 94 set mystart [Id $start]
5911515… aku 95 set myend $mystart
5911515… aku 96 }
5911515… aku 97 }
5911515… aku 98
5911515… aku 99 typemethod run {} {
5911515… aku 100 if {$mystart < 0} {set mystart 0}
ae19c0f… aku 101 if {$myend < 0} {set myend [expr {[llength $mypasses] - 1}]}
ae19c0f… aku 102
ae19c0f… aku 103 set skipped [lrange $mypasses 0 [expr {$mystart - 1}]]
ae19c0f… aku 104 set run [lrange $mypasses $mystart $myend]
ae19c0f… aku 105 set defered [lrange $mypasses [expr {$myend + 1}] end]
ae19c0f… aku 106
ae19c0f… aku 107 foreach p $skipped {
b679ca3… aku 108 log write 0 pass "Skip $p"
ae19c0f… aku 109 Call $p load
ae19c0f… aku 110 }
ae19c0f… aku 111 foreach p $run {
b679ca3… aku 112 log write 0 pass "Setup $p"
47740cc… aku 113 Call $p setup
47740cc… aku 114 }
ae19c0f… aku 115 foreach p $run {
b679ca3… aku 116 log write 0 pass "Begin $p"
9a763fe… aku 117 set secbegin [clock seconds]
9a763fe… aku 118 Call $p run
9a763fe… aku 119 set secstop [clock seconds]
47740cc… aku 120 log write 0 pass "Done $p"
9a763fe… aku 121 Time $p [expr {$secstop - $secbegin}]
47740cc… aku 122 trouble abort?
ae19c0f… aku 123 }
ae19c0f… aku 124 foreach p $defered {
b679ca3… aku 125 log write 0 pass "Defer $p"
ae19c0f… aku 126 Call $p discard
eb656de… aku 127 }
eb656de… aku 128
eb656de… aku 129 state release
05f9c95… aku 130 ShowTimes
5911515… aku 131 return
5911515… aku 132 }
05f9c95… aku 133
e288af3… aku 134 typemethod current {} { return $mycurrentpass }
e288af3… aku 135
e288af3… aku 136 # # ## ### ##### ######## #############
e288af3… aku 137 ## Internal methods
e288af3… aku 138
9a763fe… aku 139 proc Time {pass seconds} {
05f9c95… aku 140 ::variable mytime
9a763fe… aku 141 lappend mytime $pass $seconds
9a763fe… aku 142 ShowTime $pass $seconds
05f9c95… aku 143 return
05f9c95… aku 144 }
05f9c95… aku 145
05f9c95… aku 146 proc ShowTimes {} {
05f9c95… aku 147 ::variable mytime
7817ff2… aku 148 set total 0
9a763fe… aku 149 foreach {pass seconds} $mytime {
9a763fe… aku 150 ShowTime $pass $seconds
7817ff2… aku 151 incr total $seconds
e288af3… aku 152 }
7817ff2… aku 153 ShowTime Total $total
e288af3… aku 154 return
e288af3… aku 155 }
e288af3… aku 156
9a763fe… aku 157 proc ShowTime {pass seconds} {
7817ff2… aku 158 if {$seconds > 3600} {
7817ff2… aku 159 set hr [expr {$seconds / 3600}]
7817ff2… aku 160 set min [expr {$seconds % 3600}]
7817ff2… aku 161 set sec [expr {$min % 60}]
7817ff2… aku 162 set min [expr {$min / 60}]
7817ff2… aku 163
7817ff2… aku 164 log write 0 pass "[format %8d $seconds] sec/$pass ([nsp $hr hour] [nsp $min minute] [nsp $sec second])"
7817ff2… aku 165 } elseif {$seconds > 60} {
7817ff2… aku 166 set min [expr {$seconds / 60}]
7817ff2… aku 167 set sec [expr {$seconds % 60}]
7817ff2… aku 168
7817ff2… aku 169 log write 0 pass "[format %8d $seconds] sec/$pass ([nsp $min minute] [nsp $sec second])"
7817ff2… aku 170 } else {
7817ff2… aku 171 log write 0 pass "[format %8d $seconds] sec/$pass"
7817ff2… aku 172 }
05f9c95… aku 173 return
05f9c95… aku 174 }
70b0aa8… aku 175
5911515… aku 176 proc Ok? {code label ov {emptyok 1}} {
70b0aa8… aku 177 upvar 1 $ov ok
70b0aa8… aku 178 ::variable mydesc
5911515… aku 179 if {$emptyok && ($code eq "")} return
5911515… aku 180 if {[info exists mydesc($code)]} return
5911515… aku 181 if {$label ne ""} {append label " "}
5911515… aku 182 trouble fatal "Bad ${label}pass code $code"
5911515… aku 183 set ok 0
5911515… aku 184 return
5911515… aku 185 }
5911515… aku 186
5911515… aku 187 proc Convert {code default} {
70b0aa8… aku 188 ::variable mypasses
5911515… aku 189 return [expr {($code eq "") ? $default : [Id $code]}]
5911515… aku 190 }
5911515… aku 191
5911515… aku 192 proc Id {code} {
70b0aa8… aku 193 ::variable mypasses
5911515… aku 194 return [lsearch -exact $mypasses $code]
5911515… aku 195 }
5911515… aku 196
5911515… aku 197 proc Call {code args} {
70b0aa8… aku 198 ::variable mycmd
5911515… aku 199 set cmd $mycmd($code)
5911515… aku 200 foreach a $args { lappend cmd $a }
47740cc… aku 201 eval $cmd
5911515… aku 202 return
5911515… aku 203 }
5911515… aku 204
5911515… aku 205 # # ## ### ##### ######## #############
5911515… aku 206 ## Internal, state
5911515… aku 207
5911515… aku 208 typevariable mypasses {} ; # List of registered passes (codes).
5911515… aku 209 typevariable mydesc -array {} ; # Pass descriptions (one line).
5911515… aku 210 typevariable mycmd -array {} ; # Pass callback command.
5911515… aku 211
e288af3… aku 212 typevariable mystart -1
e288af3… aku 213 typevariable myend -1
e288af3… aku 214 typevariable mytime {} ; # Timing data for each executed pass.
e288af3… aku 215 typevariable mycurrentpass {} ; # Pass currently running.
5911515… aku 216
5911515… aku 217 # # ## ### ##### ######## #############
5911515… aku 218 ## Configuration
5911515… aku 219
5911515… aku 220 pragma -hasinstances no ; # singleton
5911515… aku 221 pragma -hastypeinfo no ; # no introspection
5911515… aku 222 pragma -hastypedestroy no ; # immortal
5911515… aku 223
5911515… aku 224 # # ## ### ##### ######## #############
5911515… aku 225 }
5911515… aku 226
5911515… aku 227 namespace eval ::vc::fossil::import::cvs {
5911515… aku 228 namespace export pass
47740cc… aku 229 namespace eval pass {
eb656de… aku 230 namespace import ::vc::fossil::import::cvs::state
47d52d1… aku 231 namespace import ::vc::fossil::import::cvs::integrity
43d72c6… aku 232 namespace import ::vc::tools::misc::*
47740cc… aku 233 namespace import ::vc::tools::trouble
b679ca3… aku 234 namespace import ::vc::tools::log
47740cc… aku 235 log register pass
47740cc… aku 236 }
5911515… aku 237 }
5911515… aku 238
5911515… aku 239 # # ## ### ##### ######## ############# #####################
5911515… aku 240 ## Ready
5911515… aku 241
5911515… aku 242 package provide vc::fossil::import::cvs::pass 1.0
5911515… aku 243 return

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button