df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: # Repository management (FOSSIL) 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: df91d389d5 2007-09-04 aku: namespace eval ::fossil {} 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 file, and connect to workspace in CWD. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::new {} { df91d389d5 2007-09-04 aku: variable fr [file normalize [fileutil::tempfile import2_fsl_rp_]] df91d389d5 2007-09-04 aku: variable fossil df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # pwd = workspace df91d389d5 2007-09-04 aku: exec $fossil new $fr ; # create and df91d389d5 2007-09-04 aku: exec $fossil open $fr ; # connect df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " Fossil: $fr" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: return $fr 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 ::fossil::feedback {logcmd} { df91d389d5 2007-09-04 aku: variable lc $logcmd df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Move generated fossil repository to final destination df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::destination {path} { df91d389d5 2007-09-04 aku: variable fr df91d389d5 2007-09-04 aku: file rename $fr $path df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::fossil { df91d389d5 2007-09-04 aku: # Repository file df91d389d5 2007-09-04 aku: variable fr {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Fossil application df91d389d5 2007-09-04 aku: variable fossil [auto_execok fossil] 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: # Debug the commit command (write a Tcl script containing the 492531e3a8 2007-09-04 aku: # exact command used). And the file the data goes to. 492531e3a8 2007-09-04 aku: variable debugcommit 0 492531e3a8 2007-09-04 aku: variable dcfile {} 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: proc ::fossil::debugcommit {flag} { 492531e3a8 2007-09-04 aku: variable debugcommit $flag 492531e3a8 2007-09-04 aku: if {$debugcommit} { 492531e3a8 2007-09-04 aku: variable dcfile [file normalize cvs2fossil_commit.tcl] 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: 8469631cc9 2007-09-08 aku: proc ::fossil::commit {break appname nosign meta ignore} { df91d389d5 2007-09-04 aku: variable fossil df91d389d5 2007-09-04 aku: variable lastuuid 492531e3a8 2007-09-04 aku: variable debugcommit 492531e3a8 2007-09-04 aku: variable dcfile df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Commit the current state of the workspace. Scan for new and df91d389d5 2007-09-04 aku: # removed files and issue the appropriate fossil add/rm commands df91d389d5 2007-09-04 aku: # before actually comitting. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Modified/Removed files first, that way there won't be any ADDED df91d389d5 2007-09-04 aku: # indicators. Nor REMOVED, only EDITED. Removed files show up as df91d389d5 2007-09-04 aku: # EDITED while they are not registered as removed. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set added 0 df91d389d5 2007-09-04 aku: set removed 0 df91d389d5 2007-09-04 aku: set changed 0 df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach line [split [exec $fossil changes] \n] { df91d389d5 2007-09-04 aku: regsub {^\s*EDITED\s*} $line {} path df91d389d5 2007-09-04 aku: if {[IGNORE $ignore $path]} continue df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {![file exists $path]} { df91d389d5 2007-09-04 aku: exec $fossil rm $path df91d389d5 2007-09-04 aku: incr removed df91d389d5 2007-09-04 aku: Log info " ** - $path" df91d389d5 2007-09-04 aku: } else { df91d389d5 2007-09-04 aku: incr changed df91d389d5 2007-09-04 aku: Log info " ** * $path" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Now look for unregistered added files. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach path [split [exec $fossil extra] \n] { df91d389d5 2007-09-04 aku: if {[IGNORE $ignore $path]} continue df91d389d5 2007-09-04 aku: exec $fossil add $path df91d389d5 2007-09-04 aku: incr added df91d389d5 2007-09-04 aku: Log info " ** + $path" df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Now commit, using the provided meta data, and capture the uuid df91d389d5 2007-09-04 aku: # of the new baseline. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {user message tstamp} $meta break df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set message [join [list \ df91d389d5 2007-09-04 aku: "-- Originally by $user @ $tstamp" \ df91d389d5 2007-09-04 aku: "-- Imported by $appname" \ df91d389d5 2007-09-04 aku: $message] \n] df91d389d5 2007-09-04 aku: 492531e3a8 2007-09-04 aku: if {$nosign} { 492531e3a8 2007-09-04 aku: set cmd [list exec $fossil commit -m $message --nosign] 492531e3a8 2007-09-04 aku: } else { 492531e3a8 2007-09-04 aku: set cmd [list exec $fossil commit -m $message] 492531e3a8 2007-09-04 aku: } 492531e3a8 2007-09-04 aku: 492531e3a8 2007-09-04 aku: if {$debugcommit} { 492531e3a8 2007-09-04 aku: fileutil::writeFile $dcfile "\#!tclsh\n$cmd\n" 492531e3a8 2007-09-04 aku: } 8469631cc9 2007-09-08 aku: 8469631cc9 2007-09-08 aku: # Stop, do not actually commit. 8469631cc9 2007-09-08 aku: if {$break} return 492531e3a8 2007-09-04 aku: df91d389d5 2007-09-04 aku: if {[catch { 492531e3a8 2007-09-04 aku: eval $cmd df91d389d5 2007-09-04 aku: } line]} { df91d389d5 2007-09-04 aku: if {![string match "*nothing has changed*" $line]} { df91d389d5 2007-09-04 aku: return -code error $line df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # 'Nothing changed' can happen for changesets containing only df91d389d5 2007-09-04 aku: # dead-first revisions of one or more files. For fossil we df91d389d5 2007-09-04 aku: # re-use the last baseline. TODO: Mark them as branchpoint, df91d389d5 2007-09-04 aku: # and for what file. df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Log info " UNCHANGED, keeping last" df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: return [list $lastuuid 0 0 0] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set line [string trim $line] df91d389d5 2007-09-04 aku: regsub -nocase -- {^\s*New_Version:\s*} $line {} uuid df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: set lastuuid $uuid df91d389d5 2007-09-04 aku: return [list $uuid $added $removed $changed] 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 ::fossil::IGNORE {ignore path} { df91d389d5 2007-09-04 aku: return [uplevel #0 [linsert $ignore end $path]] df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::fossil::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 ::fossil::Nop {args} {} df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::fossil { df91d389d5 2007-09-04 aku: # Logging callback. No logging by default. df91d389d5 2007-09-04 aku: variable lc ::fossil::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 fossil 1.0 df91d389d5 2007-09-04 aku: return