Fossil

Check-in [1ea319fb]
Login

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:Another helper, textual, write changeset data to stdout.
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:1ea319fb6786f7ebc42a1518f158d42818e7380c
User & Date: aku 2007-11-25 07:44:24
Context
2007-11-25
07:54
Code cleanup. Removed trailing whitespace across the board. check-in: b679ca33 user: aku tags: trunk
07:44
Another helper, textual, write changeset data to stdout. check-in: 1ea319fb user: aku tags: trunk
07:41
Tweaked log output of the topological sorter (revisions) to be tabular (aligned columns), added information (time ranges). check-in: bcc630d3 user: aku tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Added tools/cvs2fossil/changeset.















































































































































































































































>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
#!/bin/sh
## -*- tcl -*- \
exec tclsh "$0" ${1+"$@"}

# # ## ### ##### ######## ############# #####################
## Copyright (c) 2007 Andreas Kupries.
#
# This software is licensed as described in the file LICENSE, which
# you should have received as part of this distribution.
#
# This software consists of voluntary contributions made by many
# individuals.  For exact contribution history, see the revision
# history and logs, available at http://fossil-scm.hwaci.com/fossil
# # ## ### ##### ######## ############# #####################

## Helper application, debugging of cvs2fossil. This application
## extracts all information about a changeset and writes it nicely
## formatted to stdout. The changeset is specified by its internal
## numerical id. 

# # ## ### ##### ######## ############# #####################
## Requirements, extended package management for local packages.

lappend auto_path [file join [file dirname [info script]] lib]

package require Tcl 8.4                               ; # Required runtime.
package require struct::graph                         ; # Graph handling.
package require struct::list                          ; # Higher order list ops.
package require vc::fossil::import::cvs::project::rev ; # Changesets
package require vc::fossil::import::cvs::state        ; # State storage.
package require vc::tools::misc                       ; # Min/max.

namespace import ::vc::fossil::import::cvs::state
namespace import ::vc::fossil::import::cvs::project::rev
namespace import ::vc::tools::misc::*
namespace import ::vc::tools::log
log verbosity 0

# Process the command line, i.e. get the database to access, and file
# of interest. The latter can be specified by name, id, or indirectly
# through the id of one of the revisions it contains.

state use [lindex $argv 0]
state reading changeset
state reading cstype
state reading csrevision
state reading project
state reading revision
state reading file
state reading symbol
state reading meta
state reading author
state reading cmessage

set cid [lindex $argv 1]

struct::list assign [state run {
    SELECT C.cid, C.pid, C.src, P.name, CT.name
    FROM changeset C, project P, cstype CT
    WHERE C.cid = $cid
    AND   P.pid = C.pid
    AND   CT.tid = C.type
}] cid pid src pname tname

puts ""
puts "Changeset <$tname $cid> in project \"$pname\" ($pid)"

if {$tname eq "sym"} {
    puts "Symbol \"[state run {
	SELECT name
	FROM symbol
	WHERE sid = $src
    }]\""
} else {
    struct::list assign [state run {
	SELECT P.name, S.name, A.name, L.text
	FROM meta M, project P, symbol S, author A, cmessage L
	WHERE M.mid = $src
	AND P.pid = M.pid
	AND S.sid = M.bid
	AND A.aid = M.aid
	AND L.cid = M.cid
    }] project lod author cmessage
    puts "Meta: Project = \"$project\""
    puts "Meta: LOD     = \"$lod\""
    puts "Meta: Author  = \"$author\""
    puts "Meta: Log     |[join [split $cmessage \n] "\"\nMeta: Log     |"]"
}

array set rev {}
foreach {rid date pos fname frev default} [state run {
    SELECT R.rid, R.date, C.pos, F.name, R.rev, R.isdefault
    FROM csrevision C, revision R, file F
    WHERE C.cid = $cid
    AND   R.rid = C.rid
    AND   F.fid = R.fid
    ORDER BY C.pos, R.date
}] {
    set rev($rid) [list $pos $date $fname $frev $default]
    puts "File: [expr {$default?"D":" "}] [clock format $date] [format %3d $pos]/[format %6d $rid] ${frev}::$fname"
}


::vc::fossil::import::cvs::project::rev::PullPredecessorRevisions pdep [array names rev]
::vc::fossil::import::cvs::project::rev::PullSuccessorRevisions   sdep [array names rev]



puts ""
exit








exit

Changes to tools/cvs2fossil/lib/c2f_pbreakacycle.tcl.

18
19
20
21
22
23
24

25
26
27
28
29
30
31
..
59
60
61
62
63
64
65
66





67

68
69
70
71
72
73
74
..
86
87
88
89
90
91
92

93
94
95
96
97
98

99
100
101
102
103
104
105
...
299
300
301
302
303
304
305




























































306






























307
308





















































































309
310
311
312
313
314
315

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                                   ; # Required runtime.
package require snit                                      ; # OO system.
package require struct::list                              ; # Higher order list operations.

