Fossil SCM

fossil-scm / tools / cvs2fossil / filerevtree
Source Blame History 178 lines
64d0019… aku 1 #!/bin/sh
64d0019… aku 2 ## -*- tcl -*- \
64d0019… aku 3 exec tclsh "$0" ${1+"$@"}
64d0019… aku 4
64d0019… aku 5 # # ## ### ##### ######## ############# #####################
64d0019… aku 6 ## Copyright (c) 2007 Andreas Kupries.
64d0019… aku 7 #
64d0019… aku 8 # This software is licensed as described in the file LICENSE, which
64d0019… aku 9 # you should have received as part of this distribution.
64d0019… aku 10 #
64d0019… aku 11 # This software consists of voluntary contributions made by many
64d0019… aku 12 # individuals. For exact contribution history, see the revision
64d0019… aku 13 # history and logs, available at http://fossil-scm.hwaci.com/fossil
64d0019… aku 14 # # ## ### ##### ######## ############# #####################
64d0019… aku 15
64d0019… aku 16 ## Helper application, debugging of cvs2fossil. This application
64d0019… aku 17 ## extracts the tree of revisions for a file of interest, specified
64d0019… aku 18 ## either directly through its id, or indirectly through the id of a
64d0019… aku 19 ## revision it contains, and generates a nice graphical representation
64d0019… aku 20 ## of it (png image). It uses GraphiViz's 'dot' tool to do all the
64d0019… aku 21 ## layouting.
64d0019… aku 22
64d0019… aku 23 # # ## ### ##### ######## ############# #####################
64d0019… aku 24 ## Requirements, extended package management for local packages.
64d0019… aku 25
64d0019… aku 26 lappend auto_path [file join [file dirname [info script]] lib]
64d0019… aku 27
64d0019… aku 28 package require Tcl 8.4 ; # Required runtime.
64d0019… aku 29 package require struct::graph ; # Graph handling.
64d0019… aku 30 package require struct::list ; # Higher order list ops.
64d0019… aku 31 package require vc::fossil::import::cvs::project::rev ; # Changesets
64d0019… aku 32 package require vc::fossil::import::cvs::state ; # State storage.
64d0019… aku 33 package require vc::tools::misc ; # Min/max.
64d0019… aku 34 package require vc::tools::dot ; # Graph export to DOT.
124fef5… aku 35 package require vc::tools::trouble ; # Error reporting
124fef5… aku 36 package require vc::tools::log ; # User feedback
64d0019… aku 37
64d0019… aku 38 namespace import ::vc::fossil::import::cvs::state
64d0019… aku 39 namespace import ::vc::fossil::import::cvs::project::rev
64d0019… aku 40 namespace import ::vc::tools::dot
124fef5… aku 41 namespace import ::vc::tools::trouble
124fef5… aku 42 namespace import ::vc::tools::log
64d0019… aku 43 namespace import ::vc::tools::misc::*
124fef5… aku 44
124fef5… aku 45 log verbosity 0
64d0019… aku 46
64d0019… aku 47 # Process the command line, i.e. get the database to access, and file
64d0019… aku 48 # of interest. The latter can be specified by name, id, or indirectly
64d0019… aku 49 # through the id of one of the revisions it contains.
64d0019… aku 50
64d0019… aku 51 state use [lindex $argv 0]
64d0019… aku 52 state reading project
64d0019… aku 53 state reading file
64d0019… aku 54 state reading revision
64d0019… aku 55 state reading revisionbranchchildren
64d0019… aku 56 state reading changeset
fc635d5… aku 57 state reading csitem
64d0019… aku 58 state reading csorder
64d0019… aku 59
64d0019… aku 60 set what [lindex $argv 1]
64d0019… aku 61 set centralrid -1
64d0019… aku 62
64d0019… aku 63 switch -exact -- $what {
64d0019… aku 64 rid {
64d0019… aku 65 # Get the revision of interest, identified by the internal
64d0019… aku 66 # numeric id used by cvs2fossil.
64d0019… aku 67 set centralrid [lindex $argv 2]
64d0019… aku 68
64d0019… aku 69 puts "Revision : [state one { SELECT rev FROM revision WHERE rid = $centralrid }] ($centralrid)"
64d0019… aku 70
64d0019… aku 71 # Map it to the file containing the revision of interest.
64d0019… aku 72 set fid [state one { SELECT fid FROM revision WHERE rid = $centralrid }]
64d0019… aku 73 }
64d0019… aku 74 fid {
64d0019… aku 75 # Get the file of interest, identified by internal numeric id
64d0019… aku 76 # used by cvs2fossil.
64d0019… aku 77 set fid [lindex $argv 2]
64d0019… aku 78 }
64d0019… aku 79 fname {
64d0019… aku 80 # Get the file of interest, identified by its name.
64d0019… aku 81
64d0019… aku 82 set fname [lindex $argv 2]
64d0019… aku 83 set fid [state one { SELECT fid FROM file WHERE name == $fname }]
64d0019… aku 84 }
64d0019… aku 85 default {
64d0019… aku 86 trouble fatal \
64d0019… aku 87 "Unknown spec \"$what\", expected one of \"fid\", \"fname\", or \"rid\""
64d0019… aku 88 }
64d0019… aku 89 }
124fef5… aku 90 trouble abort?
64d0019… aku 91
64d0019… aku 92 set pid [state one { SELECT pid FROM file WHERE fid == $fid }]
64d0019… aku 93
64d0019… aku 94 puts "File : [state one { SELECT name FROM file WHERE fid = $fid }] ($fid)"
64d0019… aku 95 puts "Project : [state one { SELECT name FROM project WHERE pid = $pid }] ($pid)"
64d0019… aku 96
64d0019… aku 97 # Get the data of all revisions in the file of interest, as a list for
64d0019… aku 98 # iteration, and as array for random access of neighbouring revisions.
64d0019… aku 99
64d0019… aku 100 array set rev {}
64d0019… aku 101 foreach {rid revnr lod date isdefault} [set revisions [state run {
64d0019… aku 102 SELECT R.rid, R.rev, S.name, R.date, R.isdefault
64d0019… aku 103 FROM revision R, symbol S
64d0019… aku 104 WHERE R.fid = $fid
64d0019… aku 105 AND R.lod = S.sid
64d0019… aku 106 }]] {
64d0019… aku 107 set cs [state run {
64d0019… aku 108 SELECT CR.cid, CO.pos, CT.name
fc635d5… aku 109 FROM csitem CR, csorder CO, cstype CT, changeset C
fc635d5… aku 110 WHERE CR.iid = $rid
64d0019… aku 111 AND CR.cid = CO.cid
64d0019… aku 112 AND CR.cid = C.cid
64d0019… aku 113 AND CT.tid = C.type
64d0019… aku 114 }]
64d0019… aku 115
64d0019… aku 116 set rev($rid) [list $revnr $lod $date $isdefault $cs]
64d0019… aku 117 }
64d0019… aku 118
64d0019… aku 119 puts "#Revs : [array size rev]"
64d0019… aku 120
64d0019… aku 121 # Start the graph
64d0019… aku 122
64d0019… aku 123 struct::graph dg
64d0019… aku 124
64d0019… aku 125 # Convert the revisions into nodes of the graph, and use node
64d0019… aku 126 # attributes to highlight various pieces of interest for the dot
64d0019… aku 127 # conversion. Label => Revnr, Symbol (LOD), Changeset id (if
64d0019… aku 128 # available), formatted date. Background fill colors to show the
64d0019… aku 129 # different branches ?.
64d0019… aku 130
64d0019… aku 131 foreach {rid revnr lod date isdefault} $revisions {
64d0019… aku 132 set label "$rid = <$revnr> @ $lod / [clock format $date]"
64d0019… aku 133 set cs [lindex $rev($rid) 4]
64d0019… aku 134 if {[llength $cs]} {
64d0019… aku 135 foreach {cs ord cstype} $cs {
64d0019… aku 136 append label "\\nCS/${cstype}($cs) @$ord"
64d0019… aku 137 }
64d0019… aku 138 }
5bbc7d4… aku 139 set key [list rev $rid]
5bbc7d4… aku 140 dg node insert $key
5bbc7d4… aku 141 dg node set $key label $label
5bbc7d4… aku 142 dg node set $key shape [expr {$isdefault ? "diamond" : "box"}]
64d0019… aku 143 }
64d0019… aku 144
64d0019… aku 145 # Go through the revisions a second time and set up the arcs based on
64d0019… aku 146 # the stored successor information.
64d0019… aku 147
5bbc7d4… aku 148 ::vc::fossil::import::cvs::project::rev::rev successors dep [array names rev]
64d0019… aku 149
5bbc7d4… aku 150 proc Ord {cmd rid} {return 0
64d0019… aku 151 global rev
64d0019… aku 152 set ords {}
64d0019… aku 153 foreach {cs ord cstype} [lindex $rev($rid) 4] { lappend ords $ord }
64d0019… aku 154 return [$cmd $ords]
64d0019… aku 155 }
64d0019… aku 156
64d0019… aku 157 foreach {rid children} [array get dep] {
64d0019… aku 158 set max [Ord max $rid]
64d0019… aku 159
64d0019… aku 160 foreach child $children {
5bbc7d4… aku 161 if {[catch {
5bbc7d4… aku 162 set a [dg arc insert $rid $child]
5bbc7d4… aku 163 }]} continue
64d0019… aku 164
64d0019… aku 165 if {$max > [Ord min $child]} {
64d0019… aku 166 puts "Backward : $rid -> $child"
64d0019… aku 167 dg arc set $a color red
64d0019… aku 168 }
64d0019… aku 169 }
64d0019… aku 170 }
64d0019… aku 171
64d0019… aku 172 # Convert the graph to dot, then run the layouter and convert to png,
64d0019… aku 173 # at last show the image.
64d0019… aku 174
64d0019… aku 175 vc::tools::dot layout png dg SymbolTree st.png
64d0019… aku 176 exec display st.png
64d0019… aku 177 file delete st.png
64d0019… aku 178 exit

Keyboard Shortcuts

Open search /
Next entry (timeline) j
Previous entry (timeline) k
Open focused entry Enter
Show this help ?
Toggle theme Top nav button