diff options
Diffstat (limited to 'tools/cvs2fossil/lib/c2f_patopsort.tcl')
| -rw-r--r-- | tools/cvs2fossil/lib/c2f_patopsort.tcl | 210 |
1 files changed, 210 insertions, 0 deletions
diff --git a/tools/cvs2fossil/lib/c2f_patopsort.tcl b/tools/cvs2fossil/lib/c2f_patopsort.tcl new file mode 100644 index 0000000..e0dd439 --- /dev/null +++ b/tools/cvs2fossil/lib/c2f_patopsort.tcl @@ -0,0 +1,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 |