#!/bin/sh
# Start Tcl from a cluster bin directory \
exec /cluster/bin/tcl/`uname -m`/bin/tclsh8.4 $0 ${1+"$@"}
##
# Program to generate reports from CVS log.
##
package require Tclx
package require Itcl

##
# FIXME:
#  - indicate deleted files in index.
#  - be able to just specify the branch tag and not need branch point tag
##

#
# Class that contains the information about a file obtained from a cvs log
# command.
#
::itcl::class CVSFileInfo {
    # Serialization version number.
    private common SERIALIZE_VERSION 1

    # Fields to serialize
    private common SERIALIZE_FIELDS {
        fRcsFile fWorkingFile fHead fBranch
        fKeywordSubst fBranchTable fTags fTagTable fRevisions
    }

    # Separator for file records
    private common FILE_REC_SEP "============================================================================="

    # Separator for revision records
    private common REVISION_REC_SEP "----------------------------"

    # RCS file name (full repository path)
    private variable fRcsFile

    # Work file name (relative to current work directory)
    private variable fWorkingFile

    # Head and branch
    private variable fHead
    private variable fBranch
    private variable fBranchMagic {}

    # Keyword substitution
    private variable fKeywordSubst

    # Branch table, indexed by revision, with a list of branch revisions.
    # Doesn't contain unbranched revisions.
    private variable fBranchTable
    
    # Ordered list of tag names
    private variable fTags {}

    # Table of tags containing revision
    private variable fTagTable

    # Ordered list of revisions
    private variable fRevisions {}

    # Table of revisions information in the form:
    #    {rev dateTime author state comment}
    # dateTime is not parsed
    private variable fRevisionTable

    # Unexpect EOF error
    private proc unexpectedEOFError {} {
        error "Unexpect EOF parsing CVS log" {} {CVS CVS_LOG_UNEXPECTED_EOF}
    }

    # Parse error
    private proc parseError {msg} {
        error "CVS log parse error: $msg" {} {CVS CVS_LOG_PARSE}
    }

    # Read a line from the CVS log that must not return EOF.
    private proc readCvsLog {chan} {
        if {[gets $chan line] < 0} {
            unexpectedEOFError
        }
        return $line
    }

    # Determine if line is one of the record end lines.
    private proc isRecordEnd {line} {
        return [expr {[cequal $line $FILE_REC_SEP] || [cequal $line $REVISION_REC_SEP]}]
    }

    # Parse the cvs log header. `RCS file:' has already been read.
    private method parseCvsLogHeader {chan} {

        set parsingTags 0
        set inDescription 0
        while {1} {
            set line [readCvsLog $chan]
            if {[isRecordEnd $line]} {
                break
            }
            if {[string match "\t*" $line]} {
                # Process symbolic names line.
                if {!$parsingTags} {
                    parseError "unexpected symbolic names line: `$line'"
                }
                if {![regexp {^\t([^:]+): (.*)$} $line {} name value]} {
                    parseError "can't parse symbolic names line: `$line'"
                }
                lappend fTags $name
                set fTagTable($name) $value
		
            } elseif {!$inDescription} {
                if {![regexp {^([^:]+): *(.*)$} $line {} name value]} {
                    parseError "can't parse line: `$line'"
                }
                set parsingTags 0
                switch -- $name {
                    "RCS file" {
                        parseError "`RCS file:' should have already been parsed"
                    }
                    "Working file" {
                        set fWorkingFile $value
                    }
                    "head" {
                        set fHead $value
                    }
                    "branch" {
                        regsub -all {;} $value {} value
                        set fBranch $value
                    }
                    "symbolic names" {
                        set parsingTags 1
                    }
                    "keyword substitution" {
                        set fKeywordSubst $value
                    }
                    "description" {
                        set inDescription 1
                    }
                }
            }
        }
    }

    # Parse a commit record.  Return 1 if there are more to read,
    # zero if its the last.
    private method parseCvsLogCommitRec {chan} {
        set line [readCvsLog $chan]
        # Revision could have a `locked by:' (which is ignored)
        if {![regexp {^revision ([^;]+)} $line {} revision]} {
            parseError "invalid `revision' line, got `$line'"
        }
        set line [readCvsLog $chan]
        if {![regexp {^date: ([^;]+);  author: ([^;]+);  state: ([^;]+);} $line {} dateStr author state]} {
            parseError "invalid `date:' line, got `$line'"
        }
        # branches record is optional
        set line [readCvsLog $chan]
        if {[regexp {^branches: (.+;)} $line {} branchList]} {
            foreach branch $branchList {
                regsub -all {;| } $branch {} branch
                if {![lempty $branch]} {
                    lappend fBranchTable($revision) $branch
                }
            }
            set line [readCvsLog $chan]
        }
        # Rest is comment
        set comment {}
        while {1} {
            if {[isRecordEnd $line]} {
                break
            }
            append comment $line \n
            set line [readCvsLog $chan]
        }

        if {[cequal $comment "*** empty log message ***\n"]} {
            set comment {}
        }
        
        # Got it all
        lappend fRevisions $revision
        set fRevisionTable($revision) [list $revision $dateStr $author $state $comment]

        return [cequal $line $REVISION_REC_SEP]
    }

    # Parse the output of cvs log.
    private method parseCvsLog {chan {modulePath {}}} {
        parseCvsLogHeader $chan
        while {[parseCvsLogCommitRec $chan]} {
            continue
        }
        if {![info exists fWorkingFile]} {
            if {[lempty $modulePath]} {
                error "didn't parse work file and don't have module path: $fRcsFile"
            }
            if {[string first $modulePath $fRcsFile] != 0} {
                error "rcs file \"$fRcsFile\" doesn't start with module path \"$modulePath\""
            }
            set fWorkingFile [string range $fRcsFile [expr [string length $modulePath]+1] end]
            regsub {,v$} $fWorkingFile {} fWorkingFile
        }
    }

    # Parse a cvs log record and create an object for it.
    # Module path is needed to computer work directory if doing a rlog
    # Return {} on EOF.
    public proc readCvsLogRec {chan {modulePath {}}} {
        # Skip blank and `?" lines
        while {([gets $chan line] >= 0) \
                && ([lempty $line] || [string match \\?* $line])} {
            continue
        }
        if {[eof $chan]} {
            return {}
        }
        if {![regexp {^RCS file: (.*)$} $line {} value]} {
            parseError "Expected `RCS file:' line, got `$line'"
        }
        set obj [CVSFileInfo "::#auto" $value]
        try_eval {
            $obj parseCvsLog $chan $modulePath
        } {
            $obj delete
            error $errorResult $errorInfo $errorCode
        }
        return $obj
    }

    # Constructor
    public constructor {rcsFileName} {
        set fRcsFile $rcsFileName
    } {
    }
    
    # Delete self
    public method delete {} {
        ::itcl::delete object $this
    }

    # Generate a command to recreate this object
    public method serialize {} {
        error "not implemented"
        set serializeVersion SERIALIZE_VERSION
        foreach var [concat serializeVersion $SERIALIZE_FIELDS] {
            Serialize::serializeVar
        }
    }

    # Load serialized object. Cmd is the result of serialize
    public proc deserialize {cmd} {
        error "not implemented"
    }


    # Compare revisions       
    public method compareRevs {r1 r2} {
	set r1s [split $r1 .]
	set r2s [split $r2 .]
	set r1l [llength $r1s] 
	set r2l [llength $r2s] 
        set i 0
	while {1} {
            if {($i >= $r1l) && ($i >= $r2l)} { return 0 }
            if {$i >= $r1l} { return -1 }
            if {$i >= $r2l} { return  1 }
            set n1 [lindex $r1s $i]
            set n2 [lindex $r2s $i]
            if {$n1 > $n2} { return  1 }	
            if {$n1 < $n2} { return -1 }	
            incr i 1
	}
    }


    # Get the RCS file
    public method getRCSFile {} {
        return $fRcsFile
    }

    # Get the working file
    public method getWorkingFile {} {
        return $fWorkingFile
    }

    # Get the head
    public method getHead {} {
        return $fHead
    }

    # Get the branch, is in the form 1.37.20, not magic branch 1.37.0.20
    public method getBranch {} {
        return $fBranch
    }

    # Get the branch in magic number format (1.37.0.20)
    public method getBranchMagic {} {
        if {$fBranchMagic == {}} {
            set p [split $fBranch .]
            set fBranchMagic [join [linsert $p end-1 0] .]
        }
        return $fBranchMagic
    }


    # Test if a revSpec is a number or a tag
    private method isRevNumber {revSpec} {
        return [ctype digit [cindex $revSpec 0]]
    }

    # Lookup a tag.  If it doesn't exit, generate an error if check is 1
    # of return {} if check is 0. The tag HEAD is supported.
    private method lookupTag {tag {check 1}} {
        if {$tag == "HEAD"} {
            return [getHead]
        } elseif {[info exists fTagTable($tag)]} {
            return $fTagTable($tag)
        } elseif {$check} {
            error "tag \"$tag\" does not exist"
        } else {
            return {}
        }
    }

    # Test if a tag or a revision is a magic branch
    public method isBranchMagic {revSpec} {
        if {![isRevNumber $revSpec]} {
            set revSpec [lookupTag $revSpec]
        }
        return [expr [lindex [split $revSpec .] end-1] == 0]
    }

    # Translate a magic branch number to an actual revision number
    # If not a magic branch, return unchanged.
    public method translateBranchMagic {rev} {
        if {[isBranchMagic $rev]} {
            set revs [split $rev .]
            return [join [concat [lrange $revs 0 end-2] [lindex $revs end]] .]
        } else {
            return $rev
        }
    }
    
    # Deterimine if a revision or tag is a branch (x.x.x)
    public method isBranch {revSpec} {
        if {![isRevNumber $revSpec]} {
            set revSpec [lookupTag $revSpec]
        }
        return [expr {[llength [split $revSpec .]] & 1}]
    }

    # Deterimine if a revision or tag is a branch (x.x.x) or branch magic (x.x.0.x)
    public method isBranchOrMagic {revSpec} {
        if {![isRevNumber $revSpec]} {
            set revSpec [lookupTag $revSpec]
        }
        set parts [split $revSpec .]
        return [expr {([llength $parts] & 1) || ([lindex $parts end-1] == 0)}]
    }

    # Get the list of tags
    public method getTags {} {
        return $fTags
    }

    # Determine if a tag exists.
    public method containsTag {tag} {
        return [info exists fTagTable($tag)]
    }

    # Look up a tags value by tag.  If not found, return {} if
    # check is 0, or an error if check is 1.
    # This does not translation magic branch numbers.
    public method getTag {tag {check 0}} {
        return [lookupTag $tag $check]
    }

    # Look up a tags value by tag.  If not found, return {} if
    # check is 0, or an error if check is 1.
    # Translates magic branch numbers.
    public method getTagRevision {tag {check 0}} {
        if {!$check && ($tag == "")} {
            return $tag
        } 
        set rev [lookupTag $tag $check]
        if {$rev == {}} {
            return {}
        } else {
            return [translateBranchMagic $rev]
        }
    }

    # Given a revision spec (tag or revision), translate it to
    # a revision. Invalid tags generate an error if check is 1,
    # otherwise returns empty. Branch tags are translated from
    # magic number to revision.  Branch numbers are passed through.
    # If not found, return {} if check is 0, or an error if check is 1.
    public method toRevision {revSpec {check 1}} {
        if {[isRevNumber $revSpec]} {
            return $revSpec
        } else {
            return [getTagRevision $revSpec $check]
        }
    }

    # does revSpec exists as a revison
    public method hasRevision {revSpec} {
        return [expr {![lempty [toRevision $revSpec 0]]}]
    }

    # Given a branch or revision number (or tag), return its parent.
    # A trunk revision returns {}
    public method getRevisionParent {revSpec} {
        # FIXME: doesn't handle magic branchs
        set revs [split [toRevision $revSpec] .]
        if {[llength $revs] & 1} {
            # Branch number
            return [join [lrange $revs 0 end-1] .]
        } else {
            # Revision number
            return [join [lrange $revs 0 end-2] .]
        }
    }

    # Given a revision number (or tag), return its branch number.
    # Branch numbers are returned unchanged.  Head returns {}.
    # Magic branch numbers are convered to branch
    public method getRevisionBranch {revSpec} {
        set rev [toRevision $revSpec]
        set revs [split $rev .]
        if {[llength $revs] == 2} {
            return {}  ;# Head
        } elseif {[llength $revs] & 1} {
            return $rev
        } elseif {[lindex $revs end-1] == 0} {
            return [translateBranchMagic $rev]
        } else {
            # Revision number
            return [join [lrange $revs 0 end-1] .]
        }
    }

    # Given a branch tag or magic branch revision, get the first and last
    # revision numbers for the branch.  If no commits have been done on the
    # branch, return {}, otherwise return {firstRev lastRev}
    public method getBranchRevRange {branchSpec} {
        set branchRev [toRevision $branchSpec]
        if {[isBranchMagic $branchRev]} {
            set branchRev [translateBranchMagic $branchRev]
        } elseif {![isBranch $branchRev]} {
            error "Not a branch tag, branch revision or magic branch revision: $branchSpec"
        }
        
        # Search the revision list for the newest and oldest revisions
        # on the branch
        set newestRev {}
        set oldestRev {}
        foreach rev $fRevisions {
            if {[getRevisionBranch $rev] == $branchRev} {
                if {[lempty $newestRev]} {
                    set newestRev $rev
                }
                set oldestRev $rev
            }
        }
        if {$newestRev == {}} {
            return {}
        } else {
            return [list $oldestRev $newestRev]
        }
    }

    # find the previous revision, or 1.0 if none
    public method getPrevRev {rev} {
        set parts [split $rev .]
        set lastIdx [expr [llength $parts]-1]
        set last [lvarpop parts $lastIdx]
        if {$last == 1} {
            set prevRev [getRevisionParent $rev]
            if {[lempty $prevRev]} {
                # will generate diff for original commit
                set prevRev 1.0
            }
        } else {
            set prevRev [join [concat $parts [expr $last-1]] .]
        }
        return $prevRev
    }

    # Translate a revision specification:
    #   - Tag names are translated to revisions (HEAD is supported)
    #   - Revision numbers are returned as-is
    #   - Branch revisions are returned as the head.
    public method translateRevision {revSpec} {
        return [translateBranchMagic [toRevision $revSpec]]
    }

    # Get the list of revision numbers on this file
    public method getRevisions {} {
        return $fRevisions
    }

    # Get a revision record.
    # Returns: {rev dateTime author state comment}
    public method getRevision {revSpec} {
        set rev [translateRevision $revSpec]
        if {![info exists fRevisionTable($rev)]} {
            error "invalid revision specification: \"$revSpec\""
        }
        return $fRevisionTable($rev)
    }


    # Find most-recent dead for handling resurrections
    #  or return "" if none. Scans backwards from to-tag rev passed in.
    public method mostRecentDead {rev} {
	while {$rev!="1.0"} {
    	    set frev [getRevision $rev]
	    set state [lindex $frev 3]
	    if {$state=="dead"} {
		return $rev
	    }
	    set rev [getPrevRev $rev]
	}
	return {}
    }

    # find max rev on the given branch
    private method getMaxRevOnBranch {branch minRev} {
        set maxRev $minRev
        foreach rev $fRevisions {
            if {([getRevisionBranch $rev] == $branch) && ([compareRevs $rev $maxRev] > 0)} {
                set maxRev $rev
            }
        }
        return $maxRev
    }

    # get list of revisions in the specified range (from < rev <= to)
    # handles toSpec being a branch magic tag.  fromSpec can be empty
    # if toSpec is branch magic tag
    public method getRevsForRange {fromSpec toSpec} {
        
        # convert to range of revisions, without errors if uknown tag
        set fromRev [toRevision $fromSpec 0]
        set toRev [toRevision $toSpec 0]

        if {($fromRev == {}) && ($toRev == {})} {
            return {}  ;# nothing in this range
        }

        if {$fromRev == {}} {
            # no from tag/revision, use branch
            if {[isBranchOrMagic $toRev]} {
                set fromRev [getRevisionParent $toRev] ;# get branch point
            } else {
                set fromRev 1.0  ;# just added
            }
        }
        if {$toRev == {}} {
            # deleted before second tag
            set toRev [getMaxRevOnBranch [getRevisionBranch $fromRev] $fromRev]
        }
        
        # convert to start and end revisions on the same branch
        if {[isBranchOrMagic $toRev]} {
            lassign [getBranchRevRange $toRev] startRev endRev
            if {$startRev == {}} {
                return {} ;# no commits in range
            }
            set toRev $endRev
        }
        
        # find revisions on the same branch as toRev and in range
        set toBranch [getRevisionBranch $toRev]
        set revs {}
        foreach rev $fRevisions {
            if {([getRevisionBranch $rev] == $toBranch)
                && ([compareRevs $fromRev $rev] < 0)
                && ([compareRevs $rev $toRev] <= 0)} {
                lappend revs $rev
            }
        }
        return $revs
    }
    
    # Convert to a printable string for debugging
    public method toString {{indent 0}} {
        set indentStr [replicate " " $indent]
        set indent2Str "$indentStr    "
        append str $indentStr "fRcsFile=$fRcsFile\n"
        foreach var {fWorkingFile fHead fBranch fKeywordSubst} {
            append str $indent2Str "$var=[set $var]\n"
        }
        foreach br [lsort [array names fBranchTable]] {
            append str $indent2Str "branch=[list $br $fBranchTable($br)]\n"
        }

        foreach tag $fTags {
            append str $indent2Str "tag=[list $tag $fTagTable($tag)]\n"
        }

        foreach rev $fRevisions {
            set revInfo "$rev $fRevisionTable($rev)"
            regsub -all {\n} $revInfo {\n} revInfo
            append str $indent2Str "rev=$revInfo\n"
        }
        return $str
    }
}


