Fossil SCM

Added structure to the CVS frontend code, putting the repository traversal into its own package.

aku 2007-09-17 01:43 trunk
Commit 6f121db1e2d4ebc1051ce20f35a3f9f74eb0c628
Parent ebb94f75cb229fd…
3 files changed +11 -62 +49 +1
~ tools/lib/cvs.tcl + tools/lib/cvs_files.tcl ~ tools/lib/pkgIndex.tcl
M tools/lib/cvs.tcl
+11 -62
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,14 +3,15 @@
33
44
 # -----------------------------------------------------------------------------
55
 # Requirements
66
77
 package require Tcl 8.4
8
-package require fileutil ; # Tcllib (traverse directory hierarchy)
9
-package require vc::rcs::parser ; # Handling the RCS archive files.
10
-package require vc::tools::log ; # User feedback
11
-package require vc::cvs::cmd ; # Access to cvs application.
8
+package require fileutil ; # Tcllib (traverse directory hierarchy)
9
+package require vc::rcs::parser ; # Handling the RCS archive files.
10
+package require vc::tools::log ; # User feedback
11
+package require vc::cvs::cmd ; # Access to cvs application.
12
+package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
1213
 package require struct::tree
1314
1415
 namespace eval ::vc::cvs::ws {
1516
 vc::tools::log::system cvs
1617
 namespace import ::vc::tools::log::write
@@ -145,71 +146,25 @@
145146
 # information (file, revision -> date, author, commit message)
146147
147148
 proc ::vc::cvs::ws::scan {} {
148149
 variable project
149150
 variable base
150
- variable npaths
151
- variable rpaths
152151
 variable timeline
153152
154
- write 0 cvs {Scanning directory hierarchy}
155
-
156153
 set n 0
157154
 set d $base ; if {$project ne ""} {append d /$project}
158155
159
- ::foreach rcs [fileutil::findByPattern $d -glob *,v] {
160
- set rcs [fileutil::stripPath $d $rcs]
161
- # Now rcs is relative to base/project
162
-
163
- write 1 cvs "Archive $rcs"
164
-
165
- if {[string match CVSROOT/* $rcs]} {
166
- write 2 cvs {Ignored. Administrative file}
167
- continue
168
- }
169
-
170
- # Derive the regular path from the rcs path. Meaning: Chop of
171
- # the ",v" suffix, and remove a possible "Attic".
172
- set f [string range $rcs 0 end-2]
173
- if {"Attic" eq [lindex [file split $rcs] end-1]} {
174
-
175
- # The construction below ensures that Attic/X maps to X
176
- # instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
177
-
178
- set fx [file dirname [file dirname $f]]
179
- set f [file tail $f]
180
- if {$fx ne "."} { set f [file join $fx $f] }
181
-
182
- if {[file exists $d/$f,v]} {
183
- # We have a regular archive and an Attic archive
184
- # refering to the same user visible file. Ignore the
185
- # file in the Attic.
186
-
187
- write 2 cvs "Ignored. Attic superceded by regular archive"
188
-
189
- # TODO/CHECK. My method of co'ing exact file revisions
190
- # per the info in the collected csets has the flaw
191
- # that I may have to know exactly when what archive
192
- # file to use, see above. It might be better to use
193
- # the info only to gather when csets begin and end,
194
- # and then to co complete slices per exact timestamp
195
- # (-D) instead of file revisions (-r). The flaw in
196
- # that is that csets can occur in the same second
197
- # (trf, memchan - check for examples). For that exact
198
- # checkout may be needed to recreate exact sequence of
199
- # changes. Grr. Six of one ...
200
-
201
- continue
202
- }
203
- }
156
+ set files [::vc::cvs::ws::files::find $d]
157
+
158
+ write 0 cvs "Scanning archives ..."
159
+
160
+ ::foreach {rcs f} $files {
161
+ write 1 cvs "Archive $rcs"
204162
205163
 # Get the meta data we need (revisions, timeline, messages).
206164
 set meta [process $d/$rcs]
207165
208
- set npaths($rcs) $f
209
- set rpaths($f) $rcs
210
-
211166
 array set p $meta
212167
213168
 ::foreach {rev ts} $p(date) {_ a} $p(author) {_ cm} $p(commit) {_ st} $p(state) {
214169
 set op [expr {($rev eq "1.1") ? "A" : "M"}]
215170
 if {$st eq "dead"} {set op "R"}
@@ -236,16 +191,10 @@
236191
 write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]"
237192
 return
238193
 }
239194
240195
 namespace eval ::vc::cvs::ws {
241
- # Path mappings. npaths: rcs file -> user file
242
- # rpaths: user file -> rcs file, dead-status
243
-
244
- variable npaths ; array set npaths {}
245
- variable rpaths ; array set rpaths {}
246
-
247196
 # Timeline: tstamp -> (op, tstamp, author, revision, file, commit message)
248197
249198
 variable timeline ; array set timeline {}
250199
 }
251200
252201
253202
ADDED tools/lib/cvs_files.tcl
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,14 +3,15 @@
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8 package require fileutil ; # Tcllib (traverse directory hierarchy)
9 package require vc::rcs::parser ; # Handling the RCS archive files.
10 package require vc::tools::log ; # User feedback
11 package require vc::cvs::cmd ; # Access to cvs application.
 
12 package require struct::tree
13
14 namespace eval ::vc::cvs::ws {
15 vc::tools::log::system cvs
16 namespace import ::vc::tools::log::write
@@ -145,71 +146,25 @@
145 # information (file, revision -> date, author, commit message)
146
147 proc ::vc::cvs::ws::scan {} {
148 variable project
149 variable base
150 variable npaths
151 variable rpaths
152 variable timeline
153
154 write 0 cvs {Scanning directory hierarchy}
155
156 set n 0
157 set d $base ; if {$project ne ""} {append d /$project}
158
159 ::foreach rcs [fileutil::findByPattern $d -glob *,v] {
160 set rcs [fileutil::stripPath $d $rcs]
161 # Now rcs is relative to base/project
162
163 write 1 cvs "Archive $rcs"
164
165 if {[string match CVSROOT/* $rcs]} {
166 write 2 cvs {Ignored. Administrative file}
167 continue
168 }
169
170 # Derive the regular path from the rcs path. Meaning: Chop of
171 # the ",v" suffix, and remove a possible "Attic".
172 set f [string range $rcs 0 end-2]
173 if {"Attic" eq [lindex [file split $rcs] end-1]} {
174
175 # The construction below ensures that Attic/X maps to X
176 # instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
177
178 set fx [file dirname [file dirname $f]]
179 set f [file tail $f]
180 if {$fx ne "."} { set f [file join $fx $f] }
181
182 if {[file exists $d/$f,v]} {
183 # We have a regular archive and an Attic archive
184 # refering to the same user visible file. Ignore the
185 # file in the Attic.
186
187 write 2 cvs "Ignored. Attic superceded by regular archive"
188
189 # TODO/CHECK. My method of co'ing exact file revisions
190 # per the info in the collected csets has the flaw
191 # that I may have to know exactly when what archive
192 # file to use, see above. It might be better to use
193 # the info only to gather when csets begin and end,
194 # and then to co complete slices per exact timestamp
195 # (-D) instead of file revisions (-r). The flaw in
196 # that is that csets can occur in the same second
197 # (trf, memchan - check for examples). For that exact
198 # checkout may be needed to recreate exact sequence of
199 # changes. Grr. Six of one ...
200
201 continue
202 }
203 }
204
205 # Get the meta data we need (revisions, timeline, messages).
206 set meta [process $d/$rcs]
207
208 set npaths($rcs) $f
209 set rpaths($f) $rcs
210
211 array set p $meta
212
213 ::foreach {rev ts} $p(date) {_ a} $p(author) {_ cm} $p(commit) {_ st} $p(state) {
214 set op [expr {($rev eq "1.1") ? "A" : "M"}]
215 if {$st eq "dead"} {set op "R"}
@@ -236,16 +191,10 @@
236 write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]"
237 return
238 }
239
240 namespace eval ::vc::cvs::ws {
241 # Path mappings. npaths: rcs file -> user file
242 # rpaths: user file -> rcs file, dead-status
243
244 variable npaths ; array set npaths {}
245 variable rpaths ; array set rpaths {}
246
247 # Timeline: tstamp -> (op, tstamp, author, revision, file, commit message)
248
249 variable timeline ; array set timeline {}
250 }
251
252
253 DDED tools/lib/cvs_files.tcl
--- tools/lib/cvs.tcl
+++ tools/lib/cvs.tcl
@@ -3,14 +3,15 @@
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8 package require fileutil ; # Tcllib (traverse directory hierarchy)
9 package require vc::rcs::parser ; # Handling the RCS archive files.
10 package require vc::tools::log ; # User feedback
11 package require vc::cvs::cmd ; # Access to cvs application.
12 package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
13 package require struct::tree
14
15 namespace eval ::vc::cvs::ws {
16 vc::tools::log::system cvs
17 namespace import ::vc::tools::log::write
@@ -145,71 +146,25 @@
146 # information (file, revision -> date, author, commit message)
147
148 proc ::vc::cvs::ws::scan {} {
149 variable project
150 variable base
 
 
151 variable timeline
152
 
 
153 set n 0
154 set d $base ; if {$project ne ""} {append d /$project}
155
156 set files [::vc::cvs::ws::files::find $d]
157
158 write 0 cvs "Scanning archives ..."
159
160 ::foreach {rcs f} $files {
161 write 1 cvs "Archive $rcs"
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
162
163 # Get the meta data we need (revisions, timeline, messages).
164 set meta [process $d/$rcs]
165
 
 
 
166 array set p $meta
167
168 ::foreach {rev ts} $p(date) {_ a} $p(author) {_ cm} $p(commit) {_ st} $p(state) {
169 set op [expr {($rev eq "1.1") ? "A" : "M"}]
170 if {$st eq "dead"} {set op "R"}
@@ -236,16 +191,10 @@
191 write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]"
192 return
193 }
194
195 namespace eval ::vc::cvs::ws {
 
 
 
 
 
 
196 # Timeline: tstamp -> (op, tstamp, author, revision, file, commit message)
197
198 variable timeline ; array set timeline {}
199 }
200
201
202 DDED tools/lib/cvs_files.tcl
A tools/lib/cvs_files.tcl
+49
--- a/tools/lib/cvs_files.tcl
+++ b/tools/lib/cvs_files.tcl
@@ -0,0 +1,49 @@
1
+# -----------------------------------------------------------------------------
2
+# Repository management (CVS), archive files
3
+
4
+# -----------------------------------------------------------------------------
5
+# Requirements
6
+
7
+package require Tcl 8.4
8
+package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
9
+package require vc::tools::log ; # User feedback
10
+
11
+namespace eval ::vc::cvs::ws::files {
12
+ namespace import ::vc::tools::log::write
13
+ namespace import namespacverbosity?ic && [file exists $path/$f,v]} {
14
+ # We have a regular archive and an Attic archivAPI
15
+
16
+# ------
17
+# Internals
18
+
19
+API
20
+
21
+# vc::cvs::ws::files::find path - Find all RCS archives under the path.
22
+
23
+# -----------------------------------------------------------------------------
24
+# API Implementation
25
+
26
+proc ::vc::cvs::ws::files::find {path} {
27
+
28
+ write 0 cvs "Scanning directory hierarchy $path ..."
29
+
30
+ set t [fileutil::traverse %AUTO% $path]
31
+ set n 0
32
+ set r {}
33
+
34
+ $t foreach rcs {
35
+ if {![string match *,v $rcs]} continue
36
+
37
+ # Now make rcs is relative to the base/project
38
+ set rcs [fileutil::stripPath $path $rcs]
39
+
40
+ if {[string match CVSROOT/* $rcs]} {
41
+ write 2 cvs "Ignoring administrative file: $rcs"
42
+ continue
43
+ }
44
+
45
+ set f [UserFile $rcs isattic]
46
+
47
+ if {$isattic && [file exists $path/$f,v]} {
48
+ # We have a regular archive and an Attic archive refering
49
+ # to the same user visible file. Igno
--- a/tools/lib/cvs_files.tcl
+++ b/tools/lib/cvs_files.tcl
@@ -0,0 +1,49 @@
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
 
--- a/tools/lib/cvs_files.tcl
+++ b/tools/lib/cvs_files.tcl
@@ -0,0 +1,49 @@
1 # -----------------------------------------------------------------------------
2 # Repository management (CVS), archive files
3
4 # -----------------------------------------------------------------------------
5 # Requirements
6
7 package require Tcl 8.4
8 package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
9 package require vc::tools::log ; # User feedback
10
11 namespace eval ::vc::cvs::ws::files {
12 namespace import ::vc::tools::log::write
13 namespace import namespacverbosity?ic && [file exists $path/$f,v]} {
14 # We have a regular archive and an Attic archivAPI
15
16 # ------
17 # Internals
18
19 API
20
21 # vc::cvs::ws::files::find path - Find all RCS archives under the path.
22
23 # -----------------------------------------------------------------------------
24 # API Implementation
25
26 proc ::vc::cvs::ws::files::find {path} {
27
28 write 0 cvs "Scanning directory hierarchy $path ..."
29
30 set t [fileutil::traverse %AUTO% $path]
31 set n 0
32 set r {}
33
34 $t foreach rcs {
35 if {![string match *,v $rcs]} continue
36
37 # Now make rcs is relative to the base/project
38 set rcs [fileutil::stripPath $path $rcs]
39
40 if {[string match CVSROOT/* $rcs]} {
41 write 2 cvs "Ignoring administrative file: $rcs"
42 continue
43 }
44
45 set f [UserFile $rcs isattic]
46
47 if {$isattic && [file exists $path/$f,v]} {
48 # We have a regular archive and an Attic archive refering
49 # to the same user visible file. Igno
M tools/lib/pkgIndex.tcl
+1
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,9 +1,10 @@
11
 if {![package vsatisfies [package require Tcl] 8.4]} return
22
 package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
33
 package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
44
 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
5
+package ifneeded vc::cvs::ws::files 1.0 [list source [file join $dir cvs_files.tcl]]
56
 package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
67
 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
78
 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
89
 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
910
 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
1011
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,9 +1,10 @@
1 if {![package vsatisfies [package require Tcl] 8.4]} return
2 package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
3 package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
4 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
 
5 package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
6 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
7 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
8 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
9 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
10
--- tools/lib/pkgIndex.tcl
+++ tools/lib/pkgIndex.tcl
@@ -1,9 +1,10 @@
1 if {![package vsatisfies [package require Tcl] 8.4]} return
2 package ifneeded vc::rcs::parser 1.0 [list source [file join $dir rcsparser.tcl]]
3 package ifneeded vc::cvs::cmd 1.0 [list source [file join $dir cvs_cmd.tcl]]
4 package ifneeded vc::cvs::ws 1.0 [list source [file join $dir cvs.tcl]]
5 package ifneeded vc::cvs::ws::files 1.0 [list source [file join $dir cvs_files.tcl]]
6 package ifneeded vc::fossil::cmd 1.0 [list source [file join $dir fossil_cmd.tcl]]
7 package ifneeded vc::fossil::ws 1.0 [list source [file join $dir fossil.tcl]]
8 package ifneeded vc::fossil::import::cvs 1.0 [list source [file join $dir importcvs.tcl]]
9 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
10 package ifneeded vc::fossil::import::map 1.0 [list source [file join $dir import_map.tcl]]
11

Keyboard Shortcuts

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