Tcl Library Source Code

    # Future: Consolidate with ... review ...
    # Determine which packages are potentially changed, from the set
    # of modules touched since the last release, as per the fossil
    # repository's commit log.

    set trunk     [sak::review::Leaf trunk]            ;# rid
    set release   [sak::review::YoungestOfTag release] ;# datetime

    sak::review::AllParentsAfter $trunk $release -> rid {
	sak::review::FileSet $rid -> path action {
	    lappend modifiedm [lindex [file split $path] 1]
	}
    }
    set modifiedm [lsort -unique $modifiedm]

	    lappend cm($themodule) $d

	    # ignore files in modules/
	    if {[llength $px] < 3} continue
	    lappend pt($themodule) [file join {*}[lrange $px 2 end]]
	}
    }

    Next

    # cleanup module list, may have duplicates
    set modifiedm [lsort -unique $modifiedm]

    array set review {}

    # package -> list(version)

proc ::sak::review::AllParentsAfter {rid cut _ rv script} {
    upvar 1 $rv therev

    array set rev {}
    set rev($rid) .
    lappend front $rid

    # Initial run, for the starting revision.
    set therev   $rid
    uplevel 1 $script

    # Standard iterative incremental transitive-closure. We have a
    # front of revisions whose parents we take, which become the new
    # front to follow, until no parents are delivered anymore due to
    # the cutoff condition (timestamp, only the revisions coming after
    # are accepted).

    while {1} {
	set new {}
	foreach cid $front {
	    foreach pid [split [Parents $cid $cut] \n] {
		foreach {pid uuid mtraw mtime} [split [string trim $pid |] |] break
		lappend new $pid $mtime $uuid

		if {$mtraw <= $cut} {
		    puts "Overshot: $rid $mtime $uuid"
		}

	    }
	}
	if {![llength $new]} break

	# record new parents, and make them the new starting points
	set front {}
	foreach {pid mtime uuid} $new {
	    if {[info exists rev($pid)]} continue
	    set rev($pid) .
	    lappend front $pid

	    set therev   $pid
	    uplevel 1 $script
	}
    }
}

proc ::sak::review::Parents {rid cut} {
    lappend map @rid@    $rid
    lappend map @cutoff@ $cut
    F [string map $map {
	SELECT pid, blob.uuid, event.mtime, datetime(event.mtime)
	FROM  plink, blob, event
	WHERE plink.cid   = @rid@
	AND   plink.pid = blob.rid
	AND   plink.pid = event.objid
	AND   event.mtime > @cutoff@
	;
    }]
}

proc ::sak::review::YoungestOfTag {tag} {
    lappend map @tag@ $tag
    puts "last $tag = [F [string map $map {
	SELECT datetime (event.mtime)
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid
	AND   event.type      = 'ci'
	ORDER BY event.mtime DESC
	LIMIT 1
	;
    }]]"
    F [string map $map {
	SELECT event.mtime
	FROM   tag, tagxref, event
	WHERE tag.tagname     = 'sym-' || '@tag@'
	AND   tagxref.tagid   = tag.tagid
	AND   tagxref.tagtype > 0
	AND   tagxref.rid     = event.objid