Overview
| SHA1 Hash: | b6bf21e2a81ce241a94584d9fca9accf5d97276b |
|---|---|
| Date: | 2007-12-05 07:52:00 |
| User: | aku |
| Comment: | Added helper class managing access to fossil repositories. Already has a basic method to import and delta-compress a series of files. Used 'test' commands of fossil to get the necessary low-level access. |
| 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]Added tools/cvs2fossil/lib/c2f_fossil.tcl version [368156861d]
@@ -1,1 +1,168 @@
+## -*- tcl -*-
+# # ## ### ##### ######## ############# #####################
+## Copyright (c) 2007 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 {} {
+ set myrepository [fileutil::tempfile cvs2fossil_repo_]
+ set myworkspace [fileutil::tempfile cvs2fossil_wspc_]
+ file delete $myworkspace
+ file mkdir $myworkspace
+
+ Do new $myrepository
+ $self InWorkspace ; Do open $myrepository
+ $self RestorePwd
+ return
+ }
+
+ # # ## ### ##### ######## #############
+ ##
+
+ 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)
+
+ array set id {}
+ $self InWorkspace
+ foreach insn $map {
+ struct::list assign $insn cmd pa pb
+ switch -exact -- $cmd {
+ A {
+ log write 2 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 2 fossil {Compressing <$pa>, as delta of <$pb>}
+
+ Do test-content-deltify $id($pa) $id($pb) 1
+ }
+ }
+ }
+ $self RestorePwd
+ return [array get id]
+ }
+
+ method finalize {destination} {
+ file rename -force $myrepository $destination
+ file delete -force $myworkspace
+ $self destroy
+ 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
+ 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
Modified tools/cvs2fossil/lib/pkgIndex.tcl from [0a082ba7c7] to [c5fb9baccf].
@@ -7,10 +7,11 @@ package ifneeded vc::fossil::import::cvs::file 1.0 [list source [file join $dir c2f_file.tcl]] package ifneeded vc::fossil::import::cvs::file::lodmgr 1.0 [list source [file join $dir c2f_flodmgr.tcl]] package ifneeded vc::fossil::import::cvs::file::rev 1.0 [list source [file join $dir c2f_frev.tcl]] package ifneeded vc::fossil::import::cvs::file::sym 1.0 [list source [file join $dir c2f_fsym.tcl]] package ifneeded vc::fossil::import::cvs::file::trunk 1.0 [list source [file join $dir c2f_ftrunk.tcl]] +package ifneeded vc::fossil::import::cvs::fossil 1.0 [list source [file join $dir c2f_fossil.tcl]] package ifneeded vc::fossil::import::cvs::option 1.0 [list source [file join $dir c2f_option.tcl]] package ifneeded vc::fossil::import::cvs::integrity 1.0 [list source [file join $dir c2f_integrity.tcl]] package ifneeded vc::fossil::import::cvs::pass 1.0 [list source [file join $dir c2f_pass.tcl]] package ifneeded vc::fossil::import::cvs::pass::collar 1.0 [list source [file join $dir c2f_pcollar.tcl]] package ifneeded vc::fossil::import::cvs::pass::collrev 1.0 [list source [file join $dir c2f_pcollrev.tcl]]