7. File Access

Introduction

#-----------------------------
set filename {/tmp/messages}
if {![catch {open $filename r} F]} {
    while {[gets $F line] >= 0} {
        if [regexp  -- {blue} $line] {
            puts $line
        }
    }
close $F
} else {
error "Opening $filename: $F"
}

#-----------------------------
while {[gets stdin line] >= 0} {        #read from STDIN
    if {![regexp -- {\d} $line]} {
        puts stderr {No digit found}    #writes to STDERR
    }
    puts "Read: $line"                  #writes to STDOUT
}

#-----------------------------
set logfile [open {/tmp/log} w]
close $logfile

#-----------------------------
puts $logfile {Countdown initiated}
puts {You have 30 seconds to reach minimum safety distance.}

Opening a File

#-----------------------------
# open file "path" for reading only
set source  [open $path r]
# open file "path" for writing only
set sink    [open $path w]

# open file "path" for reading only
set source  [open $path RDONLY]
# open file "path" for writing only
set sink    [open $path WRONLY]

# open "path" for reading and writing
set file    [open $path r+ ]
# open "path" with the flags "flags" (see examples below for flags)
set file    [open $path $flags]

# open file "path" read only
set file    [open $path r]
set file    [open $path RDONLY]

# open file "path" write only, create it if it does not exist
# truncate it to zero length if it exists
set file    [open $path w]
set file    [open $path {WRONLY TRUNC CREAT}]

# open file "path" write only, fails if file exists
set file    [open $path {WRONLY EXCL CREAT}]

# open file "path" for appending
set file    [open $path a]
set file    [open $path {WRONLY APPEND CREAT}]

# open file "path" for appending only when file exists
set file    [open $path {WRONLY APPEND}]

# open file "path" for reading and writing
set file    [open $path r+]
set file    [open $path w+]
set file    [open $path RDWR]

# open file for reading and writing, create a new file if it does not exist
set file    [open $path {RDWR CREAT}]

# open file "path" reading and writing, fails if file exists
set file   [open $path {RDWR EXCL CREAT}]

Opening Files with Unusual Filenames

#-----------------------------
# tcl open does not use chars with special meaning.
set file [open $filename]

Expanding Tildes in Filenames

#-----------------------------
set el [file split $path]
lset el 0 [glob [lindex $el 0]]
set expandedpath [file join {expand}$el]

Making Perl Report Filenames in Errors

#-----------------------------
# the raised exception contains the filename.
open afile r

Creating Temporary Files

Storing Files Inside Your Program Text

#-----------------------------
set data {
Your data goes here
}
foreach line [split $data "\n"] {
    # process the line
}#-----------------------------
while {[gets stdin line] >= 0} {
    # do something with the line.
}

#-----------------------------
foreach filename $argv {
    # closing and exception handling are done by the block
    if {![catch {open $filename r} F]} {
        set line [gets $F] #do stuff with $line
        close $F
    } else {
        error "can't open $filename"
    }
}

#-----------------------------
if {![llength $argv]} {
    set argv [glob {*.[Cch]}]
}

#-----------------------------
# arg demo 1
set chop_first 0
if {![string compare [lindex $argv 0] {-c}]} {
    incr chop_first
    set argv [lrange $argv 1 end]
}

#-----------------------------
# arg demo 2
if [regexp -- {^-(\d+)$} [lindex $argv 0] all one] {
    set columns $one
    set argv [lrange $argv 1 end]
}

#-----------------------------
# arg demo 3 - clustered options
# unfortunately tcllib does not yet provide clustered opts
# so using the same logic as that of perl.
set append 0
set ignore_ints 0
set nostdout 0
set unbuffer 0
foreach arg $argv {
    #process arg for -abcd
    set parg $arg
    while 1 {
        if [regexp -- {^-(.)(.*)$} $parg all one two] {
            switch -- $one {
                {a} {incr append}
                {i} {incr ignore_ints}
                {n} {incr ignore_ints}
                {u} {incr unbuffer}
                default { error {usage: [-ainu] [filenames] ...}}
            }
            set parg -$two
        } else {
            break
        }
    }
}

#-----------------------------
set fd [open [lindex $argv 0]]
set data [read -nonewline $fd]
close $fd

