b6bf21e2a8 2007-12-05 aku: ## -*- tcl -*- b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# ##################### 66235f2430 2008-02-06 aku: ## Copyright (c) 2007-2008 Andreas Kupries. b6bf21e2a8 2007-12-05 aku: # b6bf21e2a8 2007-12-05 aku: # This software is licensed as described in the file LICENSE, which b6bf21e2a8 2007-12-05 aku: # you should have received as part of this distribution. b6bf21e2a8 2007-12-05 aku: # b6bf21e2a8 2007-12-05 aku: # This software consists of voluntary contributions made by many b6bf21e2a8 2007-12-05 aku: # individuals. For exact contribution history, see the revision b6bf21e2a8 2007-12-05 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# ##################### b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: ## Fossil, a helper class managing the access to fossil repositories. b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# ##################### b6bf21e2a8 2007-12-05 aku: ## Requirements b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: package require Tcl 8.4 ; # Required runtime. b6bf21e2a8 2007-12-05 aku: package require fileutil ; # Temp.dir/file b6bf21e2a8 2007-12-05 aku: package require snit ; # OO system. b6bf21e2a8 2007-12-05 aku: package require vc::tools::trouble ; # Error reporting. b6bf21e2a8 2007-12-05 aku: package require vc::tools::log ; # User feedback b6bf21e2a8 2007-12-05 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# ##################### b6bf21e2a8 2007-12-05 aku: ## b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: snit::type ::vc::fossil::import::cvs::fossil { b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## Public API b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: constructor {} { b7fc4d9d04 2008-03-05 aku: return b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method initialize {} { b6bf21e2a8 2007-12-05 aku: set myrepository [fileutil::tempfile cvs2fossil_repo_] b6bf21e2a8 2007-12-05 aku: set myworkspace [fileutil::tempfile cvs2fossil_wspc_] 7208c7ac4d 2008-01-28 mjanssen: ::file delete $myworkspace 7208c7ac4d 2008-01-28 mjanssen: ::file mkdir $myworkspace 7208c7ac4d 2008-01-28 mjanssen: 7208c7ac4d 2008-01-28 mjanssen: Do new [::file nativename $myrepository] 7208c7ac4d 2008-01-28 mjanssen: $self InWorkspace ; Do open [::file nativename $myrepository] b6bf21e2a8 2007-12-05 aku: $self RestorePwd 9214c11831 2008-02-02 aku: b7fc4d9d04 2008-03-05 aku: log write 8 fossil {Scratch repository created @ $myrepository} b7fc4d9d04 2008-03-05 aku: log write 8 fossil {Scratch workspace created @ $myworkspace } b7fc4d9d04 2008-03-05 aku: return b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method load {r w} { b7fc4d9d04 2008-03-05 aku: set myrepository $r b7fc4d9d04 2008-03-05 aku: set myworkspace $w b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: log write 8 fossil {Scratch repository found @ $myrepository} b7fc4d9d04 2008-03-05 aku: log write 8 fossil {Scratch workspace found @ $myworkspace} b6bf21e2a8 2007-12-05 aku: return b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method space {} { b7fc4d9d04 2008-03-05 aku: return [list $myrepository $myworkspace] b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: method root {} { b6bf21e2a8 2007-12-05 aku: # The id of the root manifest is hardwired into fossil. This b6bf21e2a8 2007-12-05 aku: # manifest is created when a new repository is made (See b6bf21e2a8 2007-12-05 aku: # 'new', in the constructor). b6bf21e2a8 2007-12-05 aku: return 1 b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: method workspace {} { return $myworkspace } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: method importfiles {map} { b6bf21e2a8 2007-12-05 aku: # map = list (instruction), instruction = add|delta b6bf21e2a8 2007-12-05 aku: # add = list ('A', path) b6bf21e2a8 2007-12-05 aku: # delta = list ('D', path, src) b6bf21e2a8 2007-12-05 aku: e60ba15821 2008-01-27 aku: log write 3 fossil {Importing revisions...} 08f8085700 2007-12-06 aku: b6bf21e2a8 2007-12-05 aku: array set id {} b6bf21e2a8 2007-12-05 aku: $self InWorkspace 08f8085700 2007-12-06 aku: 08f8085700 2007-12-06 aku: set n 0 08f8085700 2007-12-06 aku: set max [llength $map] 08f8085700 2007-12-06 aku: b6bf21e2a8 2007-12-05 aku: foreach insn $map { 08f8085700 2007-12-06 aku: log progress 3 fossil $n $max ; incr n 08f8085700 2007-12-06 aku: b6bf21e2a8 2007-12-05 aku: struct::list assign $insn cmd pa pb b6bf21e2a8 2007-12-05 aku: switch -exact -- $cmd { b6bf21e2a8 2007-12-05 aku: A { 08f8085700 2007-12-06 aku: log write 8 fossil {Importing <$pa>,} b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # Result = 'inserted as record :FOO:' b6bf21e2a8 2007-12-05 aku: # 0 1 2 3 b6bf21e2a8 2007-12-05 aku: set res [Do test-content-put $pa] b6bf21e2a8 2007-12-05 aku: integrity assert { b6bf21e2a8 2007-12-05 aku: [regexp {^inserted as record \d+$} $res] b6bf21e2a8 2007-12-05 aku: } {Unable to process unexpected fossil output '$res'} b6bf21e2a8 2007-12-05 aku: set id($pa) [lindex $res 3] b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: D { 08f8085700 2007-12-06 aku: log write 8 fossil {Compressing <$pa>, as delta of <$pb>} b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: Do test-content-deltify $id($pa) $id($pb) 1 b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: $self RestorePwd e60ba15821 2008-01-27 aku: e60ba15821 2008-01-27 aku: log write 3 fossil Done. b6bf21e2a8 2007-12-05 aku: return [array get id] b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: f9e0d23d97 2008-01-30 aku: method importrevision {label user message date parent revisions} { f9e0d23d97 2008-01-30 aku: # Massage the commit message to remember the old user name f9e0d23d97 2008-01-30 aku: # which did the commit in CVS. f9e0d23d97 2008-01-30 aku: f9e0d23d97 2008-01-30 aku: set message "By $user:\n$message" f9e0d23d97 2008-01-30 aku: 7c43583de1 2008-01-31 aku: log write 2 fossil {== $user @ [clock format $date]} 7c43583de1 2008-01-31 aku: log write 2 fossil {-> $parent} 8ec5d8c87c 2008-02-05 aku: log write 9 fossil {%% [join [split $message \n] "\n%% "]} 7c43583de1 2008-01-31 aku: 7c43583de1 2008-01-31 aku: lappend cmd Do test-import-manifest $date $message b7a93530ef 2008-02-01 aku: if {$parent ne ""} { lappend cmd -p $parent } 7c43583de1 2008-01-31 aku: foreach {frid fpath flabel} $revisions { b7a93530ef 2008-02-01 aku: lappend cmd -f $frid $fpath e7138d7f9c 2008-02-04 aku: log write 12 fossil {** <[format %5d $frid]> = <$flabel>} 7c43583de1 2008-01-31 aku: } 7c43583de1 2008-01-31 aku: f9e0d23d97 2008-01-30 aku: # run fossil test-command performing the import. e7138d7f9c 2008-02-04 aku: log write 12 fossil { [lreplace $cmd 3 3 @@]} 9214c11831 2008-02-02 aku: 9214c11831 2008-02-02 aku: $self InWorkspace 9214c11831 2008-02-02 aku: set res [eval $cmd] 9214c11831 2008-02-02 aku: $self RestorePwd 9214c11831 2008-02-02 aku: 9214c11831 2008-02-02 aku: integrity assert { b7fc4d9d04 2008-03-05 aku: [regexp {^inserted as record \d+, [0-9a-fA-F]+$} $res] 9214c11831 2008-02-02 aku: } {Unable to process unexpected fossil output '$res'} b7fc4d9d04 2008-03-05 aku: set rid [string trim [lindex $res 3] ,] b7fc4d9d04 2008-03-05 aku: set uuid [lindex $res 4] b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: log write 2 fossil {== $rid ($uuid)} b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: return [list $rid $uuid] b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method tag {uuid name} { b7fc4d9d04 2008-03-05 aku: log write 2 fossil {Tag '$name' @ $uuid} b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: $self InWorkspace b7fc4d9d04 2008-03-05 aku: Do tag add sym-$name $uuid b7fc4d9d04 2008-03-05 aku: $self RestorePwd b7fc4d9d04 2008-03-05 aku: return b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method branchmark {uuid name} { b7fc4d9d04 2008-03-05 aku: # We do not mark the trunk b7fc4d9d04 2008-03-05 aku: if {$name eq ":trunk:"} return b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: log write 2 fossil {Begin branch '$name' @ $uuid} b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: $self InWorkspace b7fc4d9d04 2008-03-05 aku: Do tag branch sym-$name $uuid b7fc4d9d04 2008-03-05 aku: $self RestorePwd b7fc4d9d04 2008-03-05 aku: return b7fc4d9d04 2008-03-05 aku: } b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: method branchcancel {uuid name} { b7fc4d9d04 2008-03-05 aku: # The trunk is unmarked, thus cancellation is not needed b7fc4d9d04 2008-03-05 aku: # either. b7fc4d9d04 2008-03-05 aku: if {$name eq ":trunk:"} return b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: log write 2 fossil {Cancel branch '$name' @ $uuid} b7fc4d9d04 2008-03-05 aku: b7fc4d9d04 2008-03-05 aku: $self InWorkspace b7fc4d9d04 2008-03-05 aku: Do tag delete sym-$name $uuid b7fc4d9d04 2008-03-05 aku: $self RestorePwd b7fc4d9d04 2008-03-05 aku: return f9e0d23d97 2008-01-30 aku: } f9e0d23d97 2008-01-30 aku: b6bf21e2a8 2007-12-05 aku: method finalize {destination} { b7fc4d9d04 2008-03-05 aku: log write 2 fossil {Finalize, rebuilding repository} 9214c11831 2008-02-02 aku: Do rebuild [::file nativename $myrepository] 9214c11831 2008-02-02 aku: 7208c7ac4d 2008-01-28 mjanssen: ::file rename -force $myrepository $destination 7208c7ac4d 2008-01-28 mjanssen: ::file delete -force $myworkspace b6bf21e2a8 2007-12-05 aku: $self destroy 0d02fe6c7a 2008-02-12 aku: 0d02fe6c7a 2008-02-12 aku: log write 2 fossil {destination $destination} b6bf21e2a8 2007-12-05 aku: return b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: typemethod setlocation {path} { b6bf21e2a8 2007-12-05 aku: set myfossilcmd $path b6bf21e2a8 2007-12-05 aku: set myneedlocation 0 b6bf21e2a8 2007-12-05 aku: return b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: typemethod validate {} { b6bf21e2a8 2007-12-05 aku: if {!$myneedlocation} { b6bf21e2a8 2007-12-05 aku: if {![fileutil::test $myfossilcmd efrx msg]} { b6bf21e2a8 2007-12-05 aku: trouble fatal "Bad path for fossil executable: $msg" b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: } else { b6bf21e2a8 2007-12-05 aku: trouble fatal "Don't know where to find the 'fossil' executable" b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: return b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: typeconstructor { b6bf21e2a8 2007-12-05 aku: set location [auto_execok fossil] b6bf21e2a8 2007-12-05 aku: set myneedlocation [expr {$location eq ""}] b6bf21e2a8 2007-12-05 aku: if {$myneedlocation} return b6bf21e2a8 2007-12-05 aku: $type setlocation $location b6bf21e2a8 2007-12-05 aku: return b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## State b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: variable mypwd {} ; # Path to last CWD b6bf21e2a8 2007-12-05 aku: variable myrepository {} ; # Path to our fossil database. b6bf21e2a8 2007-12-05 aku: variable myworkspace {} ; # Path to the workspace for our fossil b6bf21e2a8 2007-12-05 aku: # database. b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: typevariable myfossilcmd ; # Path to fossil executable. b6bf21e2a8 2007-12-05 aku: typevariable myneedlocation ; # Boolean, indicates if user has to b6bf21e2a8 2007-12-05 aku: # tell us where fossil lives or not. b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## Internal methods b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: proc Do {args} { b6bf21e2a8 2007-12-05 aku: # 8.5: exec $myfossilcmd {*}$args b7fc4d9d04 2008-03-05 aku: log write 14 fossil {Doing '$args'} b6bf21e2a8 2007-12-05 aku: return [eval [linsert $args 0 exec $myfossilcmd]] b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: method InWorkspace {} { set mypwd [pwd] ; cd $myworkspace ; return } b6bf21e2a8 2007-12-05 aku: method RestorePwd {} { cd $mypwd ; set mypwd {} ; return } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: ## Configuration b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: pragma -hastypeinfo no ; # no type introspection b6bf21e2a8 2007-12-05 aku: pragma -hasinfo no ; # no object introspection b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: namespace eval ::vc::fossil::import::cvs { b6bf21e2a8 2007-12-05 aku: namespace export fossil b6bf21e2a8 2007-12-05 aku: namespace eval fossil { b6bf21e2a8 2007-12-05 aku: namespace import ::vc::tools::trouble b6bf21e2a8 2007-12-05 aku: namespace import ::vc::tools::log b6bf21e2a8 2007-12-05 aku: namespace import ::vc::fossil::import::cvs::integrity b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: } b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: # # ## ### ##### ######## ############# ##################### b6bf21e2a8 2007-12-05 aku: ## Ready b6bf21e2a8 2007-12-05 aku: b6bf21e2a8 2007-12-05 aku: package provide vc::fossil::import::cvs::fossil 1.0 b6bf21e2a8 2007-12-05 aku: return
File Annotation