Fossil

Check-in [52f22540]
Login

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

Overview
Comment:Continued work on pass I. Filled in the repository management, and basic implementation of project objects. Missing are persistence and the foundation for that (cache database).
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:52f2254007f2215da3639887185db73df661d60a
User & Date: aku 2007-10-04 04:34:59
Context
2007-10-05
05:33
Added the basic parts of the state manager and integrated it with option processor and pass manager. check-in: eb656de7 user: aku tags: trunk
2007-10-04
04:34
Continued work on pass I. Filled in the repository management, and basic implementation of project objects. Missing are persistence and the foundation for that (cache database). check-in: 52f22540 user: aku tags: trunk
04:32
Extended option processing, added handling of verbosity/quietness. check-in: 2929a438 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to tools/cvs2fossil/lib/c2f_pcollar.tcl.

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
...
131
132
133
134
135
136
137

138
139
140
141
142
143
144
145
    ## Public API

    typemethod setup {} {
	# TODO ... artifact/cache - drop projects/files, create projects/files
    }

    typemethod run {} {

	foreach project [repository projects] {
	    set base [$project base]
	    log write 1 collar "Scan $base"

	    set traverse [fileutil::traverse %AUTO% $base]
	    set n 0
	    set r {}

	    $traverse foreach path {
................................................................................
		set rcs [fileutil::stripPath $base $path]
		if {[IsCVSAdmin    $rcs]}  continue
		if {![IsRCSArchive $path]} continue

		set usr [UserPath $rcs isattic]
		if {[IsSuperceded $base $rcs $usr $isattic]} continue

		log write 1 collar "Found   $rcs"
		$project add $rcs $usr

		incr n

		log progress 0 collar $n {}

	    }

	    $traverse destroy
	}





	return
    }

    typemethod ignore_conflicting_attics {} {
	set ignore 1
	return
    }

    # # ## ### ##### ######## #############
    ## Internal methods

    typevariable ignore 0

    proc IsRCSArchive {path} {
	if {![string match *,v $path]}     {return 0}
	if {[fileutil::test $path fr msg]} {return 1}
	trouble warn $msg
	return 0
    }

    proc IsCVSAdmin {rcs} {
	if {![string match CVSROOT/* $rcs]} {return 0}
	log write 2 collar "Ignored $rcs, administrative archive"
	return 1
    }

    proc UserPath {rcs iav} {
	upvar 1 $iav isattic

	# Derive the user-visible path from the rcs path. Meaning:
................................................................................
	# the same user visible file. Ignore the file in the Attic.
	#
	# By default this is a problem causing an abort after the pass
	# has completed. The user can however force us to ignore it.
	# In that case the warning is still printed, but will not
	# induce an abort any longer.


	if {$ignore} {
	    log write 2 collar "Ignored $rcs, superceded archive"
	} else {
	    trouble warn       "Ignored $rcs, superceded archive"
	}
	return 1
    }








>

|







 







|



>
|
>




>
>
>
>
>




|






|










|







 







>
|







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
...
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
    ## Public API

    typemethod setup {} {
	# TODO ... artifact/cache - drop projects/files, create projects/files
    }

    typemethod run {} {
	set rbase [repository base?]
	foreach project [repository projects] {
	    set base [file join $rbase [$project base]]
	    log write 1 collar "Scan $base"

	    set traverse [fileutil::traverse %AUTO% $base]
	    set n 0
	    set r {}

	    $traverse foreach path {
................................................................................
		set rcs [fileutil::stripPath $base $path]
		if {[IsCVSAdmin    $rcs]}  continue
		if {![IsRCSArchive $path]} continue

		set usr [UserPath $rcs isattic]
		if {[IsSuperceded $base $rcs $usr $isattic]} continue

		log write 4 collar "Found   $rcs"
		$project add $rcs $usr

		incr n
		if {[log verbosity?] < 4} {
		    log progress 0 collar $n {}
		}
	    }

	    $traverse destroy
	}

	repository printstatistics
	repository persist

	log write 1 collar "Scan completed"
	return
    }

    typemethod ignore_conflicting_attics {} {
	set myignore 1
	return
    }

    # # ## ### ##### ######## #############
    ## Internal methods

    typevariable myignore 0

    proc IsRCSArchive {path} {
	if {![string match *,v $path]}     {return 0}
	if {[fileutil::test $path fr msg]} {return 1}
	trouble warn $msg
	return 0
    }

    proc IsCVSAdmin {rcs} {
	if {![string match CVSROOT/* $rcs]} {return 0}
	log write 4 collar "Ignored $rcs, administrative archive"
	return 1
    }

    proc UserPath {rcs iav} {
	upvar 1 $iav isattic

	# Derive the user-visible path from the rcs path. Meaning:
................................................................................
	# the same user visible file. Ignore the file in the Attic.
	#
	# By default this is a problem causing an abort after the pass
	# has completed. The user can however force us to ignore it.
	# In that case the warning is still printed, but will not
	# induce an abort any longer.

	upvar 1 myignore myignore
	if {$myignore} {
	    log write 2 collar "Ignored $rcs, superceded archive"
	} else {
	    trouble warn       "Ignored $rcs, superceded archive"
	}
	return 1
    }

Added tools/cvs2fossil/lib/c2f_project.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
## -*- 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
# # ## ### ##### ######## ############# #####################

## Project, part of a CVS repository. Multiple instances are possible.

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

package require Tcl 8.4                          ; # Required runtime.
package require snit                             ; # OO system.

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

snit::type ::vc::fossil::import::cvs::project {
    # # ## ### ##### ######## #############
    ## Public API

    constructor {path} {
	set mybase $path
	return
    }

    method base {} { return $mybase }

    method printbase {} {
	if {$mybase eq ""} {return <Repository>}
	return $mybase
    }

    method add {rcs usr} {
	set myfiles($rcs) $usr
	return
    }

    method files {} {
	return [array names myfiles]
    }

    # # ## ### ##### ######## #############
    ## State

    variable mybase         {} ; # Project directory
    variable myfiles -array {} ; # Maps rcss archive to their user files.

    # # ## ### ##### ######## #############
    ## Internal methods

    pragma -hastypeinfo    no  ; # no type introspection
    pragma -hasinfo        no  ; # no object introspection
    pragma -hastypemethods no  ; # type is not relevant.
    pragma -simpledispatch yes ; # simple fast dispatch

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

namespace eval ::vc::fossil::import::cvs {
    namespace export project
}

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

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

Changes to tools/cvs2fossil/lib/c2f_repository.tcl.

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
..
46
47
48
49
50
51
52

53
54

55
56
57
58
59
60
61
62
63
# # ## ### ##### ######## ############# #####################

## Repository manager. Keeps projects and their files around.

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

package require Tcl 8.4                             ; # Required runtime.
package require snit                                ; # OO system.






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

snit::type ::vc::fossil::import::cvs::repository {
    # # ## ### ##### ######## #############
    ## Public API

    typemethod base {path} {



    }

    typemethod add {path} {




    }

    typemethod projects {} {


    }





    typemethod validate {} {
























































































































    }

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

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
................................................................................

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

namespace eval ::vc::fossil::import::cvs {
    namespace export repository
    namespace eval repository {

	#namespace import ::vc::tools::trouble
	#namespace import ::vc::tools::log

	#log register collar
    }
}

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

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







|
|
>
>
>
>
>









>
>
>



>
>
>
>



>
>
|
>
|
>
>
>

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







 







>
|
|
>
|








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
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
...
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
# # ## ### ##### ######## ############# #####################

## Repository manager. Keeps projects and their files around.

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

package require Tcl 8.4                          ; # Required runtime.
package require snit                             ; # OO system.
package require vc::tools::trouble               ; # Error reporting.
package require vc::tools::log                   ; # User feedback.
package require vc::tools::misc                  ; # Text formatting
package require vc::fossil::import::cvs::project ; # CVS projects
package require struct::list                     ; # List operations.

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

snit::type ::vc::fossil::import::cvs::repository {
    # # ## ### ##### ######## #############
    ## Public API

    typemethod base {path} {
	# Could be checked, easier to defer to the overall validation.
	set mybase $path
	return
    }

    typemethod add {path} {
	# Cannot be checked immediately, the base is not known while
	# projects are added.
	lappend myprojpaths $path
	return
    }

    typemethod projects {} {
	# TODO: Loading from the state database if CollAr is skipped
	# in a run.

	return [TheProjects]
    }

    typemethod base? {} { return $mybase }

    typemethod validate {} {
	if {![IsRepositoryBase $mybase msg]} {
	    trouble fatal $msg
	    # Without a good base directory checking any projects is
	    # wasted time, so we leave now.
	    return
	}
	foreach pp $myprojpaths {
	    if {![IsProjectBase $mybase/$pp $mybase/CVSROOT msg]} {
		trouble fatal $msg
	    }
	}
	return
    }

    typemethod printstatistics {} {
	set prlist [TheProjects]
	set npr [llength $prlist]

	log write 2 repository "Scanned [nsp $npr project]"

	if {$npr > 1} {
	    set  bmax [max [struct::list map $prlist [myproc .BaseLength]]]
	    incr bmax 2
	    set  bfmt %-${bmax}s

	    set  nmax [max [struct::list map $prlist [myproc .NFileLength]]]
	    set  nfmt %${nmax}s
	} else {
	    set bfmt %s
	    set nfmt %s
	}

	set keep {}
	foreach p $prlist {
	    set nfiles [llength [$p files]]
	    set line "Project [format $bfmt \"[$p printbase]\"] : [format $nfmt $nfiles] [sp $nfiles file]"
	    if {$nfiles < 1} {
		append line ", dropped"
	    } else {
		lappend keep $p
	    }
	    log write 2 repository $line
	}

	if {![llength $keep]} {
	    trouble warn "Dropped all projects"
	} elseif {$npr == [llength $keep]} {
	    log write 2 repository "Keeping all projects"
	} else {
	    log write 2 repository "Keeping [nsp [llength $keep] project]"
	    trouble warn "Dropped [nsp [expr {$npr - [llength $keep]}] {empty project}]"
	}

	# Keep reduced set of projects.
	set projects $keep
	return
    }

    typemethod persist {} {
    }

    # # ## ### ##### ######## #############
    ## State

    typevariable mybase      {}
    typevariable myprojpaths {}
    typevariable myprojects  {}

    # # ## ### ##### ######## #############
    ## Internal methods

    proc .BaseLength {p} {
	return [string length [$p printbase]]
    }

    proc .NFileLength {p} {
	return [string length [llength [$p files]]]
    }

    proc IsRepositoryBase {path mv} {
	upvar 1 $mv msg mybase mybase
	if {![fileutil::test $mybase         edr msg {CVS Repository}]}      {return 0}
	if {![fileutil::test $mybase/CVSROOT edr msg {CVS Admin Directory}]} {return 0}
	return 1
    }

    proc IsProjectBase {path admin mv} {
	upvar 1 $mv msg
	if {![fileutil::test $path edr msg Project]} {return 0}
	if {
	    ($path eq $admin) ||
	    [string match $admin/* $path]
	} {
	    set msg "Administrative subdirectory $path cannot be a project"
	    return 0
	}
	return 1
    }

    proc TheProjects {} {
	upvar 1 myprojects myprojects myprojpaths myprojpaths mybase mybase

	if {![llength $myprojects]} {
	    set myprojects [EmptyProjects $myprojpaths]
	}
	return $myprojects
    }

    proc EmptyProjects {projpaths} {
	upvar 1 mybase mybase
	set res {}
	if {[llength $projpaths]} {
	    foreach pp $projpaths {
		lappend res [project %AUTO% $pp]
	    }
	} else {
	    # Base is the single project.
	    lappend res [project %AUTO% ""]
	}
	return $res
    }

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

    pragma -hasinstances   no ; # singleton
    pragma -hastypeinfo    no ; # no introspection
................................................................................

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

namespace eval ::vc::fossil::import::cvs {
    namespace export repository
    namespace eval repository {
	namespace import ::vc::fossil::import::cvs::project
	namespace import ::vc::tools::trouble
	namespace import ::vc::tools::log
	namespace import ::vc::tools::misc::*
	log register repository
    }
}

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

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

Changes to tools/cvs2fossil/lib/cvs2fossil.tcl.

27
28
29
30
31
32
33

34
35
36
37
38
39
40
..
43
44
45
46
47
48
49


50
51
52
53
54
55
56
package require vc::fossil::import::cvs::pass::collar ; # Coll'ect AR'chives.

# # ## ### ##### ######## ############# #####################
## Support for passes etc.

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







>







 







>
>







27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
package require vc::fossil::import::cvs::pass::collar ; # Coll'ect AR'chives.

# # ## ### ##### ######## ############# #####################
## Support for passes etc.

package require vc::fossil::import::cvs::option ; # Cmd line parsing & database
package require vc::fossil::import::cvs::pass   ; # Pass management
package require vc::tools::log                  ; # User feedback

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

snit::type ::vc::fossil::import::cvs {
    # # ## ### ##### ######## #############
    ## Public API, Methods
................................................................................
	# 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

	vc::tools::log write 0 cvs2fossil Done
	return
    }

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

    pragma -hasinstances   no ; # singleton

Added tools/cvs2fossil/lib/misc.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
## -*- 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
# # ## ### ##### ######## ############# #####################

## Utilities for various things: text formatting, max, ...

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

package require Tcl 8.4 ; # Required runtime

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

namespace eval ::vc::tools::misc {
    # # ## ### ##### ######## #############
    ## Public API, Methods

    # Choose singular vs plural forms of a word based on a number.

    proc sp {n singular {plural {}}} {
	if {$n == 1} {return $singular}
	if {$plural eq ""} {set plural ${singular}s}
	return $plural
    }

    # As above, with the number automatically put in front of the
    # string.

    proc nsp {n singular {plural {}}} {
	return "$n [sp $n $singular $plural]"
    }

    # Find maximum in a list.

    proc max {list} {
	set max -1
	foreach e $list {
	    if {$e < $max} continue
	    set max $e
	}
	return $max
    }

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

namespace eval ::vc::tools::misc {
    namespace export sp nsp max
}

# -----------------------------------------------------------------------------
# Ready

package provide vc::tools::misc 1.0
return

Changes to tools/cvs2fossil/lib/pkgIndex.tcl.

4
5
6
7
8
9
10

11
12


# # ## ### ##### ######## ############# #####################
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::fossil::import::cvs::pass::collar 1.0 [list source [file join $dir c2f_pcollar.tcl]]
package ifneeded vc::fossil::import::cvs::repository   1.0 [list source [file join $dir c2f_repository.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]]









>


>
>
4
5
6
7
8
9
10
11
12
13
14
15
# # ## ### ##### ######## ############# #####################
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::fossil::import::cvs::pass::collar 1.0 [list source [file join $dir c2f_pcollar.tcl]]
package ifneeded vc::fossil::import::cvs::repository   1.0 [list source [file join $dir c2f_repository.tcl]]
package ifneeded vc::fossil::import::cvs::project      1.0 [list source [file join $dir c2f_project.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]]
package ifneeded vc::tools::misc                       1.0 [list source [file join $dir misc.tcl]]

Changes to tools/cvs2fossil/lib/trouble.tcl.

56
57
58
59
60
61
62







63
64
65
66
67
68
69
70

    typemethod abort? {} {
	if {
	    ![llength $myinfo] &&
	    ![llength $mywarn] &&
	    ![llength $myfatal]
	} return







	# We have error messages to print, so stop.
	exit 1
    }

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

    typevariable myinfo  {}







>
>
>
>
>
>
>
|







56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

    typemethod abort? {} {
	if {
	    ![llength $myinfo] &&
	    ![llength $mywarn] &&
	    ![llength $myfatal]
	} return

	# Frame the pending messages to make them more clear as the
	# cause of the abort.

	set     myinfo [linsert $myinfo 0 "" "Encountered problems." ""]
	lappend myfatal "Stopped due to problems."

	# We have error messages to print, so stop now.
	exit 1
    }

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

    typevariable myinfo  {}