Overview
| SHA1 Hash: | df91d389d58f7e9f068e7866a568fae14a6b4282 |
|---|---|
| Date: | 2007-09-04 05:36:56 |
| User: | aku |
| Comment: | First semi-complete app for import from CVS. Trunk only, wholesale only. |
| Timelines: | ancestors | descendants | both | trunk |
| Other Links: | files | ZIP archive | manifest |
Tags And Properties
- branch=trunk inherited from [a28c83647d]
- sym-trunk inherited from [a28c83647d]
Changes
[hide diffs]Modified ci_cvs.txt from [13f4f929b2] to [78baac6911].
@@ -166,5 +166,27 @@ This algorithm has to be refined to also take Attic/ files into account. +------------------------------------------------------------------------- + +Two archive files mapping to the same user file. How are they +interleaved ? + +(a) sqlite/src/os_unix.h,v +(b) sqlite/src/Attic/os_unix.h,v + +Problem: Max version of (a) is 1.9 + Max version of (b) is 1.11 + cvs co 1.10 -> no longer in the repository. + +This seems to indicate that the non-Attic file is relevant. + +-------------------------------------------------------------------------- + +tcllib - more problems - tklib/pie.tcl,v - + +invalid change text in +/home/aku/Projects/Tcl/Fossil/Devel/Examples/cvs-tcllib/tklib/modules/tkpiechart/pie.tcl,v + +Possibly braces ?
Modified tools/import-cvs.tcl from [8e70daebc0] to [bb9275318e].
@@ -1,370 +1,185 @@
#!/bin/sh
# -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}
# -----------------------------------------------------------------------------
+
+# Import the trunk of a CVS repository wholesale into a fossil repository.
+
+# Limitations implicitly mentioned:
+# - No incremental import.
+# - No import of branches.
+
+# WIBNI features (beyond eliminating the limitations):
+# - Restrict import to specific directory subtrees (SF projects use
+# one repository for several independent modules. Examples: tcllib
+# -> tcllib, tklib, tclapps, etc.). The restriction would allow import
+# of only a specific module.
+# - Related to the previous, strip elements from the base path to keep
+# it short.
+# - Export to CVS, trunk, possibly branches. I.e. extend the system to be
+# a full bridge. Either Fossil or CVS could be the master repository.
+
+# HACKS. I.e. I do not know if the 'fixes' I use are the correct way
+# of handling the encountered situations.
+#
+# - File F has archives F,v and Attic/F,v. Currently I will ignore the
+# file in the Attic.
+# Examples: sqlite/os_unix.h
+#
+# - A specific revision of a file F cannot be checked out (reported
+# error is 'invalid change text'). This indicates a corrupt RCS
+# file, one or more delta are bad. We report but ignore the problem
+# in a best-effort attempt at getting as much history as possible.
+# Examples: tcllib/tklib/modules/tkpiechart/pie.tcl
+
+# -----------------------------------------------------------------------------
# Make private packages accessible.
lappend auto_path [file join [file dirname [info script]] lib]
-package require rcsparser
-package require fileutil
+
+# -----------------------------------------------------------------------------
+# Requirements
+
+package Tcl 8.4
+package require cvs ; # Frontend, reading from source repository
+package require fossil ; # Backend, writing to destination repository.
# -----------------------------------------------------------------------------
-# Repository management (CVS)
-
-namespace eval ::cvs {
- variable base ; set base {} ; # Repository toplevel directory.
- variable npaths ; array set npaths {} ; # path -> actual path mapping.
- variable rpaths ; array set rpaths {} ; # path -> rcs file mapping.
- variable cmsg ; array set cmsg {} ; # Cache of commit messages.
-}
-
-proc ::cvs::hextime {hex} {
- set t 0
- foreach d [string map {
- a 10 b 11 c 12 d 13 e 14 f 15
- A 10 B 11 C 12 D 13 E 14 F 15
- } [split $hex {}]] {
- set t [expr {($t << 4) + $d}];#horner
+
+proc main {} {
+ global argv tot nto cvs fossil ntrunk
+
+ commandline
+
+ fossil::feedback Write ; # Setup progress feedback from the libraries
+ cvs::feedback Write
+
+ cvs::at $cvs ; # Define location of CVS repository
+ cvs::scan ; # Gather revision data from the archives
+ cvs::csets ; # Group changes into sets
+ cvs::rtree ; # Build revision tree (trunk only right now).
+
+ set tot 0.0
+ set nto 0
+
+ Write info {Importing ...}
+ Write info { Setting up cvs workspace and temporary fossil repository}
+
+ cvs::workspace ; # cd's to workspace
+ fossil::new ; # Uses cwd as workspace to connect to.
+
+ set ntrunk [cvs::ntrunk]
+ cvs::foreach_cset cset [cvs::root] {
+ import $cset
}
- return $t
-}
-
-proc ::cvs::at {path} {
- variable base $path
+ cvs::wsclear
+
+ Write info " ========= [string repeat = 61]"
+ Write info " Imported $nto [expr {($nto == 1) ? "changeset" : "changesets"}]"
+ Write info " Within [format %.2f $tot] seconds (avg [format %.2f [expr {$tot/$nto}]] seconds/changeset)"
+
+ Write info { Moving to final destination}
+
+ fossil::destination $fossil
+
+ Write info Ok.
return
}
-proc ::cvs::cmsg {path rev} {
- variable cmsg
- set key [list $path $rev]
-
- if {![info exists cmsg($key)]} {
- set rcs [cvs::rcsfile $path]
-
- #puts stderr "scan $path => $rcs"
-
- array set p [::rcsparser::process $rcs]
-
- foreach {r msg} $p(commit) {
- set cmsg([list $path $r]) $msg
+
+# -----------------------------------------------------------------------------
+
+proc commandline {} {
+ global argv cvs fossil nosign log
+
+ set nosign 0
+ while {[string match "-*" [set opt [lindex $argv 0]]]} {
+ if {$opt eq "--nosign"} {
+ set nosign 1
+ set argv [lrange $argv 1 end]
+ continue
}
-
- if {![info exists cmsg($key)]} {
- return -code error "Bogus revision $rev of file $path"
- }
+ usage
+ }
+ if {[llength $argv] != 2} usage
+ foreach {cvs fossil} $argv break
+
+ if {
+ ![file exists $cvs] ||
+ ![file readable $cvs] ||
+ ![file isdirectory $cvs]
+ } {
+ usage "CVS directory missing, not readable, or not a directory."
+ } elseif {[file exists $fossil]} {
+ usage "Fossil destination repository exists already."
}
- return $cmsg($key)
+ set log [open ${fossil}.log w]
+ return
+}
+
+proc usage {{text {}}} {
+ global argv0
+ puts stderr "Usage: $argv0 ?--nosign? cvs-repository fossil-rpeository"
+ if {$text eq ""} return
+ puts stderr " $text"
+ exit
}
-proc ::cvs::norm {path} {
- variable npaths
- if {![info exists npaths($path)]} {
- set npaths($path) [NormFile $path]
- }
- return $npaths($path)
+proc import {cset} {
+ global tot nto nosign ntrunk
+ Write info " Importing $cset [string repeat = [expr {60 - [string length $cset]}]]"
+ Write info " At $nto/$ntrunk ([format %.2f [expr {double($nto)/$ntrunk}]]%)"
+
+ set usec [lindex [time {
+ foreach {uuid ad rm ch} [fossil::commit cvs2fossil $nosign \
+ [cvs::wssetup $cset] \
+ ::cvs::wsignore] break
+ } 1] 0]
+ cvs::uuid $cset $uuid
+
+ set sec [expr {$usec/1e6}]
+ set tot [expr {$tot + $sec}]
+ incr nto
+
+ Write info " == $uuid +${ad}-${rm}*${ch}"
+ Write info " in $sec seconds"
+
+ set avg [expr {$tot/$nto}]
+ set max [expr {$ntrunk * $avg}]
+ set rem [expr {$max - $tot}]
+
+ Write info " st avg [format %.2f $avg]"
+ Write info " st run [format %7.2f $tot] sec [format %6.2f [expr {$tot/60}]] min [format %5.2f [expr {$tot/3600}]] hr"
+ Write info " st end [format %7.2f $max] sec [format %6.2f [expr {$max/60}]] min [format %5.2f [expr {$max/3600}]] hr"
+ Write info " st rem [format %7.2f $rem] sec [format %6.2f [expr {$rem/60}]] min [format %5.2f [expr {$rem/3600}]] hr"
+ return
}
-proc ::cvs::NormFile {path} {
- variable base
-
- set f $base/$path,v
- if {[::file exists $f]} {return $path}
-
- set hd [::file dirname $path]
- set tl [::file tail $path]
-
- set f $base/$hd/Attic/$tl,v
- if {[::file exists $f]} {return $path}
+# -----------------------------------------------------------------------------
- # Bad. The dir can be truncated, i.e. it may not be an exact
- # subdirectory of base, but deeper inside, with parents between it
- # and base left out. Example (from the tcllib history file):
- #
- # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog
- # The correct path is 'tklib/modules/ipentry'.
- # This we have to resolve too.
-
- # normalize dance - old fileutil, modern fileutil (cvs head) doesn't do that.
- set bx [file normalize $base]
- foreach c [fileutil::findByPattern $bx -glob $hd] {
- set cx [fileutil::stripPath $bx $c]
- set c $base/$cx
-
- set f $c/$tl,v
- if {[::file exists $f]} {return $cx/$tl}
- set f $c/Attic/$tl,v
- if {[::file exists $f]} {return $cx/$tl}
- }
-
- puts stderr <$f>
- return -code error "Unable to locate actual file for $path"
+array set fl {
+ debug {DEBUG }
+ info { }
+ warning {Warning}
+ error {ERROR }
}
-proc ::cvs::rcsfile {path} {
- variable rpaths
- if {![info exists rpaths($path)]} {
- set rpaths($path) [RcsFile $path]
- }
- return $rpaths($path)
-}
-
-proc ::cvs::RcsFile {path} {
- variable base
-
- set f $base/$path,v
- if {[::file exists $f]} {return $f}
-
- set hd [::file dirname $path]
- set tl [::file tail $path]
-
- set f $base/$hd/Attic/$tl,v
- if {[::file exists $f]} {return $f}
-
- # We do not have truncated directories here, assuming that only
- # norm paths are fed into this command.
+proc Write {l t} {
+ global fl log
- if 0 {
- # Bad. The dir can be truncated, i.e. it may not be an exact
- # subdirectory of base, but deeper inside, with parents
- # between it and base left out. Example (from the tcllib
- # history file):
- #
- # M3f1d1245|afaupell|<remote>|ipentry|1.2|ChangeLog The
- # correct path is 'tklib/modules/ipentry'. This we have to
- # resolve too.
-
- # normalize dance - old fileutil, modern fileutil (cvs head)
- # doesn't do that.
- set bx [file normalize $base]
- foreach c [fileutil::findByPattern $bx -glob $hd] {
- set c $base/[fileutil::stripPath $bx $c]
-
- set f $c/$tl,v
- if {[::file exists $f]} {return $f}
- set f $c/Attic/$tl,v
- if {[::file exists $f]} {return $f}
- }
+ if {[string index $t 0] eq "\r"} {
+ puts -nonewline stdout "\r$fl($l) [string range $t 0 end-1]"
+ } else {
+ puts stdout "$fl($l) $t"
+ puts $log "$fl($l) $t"
}
-
- puts stderr <$f>
- return -code error "Unable to locate rcs file for $path"
-}
-
-proc ::cvs::history {} {
- variable base
- return $base/CVSROOT/history
+ flush stdout
+ return
}
# -----------------------------------------------------------------------------
-# -----------------------------------------------------------------------------
-
-cvs::at [lindex $argv 0]
-
-#puts [::cvs::norm ipentry/ChangeLog]
-#exit
-
-#changeset state
-global cs csf
-array set cs {
- start {} end {} cm {}
- usr {} dt {}
-}
-array set csf {}
-
-proc rh {} {
- global argv cs csf repo
-
- set f [open [cvs::history] r]
-
- while {[gets $f line] >= 0} {
- # Decode line
- foreach {op usr _ dir rev file} [split [string trim $line] |] break
- set ts [cvs::hextime [string range $op 1 end]]
- set op [string index $op 0]
-
- # Filter out irrelevant parts
- if {$op eq "O"} continue ; # checkout
- if {$op eq "F"} continue ; # release
- if {$op eq "T"} continue ; # rtag
- if {$op eq "W"} continue ; # delete on update
- if {$op eq "U"} continue ; # update
- if {$op eq "P"} continue ; # update by patch
- #if {$op eq "G"} continue ; # merge on update - FUTURE - identifies mergepoints.
- if {$op eq "C"} continue ; # conflict on update - s.a.
- if {$op eq "E"} continue ; # export
- # left types
- # M: commit
- # A: addition
- # R: removal
-
- set df $dir/$file
- if {[newcs $op $usr $ts $rev df cause]} {
-
- # NOTE 1: ChangeSets containing CVSROOT => remove such files.
- # NOTE 2: Empty changesets, ignore.
-
- #commit
- csstats
-
- if {$cause eq "cmsg"} {
-set msg
- } else {
-set msg ""
- }
-
- if {$cs(end) ne ""} {
- puts =============================/$cause\ delta\ [expr {$ts - $cs(end)}]
- } else {
- puts =============================/$cause
- }
- csclear
- }
-
- # Note: newcs normalizes df, in case the log information is
- # bogus. So the df here may be different from before newcs
- csadd $op $usr $ts $rev $df
- # apply modification to workspace
- }
-}
-
-proc newcs {op usr ts rev dfv rv} {
- global cs csf
- upvar 1 $rv reason $dfv df
-
- # Logic to detect when a new change set begins. A new change sets
- # has started with the current entry when the entry
- #
- # 1. is for a different user than the last.
- # 2. tries to add a file to the changeset which is already part of it.
- # 3.is on the trunk, and the last on a branch, or vice versa.
- # 4. the current entry has a different commit message than the last.
-
- set df [cvs::norm $df]
-
- # User changed
- if {$usr ne $cs(usr)} {
- set reason user
- return 1
- }
-
- # File is already in the changeset
- if {[info exists csf($df)]} {
- set reason file
- return 1
- }
-
- # last/current are different regarding trunk/branch
- set depth [llength [split $rev .]]
- if {($cs(lastd) == 2) != ($depth == 2)} {
- set reason branch
- return 1
- }
-
- # Commit message changed
- if {[cvs::cmsg $cs(lastf) $cs(lastr)] ne [cvs::cmsg $df $rev]} {
- set reason cmsg
- return 1
- }
-
- # Same changeset
- return 0
-}
-
-proc csclear {} {
- global cs csf
- array set cs {start {} usr {} end {} dt {}}
- array unset csf *
- return
-}
-
-proc csadd {op usr ts rev df} {
- global cs csf
-
- if {$cs(usr) eq ""} {set cs(usr) $usr}
- if {$cs(start) eq ""} {
- set cs(start) $ts
- } else {
- lappend cs(dt) [expr {$ts - $cs(end)}]
- }
- set cs(end) $ts
-
- set csf($df) [list $op $rev]
- set cs(lastf) $df
- set cs(lastr) $rev
- set cs(lastd) [llength [split $rev .]]
-
- puts [list $op [clock format $ts] $usr $rev $df]
- return
-}
-
-proc csstats {} {
- global cs csf
-
- if {$cs(start) eq ""} return
-
- puts "files: [array size csf]"
- puts "delta: $cs(dt)"
- puts "range: [expr {$cs(end) - $cs(start)}] seconds"
- return
-}
-
-rh
-
-exit
-
-=========================================
-new fossil
-new fossil workspace
-
-open history
-
-foreach line {
- ignore unwanted lines
-
- accumulate changesets data
- new change-set => commit and continue
-
- current branch and branch of new change different ?
- => move fossil workspace to proper revision.
-
- apply change to workspace
- uncommitted
-}
-
-if uncommitted => commit
-delete workspace
-copy fossil repo to destination
-=========================================
-
-Not dealt with in outline: branches, tags, merging
-
-=========================================
-
-complexities
-- apply to workspace
- - remove simple, direct translation
- - add => requires extraction of indicated revision from ,v
- - modify => see above (without add following)
-
-- ,v file => Can be the either dir/file,v, or dir/Attic/file,v
- Both ? Priority ?
-
-- How to detect changes on branches ?
-
-- Have to keep knowledge of which branches went there.
- => save change-sets information, + uuid in fossil
- => need only the leaves of each branch, and of branch points.
- => better keep all until complete.
- => uuid can be gotten from 'manifest.uuid' in workspace.
-- keep tag information ? (symbolics)
-
-=========================================
-
-CVSROOT=ORIGIN
-
-cvs -d ORIGIN checkout -r REV FILE
-Extract specific revision of a specific file.
--q, -Q quietness
+main
+exit
Added tools/lib/cvs.tcl version [abba347c2b]
@@ -1,1 +1,485 @@
+# -----------------------------------------------------------------------------
+# Repository management (CVS)
+
+# -----------------------------------------------------------------------------
+# Requirements
+
+package require Tcl 8.4
+package require fileutil ; # Tcllib (cat)
+package require rcsparser ; # Handling the RCS archive files.
+package require struct::tree
+
+namespace eval ::cvs {}
+
+# -----------------------------------------------------------------------------
+# API
+
+# Define repository directory.
+
+proc ::cvs::at {path} {
+ variable base [file normalize $path]
+ return
+}
+
+namespace eval ::cvs {
+ # Toplevel repository directory
+ variable base {}
+}
+
+# Define logging callback command
+
+proc ::cvs::feedback {logcmd} {
+ variable lc $logcmd
+ ::rcsparser::feedback $logcmd
+ return
+}
+
+# Scan repository, collect archives, parse them, and collect revision
+# information (file, revision -> date, author, commit message)
+
+proc ::cvs::scan {} {
+ variable base
+ variable npaths
+ variable rpaths
+ variable timeline
+
+ Log info "Scanning CVS tree $base"
+
+ set n 0
+ foreach rcs [fileutil::findByPattern $base -glob *,v] {
+ set rcs [fileutil::stripPath $base $rcs]
+ # Now rcs is relative to base
+
+ Log info " Parsing archive $rcs"
+
+ if {[string match CVSROOT* $rcs]} {
+ Log info " => Ignoring admin 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]} {
+ set f [file join [file dirname [file dirname $f]] [file tail $f]]
+ if {[file exists $base/$f,v]} {
+ # We have a regular archive and an Attic archive
+ # refering to the same user visible file. Ignore the
+ # file in the Attic.
+ Log info " => Ignoring attic for 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 [::rcsparser::process $base/$rcs]
+
+ Log info " => $f"
+
+ 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"}]
+ if {$st eq "dead"} {set op "R"}
+
+ # A dead-first revision is rev 1.1 with op R. For an
+ # example see the file memchan/DEPENDENCIES. Such a file
+ # seems to exist only! on its branch. The branches
+ # information is set on the revision (extend rcsparser!),
+ # symbols has a tag, refering to a branch, possibly magic.
+
+ if {($rev eq "1.1") && ($op eq "R")} {
+ Log info " => Dead first"
+ }
+
+ lappend timeline($ts) [list $op $ts $a $rev $f $cm]
+ }
+
+ #unset p(commit)
+ #parray p
+
+ incr n
+ }
+
+ Log info "Processed $n [expr {($n == 1) ? "file" : "files"}]"
+ return
+}
+
+namespace eval ::cvs {
+ # 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 {}
+}
+
+# Group single changes into changesets
+
+proc ::cvs::csets {} {
+ variable timeline
+ variable csets
+ variable ncs
+ variable cmap
+
+ array unset csets * ; array set csets {}
+ array unset cmap * ; array set cmap {}
+ set ncs 0
+
+ Log info "Processing timeline"
+
+ set n 0
+ CSClear
+ foreach ts [lsort -dict [array names timeline]] {
+
+ # op tstamp author revision file commit
+ # 0 1 2 3 4 5/end
+ # b c a
+
+ set entries [lsort -index 2 [lsort -index 0 [lsort -index end $timeline($ts)]]]
+ #puts [join $entries \n]
+
+ foreach entry $entries {
+ if {![CSNone] && [CSNew $entry]} {
+ CSSave
+ CSClear
+ #puts ==\n$reason
+ }
+ CSAdd $entry
+ incr n
+ }
+ }
+
+ Log info "Processed $n [expr {($n == 1) ? "entry" : "entries"}]"
+ set n [array size csets]
+ Log info "Found $n [expr {($n == 1) ? "changeset" : "changesets"}]"
+ return
+}
+
+
+namespace eval ::cvs {
+ # Changeset data:
+ # ncs: Counter-based id generation
+ # csets: id -> (user commit start end depth (file -> (op rev)))
+
+ variable ncs ; set ncs 0 ; # Counter for changesets
+ variable csets ; array set csets {} ; # Changeset data
+}
+
+# Building the revision tree from the changesets.
+# Limitation: Currently only trunk csets is handled.
+# Limitation: Dead files are not removed, i.e. no 'R' actions right now.
+
+proc ::cvs::rtree {} {
+ variable csets
+ variable rtree {}
+ variable ntrunk 0
+
+ Log info "Extracting the trunk"
+
+ set rtree [struct::tree ::cvs::RT]
+ $rtree rename root 0 ; # Root is first changeset, always.
+ set trunk 0
+ set ntrunk 1 ; # Root is on the trunk.
+ set b 0 ; # No branch csets found yet.
+
+ # Extracting the trunk is easy, simply by looking at the involved
+ # version numbers.
+
+ foreach c [lrange [lsort -integer [array names csets]] 1 end] {
+ foreach {u cm s e rd f} $csets($c) break
+
+ # Ignore branch changes, just count them for the statistics.
+ if {$rd != 2} {
+ incr b
+ continue
+ }
+
+ # Trunk revision, connect to, and update the head.
+ $rtree insert $trunk end $c
+ set trunk $c
+ incr ntrunk
+ }
+
+ Log info "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]"
+ Log info "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]"
+ return
+}
+
+namespace eval ::cvs {
+ # Tree holding trunk and branch information (struct::tree).
+ # Node names are cset id's.
+
+ variable rtree {}
+ variable ntrunk 0
+}
+
+proc ::cvs::workspace {} {
+ variable cwd [pwd]
+ variable workspace [fileutil::tempfile importF_cvs_ws_]
+ file delete $workspace
+ file mkdir $workspace
+
+ Log info " Workspace: $workspace"
+
+ cd $workspace ; # Checkouts go here.
+ return $workspace
+}
+
+proc ::cvs::wsignore {path} {
+ # Ignore CVS admin files.
+ if {[string match */CVS/* $path]} {return 1}
+ return 0
+}
+
+proc ::cvs::wsclear {} {
+ variable cwd
+ variable workspace
+ cd $cwd
+ file delete -force $workspace
+ return
+}
+
+proc ::cvs::wssetup {c} {
+ variable csets
+ variable cvs
+ variable base
+
+ # pwd = workspace
+
+ foreach {u cm s e rd fs} $csets($c) break
+
+ Log info " @ $s"
+
+ foreach l [split [string trim $cm] \n] {
+ Log info " | $l"
+ }
+
+ foreach {f or} $fs {
+ foreach {op r} $or break
+ Log info " -- $op $f $r"
+
+ if {$op eq "R"} {
+ # Remove file from workspace. Prune empty directories.
+ #
+ # NOTE: A dead-first file (rev 1.1 dead) will never have
+ # existed.
+ #
+ # NOTE: Logically empty directories still physically
+ # contain the CVS admin directory, hence the check for ==
+ # 1, not == 0. There might also be hidden files, we count
+ # them as well. Always hidden are . and .. and they do not
+ # count as user file.
+
+ file delete $f
+ set fd [file dirname $f]
+ if {
+ ([llength [glob -nocomplain -directory $fd *]] == 1) &&
+ ([llength [glob -nocomplain -directory -type hidden $fd *]] == 2)
+ } {
+ file delete -force $fd
+ }
+ } else {
+ # Added or modified, put the requested version of the file
+ # into the workspace.
+
+ if {[catch {
+ exec $cvs -d $base co -r $r $f
+ } msg]} {
+ if {[string match {*invalid change text*} $msg]} {
+ # The archive of the file is corrupted and the
+ # chosen version not accessible due to that. We
+ # report the problem, but otherwise ignore it. As
+ # a consequence the fossil repository will not
+ # contain the full history of the named file. By
+ # ignoring the problem we however get as much as
+ # is possible.
+
+ Log info " EE Corrupted archive file. Inaccessible revision."
+ continue
+ }
+ return -code error $msg
+ }
+ }
+ }
+
+ # Provide metadata about the changeset the backend may wish to have
+ return [list $u $cm $s]
+}
+
+namespace eval ::cvs {
+ # CVS application
+ # Workspace where checkouts happen
+ # Current working directory to go back to after the import.
+
+ variable cvs [auto_execok cvs]
+ variable workspace {}
+ variable cwd {}
+}
+
+proc ::cvs::foreach_cset {cv node script} {
+ upvar 1 $cv c
+ variable rtree
+
+ set c $node
+ while {1} {
+ uplevel 1 $script
+
+ # Stop on reaching the head.
+ if {![llength [$rtree children $c]]} break
+
+ #puts <[$rtree children $c]>
+
+ # Go to next child in trunk (leftmost).
+ set c [lindex [$rtree children $c] 0]
+ }
+ return
+}
+
+proc ::cvs::root {} {
+ return 0
+}
+
+proc ::cvs::ntrunk {} {
+ variable ntrunk
+ return $ntrunk
+}
+
+proc ::cvs::uuid {c uuid} {
+ variable rtree
+ $rtree set $c uuid $uuid
+ return
+}
+
+# -----------------------------------------------------------------------------
+# Internal helper commands: Changeset inspection and construction.
+
+proc ::cvs::CSClear {} {
+ upvar 1 start start end end cm cm user user files files lastd lastd
+
+ set start {}
+ set end {}
+ set cm {}
+ set user {}
+ set lastd {}
+ array unset files *
+ array set files {}
+ return
+}
+
+proc ::cvs::CSNone {} {
+ upvar 1 start start
+ return [expr {$start eq ""}]
+}
+
+proc ::cvs::CSNew {entry} {
+ upvar 1 start start end end cm cm user user files files lastd lastd reason reason
+
+ #puts -nonewline stdout . ; flush stdout
+
+ foreach {op ts a rev f ecm} $entry break
+
+ # User change
+ if {$a ne $user} {set reason user ; return 1}
+
+ # File already in current cset
+ if {[info exists files($f)]} {set reason file ; return 1}
+
+ # Current cset trunk/branch different from entry.
+ set depth [llength [split $rev .]]
+ if {($lastd == 2) != ($depth == 2)} {set reason depth/$lastd/$depth/($rev)/$f ; return 1}
+
+ # Commit message changed
+ if {$cm ne $ecm} {set reason cmsg\ <<$ecm>> ; return 1}
+
+ # Everything is good, still the same cset
+ return 0
+}
+
+proc ::cvs::CSSave {} {
+ variable cmap
+ variable csets
+ variable ncs
+ upvar 1 start start end end cm cm user user files files lastd lastd
+
+ set csets($ncs) [list $user $cm $start $end $lastd [array get files]]
+
+ # Record which revisions of a file are in what csets
+ foreach {f or} [array get files] {
+ foreach {_ rev} $or break
+ set cmap([list $f $rev]) $ncs
+ }
+
+ #CSDump $ncs
+
+ incr ncs
+ return
+}
+
+proc ::cvs::CSAdd {entry} {
+ upvar 1 start start end end cm cm user user files files lastd lastd
+
+ foreach {op ts a rev f ecm} $entry break
+
+ if {$start eq ""} {set start $ts}
+ set end $ts
+ set cm $ecm
+ set user $a
+ set files($f) [list $op $rev]
+ set lastd [llength [split $rev .]]
+ return
+}
+
+proc ::cvs::CSDump {c} {
+ variable csets
+ foreach {u cm s e rd f} $csets($c) break
+
+ puts "$u $s"; regsub -all {.} $u { } b
+ puts "$b $e"
+ foreach {f or} $f {
+ foreach {o r} $or break
+ puts "$b $o $f $r"
+ }
+ return
+}
+
+# -----------------------------------------------------------------------------
+# Internal helper commands
+
+proc ::cvs::Log {level text} {
+ variable lc
+ uplevel #0 [linsert $lc end $level $text]
+ return
+}
+
+proc ::cvs::Nop {args} {}
+
+namespace eval ::cvs {
+ # Logging callback. No logging by default.
+ variable lc ::cvs::Nop
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+package provide cvs 1.0
+return
Added tools/lib/fossil.tcl version [64ed240c1f]
@@ -1,1 +1,154 @@
+# -----------------------------------------------------------------------------
+# Repository management (FOSSIL)
+
+# -----------------------------------------------------------------------------
+# Requirements
+
+package require Tcl 8.4
+
+namespace eval ::fossil {}
+
+# -----------------------------------------------------------------------------
+# API
+
+# Define repository file, and connect to workspace in CWD.
+
+proc ::fossil::new {} {
+ variable fr [file normalize [fileutil::tempfile import2_fsl_rp_]]
+ variable fossil
+
+ # pwd = workspace
+ exec $fossil new $fr ; # create and
+ exec $fossil open $fr ; # connect
+
+ Log info " Fossil: $fr"
+
+ return $fr
+}
+
+# Define logging callback command
+
+proc ::fossil::feedback {logcmd} {
+ variable lc $logcmd
+ return
+}
+
+# Move generated fossil repository to final destination
+
+proc ::fossil::destination {path} {
+ variable fr
+ file rename $fr $path
+ return
+}
+
+namespace eval ::fossil {
+ # Repository file
+ variable fr {}
+
+ # Fossil application
+ variable fossil [auto_execok fossil]
+}
+
+
+proc ::fossil::commit {appname nosign meta ignore} {
+ variable fossil
+ variable lastuuid
+
+ # Commit the current state of the workspace. Scan for new and
+ # removed files and issue the appropriate fossil add/rm commands
+ # before actually comitting.
+
+ # Modified/Removed files first, that way there won't be any ADDED
+ # indicators. Nor REMOVED, only EDITED. Removed files show up as
+ # EDITED while they are not registered as removed.
+
+ set added 0
+ set removed 0
+ set changed 0
+
+ foreach line [split [exec $fossil changes] \n] {
+ regsub {^\s*EDITED\s*} $line {} path
+ if {[IGNORE $ignore $path]} continue
+
+ if {![file exists $path]} {
+ exec $fossil rm $path
+ incr removed
+ Log info " ** - $path"
+ } else {
+ incr changed
+ Log info " ** * $path"
+ }
+ }
+
+ # Now look for unregistered added files.
+
+ foreach path [split [exec $fossil extra] \n] {
+ if {[IGNORE $ignore $path]} continue
+ exec $fossil add $path
+ incr added
+ Log info " ** + $path"
+ }
+
+ # Now commit, using the provided meta data, and capture the uuid
+ # of the new baseline.
+
+ foreach {user message tstamp} $meta break
+
+ set message [join [list \
+ "-- Originally by $user @ $tstamp" \
+ "-- Imported by $appname" \
+ $message] \n]
+
+ if {[catch {
+ if {$nosign} {
+ exec $fossil commit -m $message --nosign
+ } else {
+ exec $fossil commit -m $message
+ }
+ } line]} {
+ if {![string match "*nothing has changed*" $line]} {
+ return -code error $line
+ }
+
+ # 'Nothing changed' can happen for changesets containing only
+ # dead-first revisions of one or more files. For fossil we
+ # re-use the last baseline. TODO: Mark them as branchpoint,
+ # and for what file.
+
+ Log info " UNCHANGED, keeping last"
+
+ return [list $lastuuid 0 0 0]
+ }
+
+ set line [string trim $line]
+ regsub -nocase -- {^\s*New_Version:\s*} $line {} uuid
+
+ set lastuuid $uuid
+ return [list $uuid $added $removed $changed]
+}
+
+# -----------------------------------------------------------------------------
+# Internal helper commands
+
+proc ::fossil::IGNORE {ignore path} {
+ return [uplevel #0 [linsert $ignore end $path]]
+}
+
+proc ::fossil::Log {level text} {
+ variable lc
+ uplevel #0 [linsert $lc end $level $text]
+ return
+}
+
+proc ::fossil::Nop {args} {}
+
+namespace eval ::fossil {
+ # Logging callback. No logging by default.
+ variable lc ::fossil::Nop
+}
+
+# -----------------------------------------------------------------------------
+# Ready
+package provide fossil 1.0
+return
Modified tools/lib/pkgIndex.tcl from [71b6b857ad] to [bb6c58a2d8].
@@ -1,2 +1,4 @@
if {![package vsatisfies [package require Tcl] 8.4]} return
package ifneeded rcsparser 1.0 [list source [file join $dir rcsparser.tcl]]
+package ifneeded cvs 1.0 [list source [file join $dir cvs.tcl]]
+package ifneeded fossil 1.0 [list source [file join $dir fossil.tcl]]
Modified tools/lib/rcsparser.tcl from [69db20ceda] to [ec0acbb634].
@@ -12,17 +12,48 @@
namespace eval ::rcsparser {}
# -----------------------------------------------------------------------------
# API
+proc ::rcsparser::feedback {logcmd} {
+ variable lc $logcmd
+ return
+}
+
proc ::rcsparser::process {path} {
set data [fileutil::cat -encoding binary $path]
array set res {}
+ set res(size) [file size $path]
+ set res(done) 0
+ set res(nsize) [string length $res(size)]
+
Admin
Deltas
Description
DeltaTexts
+
+ Feedback \r
+
+ # Remove parser state
+ catch {unset res(id)}
+ catch {unset res(lastval)}
+ unset res(size)
+ unset res(nsize)
+ unset res(done)
+
+ # res: 'head' -> head revision
+ # 'branch' -> ?
+ # 'symbol' -> (sym -> revision)
+ # 'lock' -> (sym -> revision)
+ # 'comment' -> file comment
+ # 'expand' -> ?
+ # 'date' -> (revision -> date)
+ # 'author' -> (revision -> author)
+ # 'state' -> (revision -> state)
+ # 'parent' -> (revision -> parent revision)
+ # 'commit' -> (revision -> commit message)
+
return [array get res]
}
# -----------------------------------------------------------------------------
# Internal helper commands
@@ -33,11 +64,11 @@
return
}
proc ::rcsparser::Deltas {} {
upvar 1 data data res res
- while {[Num 0]} { Date ; Author ; State ; Branches ; NextRev }
+ while {[Num 0]} { IsIdent ; Date ; Author ; State ; Branches ; NextRev }
return
}
proc ::rcsparser::Description {} {
upvar 1 data data res res
@@ -47,11 +78,11 @@
return
}
proc ::rcsparser::DeltaTexts {} {
upvar 1 data data res res
- while {[Num 0]} { Log ; Text }
+ while {[Num 0]} { IsIdent ; Log ; Text }
return
}
proc ::rcsparser::Head {} {
upvar 1 data data res res
@@ -114,22 +145,27 @@
}
proc ::rcsparser::Date {} {
upvar 1 data data res res
Literal date ; Num 1 ; Literal \;
+
+ foreach {yr mo dy h m s} [split $res(lastval) .] break
+ if {$yr < 100} {incr yr 1900}
+ set res(lastval) [join [list $yr $mo $dy $h $m $s] .]
+ Map date
return
}
proc ::rcsparser::Author {} {
upvar 1 data data res res
- Literal author ; Skip ; Literal \;
+ Literal author ; Skip ; Literal \; ; Map author
return
}
proc ::rcsparser::State {} {
upvar 1 data data res res
- Literal state ; Skip ; Literal \;
+ Literal state ; Skip ; Literal \; ; Map state
return
}
proc ::rcsparser::Branches {} {
upvar 1 data data res res
@@ -137,25 +173,27 @@
return
}
proc ::rcsparser::NextRev {} {
upvar 1 data data res res
- Literal next ; Skip ; Literal \;
+ Literal next ; Skip ; Literal \; ; Map parent
return
}
proc ::rcsparser::Log {} {
upvar 1 data data res res
- IsIdent ; Literal log ; String 1 ; Map commit
+ Literal log ; String 1 ; Map commit
return
}
proc ::rcsparser::Text {} {
upvar 1 data data res res
Literal text ; String 1
return
}
+
+# -----------------------------------------------------------------------------
proc ::rcsparser::Ident {} {
upvar 1 data data res res
#puts I@?<[string range $data 0 10]...>
@@ -213,11 +251,12 @@
return 1
}
proc ::rcsparser::Skip {} {
upvar 1 data data res res
- regexp -indices -- {^\s*[^;]*\s*} $data match
+ regexp -indices -- {^\s*([^;]*)\s*} $data match val
+ Get $val
Next
return
}
proc ::rcsparser::Def {key} {
@@ -230,11 +269,11 @@
proc ::rcsparser::Map {key} {
upvar 1 data data res res
lappend res($key) $res(id) $res(lastval)
#puts Map($res(id))=($res(lastval))
unset res(lastval)
- unset res(id)
+ #unset res(id);#Keep id for additional mappings.
return
}
proc ::rcsparser::IsIdent {} {
upvar 1 data data res res
@@ -250,16 +289,33 @@
#puts G|$res(lastval)
return
}
proc ::rcsparser::Next {} {
- upvar 1 match match data data
+ upvar 1 match match data data res res
foreach {s e} $match break ; incr e
set data [string range $data $e end]
+ set res(done) [expr {$res(size) - [string length $data]}]
+
+ Feedback "\r [format "%$res(nsize)s" $res(done)]/$res(size) "
+ return
+}
+
+# -----------------------------------------------------------------------------
+
+namespace eval ::rcsparser {
+ variable lc ::rcs::Nop
+}
+
+proc ::rcsparser::Feedback {text} {
+ variable lc
+ uplevel #0 [linsert $lc end info $text]
return
}
+
+proc ::rcsparser::Nop {args} {}
# -----------------------------------------------------------------------------
# Ready
package provide rcsparser 1.0
return