8. File Contents

#-----------------------------
foreach line [split [read -nonewline $fd] "\n"] {
   puts [string length $line] # we get chomped line by default.
}

#-----------------------------
set lines [split [read -nonewline $fd] "\n"]

#-----------------------------
set data [read $fd]

#-----------------------------
# not a direct equivalent but it is not required in tcl.
puts $fd [list one two three]

#-----------------------------
puts {Baa baa black sheep.}

#-----------------------------
set buffer [read $fd 4096]
set rv [string length $buffer]

#-----------------------------
chan truncate $fd $length
# truncating with out a file handle is not possible directly in tcl.

#-----------------------------
set pos [chan tell $datafd]
puts "I am $pos bytes from the start of datafd"

#-----------------------------
chan seek $logfd 0 end
chan seek $datafd $pos start
chan seek $outfd -20 current
#-----------------------------
# in tcl, there is no partial write, as even in non blocking mode,
# tcl writes in the background to complete the write.
chan configure $datafd -blocking 0 -buffering none
puts -nonewline $mystring

chan configure $infd -blocking 0 -buffering none
set block [read $infd 256]
set len [string length $block]
expr {($len != 256) ? [puts "only read $len bytes"] : 0 }

#-----------------------------
set pos [seek $handle 0 current] #dont change position.

#-----------------------------
while {[gets $fd line] >= 0} {
    while {[regexp -- {\\$} $line]} {
        regsub -- {\\$} $line [gets $fd] line
    }
    #process the full $line here.
}

#-----------------------------
set count [wc -l $filename]

#-----------------------------
set fd [open $file]
set count [llength [split [read -nonewline $fd] "\n"]]

#-----------------------------
set count [expr [regsub -all -- "\n" [read -nonewline $fd] {} tmp] + 1]

#-----------------------------
for {set count 0} {[gets $fd line] > -1} {incr count} {}

#-----------------------------
# para is just \n\n
set count [expr [regsub -all -- "\n\n" [read -nonewline $fd] {} tmp] + 1]

#-----------------------------
while {[gets $fd line] >= 0} {
    foreach word $line {
        #do something with the word.
    }
}

