% 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 <antirez@invece.org>
 # 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

• Home
• Recent changes
• Help
• WhoAmI/Logout
• Create new page
• Random page
• 
  
• Add comments
• Edit
• History
• Edit summary
• References