Fossil SCM

fossil-scm / tools / cvs2fossil / lib / c2f_patopsort.tcl
Blame History Raw 211 lines
1
## -*- tcl -*-
2
# # ## ### ##### ######## ############# #####################
3
## Copyright (c) 2007 Andreas Kupries.
4
#
5
# This software is licensed as described in the file LICENSE, which
6
# you should have received as part of this distribution.
7
#
8
# This software consists of voluntary contributions made by many
9
# individuals. For exact contribution history, see the revision
10
# history and logs, available at http://fossil-scm.hwaci.com/fossil
11
# # ## ### ##### ######## ############# #####################
12
13
## Pass XI. This pass goes over all changesets and sorts them
14
## topologically. It assumes that there are no cycles which could
15
## impede it, any remaining having been broken by the previous two
16
## passes, and aborts if that condition doesn't hold.
17
18
# # ## ### ##### ######## ############# #####################
19
## Requirements
20
21
package require Tcl 8.4 ; # Required runtime.
22
package require snit ; # OO system.
23
package require struct::list ; # Higher order list operations.
24
package require vc::tools::log ; # User feedback.
25
package require vc::fossil::import::cvs::cyclebreaker ; # Breaking dependency cycles.
26
package require vc::fossil::import::cvs::state ; # State storage.
27
package require vc::fossil::import::cvs::project::rev ; # Project level changesets
28
29
# # ## ### ##### ######## ############# #####################
30
## Register the pass with the management
31
32
vc::fossil::import::cvs::pass define \
33
AllTopologicalSort \
34
{Topologically Sort All ChangeSets} \
35
::vc::fossil::import::cvs::pass::atopsort
36
37
# # ## ### ##### ######## ############# #####################
38
##
39
40
snit::type ::vc::fossil::import::cvs::pass::atopsort {
41
# # ## ### ##### ######## #############
42
## Public API
43
44
typemethod setup {} {
45
# Define the names and structure of the persistent state of
46
# this pass.
47
48
state use revision
49
state use tag
50
state use branch
51
state use symbol
52
state use changeset
53
state use csitem
54
state use cssuccessor
55
state use csorder
56
57
state extend cstimestamp {
58
-- Commit order of all changesets based on their
59
-- dependencies, plus a monotonically increasing
60
-- timestamp.
61
62
cid INTEGER NOT NULL REFERENCES changeset,
63
pos INTEGER NOT NULL,
64
date INTEGER NOT NULL,
65
UNIQUE (cid),
66
UNIQUE (pos),
67
UNIQUE (date)
68
}
69
return
70
}
71
72
typemethod load {} {
73
# Pass manager interface. Executed to load data computed by
74
# this pass into memory when this pass is skipped instead of
75
# executed.
76
return
77
}
78
79
typemethod run {} {
80
# Pass manager interface. Executed to perform the
81
# functionality of the pass.
82
83
set len [string length [project::rev num]]
84
set myatfmt %${len}s
85
incr len 12
86
set mycsfmt %${len}s
87
88
cyclebreaker savecmd [myproc SaveTimestamps]
89
90
state transaction {
91
LoadSymbolChangesets
92
cyclebreaker run tsort-all [myproc Changesets]
93
}
94
return
95
}
96
97
typemethod discard {} {
98
# Pass manager interface. Executed for all passes after the
99
# run passes, to remove all data of this pass from the state,
100
# as being out of date.
101
102
state discard cstimestamp
103
return
104
}
105
106
# # ## ### ##### ######## #############
107
## Internal methods
108
109
proc Changesets {} { project::rev all }
110
111
proc LoadSymbolChangesets {} {
112
# Consider use of 'project::rev sym' here.
113
set mysymchangesets [struct::list filter [project::rev all] [myproc IsBySymbol]]
114
return
115
}
116
117
proc IsBySymbol {cset} { $cset bysymbol }
118
119
proc SaveTimestamps {graph at cset} {
120
set cid [$cset id]
121
122
set date [GetTime [lindex [$graph node get $cset timerange] 1] \
123
[struct::set contains $mysymchangesets $cset] \
124
message]
125
126
log write 4 atopsort "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]] '[$cset lod]' $message"
127
128
state run {
129
INSERT INTO cstimestamp (cid, pos, date)
130
VALUES ($cid, $at, $date)
131
}
132
return
133
}
134
135
proc GetTime {stamp expectchange mv} {
136
::variable mylasttimestamp
137
upvar 1 $mv message
138
set message ""
139
if {$stamp > $mymaxtimestamp} {
140
# A timestamp in the future is believed to be bogus and
141
# shifted backwars in time to prevent it from forcing
142
# other timestamps to be pushed even further in the
143
# future.
144
145
# From cvs2svn: Note that this is not nearly a complete
146
# solution to the bogus timestamp problem. A timestamp in
147
# the future still affects the ordering of changesets, and
148
# a changeset having such a timestamp will not be
149
# committed until all changesets with earlier timestamps
150
# have been committed, even if other changesets with even
151
# earlier timestamps depend on this one.
152
153
incr mylasttimestamp
154
if {!$expectchange} {
155
set message " Timestamp [clock format $stamp] is in the future; shifted back to [clock format $mylasttimestamp] ([expr {$mylasttimestamp - $stamp}])"
156
}
157
} elseif {$stamp < ($mylasttimestamp)+1} {
158
incr mylasttimestamp
159
if {!$expectchange} {
160
set message " Timestamp [clock format $stamp] adjusted to [clock format $mylasttimestamp] (+[expr {$mylasttimestamp - $stamp}])"
161
}
162
} else {
163
set mylasttimestamp $stamp
164
}
165
return $mylasttimestamp
166
}
167
168
typevariable myatfmt ; # Format for log output to gain better alignment of the various columns.
169
typevariable mycsfmt ; # Ditto for the changesets.
170
171
typevariable mysymchangesets {} ; # Set of the symbol changesets.
172
typevariable mylasttimestamp 0 ; # Last delivered timestamp.
173
typevariable mymaxtimestamp
174
175
typeconstructor {
176
# The maximum timestamp considered as reasonable is
177
# "now + 1 day".
178
set mymaxtimestamp [clock seconds]
179
incr mymaxtimestamp 86400 ; # 24h * 60min * 60sec
180
return
181
}
182
183
# # ## ### ##### ######## #############
184
## Configuration
185
186
pragma -hasinstances no ; # singleton
187
pragma -hastypeinfo no ; # no introspection
188
pragma -hastypedestroy no ; # immortal
189
190
# # ## ### ##### ######## #############
191
}
192
193
namespace eval ::vc::fossil::import::cvs::pass {
194
namespace export atopsort
195
namespace eval atopsort {
196
namespace import ::vc::fossil::import::cvs::cyclebreaker
197
namespace import ::vc::fossil::import::cvs::state
198
namespace eval project {
199
namespace import ::vc::fossil::import::cvs::project::rev
200
}
201
namespace import ::vc::tools::log
202
log register atopsort
203
}
204
}
205
206
# # ## ### ##### ######## ############# #####################
207
## Ready
208
209
package provide vc::fossil::import::cvs::pass::atopsort 1.0
210
return
211

Keyboard Shortcuts

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