52f2254007 2007-10-04 aku: ## -*- tcl -*- 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 52f2254007 2007-10-04 aku: ## Copyright (c) 2007 Andreas Kupries. 52f2254007 2007-10-04 aku: # 52f2254007 2007-10-04 aku: # This software is licensed as described in the file LICENSE, which 52f2254007 2007-10-04 aku: # you should have received as part of this distribution. 52f2254007 2007-10-04 aku: # 52f2254007 2007-10-04 aku: # This software consists of voluntary contributions made by many 52f2254007 2007-10-04 aku: # individuals. For exact contribution history, see the revision 52f2254007 2007-10-04 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: ## Project, part of a CVS repository. Multiple instances are possible. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 52f2254007 2007-10-04 aku: ## Requirements 52f2254007 2007-10-04 aku: e5441b908d 2007-10-15 aku: package require Tcl 8.4 ; # Required runtime. e5441b908d 2007-10-15 aku: package require snit ; # OO system. e5441b908d 2007-10-15 aku: package require vc::fossil::import::cvs::file ; # CVS archive file. e5441b908d 2007-10-15 aku: package require vc::fossil::import::cvs::state ; # State storage. e5441b908d 2007-10-15 aku: package require vc::fossil::import::cvs::project::sym ; # Per project symbols. e5441b908d 2007-10-15 aku: package require vc::fossil::import::cvs::project::trunk ; # Per project trunk, main lod e5441b908d 2007-10-15 aku: package require struct::list ; # Advanced list operations.. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 52f2254007 2007-10-04 aku: ## 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: snit::type ::vc::fossil::import::cvs::project { 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: ## Public API 52f2254007 2007-10-04 aku: 8487172254 2007-10-06 aku: constructor {path r} { 8487172254 2007-10-06 aku: set mybase $path 8487172254 2007-10-06 aku: set myrepository $r e5441b908d 2007-10-15 aku: set mytrunk [trunk %AUTO%] 52f2254007 2007-10-04 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: e5441b908d 2007-10-15 aku: method base {} { return $mybase } e5441b908d 2007-10-15 aku: method trunk {} { return $mytrunk } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: method printbase {} { 52f2254007 2007-10-04 aku: if {$mybase eq ""} {return <Repository>} 52f2254007 2007-10-04 aku: return $mybase 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 67c24820c7 2007-10-14 aku: method setid {id} { set myid $id ; return } 67c24820c7 2007-10-14 aku: adf168e23e 2007-10-24 aku: method addfile {rcs usr executable {fid {}}} { adf168e23e 2007-10-24 aku: set myfiles($rcs) [list $usr $executable $fid] 52f2254007 2007-10-04 aku: return 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 8a93ffa9c1 2007-10-06 aku: method filenames {} { ec053168a8 2007-10-06 aku: return [lsort -dict [array names myfiles]] 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: method files {} { 6d1811d61e 2007-10-06 aku: return [TheFiles] 8487172254 2007-10-06 aku: } 8487172254 2007-10-06 aku: cfe4b269ac 2007-10-17 aku: delegate method defauthor to myrepository cfe4b269ac 2007-10-17 aku: delegate method defcmessage to myrepository cfe4b269ac 2007-10-17 aku: delegate method trunkonly to myrepository cfe4b269ac 2007-10-17 aku: delegate method commitmessageof to myrepository 67c24820c7 2007-10-14 aku: 67c24820c7 2007-10-14 aku: method defmeta {bid aid cid} { 67c24820c7 2007-10-14 aku: return [$myrepository defmeta $myid $bid $aid $cid] 67c24820c7 2007-10-14 aku: } da9295c6f6 2007-10-12 aku: da9295c6f6 2007-10-12 aku: method getsymbol {name} { da9295c6f6 2007-10-12 aku: if {![info exists mysymbols($name)]} { 67c24820c7 2007-10-14 aku: set mysymbols($name) \ 67c24820c7 2007-10-14 aku: [sym %AUTO% $name [$myrepository defsymbol $myid $name]] 8a93ffa9c1 2007-10-06 aku: } da9295c6f6 2007-10-12 aku: return $mysymbols($name) 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 6d1811d61e 2007-10-06 aku: # pass I persistence 042d54bae5 2007-10-05 aku: method persist {} { adf168e23e 2007-10-24 aku: TheFiles ; # Force id assignment. adf168e23e 2007-10-24 aku: 042d54bae5 2007-10-05 aku: state transaction { 042d54bae5 2007-10-05 aku: # Project data first. Required so that we have its id 042d54bae5 2007-10-05 aku: # ready for the files. 042d54bae5 2007-10-05 aku: 042d54bae5 2007-10-05 aku: state run { 042d54bae5 2007-10-05 aku: INSERT INTO project (pid, name) 042d54bae5 2007-10-05 aku: VALUES (NULL, $mybase); 042d54bae5 2007-10-05 aku: } 67c24820c7 2007-10-14 aku: set myid [state id] 042d54bae5 2007-10-05 aku: 042d54bae5 2007-10-05 aku: # Then all files, with proper backreference to their 042d54bae5 2007-10-05 aku: # project. 042d54bae5 2007-10-05 aku: adf168e23e 2007-10-24 aku: foreach rcs [lsort -dict [array names myfiles]] { adf168e23e 2007-10-24 aku: struct::list assign $myfiles($rcs) usr executable _fid_ 042d54bae5 2007-10-05 aku: state run { 67c24820c7 2007-10-14 aku: INSERT INTO file (fid, pid, name, visible, exec) 67c24820c7 2007-10-14 aku: VALUES (NULL, $myid, $rcs, $usr, $executable); 042d54bae5 2007-10-05 aku: } adf168e23e 2007-10-24 aku: $myfmap($rcs) setid [state id] 042d54bae5 2007-10-05 aku: } 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: return 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: # pass II persistence 6d1811d61e 2007-10-06 aku: method persistrev {} { adf168e23e 2007-10-24 aku: # Note: The per file information (incl. revisions and symbols) adf168e23e 2007-10-24 aku: # has already been saved and dropped, immediately after adf168e23e 2007-10-24 aku: # processing it, to keep out use of memory under control. Now adf168e23e 2007-10-24 aku: # we just have to save the remaining project level parts to adf168e23e 2007-10-24 aku: # fix the left-over dangling references. adf168e23e 2007-10-24 aku: 6d1811d61e 2007-10-06 aku: state transaction { 6d1811d61e 2007-10-06 aku: # TODO: per project persistence (symbols, meta data) 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: return 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: ## State 52f2254007 2007-10-04 aku: e5441b908d 2007-10-15 aku: variable mybase {} ; # Project directory. 67c24820c7 2007-10-14 aku: variable myid {} ; # Project id in the persistent state. e5441b908d 2007-10-15 aku: variable mytrunk {} ; # Reference to the main line of e5441b908d 2007-10-15 aku: # development for the project. e5441b908d 2007-10-15 aku: variable myfiles -array {} ; # Maps the rcs archive paths to e5441b908d 2007-10-15 aku: # their user-visible files. da9295c6f6 2007-10-12 aku: variable myfobj {} ; # File objects for the rcs archives adf168e23e 2007-10-24 aku: variable myfmap -array {} ; # Map rcs archive to their object. da9295c6f6 2007-10-12 aku: variable myrepository {} ; # Repository the prject belongs to. e5441b908d 2007-10-15 aku: variable mysymbols -array {} ; # Map symbol names to project-level e5441b908d 2007-10-15 aku: # symbol objects. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: ## Internal methods 52f2254007 2007-10-04 aku: 6d1811d61e 2007-10-06 aku: proc TheFiles {} { adf168e23e 2007-10-24 aku: upvar 1 myfiles myfiles myfobj myfobj self self myfmap myfmap 6d1811d61e 2007-10-06 aku: if {![llength $myfobj]} { 6d1811d61e 2007-10-06 aku: set myfobj [EmptyFiles myfiles] 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: return $myfobj 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: proc EmptyFiles {fv} { adf168e23e 2007-10-24 aku: upvar 1 $fv myfiles self self myfmap myfmap 6d1811d61e 2007-10-06 aku: set res {} cfe4b269ac 2007-10-17 aku: foreach rcs [lsort -dict [array names myfiles]] { adf168e23e 2007-10-24 aku: struct::list assign $myfiles($rcs) f executable fid adf168e23e 2007-10-24 aku: set file [file %AUTO% $fid $rcs $f $executable $self] adf168e23e 2007-10-24 aku: lappend res $file adf168e23e 2007-10-24 aku: set myfmap($rcs) $file 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: return $res 6d1811d61e 2007-10-06 aku: } 6d1811d61e 2007-10-06 aku: 6d1811d61e 2007-10-06 aku: # # ## ### ##### ######## ############# 6d1811d61e 2007-10-06 aku: ## Configuration 6d1811d61e 2007-10-06 aku: 52f2254007 2007-10-04 aku: pragma -hastypeinfo no ; # no type introspection 52f2254007 2007-10-04 aku: pragma -hasinfo no ; # no object introspection 52f2254007 2007-10-04 aku: pragma -hastypemethods no ; # type is not relevant. 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: namespace eval ::vc::fossil::import::cvs { 52f2254007 2007-10-04 aku: namespace export project 042d54bae5 2007-10-05 aku: namespace eval project { 8a93ffa9c1 2007-10-06 aku: namespace import ::vc::fossil::import::cvs::file 042d54bae5 2007-10-05 aku: namespace import ::vc::fossil::import::cvs::state da9295c6f6 2007-10-12 aku: # Import not required, already a child namespace. da9295c6f6 2007-10-12 aku: # namespace import ::vc::fossil::import::cvs::project::sym 042d54bae5 2007-10-05 aku: } 52f2254007 2007-10-04 aku: } 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 52f2254007 2007-10-04 aku: ## Ready 52f2254007 2007-10-04 aku: 52f2254007 2007-10-04 aku: package provide vc::fossil::import::cvs::project 1.0 52f2254007 2007-10-04 aku: return
File Annotation