package require Itcl

#
# Class to do invoke CVS
#
::itcl::class CVSInvoke {
    private variable fRepository
    private variable fModule
    private variable fWorkDir
    private variable fDebug 0

    # Create for accessing the specified repository.  repository and module
    # maybe null depending on what commands are used.
    constructor {repository module workDir} {
        if {![lempty $repository]} {
            set fRepository $repository
        }
        if {![lempty $module]} {
            set fModule $module
        }
        set fWorkDir $workDir
    }

    # enable/disable debug tracing
    public method setDebug {val} {
        set fDebug $val
    }

    # evaluate a command in the working directory
    private method workDirEval {cmd} {
        set cwd [pwd]
        if {$fDebug} {
            puts stderr "cd $fWorkDir"
        }
        cd $fWorkDir
        if {[catch {
            set result [uplevel $cmd]
        } msg]} {
            cd $cwd
            error $msg $::errorInfo $::errorCode
        }
        cd $cwd
        return $result
    }

    # execute a cvs command 
    private method cvsExec {argv} {
        if {$fDebug} {
            puts stderr [join $argv]
        }
        return [eval exec $argv]
    }

    # open a pipe from a command
    private method cvsOpen {argv} {
        if {$fDebug} {
            puts stderr [join [concat | $argv]]
        }
        return [open [concat | $argv 2>@stderr]]
    }

    # throw an error including a cvs commit
    private method throwError {cvsCmd} {
        error "$cvsCmd\n$::errorResult" $::errorInfo $::errorCode
    }
    
    # update the working directory
    public method update {} {
        set cmd [list cvs -Q update -kk -dP]
        try_eval {
            workDirEval {
                cvsExec $cmd
            }
        } {
            throwError $cmd
        }
    }

    # read file info objects from a cvs log stream
    private method readFileInfo {chan {modulePath {}}} {
        set infoObjs {}
        while {![lempty [set obj [CVSFileInfo::readCvsLogRec $chan $modulePath]]]} {
            lappend infoObjs $obj
        }
        return $infoObjs
    }

    # do an rlog, return a list of CVSFileInfo objects
    public method getRLogInfo {} {
        # construct actually part to module dir, this is needed because we are
        # doing an rlog and need to compute the work directory
        set cwd [pwd]
        cd $fRepository/$fModule
        set modulePath [pwd]
        cd $cwd
        
        set cmd [list cvs -q -d $fRepository rlog $fModule]
        try_eval {
            set chan [cvsOpen $cmd]
            set infoObjs [readFileInfo $chan $modulePath]
            close $chan
        } {
            throwError $cmd
        } {
            catch {close $chan}
        }
        return $infoObjs
    }

    # do an log, return a list of CVSFileInfo objects
    public method getLogInfo {{fileSubset {}}} {
        set cwd [pwd]
        
        set cmd [list cvs -q log]
        if {$fileSubset != {}} {
            set cmd [concat $cmd $fileSubset]
        }
        try_eval {
            workDirEval {
                set chan [cvsOpen $cmd]
                set infoObjs [readFileInfo $chan]
                close $chan
            }
        } {
            throwError $cmd
        } {
            catch {close $chan}
        }
        return $infoObjs
    }

    # return -r or -D for a revision
    private proc getRevFlag {rev} {
        if {[regexp {[-/]} $rev]} {
            return -D
        } else {
            return -r
        }
    }

    # do unified context diff on a file, requires a working directory
    # rev1 of 1.0 for a new file, rev maybe a file or date.  rev2 maybe
    # empty.
    public method uniDiff {contextSize rev1 rev2 file} {


	# disabling for now
        ## -r 1.0 no longer accepted by new cvs diff
        ## maybe BASE work instead? (still needs -N)
        #if {$rev1 == 1.0} {
        #    set rev1 "BASE"
        #}

        # -N required to make -r 1.0 work
        set cmd [list cvs -q diff -bB -U$contextSize -kk -N]
        lappend cmd [getRevFlag $rev1] $rev1
        if {![lempty $rev2]} {
            lappend cmd [getRevFlag $rev2] $rev2
        }
        lappend cmd $file
        try_eval {
            workDirEval {
                # only way to determine if an error occured vs diff exit 1
                # is to check stderr
                set errTmp /var/tmp/err.[pid].tmp
                catch {
                    lappend cmd 2> $errTmp
                    cvsExec $cmd
                } diff
                if {![file exists $errTmp]} {
                    error $diff
                }
                if {[file size $errTmp] != 0} {
                    set errMsg [read_file $errTmp]
		    if {[string first "obtained lock in" $errTmp] == -1} {
			progress "error: command=[$cmd]"
			file delete $errTmp
			error $errMsg
		    }
                }
                file delete $errTmp
            }
        } {
            throwError $cmd
        }
        regsub {child process exited abnormally$} $diff {} diff
        return $diff
    }
}

