File library/tko_file.tcl artifact 7cf409fad7 part of check-in b597f7efa4

# tko_file.tcl --
#
#       Additional file commands.
#
# Copyright (c) 2024- <r.zaumseil@freenet.de>

namespace eval ::tko::file {
    namespace export *
    namespace ensemble create
}

# ::tko::file::read --
#   Return content of given file.
#
# Arguments:
# file -    Name of file to read
# args -    fconfigure options
proc ::tko::file::read {file args} {
    if {[catch {
        set myFd [open $file r]
        fconfigure $myFd {*}$args
        set myRet [::read $myFd]
    } m]} {
        catch {close $myFd}
        return -code error "read $file: $m"
    }
    close $myFd
    return $myRet
}

# ::tko::file::write --
#   Write given data into given file
#
# Arguments:
# file -    Name of file to write
# data -    Data to write into file
# args -    fconfigure options
proc ::tko::file::write {file data args} {
    if {[catch {
        set myDir [file dirname $file]
        if {![file isdirectory $myDir]} {
            file mkdir $myDir
        }
        set myFd [open $file w]
        fconfigure $myFd {*}$args
        puts -nonewline $myFd $data
    } m]} {
        catch {close $myFd}
        return -code error "write $file: $m"
    }
    close $myFd
    return
}

# ::tko::file::tail --
#   Implement file tail function.
#   If the file disappears or is replaced by a new file with the
#   same name it is handled transparently.
#
#   The behaviour of this function is based upon tail in the gnu
#   fileutils alpha release 4.0 package.
#
# Arguments
# mode -    One of start, stop, status. _runis for internal use!
# file -    Name of file. Can be file pattern for status command.
# command - Used when mode=start. Name of command for output.
#           The command will called with appending "stdout linelist" for
#           new data and "stderr {fd readon}" for state changes.
# delay -   Used when mode=start. Delay time in ms. Default ist 1000ms
#
# Usage:
#   # define receive proc.
#   proc cmd {mode arg} {
#     if {$mode eq {stdout}} {
#       foreach line $arg {
#         # do something with tail'd lines
#       }
#     } else {
#       lassign $arg fd reason
#       # do something with state message
#     }
#   }
#   # startup
#   tko::file::tail start t.txt ::cmd
#   ..
#   # check running tail's
#   tko::file::tail state *
#   # stop it
#   tko::file::tail stop t.txt
#
proc ::tko::file::tail {mode file {command {}} {delay 1000}} {
    array set ::tko::file::tail {};# ensure variable exists
    switch -- $mode {
    start {;# file command delay
        if {$file eq {}} {
return -code error "empty file name"
        }
        if {[info exists ::tko::file::tail($file)]} {
return -code error "already running on $file"
        }
        if {$command eq {}} {
return -code error "missing command parameter"
        }
        set myInode -1
        set mySize  -1
        set myMtime -1
    }
    stop {;# file
        unset -nocomplain ::tko::file::tail($file)
        after cancel [list ::tko::file::tail _run $file]
        return
    }
    state {;# pattern
        if {$file eq {}} {set file *}
        return [array get ::tko::file::tail $file]
    }
    _run {;# file
        if {![info exists ::tko::file::tail($file)]} return
        lassign $::tko::file::tail($file) myCommand myDelay myFid myInode mySize myMtime
    }
    default {
return -code "unknown '$mode', should be one of start, stop, state"
    }
    }
    # if the file exists at this iteration, tail it
    if {[::file readable $file]} {
        ::file stat $file fstat
        # if the inode has changed since the last iteration, reopen the file.
        # this is from tail v4.0 in the gnu fileutils package.
        if {$fstat(ino) != $myInode} {
            catch {close $myFid}
            {*}$myCommand stderr "$myFid inode"
            set myFid {}
        } else {
            if {$fstat(size) < $mySize} {
                if {[catch {seek $myFid 0}]} {
                    catch {close $myFid}
                    {*}$myCommand stderr "$myFid size"
                    set myFid {}
                } else {
                    {*}$myCommand stderr "$myFid seek"
                }
            }
            if {$fstat(size) == $mySize && $fstat(mtime) != $myMtime} {
                if {[catch {seek $myFid 0}]} {
                    catch {close $myFid}
                    {*}$myCommand stderr "$myFid mtime"
                    set myFid {}
                } else {
                    {*}$myCommand stderr "$myFid seek"
                }
            }
        }
        # if the file is not open, open it!
        if {$myFid eq {}} {
            if {[catch {set myFid [open $file r]} myMsg]} {
                {*}$myCommand notopen=$myMsg
            } else {
                fconfigure $myFid -blocking off
                fconfigure $myFid -buffering line
                {*}$myCommand stderr "$myFid open"
            }
        # normal operation, get new lines
        } else {
            # set a variable with the content of the new data
            set myLines [list]
            while {[gets $myFid myLine] >= 0} {
                lappend myLines $myLine
            }
            {*}$myCommand stdout $myLines
        }
        set ::tko::file::tail($file) [list $myCommand $myDelay $myFid\
            $fstat(ino) $fstat(size) $fstat(mtime) $myFid]
    # if the file doesn't exist, make sure we aren't creating an NFS orphan.
    } else {
        # maybe the file got nuked? Handle it!
        if {$myFid ne {}} {
            catch {close $myFid}
        }
        set ::tko::file::tail($file) [list $myCommand $myDelay {} -1 -1 -1]
    }

    # lather, rinse, repeat. This is not recursion!
    after $myDelay [list ::tko::file::tail _run $file]
}

# vim: set ts=4 sw=4 sts=4 et :