package require vc::tools::misc                           ; # Min, max.
package require vc::tools::log                            ; # User feedback.
package require vc::tools::trouble                        ; # Error reporting.
package require vc::fossil::import::cvs::repository       ; # Repository management.
package require vc::fossil::import::cvs::cyclebreaker     ; # Breaking dependency cycles.
package require vc::fossil::import::cvs::state            ; # State storage.
package require vc::fossil::import::cvs::project::rev     ; # Project level changesets
................................................................................
	# executed.
	return
    }

    typemethod run {} {
	# Pass manager interface. Executed to perform the
	# functionality of the pass.






	cyclebreaker precmd   [myproc BreakBackwardBranches]

	cyclebreaker breakcmd [myproc BreakCycle]

	state transaction {
	    LoadCommitOrder
	    cyclebreaker run break-all [myproc Changesets]
	}

................................................................................
    # # ## ### ##### ######## #############
    ## Internal methods

    proc Changesets {} { project::rev all }

    proc LoadCommitOrder {} {
	::variable mycset


	state transaction {
	    foreach {cid pos} [state run { SELECT cid, pos FROM csorder }] {
		set cset [project::rev of $cid]
		$cset setpos $pos
		set mycset($pos) $cset

	    }
	    # Remove the order information now that we have it in
	    # memory, so that we can save it once more, for all
	    # changesets, while breaking the remaining cycles.
	    state run { DELETE FROM csorder }
	}
	return
................................................................................
	if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" }
	return
    }


    # # ## ### ##### ######## #############





























































    proc BreakCycle {graph} {






























	cyclebreaker break $graph
    }






















































































    # # ## ### ##### ######## #############

    typevariable mycset -array {} ; # Map from commit positions to the
				    # changeset (object ref) at that
				    # position.








>







 








>
>
>
>
>

>







 







>






>







 







>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>

>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>


>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>
>







18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
..
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
..
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
...
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499

# # ## ### ##### ######## ############# #####################
## Requirements

package require Tcl 8.4                                   ; # Required runtime.
package require snit                                      ; # OO system.
package require struct::list                              ; # Higher order list operations.
package require struct::set                               ; # Set operations.
package require vc::tools::misc                           ; # Min, max.
package require vc::tools::log                            ; # User feedback.
package require vc::tools::trouble                        ; # Error reporting.
package require vc::fossil::import::cvs::repository       ; # Repository management.
package require vc::fossil::import::cvs::cyclebreaker     ; # Breaking dependency cycles.
package require vc::fossil::import::cvs::state            ; # State storage.
package require vc::fossil::import::cvs::project::rev     ; # Project level changesets
................................................................................
	# executed.
	return
    }

    typemethod run {} {
	# Pass manager interface. Executed to perform the
	# functionality of the pass.

	set len [string length [project::rev num]]
	set myatfmt %${len}s
	incr len 6
	set mycsfmt %${len}s

	cyclebreaker precmd   [myproc BreakBackwardBranches]
	cyclebreaker savecmd  [myproc KeepOrder]
	cyclebreaker breakcmd [myproc BreakCycle]

	state transaction {
	    LoadCommitOrder
	    cyclebreaker run break-all [myproc Changesets]
	}

................................................................................
    # # ## ### ##### ######## #############
    ## Internal methods

    proc Changesets {} { project::rev all }

    proc LoadCommitOrder {} {
	::variable mycset
	::variable myrevisionchangesets

	state transaction {
	    foreach {cid pos} [state run { SELECT cid, pos FROM csorder }] {
		set cset [project::rev of $cid]
		$cset setpos $pos
		set mycset($pos) $cset
		lappend myrevisionchangesets $cset
	    }
	    # Remove the order information now that we have it in
	    # memory, so that we can save it once more, for all
	    # changesets, while breaking the remaining cycles.
	    state run { DELETE FROM csorder }
	}
	return
................................................................................
	if {![llength $backwardrevisions]} { trouble internal "Set of backward revisions is empty" }
	return
    }


    # # ## ### ##### ######## #############

    proc KeepOrder {graph at cset} {
	set cid [$cset id]

	log write 4 breakacycle "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] <<[FormatTR $graph $cset]>>"

	# We see here a mixture of symbol and revision changesets.
	# The symbol changesets are ignored as irrelevant.

	if {[$cset pos] eq ""} return

	# For the revision changesets we are sure that they are
	# consumed in the same order as generated by pass 7
	# (RevTopologicalSort). Per the code in cvs2svn.

	# NOTE: I cannot see that. Assume cs A and cs B, not dependent
	#       on each other in the set of revisions, now B after A
	#       simply means that B has a later time or depends on
	#       something wit a later time than A. In the full graph A
	#       may now have dependencies which shift it after B,
	#       violating the above assumption.
	#
	# Well, it seems to work if I do not make the NTDB root a
	# successor of the regular root. Doing so seems to tangle the
	# changesets into a knots regarding time vs dependencies and
	# trigger such shifts. Keeping these two roots separate OTOH
	# disappears the tangle. So, for now I accept that, and for
	# paranoia I add code which checks this assumption.

	struct::set exclude myrevisionchangesets $cset

	::variable mylastpos
	set new [$cset pos]

	if {$new != ($mylastpos + 1)} {
	    if {$mylastpos < 0} {
		set old "<NONE>"
	    } else {
		::variable mycset
		set old [$mycset($mylastpos) str]@$mylastpos
	    }

	    trouble internal "Ordering of revision changesets violated, [$cset str]@$new is not immediately after $old"
	}

	set mylastpos $new
	return
    }

    proc FormatTR {graph cset} {
	return [join [struct::list map [$graph node set $cset timerange] {clock format}] { -- }]
    }

    typevariable mylastpos            -1 ; # Position of last revision changeset saved.
    typevariable myrevisionchangesets {} ; # Set of revision changesets

    typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
    typevariable mycsfmt ; # Ditto for the changesets.

    # # ## ### ##### ######## #############

    proc BreakCycle {graph} {
	# In this pass the cycle breaking can be made a bit more
	# targeted, hence this custom callback.
	#
	# First we use the data remembered by 'SaveOrder', about the
	# last commit position it handled, to deduce the next revision
	# changeset it would encounter. Then we look for the shortest
	# predecessor path from it to all other revision changesets
	# and break this path. Without such a path we fall back to the
	# generic cycle breaker.

	::variable mylastpos
	::variable mycset
	::variable myrevisionchangesets

	set nextpos [expr {$mylastpos + 1}]
	set next    $mycset($nextpos)

	puts "** Last: $mylastpos = [$mycset($mylastpos) str] @ [$mycset($mylastpos) pos]"
	puts "** Next: $nextpos = [$next str] @ [$next pos]"

	set path [SearchForPath $graph $next $myrevisionchangesets]
	if {[llength $path]} {
	    cyclebreaker break-segment $graph $path
	    return
	}

	# We were unable to find an ordered changeset in the reachable
	# predecessors, fall back to the generic code for breaking the
	# found cycle.

	cyclebreaker break $graph
    }

    proc SearchForPath {graph n stopnodes} {
	# Search for paths to prerequisites of N.
	#
	# Try to find the shortest dependency path that causes the
	# changeset N to depend (directly or indirectly) on one of the
	# changesets contained in STOPNODES.
	#
	# We consider direct and indirect dependencies in the sense
	# that the changeset can be reached by following a chain of
	# predecessor nodes.
	#
	# When one of the csets in STOPNODES is found, we terminate
	# the search and return the path from that cset to N.  If no
	# path is found to a node in STOP_SET, we return the empty
	# list/path.

	# This is in essence a multi-destination Dijkstra starting at
	# N which stops when one of the destinations in STOPNODES has
	# been reached, traversing the predecessor arcs.

	# REACHABLE :: array (NODE -> list (STEPS, PREVIOUS))
	#
	# Semantics: NODE can be reached from N in STEPS steps, and
	# PREVIOUS is the previous node in the path which reached it,
	# allowing us at the end to construct the full path by
	# following these backlinks from the found destination. N is
	# only included as a key if there is a loop leading back to
	# it.

	# PENDING :: list (list (NODE, STEPS))
	#
	# Semantics: A list of possibilities that still have to be
	# investigated, where STEPS is the number of steps to get to
	# NODE.

	array set reachable {}
	set pending [list [list $n 0]]
	set at 0

	puts "** Searching shortest path ..."

	while {$at < [llength $pending]} {
	    struct::list assign [lindex $pending $at] current steps

	    #puts "** [lindex $pending $at] ** [$current str] **"
	    incr at

	    # Process the possibility. This is a breadth-first traversal.
	    incr steps
	    foreach pre [$graph nodes -in $current] {
	        # Since the search is breadth-first, we only have to #
	        # set nodes that don't already exist. If they do they
	        # have been reached already on a shorter path.

		if {[info exists reachable($pre)]} continue

		set reachable($pre) [list $steps $current]
		lappend pending [list $pre $steps]

		# Continue the search while have not reached any of
		# our destinations?
		if {![struct::set contain $pre $stopnodes]} continue

		# We have arrived, PRE is one of the destination; now
		# construct and return the path to it from N by
		# following the backlinks in the search state.
		set path [list $pre]
		while {1} {
		    set pre [lindex $reachable($pre) 1]
		    if {$pre eq $n} break
		    lappend path $pre
		}
		lappend path $n

		puts "** Searching shortest path ... Found ([project rev strlist $path])"
		return $path
	    }
	}

	puts "** Searching shortest path ... Not found"

	# No path found.
	return {}
    }

    # # ## ### ##### ######## #############

    typevariable mycset -array {} ; # Map from commit positions to the
				    # changeset (object ref) at that
				    # position.