# convert date/time string to sec
proc cnvDateTime {dateStr} {
    # Tcl clock wants dates in form 2003-01-30
    regsub -all / $dateStr - dateStr
    return [clock scan $dateStr]
}

# format a date 
proc fmtDate {date} {
    return [clock format $date -format %F]
}

# encode a string as HTML test
proc htmlEncode {text} {
    regsub -all {&} $text {\&amp;} text
    regsub -all {<} $text {\&lt;} text
    regsub -all {>} $text {\&gt;} text
    return $text
}

set gDiffStyle {
<LINK REL="STYLESHEET" HREF="/style/cvs_reports.css">
}

# HTML format a diff; desc should be HTML-ized.
proc mkHtmlDiff {outHtml fileInfo title desc diff} {
    # include rev and user
    set fh [open $outHtml.tmp w]
    puts $fh "<HTML><HEAD><TITLE>$title</TITLE>"
    puts $fh $::gDiffStyle
    puts $fh "</HEAD>"
    puts $fh "<BODY BGCOLOR=white>"
    puts $fh "<H1>$title</H1>"
    puts $fh $desc
    puts $fh "<PRE>"

    set diff [htmlEncode $diff]
    regsub -all -line {^!.*$} $diff {<SPAN class=repl>\0</SPAN>} diff
    regsub -all -line {^-.*$} $diff {<SPAN class=del>\0</SPAN>} diff
    regsub -all -line {^\+.*$} $diff {<SPAN class=add>\0</SPAN>} diff
    regsub -all -line {^@@.*$} $diff {<SPAN class=begin>\0</SPAN>} diff
    puts $fh $diff

    puts $fh "</PRE>"
    puts $fh "</BODY>"
    puts $fh "</HTML>"
    close $fh
    file rename -force $outHtml.tmp $outHtml
}

