Check-in [5911515322]
Not logged in
Overview

SHA1 Hash:591151532206cdd5d9f72335df2ff1440366bfb9
Date: 2007-10-02 06:48:55
User: aku
Comment:Added the pass management, integrated with application and option processor.
Timelines: ancestors | descendants | both | trunk
Other Links: files | ZIP archive | manifest

Tags And Properties
Changes
[hide diffs]

Modified tools/cvs2fossil/lib/c2f_option.tcl from [fc9f62797d] to [87e6ea6315].

@@ -19,10 +19,11 @@
 ## Requirements
 
 package require Tcl 8.4                         ; # Required runtime.
 package require snit                            ; # OO system.
 package require vc::tools::trouble              ; # Error reporting.
+package require vc::fossil::import::cvs::pass   ; # Pass management
 
 # # ## ### ##### ######## ############# #####################
 ##
 
 snit::type ::vc::fossil::import::cvs::option {
@@ -29,13 +30,14 @@
     # # ## ### ##### ######## #############
     ## Public API, Options.
 
     # --help, --help-passes, -h
     # --version
+    # -p, --pass, --passes
+
     # --project
     # --cache (conversion status, ala config.cache)
-
     # -o, --output
     # --dry-run
     # --trunk-only
     # --force-branch RE
     # --force-tag RE
@@ -52,13 +54,18 @@
 	# Syntax of arguments: ?option ?value?...? /path/to/cvs/repository
 
 	while {[IsOption arguments -> option]} {
 	    switch -exact -- $option {
 		-h            -
-		--help        PrintHelp
-		--help-passes PrintHelpPasses
-		--version     PrintVersion
+		--help        { PrintHelp    ; exit 0 }
+		--help-passes { pass help    ; exit 0 }
+		--version     { PrintVersion ; exit 0 }
+		-p            -
+		--pass        -
+		--passes      {
+		    pass select [Value arguments]
+		}
 		--project     {
 		    #cvs::repository addproject [Value arguments]
 		}
 		--cache       {
 		    # [Value arguments]
@@ -88,41 +95,35 @@
 	trouble info ""
 	trouble info "    -h, --help    Print this message and exit with success"
 	trouble info "    --help-passes Print list of passes and exit with success"
 	trouble info "    --version     Print version number of $argv0"
 	trouble info ""
+	trouble info "  Conversion control options"
+	trouble info ""
+	trouble info "    -p, --pass PASS            Run only the specified conversion pass"
+	trouble info "    -p, --passes ?START?:?END? Run only the passes START through END,"
+	trouble info "                               inclusive."
+	trouble info ""
+	trouble info "                               Passes are specified by name."
+	trouble info ""
 	# --project, --cache
 	# ...
-	exit 0
-    }
-
-    proc PrintHelpPasses {} {
-	trouble info ""
-	trouble info "Conversion passes:"
-	trouble info ""
-	set n 0
-	foreach {p desc} {
-	    CollectAr  {Collect archives}
-	    CollectRev {Collect revisions}
-	} { trouble info "  [format %2d $n]: $p $desc" ; incr n }
-	trouble info ""
-	exit 0
+	return
     }
 
     proc PrintVersion {} {
 	global argv0
 	set v [package require vc::fossil::import::cvs]
 	trouble info "$argv0 v$v"
-	exit 0
+	return
     }
 
     proc Usage {{text {}}} {
 	global argv0
-	if {$text ne ""} {set text \n$text}
-	trouble fatal "Usage: $argv0 $usage$text"
-	# Not reached
-	return
+	trouble fatal "Usage: $argv0 $usage"
+	if {$text ne ""} { trouble fatal "$text" }
+	exit 1
     }
 
     # # ## ### ##### ######## #############
     ## Internal methods, command line processing
 
@@ -149,10 +150,15 @@
 
     # # ## ### ##### ######## #############
     ## Internal methods, state validation
 
     proc Validate {} {
+	# Prevent in-depth validation if the options were already bad.
+	trouble abort?
+
+
+	trouble abort?
 	return
     }
 
     # # ## ### ##### ######## #############
     ## Configuration
@@ -164,12 +170,13 @@
     # # ## ### ##### ######## #############
 }
 
 namespace eval ::vc::fossil::import::cvs::option {
     namespace import ::vc::tools::trouble
+    namespace import ::vc::fossil::import::cvs::pass
 }
 
 # # ## ### ##### ######## ############# #####################
 ## Ready
 
 package provide vc::fossil::import::cvs::option 1.0
 return

Added tools/cvs2fossil/lib/c2f_pass.tcl version [2ca003bd9b]

@@ -1,1 +1,165 @@
+## -*- 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::tools::trouble              ; # Error reporting.
+package require struct::list                    ; # Portable lassign
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::fossil::import::cvs::pass {
+    # # ## ### ##### ######## #############
+    ## Public API, Methods (Setup, query)
+
+    typemethod define {name description command} {
+	if {[info exists mydesc($name)]} {
+	    trouble internal "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
+	foreach code $mypasses {
+	    trouble info "  [format %2d $n]: $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 end]
+		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 end}
+
+	set runlist [lrange $mypasses $mystart $myend]
+	# TODO: Timing statistics for the passes.
+	# TODO: Artifact manager (clean after pass?. need to know skipped/defered passes ?)
+	# TODO:
+	# TODO:
+
+	foreach p $runlist { Call $p setup }
+	foreach p $runlist { Call $p run   }
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ## Internal methods
+
+    proc Ok? {code label ov {emptyok 1}} {
+	upvar 1 mydesc mydesc $ov ok
+	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} {
+	upvar 1 mypasses mypasses
+	return [expr {($code eq "") ? $default : [Id $code]}]
+    }
+
+    proc Id {code} {
+	upvar 1 mypasses mypasses
+	return [lsearch -exact $mypasses $code]
+    }
+
+    proc Call {code args} {
+	upvar 1 mycmd mycmd
+	set cmd $mycmd($code)
+	foreach a $args { lappend cmd $a }
+	eval $a
+	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
+
+    # # ## ### ##### ######## #############
+    ## 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::tools::trouble }
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
 
+package provide vc::fossil::import::cvs::pass 1.0
+return

Modified tools/cvs2fossil/lib/cvs2fossil.tcl from [2ea7561a94] to [5cf11cf591].

@@ -17,30 +17,27 @@
 ## Requirements
 
 package require Tcl 8.4                         ; # Required runtime.
 package require snit                            ; # OO system
 package require vc::fossil::import::cvs::option ; # Cmd line parsing & database
+package require vc::fossil::import::cvs::pass   ; # Pass management
 
 # # ## ### ##### ######## ############# #####################
 ##
 
 snit::type ::vc::fossil::import::cvs {
     # # ## ### ##### ######## #############
     ## Public API, Methods
 
     typemethod run {arguments} {
-	option process $arguments
-
 	# Run a series of passes over the cvs repository to extract,
 	# filter, and order its historical information. Which passes
 	# are actually run is determined through the specified options
 	# and their defaults.
 
-	foreach pass [option passes] {
-	    $pass run
-	}
-
+	option process $arguments
+	pass run
 	return
     }
 
     # # ## ### ##### ######## #############
     ## Configuration

Modified tools/cvs2fossil/lib/pkgIndex.tcl from [6725ddc053] to [d90ebe99e1].

@@ -3,7 +3,8 @@
 ## Index of the local packages required by cvs2fossil
 # # ## ### ##### ######## ############# #####################
 if {![package vsatisfies [package require Tcl] 8.4]} return
 package ifneeded vc::fossil::import::cvs         1.0 [list source [file join $dir cvs2fossil.tcl]]
 package ifneeded vc::fossil::import::cvs::option 1.0 [list source [file join $dir c2f_option.tcl]]
+package ifneeded vc::fossil::import::cvs::pass   1.0 [list source [file join $dir c2f_pass.tcl]]
 package ifneeded vc::tools::trouble              1.0 [list source [file join $dir trouble.tcl]]
 package ifneeded vc::tools::log                  1.0 [list source [file join $dir log.tcl]]

Modified tools/cvs2fossil/lib/trouble.tcl from [fdf622fa20] to [a28d3a5333].

@@ -24,13 +24,18 @@
 
 snit::type ::vc::tools::trouble {
     # # ## ### ##### ######## #############
     ## Public API, Methods
 
+    typemethod internal {text} {
+	foreach line [split $text \n] { $type fatal "INTERNAL ERROR! $line" }
+	exit 1
+    }
+
     typemethod fatal {text} {
 	lappend myfatal $text
-	exit 1
+	return
     }
 
     typemethod warn {text} {
 	lappend mywarn $text
 	log write 0 trouble $text
@@ -45,10 +50,20 @@
     typemethod show {} {
 	foreach m $myinfo  { log write 0 ""      $m }
 	foreach m $mywarn  { log write 0 warning $m }
 	foreach m $myfatal { log write 0 fatal   $m }
 	return
+    }
+
+    typemethod abort? {} {
+	if {
+	    ![llength $myinfo] &&
+	    ![llength $mywarn] &&
+	    ![llength $myfatal]
+	} return
+	# We have error messages to print, so stop.
+	exit 1
     }
 
     # # ## ### ##### ######## #############
     ## Internal, state