Check-in [6f121db1e2]
Not logged in
HomeFilesLeavesTimelineBranchesTagsTicketsWikiLogin
Overview

SHA1 Hash:6f121db1e2d4ebc1051ce20f35a3f9f74eb0c628
Date: 2007-09-17 01:43:07
User: aku
Comment:Added structure to the CVS frontend code, putting the repository traversal into its own package.
Timelines: ancestors | descendants | both | trunk
Other Links: files | ZIP archive | manifest

Tags And Properties
Changes
[hide diffs]

Modified tools/lib/cvs.tcl from [11e2bbce8e] to [a7a859e048]. 

@@ -3,14 +3,15 @@
 
 # -----------------------------------------------------------------------------
 # Requirements
 
 package require Tcl 8.4
-package require fileutil        ; # Tcllib (traverse directory hierarchy)
-package require vc::rcs::parser ; # Handling the RCS archive files.
-package require vc::tools::log  ; # User feedback
-package require vc::cvs::cmd    ; # Access to cvs application.
+package require fileutil           ; # Tcllib (traverse directory hierarchy)
+package require vc::rcs::parser    ; # Handling the RCS archive files.
+package require vc::tools::log     ; # User feedback
+package require vc::cvs::cmd       ; # Access to cvs application.
+package require vc::cvs::ws::files ; # Scan CVS repository for relevant files.
 package require struct::tree
 
 namespace eval ::vc::cvs::ws {
     vc::tools::log::system cvs
     namespace import ::vc::tools::log::write
@@ -145,70 +146,24 @@
 # information (file, revision -> date, author, commit message)
 
 proc ::vc::cvs::ws::scan {} {
     variable project
     variable base
-    variable npaths
-    variable rpaths
-    variable timeline
-
-    write 0 cvs {Scanning directory hierarchy}
+    variable timeline
 
     set n 0
     set d $base ; if {$project ne ""} {append d /$project}
 
-    ::foreach rcs [fileutil::findByPattern $d -glob *,v] {
-	set rcs [fileutil::stripPath $d $rcs]
-	# Now rcs is relative to base/project
-
+    set files [::vc::cvs::ws::files::find $d]
+
+    write 0 cvs "Scanning archives ..."
+
+    ::foreach {rcs f} $files {
 	write 1 cvs "Archive $rcs"
 
-	if {[string match CVSROOT/* $rcs]} {
-	    write 2 cvs {Ignored. Administrative file}
-	    continue
-	}
-
-	# Derive the regular path from the rcs path. Meaning: Chop of
-	# the ",v" suffix, and remove a possible "Attic".
-	set f [string range $rcs 0 end-2]
-	if {"Attic" eq [lindex [file split $rcs] end-1]} {
-
-	    # The construction below ensures that Attic/X maps to X
-	    # instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
-
-	    set fx [file dirname [file dirname $f]]
-	    set f  [file tail $f]
-	    if {$fx ne "."} { set f [file join $fx $f] }
-
-	    if {[file exists $d/$f,v]} {
-		# We have a regular archive and an Attic archive
-		# refering to the same user visible file. Ignore the
-		# file in the Attic.
-
-		write 2 cvs "Ignored. Attic superceded by regular archive"
-
-		# TODO/CHECK. My method of co'ing exact file revisions
-		# per the info in the collected csets has the flaw
-		# that I may have to know exactly when what archive
-		# file to use, see above. It might be better to use
-		# the info only to gather when csets begin and end,
-		# and then to co complete slices per exact timestamp
-		# (-D) instead of file revisions (-r). The flaw in
-		# that is that csets can occur in the same second
-		# (trf, memchan - check for examples). For that exact
-		# checkout may be needed to recreate exact sequence of
-		# changes. Grr. Six of one ...
-
-		continue
-	    }
-	}
-
 	# Get the meta data we need (revisions, timeline, messages).
 	set meta [process $d/$rcs]
-
-	set npaths($rcs) $f
-	set rpaths($f) $rcs
 
 	array set p $meta
 
 	::foreach {rev ts} $p(date) {_ a} $p(author) {_ cm} $p(commit) {_ st} $p(state) {
 	    set op [expr {($rev eq "1.1") ? "A" : "M"}]
@@ -236,16 +191,10 @@
     write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]"
     return
 }
 
 namespace eval ::vc::cvs::ws {
-    # Path mappings. npaths: rcs file  -> user file
-    #                rpaths: user file -> rcs file, dead-status
-
-    variable npaths   ; array set npaths   {}
-    variable rpaths   ; array set rpaths   {}
-
     # Timeline: tstamp -> (op, tstamp, author, revision, file, commit message)
 
     variable timeline ; array set timeline {}
 }

Added tools/lib/cvs_files.tcl version [605edf3ab3]

@@ -1,1 +1,114 @@
+# -----------------------------------------------------------------------------
+# Repository management (CVS), archive files
+
+# -----------------------------------------------------------------------------
+# Requirements
+
+package require Tcl 8.4
+package require fileutil::traverse ; # Tcllib (traverse directory hierarchy)
+package require vc::tools::log     ; # User feedback
+
+namespace eval ::vc::cvs::ws::files {
+    namespace import ::vc::tools::log::write
+    namespace import ::vc::tools::log::progress
+    namespace import ::vc::tools::log::verbosity?
+}
+
+# -----------------------------------------------------------------------------
+# API
+
+# vc::cvs::ws::files::find path - Find all RCS archives under the path.
+
+# -----------------------------------------------------------------------------
+# API Implementation
+
+proc ::vc::cvs::ws::files::find {path} {
+
+    write 0 cvs "Scanning directory hierarchy $path ..."
+
+    set t [fileutil::traverse %AUTO% $path]
+    set n 0
+    set r {}
+
+    $t foreach rcs {
+	if {![string match *,v $rcs]} continue
+
+	# Now make rcs is relative to the base/project
+	set rcs [fileutil::stripPath $path $rcs]
+
+	if {[string match CVSROOT/* $rcs]} {
+	    write 2 cvs "Ignoring administrative file: $rcs"
+	    continue
+	}
+
+	set f [UserFile $rcs isattic]
+
+	if {$isattic && [file exists $path/$f,v]} {
+	    # We have a regular archive and an Attic archive refering
+	    # to the same user visible file. Ignore the file in the
+	    # Attic.
+
+	    write 2 cvs "Ignoring superceded attic:    $rcs"
+
+	    # TODO/CHECK. My method of co'ing exact file revisions per
+	    # the info in the collected csets has the flaw that I may
+	    # have to know exactly when what archive file to use, see
+	    # above. It might be better to use the info only to gather
+	    # when csets begin and end, and then to co complete slices
+	    # per exact timestamp (-D) instead of file revisions
+	    # (-r). The flaw in that is that csets can occur in the
+	    # same second (trf, memchan - check for examples). For
+	    # that exact checkout may be needed to recreate exact
+	    # sequence of changes. Grr. Six of one ...
+
+	    continue
+	}
+
+	lappend r $rcs $f
+	incr n
+	progress 0 cvs $n {}
+    }
+
+    $t destroy
+    return $r
+}
+
+# -----------------------------------------------------------------------------
+# Internals
+
+proc ::vc::cvs::ws::files::UserFile {rcs iav} {
+    upvar 1 $iav isattic
+
+    # Derive the regular path from the rcs path. Meaning: Chop of the
+    # ",v" suffix, and remove a possible "Attic".
+
+    set f [string range $rcs 0 end-2]
+
+    if {"Attic" eq [lindex [file split $rcs] end-1]} {
+
+	# The construction below ensures that Attic/X maps to X
+	# instead of ./X. Otherwise, Y/Attic/X maps to Y/X.
+
+	set fx [file dirname [file dirname $f]]
+	set f  [file tail $f]
+	if {$fx ne "."} { set f [file join $fx $f] }
+
+	set isattic 1
+    } else {
+	set isattic 0
+    }
+
+    return $f
+}
+
+# -----------------------------------------------------------------------------
+
+namespace eval ::vc::cvs::ws::files {
+    namespace export find
+}
+
+# -----------------------------------------------------------------------------
+# Ready
 
+package provide vc::cvs::ws::files 1.0
+return

Modified tools/lib/pkgIndex.tcl from [66cbd64e60] to [5bdfea38bf]. 

@@ -1,10 +1,11 @@
 if {![package vsatisfies [package require Tcl] 8.4]} return
 package ifneeded vc::rcs::parser           1.0 [list source [file join $dir rcsparser.tcl]]
 package ifneeded vc::cvs::cmd              1.0 [list source [file join $dir cvs_cmd.tcl]]
 package ifneeded vc::cvs::ws               1.0 [list source [file join $dir cvs.tcl]]
+package ifneeded vc::cvs::ws::files        1.0 [list source [file join $dir cvs_files.tcl]]
 package ifneeded vc::fossil::cmd           1.0 [list source [file join $dir fossil_cmd.tcl]]
 package ifneeded vc::fossil::ws            1.0 [list source [file join $dir fossil.tcl]]
 package ifneeded vc::fossil::import::cvs   1.0 [list source [file join $dir importcvs.tcl]]
 package ifneeded vc::fossil::import::stats 1.0 [list source [file join $dir import_statistics.tcl]]
 package ifneeded vc::fossil::import::map   1.0 [list source [file join $dir import_map.tcl]]
 package ifneeded vc::tools::log            1.0 [list source [file join $dir log.tcl]]

Fossil version [c0211010a1] 2009-12-13 01:31:36