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 d4aa7da67d 2007-09-13 aku: package require fileutil ; # Tcllib (traverse directory hierarchy) d4aa7da67d 2007-09-13 aku: package require vc::rcs::parser ; # Handling the RCS archive files. d4aa7da67d 2007-09-13 aku: package require vc::tools::log ; # User feedback cdf5e6d8b7 2007-09-13 aku: package require vc::cvs::cmd ; # Access to cvs application. df91d389d5 2007-09-04 aku: package require struct::tree df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 86a7f249c1 2007-09-09 aku: vc::tools::log::system cvs 86a7f249c1 2007-09-09 aku: namespace import ::vc::tools::log::write d4aa7da67d 2007-09-13 aku: namespace import ::vc::rcs::parser::process cdf5e6d8b7 2007-09-13 aku: namespace import ::vc::cvs::cmd::dova be32ebcb41 2007-09-08 aku: } 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::at {path} { df91d389d5 2007-09-04 aku: variable base [file normalize $path] be32ebcb41 2007-09-08 aku: write 0 cvs "Base: $base" be32ebcb41 2007-09-08 aku: return be32ebcb41 2007-09-08 aku: } be32ebcb41 2007-09-08 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 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: # 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: be32ebcb41 2007-09-08 aku: write 0 cvs {Scanning directory hierarchy} 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: be32ebcb41 2007-09-08 aku: write 1 cvs "Archive $rcs" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {[string match CVSROOT* $rcs]} { be32ebcb41 2007-09-08 aku: write 2 cvs {Ignored. Administrative 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. be32ebcb41 2007-09-08 aku: be32ebcb41 2007-09-08 aku: write 2 cvs "Ignored. Attic superceded by 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). d4aa7da67d 2007-09-13 aku: set meta [process $base/$rcs] 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")} { be32ebcb41 2007-09-08 aku: write 2 cvs {Dead root revision} 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: be32ebcb41 2007-09-08 aku: write 0 cvs "Processed $n [expr {($n == 1) ? "file" : "files"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: be32ebcb41 2007-09-08 aku: write 0 cvs "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: be32ebcb41 2007-09-08 aku: write 0 cvs "Processed $n [expr {($n == 1) ? "entry" : "entries"}]" be32ebcb41 2007-09-08 aku: df91d389d5 2007-09-04 aku: set n [array size csets] be32ebcb41 2007-09-08 aku: write 0 cvs "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: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: be32ebcb41 2007-09-08 aku: write 0 cvs "Extracting the trunk" be32ebcb41 2007-09-08 aku: 00228d1547 2007-09-13 aku: set rtree [struct::tree ::vc::cvs::ws::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: be32ebcb41 2007-09-08 aku: write 0 cvs "Processed $ntrunk trunk [expr {($ntrunk == 1) ? "changeset" : "changesets"}]" be32ebcb41 2007-09-08 aku: write 0 cvs "Ignored $b branch [expr {($b == 1) ? "changeset" : "changesets"}]" df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: be32ebcb41 2007-09-08 aku: write 0 cvs "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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::wssetup {c} { 00228d1547 2007-09-13 aku: variable csets 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: be32ebcb41 2007-09-08 aku: write 1 cvs "@ $s" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach l [split [string trim $cm] \n] { be32ebcb41 2007-09-08 aku: write 1 cvs "| $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 be32ebcb41 2007-09-08 aku: write 2 cvs "$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 { cdf5e6d8b7 2007-09-13 aku: dova -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: be32ebcb41 2007-09-08 aku: write 0 cvs "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 b504674c5f 2007-09-15 aku: return [list $u $s $cm] 00228d1547 2007-09-13 aku: } 00228d1547 2007-09-13 aku: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 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 workspace {} df91d389d5 2007-09-04 aku: variable cwd {} df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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} { 8469631cc9 2007-09-08 aku: set code [catch {uplevel 1 $script} res] 8469631cc9 2007-09-08 aku: 8469631cc9 2007-09-08 aku: # 0 - ok, 1 - error, 2 - return, 3 - break, 4 - continue 8469631cc9 2007-09-08 aku: switch -- $code { 8469631cc9 2007-09-08 aku: 0 {} be32ebcb41 2007-09-08 aku: 1 { return -errorcode $::errorCode -errorinfo $::errorInfo -code error $res } 8469631cc9 2007-09-08 aku: 2 {} 8469631cc9 2007-09-08 aku: 3 { return } 8469631cc9 2007-09-08 aku: 4 {} 8469631cc9 2007-09-08 aku: default { 8469631cc9 2007-09-08 aku: return -code $code $result 8469631cc9 2007-09-08 aku: } 8469631cc9 2007-09-08 aku: } 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::root {} { df91d389d5 2007-09-04 aku: return 0 df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::ncsets {} { be32ebcb41 2007-09-08 aku: variable ncs be32ebcb41 2007-09-08 aku: return $ncs 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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: proc ::vc::cvs::ws::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: 00228d1547 2007-09-13 aku: namespace eval ::vc::cvs::ws { 00228d1547 2007-09-13 aku: namespace export at scan csets rtree workspace wsignore wsclear wssetup \ b504674c5f 2007-09-15 aku: foreach_cset root ntrunk ncsets 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: 00228d1547 2007-09-13 aku: package provide vc::cvs::ws 1.0 df91d389d5 2007-09-04 aku: return
File Annotation