64d0019e0f 2007-11-23 aku: #!/bin/sh 64d0019e0f 2007-11-23 aku: ## -*- tcl -*- \ 64d0019e0f 2007-11-23 aku: exec tclsh "$0" ${1+"$@"} 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # # ## ### ##### ######## ############# ##################### 64d0019e0f 2007-11-23 aku: ## Copyright (c) 2007 Andreas Kupries. 64d0019e0f 2007-11-23 aku: # 64d0019e0f 2007-11-23 aku: # This software is licensed as described in the file LICENSE, which 64d0019e0f 2007-11-23 aku: # you should have received as part of this distribution. 64d0019e0f 2007-11-23 aku: # 64d0019e0f 2007-11-23 aku: # This software consists of voluntary contributions made by many 64d0019e0f 2007-11-23 aku: # individuals. For exact contribution history, see the revision 64d0019e0f 2007-11-23 aku: # history and logs, available at http://fossil-scm.hwaci.com/fossil 64d0019e0f 2007-11-23 aku: # # ## ### ##### ######## ############# ##################### 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: ## Helper application, debugging of cvs2fossil. This application 64d0019e0f 2007-11-23 aku: ## extracts the tree of revisions for a file of interest, specified 64d0019e0f 2007-11-23 aku: ## either directly through its id, or indirectly through the id of a 64d0019e0f 2007-11-23 aku: ## revision it contains, and generates a nice graphical representation 64d0019e0f 2007-11-23 aku: ## of it (png image). It uses GraphiViz's 'dot' tool to do all the 64d0019e0f 2007-11-23 aku: ## layouting. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # # ## ### ##### ######## ############# ##################### 64d0019e0f 2007-11-23 aku: ## Requirements, extended package management for local packages. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: lappend auto_path [file join [file dirname [info script]] lib] 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: package require Tcl 8.4 ; # Required runtime. 64d0019e0f 2007-11-23 aku: package require struct::graph ; # Graph handling. 64d0019e0f 2007-11-23 aku: package require struct::list ; # Higher order list ops. 64d0019e0f 2007-11-23 aku: package require vc::fossil::import::cvs::project::rev ; # Changesets 64d0019e0f 2007-11-23 aku: package require vc::fossil::import::cvs::state ; # State storage. 64d0019e0f 2007-11-23 aku: package require vc::tools::misc ; # Min/max. 64d0019e0f 2007-11-23 aku: package require vc::tools::dot ; # Graph export to DOT. 124fef5b1c 2007-11-25 aku: package require vc::tools::trouble ; # Error reporting 124fef5b1c 2007-11-25 aku: package require vc::tools::log ; # User feedback 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: namespace import ::vc::fossil::import::cvs::state 64d0019e0f 2007-11-23 aku: namespace import ::vc::fossil::import::cvs::project::rev 64d0019e0f 2007-11-23 aku: namespace import ::vc::tools::dot 124fef5b1c 2007-11-25 aku: namespace import ::vc::tools::trouble 124fef5b1c 2007-11-25 aku: namespace import ::vc::tools::log 64d0019e0f 2007-11-23 aku: namespace import ::vc::tools::misc::* 124fef5b1c 2007-11-25 aku: 124fef5b1c 2007-11-25 aku: log verbosity 0 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Process the command line, i.e. get the database to access, and file 64d0019e0f 2007-11-23 aku: # of interest. The latter can be specified by name, id, or indirectly 64d0019e0f 2007-11-23 aku: # through the id of one of the revisions it contains. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: state use [lindex $argv 0] 64d0019e0f 2007-11-23 aku: state reading project 64d0019e0f 2007-11-23 aku: state reading file 64d0019e0f 2007-11-23 aku: state reading revision 64d0019e0f 2007-11-23 aku: state reading revisionbranchchildren 64d0019e0f 2007-11-23 aku: state reading changeset fc635d5977 2007-11-30 aku: state reading csitem 64d0019e0f 2007-11-23 aku: state reading csorder 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: set what [lindex $argv 1] 64d0019e0f 2007-11-23 aku: set centralrid -1 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: switch -exact -- $what { 64d0019e0f 2007-11-23 aku: rid { 64d0019e0f 2007-11-23 aku: # Get the revision of interest, identified by the internal 64d0019e0f 2007-11-23 aku: # numeric id used by cvs2fossil. 64d0019e0f 2007-11-23 aku: set centralrid [lindex $argv 2] 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: puts "Revision : [state one { SELECT rev FROM revision WHERE rid = $centralrid }] ($centralrid)" 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Map it to the file containing the revision of interest. 64d0019e0f 2007-11-23 aku: set fid [state one { SELECT fid FROM revision WHERE rid = $centralrid }] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: fid { 64d0019e0f 2007-11-23 aku: # Get the file of interest, identified by internal numeric id 64d0019e0f 2007-11-23 aku: # used by cvs2fossil. 64d0019e0f 2007-11-23 aku: set fid [lindex $argv 2] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: fname { 64d0019e0f 2007-11-23 aku: # Get the file of interest, identified by its name. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: set fname [lindex $argv 2] 64d0019e0f 2007-11-23 aku: set fid [state one { SELECT fid FROM file WHERE name == $fname }] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: default { 64d0019e0f 2007-11-23 aku: trouble fatal \ 64d0019e0f 2007-11-23 aku: "Unknown spec \"$what\", expected one of \"fid\", \"fname\", or \"rid\"" 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: } 124fef5b1c 2007-11-25 aku: trouble abort? 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: set pid [state one { SELECT pid FROM file WHERE fid == $fid }] 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: puts "File : [state one { SELECT name FROM file WHERE fid = $fid }] ($fid)" 64d0019e0f 2007-11-23 aku: puts "Project : [state one { SELECT name FROM project WHERE pid = $pid }] ($pid)" 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Get the data of all revisions in the file of interest, as a list for 64d0019e0f 2007-11-23 aku: # iteration, and as array for random access of neighbouring revisions. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: array set rev {} 64d0019e0f 2007-11-23 aku: foreach {rid revnr lod date isdefault} [set revisions [state run { 64d0019e0f 2007-11-23 aku: SELECT R.rid, R.rev, S.name, R.date, R.isdefault 64d0019e0f 2007-11-23 aku: FROM revision R, symbol S 64d0019e0f 2007-11-23 aku: WHERE R.fid = $fid 64d0019e0f 2007-11-23 aku: AND R.lod = S.sid 64d0019e0f 2007-11-23 aku: }]] { 64d0019e0f 2007-11-23 aku: set cs [state run { 64d0019e0f 2007-11-23 aku: SELECT CR.cid, CO.pos, CT.name fc635d5977 2007-11-30 aku: FROM csitem CR, csorder CO, cstype CT, changeset C fc635d5977 2007-11-30 aku: WHERE CR.iid = $rid 64d0019e0f 2007-11-23 aku: AND CR.cid = CO.cid 64d0019e0f 2007-11-23 aku: AND CR.cid = C.cid 64d0019e0f 2007-11-23 aku: AND CT.tid = C.type 64d0019e0f 2007-11-23 aku: }] 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: set rev($rid) [list $revnr $lod $date $isdefault $cs] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: puts "#Revs : [array size rev]" 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Start the graph 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: struct::graph dg 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Convert the revisions into nodes of the graph, and use node 64d0019e0f 2007-11-23 aku: # attributes to highlight various pieces of interest for the dot 64d0019e0f 2007-11-23 aku: # conversion. Label => Revnr, Symbol (LOD), Changeset id (if 64d0019e0f 2007-11-23 aku: # available), formatted date. Background fill colors to show the 64d0019e0f 2007-11-23 aku: # different branches ?. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: foreach {rid revnr lod date isdefault} $revisions { 64d0019e0f 2007-11-23 aku: set label "$rid = <$revnr> @ $lod / [clock format $date]" 64d0019e0f 2007-11-23 aku: set cs [lindex $rev($rid) 4] 64d0019e0f 2007-11-23 aku: if {[llength $cs]} { 64d0019e0f 2007-11-23 aku: foreach {cs ord cstype} $cs { 64d0019e0f 2007-11-23 aku: append label "\\nCS/${cstype}($cs) @$ord" 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: } 5bbc7d4c57 2007-12-01 aku: set key [list rev $rid] 5bbc7d4c57 2007-12-01 aku: dg node insert $key 5bbc7d4c57 2007-12-01 aku: dg node set $key label $label 5bbc7d4c57 2007-12-01 aku: dg node set $key shape [expr {$isdefault ? "diamond" : "box"}] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Go through the revisions a second time and set up the arcs based on 64d0019e0f 2007-11-23 aku: # the stored successor information. 64d0019e0f 2007-11-23 aku: 5bbc7d4c57 2007-12-01 aku: ::vc::fossil::import::cvs::project::rev::rev successors dep [array names rev] 64d0019e0f 2007-11-23 aku: 5bbc7d4c57 2007-12-01 aku: proc Ord {cmd rid} {return 0 64d0019e0f 2007-11-23 aku: global rev 64d0019e0f 2007-11-23 aku: set ords {} 64d0019e0f 2007-11-23 aku: foreach {cs ord cstype} [lindex $rev($rid) 4] { lappend ords $ord } 64d0019e0f 2007-11-23 aku: return [$cmd $ords] 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: foreach {rid children} [array get dep] { 64d0019e0f 2007-11-23 aku: set max [Ord max $rid] 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: foreach child $children { 5bbc7d4c57 2007-12-01 aku: if {[catch { 5bbc7d4c57 2007-12-01 aku: set a [dg arc insert $rid $child] 5bbc7d4c57 2007-12-01 aku: }]} continue 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: if {$max > [Ord min $child]} { 64d0019e0f 2007-11-23 aku: puts "Backward : $rid -> $child" 64d0019e0f 2007-11-23 aku: dg arc set $a color red 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: } 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: # Convert the graph to dot, then run the layouter and convert to png, 64d0019e0f 2007-11-23 aku: # at last show the image. 64d0019e0f 2007-11-23 aku: 64d0019e0f 2007-11-23 aku: vc::tools::dot layout png dg SymbolTree st.png 64d0019e0f 2007-11-23 aku: exec display st.png 64d0019e0f 2007-11-23 aku: file delete st.png 64d0019e0f 2007-11-23 aku: exit
File Annotation