# Count number of changes lines
proc cntDiffChgs {diff} {
    set changes 0
    set adds 0
    set replaces 0
    set deletes 0
    set inChgBlock 0
    foreach line [split $diff \n] {
        set wasInChgBlock $inChgBlock
        switch -glob -- $line {
            +++* -
            ---* {
                set inChgBlock 0
            }
            +* {
                incr adds
                set inChgBlock 1
            }
            -* {
                incr deletes
                set inChgBlock 1
            }
            !* {
                incr replaces
                set inChgBlock 1
            }
            default {
                set inChgBlock 0
            }
        }
        if {$wasInChgBlock && !$inChgBlock} {
            incr changes [expr max($adds,$deletes)+$replaces]
            set adds 0
            set replaces 0
            set deletes 0
        }
    }
    if ($inChgBlock) {
        incr changes [expr max($adds,$deletes)+$replaces]
    }
    return $changes
}

# generate diffs for a revision as txt and html.  If it already
# exists, just return the files relative to outdir.  Type is
# context or full.  Also returns the diff text.
proc mkFileDiff {outDir fileInfo rev1 rev2 title desc type} {
    set srcFile [$fileInfo getWorkingFile]
    if {$rev1 == $rev2} {
        error "mkFileDiff $srcFile must have different recs, got $rev1 == $rev2"
    }
    if {$type == "full"} {
        set relBase full/$srcFile.$rev1-$rev2
        set contentSize 1000000
    } else {
        set relBase context/$srcFile.$rev1-$rev2
        set contentSize 4
    }

    set outTxtRel $relBase.diff
    set outTxt $outDir/$outTxtRel

    set outHtmlRel $relBase.html
    set outHtml $outDir/$outHtmlRel

    if {[file exists $outTxt] || [file exists $outHtml]} {
        # cached
	if {$type == "context"} {
    	    return [list $outTxtRel $outHtmlRel [read_file $outTxt]]
	} else {
	    return [list $outTxtRel $outHtmlRel]
	}
    }
    set diff [$::gCvsInvoke uniDiff $contentSize $rev1 $rev2 $srcFile]
    file mkdir [file dirname $outHtml]

    write_file $outTxt.tmp $diff 
    file rename -force $outTxt.tmp $outTxt
  
    mkHtmlDiff $outHtml $fileInfo $title $desc $diff
    return [list $outTxtRel $outHtmlRel $diff]
}