#-----------------------------
while {[gets $fd line] >= 0} {
    foreach word [regexp -all -inline -- {\w[\w'-]*} $line] {
        #do something with the word.
    }
}

#-----------------------------
# word frequency
array set seen {}
while {[gets $fd line] >= 0} {
    foreach word [regexp -all -inline -- {\w[\w'-]*} $line] {
        incr seen([string tolower $word])
    }
}

#-----------------------------
array set seen {}
while {[gets $fd line] >= 0} {
    incr seen([string tolower $line])
}

set names [lsort -command {apply {{a b} {upvar seen seen; expr $seen($a) > $seen($b)}}} [array names seen]]
foreach line $names {
    puts "$line $seen($line)"
}

#-----------------------------
package require struct::list

set lines [split [read -nonewline $fd] "\n"]
foreach line [struct::list reverse $lines] {
    # do something with the line.
}

#-----------------------------
set lines [split [read -nonewline $fd] "\n"]
for {set i [llength $lines]} {$i} {incr i -1} {
    set line [lindex $lines $i-1]
}
# same strategy for paragraphs.

#-----------------------------
while 1 {
    myproc [read $fd]
    while {[eof $fd]} {
        after 5000
        seek $fd 0 current
    }
}

#-----------------------------
set naptime 1000
set fd [open {/tmp/logfile}]
while 1 {
    set out [gets $fd]
    if [string length $out] {
        puts $out
    }
    while {[eof $fd]} {
        after $naptime
        seek $fd 0 current
    }
}

#-----------------------------
file stat $logfile info
if {!$info(nlink)} {
    exit 0
}

#-----------------------------
set lines [split [read -nonewline $fd] "\n"]
set randline [lindex $lines [expr "round(rand() * [llength $lines])"]]

#-----------------------------
set fd [open {/usr/share/fortune/humorists}]
set lines [split [regsub -all -- {%\n} [read -nonewline $fd] "\0"] "\0"]
set idx [expr "round(rand() * [llength $lines])"]
puts [lindex $lines $idx]

#-----------------------------
set lines [split [read -nonewline $input] "\n"]
foreach line [shuffle $lines] { #assumes shuffle from chapt 4
    puts $output $line
}

#-----------------------------
for {set i 0} {[gets $fd line] >= 0} {incr i} {
    if {$desired_line_number == $i} break
}

#-----------------------------
set lines [split [read -nonewline $input] "\n"]
set line [lindex $lines $desired_line_number]

#-----------------------------
proc build_index {data_file index_file} {
    puts -nonewline $index_file [binary format i 0]
    while {[gets $data_file line] >= 0} {
        puts -nonewline $index_file [binary format i [tell $data_file]]
    }
}

proc line_with_index {data_file index_file line_no} {
    set size [string length [binary format i 0]]
    set i_offset [expr $size * ($line_no - 1)]
    seek $index_file $i_offset start
    if {[tell $index_file] != $i_offset} {
        error "Did not find $line_no"
    }
    set entry [read $index_file $size]
    binary scan $entry i* d_offset
    seek $data_file $d_offset start
    if {[tell $data_file] != $d_offset} {
        error "Did not find $line_no"
    }
    return [gets $data_file]
}

# usage
set dfd [open fortune.dat]
set ifd [open fortune.dat.index w]
build_index $dfd $ifd
close $dfd
close $ifd

set dfd [open fortune.dat]
set ifd [open fortune.dat.index]
puts [line_with_index $dfd $ifd 90]
close $dfd
close $ifd

#-----------------------------
# we dont have a tie.
package require struct::list

expr {([llength $argv] == 2) || [error "usage: print_line FILENAME
LINE_NUMBER\n"]}
::struct::list assign $argv filename linenumber

set fd [open $filename]
for {set i 0} {[gets $fd line] >= 0} {incr i} {
    if {$linenumber == $i} {
        puts $line
        exit 0
    }
}
error "Didn't find line $line_number in $filename\n"

#-----------------------------
package require struct::list

expr {([llength $argv] == 2) || [error "usage: print_line FILENAME LINE_NUMBER\n"]}
::struct::list assign $argv filename linenumber
set dfd [open $filename]
set ifd [open $filename.index]
build_index $dfd $ifd
puts [line_with_index $dfd $ifd]

#-----------------------------
set fields [split [regsub -all -- {PATTERN} $record {\0}] "\0"]

#-----------------------------
set fields [split [regsub -all -- {:} $record {\0}] "\0"]

#-----------------------------
set fields [split [regsub -all -- {\s+} $record {\0}] "\0"]

#-----------------------------
set fields [split [regsub -all -- { } $record {\0}] "\0"]

#-----------------------------
set last 0
while {[gets $fd line] >= 0} {
    if {![eof $fd]} {
        set last [tell $fd]
    }
}
chan truncate $fd $last

#-----------------------------
chan configure $handle -translation binary

#-----------------------------
set gifname "picture.gif"
set gif [open $gifname]
chan configure $gif -translation binary
chan configure stdout -translation binary
while {![eof $gif]} {
    puts -nonewline [read $gif [expr 8 * 2**10]]
}

#-----------------------------
set addr [expr $recsize * $recno]
seek $fh $addr start
set data [read $fh $recsize]
binary scan $buffer $format field1 field2 #we can not pass a list/array as argument.
#update fields
set buffer [binary format $format $field1 $field2]
seek $fh -$recsize current
puts -nonewline $fh $buffer
close $fh

#-----------------------------
# setting the login date.
# @@INCOMPLETE@@

#-----------------------------
chan configure $fh -translation binary
seek $fh $addr start
set out [read $fh]

#-----------------------------
#not optimal. do not use it for large strings.
proc get_till_null {fh} {
    set out {}
    while {![eof $fh]} {
        set char [read $fh 1]
        set out "$out$char"
        if [regexp -- {\0} $char] break
    }
    return $out
}

foreach addr $addrs {
    #seek will detect the oct if it is prefixed with '0'.
    seek $fh $addr start
    puts [format {%x %o %d "%s"} $addr $addr $addr [get_till_null $fh]]
}

#-----------------------------
set fh [open $argv]
chan configure $fh -translation binary
foreach line [split [read $fh] "\0"] {
    foreach word [regexp -all -inline -- {[\x20-\x7e]+} $line] {
        puts $word
    }
}

#-----------------------------
chan configure $fh -translation binary
while {![eof $fh]} {
    set record [read $fh $recordsize]
    binary scan $data $template field1 field2 field3
}

#-----------------------------
array set user_preferences {}
foreach line [split [read -nonewline $fh] "\n"] {
    regsub -- {#.*$} [string trim $line] {} line
    if [string length $line] {
        array set user_preferences [string map {= { }} $line]
    }
}

#-----------------------------
file stat $filename statinfo
# statinfo now contains the relevant information.
foreach var [array names statinfo] {
    set $var $statinfo($var)
}
set mode [expr $mode & 07777]

#-----------------------------
file stat $filename statinfo
if {!$statinfo(uid)) {
    puts "Superuser owns $filename"
}
if {$statinfo(atime) > $statinfo(mtime)} {
    puts "$filename has been read since it was written."
}

#-----------------------------
proc is_safe path {
    file stat $path info
    # owner neither su nor me
    if {$info(uid) && ![file owned $path]} {
        return 0
    }
    # check if group or other can write file.
    if {$info(mode) & 022} {
        if {![file isdirectory $path]} {
            return 0
        }
        if {!($info(mode) & 01000)} {
            return 0
        }
    }
    return 1
}

#-----------------------------
proc is_verysafe path {
    set build {}
    foreach elem [file split $path] {
        set build [file join $build $elem]
        if {![is_safe $build]} {
            return 0
        }
    }
    return 1
}

#-----------------------------
#struct tmp {
#    short ut_type;                 +2      -> s    short
#                                   +2      -> x2   padding
#    pid_t ut_pid;                  +4      -> i    int
#    //alignment                    +20     -> x20  padding
#    char ut_line[UT_LINESIZE];     +12     -> A12  char
#    char ut_id[4];                 +4      -> A4   char
#    char ut_user[UT_NAMESIZE];     +32     -> A32  char
#    char ut_host[UT_HOSTSIZE];     +256    -> A256 char
#    struct exit_status ut_exit;    +4      -> x4   skip
#
#    long ut_session;               +4      -> x4   skip
#    struct timeval ut_tv;          +8      -> ii   int
#    int32_t ut_addr_v6[4];         +16     -> iiii int
#    char pad[20];                          -> x20  skip
#};

set typedef {s x2 i x20 A12 A4 A32 A256 x4 x4 ii iiii x20}
set sizeof [string length [binary format $typedef 0 0 {} {} {} {} 0 0 0 0 0 0 ]]

set wtmp [open {/var/log/wtmp}]
seek $wtmp 0 end
while 1 {
        set buffer [read $wtmp $sizeof]
        binary scan $buffer $typedef type pid line id user host tsec tmsec addr addr2 addr3 addr4
        scan $user %c ord
        if {!$user || !$time || !$ord} continue
        puts "type:$type user:$user uid:$line id:$id host:$host pid:$pid time:[clock format $tval1]"
        puts [format "->%u.%u.%u.%u" [expr $addr & 0xff] [expr ($addr >> 8) & 0xff] [expr ($addr >> 16) & 0xff] [expr ($addr >> 24) & 0xff]]
}

#-----------------------------
# @@INCOMPLETE@@
# @@INCOMPLETE@@

#-----------------------------
# @@INCOMPLETE@@
# @@INCOMPLETE@@

#-----------------------------