Artifact 78ad19a406a27646f818316b104b96dda50e274d
File
tools/cvs2fossil/lib/c2f_project.tcl
part of check-in
[2c08006d9d]
- Changed the coding of trunk symbols. Using NULL makes for difficult comparisons later when doing integrity checks. Each trunk now has a regular unique id as a symbol. Added documentation to the table definitions, about references, constraints, etc.
by
aku on
2007-10-25 05:13:41.
## -*- 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
# # ## ### ##### ######## ############# #####################
## Project, part of a CVS repository. Multiple instances are possible.
# # ## ### ##### ######## ############# #####################
## Requirements
package require Tcl 8.4 ; # Required runtime.
package require snit ; # OO system.
package require vc::fossil::import::cvs::file ; # CVS archive file.
package require vc::fossil::import::cvs::state ; # State storage.
package require vc::fossil::import::cvs::project::sym ; # Per project symbols.
package require vc::fossil::import::cvs::project::trunk ; # Per project trunk, main lod
package require struct::list ; # Advanced list operations..
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::project {
# # ## ### ##### ######## #############
## Public API
constructor {path r} {
set mybase $path
set myrepository $r
set mytrunk [trunk %AUTO% $self]
return
}
method base {} { return $mybase }
method trunk {} { return $mytrunk }
method printbase {} {
if {$mybase eq ""} {return <Repository>}
return $mybase
}
method setid {id} { set myid $id ; return }
method addfile {rcs usr executable {fid {}}} {
set myfiles($rcs) [list $usr $executable $fid]
return
}
method filenames {} {
return [lsort -dict [array names myfiles]]
}
method files {} {
return [TheFiles]
}
delegate method defauthor to myrepository
delegate method defcmessage to myrepository
delegate method trunkonly to myrepository
delegate method commitmessageof to myrepository
method defmeta {bid aid cid} {
return [$myrepository defmeta $myid $bid $aid $cid]
}
method getsymbol {name} {
if {![info exists mysymbols($name)]} {
set mysymbols($name) \
[sym %AUTO% $name [$myrepository defsymbol $myid $name]]
}
return $mysymbols($name)
}
# pass I persistence
method persist {} {
TheFiles ; # Force id assignment.
state transaction {
# Project data first. Required so that we have its id
# ready for the files.
state run {
INSERT INTO project (pid, name)
VALUES (NULL, $mybase);
}
set myid [state id]
# Then all files, with proper backreference to their
# project.
foreach rcs [lsort -dict [array names myfiles]] {
struct::list assign $myfiles($rcs) usr executable _fid_
state run {
INSERT INTO file (fid, pid, name, visible, exec)
VALUES (NULL, $myid, $rcs, $usr, $executable);
}
$myfmap($rcs) setid [state id]
}
}
return
}
# pass II persistence
method persistrev {} {
# Note: The per file information (incl. revisions and symbols)
# has already been saved and dropped, immediately after
# processing it, to keep out use of memory under control. Now
# we just have to save the remaining project level parts to
# fix the left-over dangling references.
state transaction {
# TODO: per project persistence (symbols, meta data)
}
return
}
# # ## ### ##### ######## #############
## State
variable mybase {} ; # Project directory.
variable myid {} ; # Project id in the persistent state.
variable mytrunk {} ; # Reference to the main line of
# development for the project.
variable myfiles -array {} ; # Maps the rcs archive paths to
# their user-visible files.
variable myfobj {} ; # File objects for the rcs archives
variable myfmap -array {} ; # Map rcs archive to their object.
variable myrepository {} ; # Repository the prject belongs to.
variable mysymbols -array {} ; # Map symbol names to project-level
# symbol objects.
# # ## ### ##### ######## #############
## Internal methods
proc TheFiles {} {
upvar 1 myfiles myfiles myfobj myfobj self self myfmap myfmap
if {![llength $myfobj]} {
set myfobj [EmptyFiles myfiles]
}
return $myfobj
}
proc EmptyFiles {fv} {
upvar 1 $fv myfiles self self myfmap myfmap
set res {}
foreach rcs [lsort -dict [array names myfiles]] {
struct::list assign $myfiles($rcs) f executable fid
set file [file %AUTO% $fid $rcs $f $executable $self]
lappend res $file
set myfmap($rcs) $file
}
return $res
}
# # ## ### ##### ######## #############
## Configuration
pragma -hastypeinfo no ; # no type introspection
pragma -hasinfo no ; # no object introspection
pragma -hastypemethods no ; # type is not relevant.
# # ## ### ##### ######## #############
}
namespace eval ::vc::fossil::import::cvs {
namespace export project
namespace eval project {
namespace import ::vc::fossil::import::cvs::file
namespace import ::vc::fossil::import::cvs::state
# Import not required, already a child namespace.
# namespace import ::vc::fossil::import::cvs::project::sym
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::project 1.0
return