# Generate diffs and output the links.  Returns {htmlLinks chgCount}
proc mkDiffs {outDir fileInfo rev1 rev2 title desc} {
    lassign [mkFileDiff $outDir $fileInfo $rev1 $rev2 $title $desc context] \
        contextTxtRel contextHtmlRel diffs
    lassign [mkFileDiff $outDir $fileInfo $rev1 $rev2 $title $desc full] \
        fullTxtRel fullHtmlRel

    set chgCnt [cntDiffChgs $diffs]
    set links "lines changed: $chgCnt,\
               context: <A HREF=\"$contextHtmlRel\">html</A>,\
                    <A HREF=\"$contextTxtRel\">text</A>, \
               full: <A HREF=\"$fullHtmlRel\">html</A>,\
                    <A HREF=\"$fullTxtRel\">text</A>"
    return [list $links $chgCnt]
}

# returns {htmlLinks chgCnt}
proc mkCommitDiffs {outDir fileInfo revInfo} {
    set title "[$fileInfo getWorkingFile] [lindex $revInfo 0]"
    set desc1 [htmlEncode [join [lrange $revInfo 0 2]]]
    set desc2 [htmlEncode [lindex $revInfo 4]]
    set desc "$desc1<br>$desc2"
    set rev2 [lindex $revInfo 0]
    set rev1 [$fileInfo getPrevRev $rev2]
    return [mkDiffs $outDir $fileInfo $rev1 $rev2 $title $desc]
}

