Fossil

Check-in [5911515322]
Login

Check-in [5911515322]

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Added the pass management, integrated with application and option processor.
Downloads: Tarball | ZIP archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 591151532206cdd5d9f72335df2ff1440366bfb9
User & Date: aku 2007-10-02 06:48:55.000
Context
2007-10-03
04:18
Added stub for repository management, added most of pass I, collecting archives in the repository. ... (check-in: 47740cc1f6 user: aku tags: trunk)
2007-10-02
06:48
Added the pass management, integrated with application and option processor. ... (check-in: 5911515322 user: aku tags: trunk)
05:33
Re-added the user feedback and error reporting utilities, with modifications, and completed the handling of the informational options. ... (check-in: d57b7b4a05 user: aku tags: trunk)
Changes
Unified Diff Ignore Whitespace Patch
Changes to tools/cvs2fossil/lib/c2f_option.tcl.
︙︙
17
18
19
20
21
22
23

24
25
26
27
28
29
30
31
32
33


34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59





60
61
62
63
64
65
66


# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                         ; # Required runtime.
package require snit                            ; # OO system.
package require vc::tools::trouble              ; # Error reporting.


# # ## ### ##### ######## ############# #####################
## 

snit::type ::vc::fossil::import::cvs::option {
    # # ## ### ##### ######## #############
    ## Public API, Options.

    # --help, --help-passes, -h
    # --version


    # --project
    # --cache (conversion status, ala config.cache)

    # -o, --output
    # --dry-run
    # --trunk-only
    # --force-branch RE
    # --force-tag RE
    # --symbol-transform RE:XX
    # --exclude
    # -p, --passes
    # -v, --verbose
    # -q, --quiet

    # # ## ### ##### ######## #############
    ## Public API, Methods

    typemethod process {arguments} {
	# Syntax of arguments: ?option ?value?...? /path/to/cvs/repository

	while {[IsOption arguments -> option]} {
	    switch -exact -- $option {
		-h            -
		--help        PrintHelp
		--help-passes PrintHelpPasses
		--version     PrintVersion





		--project     {
		    #cvs::repository addproject [Value arguments]
		}
		--cache       {
		    # [Value arguments]
		}
		default {








>










>
>


<




















|
|
|
>
>
>
>
>








17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38

39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73


# # ## ### ##### ######## ############# #####################
## 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 {
    # # ## ### ##### ######## #############
    ## 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
    # --symbol-transform RE:XX
    # --exclude
    # -p, --passes
    # -v, --verbose
    # -q, --quiet

    # # ## ### ##### ######## #############
    ## Public API, Methods

    typemethod process {arguments} {
	# Syntax of arguments: ?option ?value?...? /path/to/cvs/repository

	while {[IsOption arguments -> option]} {
	    switch -exact -- $option {
		-h            -
		--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]
		}
		default {
︙︙
86
87
88
89
90
91
92
93
94
95
96
97
98
99


100
101
102
103
104
105
106
107

108

109
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124
125
126
127
128
129
130

	trouble info ""
	trouble info "  Information options"
	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 ""
	# --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

    }

    proc PrintVersion {} {
	global argv0
	set v [package require vc::fossil::import::cvs]
	trouble info "$argv0 v$v"
	exit 0
    }

    proc Usage {{text {}}} {
	global argv0
	if {$text ne ""} {set text \n$text}
	trouble fatal "Usage: $argv0 $usage$text"

	# Not reached
	return
    }

    # # ## ### ##### ######## #############
    ## Internal methods, command line processing

    typevariable usage     "?option ?value?...? cvs-repository-path"
    typevariable nocvs     "       The cvs-repository-path is missing."








<
<
<
<
|
<

>
>
|

<
<
<
<
|

>
|
>






|




<
|
>
|
<








93
94
95
96
97
98
99




100

101
102
103
104
105




106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121

122
123
124

125
126
127
128
129
130
131

	trouble info ""
	trouble info "  Information options"
	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
	# ...
	return
    }

    proc PrintVersion {} {
	global argv0
	set v [package require vc::fossil::import::cvs]
	trouble info "$argv0 v$v"
	return
    }

    proc Usage {{text {}}} {
	global argv0

	trouble fatal "Usage: $argv0 $usage"
	if {$text ne ""} { trouble fatal "$text" }
	exit 1

    }

    # # ## ### ##### ######## #############
    ## Internal methods, command line processing

    typevariable usage     "?option ?value?...? cvs-repository-path"
    typevariable nocvs     "       The cvs-repository-path is missing."
︙︙
147
148
149
150
151
152
153





154
155
156
157
158
159
160
161
162
163
164
165
166
167
168

169
170
171
172
173
174
175

	return $v
    }

    # # ## ### ##### ######## #############
    ## Internal methods, state validation

    proc Validate {} {





	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
    pragma -hastypedestroy no ; # immortal

    # # ## ### ##### ######## #############
}

namespace eval ::vc::fossil::import::cvs::option {
    namespace import ::vc::tools::trouble

}

# # ## ### ##### ######## ############# #####################
## Ready

package provide vc::fossil::import::cvs::option 1.0
return








>
>
>
>
>















>








148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182

	return $v
    }

    # # ## ### ##### ######## #############
    ## Internal methods, state validation

    proc Validate {} {
	# Prevent in-depth validation if the options were already bad.
	trouble abort?


	trouble abort?
	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
    pragma -hastypedestroy no ; # immortal

    # # ## ### ##### ######## #############
}

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. 












































































































































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
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
Changes to tools/cvs2fossil/lib/cvs2fossil.tcl.
︙︙
15
16
17
18
19
20
21

22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48


# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                         ; # Required runtime.
package require snit                            ; # OO system
package require vc::fossil::import::cvs::option ; # Cmd line parsing & database


# # ## ### ##### ######## ############# #####################
## 

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
	}

	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton








>









<
<





|
|
<
<








15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31


32
33
34
35
36
37
38


39
40
41
42
43
44
45


# # ## ### ##### ######## ############# #####################
## 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} {


	# 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.

	option process $arguments
	pass run


	return
    }

    # # ## ### ##### ######## #############
    ## Configuration

    pragma -hasinstances   no ; # singleton
︙︙
Changes to tools/cvs2fossil/lib/pkgIndex.tcl. 
1
2
3
4
5
6
7

8
9

# # ## ### ##### ######## ############# #####################
## Package management.
## 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::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]]








>



1
2
3
4
5
6
7
8
9
10

# # ## ### ##### ######## ############# #####################
## Package management.
## 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]]
Changes to tools/cvs2fossil/lib/trouble.tcl.
︙︙
21
22
23
24
25
26
27





28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50










51
52
53
54
55
56
57


# # ## ### ##### ######## ############# #####################
## 

snit::type ::vc::tools::trouble {
    # # ## ### ##### ######## #############
    ## Public API, Methods






    typemethod fatal {text} {
	lappend myfatal $text
	exit 1
    }

    typemethod warn {text} {
	lappend mywarn $text
	log write 0 trouble $text
	return
    }

    typemethod info {text} {
	lappend myinfo $text
	return
    }

    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
    }











    # # ## ### ##### ######## #############
    ## Internal, state

    typevariable myinfo  {}
    typevariable mywarn  {}
    typevariable myfatal {}








>
>
>
>
>



|



















>
>
>
>
>
>
>
>
>
>








21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72


# # ## ### ##### ######## ############# #####################
## 

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
	return
    }

    typemethod warn {text} {
	lappend mywarn $text
	log write 0 trouble $text
	return
    }

    typemethod info {text} {
	lappend myinfo $text
	return
    }

    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

    typevariable myinfo  {}
    typevariable mywarn  {}
    typevariable myfatal {}
︙︙