summaryrefslogtreecommitdiff
path: root/tools/cvs2fossil/lib/c2f_fossil.tcl
diff options
context:
space:
mode:
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_fossil.tcl')
-rw-r--r--tools/cvs2fossil/lib/c2f_fossil.tcl273
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
generated by cgit v1.3.1 (git 2.54.0) at 2026-10-17 05:42:32 +0000