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
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
## -*- tcl -*-
# # ## ### ##### ######## ############# #####################
## 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
# # ## ### ##### ######## ############# #####################
## Pass XI. This pass goes over all changesets and sorts them
## topologically. It assumes that there are no cycles which could
## impede it, any remaining having been broken by the previous two
## passes, and aborts if that condition doesn't hold.
# # ## ### ##### ######## ############# #####################
## 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::log ; # User feedback.
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
# # ## ### ##### ######## ############# #####################
## Register the pass with the management
vc::fossil::import::cvs::pass define \
AllTopologicalSort \
{Topologically Sort All ChangeSets} \
::vc::fossil::import::cvs::pass::atopsort
# # ## ### ##### ######## ############# #####################
##
snit::type ::vc::fossil::import::cvs::pass::atopsort {
# # ## ### ##### ######## #############
## Public API
typemethod setup {} {
# Define the names and structure of the persistent state of
# this pass.
state use revision
state use tag
state use branch
state use symbol
state use changeset
state use csitem
state use cssuccessor
state use csorder
state extend cstimestamp {
-- Commit order of all changesets based on their
-- dependencies, plus a monotonically increasing
-- timestamp.
cid INTEGER NOT NULL REFERENCES changeset,
pos INTEGER NOT NULL,
date INTEGER NOT NULL,
UNIQUE (cid),
UNIQUE (pos),
UNIQUE (date)
}
return
}
typemethod load {} {
# Pass manager interface. Executed to load data computed by
# this pass into memory when this pass is skipped instead of
# 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 12
set mycsfmt %${len}s
cyclebreaker savecmd [myproc SaveTimestamps]
state transaction {
LoadSymbolChangesets
cyclebreaker run tsort-all [myproc Changesets]
}
return
}
typemethod discard {} {
# Pass manager interface. Executed for all passes after the
# run passes, to remove all data of this pass from the state,
# as being out of date.
state discard cstimestamp
return
}
# # ## ### ##### ######## #############
## Internal methods
proc Changesets {} { project::rev all }
proc LoadSymbolChangesets {} {
# Consider use of 'project::rev sym' here.
set mysymchangesets [struct::list filter [project::rev all] [myproc IsBySymbol]]
return
}
proc IsBySymbol {cset} { $cset bysymbol }
proc SaveTimestamps {graph at cset} {
set cid [$cset id]
set date [GetTime [lindex [$graph node get $cset timerange] 1] \
[struct::set contains $mysymchangesets $cset] \
message]
log write 4 atopsort "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] '[$cset lod]' $message"
state run {
INSERT INTO cstimestamp (cid, pos, date)
VALUES ($cid, $at, $date)
}
return
}
proc GetTime {stamp expectchange mv} {
::variable mylasttimestamp
upvar 1 $mv message
set message ""
if {$stamp > $mymaxtimestamp} {
# A timestamp in the future is believed to be bogus and
# shifted backwars in time to prevent it from forcing
# other timestamps to be pushed even further in the
# future.
# From cvs2svn: Note that this is not nearly a complete
# solution to the bogus timestamp problem. A timestamp in
# the future still affects the ordering of changesets, and
# a changeset having such a timestamp will not be
# committed until all changesets with earlier timestamps
# have been committed, even if other changesets with even
# earlier timestamps depend on this one.
incr mylasttimestamp
if {!$expectchange} {
set message " Timestamp [clock format $stamp] is in the future; shifted back to [clock format $mylasttimestamp] ([expr {$mylasttimestamp - $stamp}])"
}
} elseif {$stamp < ($mylasttimestamp)+1} {
incr mylasttimestamp
if {!$expectchange} {
set message " Timestamp [clock format $stamp] adjusted to [clock format $mylasttimestamp] (+[expr {$mylasttimestamp - $stamp}])"
}
} else {
set mylasttimestamp $stamp
}
return $mylasttimestamp
}
typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
typevariable mycsfmt ; # Ditto for the changesets.
typevariable mysymchangesets {} ; # Set of the symbol changesets.
typevariable mylasttimestamp 0 ; # Last delivered timestamp.
typevariable mymaxtimestamp
typeconstructor {
# The maximum timestamp considered as reasonable is
# "now + 1 day".
set mymaxtimestamp [clock seconds]
incr mymaxtimestamp 86400 ; # 24h * 60min * 60sec
return
}
# # ## ### ##### ######## #############
## Configuration
pragma -hasinstances no ; # singleton
pragma -hastypeinfo no ; # no introspection
pragma -hastypedestroy no ; # immortal
# # ## ### ##### ######## #############
}
namespace eval ::vc::fossil::import::cvs::pass {
namespace export atopsort
namespace eval atopsort {
namespace import ::vc::fossil::import::cvs::cyclebreaker
namespace import ::vc::fossil::import::cvs::state
namespace eval project {
namespace import ::vc::fossil::import::cvs::project::rev
}
namespace import ::vc::tools::log
log register atopsort
}
}
# # ## ### ##### ######## ############# #####################
## Ready
package provide vc::fossil::import::cvs::pass::atopsort 1.0
return
|
