Artifact 55a6ec9011f9335bac80172c4d49a7989ef2f116:

  • File tools/cvs2fossil/lib/c2f_fossil.tcl — part of check-in [b7fc4d9d] at 2008-03-05 03:35:16 on branch trunk — Extended test-import-manifest to return not only the record-id, but the hash uuid as well. Extended the fossil accessor class with methods for regular and branch tagging. Split the initialization from construction (needed for when we split the import pass into three), and a method to set/retrieve the accessor's configuration (persistence across passes). (user: aku size: 7274) [more...]

## -*- 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