initial commitHEADmaster

1 files changed, 273 insertions, 0 deletions

diff --git a/tools/cvs2fossil/lib/c2f_fossil.tcl b/tools/cvs2fossil/lib/c2f_fossil.tcl
new file mode 100644
index 0000000..6465d98
--- /dev/null
+++ b/tools/cvs2fossil/lib/c2f_fossil.tcl
@@ -0,0 +1,273 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007-2008 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
+# # ## ### ##### ######## ############# #####################
+
+## Fossil, a helper class managing the access to fossil repositories.
+
+# # ## ### ##### ######## ############# #####################
+## Requirements
+
+package require Tcl 8.4                             ; # Required runtime.
+package require fileutil                            ; # Temp.dir/file
+package require snit                                ; # OO system.
+package require vc::tools::trouble                  ; # Error reporting.
+package require vc::tools::log                      ; # User feedback
+package require vc::fossil::import::cvs::integrity  ; # State integrity checks.
+
+# # ## ### ##### ######## ############# #####################
+##
+
+snit::type ::vc::fossil::import::cvs::fossil {
+    # # ## ### ##### ######## #############
+    ## Public API
+
+    constructor {} {
+	return
+    }
+
+    method initialize {} {
+	set myrepository [fileutil::tempfile cvs2fossil_repo_]
+	set myworkspace  [fileutil::tempfile cvs2fossil_wspc_]
+	::file delete $myworkspace
+	::file mkdir  $myworkspace
+
+	Do new [::file nativename $myrepository]
+	$self InWorkspace ; Do open [::file nativename $myrepository]
+	$self RestorePwd
+
+	log write 8 fossil {Scratch repository created @ $myrepository}
+	log write 8 fossil {Scratch workspace  created @ $myworkspace }
+	return
+    }
+
+    method load {r w} {
+	set myrepository $r
+	set myworkspace  $w
+
+	log write 8 fossil {Scratch repository found @ $myrepository}
+	log write 8 fossil {Scratch workspace  found @ $myworkspace}
+	return
+    }
+
+    method space {} {
+	return [list $myrepository $myworkspace]
+    }
+
+    # # ## ### ##### ######## #############
+    ##
+
+    method root {} {
+	# The id of the root manifest is hardwired into fossil. This
+	# manifest is created when a new repository is made (See
+	# 'new', in the constructor).
+	return 1
+    }
+
+    method workspace {} { return $myworkspace }
+
+    method importfiles {map} {
+	# map = list (instruction), instruction = add|delta
+	# add   = list ('A', path)
+	# delta = list ('D', path, src)
+
+	log write 3 fossil {Importing revisions...}
+
+	array set id {}
+	$self InWorkspace
+
+	set n   0
+	set max [llength $map]
+
+	foreach insn $map {
+	    log progress 3 fossil $n $max ; incr n
+
+	    struct::list assign $insn cmd pa pb
+	    switch -exact -- $cmd {
+		A {
+		    log write 8 fossil {Importing   <$pa>,}
+
+		    # Result = 'inserted as record :FOO:'
+		    #           0        1  2     3
+		    set res [Do test-content-put $pa]
+		    integrity assert {
+			[regexp {^inserted as record \d+$} $res]
+		    } {Unable to process unexpected fossil output '$res'}
+		    set id($pa) [lindex $res 3]
+		}
+		D {
+		    log write 8 fossil {Compressing <$pa>, as delta of <$pb>}
+
+		    Do test-content-deltify $id($pa) $id($pb) 1
+		}
+	    }
+	}
+	$self RestorePwd
+
+	log write 3 fossil Done.
+	return [array get id]
+    }
+
+    method importrevision {label user message date parent revisions} {
+	# Massage the commit message to remember the old user name
+	# which did the commit in CVS.
+
+	set message "By $user:\n$message"
+
+	log write 2 fossil {== $user @ [clock format $date]}
+	log write 2 fossil {-> $parent}
+	log write 9 fossil {%% [join [split $message \n] "\n%% "]}
+
+	lappend cmd Do test-import-manifest $date $message
+	if {$parent ne ""} { lappend cmd -p $parent }
+	foreach {frid fpath flabel} $revisions {
+	    lappend cmd -f $frid $fpath
+	    log write 12 fossil {** <[format %5d $frid]> = <$flabel>}
+	}
+
+	# run fossil test-command performing the import.
+	log write 12 fossil {	[lreplace $cmd 3 3 @@]}
+
+	$self InWorkspace
+	set res [eval $cmd]
+	$self RestorePwd
+
+	integrity assert {
+	    [regexp {^inserted as record \d+, [0-9a-fA-F]+$} $res]
+	} {Unable to process unexpected fossil output '$res'}
+	set rid  [string trim [lindex $res 3] ,]
+	set uuid [lindex $res 4]
+
+	log write 2 fossil {== $rid ($uuid)}
+
+	return [list $rid $uuid]
+    }
+
+    method tag {uuid name} {
+	log write 2 fossil {Tag '$name' @ $uuid}
+
+	$self InWorkspace
+	Do tag add sym-$name $uuid
+	$self RestorePwd
+	return
+    }
+
+    method branchmark {uuid name} {
+	# We do not mark the trunk
+	if {$name eq ":trunk:"} return
+
+	log write 2 fossil {Begin branch '$name' @ $uuid}
+
+	$self InWorkspace
+	Do tag branch sym-$name $uuid
+	$self RestorePwd
+	return
+    }
+
+    method branchcancel {uuid name} {
+	# The trunk is unmarked, thus cancellation is not needed
+	# either.
+	if {$name eq ":trunk:"} return
+
+	log write 2 fossil {Cancel branch '$name' @ $uuid}
+
+	$self InWorkspace
+	Do tag delete sym-$name $uuid
+	$self RestorePwd
+	return
+    }
+
+    method finalize {destination} {
+	log write 2 fossil {Finalize, rebuilding repository}
+	Do rebuild [::file nativename $myrepository]
+
+	::file rename -force $myrepository $destination
+	::file delete -force $myworkspace
+	$self destroy
+
+	log write 2 fossil {destination $destination}
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ##
+
+    typemethod setlocation {path} {
+	set myfossilcmd    $path
+	set myneedlocation 0
+	return
+    }
+
+    typemethod validate {} {
+	if {!$myneedlocation} {
+	    if {![fileutil::test $myfossilcmd efrx msg]} {
+		trouble fatal "Bad path for fossil executable: $msg"
+	    }
+	} else {
+	    trouble fatal "Don't know where to find the 'fossil' executable"
+	}
+	return
+    }
+
+    typeconstructor {
+	set location [auto_execok fossil]
+	set myneedlocation [expr {$location eq ""}]
+	if {$myneedlocation} return
+	$type setlocation $location
+	return
+    }
+
+    # # ## ### ##### ######## #############
+    ## State
+
+    variable mypwd        {} ; # Path to last CWD
+    variable myrepository {} ; # Path to our fossil database.
+    variable myworkspace  {} ; # Path to the workspace for our fossil
+			       # database.
+
+    typevariable myfossilcmd    ; # Path to fossil executable.
+    typevariable myneedlocation ; # Boolean, indicates if user has to
+				  # tell us where fossil lives or not.
+
+    # # ## ### ##### ######## #############
+    ## Internal methods
+
+    proc Do {args} {
+	# 8.5: exec $myfossilcmd {*}$args
+	log write 14 fossil {Doing '$args'}
+	return [eval [linsert $args 0 exec $myfossilcmd]]
+    }
+
+    method InWorkspace {} { set mypwd [pwd] ; cd $myworkspace ; return }
+    method RestorePwd  {} { cd $mypwd       ; set mypwd {}    ; return }
+
+    # # ## ### ##### ######## #############
+    ## Configuration
+
+    pragma -hastypeinfo    no  ; # no type introspection
+    pragma -hasinfo        no  ; # no object introspection
+
+    # # ## ### ##### ######## #############
+}
+
+namespace eval ::vc::fossil::import::cvs {
+    namespace export fossil
+    namespace eval   fossil {
+	namespace import ::vc::tools::trouble
+	namespace import ::vc::tools::log
+	namespace import ::vc::fossil::import::cvs::integrity
+    }
+}
+
+# # ## ### ##### ######## ############# #####################
+## Ready
+
+package provide vc::fossil::import::cvs::fossil 1.0
+return