#-----------------------------
foreach arg $argv {
    set F [open $arg r]
    for {set i 0} {[gets $F line] >= 0} {incr i} {
        puts $arg:$i:$line
    }
    close $F
}

#-----------------------------
foreach arg $argv {
    set F [open $arg r]
    while {[gets $F line] >= 0} {
        if [regexp -- {login} $line] {
            puts $line
        }
    }
    close $F
}

#-----------------------------
set fd [open [lindex $argv 0] r]
set data [read -nonewline $fd]
close $fd
set chunks 0
foreach line [split $data "\n"] {
    switch $line {
    {^#} continue
    {__(DATA|END)__} break
    default { set chunks [llength $line]}
}

puts "Found $chunks chunks"

Writing a Filter

Modifying a File in Place with Temporary File

#-----------------------------
set old [open $old_file]
set new [open $new_file w]
while {[gets $old line] >= 0} {
    # change $line, then...
    puts $new $line
}
close $old
close $new

file rename $old_file "old.orig"
file rename $new_file $old_file

for {set i 0} {[gets $old line] >= 0} {incr i} {
    if {$i == 20} { # we are at the 20th line
        puts $new "Extra line 1"
        puts $new "Extra line 2"
    }
    puts $new $line
}

for {set i 0} {[gets $old line] >= 0} {incr i} {
    if {![expr (20 <= $i) && ($i <= 30)]} {
        puts $new $line
    }
}

Modifying a File in Place with -i Switch

Modifying a File in Place Without a Temporary File

#-----------------------------
set fd [open {itest} r+]
set data [read -nonewline $fd]
regsub {foo} $data {QQQ} data
chan seek $fd 0
puts $fd $data
chan truncate $fd
close $fd

#-----------------------------
set fd [open {itest} r+]
set data [read -nonewline $fd]
regsub {foo} $data [clock format [clock seconds]] data
chan seek $fd 0
puts $fd $data
chan truncate $fd
close $fd

Locking a File

#-----------------------------
# tcl does not yet support locking of files though it is available in tclx
# @@INCOMPLETE@@
# @@INCOMPLETE@@

Flushing Output

#-----------------------------
chan configure $fd none
if [llength $argv] {
    chan configure stdout none
}
puts -nonewline {Now you dont see it...}
sleep 2
puts {Now you do}

#-----------------------------
# stderr is unbuffered by default. so this is not necessary
chan configure stderr none
chan configure $fd full

#-----------------------------
chan configure $sock none
chan configure $fd full

#-----------------------------
set sock [socket {www.tcl.tk} 80]
chan configure $sock -buffering none
puts $sock "GET / HTTP/1.0\n\n"
set resp [read -nonewline $sock]
close $sock
puts "DOC is \n$resp\n"

Reading from Many Filehandles Without Blocking

#-----------------------------
# assume fh1 fh2 fh3 are open channels
foreach $f {fh1 fh2 fh3} {
    chan event [set $f] readable {
        # do something when this becomes readable.
    }
    chan event [set $f] writable {
        # do something when this becomes writable.
    }
}
vwait forever

Doing Non-Blocking I/O

#-----------------------------
set fd [open {/dev/cua0} r+]
chan configure $fd -blocking 0

#-----------------------------
set blocked [chan configure $fd -blocking]
chan configure $fd -blocking 0

#-----------------------------
chan configure $fd -blocking 0
chan puts $fd {some data}
if [chan blocked $fd] {
    # incomplete write, but there is no case of
    # us having to redo the write again since tcl
    # does it in the back ground for us.
}

set buffer [chan read -nonewline $fd $bufsize]
if [chan blocked $fd] {
    # did not read full bufsize.
}

Determining the Number of Bytes to Read

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

Storing Filehandles in Variables

#-----------------------------
# tcl filehandles are like any other vars
set fd [open {myfile}]
set newfd $fd
set data [myproc $newfd]

Caching Open Output Filehandles

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

Printing to Many Filehandles Simultaneously

#-----------------------------
foreach $f {fh1 fh2 fh3} {
    puts [set $f] $stuff_to_print
}

#-----------------------------
set fd [open {| tee file1 file2 > /dev/null} w]
puts $fd {data\n}
close $fd

Opening and Closing File Descriptors by Number

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

Copying Filehandles

#-----------------------------
# file descriptors are just like any other variables
set fd [open {file}]
set newfd $fd

Program: netlock

Program: lockarea