initial commitHEADmaster

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