Artifact 15df8101524f815ebb17242245ecbb9446e3bb44
File
tools/cvs2fossil/lib/c2f_project.tcl
part of check-in
[82e35d3304]
- Extended project class with method return full path of the project, i.e. inclusive its repository base path.
by
aku on
2007-12-05 07:47:36.
## -*- 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 vc::tools::log ; # User feedback
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]
set mysymbol([$mytrunk name]) $mytrunk
return
}
method base {} { return $mybase }
method trunk {} { return $mytrunk }
method fullpath {} { return [$myrepository base?]/$mybase }
method printbase {} {
if {$mybase eq ""} {return <Repository>}
return $mybase
}
method id {} { return $myid }
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 mysymbol($name)]} {
set mysymbol($name) \
[sym %AUTO% $name [$myrepository defsymbol $myid $name] $self]
}
return $mysymbol($name)
}
method hassymbol {name} {
return [info exists mysymbol($name)]
}
method purgeghostsymbols {} {
set changes 1
while {$changes} {
set changes 0
foreach {name symbol} [array get mysymbol] {
if {![$symbol isghost]} continue
log write 3 project "$mybase: Deleting ghost symbol '$name'"
$symbol destroy
unset mysymbol($name)
set changes 1
}
}
return
}
method determinesymboltypes {} {
foreach {name symbol} [array get mysymbol] {
$symbol determinetype
}
return
}
# 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. This was done
# immediately after processing it, i.e. as part of the main
# segment of the pass, to keep out use of memory under
# control.
#
# The repository level information has been saved as well too,
# just before saving the projects started. So now we just have
# to save the remaining project level parts to fix the
# left-over dangling references, which are the symbols.
state transaction {
foreach {name symbol} [array get mysymbol] {
$symbol persistrev
}
}
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 mysymbol -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::tools::log
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