52f2254007 2007-10-04 aku: ## -*- tcl -*- 52f2254007 2007-10-04 aku: # # ## ### ##### ######## ############# ##################### 66235f2430 2008-02-06 aku: ## Copyright (c) 2007-2008 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. 348e45b0d6 2008-01-30 aku: package require vc::fossil::import::cvs::project::rev ; # Changesets. 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 6f8667b03e 2007-10-31 aku: package require vc::tools::log ; # User feedback 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 2c08006d9d 2007-10-25 aku: set mytrunk [trunk %AUTO% $self] 6f8667b03e 2007-10-31 aku: set mysymbol([$mytrunk name]) $mytrunk 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 } adf168e23e 2007-10-24 aku: 82e35d3304 2007-12-05 aku: method fullpath {} { return [$myrepository base?]/$mybase } 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: 1deb3786aa 2007-10-26 aku: method id {} { return $myid } 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 8a93ffa9c1 2007-10-06 aku: } 8a93ffa9c1 2007-10-06 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] 6d1811d61e 2007-10-06 aku: } 6d1811d61e 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} { 1deb3786aa 2007-10-26 aku: if {![info exists mysymbol($name)]} { 1deb3786aa 2007-10-26 aku: set mysymbol($name) \ 1deb3786aa 2007-10-26 aku: [sym %AUTO% $name [$myrepository defsymbol $myid $name] $self] 1deb3786aa 2007-10-26 aku: } 1deb3786aa 2007-10-26 aku: return $mysymbol($name) 6f8667b03e 2007-10-31 aku: } 6f8667b03e 2007-10-31 aku: c3d5104084 2007-11-02 aku: method hassymbol {name} { c3d5104084 2007-11-02 aku: return [info exists mysymbol($name)] c3d5104084 2007-11-02 aku: } c3d5104084 2007-11-02 aku: 6f8667b03e 2007-10-31 aku: method purgeghostsymbols {} { 6f8667b03e 2007-10-31 aku: set changes 1 6f8667b03e 2007-10-31 aku: while {$changes} { 6f8667b03e 2007-10-31 aku: set changes 0 6f8667b03e 2007-10-31 aku: foreach {name symbol} [array get mysymbol] { 6f8667b03e 2007-10-31 aku: if {![$symbol isghost]} continue 6f8667b03e 2007-10-31 aku: log write 3 project "$mybase: Deleting ghost symbol '$name'" 6f8667b03e 2007-10-31 aku: $symbol destroy 6f8667b03e 2007-10-31 aku: unset mysymbol($name) 6f8667b03e 2007-10-31 aku: set changes 1 6f8667b03e 2007-10-31 aku: } c3d5104084 2007-11-02 aku: } c3d5104084 2007-11-02 aku: return c3d5104084 2007-11-02 aku: } c3d5104084 2007-11-02 aku: f888f06fe3 2007-11-02 aku: method determinesymboltypes {} { f888f06fe3 2007-11-02 aku: foreach {name symbol} [array get mysymbol] { f888f06fe3 2007-11-02 aku: $symbol determinetype 8a93ffa9c1 2007-10-06 aku: } 6f8667b03e 2007-10-31 aku: return 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] 6d1811d61e 2007-10-06 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) 1deb3786aa 2007-10-26 aku: # has already been saved and dropped. This was done 1deb3786aa 2007-10-26 aku: # immediately after processing it, i.e. as part of the main 1deb3786aa 2007-10-26 aku: # segment of the pass, to keep out use of memory under 1deb3786aa 2007-10-26 aku: # control. 1deb3786aa 2007-10-26 aku: # 1deb3786aa 2007-10-26 aku: # The repository level information has been saved as well too, 1deb3786aa 2007-10-26 aku: # just before saving the projects started. So now we just have 1deb3786aa 2007-10-26 aku: # to save the remaining project level parts to fix the 1deb3786aa 2007-10-26 aku: # left-over dangling references, which are the symbols. adf168e23e 2007-10-24 aku: 6d1811d61e 2007-10-06 aku: state transaction { 1deb3786aa 2007-10-26 aku: foreach {name symbol} [array get mysymbol] { 1deb3786aa 2007-10-26 aku: $symbol persistrev 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: return 042d54bae5 2007-10-05 aku: } 042d54bae5 2007-10-05 aku: 983090a343 2008-03-05 aku: method changesetsinorder {} { 348e45b0d6 2008-01-30 aku: return [rev inorder $myid] 52f2254007 2007-10-04 aku: } 348e45b0d6 2008-01-30 aku: 348e45b0d6 2008-01-30 aku: delegate method getmeta to myrepository 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. 348e45b0d6 2008-01-30 aku: variable myrepository {} ; # Repository the project belongs to. 1deb3786aa 2007-10-26 aku: variable mysymbol -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 { 6f8667b03e 2007-10-31 aku: namespace import ::vc::tools::log 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 348e45b0d6 2008-01-30 aku: # Import not required, already a child namespace. 348e45b0d6 2008-01-30 aku: # namespace import ::vc::fossil::import::cvs::project::rev 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