Artifact bd89b94e5f31aa5d3a00c2fb839b20cfa821cfa2

File tools/cvs2fossil/lib/c2f_patopsort.tcl part of check-in [e288af3995] - Fluff: Renamed state methods use/reading/writing to usedb/use/extend for clarity. Updated all callers. Extended state module with code to dump the SQL statements it receives to a file for analysis. Extended the 'use' declarations of several passes. by aku on 2007-12-02 23:47:45.

## -*- 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 {} {
	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 contain $mysymchangesets $cset] \
		     message]

	log write 4 atopsort "Changeset @ [format $myatfmt $at]: [format $mycsfmt [$cset str]]$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