# write index page of commits for a file
proc fileReport {fh outDir fileInfo revisions} {
    set totalChgCnt 0
    puts $fh "<LI> [$fileInfo getWorkingFile]"
    puts $fh "<UL>"
    foreach rev $revisions {
        set revInfo [$fileInfo getRevision $rev]
        lassign [mkCommitDiffs $outDir $fileInfo $revInfo] diffLinks chgCnt
        puts $fh "<LI> $rev $diffLinks<br>"
        puts $fh [htmlEncode [lindex $revInfo 4]]
        incr totalChgCnt $chgCnt
    }
    puts $fh "</UL>"
    return $totalChgCnt
}

# returns {htmlLinks chgCnt}
proc mkRangeDiffs {outDir fileInfo revInfo1 revInfo2} {
    set rev1 [lindex $revInfo1 0]
    set rev2 [lindex $revInfo2 0]
    set title "[$fileInfo getWorkingFile] $rev1 - $rev2"
    return [mkDiffs $outDir $fileInfo $rev1 $rev2 $title ""]
}

# write file info for change on a range of revisions
proc fileRangeReport {fh outDir fileInfo revisions} {
    set rev1 [$fileInfo getPrevRev [lindex $revisions end]]
    set rev2 [lindex $revisions 0]
    set revInfo1 [$fileInfo getRevision $rev1]
    set revInfo2 [$fileInfo getRevision $rev2]
    lassign [mkRangeDiffs $outDir $fileInfo $revInfo1 $revInfo2] diffLinks chgCnt
    puts $fh "<LI> [$fileInfo getWorkingFile] $rev1 - $rev2 $diffLinks"
    return $chgCnt
}

# write a report for a user in file and revision order
proc userReportByFile {outDir title2 user userInfo rangeDiffs} {
    set userDir $outDir/$user
    file mkdir $userDir
    if {$rangeDiffs} {
        set switchAnchor ""
        set fh [open $userDir/index.html w]
    } else {
        set switchAnchor "switch to: <a href=\"index.html\">grouped by commit view</a>, <a href=\"../../index.html\">user index</a><br>"
        set fh [open $userDir/index-by-file.html w]
    }

    set title "$user: changes by file"
    puts $fh "<html><head><title>$title</title></head><body>"
    puts $fh "<h1>$title</h1>"
    puts $fh $switchAnchor

    puts $fh "<h3>$title2</h3>"
    puts $fh "<ul>"
    set totalChgCnt 0
    foreach fileRec $userInfo {
        lassign $fileRec fileInfo revisions
        if {$rangeDiffs} {
            set chgCnt [fileRangeReport $fh $userDir $fileInfo $revisions]
        } else {
            set chgCnt [fileReport $fh $userDir $fileInfo $revisions]
        }
        incr totalChgCnt $chgCnt
    }
    puts $fh "</ul>"
    puts $fh $switchAnchor
    puts $fh "</body></html>"
    close $fh
    return $totalChgCnt
}

# generate list of files by commit message
# {commit {{fileInfo revision} ..} }
proc sortByCommit {userInfo} {
    # build tmp table
    foreach fileRec $userInfo {
        lassign $fileRec fileInfo revisions
        foreach rev $revisions {
            set revInfo [$fileInfo getRevision $rev]
            set commit [string trim [lindex $revInfo 4]]

            # save file for sort
            lappend byCommit($commit) [list [$fileInfo getWorkingFile] $fileInfo $rev]
            # save lowest date/time for commit sort
            set time [lindex $revInfo 1]
            if {![info exists commitTimes($commit)]
                || ([string compare $time $commitTimes($commit)] > 0)} {
                set commitTimes($commit) $time
            }
        }
    }

    # Sort commits by time
    set commitTimeList {}
    foreach commit [array names commitTimes] {
        lappend commitTimeList [list $commitTimes($commit) $commit]
    }
    set commitTimeList [lsort -index 0 $commitTimeList]

    # now create commit list, sort each commit by file name
    set commits {}
    foreach commitTime $commitTimeList {
        set commit [lindex $commitTime 1]
        set commitInfo {}
        foreach fileRec [lsort -index 0 $byCommit($commit)] {
            lappend commitInfo [lrange $fileRec 1 2]
        }
        lappend commits [list $commit $commitInfo]
    }
    return $commits
}

# write commit info
proc userCommitReport {fh outDir commit commitInfo} {
    puts $fh "<LI> [htmlEncode $commit]"
    puts $fh "<UL>"

    foreach fileRec $commitInfo {
        lassign $fileRec fileInfo rev
        set revInfo [$fileInfo getRevision $rev]

        lassign [mkCommitDiffs $outDir $fileInfo $revInfo] diffLinks chgCnt
        puts $fh "<LI> [$fileInfo getWorkingFile] $rev - $diffLinks"
	
    }
    puts $fh "</UL>"
}

# write a report for a user grouped by commit
proc userReportByCommit {outDir title2 user userCommits} {
    set userDir $outDir/$user
    file mkdir $userDir
    set switchAnchor "switch to <a href=\"index-by-file.html\">grouped by file view</a>, <a href=\"../../index.html\">user index</a><br>"

    set fh [open $userDir/index.html w]
    set title "$user: changes by commit"
    puts $fh "<html><head><title>$title</title></head><body>"
    puts $fh "<h1>$title</h1>"
    puts $fh $switchAnchor

    puts $fh "<h3>$title2</h3>"
    puts $fh "<ul>"
    foreach commitRec $userCommits {
        userCommitReport $fh $userDir [lindex $commitRec 0] [lindex $commitRec 1]
    }
    puts $fh "</ul>"
    puts $fh $switchAnchor
    puts $fh "</body></html>"
    close $fh
}

