84de38d73f 2007-10-10 aku: ## -*- tcl -*- 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 66235f2430 2008-02-06 aku: ## Copyright (c) 2007-2008 Andreas Kupries. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software is licensed as described in the file LICENSE, which 84de38d73f 2007-10-10 aku: # you should have received as part of this distribution. 84de38d73f 2007-10-10 aku: # 84de38d73f 2007-10-10 aku: # This software consists of voluntary contributions made by many 84de38d73f 2007-10-10 aku: # individuals. For exact contribution history, see the revision 84de38d73f 2007-10-10 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: ## Revisions per project, aka Changesets. These objects are first used 5f7acef887 2007-11-10 aku: ## in pass 5, which creates the initial set covering the repository. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Requirements 84de38d73f 2007-10-10 aku: 5f7acef887 2007-11-10 aku: package require Tcl 8.4 ; # Required runtime. 5f7acef887 2007-11-10 aku: package require snit ; # OO system. b42cff97e3 2007-11-30 aku: package require struct::set ; # Set operations. 08ebab80cd 2007-11-10 aku: package require vc::tools::misc ; # Text formatting 08ebab80cd 2007-11-10 aku: package require vc::tools::trouble ; # Error reporting. 95af789e1f 2007-11-10 aku: package require vc::tools::log ; # User feedback. 5f7acef887 2007-11-10 aku: package require vc::fossil::import::cvs::state ; # State storage. 47d52d1efd 2007-11-28 aku: package require vc::fossil::import::cvs::integrity ; # State integrity checks. 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: snit::type ::vc::fossil::import::cvs::project::rev { 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Public API 84de38d73f 2007-10-10 aku: deab4d035b 2007-11-29 aku: constructor {project cstype srcid items {theid {}}} { 65be27aa69 2007-11-22 aku: if {$theid ne ""} { 65be27aa69 2007-11-22 aku: set myid $theid 65be27aa69 2007-11-22 aku: } else { 65be27aa69 2007-11-22 aku: set myid [incr mycounter] 65be27aa69 2007-11-22 aku: } 65be27aa69 2007-11-22 aku: b42cff97e3 2007-11-30 aku: integrity assert { b42cff97e3 2007-11-30 aku: [info exists mycstype($cstype)] b42cff97e3 2007-11-30 aku: } {Bad changeset type '$cstype'.} c74fe3de3f 2007-11-29 aku: 5f7acef887 2007-11-10 aku: set myproject $project 5f7acef887 2007-11-10 aku: set mytype $cstype c74fe3de3f 2007-11-29 aku: set mytypeobj ::vc::fossil::import::cvs::project::rev::${cstype} 5f7acef887 2007-11-10 aku: set mysrcid $srcid deab4d035b 2007-11-29 aku: set myitems $items de4cff4142 2007-11-22 aku: set mypos {} ; # Commit location is not known yet. de4cff4142 2007-11-22 aku: 4b0f43fb2f 2008-02-24 aku: foreach iid $items { lappend mytitems [list $cstype $iid] } 85bd219d0b 2007-11-13 aku: 85bd219d0b 2007-11-13 aku: # Keep track of the generated changesets and of the inverse deab4d035b 2007-11-29 aku: # mapping from items to them. de4cff4142 2007-11-22 aku: lappend mychangesets $self 00bf8c198e 2007-12-02 aku: lappend mytchangesets($cstype) $self de4cff4142 2007-11-22 aku: set myidmap($myid) $self 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: MapItems $cstype $items f46458d5bd 2008-02-17 aku: return f46458d5bd 2008-02-17 aku: } f46458d5bd 2008-02-17 aku: f46458d5bd 2008-02-17 aku: destructor { 4b0f43fb2f 2008-02-24 aku: # We may be able to get rid of this entirely, at least for 4b0f43fb2f 2008-02-24 aku: # (de)construction and pass InitCSets. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: UnmapItems $mytype $myitems 4b0f43fb2f 2008-02-24 aku: unset myidmap($myid) 4b0f43fb2f 2008-02-24 aku: 4b0f43fb2f 2008-02-24 aku: set pos [lsearch -exact $mychangesets $self] 4b0f43fb2f 2008-02-24 aku: set mychangesets [lreplace $mychangesets $pos $pos] 4b0f43fb2f 2008-02-24 aku: set pos [lsearch -exact $mytchangesets($mytype) $self] 4b0f43fb2f 2008-02-24 aku: set mytchangesets($mytype) [lreplace $mytchangesets($mytype) $pos $pos] 911d56a8c8 2007-11-27 aku: return 911d56a8c8 2007-11-27 aku: } 911d56a8c8 2007-11-27 aku: 911d56a8c8 2007-11-27 aku: method str {} { 911d56a8c8 2007-11-27 aku: set str "<" 911d56a8c8 2007-11-27 aku: set detail "" 70d2283564 2007-11-29 aku: if {[$mytypeobj bysymbol]} { 70d2283564 2007-11-29 aku: set detail " '[state one { 70d2283564 2007-11-29 aku: SELECT S.name 70d2283564 2007-11-29 aku: FROM symbol S 911d56a8c8 2007-11-27 aku: WHERE S.sid = $mysrcid 70d2283564 2007-11-29 aku: }]'" 911d56a8c8 2007-11-27 aku: } 911d56a8c8 2007-11-27 aku: append str "$mytype ${myid}${detail}>" 911d56a8c8 2007-11-27 aku: return $str 911d56a8c8 2007-11-27 aku: } 911d56a8c8 2007-11-27 aku: 0d13da3018 2008-02-06 aku: method lod {} { 983090a343 2008-03-05 aku: return [$mytypeobj cs_lod $mysrcid $myitems] 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 61829b076b 2007-11-29 aku: method id {} { return $myid } 61829b076b 2007-11-29 aku: method items {} { return $mytitems } 61829b076b 2007-11-29 aku: method data {} { return [list $myproject $mytype $mysrcid] } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: delegate method bysymbol to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method byrevision to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method isbranch to mytypeobj c74fe3de3f 2007-11-29 aku: delegate method istag to mytypeobj de4cff4142 2007-11-22 aku: de4cff4142 2007-11-22 aku: method setpos {p} { set mypos $p ; return } de4cff4142 2007-11-22 aku: method pos {} { return $mypos } de4cff4142 2007-11-22 aku: 00bf8c198e 2007-12-02 aku: method determinesuccessors {} { 00bf8c198e 2007-12-02 aku: # Pass 6 operation. Compute project-level dependencies from 00bf8c198e 2007-12-02 aku: # the file-level data and save it back to the state. This may 00bf8c198e 2007-12-02 aku: # be called during the cycle breaker passes as well, to adjust 00bf8c198e 2007-12-02 aku: # the successor information of changesets which are the 00bf8c198e 2007-12-02 aku: # predecessors of dropped changesets. For them we have to 00bf8c198e 2007-12-02 aku: # remove their existing information first before inserting the 00bf8c198e 2007-12-02 aku: # new data. 00bf8c198e 2007-12-02 aku: state run { 00bf8c198e 2007-12-02 aku: DELETE FROM cssuccessor WHERE cid = $myid; 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: set loop 0 6559f3231e 2008-02-24 aku: # TODO: Check other uses of cs_sucessors. 6559f3231e 2008-02-24 aku: # TODO: Consider merging cs_sucessor's SELECT with the INSERT here. 00bf8c198e 2007-12-02 aku: foreach nid [$mytypeobj cs_successors $myitems] { 00bf8c198e 2007-12-02 aku: state run { 00bf8c198e 2007-12-02 aku: INSERT INTO cssuccessor (cid, nid) 00bf8c198e 2007-12-02 aku: VALUES ($myid,$nid) 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: if {$nid == $myid} { set loop 1 } 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: # Report after the complete structure has been saved. 00bf8c198e 2007-12-02 aku: if {$loop} { $self reportloop } 00bf8c198e 2007-12-02 aku: return 0fcfbf7828 2007-11-29 aku: } 0fcfbf7828 2007-11-29 aku: 0fcfbf7828 2007-11-29 aku: # result = list (changeset) 85bd219d0b 2007-11-13 aku: method successors {} { 00bf8c198e 2007-12-02 aku: # Use the data saved by pass 6. 00bf8c198e 2007-12-02 aku: return [struct::list map [state run { 00bf8c198e 2007-12-02 aku: SELECT S.nid 00bf8c198e 2007-12-02 aku: FROM cssuccessor S 00bf8c198e 2007-12-02 aku: WHERE S.cid = $myid 00bf8c198e 2007-12-02 aku: }] [mytypemethod of]] 0fcfbf7828 2007-11-29 aku: } 0fcfbf7828 2007-11-29 aku: 0fcfbf7828 2007-11-29 aku: # item -> list (item) 94c39d6375 2007-11-14 aku: method nextmap {} { deab4d035b 2007-11-29 aku: $mytypeobj successors tmp $myitems e50f9ed55e 2007-11-22 aku: return [array get tmp] e50f9ed55e 2007-11-22 aku: } 95af789e1f 2007-11-10 aku: 95af789e1f 2007-11-10 aku: method breakinternaldependencies {cv} { f46458d5bd 2008-02-17 aku: upvar 1 $cv counter 27ed4f7dc3 2008-02-16 aku: log write 14 csets {[$self str] BID} 27ed4f7dc3 2008-02-16 aku: vc::tools::mem::mark 4b0f43fb2f 2008-02-24 aku: 4b0f43fb2f 2008-02-24 aku: # This method inspects the changeset, looking for internal 4b0f43fb2f 2008-02-24 aku: # dependencies. Nothing is done if there are no such. 4b0f43fb2f 2008-02-24 aku: 4b0f43fb2f 2008-02-24 aku: # Otherwise the changeset is split into a set of fragments 4b0f43fb2f 2008-02-24 aku: # which have no internal dependencies, transforming the 95af789e1f 2007-11-10 aku: # internal dependencies into external ones. The new changesets 530168ec30 2008-02-23 aku: # generated from the fragment information are added to the 4b0f43fb2f 2008-02-24 aku: # list of all changesets (by the caller). 4b0f43fb2f 2008-02-24 aku: 4b0f43fb2f 2008-02-24 aku: # The code checks only successor dependencies, as this auto- 4b0f43fb2f 2008-02-24 aku: # matically covers the predecessor dependencies as well (Any 08ebab80cd 2007-11-10 aku: # successor dependency a -> b is also a predecessor dependency 08ebab80cd 2007-11-10 aku: # b -> a). 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set breaks {} 08ebab80cd 2007-11-10 aku: 530168ec30 2008-02-23 aku: set fragments [BreakDirectDependencies $myitems breaks] 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: if {![llength $fragments]} { return {} } 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: return [$self CreateFromFragments $fragments counter breaks] 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: method persist {} { 5f7acef887 2007-11-10 aku: set tid $mycstype($mytype) 5f7acef887 2007-11-10 aku: set pid [$myproject id] 5f7acef887 2007-11-10 aku: set pos 0 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: state transaction { 5f7acef887 2007-11-10 aku: state run { 5f7acef887 2007-11-10 aku: INSERT INTO changeset (cid, pid, type, src) 5f7acef887 2007-11-10 aku: VALUES ($myid, $pid, $tid, $mysrcid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: deab4d035b 2007-11-29 aku: foreach iid $myitems { 5f7acef887 2007-11-10 aku: state run { 80b1e8936f 2007-11-29 aku: INSERT INTO csitem (cid, pos, iid) 80b1e8936f 2007-11-29 aku: VALUES ($myid, $pos, $iid); 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: incr pos 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: return 5f7acef887 2007-11-10 aku: } 5f7acef887 2007-11-10 aku: deab4d035b 2007-11-29 aku: method timerange {} { return [$mytypeobj timerange $myitems] } deab4d035b 2007-11-29 aku: 711e000206 2007-12-04 aku: method limits {} { 711e000206 2007-12-04 aku: struct::list assign [$mytypeobj limits $myitems] maxp mins 711e000206 2007-12-04 aku: return [list [TagItemDict $maxp $mytype] [TagItemDict $mins $mytype]] 94c39d6375 2007-11-14 aku: } 94c39d6375 2007-11-14 aku: 94c39d6375 2007-11-14 aku: method drop {} { b42cff97e3 2007-11-30 aku: log write 8 csets {Dropping $self = [$self str]} b42cff97e3 2007-11-30 aku: 94c39d6375 2007-11-14 aku: state transaction { 94c39d6375 2007-11-14 aku: state run { 00bf8c198e 2007-12-02 aku: DELETE FROM changeset WHERE cid = $myid; 00bf8c198e 2007-12-02 aku: DELETE FROM csitem WHERE cid = $myid; 00bf8c198e 2007-12-02 aku: DELETE FROM cssuccessor WHERE cid = $myid; 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: # Return the list of predecessors so that they can be adjusted. 00bf8c198e 2007-12-02 aku: return [struct::list map [state run { 00bf8c198e 2007-12-02 aku: SELECT cid 00bf8c198e 2007-12-02 aku: FROM cssuccessor 00bf8c198e 2007-12-02 aku: WHERE nid = $myid 00bf8c198e 2007-12-02 aku: }] [mytypemethod of]] 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: method reportloop {{kill 1}} { 00bf8c198e 2007-12-02 aku: # We print the items which are producing the loop, and how. 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: set hdr "Self-referential changeset [$self str] __________________" 00bf8c198e 2007-12-02 aku: set ftr [regsub -all {[^ ]} $hdr {_}] 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: log write 0 csets $hdr 00bf8c198e 2007-12-02 aku: foreach {item nextitem} [$mytypeobj loops $myitems] { 00bf8c198e 2007-12-02 aku: # Create tagged items from the id and our type. 00bf8c198e 2007-12-02 aku: set item [list $mytype $item] 00bf8c198e 2007-12-02 aku: set nextitem [list $mytype $nextitem] 00bf8c198e 2007-12-02 aku: # Printable labels. 00bf8c198e 2007-12-02 aku: set i "<[$type itemstr $item]>" 00bf8c198e 2007-12-02 aku: set n "<[$type itemstr $nextitem]>" 00bf8c198e 2007-12-02 aku: set ncs $myitemmap($nextitem) 00bf8c198e 2007-12-02 aku: # Print 00bf8c198e 2007-12-02 aku: log write 0 csets {* $i --> $n --> cs [$ncs str]} 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: log write 0 csets $ftr 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: if {!$kill} return 00bf8c198e 2007-12-02 aku: trouble internal "[$self str] depends on itself" 00bf8c198e 2007-12-02 aku: return 348e45b0d6 2008-01-30 aku: } 348e45b0d6 2008-01-30 aku: e1dbf3186d 2008-02-04 aku: method pushto {repository date rstate} { 348e45b0d6 2008-01-30 aku: # Generate and import the manifest for this changeset. 348e45b0d6 2008-01-30 aku: # 348e45b0d6 2008-01-30 aku: # Data needed: 348e45b0d6 2008-01-30 aku: # - Commit message (-- mysrcid -> repository meta) 348e45b0d6 2008-01-30 aku: # - User doing the commit (s.a.) 348e45b0d6 2008-01-30 aku: # 348e45b0d6 2008-01-30 aku: # - Timestamp of when committed (command argument) 348e45b0d6 2008-01-30 aku: # e8efbc317a 2008-02-01 aku: # - The parent changeset, if any. If there is no parent fossil e8efbc317a 2008-02-01 aku: # will use the empty base revision as parent. 08ebab80cd 2007-11-10 aku: # 348e45b0d6 2008-01-30 aku: # - List of the file revisions in the changeset. 348e45b0d6 2008-01-30 aku: 0d13da3018 2008-02-06 aku: # We derive the lod information directly from the revisions of 0d13da3018 2008-02-06 aku: # the changeset, as the branch part of the meta data (s.a.) is 983090a343 2008-03-05 aku: # outdated since pass FilterSymbols. See the method 'run' in 983090a343 2008-03-05 aku: # file "c2f_pfiltersym.tcl" for more commentary on this. 0d13da3018 2008-02-06 aku: 0d13da3018 2008-02-06 aku: set lodname [$self lod] 0d13da3018 2008-02-06 aku: 983090a343 2008-03-05 aku: log write 2 csets {Importing changeset [$self str] on $lodname} 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: if {[$mytypeobj istag]} { 983090a343 2008-03-05 aku: # Handle tags. They appear immediately after the revision 983090a343 2008-03-05 aku: # they are attached to (*). We can assume that the 983090a343 2008-03-05 aku: # workspace for the relevant line of development 983090a343 2008-03-05 aku: # exists. We retrieve it, then the uuid of the last 983090a343 2008-03-05 aku: # revision entered into it, then tag this revision. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # (*) Immediately in terms of the relevant line of 983090a343 2008-03-05 aku: # development. Revisions on other lines may come in 983090a343 2008-03-05 aku: # between, but they do not matter to that. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: set lws [Getworkspace $rstate $lodname $myproject 0] 983090a343 2008-03-05 aku: set uuid [lindex [$lws getid] 1] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: $repository tag $uuid [state one { 983090a343 2008-03-05 aku: SELECT S.name 983090a343 2008-03-05 aku: FROM symbol S 983090a343 2008-03-05 aku: WHERE S.sid = $mysrcid 983090a343 2008-03-05 aku: }] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: } elseif {[$mytypeobj isbranch]} { 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # Handle branches. They appear immediately after the 983090a343 2008-03-05 aku: # revision they are spawned from (*). We can assume that 983090a343 2008-03-05 aku: # the workspace for the relevant line of development 983090a343 2008-03-05 aku: # exists. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # We retrieve it, then the uuid of the last revision 983090a343 2008-03-05 aku: # entered into it. That revision is tagged as the root of 983090a343 2008-03-05 aku: # the branch (**). A new workspace for the branch is 983090a343 2008-03-05 aku: # created as well, for the future revisions of the new 983090a343 2008-03-05 aku: # line of development. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # An exception is made of the non-trunk default branch, 983090a343 2008-03-05 aku: # aka vendor branch. This lod has to have a workspace not 983090a343 2008-03-05 aku: # inherited from anything else. It has no root either, so 983090a343 2008-03-05 aku: # tagging is out as well. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # (*) Immediately in terms of the relevant line of 983090a343 2008-03-05 aku: # development. Revisions on other lines may come in 983090a343 2008-03-05 aku: # between, but they do not matter to that. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # (**) Tagging the parent revision of the branch as its 983090a343 2008-03-05 aku: # root is done to let us know about the existence of 983090a343 2008-03-05 aku: # the branch even if it has no revisions committed to 983090a343 2008-03-05 aku: # it, and thus no regular branch tag anywhere else. 983090a343 2008-03-05 aku: # The name of the tag is the name for the lod, with 983090a343 2008-03-05 aku: # the suffix '-root' appended to it. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # LOD is self symbol of branch, not parent 983090a343 2008-03-05 aku: set lodname [state one { 983090a343 2008-03-05 aku: SELECT S.name 983090a343 2008-03-05 aku: FROM symbol S 983090a343 2008-03-05 aku: WHERE S.sid = $mysrcid 983090a343 2008-03-05 aku: }] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: if {![$rstate has :trunk:]} { 983090a343 2008-03-05 aku: # No trunk implies default branch. Just create the 983090a343 2008-03-05 aku: # proper workspace. 983090a343 2008-03-05 aku: Getworkspace $rstate $lodname $myproject 1 8c9030e3e8 2007-11-24 aku: } else { 983090a343 2008-03-05 aku: # Non-default branch. Need workspace, and tag parent 983090a343 2008-03-05 aku: # revision. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: set lws [Getworkspace $rstate $lodname $myproject 0] 983090a343 2008-03-05 aku: set uuid [lindex [$lws getid] 1] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: $repository tag $uuid ${lodname}-root 983090a343 2008-03-05 aku: } 348e45b0d6 2008-01-30 aku: } else { 983090a343 2008-03-05 aku: # Revision changeset. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: struct::list assign [$myproject getmeta $mysrcid] __ __ user message 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # Perform the import. As part of that we determine the 983090a343 2008-03-05 aku: # parent we need, and convert the list of items in the 983090a343 2008-03-05 aku: # changeset into uuids and printable data. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: struct::list assign [Getisdefault $myitems] \ 983090a343 2008-03-05 aku: isdefault lastdefaultontrunk 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: log write 8 csets {LOD '$lodname'} 983090a343 2008-03-05 aku: log write 8 csets { def? $isdefault} 983090a343 2008-03-05 aku: log write 8 csets { last? $lastdefaultontrunk} 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: set lws [Getworkspace $rstate $lodname $myproject $isdefault] 983090a343 2008-03-05 aku: $lws add [Getrevisioninfo $myitems] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: struct::list assign \ 983090a343 2008-03-05 aku: [$repository importrevision [$self str] \ 983090a343 2008-03-05 aku: $user $message $date \ 983090a343 2008-03-05 aku: [lindex [$lws getid] 0] [$lws get]] \ 983090a343 2008-03-05 aku: rid uuid 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: if {[$lws ticks] == 1} { 983090a343 2008-03-05 aku: # First commit on this line of development. Set our 983090a343 2008-03-05 aku: # own name as a propagating tag. And if the LOD has a 983090a343 2008-03-05 aku: # parent we have to prevent the propagation of that 983090a343 2008-03-05 aku: # tag into this new line. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: set plws [$lws parent] 983090a343 2008-03-05 aku: if {$plws ne ""} { 983090a343 2008-03-05 aku: $repository branchcancel $uuid [$plws name] 983090a343 2008-03-05 aku: } 983090a343 2008-03-05 aku: $repository branchmark $uuid [$lws name] 983090a343 2008-03-05 aku: } 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # Remember the imported changeset in the state, under our 983090a343 2008-03-05 aku: # LOD. And if it is the last trunk changeset on the vendor 983090a343 2008-03-05 aku: # branch then the revision is also the actual root of the 983090a343 2008-03-05 aku: # :trunk:, so we remember it as such in the state. However 983090a343 2008-03-05 aku: # if the trunk already exists then the changeset cannot be 983090a343 2008-03-05 aku: # on it any more. This indicates weirdness in the setup of 983090a343 2008-03-05 aku: # the vendor branch, but one we can work around. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: $lws defid [list $rid $uuid] 983090a343 2008-03-05 aku: if {$lastdefaultontrunk} { 983090a343 2008-03-05 aku: log write 2 csets {This cset is the last on the NTDB, set the trunk workspace up} 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: if {[$rstate has :trunk:]} { 983090a343 2008-03-05 aku: log write 2 csets {Multiple changesets declared to be the last trunk changeset on the vendor-branch} 983090a343 2008-03-05 aku: } else { 983090a343 2008-03-05 aku: $rstate new :trunk: [$lws name] 08ebab80cd 2007-11-10 aku: } e50f9ed55e 2007-11-22 aku: } 678765068d 2007-11-27 aku: } a1bbf19d51 2008-02-05 aku: 983090a343 2008-03-05 aku: log write 2 csets { } 983090a343 2008-03-05 aku: log write 2 csets { } 3cd599cacd 2008-01-31 aku: return 3cd599cacd 2008-01-31 aku: } 3cd599cacd 2008-01-31 aku: 3cd599cacd 2008-01-31 aku: proc Getrevisioninfo {revisions} { e50f9ed55e 2007-11-22 aku: set theset ('[join $revisions {','}]') 3cd599cacd 2008-01-31 aku: set revisions {} f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT U.uuid AS frid, f637d42206 2008-02-24 aku: F.visible AS path, f637d42206 2008-02-24 aku: F.name AS fname, f637d42206 2008-02-24 aku: R.rev AS revnr, f637d42206 2008-02-24 aku: R.op AS rop 3cd599cacd 2008-01-31 aku: FROM revision R, revuuid U, file F 3cd599cacd 2008-01-31 aku: WHERE R.rid IN $theset -- All specified revisions 3cd599cacd 2008-01-31 aku: AND U.rid = R.rid -- get fossil uuid of revision 3cd599cacd 2008-01-31 aku: AND F.fid = R.fid -- get file of revision f637d42206 2008-02-24 aku: }] { c9270189c2 2008-02-05 aku: lappend revisions $frid $path $fname/$revnr $rop 3cd599cacd 2008-01-31 aku: } 3cd599cacd 2008-01-31 aku: return $revisions 3cd599cacd 2008-01-31 aku: } 3cd599cacd 2008-01-31 aku: e1dbf3186d 2008-02-04 aku: proc Getworkspace {rstate lodname project isdefault} { e1dbf3186d 2008-02-04 aku: e1dbf3186d 2008-02-04 aku: # The state object holds the workspace state of each known e1dbf3186d 2008-02-04 aku: # line-of-development (LOD), up to the last committed e1dbf3186d 2008-02-04 aku: # changeset belonging to that LOD. e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: # (*) Standard handling if in-LOD changesets. If the LOD of e8efbc317a 2008-02-01 aku: # the current changeset exists in the state (= has been e1dbf3186d 2008-02-04 aku: # committed to) then this it has the workspace we are e1dbf3186d 2008-02-04 aku: # looking for. e1dbf3186d 2008-02-04 aku: e1dbf3186d 2008-02-04 aku: if {[$rstate has $lodname]} { e1dbf3186d 2008-02-04 aku: return [$rstate get $lodname] e1dbf3186d 2008-02-04 aku: } e1dbf3186d 2008-02-04 aku: e1dbf3186d 2008-02-04 aku: # If the LOD is however not yet known, then the current e1dbf3186d 2008-02-04 aku: # changeset can be either of e1dbf3186d 2008-02-04 aku: # (a) root of a vendor branch, e1dbf3186d 2008-02-04 aku: # (b) root of the trunk LOD, or e8efbc317a 2008-02-01 aku: # (c) the first changeset in a new LOD which was spawned from e8efbc317a 2008-02-01 aku: # an existing LOD. e8efbc317a 2008-02-01 aku: 6d5de5f1c1 2008-02-13 aku: # For both (a) and (b) we have to create a new workspace for 6d5de5f1c1 2008-02-13 aku: # the lod, and it doesn't inherit from anything. 6d5de5f1c1 2008-02-13 aku: 6d5de5f1c1 2008-02-13 aku: # One exception for (a). If we already have a :vendor: branch 6d5de5f1c1 2008-02-13 aku: # then multiple symbols were used for the vendor branch by 6d5de5f1c1 2008-02-13 aku: # different files. In that case the 'new' branch is made an 6d5de5f1c1 2008-02-13 aku: # alias of the :vendor:, effectively merging the symbols 6d5de5f1c1 2008-02-13 aku: # together. 6d5de5f1c1 2008-02-13 aku: 6d5de5f1c1 2008-02-13 aku: # Note that case (b) may never occur. See the variable 6d5de5f1c1 2008-02-13 aku: # 'lastdefaultontrunk' in the caller (method pushto). This 6d5de5f1c1 2008-02-13 aku: # flag can the generation of the workspace for the :trunk: LOD 6d5de5f1c1 2008-02-13 aku: # as well, making it inherit the state of the last 6d5de5f1c1 2008-02-13 aku: # trunk-changeset on the vendor-branch. 6d5de5f1c1 2008-02-13 aku: e8efbc317a 2008-02-01 aku: if {$isdefault} { 6d5de5f1c1 2008-02-13 aku: if {![$rstate has ":vendor:"]} { 983090a343 2008-03-05 aku: # Create the vendor branch if not present already. We 983090a343 2008-03-05 aku: # use the actual name for the lod, and additional make 983090a343 2008-03-05 aku: # it accessible under an internal name (:vendor:) so 983090a343 2008-03-05 aku: # that we can merge to it later, should it become 983090a343 2008-03-05 aku: # necessary. See the other branch below. 983090a343 2008-03-05 aku: $rstate new $lodname 983090a343 2008-03-05 aku: $rstate dup :vendor: <-- $lodname 08ebab80cd 2007-11-10 aku: } else { 983090a343 2008-03-05 aku: # Merge the new symbol to the vendor branch 983090a343 2008-03-05 aku: $rstate dup $lodname <-- :vendor: 184c56327e 2007-11-24 aku: } 6d5de5f1c1 2008-02-13 aku: return [$rstate get $lodname] e8efbc317a 2008-02-01 aku: } e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: if {$lodname eq ":trunk:"} { e1dbf3186d 2008-02-04 aku: return [$rstate new $lodname] e1dbf3186d 2008-02-04 aku: } e1dbf3186d 2008-02-04 aku: e1dbf3186d 2008-02-04 aku: # Case (c). We find the parent LOD of our LOD and let the new e1dbf3186d 2008-02-04 aku: # workspace inherit from the parent's workspace. 9214c11831 2008-02-02 aku: 9214c11831 2008-02-02 aku: set plodname [[[$project getsymbol $lodname] parent] name] 9214c11831 2008-02-02 aku: 9214c11831 2008-02-02 aku: log write 8 csets {pLOD '$plodname'} 9214c11831 2008-02-02 aku: e1dbf3186d 2008-02-04 aku: if {[$rstate has $plodname]} { e1dbf3186d 2008-02-04 aku: return [$rstate new $lodname $plodname] e1dbf3186d 2008-02-04 aku: } e1dbf3186d 2008-02-04 aku: e1dbf3186d 2008-02-04 aku: foreach k [lsort [$rstate names]] { e1dbf3186d 2008-02-04 aku: log write 8 csets { $k = [[$rstate get $k] getid]} e8efbc317a 2008-02-01 aku: } e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: trouble internal {Unable to determine changeset parent} e8efbc317a 2008-02-01 aku: return e8efbc317a 2008-02-01 aku: } e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: proc Getisdefault {revisions} { 184c56327e 2007-11-24 aku: set theset ('[join $revisions {','}]') 184c56327e 2007-11-24 aku: e8efbc317a 2008-02-01 aku: struct::list assign [state run [subst -nocommands -nobackslashes { e8efbc317a 2008-02-01 aku: SELECT R.isdefault, R.dbchild 184c56327e 2007-11-24 aku: FROM revision R e8efbc317a 2008-02-01 aku: WHERE R.rid IN $theset -- All specified revisions e8efbc317a 2008-02-01 aku: LIMIT 1 e8efbc317a 2008-02-01 aku: }]] def last e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: # TODO/CHECK: look for changesets where isdefault/dbchild is e8efbc317a 2008-02-01 aku: # ambigous. e8efbc317a 2008-02-01 aku: e8efbc317a 2008-02-01 aku: return [list $def [expr {$last ne ""}]] c74fe3de3f 2007-11-29 aku: } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: typemethod split {cset args} { c74fe3de3f 2007-11-29 aku: # As part of the creation of the new changesets specified in deab4d035b 2007-11-29 aku: # ARGS as sets of items, all subsets of CSET's item set, CSET deab4d035b 2007-11-29 aku: # will be dropped from all databases, in and out of memory, deab4d035b 2007-11-29 aku: # and then destroyed. 96167b2a48 2007-11-25 aku: # 0fcfbf7828 2007-11-29 aku: # Note: The item lists found in args are tagged items. They 0fcfbf7828 2007-11-29 aku: # have to have the same type as the changeset, being subsets 0fcfbf7828 2007-11-29 aku: # of its items. This is checked in Untag1. 0fcfbf7828 2007-11-29 aku: b42cff97e3 2007-11-30 aku: log write 8 csets {OLD: [lsort [$cset items]]} fbfb531868 2007-12-02 aku: ValidateFragments $cset $args b42cff97e3 2007-11-30 aku: b42cff97e3 2007-11-30 aku: # All checks pass, actually perform the split. c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: struct::list assign [$cset data] project cstype cssrc c74fe3de3f 2007-11-29 aku: 00bf8c198e 2007-12-02 aku: set predecessors [$cset drop] c74fe3de3f 2007-11-29 aku: $cset destroy c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: set newcsets {} deab4d035b 2007-11-29 aku: foreach fragmentitems $args { b42cff97e3 2007-11-30 aku: log write 8 csets {MAKE: [lsort $fragmentitems]} b42cff97e3 2007-11-30 aku: b42cff97e3 2007-11-30 aku: set fragment [$type %AUTO% $project $cstype $cssrc \ b42cff97e3 2007-11-30 aku: [Untag $fragmentitems $cstype]] b42cff97e3 2007-11-30 aku: lappend newcsets $fragment 00bf8c198e 2007-12-02 aku: b42cff97e3 2007-11-30 aku: $fragment persist 00bf8c198e 2007-12-02 aku: $fragment determinesuccessors 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: # The predecessors have to recompute their successors, i.e. 00bf8c198e 2007-12-02 aku: # remove the dropped changeset and put one of the fragments 00bf8c198e 2007-12-02 aku: # into its place. 00bf8c198e 2007-12-02 aku: foreach p $predecessors { 00bf8c198e 2007-12-02 aku: $p determinesuccessors 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: c74fe3de3f 2007-11-29 aku: return $newcsets fbfb531868 2007-12-02 aku: } fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: typemethod itemstr {item} { fbfb531868 2007-12-02 aku: struct::list assign $item itype iid fbfb531868 2007-12-02 aku: return [$itype str $iid] c74fe3de3f 2007-11-29 aku: } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: typemethod strlist {changesets} { c74fe3de3f 2007-11-29 aku: return [join [struct::list map $changesets [myproc ID]]] c74fe3de3f 2007-11-29 aku: } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: proc ID {cset} { $cset str } 0fcfbf7828 2007-11-29 aku: 0fcfbf7828 2007-11-29 aku: proc Untag {taggeditems cstype} { 0fcfbf7828 2007-11-29 aku: return [struct::list map $taggeditems [myproc Untag1 $cstype]] 0fcfbf7828 2007-11-29 aku: } 0fcfbf7828 2007-11-29 aku: 0fcfbf7828 2007-11-29 aku: proc Untag1 {cstype theitem} { 0fcfbf7828 2007-11-29 aku: struct::list assign $theitem t i 0fcfbf7828 2007-11-29 aku: integrity assert {$cstype eq $t} {Item $i's type is '$t', expected '$cstype'} 0fcfbf7828 2007-11-29 aku: return $i b42cff97e3 2007-11-30 aku: } b42cff97e3 2007-11-30 aku: 711e000206 2007-12-04 aku: proc TagItemDict {itemdict cstype} { 711e000206 2007-12-04 aku: set res {} 711e000206 2007-12-04 aku: foreach {i v} $itemdict { lappend res [list $cstype $i] $v } 711e000206 2007-12-04 aku: return $res fbfb531868 2007-12-02 aku: } fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: proc ValidateFragments {cset fragments} { fbfb531868 2007-12-02 aku: # Check the various integrity constraints for the fragments fbfb531868 2007-12-02 aku: # specifying how to split the changeset: 96167b2a48 2007-11-25 aku: # fbfb531868 2007-12-02 aku: # * We must have two or more fragments, as splitting a fbfb531868 2007-12-02 aku: # changeset into one makes no sense. fbfb531868 2007-12-02 aku: # * No fragment may be empty. fbfb531868 2007-12-02 aku: # * All fragments have to be true subsets of the items in the fbfb531868 2007-12-02 aku: # changeset to split. The 'true' is implied because none are fbfb531868 2007-12-02 aku: # allowed to be empty, so each has to be smaller than the fbfb531868 2007-12-02 aku: # total. fbfb531868 2007-12-02 aku: # * The union of the fragments has to be the item set of the fbfb531868 2007-12-02 aku: # changeset. fbfb531868 2007-12-02 aku: # * The fragment must not overlap, i.e. their pairwise fbfb531868 2007-12-02 aku: # intersections have to be empty. fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: set cover {} fbfb531868 2007-12-02 aku: foreach fragmentitems $fragments { fbfb531868 2007-12-02 aku: log write 8 csets {NEW: [lsort $fragmentitems]} fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: integrity assert { fbfb531868 2007-12-02 aku: ![struct::set empty $fragmentitems] fbfb531868 2007-12-02 aku: } {changeset fragment is empty} fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: integrity assert { fbfb531868 2007-12-02 aku: [struct::set subsetof $fragmentitems [$cset items]] fbfb531868 2007-12-02 aku: } {changeset fragment is not a subset} fbfb531868 2007-12-02 aku: struct::set add cover $fragmentitems fbfb531868 2007-12-02 aku: } fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: integrity assert { fbfb531868 2007-12-02 aku: [struct::set equal $cover [$cset items]] fbfb531868 2007-12-02 aku: } {The fragments do not cover the original changeset} fbfb531868 2007-12-02 aku: fbfb531868 2007-12-02 aku: set i 1 fbfb531868 2007-12-02 aku: foreach fia $fragments { fbfb531868 2007-12-02 aku: foreach fib [lrange $fragments $i end] { fbfb531868 2007-12-02 aku: integrity assert { fbfb531868 2007-12-02 aku: [struct::set empty [struct::set intersect $fia $fib]] fbfb531868 2007-12-02 aku: } {The fragments <$fia> and <$fib> overlap} fbfb531868 2007-12-02 aku: } fbfb531868 2007-12-02 aku: incr i fbfb531868 2007-12-02 aku: } fbfb531868 2007-12-02 aku: 84de38d73f 2007-10-10 aku: return 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## State 84de38d73f 2007-10-10 aku: c74fe3de3f 2007-11-29 aku: variable myid {} ; # Id of the cset for the persistent c74fe3de3f 2007-11-29 aku: # state. c74fe3de3f 2007-11-29 aku: variable myproject {} ; # Reference of the project object the c74fe3de3f 2007-11-29 aku: # changeset belongs to. c74fe3de3f 2007-11-29 aku: variable mytype {} ; # What the changeset is based on c74fe3de3f 2007-11-29 aku: # (revisions, tags, or branches). c74fe3de3f 2007-11-29 aku: # Values: See mycstype. Note that we c74fe3de3f 2007-11-29 aku: # have to keep the names of the helper c74fe3de3f 2007-11-29 aku: # singletons in sync with the contents c74fe3de3f 2007-11-29 aku: # of state table 'cstype', and various c74fe3de3f 2007-11-29 aku: # other places using them hardwired. c74fe3de3f 2007-11-29 aku: variable mytypeobj {} ; # Reference to the container for the c74fe3de3f 2007-11-29 aku: # type dependent code. Derived from c74fe3de3f 2007-11-29 aku: # mytype. c74fe3de3f 2007-11-29 aku: variable mysrcid {} ; # Id of the metadata or symbol the cset c74fe3de3f 2007-11-29 aku: # is based on. deab4d035b 2007-11-29 aku: variable myitems {} ; # List of the file level revisions, 0fcfbf7828 2007-11-29 aku: # tags, or branches in the cset, as 0fcfbf7828 2007-11-29 aku: # ids. Not tagged. deab4d035b 2007-11-29 aku: variable mytitems {} ; # As myitems, the tagged form. c74fe3de3f 2007-11-29 aku: variable mypos {} ; # Commit position of the changeset, if c74fe3de3f 2007-11-29 aku: # known. 5f7acef887 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Internal methods 84de38d73f 2007-10-10 aku: 70d2283564 2007-11-29 aku: typevariable mycounter 0 ; # Id counter for csets. Last id 70d2283564 2007-11-29 aku: # used. c74fe3de3f 2007-11-29 aku: typevariable mycstype -array {} ; # Map cstypes (names) to persistent c74fe3de3f 2007-11-29 aku: # ids. Note that we have to keep c74fe3de3f 2007-11-29 aku: # the names in the table 'cstype' c74fe3de3f 2007-11-29 aku: # in sync with the names of the c74fe3de3f 2007-11-29 aku: # helper singletons. c74fe3de3f 2007-11-29 aku: 348e45b0d6 2008-01-30 aku: typemethod inorder {projectid} { 983090a343 2008-03-05 aku: # Return all changesets (object references) for the specified 983090a343 2008-03-05 aku: # project, in the order given to them by the sort passes. Both 983090a343 2008-03-05 aku: # the filtering by project and the sorting by time make the 983090a343 2008-03-05 aku: # use of 'project::rev rev' impossible. 348e45b0d6 2008-01-30 aku: 348e45b0d6 2008-01-30 aku: set res {} f637d42206 2008-02-24 aku: state foreachrow { 983090a343 2008-03-05 aku: SELECT C.cid AS xcid, 983090a343 2008-03-05 aku: T.date AS cdate 348e45b0d6 2008-01-30 aku: FROM changeset C, cstimestamp T 983090a343 2008-03-05 aku: WHERE C.pid = $projectid -- limit to changesets in project 348e45b0d6 2008-01-30 aku: AND T.cid = C.cid -- get ordering information 348e45b0d6 2008-01-30 aku: ORDER BY T.date -- sort into commit order f637d42206 2008-02-24 aku: } { f637d42206 2008-02-24 aku: lappend res $myidmap($xcid) $cdate 348e45b0d6 2008-01-30 aku: } 348e45b0d6 2008-01-30 aku: return $res 348e45b0d6 2008-01-30 aku: } 5f7acef887 2007-11-10 aku: 5f7acef887 2007-11-10 aku: typemethod getcstypes {} { 6559f3231e 2008-02-24 aku: state foreachrow { 5f7acef887 2007-11-10 aku: SELECT tid, name FROM cstype; 6559f3231e 2008-02-24 aku: } { set mycstype($name) $tid } 9e1b461b2f 2008-01-30 aku: return 9e1b461b2f 2008-01-30 aku: } 9e1b461b2f 2008-01-30 aku: 9e1b461b2f 2008-01-30 aku: typemethod load {repository} { 49dd66f64f 2008-01-30 aku: set n 0 49dd66f64f 2008-01-30 aku: log write 2 csets {Loading the changesets} 6559f3231e 2008-02-24 aku: state foreachrow { 6559f3231e 2008-02-24 aku: SELECT C.cid AS id, 6559f3231e 2008-02-24 aku: C.pid AS xpid, 6559f3231e 2008-02-24 aku: CS.name AS cstype, 6559f3231e 2008-02-24 aku: C.src AS srcid 49dd66f64f 2008-01-30 aku: FROM changeset C, cstype CS 49dd66f64f 2008-01-30 aku: WHERE C.type = CS.tid 49dd66f64f 2008-01-30 aku: ORDER BY C.cid 6559f3231e 2008-02-24 aku: } { 49dd66f64f 2008-01-30 aku: log progress 2 csets $n {} 6559f3231e 2008-02-24 aku: set r [$type %AUTO% [$repository projectof $xpid] $cstype $srcid [state run { 49dd66f64f 2008-01-30 aku: SELECT C.iid 49dd66f64f 2008-01-30 aku: FROM csitem C 49dd66f64f 2008-01-30 aku: WHERE C.cid = $id 49dd66f64f 2008-01-30 aku: ORDER BY C.pos 49dd66f64f 2008-01-30 aku: }] $id] 49dd66f64f 2008-01-30 aku: incr n 49dd66f64f 2008-01-30 aku: } c74fe3de3f 2007-11-29 aku: return c74fe3de3f 2007-11-29 aku: } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: typemethod loadcounter {} { c74fe3de3f 2007-11-29 aku: # Initialize the counter from the state 49dd66f64f 2008-01-30 aku: log write 2 csets {Loading changeset counter} c74fe3de3f 2007-11-29 aku: set mycounter [state one { SELECT MAX(cid) FROM changeset }] c74fe3de3f 2007-11-29 aku: return c74fe3de3f 2007-11-29 aku: } c74fe3de3f 2007-11-29 aku: c74fe3de3f 2007-11-29 aku: typemethod num {} { return $mycounter } c74fe3de3f 2007-11-29 aku: 530168ec30 2008-02-23 aku: # # ## ### ##### ######## ############# 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: method CreateFromFragments {fragments cv bv} { 530168ec30 2008-02-23 aku: upvar 1 $cv counter $bv breaks 530168ec30 2008-02-23 aku: UnmapItems $mytype $myitems 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # Create changesets for the fragments, reusing the current one 530168ec30 2008-02-23 aku: # for the first fragment. We sort them in order to allow 530168ec30 2008-02-23 aku: # checking for gaps and nice messages. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set newcsets {} 530168ec30 2008-02-23 aku: set fragments [lsort -index 0 -integer $fragments] 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: #puts \t.[join [PRs $fragments] .\n\t.]. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: Border [lindex $fragments 0] firsts firste 530168ec30 2008-02-23 aku: 4b0f43fb2f 2008-02-24 aku: integrity assert { 4b0f43fb2f 2008-02-24 aku: $firsts == 0 4b0f43fb2f 2008-02-24 aku: } {Bad fragment start @ $firsts, gap, or before beginning of the range} 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set laste $firste 530168ec30 2008-02-23 aku: foreach fragment [lrange $fragments 1 end] { 530168ec30 2008-02-23 aku: Border $fragment s e 4b0f43fb2f 2008-02-24 aku: integrity assert { 4b0f43fb2f 2008-02-24 aku: $laste == ($s - 1) 4b0f43fb2f 2008-02-24 aku: } {Bad fragment border <$laste | $s>, gap or overlap} 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set new [$type %AUTO% $myproject $mytype $mysrcid [lrange $myitems $s $e]] 530168ec30 2008-02-23 aku: lappend newcsets $new 530168ec30 2008-02-23 aku: incr counter 530168ec30 2008-02-23 aku: 4b0f43fb2f 2008-02-24 aku: log write 4 csets {Breaking [$self str ] @ $laste, new [$new str], cutting $breaks($laste)} 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set laste $e 530168ec30 2008-02-23 aku: } 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: integrity assert { 530168ec30 2008-02-23 aku: $laste == ([llength $myitems]-1) 530168ec30 2008-02-23 aku: } {Bad fragment end @ $laste, gap, or beyond end of the range} 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # Put the first fragment into the current changeset, and 530168ec30 2008-02-23 aku: # update the in-memory index. We can simply (re)add the items 530168ec30 2008-02-23 aku: # because we cleared the previously existing information, see 530168ec30 2008-02-23 aku: # 'UnmapItems' above. Persistence does not matter here, none 530168ec30 2008-02-23 aku: # of the changesets has been saved to the persistent state 530168ec30 2008-02-23 aku: # yet. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set myitems [lrange $myitems 0 $firste] 530168ec30 2008-02-23 aku: set mytitems [lrange $mytitems 0 $firste] 530168ec30 2008-02-23 aku: MapItems $mytype $myitems 530168ec30 2008-02-23 aku: return $newcsets 530168ec30 2008-02-23 aku: } 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # # ## ### ##### ######## ############# 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: proc BreakDirectDependencies {theitems bv} { 530168ec30 2008-02-23 aku: upvar 1 mytypeobj mytypeobj self self $bv breaks 530168ec30 2008-02-23 aku: 4b0f43fb2f 2008-02-24 aku: # Array of dependencies (parent -> child). This is pulled from 4b0f43fb2f 2008-02-24 aku: # the state, and limited to successors within the changeset. 4b0f43fb2f 2008-02-24 aku: 530168ec30 2008-02-23 aku: array set dependencies {} 4b0f43fb2f 2008-02-24 aku: 530168ec30 2008-02-23 aku: $mytypeobj internalsuccessors dependencies $theitems 530168ec30 2008-02-23 aku: if {![array size dependencies]} { 530168ec30 2008-02-23 aku: return {} 530168ec30 2008-02-23 aku: } ; # Nothing to break. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: log write 5 csets ...[$self str]....................................................... 530168ec30 2008-02-23 aku: vc::tools::mem::mark 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: return [BreakerCore $theitems dependencies breaks] 530168ec30 2008-02-23 aku: } 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: proc BreakerCore {theitems dv bv} { 530168ec30 2008-02-23 aku: # Break a set of revisions into fragments which have no 530168ec30 2008-02-23 aku: # internal dependencies. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # We perform all necessary splits in one go, instead of only 530168ec30 2008-02-23 aku: # one. The previous algorithm, adapted from cvs2svn, computed 530168ec30 2008-02-23 aku: # a lot of state which was thrown away and then computed again 530168ec30 2008-02-23 aku: # for each of the fragments. It should be easier to update and 530168ec30 2008-02-23 aku: # reuse that state. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: upvar 1 $dv dependencies $bv breaks 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # We have internal dependencies to break. We now iterate over 530168ec30 2008-02-23 aku: # all positions in the list (which is chronological, at least 530168ec30 2008-02-23 aku: # as far as the timestamps are correct and unique) and 530168ec30 2008-02-23 aku: # determine the best position for the break, by trying to 530168ec30 2008-02-23 aku: # break as many dependencies as possible in one go. When a 530168ec30 2008-02-23 aku: # break was found this is redone for the fragments coming and 530168ec30 2008-02-23 aku: # after, after upding the crossing information. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # Data structures: 530168ec30 2008-02-23 aku: # Map: POS revision id -> position in list. 530168ec30 2008-02-23 aku: # CROSS position in list -> number of dependencies crossing it 530168ec30 2008-02-23 aku: # DEPC dependency -> positions it crosses 530168ec30 2008-02-23 aku: # List: RANGE Of the positions itself. 530168ec30 2008-02-23 aku: # Map: DELTA position in list -> time delta between its revision 530168ec30 2008-02-23 aku: # and the next, if any. 530168ec30 2008-02-23 aku: # A dependency is a single-element map parent -> child 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: # InitializeBreakState initializes their contents after 530168ec30 2008-02-23 aku: # upvar'ing them from this scope. It uses the information in 530168ec30 2008-02-23 aku: # DEPENDENCIES to do so. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: InitializeBreakState $theitems 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: set fragments {} 530168ec30 2008-02-23 aku: set new [list $range] c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: # Instead of one list holding both processed and pending c14e8f84cd 2007-11-30 aku: # fragments we use two, one for the framents to process, one c14e8f84cd 2007-11-30 aku: # to hold the new fragments, and the latter is copied to the c14e8f84cd 2007-11-30 aku: # former when they run out. This keeps the list of pending c14e8f84cd 2007-11-30 aku: # fragments short without sacrificing speed by shifting stuff c14e8f84cd 2007-11-30 aku: # down. We especially drop the memory of fragments broken c14e8f84cd 2007-11-30 aku: # during processing after a short time, instead of letting it c14e8f84cd 2007-11-30 aku: # consume memory. c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: while {[llength $new]} { c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: set pending $new c14e8f84cd 2007-11-30 aku: set new {} c14e8f84cd 2007-11-30 aku: set at 0 c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: while {$at < [llength $pending]} { c14e8f84cd 2007-11-30 aku: set current [lindex $pending $at] c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: log write 6 csets {. . .. ... ..... ........ .............} c14e8f84cd 2007-11-30 aku: log write 6 csets {Scheduled [join [PRs [lrange $pending $at end]] { }]} c14e8f84cd 2007-11-30 aku: log write 6 csets {Considering [PR $current] \[$at/[llength $pending]\]} c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: set best [FindBestBreak $current] c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: if {$best < 0} { c14e8f84cd 2007-11-30 aku: # The inspected range has no internal c14e8f84cd 2007-11-30 aku: # dependencies. This is a complete fragment. c14e8f84cd 2007-11-30 aku: lappend fragments $current c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: log write 6 csets "No breaks, final" c14e8f84cd 2007-11-30 aku: } else { c14e8f84cd 2007-11-30 aku: # Split the range and schedule the resulting c14e8f84cd 2007-11-30 aku: # fragments for further inspection. Remember the c14e8f84cd 2007-11-30 aku: # number of dependencies cut before we remove them c14e8f84cd 2007-11-30 aku: # from consideration, for documentation later. c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: set breaks($best) $cross($best) c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: log write 6 csets "Best break @ $best, cutting [nsp $cross($best) dependency dependencies]" c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: # Note: The value of best is an abolute location c14e8f84cd 2007-11-30 aku: # in myitems. Use the start of current to make it c14e8f84cd 2007-11-30 aku: # an index absolute to current. c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: set brel [expr {$best - [lindex $current 0]}] c14e8f84cd 2007-11-30 aku: set bnext $brel ; incr bnext c14e8f84cd 2007-11-30 aku: set fragbefore [lrange $current 0 $brel] c14e8f84cd 2007-11-30 aku: set fragafter [lrange $current $bnext end] c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: log write 6 csets "New pieces [PR $fragbefore] [PR $fragafter]" c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: integrity assert {[llength $fragbefore]} {Found zero-length fragment at the beginning} c14e8f84cd 2007-11-30 aku: integrity assert {[llength $fragafter]} {Found zero-length fragment at the end} c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: lappend new $fragbefore $fragafter c14e8f84cd 2007-11-30 aku: CutAt $best c74fe3de3f 2007-11-29 aku: } c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: incr at 184c56327e 2007-11-24 aku: } c74fe3de3f 2007-11-29 aku: } c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: log write 6 csets ". . .. ... ..... ........ ............." c14e8f84cd 2007-11-30 aku: 530168ec30 2008-02-23 aku: return $fragments 184c56327e 2007-11-24 aku: } 184c56327e 2007-11-24 aku: 184c56327e 2007-11-24 aku: proc InitializeBreakState {revisions} { 184c56327e 2007-11-24 aku: upvar 1 pos pos cross cross range range depc depc delta delta \ 184c56327e 2007-11-24 aku: dependencies dependencies 184c56327e 2007-11-24 aku: 184c56327e 2007-11-24 aku: # First we create a map of positions to make it easier to 184c56327e 2007-11-24 aku: # determine whether a dependency crosses a particular index. c2ad73ed92 2008-02-21 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: #rev [llength $revisions]} c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: pos map, cross counter} 184c56327e 2007-11-24 aku: 184c56327e 2007-11-24 aku: array set pos {} 184c56327e 2007-11-24 aku: array set cross {} 184c56327e 2007-11-24 aku: array set depc {} 184c56327e 2007-11-24 aku: set range {} 184c56327e 2007-11-24 aku: set n 0 184c56327e 2007-11-24 aku: foreach rev $revisions { 184c56327e 2007-11-24 aku: lappend range $n 184c56327e 2007-11-24 aku: set pos($rev) $n 184c56327e 2007-11-24 aku: set cross($n) 0 184c56327e 2007-11-24 aku: incr n 184c56327e 2007-11-24 aku: } 184c56327e 2007-11-24 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: pos/[array size pos], cross/[array size cross]} 70d2283564 2007-11-29 aku: 184c56327e 2007-11-24 aku: # Secondly we count the crossings per position, by iterating 184c56327e 2007-11-24 aku: # over the recorded internal dependencies. 184c56327e 2007-11-24 aku: 184c56327e 2007-11-24 aku: # Note: If the timestamps are badly out of order it is 184c56327e 2007-11-24 aku: # possible to have a backward successor dependency, 184c56327e 2007-11-24 aku: # i.e. with start > end. We may have to swap the indices 184c56327e 2007-11-24 aku: # to ensure that the following loop runs correctly. 184c56327e 2007-11-24 aku: # 184c56327e 2007-11-24 aku: # Note 2: start == end is not possible. It indicates a 184c56327e 2007-11-24 aku: # self-dependency due to the uniqueness of positions, 184c56327e 2007-11-24 aku: # and that is something we have ruled out already, see 70d2283564 2007-11-29 aku: # 'rev internalsuccessors'. 70d2283564 2007-11-29 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: cross counter filling, pos/cross map} 678765068d 2007-11-27 aku: 678765068d 2007-11-27 aku: foreach {rid children} [array get dependencies] { 678765068d 2007-11-27 aku: foreach child $children { 678765068d 2007-11-27 aku: set dkey [list $rid $child] 678765068d 2007-11-27 aku: set start $pos($rid) 678765068d 2007-11-27 aku: set end $pos($child) 678765068d 2007-11-27 aku: 678765068d 2007-11-27 aku: if {$start > $end} { 59b54efab5 2008-02-24 aku: set crosses [list $end [expr {$start-1}]] 59b54efab5 2008-02-24 aku: while {$end < $start} { 678765068d 2007-11-27 aku: incr cross($end) 678765068d 2007-11-27 aku: incr end 678765068d 2007-11-27 aku: } 678765068d 2007-11-27 aku: } else { 59b54efab5 2008-02-24 aku: set crosses [list $start [expr {$end-1}]] 59b54efab5 2008-02-24 aku: while {$start < $end} { 678765068d 2007-11-27 aku: incr cross($start) 678765068d 2007-11-27 aku: incr start 678765068d 2007-11-27 aku: } 08ebab80cd 2007-11-10 aku: } 678765068d 2007-11-27 aku: set depc($dkey) $crosses 08ebab80cd 2007-11-10 aku: } 678765068d 2007-11-27 aku: } 678765068d 2007-11-27 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: pos/[array size pos], cross/[array size cross], depc/[array size depc] (for [llength $revisions])} c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: timestamps, deltas} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: InitializeDeltas $revisions c2ad73ed92 2008-02-21 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: delta [array size delta]} 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc InitializeDeltas {revisions} { 08ebab80cd 2007-11-10 aku: upvar 1 delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Pull the timestamps for all revisions in the changesets and 08ebab80cd 2007-11-10 aku: # compute their deltas for use by the break finder. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: array set delta {} 08ebab80cd 2007-11-10 aku: array set stamp {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set theset ('[join $revisions {','}]') f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, R.date AS time 08ebab80cd 2007-11-10 aku: FROM revision R 08ebab80cd 2007-11-10 aku: WHERE R.rid IN $theset f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: set stamp($xrid) $time c2ad73ed92 2008-02-21 aku: } c2ad73ed92 2008-02-21 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {IBS: stamp [array size stamp]} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set n 0 08ebab80cd 2007-11-10 aku: foreach rid [lrange $revisions 0 end-1] rnext [lrange $revisions 1 end] { 08ebab80cd 2007-11-10 aku: set delta($n) [expr {$stamp($rnext) - $stamp($rid)}] 08ebab80cd 2007-11-10 aku: incr n 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc FindBestBreak {range} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross delta delta 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Determine the best break location in the given range of 08ebab80cd 2007-11-10 aku: # positions. First we look for the locations with the maximal 08ebab80cd 2007-11-10 aku: # number of crossings. If there are several we look for the 08ebab80cd 2007-11-10 aku: # shortest time interval among them. If we still have multiple 08ebab80cd 2007-11-10 aku: # possibilities after that we select the earliest location 08ebab80cd 2007-11-10 aku: # among these. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: If the maximal number of crossings is 0 then the range 08ebab80cd 2007-11-10 aku: # has no internal dependencies, and no break location at 08ebab80cd 2007-11-10 aku: # all. This possibility is signaled via result -1. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Note: A range of length 1 or less cannot have internal 08ebab80cd 2007-11-10 aku: # dependencies, as that needs at least two revisions in 08ebab80cd 2007-11-10 aku: # the range. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $range] < 2} { return -1 } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set max -1 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $range { 08ebab80cd 2007-11-10 aku: set crossings $cross($location) 08ebab80cd 2007-11-10 aku: if {$crossings > $max} { 08ebab80cd 2007-11-10 aku: set max $crossings 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: continue 08ebab80cd 2007-11-10 aku: } elseif {$crossings == $max} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {$max == 0} { return -1 } 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set locations $best 08ebab80cd 2007-11-10 aku: set best {} 08ebab80cd 2007-11-10 aku: set min -1 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: foreach location $locations { 08ebab80cd 2007-11-10 aku: set interval $delta($location) 08ebab80cd 2007-11-10 aku: if {($min < 0) || ($interval < $min)} { 08ebab80cd 2007-11-10 aku: set min $interval 08ebab80cd 2007-11-10 aku: set best [list $location] 08ebab80cd 2007-11-10 aku: } elseif {$interval == $min} { 08ebab80cd 2007-11-10 aku: lappend best $location 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {[llength $best] == 1} { return [lindex $best 0] } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return [lindex [lsort -integer -increasing $best] 0] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc CutAt {location} { 08ebab80cd 2007-11-10 aku: upvar 1 cross cross depc depc 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # It was decided to split the changeset at the given 08ebab80cd 2007-11-10 aku: # location. This cuts a number of dependencies. Here we update 08ebab80cd 2007-11-10 aku: # the cross information so that the break finder has accurate 08ebab80cd 2007-11-10 aku: # data when we look at the generated fragments. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: set six [log visible? 6] 08ebab80cd 2007-11-10 aku: 59b54efab5 2008-02-24 aku: # Note: The loop below could be made faster by keeping a map 59b54efab5 2008-02-24 aku: # from positions to the dependencies crossing. An extension of 59b54efab5 2008-02-24 aku: # CROSS, i.e. list of dependencies, counter is implied. Takes 59b54efab5 2008-02-24 aku: # a lot more memory however, and takes time to update here 59b54efab5 2008-02-24 aku: # (The inner loop is not incr -1, but ldelete). 59b54efab5 2008-02-24 aku: 59b54efab5 2008-02-24 aku: foreach dep [array names depc] { 59b54efab5 2008-02-24 aku: set range $depc($dep) 08ebab80cd 2007-11-10 aku: # Check all dependencies still known, take their range and 08ebab80cd 2007-11-10 aku: # see if the break location falls within. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: if {$location < $s} continue ; # break before range, ignore 08ebab80cd 2007-11-10 aku: if {$location > $e} continue ; # break after range, ignore. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # This dependency crosses the break location. We remove it 08ebab80cd 2007-11-10 aku: # from the crossings counters, and then also from the set 08ebab80cd 2007-11-10 aku: # of known dependencies, as we are done with it. 08ebab80cd 2007-11-10 aku: 59b54efab5 2008-02-24 aku: Border $depc($dep) ds de 59b54efab5 2008-02-24 aku: for {set loc $ds} {$loc <= $de} {incr loc} { 59b54efab5 2008-02-24 aku: incr cross($loc) -1 59b54efab5 2008-02-24 aku: } 08ebab80cd 2007-11-10 aku: unset depc($dep) 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: if {!$six} continue 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: struct::list assign $dep parent child 911d56a8c8 2007-11-27 aku: log write 5 csets "Broke dependency [PD $parent] --> [PD $child]" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Print identifying data for a revision (project, file, dotted rev 08ebab80cd 2007-11-10 aku: # number), for high verbosity log output. ac02614803 2007-12-02 aku: # TODO: Replace with call to itemstr (list rev $id) 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PD {id} { 08ebab80cd 2007-11-10 aku: foreach {p f r} [state run { 08ebab80cd 2007-11-10 aku: SELECT P.name , F.name, R.rev 08ebab80cd 2007-11-10 aku: FROM revision R, file F, project P 6809145eb1 2008-01-19 aku: WHERE R.rid = $id -- Find specified file revision 6809145eb1 2008-01-19 aku: AND F.fid = R.fid -- Get file of the revision 6809145eb1 2008-01-19 aku: AND P.pid = F.pid -- Get project of the file. 08ebab80cd 2007-11-10 aku: }] break 08ebab80cd 2007-11-10 aku: return "'$p : $f/$r'" 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # Printing one or more ranges, formatted, and only their border to 08ebab80cd 2007-11-10 aku: # keep the strings short. 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PRs {ranges} { 08ebab80cd 2007-11-10 aku: return [struct::list map $ranges [myproc PR]] 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc PR {range} { 08ebab80cd 2007-11-10 aku: Border $range s e 08ebab80cd 2007-11-10 aku: return <${s}...${e}> 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: proc Border {range sv ev} { 08ebab80cd 2007-11-10 aku: upvar 1 $sv s $ev e 08ebab80cd 2007-11-10 aku: set s [lindex $range 0] 08ebab80cd 2007-11-10 aku: set e [lindex $range end] 08ebab80cd 2007-11-10 aku: return 08ebab80cd 2007-11-10 aku: } 08ebab80cd 2007-11-10 aku: 08ebab80cd 2007-11-10 aku: # # ## ### ##### ######## ############# 24c0b662de 2007-11-13 aku: 530168ec30 2008-02-23 aku: proc UnmapItems {thetype theitems} { 530168ec30 2008-02-23 aku: # (*) We clear out the associated part of the myitemmap 530168ec30 2008-02-23 aku: # in-memory index in preparation for new data, or as part of 530168ec30 2008-02-23 aku: # object destruction. A simple unset is enough, we have no 530168ec30 2008-02-23 aku: # symbol changesets at this time, and thus never more than one 530168ec30 2008-02-23 aku: # reference in the list. 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: upvar 1 myitemmap myitemmap self self 530168ec30 2008-02-23 aku: foreach iid $theitems { 530168ec30 2008-02-23 aku: set key [list $thetype $iid] 530168ec30 2008-02-23 aku: unset myitemmap($key) 530168ec30 2008-02-23 aku: log write 8 csets {MAP- item <$key> $self = [$self str]} 530168ec30 2008-02-23 aku: } 530168ec30 2008-02-23 aku: return 530168ec30 2008-02-23 aku: } 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: proc MapItems {thetype theitems} { 530168ec30 2008-02-23 aku: upvar 1 myitemmap myitemmap self self 530168ec30 2008-02-23 aku: 530168ec30 2008-02-23 aku: foreach iid $theitems { 530168ec30 2008-02-23 aku: set key [list $thetype $iid] 530168ec30 2008-02-23 aku: set myitemmap($key) $self 530168ec30 2008-02-23 aku: log write 8 csets {MAP+ item <$key> $self = [$self str]} 530168ec30 2008-02-23 aku: } 5f7acef887 2007-11-10 aku: return 5f7acef887 2007-11-10 aku: } 21d9664fb5 2008-02-08 aku: 21d9664fb5 2008-02-08 aku: # # ## ### ##### ######## ############# 21d9664fb5 2008-02-08 aku: 00bf8c198e 2007-12-02 aku: typevariable mychangesets {} ; # List of all known 00bf8c198e 2007-12-02 aku: # changesets. 21d9664fb5 2008-02-08 aku: 21d9664fb5 2008-02-08 aku: # List of all known changesets of a type. 21d9664fb5 2008-02-08 aku: typevariable mytchangesets -array { 21d9664fb5 2008-02-08 aku: sym::branch {} 21d9664fb5 2008-02-08 aku: sym::tag {} 21d9664fb5 2008-02-08 aku: rev {} 21d9664fb5 2008-02-08 aku: } 21d9664fb5 2008-02-08 aku: 00bf8c198e 2007-12-02 aku: typevariable myitemmap -array {} ; # Map from items (tagged) 00bf8c198e 2007-12-02 aku: # to the list of changesets 00bf8c198e 2007-12-02 aku: # containing it. Each item 00bf8c198e 2007-12-02 aku: # can be used by only one 00bf8c198e 2007-12-02 aku: # changeset. deab4d035b 2007-11-29 aku: typevariable myidmap -array {} ; # Map from changeset id to deab4d035b 2007-11-29 aku: # changeset. deab4d035b 2007-11-29 aku: 04d76a9e79 2007-11-29 aku: typemethod all {} { return $mychangesets } 04d76a9e79 2007-11-29 aku: typemethod of {cid} { return $myidmap($cid) } 04d76a9e79 2007-11-29 aku: typemethod ofitem {iid} { return $myitemmap($iid) } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: typemethod rev {} { return $mytchangesets(rev) } 00bf8c198e 2007-12-02 aku: typemethod sym {} { return [concat \ 00bf8c198e 2007-12-02 aku: ${mytchangesets(sym::branch)} \ 00bf8c198e 2007-12-02 aku: ${mytchangesets(sym::tag)}] } 5f7acef887 2007-11-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 84de38d73f 2007-10-10 aku: ## Configuration 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: pragma -hastypeinfo no ; # no type introspection 84de38d73f 2007-10-10 aku: pragma -hasinfo no ; # no object introspection 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# 27b15b7095 2007-11-29 aku: } c14e8f84cd 2007-11-30 aku: c14e8f84cd 2007-11-30 aku: ## c14e8f84cd 2007-11-30 aku: ## NOTE: The successor and predecessor methods defined by the classes c14e8f84cd 2007-11-30 aku: ## below are -- bottle necks --. Look for ways to make the SQL c14e8f84cd 2007-11-30 aku: ## faster. c14e8f84cd 2007-11-30 aku: ## 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for revision changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::rev { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 0 } 27b15b7095 2007-11-29 aku: b42cff97e3 2007-11-30 aku: typemethod str {revision} { b42cff97e3 2007-11-30 aku: struct::list assign [state run { b42cff97e3 2007-11-30 aku: SELECT R.rev, F.name, P.name b42cff97e3 2007-11-30 aku: FROM revision R, file F, project P 6809145eb1 2008-01-19 aku: WHERE R.rid = $revision -- Find specified file revision 6809145eb1 2008-01-19 aku: AND F.fid = R.fid -- Get file of the revision 6809145eb1 2008-01-19 aku: AND P.pid = F.pid -- Get project of the file. b42cff97e3 2007-11-30 aku: }] revnr fname pname b42cff97e3 2007-11-30 aku: return "$pname/${revnr}::$fname" b42cff97e3 2007-11-30 aku: } b42cff97e3 2007-11-30 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {items} { c74fe3de3f 2007-11-29 aku: set theset ('[join $items {','}]') 0ee9711e2e 2007-12-05 aku: return [state run [subst -nocommands -nobackslashes { c74fe3de3f 2007-11-29 aku: SELECT MIN(R.date), MAX(R.date) c74fe3de3f 2007-11-29 aku: FROM revision R 6809145eb1 2008-01-19 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 0ee9711e2e 2007-12-05 aku: }]] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (revision -> list (revision)) 27b15b7095 2007-11-29 aku: typemethod internalsuccessors {dv revisions} { 70d2283564 2007-11-29 aku: upvar 1 $dv dependencies 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 6809145eb1 2008-01-19 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets internalsuccessors 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # See 'successors' below for the main explanation of 70d2283564 2007-11-29 aku: # the various cases. This piece is special in that it 70d2283564 2007-11-29 aku: # restricts the successors we look for to the same set of 70d2283564 2007-11-29 aku: # revisions we start from. Sensible as we are looking for 70d2283564 2007-11-29 aku: # changeset internal dependencies. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: array set dep {} 70d2283564 2007-11-29 aku: 6559f3231e 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { 6809145eb1 2008-01-19 aku: -- (1) Primary child 6559f3231e 2008-02-24 aku: SELECT R.rid AS xrid, R.child AS xchild 70d2283564 2007-11-29 aku: FROM revision R 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.child IS NOT NULL -- Has primary child 70d2283564 2007-11-29 aku: AND R.child IN $theset -- Which is also of interest 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (2) Secondary (branch) children 6559f3231e 2008-02-24 aku: SELECT R.rid AS xrid, B.brid AS xchild 70d2283564 2007-11-29 aku: FROM revision R, revisionbranchchildren B 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.rid = B.rid -- Select subset of branch children 70d2283564 2007-11-29 aku: AND B.brid IN $theset -- Which is also of interest 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (4) Child of trunk root successor of last NTDB on trunk. 6559f3231e 2008-02-24 aku: SELECT R.rid AS xrid, RA.child AS xchild 70d2283564 2007-11-29 aku: FROM revision R, revision RA 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.isdefault -- Restrict to NTDB 70d2283564 2007-11-29 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 70d2283564 2007-11-29 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 70d2283564 2007-11-29 aku: AND RA.child IS NOT NULL -- Has primary child. 70d2283564 2007-11-29 aku: AND RA.child IN $theset -- Which is also of interest 6559f3231e 2008-02-24 aku: }] { 70d2283564 2007-11-29 aku: # Consider moving this to the integrity module. 6559f3231e 2008-02-24 aku: integrity assert {$xrid != $xchild} {Revision $xrid depends on itself.} 6559f3231e 2008-02-24 aku: lappend dependencies($xrid) $xchild 6559f3231e 2008-02-24 aku: set dep($xrid,$xchild) . 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The sql statements above looks only for direct dependencies 70d2283564 2007-11-29 aku: # between revision in the changeset. However due to the 70d2283564 2007-11-29 aku: # vagaries of meta data it is possible for two revisions of 70d2283564 2007-11-29 aku: # the same file to end up in the same changeset, without a 70d2283564 2007-11-29 aku: # direct dependency between them. However we know that there 70d2283564 2007-11-29 aku: # has to be a an indirect dependency, be it through primary 70d2283564 2007-11-29 aku: # children, branch children, or a combination thereof. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # We now fill in these pseudo-dependencies, if no such 70d2283564 2007-11-29 aku: # dependency exists already. The direction of the dependency 70d2283564 2007-11-29 aku: # is actually irrelevant for this. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # NOTE: This is different from cvs2svn. Our spiritual ancestor 70d2283564 2007-11-29 aku: # does not use such pseudo-dependencies, however it uses a 70d2283564 2007-11-29 aku: # COMMIT_THRESHOLD, a time interval commits should fall. This 70d2283564 2007-11-29 aku: # will greatly reduces the risk of getting far separated 70d2283564 2007-11-29 aku: # revisions of the same file into one changeset. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # We allow revisions to be far apart in time in the same fbfb531868 2007-12-02 aku: # changeset, but in turn need the pseudo-dependencies to fbfb531868 2007-12-02 aku: # handle this. fbfb531868 2007-12-02 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {internal [array size dep]} c2ad73ed92 2008-02-21 aku: log write 14 csets {collected [array size dependencies]} c2ad73ed92 2008-02-21 aku: log write 14 csets pseudo-internalsuccessors 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: array set fids {} 6559f3231e 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { 6559f3231e 2008-02-24 aku: SELECT R.rid AS xrid, R.fid AS xfid fbfb531868 2007-12-02 aku: FROM revision R fbfb531868 2007-12-02 aku: WHERE R.rid IN $theset 6559f3231e 2008-02-24 aku: }] { lappend fids($xfid) $xrid } c2ad73ed92 2008-02-21 aku: c2ad73ed92 2008-02-21 aku: set groups {} 70d2283564 2007-11-29 aku: foreach {fid rids} [array get fids] { 70d2283564 2007-11-29 aku: if {[llength $rids] < 2} continue 70d2283564 2007-11-29 aku: foreach a $rids { 70d2283564 2007-11-29 aku: foreach b $rids { 70d2283564 2007-11-29 aku: if {$a == $b} continue 70d2283564 2007-11-29 aku: if {[info exists dep($a,$b)]} continue 70d2283564 2007-11-29 aku: if {[info exists dep($b,$a)]} continue 70d2283564 2007-11-29 aku: lappend dependencies($a) $b 70d2283564 2007-11-29 aku: set dep($a,$b) . 70d2283564 2007-11-29 aku: set dep($b,$a) . 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: } c2ad73ed92 2008-02-21 aku: set n [llength $rids] c2ad73ed92 2008-02-21 aku: lappend groups [list $n [expr {($n*$n-$n)/2}]] 70d2283564 2007-11-29 aku: } 27ed4f7dc3 2008-02-16 aku: c2ad73ed92 2008-02-21 aku: log write 14 csets {pseudo [array size fids] ([lsort -index 0 -decreasing -integer $groups])} c2ad73ed92 2008-02-21 aku: log write 14 csets {internal [array size dep]} c2ad73ed92 2008-02-21 aku: log write 14 csets {collected [array size dependencies]} c2ad73ed92 2008-02-21 aku: log write 14 csets complete 70d2283564 2007-11-29 aku: return 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: # result = 4-list (itemtype itemid nextitemtype nextitemid ...) 00bf8c198e 2007-12-02 aku: typemethod loops {revisions} { 00bf8c198e 2007-12-02 aku: # Note: Tags and branches cannot cause the loop. Their id's, 6809145eb1 2008-01-19 aku: # being of a fundamentally different type than the revisions 00bf8c198e 2007-12-02 aku: # coming in cannot be in the set. 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: set theset ('[join $revisions {','}]') 00bf8c198e 2007-12-02 aku: return [state run [subst -nocommands -nobackslashes { 00bf8c198e 2007-12-02 aku: -- (1) Primary child 00bf8c198e 2007-12-02 aku: SELECT R.rid, R.child 00bf8c198e 2007-12-02 aku: FROM revision R 00bf8c198e 2007-12-02 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 00bf8c198e 2007-12-02 aku: AND R.child IS NOT NULL -- Has primary child 00bf8c198e 2007-12-02 aku: AND R.child IN $theset -- Loop 00bf8c198e 2007-12-02 aku: -- 00bf8c198e 2007-12-02 aku: UNION 00bf8c198e 2007-12-02 aku: -- (2) Secondary (branch) children 00bf8c198e 2007-12-02 aku: SELECT R.rid, B.brid 00bf8c198e 2007-12-02 aku: FROM revision R, revisionbranchchildren B 00bf8c198e 2007-12-02 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 00bf8c198e 2007-12-02 aku: AND R.rid = B.rid -- Select subset of branch children 00bf8c198e 2007-12-02 aku: AND B.rid IN $theset -- Loop 00bf8c198e 2007-12-02 aku: -- 00bf8c198e 2007-12-02 aku: UNION 00bf8c198e 2007-12-02 aku: -- (4) Child of trunk root successor of last NTDB on trunk. 00bf8c198e 2007-12-02 aku: SELECT R.rid, RA.child 00bf8c198e 2007-12-02 aku: FROM revision R, revision RA 00bf8c198e 2007-12-02 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 00bf8c198e 2007-12-02 aku: AND R.isdefault -- Restrict to NTDB 00bf8c198e 2007-12-02 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 00bf8c198e 2007-12-02 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 00bf8c198e 2007-12-02 aku: AND RA.child IS NOT NULL -- Has primary child. 00bf8c198e 2007-12-02 aku: AND RA.child IN $theset -- Loop 00bf8c198e 2007-12-02 aku: }]] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv revisions} { 70d2283564 2007-11-29 aku: upvar 1 $dv dependencies 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # The following cases specify when a revision S is a successor 70d2283564 2007-11-29 aku: # of a revision R. Each of the cases translates into one of 70d2283564 2007-11-29 aku: # the branches of the SQL UNION coming below. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (1) S can be a primary child of R, i.e. in the same LOD. R 70d2283564 2007-11-29 aku: # references S directly. R.child = S(.rid), if it exists. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (2) S can be a secondary, i.e. branch, child of R. Here the 70d2283564 2007-11-29 aku: # link is made through the helper table 70d2283564 2007-11-29 aku: # REVISIONBRANCHCHILDREN. R.rid -> RBC.rid, RBC.brid = 70d2283564 2007-11-29 aku: # S(.rid) 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (3) Originally this use case defined the root of a detached 70d2283564 2007-11-29 aku: # NTDB as the successor of the trunk root. This leads to a 70d2283564 2007-11-29 aku: # bad tangle later on. With a detached NTDB the original 70d2283564 2007-11-29 aku: # trunk root revision was removed as irrelevant, allowing 70d2283564 2007-11-29 aku: # the nominal root to be later in time than the NTDB 70d2283564 2007-11-29 aku: # root. Now setting this dependency will be backward in 70d2283564 2007-11-29 aku: # time. REMOVED. 70d2283564 2007-11-29 aku: # 70d2283564 2007-11-29 aku: # (4) If R is the last of the NTDB revisions which belong to 70d2283564 2007-11-29 aku: # the trunk, then the primary child of the trunk root (the 70d2283564 2007-11-29 aku: # '1.2' revision) is a successor, if it exists. 70d2283564 2007-11-29 aku: 70d2283564 2007-11-29 aku: # Note that the branches spawned from the revisions, and the 70d2283564 2007-11-29 aku: # tags associated with them are successors as well. 70d2283564 2007-11-29 aku: f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { 6809145eb1 2008-01-19 aku: -- (1) Primary child f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, R.child AS xchild 70d2283564 2007-11-29 aku: FROM revision R 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.child IS NOT NULL -- Has primary child 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (2) Secondary (branch) children f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, B.brid AS xchild 70d2283564 2007-11-29 aku: FROM revision R, revisionbranchchildren B 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.rid = B.rid -- Select subset of branch children 70d2283564 2007-11-29 aku: UNION 70d2283564 2007-11-29 aku: -- (4) Child of trunk root successor of last NTDB on trunk. f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, RA.child AS xchild 70d2283564 2007-11-29 aku: FROM revision R, revision RA 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 70d2283564 2007-11-29 aku: AND R.isdefault -- Restrict to NTDB 70d2283564 2007-11-29 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 70d2283564 2007-11-29 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 70d2283564 2007-11-29 aku: AND RA.child IS NOT NULL -- Has primary child. f637d42206 2008-02-24 aku: }] { 70d2283564 2007-11-29 aku: # Consider moving this to the integrity module. f637d42206 2008-02-24 aku: integrity assert {$xrid != $xchild} {Revision $xrid depends on itself.} f637d42206 2008-02-24 aku: lappend dependencies([list rev $xrid]) [list rev $xchild] 70d2283564 2007-11-29 aku: } f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, T.tid AS xchild 70d2283564 2007-11-29 aku: FROM revision R, tag T 6809145eb1 2008-01-19 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 6809145eb1 2008-01-19 aku: AND T.rev = R.rid -- Select tags attached to them f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: lappend dependencies([list rev $xrid]) [list sym::tag $xchild] 70d2283564 2007-11-29 aku: } f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT R.rid AS xrid, B.bid AS xchild 70d2283564 2007-11-29 aku: FROM revision R, branch B 6809145eb1 2008-01-19 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 6809145eb1 2008-01-19 aku: AND B.root = R.rid -- Select branches attached to them f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: lappend dependencies([list rev $xrid]) [list sym::branch $xchild] 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: return 70d2283564 2007-11-29 aku: } 70d2283564 2007-11-29 aku: 9c57055025 2007-12-02 aku: # result = list (changeset-id) 9c57055025 2007-12-02 aku: typemethod cs_successors {revisions} { 9c57055025 2007-12-02 aku: # This is a variant of 'successors' which maps the low-level 9c57055025 2007-12-02 aku: # data directly to the associated changesets. I.e. instead 9c57055025 2007-12-02 aku: # millions of dependency pairs (in extreme cases (Example: Tcl 9c57055025 2007-12-02 aku: # CVS)) we return a very short and much more manageable list 9c57055025 2007-12-02 aku: # of changesets. 9c57055025 2007-12-02 aku: 70d2283564 2007-11-29 aku: set theset ('[join $revisions {','}]') 0ee9711e2e 2007-12-05 aku: return [state run [subst -nocommands -nobackslashes { 6809145eb1 2008-01-19 aku: -- (1) Primary child 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM revision R, csitem CI, changeset C 9c57055025 2007-12-02 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 9c57055025 2007-12-02 aku: AND R.child IS NOT NULL -- Has primary child 6809145eb1 2008-01-19 aku: AND CI.iid = R.child -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the primary child 6809145eb1 2008-01-19 aku: AND C.type = 0 -- which are revision changesets 9c57055025 2007-12-02 aku: UNION 6809145eb1 2008-01-19 aku: -- (2) Secondary (branch) children 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM revision R, revisionbranchchildren B, csitem CI, changeset C 70d2283564 2007-11-29 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 9c57055025 2007-12-02 aku: AND R.rid = B.rid -- Select subset of branch children 6809145eb1 2008-01-19 aku: AND CI.iid = B.brid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the branch 6809145eb1 2008-01-19 aku: AND C.type = 0 -- which are revision changesets 9c57055025 2007-12-02 aku: UNION 6809145eb1 2008-01-19 aku: -- (4) Child of trunk root successor of last NTDB on trunk. 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM revision R, revision RA, csitem CI, changeset C 9c57055025 2007-12-02 aku: WHERE R.rid IN $theset -- Restrict to revisions of interest 9c57055025 2007-12-02 aku: AND R.isdefault -- Restrict to NTDB 9c57055025 2007-12-02 aku: AND R.dbchild IS NOT NULL -- and last NTDB belonging to trunk 9c57055025 2007-12-02 aku: AND RA.rid = R.dbchild -- Go directly to trunk root 9c57055025 2007-12-02 aku: AND RA.child IS NOT NULL -- Has primary child. 6809145eb1 2008-01-19 aku: AND CI.iid = RA.child -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the primary child 6809145eb1 2008-01-19 aku: AND C.type = 0 -- which are revision changesets 9c57055025 2007-12-02 aku: UNION 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM revision R, tag T, csitem CI, changeset C 6809145eb1 2008-01-19 aku: WHERE R.rid in $theset -- Restrict to revisions of interest 6809145eb1 2008-01-19 aku: AND T.rev = R.rid -- Select tags attached to them 6809145eb1 2008-01-19 aku: AND CI.iid = T.tid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the tags 6809145eb1 2008-01-19 aku: AND C.type = 1 -- which are tag changesets 70d2283564 2007-11-29 aku: UNION 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM revision R, branch B, csitem CI, changeset C 6809145eb1 2008-01-19 aku: WHERE R.rid in $theset -- Restrict to revisions of interest 6809145eb1 2008-01-19 aku: AND B.root = R.rid -- Select branches attached to them 6809145eb1 2008-01-19 aku: AND CI.iid = B.bid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the branches 6809145eb1 2008-01-19 aku: AND C.type = 2 -- which are branch changesets 6809145eb1 2008-01-19 aku: }]] 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: # Regarding rev -> branch|tag, we could consider looking at 983090a343 2008-03-05 aku: # the symbol of the branch|tag, its lod-symbol, and the 983090a343 2008-03-05 aku: # revisions on that lod, but don't. Because it is not exact 983090a343 2008-03-05 aku: # enough, the branch|tag would depend on revisions coming 983090a343 2008-03-05 aku: # after its creation on the parental lod. 0d13da3018 2008-02-06 aku: } 0d13da3018 2008-02-06 aku: 0d13da3018 2008-02-06 aku: # result = symbol name 983090a343 2008-03-05 aku: typemethod cs_lod {metaid revisions} { 0d13da3018 2008-02-06 aku: # Determines the name of the symbol which is the line of 983090a343 2008-03-05 aku: # development for the revisions in a changeset. The 983090a343 2008-03-05 aku: # information in the meta data referenced by the source metaid 983090a343 2008-03-05 aku: # is out of date by the time we come here (since pass 983090a343 2008-03-05 aku: # FilterSymbols), so it cannot be used. See the method 'run' 983090a343 2008-03-05 aku: # in file "c2f_pfiltersym.tcl" for more commentary on this. 0d13da3018 2008-02-06 aku: 0d13da3018 2008-02-06 aku: set theset ('[join $revisions {','}]') 0d13da3018 2008-02-06 aku: return [state run [subst -nocommands -nobackslashes { 0d13da3018 2008-02-06 aku: SELECT 0d13da3018 2008-02-06 aku: DISTINCT L.name 0d13da3018 2008-02-06 aku: FROM revision R, symbol L 0d13da3018 2008-02-06 aku: WHERE R.rid in $theset -- Restrict to revisions of interest 0d13da3018 2008-02-06 aku: AND L.sid = R.lod -- Get lod symbol of revision 0ee9711e2e 2007-12-05 aku: }]] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for tag symbol changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::sym::tag { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 0 } 27b15b7095 2007-11-29 aku: b42cff97e3 2007-11-30 aku: typemethod str {tag} { b42cff97e3 2007-11-30 aku: struct::list assign [state run { b42cff97e3 2007-11-30 aku: SELECT S.name, F.name, P.name b42cff97e3 2007-11-30 aku: FROM tag T, symbol S, file F, project P 6809145eb1 2008-01-19 aku: WHERE T.tid = $tag -- Find specified tag 6809145eb1 2008-01-19 aku: AND F.fid = T.fid -- Get file of tag 6809145eb1 2008-01-19 aku: AND P.pid = F.pid -- Get project of file 6809145eb1 2008-01-19 aku: AND S.sid = T.sid -- Get symbol of tag b42cff97e3 2007-11-30 aku: }] sname fname pname b42cff97e3 2007-11-30 aku: return "$pname/T'${sname}'::$fname" b42cff97e3 2007-11-30 aku: } b42cff97e3 2007-11-30 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {tags} { b1666f8ff4 2007-11-29 aku: # The range is defined as the range of the revisions the tags b1666f8ff4 2007-11-29 aku: # are attached to. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $tags {','}]') 0ee9711e2e 2007-12-05 aku: return [state run [subst -nocommands -nobackslashes { b1666f8ff4 2007-11-29 aku: SELECT MIN(R.date), MAX(R.date) fbfb531868 2007-12-02 aku: FROM tag T, revision R 6809145eb1 2008-01-19 aku: WHERE T.tid IN $theset -- Restrict to tags of interest 6809145eb1 2008-01-19 aku: AND R.rid = T.rev -- Select tag parent revisions 0ee9711e2e 2007-12-05 aku: }]] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv tags} { b1666f8ff4 2007-11-29 aku: # Tags have no successors. b1666f8ff4 2007-11-29 aku: return b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: 00bf8c198e 2007-12-02 aku: # result = 4-list (itemtype itemid nextitemtype nextitemid ...) 00bf8c198e 2007-12-02 aku: typemethod loops {tags} { 00bf8c198e 2007-12-02 aku: # Tags have no successors, therefore cannot cause loops 00bf8c198e 2007-12-02 aku: return {} 9c57055025 2007-12-02 aku: } 9c57055025 2007-12-02 aku: 9c57055025 2007-12-02 aku: # result = list (changeset-id) 9c57055025 2007-12-02 aku: typemethod cs_successors {tags} { 9c57055025 2007-12-02 aku: # Tags have no successors. b1666f8ff4 2007-11-29 aku: return 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 0d13da3018 2008-02-06 aku: # result = symbol name 983090a343 2008-03-05 aku: typemethod cs_lod {sid tags} { 0d13da3018 2008-02-06 aku: # Determines the name of the symbol which is the line of 983090a343 2008-03-05 aku: # development for the tags in a changeset. Comes directly from 983090a343 2008-03-05 aku: # the symbol which is the changeset's source and its prefered 983090a343 2008-03-05 aku: # parent. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: return [state run { 983090a343 2008-03-05 aku: SELECT P.name 983090a343 2008-03-05 aku: FROM preferedparent SP, symbol P 983090a343 2008-03-05 aku: WHERE SP.sid = $sid 983090a343 2008-03-05 aku: AND P.sid = SP.pid 983090a343 2008-03-05 aku: }] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## Helper singleton. Commands for branch symbol changesets. 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: snit::type ::vc::fossil::import::cvs::project::rev::sym::branch { 27b15b7095 2007-11-29 aku: typemethod byrevision {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod bysymbol {} { return 1 } 27b15b7095 2007-11-29 aku: typemethod istag {} { return 0 } 27b15b7095 2007-11-29 aku: typemethod isbranch {} { return 1 } 27b15b7095 2007-11-29 aku: b42cff97e3 2007-11-30 aku: typemethod str {branch} { b42cff97e3 2007-11-30 aku: struct::list assign [state run { b42cff97e3 2007-11-30 aku: SELECT S.name, F.name, P.name b42cff97e3 2007-11-30 aku: FROM branch B, symbol S, file F, project P 6809145eb1 2008-01-19 aku: WHERE B.bid = $branch -- Find specified branch 6809145eb1 2008-01-19 aku: AND F.fid = B.fid -- Get file of branch 6809145eb1 2008-01-19 aku: AND P.pid = F.pid -- Get project of file 6809145eb1 2008-01-19 aku: AND S.sid = B.sid -- Get symbol of branch b42cff97e3 2007-11-30 aku: }] sname fname pname b42cff97e3 2007-11-30 aku: return "$pname/B'${sname}'::$fname" b42cff97e3 2007-11-30 aku: } b42cff97e3 2007-11-30 aku: 27b15b7095 2007-11-29 aku: # result = list (mintime, maxtime) 27b15b7095 2007-11-29 aku: typemethod timerange {branches} { b1666f8ff4 2007-11-29 aku: # The range of a branch is defined as the range of the b1666f8ff4 2007-11-29 aku: # revisions the branches are spawned by. NOTE however that the b1666f8ff4 2007-11-29 aku: # branches associated with a detached NTDB will have no root b1666f8ff4 2007-11-29 aku: # spawning them, hence they have no real timerange any b1666f8ff4 2007-11-29 aku: # longer. By using 0 we put them in front of everything else, b1666f8ff4 2007-11-29 aku: # as they logically are. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $branches {','}]') 0ee9711e2e 2007-12-05 aku: return [state run [subst -nocommands -nobackslashes { b1666f8ff4 2007-11-29 aku: SELECT IFNULL(MIN(R.date),0), IFNULL(MAX(R.date),0) fbfb531868 2007-12-02 aku: FROM branch B, revision R 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND R.rid = B.root -- Select branch parent revisions 0ee9711e2e 2007-12-05 aku: }]] 00bf8c198e 2007-12-02 aku: } 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: # result = 4-list (itemtype itemid nextitemtype nextitemid ...) 00bf8c198e 2007-12-02 aku: typemethod loops {branches} { 00bf8c198e 2007-12-02 aku: # Note: Revisions and tags cannot cause the loop. Being of a 00bf8c198e 2007-12-02 aku: # fundamentally different type they cannot be in the incoming 00bf8c198e 2007-12-02 aku: # set of ids. 00bf8c198e 2007-12-02 aku: 00bf8c198e 2007-12-02 aku: set theset ('[join $branches {','}]') 00bf8c198e 2007-12-02 aku: return [state run [subst -nocommands -nobackslashes { 00bf8c198e 2007-12-02 aku: SELECT B.bid, BX.bid 00bf8c198e 2007-12-02 aku: FROM branch B, preferedparent P, branch BX 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.sid = P.pid -- Get the prefered branches via 6809145eb1 2008-01-19 aku: AND BX.sid = P.sid -- the branch symbols 6809145eb1 2008-01-19 aku: AND BX.bid IN $theset -- Loop 00bf8c198e 2007-12-02 aku: }]] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # var(dv) = dict (item -> list (item)), item = list (type id) 27b15b7095 2007-11-29 aku: typemethod successors {dv branches} { 712010580a 2007-12-02 aku: upvar 1 $dv dependencies b1666f8ff4 2007-11-29 aku: # The first revision committed on a branch, and all branches b1666f8ff4 2007-11-29 aku: # and tags which have it as their prefered parent are the b1666f8ff4 2007-11-29 aku: # successors of a branch. b1666f8ff4 2007-11-29 aku: b1666f8ff4 2007-11-29 aku: set theset ('[join $branches {','}]') f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT B.bid AS xbid, R.rid AS xchild fbfb531868 2007-12-02 aku: FROM branch B, revision R 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.first = R.rid -- Get first revision on the branch f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: lappend dependencies([list sym::branch $xbid]) [list rev $xchild] b1666f8ff4 2007-11-29 aku: } f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT B.bid AS xbid, BX.bid AS xchild fbfb531868 2007-12-02 aku: FROM branch B, preferedparent P, branch BX 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.sid = P.pid -- Get subordinate branches via the 6809145eb1 2008-01-19 aku: AND BX.sid = P.sid -- prefered parents of their symbols f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: lappend dependencies([list sym::branch $xbid]) [list sym::branch $xchild] b1666f8ff4 2007-11-29 aku: } f637d42206 2008-02-24 aku: state foreachrow [subst -nocommands -nobackslashes { f637d42206 2008-02-24 aku: SELECT B.bid AS xbid, T.tid AS xchild fbfb531868 2007-12-02 aku: FROM branch B, preferedparent P, tag T 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.sid = P.pid -- Get subordinate tags via the 6809145eb1 2008-01-19 aku: AND T.sid = P.sid -- prefered parents of their symbols f637d42206 2008-02-24 aku: }] { f637d42206 2008-02-24 aku: lappend dependencies([list sym::branch $xbid]) [list sym::tag $xchild] b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: return b1666f8ff4 2007-11-29 aku: } b1666f8ff4 2007-11-29 aku: 9c57055025 2007-12-02 aku: # result = list (changeset-id) 9c57055025 2007-12-02 aku: typemethod cs_successors {branches} { 9c57055025 2007-12-02 aku: # This is a variant of 'successors' which maps the low-level 9c57055025 2007-12-02 aku: # data directly to the associated changesets. I.e. instead 9c57055025 2007-12-02 aku: # millions of dependency pairs (in extreme cases (Example: Tcl 9c57055025 2007-12-02 aku: # CVS)) we return a very short and much more manageable list 9c57055025 2007-12-02 aku: # of changesets. 9c57055025 2007-12-02 aku: 9c57055025 2007-12-02 aku: set theset ('[join $branches {','}]') 0ee9711e2e 2007-12-05 aku: return [state run [subst -nocommands -nobackslashes { 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM branch B, revision R, csitem CI, changeset C 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.first = R.rid -- Get first revision on the branch 6809145eb1 2008-01-19 aku: AND CI.iid = R.rid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing this revision 6809145eb1 2008-01-19 aku: AND C.type = 0 -- which are revision changesets 9c57055025 2007-12-02 aku: UNION 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM branch B, preferedparent P, branch BX, csitem CI, changeset C 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.sid = P.pid -- Get subordinate branches via the 6809145eb1 2008-01-19 aku: AND BX.sid = P.sid -- prefered parents of their symbols 6809145eb1 2008-01-19 aku: AND CI.iid = BX.bid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the subordinate branches 6809145eb1 2008-01-19 aku: AND C.type = 2 -- which are branch changesets 9c57055025 2007-12-02 aku: UNION 9c57055025 2007-12-02 aku: SELECT C.cid 9c57055025 2007-12-02 aku: FROM branch B, preferedparent P, tag T, csitem CI, changeset C 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.sid = P.pid -- Get subordinate tags via the 6809145eb1 2008-01-19 aku: AND T.sid = P.sid -- prefered parents of their symbols 6809145eb1 2008-01-19 aku: AND CI.iid = T.tid -- Select all changesets 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- containing the subordinate tags 6809145eb1 2008-01-19 aku: AND C.type = 1 -- which are tag changesets 0ee9711e2e 2007-12-05 aku: }]] b1666f8ff4 2007-11-29 aku: return 0d13da3018 2008-02-06 aku: } 0d13da3018 2008-02-06 aku: 0d13da3018 2008-02-06 aku: # result = symbol name 983090a343 2008-03-05 aku: typemethod cs_lod {sid branches} { 0d13da3018 2008-02-06 aku: # Determines the name of the symbol which is the line of 983090a343 2008-03-05 aku: # development for the branches in a changeset. Comes directly 983090a343 2008-03-05 aku: # from the symbol which is the changeset's source and its 983090a343 2008-03-05 aku: # prefered parent. 983090a343 2008-03-05 aku: 983090a343 2008-03-05 aku: return [state run { 983090a343 2008-03-05 aku: SELECT P.name 983090a343 2008-03-05 aku: FROM preferedparent SP, symbol P 983090a343 2008-03-05 aku: WHERE SP.sid = $sid 983090a343 2008-03-05 aku: AND P.sid = SP.pid 983090a343 2008-03-05 aku: }] 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: 711e000206 2007-12-04 aku: typemethod limits {branches} { 711e000206 2007-12-04 aku: # Notes. This method exists only for branches. It is needed to 711e000206 2007-12-04 aku: # get detailed information about a backward branch. It does 711e000206 2007-12-04 aku: # not apply to tags, nor revisions. The queries can also 711e000206 2007-12-04 aku: # restrict themselves to the revision sucessors/predecessors 711e000206 2007-12-04 aku: # of branches, as only they have ordering data and thus can 711e000206 2007-12-04 aku: # cause the backwardness. 711e000206 2007-12-04 aku: 711e000206 2007-12-04 aku: set theset ('[join $branches {','}]') 711e000206 2007-12-04 aku: 711e000206 2007-12-04 aku: set maxp [state run [subst -nocommands -nobackslashes { 711e000206 2007-12-04 aku: -- maximal predecessor position per branch 711e000206 2007-12-04 aku: SELECT B.bid, MAX (CO.pos) 711e000206 2007-12-04 aku: FROM branch B, revision R, csitem CI, changeset C, csorder CO 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.root = R.rid -- Get branch root revisions 6809145eb1 2008-01-19 aku: AND CI.iid = R.rid -- Get changesets containing the 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- root revisions, which are 6809145eb1 2008-01-19 aku: AND C.type = 0 -- revision changesets 6809145eb1 2008-01-19 aku: AND CO.cid = C.cid -- Get their topological ordering 711e000206 2007-12-04 aku: GROUP BY B.bid 711e000206 2007-12-04 aku: }]] 711e000206 2007-12-04 aku: 711e000206 2007-12-04 aku: set mins [state run [subst -nocommands -nobackslashes { 711e000206 2007-12-04 aku: -- minimal successor position per branch 711e000206 2007-12-04 aku: SELECT B.bid, MIN (CO.pos) 711e000206 2007-12-04 aku: FROM branch B, revision R, csitem CI, changeset C, csorder CO 6809145eb1 2008-01-19 aku: WHERE B.bid IN $theset -- Restrict to branches of interest 6809145eb1 2008-01-19 aku: AND B.first = R.rid -- Get the first revisions on the branches 6809145eb1 2008-01-19 aku: AND CI.iid = R.rid -- Get changesets containing the 6809145eb1 2008-01-19 aku: AND C.cid = CI.cid -- first revisions, which are 6809145eb1 2008-01-19 aku: AND C.type = 0 -- revision changesets 6809145eb1 2008-01-19 aku: AND CO.cid = C.cid -- Get their topological ordering 711e000206 2007-12-04 aku: GROUP BY B.bid 711e000206 2007-12-04 aku: }]] 711e000206 2007-12-04 aku: 711e000206 2007-12-04 aku: return [list $maxp $mins] 27b15b7095 2007-11-29 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# 27b15b7095 2007-11-29 aku: ## Configuration 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: pragma -hasinstances no ; # singleton 27b15b7095 2007-11-29 aku: pragma -hastypeinfo no ; # no introspection 27b15b7095 2007-11-29 aku: pragma -hastypedestroy no ; # immortal 84de38d73f 2007-10-10 aku: } 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # # ## ### ##### ######## ############# ##################### 27b15b7095 2007-11-29 aku: ## 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: namespace eval ::vc::fossil::import::cvs::project { 84de38d73f 2007-10-10 aku: namespace export rev 5f7acef887 2007-11-10 aku: namespace eval rev { 5f7acef887 2007-11-10 aku: namespace import ::vc::fossil::import::cvs::state 47d52d1efd 2007-11-28 aku: namespace import ::vc::fossil::import::cvs::integrity 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::misc::* 08ebab80cd 2007-11-10 aku: namespace import ::vc::tools::trouble 95af789e1f 2007-11-10 aku: namespace import ::vc::tools::log 95af789e1f 2007-11-10 aku: log register csets 27b15b7095 2007-11-29 aku: 27b15b7095 2007-11-29 aku: # Set up the helper singletons 27b15b7095 2007-11-29 aku: namespace eval rev { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27ed4f7dc3 2008-02-16 aku: namespace import ::vc::tools::log 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: namespace eval sym::tag { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27ed4f7dc3 2008-02-16 aku: namespace import ::vc::tools::log 27b15b7095 2007-11-29 aku: } 27b15b7095 2007-11-29 aku: namespace eval sym::branch { 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::state 27b15b7095 2007-11-29 aku: namespace import ::vc::fossil::import::cvs::integrity 27ed4f7dc3 2008-02-16 aku: namespace import ::vc::tools::log 27b15b7095 2007-11-29 aku: } 5f7acef887 2007-11-10 aku: } 84de38d73f 2007-10-10 aku: } 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: # # ## ### ##### ######## ############# ##################### 84de38d73f 2007-10-10 aku: ## Ready 84de38d73f 2007-10-10 aku: 84de38d73f 2007-10-10 aku: package provide vc::fossil::import::cvs::project::rev 1.0 84de38d73f 2007-10-10 aku: return
File Annotation