df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Repository management (CVS) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Requirements df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: package require Tcl 8.4 df91d389d5 2007-09-04 aku: package require fileutil ; # Tcllib (cat) df91d389d5 2007-09-04 aku: package require rcsparser ; # Handling the RCS archive files. df91d389d5 2007-09-04 aku: package require struct::tree df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # API df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Define repository directory. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::at {path} { df91d389d5 2007-09-04 aku: variable base [file normalize $path] df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # Toplevel repository directory df91d389d5 2007-09-04 aku: variable base {} df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Define logging callback command df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::feedback {logcmd} { df91d389d5 2007-09-04 aku: variable lc $logcmd df91d389d5 2007-09-04 aku: ::rcsparser::feedback $logcmd df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Scan repository, collect archives, parse them, and collect revision df91d389d5 2007-09-04 aku: # information (file, revision -> date, author, commit message) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::scan {} { df91d389d5 2007-09-04 aku: variable base df91d389d5 2007-09-04 aku: variable npaths df91d389d5 2007-09-04 aku: variable rpaths df91d389d5 2007-09-04 aku: variable timeline df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Scanning CVS tree $base" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set n 0 df91d389d5 2007-09-04 aku: foreach rcs [fileutil::findByPattern $base -glob *,v] { df91d389d5 2007-09-04 aku: set rcs [fileutil::stripPath $base $rcs] df91d389d5 2007-09-04 aku: # Now rcs is relative to base df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " Parsing archive $rcs" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {[string match CVSROOT* $rcs]} { df91d389d5 2007-09-04 aku: Log info " => Ignoring admin file" df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Derive the regular path from the rcs path. Meaning: Chop of df91d389d5 2007-09-04 aku: # the ",v" suffix, and remove a possible "Attic". df91d389d5 2007-09-04 aku: set f [string range $rcs 0 end-2] df91d389d5 2007-09-04 aku: if {"Attic" eq [lindex [file split $rcs] end-1]} { df91d389d5 2007-09-04 aku: set f [file join [file dirname [file dirname $f]] [file tail $f]] df91d389d5 2007-09-04 aku: if {[file exists $base/$f,v]} { df91d389d5 2007-09-04 aku: # We have a regular archive and an Attic archive df91d389d5 2007-09-04 aku: # refering to the same user visible file. Ignore the df91d389d5 2007-09-04 aku: # file in the Attic. df91d389d5 2007-09-04 aku: Log info " => Ignoring attic for regular archive" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # TODO/CHECK. My method of co'ing exact file revisions df91d389d5 2007-09-04 aku: # per the info in the collected csets has the flaw df91d389d5 2007-09-04 aku: # that I may have to know exactly when what archive df91d389d5 2007-09-04 aku: # file to use, see above. It might be better to use df91d389d5 2007-09-04 aku: # the info only to gather when csets begin and end, df91d389d5 2007-09-04 aku: # and then to co complete slices per exact timestamp df91d389d5 2007-09-04 aku: # (-D) instead of file revisions (-r). The flaw in df91d389d5 2007-09-04 aku: # that is that csets can occur in the same second df91d389d5 2007-09-04 aku: # (trf, memchan - check for examples). For that exact df91d389d5 2007-09-04 aku: # checkout may be needed to recreate exact sequence of df91d389d5 2007-09-04 aku: # changes. Grr. Six of one ... df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Get the meta data we need (revisions, timeline, messages). df91d389d5 2007-09-04 aku: set meta [::rcsparser::process $base/$rcs] df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " => $f" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set npaths($rcs) $f df91d389d5 2007-09-04 aku: set rpaths($f) $rcs df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: array set p $meta df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {rev ts} $p(date) {_ a} $p(author) {_ cm} $p(commit) {_ st} $p(state) { df91d389d5 2007-09-04 aku: set op [expr {($rev eq "1.1") ? "A" : "M"}] df91d389d5 2007-09-04 aku: if {$st eq "dead"} {set op "R"} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # A dead-first revision is rev 1.1 with op R. For an df91d389d5 2007-09-04 aku: # example see the file memchan/DEPENDENCIES. Such a file df91d389d5 2007-09-04 aku: # seems to exist only! on its branch. The branches df91d389d5 2007-09-04 aku: # information is set on the revision (extend rcsparser!), df91d389d5 2007-09-04 aku: # symbols has a tag, refering to a branch, possibly magic. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {($rev eq "1.1") && ($op eq "R")} { df91d389d5 2007-09-04 aku: Log info " => Dead first" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: lappend timeline($ts) [list $op $ts $a $rev $f $cm] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #unset p(commit) df91d389d5 2007-09-04 aku: #parray p df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: incr n df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Processed $n [expr {($n == 1) ? "file" : "files"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # Path mappings. npaths: rcs file -> user file df91d389d5 2007-09-04 aku: # rpaths: user file -> rcs file, dead-status df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable npaths ; array set npaths {} df91d389d5 2007-09-04 aku: variable rpaths ; array set rpaths {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Timeline: tstamp -> (op, tstamp, author, revision, file, commit message) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable timeline ; array set timeline {} df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Group single changes into changesets df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::csets {} { df91d389d5 2007-09-04 aku: variable timeline df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable ncs df91d389d5 2007-09-04 aku: variable cmap df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: array unset csets * ; array set csets {} df91d389d5 2007-09-04 aku: array unset cmap * ; array set cmap {} df91d389d5 2007-09-04 aku: set ncs 0 df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Processing timeline" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set n 0 df91d389d5 2007-09-04 aku: CSClear df91d389d5 2007-09-04 aku: foreach ts [lsort -dict [array names timeline]] { df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # op tstamp author revision file commit df91d389d5 2007-09-04 aku: # 0 1 2 3 4 5/end df91d389d5 2007-09-04 aku: # b c a df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set entries [lsort -index 2 [lsort -index 0 [lsort -index end $timeline($ts)]]] df91d389d5 2007-09-04 aku: #puts [join $entries \n] df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach entry $entries { df91d389d5 2007-09-04 aku: if {![CSNone] && [CSNew $entry]} { df91d389d5 2007-09-04 aku: CSSave df91d389d5 2007-09-04 aku: CSClear df91d389d5 2007-09-04 aku: #puts ==\n$reason df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: CSAdd $entry df91d389d5 2007-09-04 aku: incr n df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Processed $n [expr {($n == 1) ? "entry" : "entries"}]" df91d389d5 2007-09-04 aku: set n [array size csets] df91d389d5 2007-09-04 aku: Log info "Found $n [expr {($n == 1) ? "changeset" : "changesets"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # Changeset data: df91d389d5 2007-09-04 aku: # ncs: Counter-based id generation df91d389d5 2007-09-04 aku: # csets: id -> (user commit start end depth (file -> (op rev))) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable ncs ; set ncs 0 ; # Counter for changesets df91d389d5 2007-09-04 aku: variable csets ; array set csets {} ; # Changeset data df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Building the revision tree from the changesets. df91d389d5 2007-09-04 aku: # Limitation: Currently only trunk csets is handled. df91d389d5 2007-09-04 aku: # Limitation: Dead files are not removed, i.e. no 'R' actions right now. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::rtree {} { df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable rtree {} df91d389d5 2007-09-04 aku: variable ntrunk 0 df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Extracting the trunk" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set rtree [struct::tree ::cvs::RT] df91d389d5 2007-09-04 aku: $rtree rename root 0 ; # Root is first changeset, always. df91d389d5 2007-09-04 aku: set trunk 0 df91d389d5 2007-09-04 aku: set ntrunk 1 ; # Root is on the trunk. df91d389d5 2007-09-04 aku: set b 0 ; # No branch csets found yet. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Extracting the trunk is easy, simply by looking at the involved df91d389d5 2007-09-04 aku: # version numbers. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach c [lrange [lsort -integer [array names csets]] 1 end] { df91d389d5 2007-09-04 aku: foreach {u cm s e rd f} $csets($c) break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Ignore branch changes, just count them for the statistics. df91d389d5 2007-09-04 aku: if {$rd != 2} { df91d389d5 2007-09-04 aku: incr b df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Trunk revision, connect to, and update the head. df91d389d5 2007-09-04 aku: $rtree insert $trunk end $c df91d389d5 2007-09-04 aku: set trunk $c df91d389d5 2007-09-04 aku: incr ntrunk df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]" df91d389d5 2007-09-04 aku: Log info "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # Tree holding trunk and branch information (struct::tree). df91d389d5 2007-09-04 aku: # Node names are cset id's. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable rtree {} df91d389d5 2007-09-04 aku: variable ntrunk 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::workspace {} { df91d389d5 2007-09-04 aku: variable cwd [pwd] df91d389d5 2007-09-04 aku: variable workspace [fileutil::tempfile importF_cvs_ws_] df91d389d5 2007-09-04 aku: file delete $workspace df91d389d5 2007-09-04 aku: file mkdir $workspace df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " Workspace: $workspace" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: cd $workspace ; # Checkouts go here. df91d389d5 2007-09-04 aku: return $workspace df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::wsignore {path} { df91d389d5 2007-09-04 aku: # Ignore CVS admin files. df91d389d5 2007-09-04 aku: if {[string match */CVS/* $path]} {return 1} df91d389d5 2007-09-04 aku: return 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::wsclear {} { df91d389d5 2007-09-04 aku: variable cwd df91d389d5 2007-09-04 aku: variable workspace df91d389d5 2007-09-04 aku: cd $cwd df91d389d5 2007-09-04 aku: file delete -force $workspace df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::wssetup {c} { df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable cvs df91d389d5 2007-09-04 aku: variable base df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # pwd = workspace df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {u cm s e rd fs} $csets($c) break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " @ $s" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach l [split [string trim $cm] \n] { df91d389d5 2007-09-04 aku: Log info " | $l" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {f or} $fs { df91d389d5 2007-09-04 aku: foreach {op r} $or break df91d389d5 2007-09-04 aku: Log info " -- $op $f $r" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {$op eq "R"} { df91d389d5 2007-09-04 aku: # Remove file from workspace. Prune empty directories. df91d389d5 2007-09-04 aku: # df91d389d5 2007-09-04 aku: # NOTE: A dead-first file (rev 1.1 dead) will never have df91d389d5 2007-09-04 aku: # existed. df91d389d5 2007-09-04 aku: # df91d389d5 2007-09-04 aku: # NOTE: Logically empty directories still physically df91d389d5 2007-09-04 aku: # contain the CVS admin directory, hence the check for == df91d389d5 2007-09-04 aku: # 1, not == 0. There might also be hidden files, we count df91d389d5 2007-09-04 aku: # them as well. Always hidden are . and .. and they do not df91d389d5 2007-09-04 aku: # count as user file. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: file delete $f df91d389d5 2007-09-04 aku: set fd [file dirname $f] df91d389d5 2007-09-04 aku: if { df91d389d5 2007-09-04 aku: ([llength [glob -nocomplain -directory $fd *]] == 1) && df91d389d5 2007-09-04 aku: ([llength [glob -nocomplain -directory -type hidden $fd *]] == 2) df91d389d5 2007-09-04 aku: } { df91d389d5 2007-09-04 aku: file delete -force $fd df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } else { df91d389d5 2007-09-04 aku: # Added or modified, put the requested version of the file df91d389d5 2007-09-04 aku: # into the workspace. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {[catch { df91d389d5 2007-09-04 aku: exec $cvs -d $base co -r $r $f df91d389d5 2007-09-04 aku: } msg]} { df91d389d5 2007-09-04 aku: if {[string match {*invalid change text*} $msg]} { df91d389d5 2007-09-04 aku: # The archive of the file is corrupted and the df91d389d5 2007-09-04 aku: # chosen version not accessible due to that. We df91d389d5 2007-09-04 aku: # report the problem, but otherwise ignore it. As df91d389d5 2007-09-04 aku: # a consequence the fossil repository will not df91d389d5 2007-09-04 aku: # contain the full history of the named file. By df91d389d5 2007-09-04 aku: # ignoring the problem we however get as much as df91d389d5 2007-09-04 aku: # is possible. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " EE Corrupted archive file. Inaccessible revision." df91d389d5 2007-09-04 aku: continue df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return -code error $msg df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Provide metadata about the changeset the backend may wish to have df91d389d5 2007-09-04 aku: return [list $u $cm $s] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # CVS application df91d389d5 2007-09-04 aku: # Workspace where checkouts happen df91d389d5 2007-09-04 aku: # Current working directory to go back to after the import. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: variable cvs [auto_execok cvs] df91d389d5 2007-09-04 aku: variable workspace {} df91d389d5 2007-09-04 aku: variable cwd {} df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::foreach_cset {cv node script} { df91d389d5 2007-09-04 aku: upvar 1 $cv c df91d389d5 2007-09-04 aku: variable rtree df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set c $node df91d389d5 2007-09-04 aku: while {1} { df91d389d5 2007-09-04 aku: uplevel 1 $script df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Stop on reaching the head. df91d389d5 2007-09-04 aku: if {![llength [$rtree children $c]]} break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #puts <[$rtree children $c]> df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Go to next child in trunk (leftmost). df91d389d5 2007-09-04 aku: set c [lindex [$rtree children $c] 0] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::root {} { df91d389d5 2007-09-04 aku: return 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::ntrunk {} { df91d389d5 2007-09-04 aku: variable ntrunk df91d389d5 2007-09-04 aku: return $ntrunk df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::uuid {c uuid} { df91d389d5 2007-09-04 aku: variable rtree df91d389d5 2007-09-04 aku: $rtree set $c uuid $uuid df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Internal helper commands: Changeset inspection and construction. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSClear {} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set start {} df91d389d5 2007-09-04 aku: set end {} df91d389d5 2007-09-04 aku: set cm {} df91d389d5 2007-09-04 aku: set user {} df91d389d5 2007-09-04 aku: set lastd {} df91d389d5 2007-09-04 aku: array unset files * df91d389d5 2007-09-04 aku: array set files {} df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSNone {} { df91d389d5 2007-09-04 aku: upvar 1 start start df91d389d5 2007-09-04 aku: return [expr {$start eq ""}] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSNew {entry} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd reason reason df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #puts -nonewline stdout . ; flush stdout df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {op ts a rev f ecm} $entry break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # User change df91d389d5 2007-09-04 aku: if {$a ne $user} {set reason user ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # File already in current cset df91d389d5 2007-09-04 aku: if {[info exists files($f)]} {set reason file ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Current cset trunk/branch different from entry. df91d389d5 2007-09-04 aku: set depth [llength [split $rev .]] df91d389d5 2007-09-04 aku: if {($lastd == 2) != ($depth == 2)} {set reason depth/$lastd/$depth/($rev)/$f ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Commit message changed df91d389d5 2007-09-04 aku: if {$cm ne $ecm} {set reason cmsg\ <<$ecm>> ; return 1} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Everything is good, still the same cset df91d389d5 2007-09-04 aku: return 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSSave {} { df91d389d5 2007-09-04 aku: variable cmap df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: variable ncs df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set csets($ncs) [list $user $cm $start $end $lastd [array get files]] df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Record which revisions of a file are in what csets df91d389d5 2007-09-04 aku: foreach {f or} [array get files] { df91d389d5 2007-09-04 aku: foreach {_ rev} $or break df91d389d5 2007-09-04 aku: set cmap([list $f $rev]) $ncs df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: #CSDump $ncs df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: incr ncs df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSAdd {entry} { df91d389d5 2007-09-04 aku: upvar 1 start start end end cm cm user user files files lastd lastd df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {op ts a rev f ecm} $entry break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {$start eq ""} {set start $ts} df91d389d5 2007-09-04 aku: set end $ts df91d389d5 2007-09-04 aku: set cm $ecm df91d389d5 2007-09-04 aku: set user $a df91d389d5 2007-09-04 aku: set files($f) [list $op $rev] df91d389d5 2007-09-04 aku: set lastd [llength [split $rev .]] df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::CSDump {c} { df91d389d5 2007-09-04 aku: variable csets df91d389d5 2007-09-04 aku: foreach {u cm s e rd f} $csets($c) break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: puts "$u $s"; regsub -all {.} $u { } b df91d389d5 2007-09-04 aku: puts "$b $e" df91d389d5 2007-09-04 aku: foreach {f or} $f { df91d389d5 2007-09-04 aku: foreach {o r} $or break df91d389d5 2007-09-04 aku: puts "$b $o $f $r" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Internal helper commands df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::Log {level text} { df91d389d5 2007-09-04 aku: variable lc df91d389d5 2007-09-04 aku: uplevel #0 [linsert $lc end $level $text] df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::cvs::Nop {args} {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::cvs { df91d389d5 2007-09-04 aku: # Logging callback. No logging by default. df91d389d5 2007-09-04 aku: variable lc ::cvs::Nop df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Ready df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: package provide cvs 1.0 df91d389d5 2007-09-04 aku: return
File Annotation