proc genUserReports {outDir title2 userTableVar numChangedFiles rangeDiffs} {
    upvar $userTableVar userTable
    progress "sorting commit information"
    foreach u [array names userTable] {
        set userCommits($u) [sortByCommit $userTable($u)]
    }
    progress "generating user reports"

    exec rm -rf $outDir
    file mkdir $outDir
    set index $outDir/index.html
    set fh [open $index.tmp w]
    set title "CVS changes by user"

    puts $fh "<html><head><title>$title</title></head><body>"
    puts $fh "<h1>$title</h1>"
    puts $fh "<h2>$title2</h2>"
    puts $fh "<ul>"
    set totalChgCnt 0
    foreach u [lsort [array names userTable]] {
        set chgCnt [userReportByFile $outDir $title2 $u $userTable($u) $rangeDiffs]
        if {!$rangeDiffs} {
            userReportByCommit $outDir $title2 $u $userCommits($u)
        }
        incr totalChgCnt $chgCnt
        set numFiles [llength $userTable($u)]
        puts $fh "<LI> <A HREF=\"$u/index.html\">$u</A> - changed lines: $chgCnt, files: $numFiles"
    }
    puts $fh "</ul>"
    puts $fh "<ul>"
    puts $fh "<li> lines changed: $totalChgCnt"
    puts $fh "<li> files changed: $numChangedFiles"
    puts $fh "</ul>"
    puts $fh "</body></html>"
    close $fh
    file rename -force $index.tmp $index
    return $totalChgCnt
}

proc genFileReports {outDir title2 fileTableVar lineChgCount rangeDiffs} {
    upvar $fileTableVar fileTable

    progress "generating file reports"
    exec rm -rf $outDir
    file mkdir $outDir
    set index $outDir/index.html
    set fh [open $index.tmp w]
    set title "CVS changes by file"

    puts $fh "<html><head><title>$title</title></head><body>"
    puts $fh "<h1>$title</h1>"
    puts $fh "<h2>$title2</h2>"
    puts $fh "<ul>"
    foreach f [lsort [array names fileTable]] {
        lassign $fileTable($f) fileInfo revisions
        if {$rangeDiffs} {
            fileRangeReport $fh $outDir $fileInfo $revisions
        } else {
            fileReport $fh $outDir $fileInfo $revisions
        }
    }
    puts $fh "</ul>"
    puts $fh "<ul>"
    puts $fh "<li> lines changed: $lineChgCount"
    puts $fh "<li> files changed: [array size fileTable]"
    puts $fh "</ul>"
    puts $fh "</body></html>"
    close $fh
    file rename -force $index.tmp $index
}

# check if fromTag is brach point of toTag
proc isRevParent {fileInfo fromTag toTag} {
    return [expr {[$fileInfo getRevisionParent $toTag] == [lindex [$fileInfo getRevision $fromTag] 0]}]
}

proc isSameBranch {fileInfo fromTag toTag} {
    return [expr {[$fileInfo getRevisionBranch $fromTag] == [$fileInfo getRevisionBranch $toTag]}]
}

# Code will lose stuff if fromTag is not branch point of toTag or if
# fromTag and toTag are on different branches.  Check if tags are ok
proc checkRevTags {fileInfo fromTag toTag} {
    # only check if file contans revision, and fromTag doesn't specify the base
    if {![lempty $fromTag] && [$fileInfo hasRevision $fromTag] && [$fileInfo hasRevision $toTag]} {
        if {!([isRevParent $fileInfo $fromTag $toTag] || [isSameBranch $fileInfo $fromTag $toTag])} {
            error "[$fileInfo getWorkingFile] fromTag $fromTag not on same branch as toTag $toTag or fromTag is not point branch point for two"
        }
    }
}

# select and sort by user add to use table
# user table are entries of {{fileObj {rev ...} ...}
# file table entries are {fileObj {rev ...}}
proc selectFileRevs {fileInfo userTableVar fileTableVar fromTag toTag} {
    upvar $userTableVar userTable $fileTableVar fileTable

    checkRevTags $fileInfo $fromTag $toTag

    # sort revisions out by users
    set selectRevs [$fileInfo getRevsForRange $fromTag $toTag]
    
    # partition revisions my user
    foreach rev $selectRevs {
        lappend byUser([lindex [$fileInfo getRevision $rev] 2]) $rev
    }

    # add to tables
    foreach u [array names byUser] {
        lappend userTable($u) [list $fileInfo $byUser($u)]
    }
    if {![lempty $selectRevs]} {
        set fileTable([$fileInfo getWorkingFile]) [list $fileInfo $selectRevs]
    }
}

proc makeIndexPage {outDir title2 module} {
    file mkdir $outDir
    set index $outDir/index.html
    set fh [open $index.tmp w]
    set title "CVS changes: $module"

    puts $fh "<html><head><title>$title</title></head><body>"
    puts $fh "<h1>$title</h1>"
    puts $fh "<h2>$title2</h2>"
    puts $fh {
<ul>
<li><a href="user/index.html">Changes by user</a>
<li><a href="file/index.html">Changes by file</a>
</ul>
</body>
</html>
}
    close $fh
    file rename -force $index.tmp $index
}

