Eskil

2014-11-12
 Added vcsvfs, to be used for revision aware dirdiff.

2014-11-07
 Fixed silly error from dirdiff refactoring. [da1ad24ee2]

2014-10-27
 Bumped revision to 2.6.6

2014-10-27

#----------------------------------------------------------------------
# Make file for Eskil
#----------------------------------------------------------------------

VERSION = 2661

# Path to the TclKits used for creating StarPacks.
TCLKIT = /home/peter/tclkit/v85
TCLKIT_LINUX   = $(TCLKIT)/tclkit-linux
TCLKIT_SOLARIS = $(TCLKIT)/tclkit-solaris-sparc
TCLKIT_WIN     = $(TCLKIT)/tclkit-win32.upx.exe

# Tools
NAGELFAR    = nagelfar

all: setup

SRCFILES = src/eskil.tcl src/clip.tcl src/dirdiff.tcl src/help.tcl src/map.tcl \
	   src/print.tcl src/registry.tcl src/rev.tcl src/debug.tcl \
	   src/compare.tcl src/merge.tcl src/printobj.tcl src/plugin.tcl \
           src/vcsvfs.tcl

#----------------------------------------------------------------
# Setup symbolic links from the VFS to the real files
#----------------------------------------------------------------

eskil.vfs/src/eskil.tcl:
	@mkdir -p eskil.vfs/src

# Stop Tk from meddling with the command line by copying it first.
set ::eskil(argv) $::argv
set ::eskil(argc) $::argc
set ::argv {}
set ::argc 0

set ::eskil(debug) 0
set ::eskil(diffver) "Version 2.6.6+ 2014-11-12"
set ::eskil(thisScript) [file join [pwd] [info script]]

namespace import tcl::mathop::+
namespace import tcl::mathop::-
namespace import tcl::mathop::*
namespace import tcl::mathop::/

    source $::eskil(thisDir)/dirdiff.tcl
    source $::eskil(thisDir)/help.tcl
    source $::eskil(thisDir)/plugin.tcl
    source $::eskil(thisDir)/printobj.tcl
    source $::eskil(thisDir)/print.tcl
    source $::eskil(thisDir)/rev.tcl
    source $::eskil(thisDir)/debug.tcl

    # Only load vcsvfs if vfs is present
    if {![catch {package require vfs}]} {
        source $::eskil(thisDir)/vcsvfs.tcl
    }
}

