% set f [cfile /etc/passwd]
::cfile::file1
% $f gets
root:x:0:0:root:/root:/bin/zsh

source cfile.tcl

# Example 1: counts the number of lines inside /etc/passwd
set f [cfile /etc/passwd]
set lines [llength [$f lines]]
puts "/etc/passwd is composed of $lines lines"
$f close

# Example 2: put the whole file content into the $content variable
set f [cfile /etc/passwd]
set content [$f content]
puts "/etc/passwd contains [string length $content] characters"
$f close

# Example 3: counts the number of lines inside /etc/passwd matching */bin/sh*
set f [cfile /etc/passwd]
set matches 0
$f foreach line {
    if {[string match {*/bin/sh*} $line]} {
        incr matches
    }
}
$f close
puts "It contains $matches lines matching */bin/sh*"

# Example 4: Alternative of Example 3 using the 'map' method.
set f [cfile /etc/passwd]
set matches [expr [join [$f map line {string match {*/bin/sh*} $line}] +]]
puts "It contains $matches lines matching */bin/sh* (2)"
$f close

# Example 5: Sorts the lines of /etc/passwd and write the sorted
# version of the file in /tmp/sorted.txt
set f [cfile /etc/passwd]
set lines [lsort [$f lines]]
$f close
set f [cfile /tmp/sorted.txt w]
$f putlist $lines
$f close

# Example 6: Auto close a file when a procedure exits
proc foobar {} {
    set f [cfile /etc/passwd]
    $f autoclean
    # Do some work, possibly complex with handling of special coditions...
    # The $f file will be automatically closed when the procedure returns.
}
 
foobar

# Cfile - Object based interface for file handling in Tcl.
# Copyright (C) 2004 Salvatore Sanfilippo <[email protected]>
# This software is released under the BSD license.
 
package provide cfile 0.1
 
namespace eval cfile {}
set ::cfile::id 0
array set ::cfile::fd {}
 
proc cfile {filename args} {
     switch -- [llength $args] {
        0 {set fd [open $filename]}
        1 {set fd [open $filename [lindex $args 0]]}
        2 {set fd [open $filename [lindex $args 0] [lindex $args 1]]}
        default {
            return -code error "wrong # of args for command"
        }
     }
     set id [incr ::cfile::id]
     set ::cfile::fd($id) $fd
     interp alias {} ::cfile::file$id {} ::cfile::__dispatch__ $id
}
 
proc cfileFromChannel channel {
     set id [incr ::cfile::id]
     set ::cfile::fd($id) $channel
     interp alias {} ::cfile::file$id {} ::cfile::__dispatch__ $id
}
 
proc ::cfile::__dispatch__ {id method args} {
     if {[info command ::cfile::__method__$method] eq {}} {
        return -code error "cfile: no such subcommand: '$method'"
     }
     set fd $::cfile::fd($id)
     uplevel 1 [list ::cfile::__method__$method $id $fd] $args
}
 
# Close the file
proc ::cfile::__method__close {id fd} {
     catch {close $fd}
     catch {unset ::cfile::fd($id)}
     catch {interp alias {} $::cfile::file$id {}}
}
 
# Return the file channel
proc ::cfile::__method__channel {id fd} {
     return $fd
}
 
# Return the whole content of the file.
proc ::cfile::__method__content {id fd} {
     catch {seek $fd 0}
     set buf [read $fd]
     return $buf
}
 
# method similar to the [gets] command.
proc ::cfile::__method__gets {id fd args} {
     if {![llength $args]} {
        gets $fd
     } else {
        upvar 1 [lindex $args 0] var
        gets $fd var
     }
}
 
# method similar to the [read] command.
proc ::cfile::__method__read {id fd {count {}}} {
     if {$count eq {}} {
        return [read $fd]
     } else {
        return [read $fd $count]
     }
}
 
# method similar to the [puts] command.
proc ::cfile::__method__puts {id fd buf} {
     puts $fd $buf
}
 
# method similar to the [puts] command with the -nonewline option
proc ::cfile::__method__write {id fd buf} {
     puts -nonewline $fd $buf
}
 
# method foreach:
# Execute a Tcl script for each line of file
proc ::cfile::__method__foreach {id fd var script} {
     catch {seek $fd 0}
     upvar 1 $var line
     while {[gets $fd line] != -1} {
        uplevel 1 $script
     }
}
 
# method map:
# Execute a Tcl script for each line of file, accumulate the result
# of every iteration into a list, returned as result.
proc ::cfile::__method__map {id fd var script} {
     catch {seek $fd 0}
     set result {}
     upvar 1 $var line
     while {[gets $fd line] != -1} {
        lappend result [uplevel 1 $script]
     }
     return $result
}
 
# method lines: return all the file lines as a Tcl list.
proc ::cfile::__method__lines {id fd} {
     catch {seek $fd 0}
     set result {}
     while {[gets $fd line] != -1} {
        lappend result $line
     }
     return $result
}
 
# method putlist: write every element of $list as a file line.
proc ::cfile::__method__putlist {id fd list} {
     foreach e $list {
        puts $fd $e
     }
}
 
# method similar to the [seek] command.
proc ::cfile::__method__seek {id fd offset {origin start}} {
     seek $fd $offset $origin
}
 
# method rewind: equivalent to "seek 0"
proc ::cfile::__method__rewind {id fd} {
     seek $fd 0
}
 
# method similar to the [tell] command.
proc ::cfile::__method__tell {id fd} {
     tell $fd
}
 
# method blocking: set the channel blocking mode on/off
proc ::cfile::__method__blocking {id fd val} {
     fconfigure $fd -blocking $val
}
 
# method encoding: set the channel encoding
proc ::cfile::__method__encoding {id fd val} {
     fconfigure $fd -encoding $val
}
 
# method translation: set the channel translation mode
proc ::cfile::__method__translation {id fd val} {
     fconfigure $fd -translation $val
}
 
# method buffering: set the channel buffering mode
proc ::cfile::__method__buffering {id fd val} {
     fconfigure $fd -buffering $val
}
 
# method flush: calls [flush] against the file channel
proc ::cfile::__method__flush {id fd} {
     flush $fd
}
 
# method readable: set a callback for the 'fileevent readable' event.
proc ::cfile::__method__readable {id fd script} {
     fileevent $fd readable $script
}
 
# method writable: set a callback for the 'fileevent writable' event.
proc ::cfile::__method__readable {id fd script} {
     fileevent $fd writable $script
}
 
# method to automatically free a cfile once the current procedure returns.
proc ::cfile::__method__autoclean {id fd} {
     set var __cfile__autoclean__$id
     uplevel 1 [list set $var {}]
     uplevel 1 [list trace add variable $var unset ::cfile::autocleanCallback]
}
 
# The trace callback handler for the 'autoclean' method.
proc ::cfile::autocleanCallback {name1 name2 op} {
     set id [string range $name1 21 end]
     ::cfile::file$id close
}

 proc chan: {c cmd args} { uplevel 1 [linsert $args 0 ::chan $cmd $c] }
 interp alias {} log {} chan: [open myapp.log w]
 log configure -buffering line -encoding utf-8
 log puts "INFO: this is a test..."
 ...
 log close