proc makeHelpPage {outDir} {
    file mkdir $outDir
    set help $outDir/help.html
    set fh [open $help.tmp w]
    puts $fh {<html><head><title>CVS Reports</title></head><body>
<h1>CVS Reports</h1>
<h2>Content diffs</h3>
Two types of diffs are produced:
<ul>
<li> Unified contexts diffs - shows the changes and surrounding
     few lines.
<li> Full diffs - unified diffs in context of the entire file. 
     For user reports, this is the file after the change,
     not the current version of the file.  For file reports,
     this is all changes over the time period.
</ul>
The diffs are in two formats:
<ul>
<li> HTML with changes color coded.
<li> ASCII text, useful for emacs.
</ul>

<p>
The <code>changed</code> line counts are derived by examining the diffs.
Blocks of deletes followed by inserts are considered replacements,
so the change count is the larger of the delete count and add count.
</body>
</html>
}
    close $fh
    file rename -force $help.tmp $help
}

proc getFileRevs {infoList userTableVar fileTableVar fromTag toTag} {
    upvar $userTableVar userTable $fileTableVar fileTable
    progress "sorting revision information"
    foreach f $infoList {
        selectFileRevs $f userTable fileTable $fromTag $toTag
    }
}

proc genReports {outDir title2 module infoList fromTag toTag rangeDiffs} {
    getFileRevs $infoList userTable fileTable $fromTag $toTag
    exec rm -rf $outDir/user.new
    set lineChgCount [genUserReports $outDir/user.new $title2 userTable [array size fileTable] $rangeDiffs]
    exec rm -rf $outDir/user
    file rename $outDir/user.new $outDir/user

    exec rm -rf $outDir/file.new
    genFileReports $outDir/file.new $title2 fileTable $lineChgCount $rangeDiffs
    exec rm -rf $outDir/file
    file rename $outDir/file.new $outDir/file

    makeIndexPage $outDir $title2 $module
}

#
# Entry
#
set gUsage {cvs-reports [options] workdir outDir
   
options:
   -start date - Starting date, in the form 2003/02/30 or 2003-02-30
   -verbose - Generate progress messages
   -from fromTag
   -to toTag
   -fromDate date - only used in title
   -toDate date - only used in title
   -branchVersion version  - only used in title
   -rangeDiffs - do just per-file diffs for target range, rather than per-commit
   -debug
   -no-update - don't do a cvs update on working directory
   -file path - only operate on path, relative to the working directory.
    Mainly for debugging, maybe repeated.

fromTag can be a tag made at the branch point and toTag the branch tag
}

#
# Usage error.
#
proc usage {{msg {}}} {
    if {![lempty $msg]} {
        puts stderr "Error: $msg"
    }
    puts stderr $::gUsage
    exit 1
}

proc progress {msg} {
    if {$::gVerbose} {
        catch {
            puts "$msg"
            flush stdout
        }
    }
}

# these will be calculated from value(s) passed in
set toTag {}
set toTagDate {}
set fromTag {}
set fromTagDate {}
set branchVersion {}
set rangeDiffs 0
set fileSubset {}

set gVerbose 0
set debug 0
set doUpdate 1

while {[string match -* [lindex $argv 0]]} {
    set opt [lvarpop argv]
    switch -- $opt {
        -from {
            if {[lempty $argv]} {
                usage "-from requires an argument"
            }
            set fromTag [lvarpop argv]
        }
        -to {
            if {[lempty $argv]} {
                usage "-to requires an argument"
            }
            set toTag [lvarpop argv]
	}
        -fromDate {
            if {[lempty $argv]} {
                usage "-fromDate requires an argument"
            }
            set fromTagDate [lvarpop argv]
        }
        -toDate {
            if {[lempty $argv]} {
                usage "-toDate requires an argument"
            }
            set toTagDate [lvarpop argv]
	}
        -whichReport {
            puts stderr "WARNING: -whichReport is no longer used"
            if {[lempty $argv]} {
                usage "-whichReport requires an argument"
            }
            lvarpop argv
	}
        -branchVersion {
            if {[lempty $argv]} {
                usage "-branchVersion requires an argument"
            }
            set branchVersion [lvarpop argv]
	}
        -verbose {
            set gVerbose 1
        }
        -rangeDiffs {
            set rangeDiffs 1
        }
        -debug {
            set debug 1
        }
        -no-update {
            set doUpdate 0
        }
        -file {
            if {[lempty $argv]} {
                usage "-file requires an argument"
            }
            lappend fileSubset [lvarpop argv]
	}

        default {
            usage "Invalid option \"$opt\""
        }
    }
}
if {[llength $argv] != 2} {
    usage "wrong \# args"
}
lassign $argv workDir outDir
if {![file isdir $workDir]} {
    usage "workdir does not exists: $workDir"
}

# make sure directory write perms are maintained
umask 0002

# get module from workDir for use in messages
set module [string trim [read_file $workDir/CVS/Repository]]

set gCvsInvoke [CVSInvoke \#auto {} $module $workDir]
$gCvsInvoke setDebug $debug

progress "starting from-tag $fromTag"
progress "  ending   to-tag $toTag"
if {$fromTagDate != {}} {
    progress "starting from-tag-date $fromTagDate"
}
if {$toTagDate != {}} {
    progress "  ending   to-tag-date $toTagDate"
}
if {$branchVersion != {}} {
    progress " branch version: $branchVersion"
}

if {$doUpdate} {
    # update the working directory (if rdiff supported -U to specify context
    # size, we wouldn't need a working dir)
    progress "updating cvs working directory for $module"
    $gCvsInvoke update
}

progress "collecting cvs change logs for $module"
set infoList [$gCvsInvoke getLogInfo $fileSubset]
set title2 "$fromTag to $toTag"
if {![lempty $fromTag]} {
    append title2 " ($fromTagDate to $toTagDate)"
}
append title2 " $branchVersion"
genReports $outDir $title2 $module $infoList $fromTag $toTag $rangeDiffs

progress "cvs report generation complete"

# Local Variables: **
# mode: tcl **
# End: **