# Debug function to be able to reread the source even when wrapped in a kit.
proc EskilRereadSource {} {
    set this $::eskil(thisScript)

    # FIXA: Better detection of starkit?

#----------------------------------------------------------------------
#  Virtual File System for Verision Control Systems
#
#  Copyright (c) 2014, Peter Spjuth
#
#  License for vcsvfs package: Same as for Tcl
#----------------------------------------------------------------------

package require vfs
package provide vcsvfs 0.1

namespace eval vcsvfs {
    variable DataRefChan
    namespace eval fossil {
        variable mpoints {}
    }
}

# Create a Virtual File System showing a revision of a fossil checkout
#
# dir: Directory in a fossil checkout
# rev: Revision to mount
#
# Returns: path to the generated VFS
proc vcsvfs::fossil::mount {dir rev} {
    variable mpoints
    set dir [file normalize $dir]

    # Fossil command must be run within the dir, so temporarily change pwd
    set oldpwd [pwd]
    cd $dir

    # The mount point will always be at the fossil root, even if
    # a sub directory was given.
    # Locate fossil root for the given directory.
    set info [exec fossil info]
    regexp -line {local-root:\s*(\S.*)} $info -> root
    set root [file normalize $root]
    cd $root

    # Getting files via ls
    set allfiles [exec fossil ls --age $rev .]
    foreach line [split $allfiles \n] {
        # Expected format in a line:
        # 2012-08-21 20:38:19  tests/rev.test
        regexp {(\S+ \S+)\s+(.+)} $line -> fDate fName
        dict set finfo $fName mtimestr $fDate
        dict set finfo $fName isfile 1
        dict set finfo $fName isdir 0
        # Mark all known directory paths and build up file tree info
        set parentStr ""
        foreach dirPath [file split $fName] {
            dict set finfo $parentStr child $dirPath 1
            dict set finfo $parentStr isfile 0
            dict set finfo $parentStr isdir 1
            set parentStr [file join $parentStr $dirPath]
        }
    }
    # Getting files via artifact
    set artifact [exec fossil artifact $rev]
    foreach line [split $artifact \n] {
        # Expected format in a line:
        # F tests/left.txt c1572b3809a1ba6ab2de9307c96b1cfeefdcf0ba
        if {[regexp {F (\S+) (\S+)} $line -> fName fSha]} {
            # File names can have spaces, coded with \s
            set fName [string map {\\s " "} $fName]
            dict set finfo $fName sha $fSha
            # TBD: Delay calling whatis until size is needed
            # Expected format in a line:
            # size:    629 bytes
            set whatis [exec fossil whatis $fSha]
            regexp {size:\s+(\d+)} $whatis -> fSize
            dict set finfo $fName size $fSize
        }
    }
    cd $oldpwd

    # Generate a mount point.
    set tail [string range $dir [string length $root] end]
    set mountpoint "${root} ($rev)"

    dict set mpoints $mountpoint finfo $finfo
    dict set mpoints $mountpoint origroot $root
    dict set mpoints $mountpoint rev $rev
    vfs::filesystem mount $mountpoint [list vcsvfs::fossil::Vfs]

    set result $mountpoint$tail
    #puts $result
    #puts [dict size $finfo]
    #puts [dict get $finfo [lindex $finfo 0]]
    return $result
}

proc vcsvfs::fossil::unmount {dir} {
    variable mpoints
    # TBD: Find the mountpoint
    #dict unset mpoints $mountpoint
    #vfs::filesystem unmount $mountpoint
}

# Handler for Reflected Channel
proc vcsvfs::DataRefChan {id cmd chId args} {
    variable DataRefChan
    switch $cmd {
        initialize {
            set mode [lindex $args 0]
            return "initialize finalize watch read"
        }
        finalize {
            unset DataRefChan($id,data)
            return
        }
        watch {
            #set eventSpec [lindex $args 0]
            return
        }
        read {
            set count [lindex $args 0]
            set si $DataRefChan($id,ptr)
            set newPtr [expr {$si + $count}]
            set ei [expr {$newPtr - 1}]
            set data [string range $DataRefChan($id,data) $si $ei]
            set DataRefChan($id,ptr) $newPtr
            return $data
        }
    }
}

# Set up a Reflected Channel which reads the provided data
proc vcsvfs::CreateDataRefChan {data} {
    variable DataRefChan
    set t 0
    while {[info exists DataRefChan($t,data)]} {
        incr t
    }
    set DataRefChan($t,data) $data
    set DataRefChan($t,ptr) 0
    set chId [chan create r [list vcsvfs::DataRefChan $t]]
    return $chId
}

# Helper for glob matching in directory
proc vcsvfs::MatchInDirectory {finfo relative actual args} {
    set pattern [lindex $args 0]
    set types [lindex $args 1]
    set allowFile 0
    set allowDir 0
    if {[::vfs::matchDirectories $types]} {set allowDir 1}
    if {[::vfs::matchFiles $types]} {set allowFile 1}

    set result {}
    foreach child [dict keys [dict get $finfo $relative child]] {
        if {![string match $pattern $child]} continue
        set local [file join $relative $child]
        if {[dict get $finfo $local isfile] && !$allowFile} continue
        if {[dict get $finfo $local isdir] && !$allowDir} continue
        lappend result [file join $actual $child]
    }
    return $result
}

# The handler for the mounted VFS
proc vcsvfs::fossil::Vfs {subcmd root relative actual args} {
    variable mpoints
    #puts "\nfossilVfs called:"
    #puts " Su $subcmd"
    #puts " Ro $root"
    #puts " Re $relative"
    #puts " Ac $actual"
    #puts " Ar $args"

    set origroot [dict get $mpoints $root origroot]
    set finfo [dict get $mpoints $root finfo]

    if {![dict exists $finfo $relative]} {
        # Unknown path
        vfs::filesystem posixerror $::vfs::posix(EACCES)
        return -code error $::vfs::posix(EACCES)
    }
    set finfor [dict get $finfo $relative]
    #puts " $finfor"

    switch $subcmd {
        access {
            set mode [vfs::accessMode [lindex $args 0]]
            # Only read supported
            if {$mode ne "R"} {
                vfs::filesystem posixerror $::vfs::posix(EACCES)
                return -code error $::vfs::posix(EACCES)
            }
            return
        }
        fileattributes {
            #set index [lindex $args 0]
            #set value [lindex $args 1]
            return
        }
        matchindirectory {
            return [vcsvfs::MatchInDirectory $finfo $relative $actual {*}$args]
        }
        open {
            set mode [lindex $args 0]
            if {$mode == {}} {set mode r}
            #set permissions [lindex $args 1]
            if {$mode ne "r"} {
                # Read only
                vfs::filesystem posixerror $::vfs::posix(EACCES)
                return -code error $::vfs::posix(EACCES)
            }

            set oldpwd [pwd]
            cd [dict get $mpoints $root origroot]
            set rev [dict get $mpoints $root rev]
            set data [exec fossil cat $relative -r $rev]
            cd $oldpwd

            set chId [vcsvfs::CreateDataRefChan $data]
            return [list $chId ""]
        }
        stat {
            set res [dict create dev 0 ino 0 mode 0 nlink 0 uid 0 gid 0 \
                             size 0 atime 0 mtime 0 ctime 0 type file]
            if {[dict get $finfor isdir]} {
                # TBD, fake mtime etc. for directory?
                dict set res type directory
            } else {
                if {![dict exists $finfor mtime]} {
                    set str [dict get $finfor mtimestr]
                    # TBD parse to mtime correct?
                    set mtime [clock scan $str -gmt 1]
                    dict set finfor mtime $mtime
                    # Cache in main dictionary too
                    dict set mpoints $root finfo $relative mtime $mtime
                }
                dict set res mtime [dict get $finfor mtime]
                dict set res size  [dict get $finfor size]
            }
            return $res
        }
        createdirectory - deletefile - removedirectory - utime { 
            # Read-only, always error
        }
    }
    vfs::filesystem posixerror $::vfs::posix(EACCES)
    return -code error $::vfs::posix(EACCES)
}


##################################################################
# Test structure
##################################################################
if 0 {
# File traversing stuff from wiki...
proc ftw_1 {{dirs .}} {
    while {[llength $dirs]} {
        set dirs [lassign $dirs name]
        lappend dirs {*}[glob -nocomplain -directory $name -type d *]
        puts $name
    }
}
proc ls-l { dir } {
    # Get the current year, because the date format depends on it.
    set thisYear [clock format [clock seconds] -format %Y]
    # Walk the files in the given directory, accumulating lines
    # in $retval
    set retval {}
    set sep {}
    # In Tcl older than 8.3 use 'glob [file join $dir *]'
    foreach fileName [lsort [glob -dir $dir *]] {
        append retval $sep
        set sep \n
        # Get status of the file
        #file stat $fileName stat
        # use 'file lstat' instead: if the file is a symbolic link we don't want info about its target
        file lstat $fileName stat
        # Put in one character for file type.  Use - for a plain file.
        set type -
        if { [info exists stat(type)]
             && [string compare file $stat(type)] } {
            set type [string index $stat(type) 0]
        }
        append retval $type
        # Decode $stat(mode) into permissions the way that ls does it.
        foreach { mask pairs } {
            00400 { 00400 r }
            00200 { 00200 w }
            04100 { 04100 s 04000 S 00100 x }
            00040 { 00040 r }
            00020 { 00020 w }
            02010 { 02010 s 02000 S 00010 x }
            00004 { 00004 r }
            00002 { 00002 w }
            01001 { 01001 t 01000 T 00001 x }
        } {
            set value [expr $stat(mode) & $mask]
            set bit -
            foreach { x b } $pairs {
                if { $value == $x } {
                    set bit $b
                }
            }
            append retval $bit
        }
        # Put in link count, user ID, and size.  Note that the UID
        # will be numeric.  If you know how to back-translate this
        # from Tcl, please feel free to edit it in!
        # LV writes - use file userid and file groupid to convert the numbers back to names.
        #   I don't know what version of Tcl added those commands...
        append retval [format %4d $stat(nlink)] { }
        array set attribs [file attributes $fileName]
        if {[info exists attribs(-owner)]} {
            append retval [format %-8s $attribs(-owner)]
            append retval [format %-8s $attribs(-group)]
        } else {
            append retval [format %8d $stat(uid)]
            append retval [format %8d $stat(gid)]
        }
        append retval [format %9d $stat(size)]
        # Put in the date.  The current year is formatted differently
        # from prior years.
        set year [clock format $stat(mtime) -format "%Y"]
        if { $year == $thisYear } {
            set modified [clock format $stat(mtime) -format "%h %e %H:%M"]
        } else {
            set modified [clock format $stat(mtime) -format "%h %e  %Y"]
        }
        # glennj: see note below
        append retval { } $modified { }
        # Finally, put in the file name, stripping off the directory.
        append retval [file tail $fileName]
        if {[string compare $stat(type) link] == 0} {
            append retval " -> [file readlink $fileName]"
        }
        if {$type eq "-"} {
            set ch [open $fileName]
            set x [read $ch]
            set x [string range $x 0 4]
            close $ch
            append retval " = '$x'"
        }
        unset stat attribs
    }
    return $retval
}


set d [vcsvfs::fossil::mount ~/src/eskil f96b0fd915]
puts "------------- GLOB:"
puts [join [glob -dir $d *] \n]
puts "------------- FTW:"
ftw_1 [list $d]
puts "------------- LS:"
puts [ls-l $d]
}