TIP #670: Simple Extra Procedures for File Access

doc/library.n

@@ -25,6 +25,11 @@ auto_execok, auto_import, auto_load, auto_mkindex, auto_qualify, auto_reset, tcl
 \fBtcl_startOfPreviousWord \fIstr start\fR
 \fBtcl_wordBreakAfter \fIstr start\fR
 \fBtcl_wordBreakBefore \fIstr start\fR
+.VS "Tcl 8.7, TIP 670"
+\fBforeachLine \fIfilename varName body\fR
+\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
+\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
+.VE "Tcl 8.7, TIP 670"
 .BE
 .SH INTRODUCTION
 .PP
@@ -306,6 +311,41 @@ Returns the index of the first word boundary before the starting index
 boundaries before the starting point in the given string.  The index
 returned refers to the second character of the pair that comprises a
 boundary.
+.TP
+\fBforeachLine \fIvarName filename body\fR
+.VS "Tcl 8.7, TIP 670"
+This reads in the text file named \fIfilename\fR one line at a time
+(using system defaults for reading text files). It writes that line to the
+variable named by \fIvarName\fR and then executes \fIbody\fR for that line.
+The result value of \fIbody\fR is ignored, but \fBerror\fR, \fBreturn\fR,
+\fBbreak\fR and \fBcontinue\fR may be used within it to produce an error,
+return from the calling context, stop the loop, or go to the next line
+respectively.
+The overall result of \fBforeachLine\fR is the empty string (assuming no
+errors from I/O or from evaluating the body of the loop); the file will be
+closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
+.TP
+\fBreadFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR?
+.VS "Tcl 8.7, TIP 670"
+Reads in the file named in \fIfilename\fR and returns its contents.
+The second argument says how to read in the file, either as \fBtext\fR
+(using the system defaults for reading text files) or as \fBbinary\fR
+(as uninterpreted bytes). The default is \fBtext\fR. When read as text, this
+will include any trailing newline.
+The file will be closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
+.TP
+\fBwriteFile \fIfilename\fR ?\fBtext\fR|\fBbinary\fR? \fIcontents\fR
+.VS "Tcl 8.7, TIP 670"
+Writes the \fIcontents\fR to the file named in \fIfilename\fR.
+The optional second argument says how to write to the file, either as
+\fBtext\fR (using the system defaults for writing text files) or as
+\fBbinary\fR (as uninterpreted bytes). The default is \fBtext\fR.
+If a trailing newline is required, it will need to be provided in
+\fIcontents\fR. The result of this command is the empty string; the file will
+be closed prior to the procedure returning.
+.VE "Tcl 8.7, TIP 670"
 .SH "VARIABLES"
 .PP
 The following global variables are defined or used by the procedures in

library/foreachline.tcl

@@ -0,0 +1,25 @@
+# foreachLine:
+# Iterate over the contents of a file, a line at a time.
+# The body script is run for each, with variable varName set to the line
+# contents.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc foreachLine {varName filename body} {
+    upvar 1 $varName line
+    set f [open $filename "r"]
+    try {
+	while {[gets $f line] >= 0} {
+	    uplevel 1 $body
+	}
+    } on return {msg opt} {
+	dict incr opt -level
+	return -options $opt $msg
+    } finally {
+	close $f
+    }
+}

library/readfile.tcl

@@ -0,0 +1,23 @@
+# readFile:
+# Read the contents of a file.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc readFile {filename {mode text}} {
+    # Parse the arguments
+    set MODES {binary text}
+    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
+    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
+
+    # Read the file
+    set f [open $filename [dict get {text r binary rb} $mode]]
+    try {
+	return [read $f]
+    } finally {
+	close $f
+    }
+}

library/tclIndex

@@ -19,6 +19,7 @@ set auto_index(::auto_mkindex_parser::childhook) [list ::tcl::Pkg::source [file
 set auto_index(::auto_mkindex_parser::command) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
 set auto_index(::auto_mkindex_parser::commandInit) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
 set auto_index(::auto_mkindex_parser::fullname) [list ::tcl::Pkg::source [file join $dir auto.tcl]]
+set auto_index(foreachLine) [list ::tcl::Pkg::source [file join $dir foreachline.tcl]]
 set auto_index(history) [list ::tcl::Pkg::source [file join $dir history.tcl]]
 set auto_index(::tcl::HistAdd) [list ::tcl::Pkg::source [file join $dir history.tcl]]
 set auto_index(::tcl::HistKeep) [list ::tcl::Pkg::source [file join $dir history.tcl]]
@@ -34,6 +35,7 @@ set auto_index(tclPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.t
 set auto_index(::tcl::MacOSXPkgUnknown) [list ::tcl::Pkg::source [file join $dir package.tcl]]
 set auto_index(::pkg::create) [list ::tcl::Pkg::source [file join $dir package.tcl]]
 set auto_index(parray) [list ::tcl::Pkg::source [file join $dir parray.tcl]]
+set auto_index(readFile) [list ::tcl::Pkg::source [file join $dir readfile.tcl]]
 set auto_index(::safe::InterpStatics) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
 set auto_index(::safe::InterpNested) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
 set auto_index(::safe::interpCreate) [list ::tcl::Pkg::source [file join $dir safe.tcl]]
@@ -67,6 +69,7 @@ set auto_index(tcl_wordBreakBefore) [list ::tcl::Pkg::source [file join $dir wor
 set auto_index(tcl_endOfWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
 set auto_index(tcl_startOfNextWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
 set auto_index(tcl_startOfPreviousWord) [list ::tcl::Pkg::source [file join $dir word.tcl]]
+set auto_index(writeFile) [list ::tcl::Pkg::source [file join $dir writefile.tcl]]
 set auto_index(::tcl::tm::add) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
 set auto_index(::tcl::tm::remove) [list ::tcl::Pkg::source [file join $dir tm.tcl]]
 set auto_index(::tcl::tm::list) [list ::tcl::Pkg::source [file join $dir tm.tcl]]

library/writefile.tcl

@@ -0,0 +1,37 @@
+# writeFile:
+# Write the contents of a file.
+#
+# Copyright © 2023 Donal K Fellows.
+#
+# See the file "license.terms" for information on usage and redistribution
+# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+#
+
+proc writeFile {args} {
+    # Parse the arguments
+    switch [llength $args] {
+	2 {
+	    lassign $args filename data
+	    set mode text
+	}
+	3 {
+	    lassign $args filename mode data
+	    set MODES {binary text}
+	    set ERR [list -level 1 -errorcode [list TCL LOOKUP MODE $mode]]
+	    set mode [tcl::prefix match -message "mode" -error $ERR $MODES $mode]
+	}
+	default {
+	    set COMMAND [lindex [info level 0] 0]
+	    return -code error -errorcode {TCL WRONGARGS} \
+		"wrong # args: should be \"$COMMAND filename ?mode? data\""
+	}
+    }
+
+    # Write the file
+    set f [open $filename [dict get {text w binary wb} $mode]]
+    try {
+	puts -nonewline $f $data
+    } finally {
+	close $f
+    }
+}

tests/ioCmd.test

@@ -1,6 +1,7 @@
 # -*- tcl -*-
 # Commands covered: open, close, gets, read, puts, seek, tell, eof, flush,
-#		    fblocked, fconfigure, open, channel, fcopy
+#		    fblocked, fconfigure, open, channel, fcopy,
+#		    readFile, writeFile, foreachLine
 #
 # This file contains a collection of tests for one or more of the Tcl
 # built-in commands.  Sourcing this file into Tcl runs the tests and
@@ -3927,6 +3928,207 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
 } -constraints {testchannel thread notValgrind} \
     -result {Owner lost}
 
+# Tests of readFile
+
+set BIN_DATA "\u0000\u0001\u0002\u0003\u0004\u001a\u001b\u000d\u000a\u0000"
+
+test iocmd.readFile-1.1 "readFile procedure: syntax" -body {
+    readFile
+} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
+test iocmd.readFile-1.2 "readFile procedure: syntax" -body {
+    readFile a b c
+} -returnCodes error -result {wrong # args: should be "readFile filename ?mode?"}
+test iocmd.readFile-1.3 "readFile procedure: syntax" -body {
+    readFile gorp gorp2
+} -returnCodes error -result {bad mode "gorp2": must be binary or text}
+
+test iocmd.readFile-2.1 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile21.txt "File\nContents"]
+} -body {
+    readFile $f
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.readFile-2.2 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile22.txt "File\nContents"]
+} -body {
+    readFile $f text
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.readFile-2.3 "readFile procedure: behaviour" -setup {
+    set f [makeFile readFile23.bin ""]
+    apply {filename {
+	set ff [open $filename wb]
+	puts -nonewline $ff $BIN_DATA
+	close $ff
+    }} $f
+} -body {
+    list [binary scan [readFile $f binary] c* x] $x
+} -cleanup {
+    removeFile $f
+} -result {1 {0 1 2 3 4 26 27 13 10 0}}
+# Need to set up ahead of the test
+set f [makeFile readFile24.txt ""]
+removeFile $f
+test iocmd.readFile-2.4 "readFile procedure: behaviour" -body {
+    readFile $f
+} -returnCodes error -result "couldn't open \"$f\": no such file or directory"
+
+# Tests of writeFile
+
+test iocmd.writeFile-1.1 "writeFile procedure: syntax" -body {
+    writeFile
+} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
+test iocmd.writeFile-1.2 "writeFile procedure: syntax" -body {
+    writeFile a b c d
+} -returnCodes error -result {wrong # args: should be "writeFile filename ?mode? data"}
+test iocmd.writeFile-1.3 "writeFile procedure: syntax" -body {
+    writeFile gorp gorp2 gorp3
+} -returnCodes error -result {bad mode "gorp2": must be binary or text}
+
+test iocmd.writeFile-2.1 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile21.txt ""]
+    removeFile $f
+} -body {
+    list [writeFile $f "File\nContents\n"] [apply {filename {
+	set f [open $filename]
+	set text [read $f]
+	close $f
+	return $text
+    }} $f]
+} -cleanup {
+    removeFile $f
+} -result [list {} "File\nContents\n"]
+test iocmd.writeFile-2.2 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile22.txt ""]
+    removeFile $f
+} -body {
+    writeFile $f text "File\nContents\n"
+    apply {filename {
+	set f [open $filename]
+	set text [read $f]
+	close $f
+	return $text
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result "File\nContents\n"
+test iocmd.writeFile-2.3 "readFile procedure: behaviour" -setup {
+    set f [makeFile writeFile23.txt ""]
+    removeFile $f
+} -body {
+    writeFile $f binary $BIN_DATA
+    apply {filename {
+	set f [open $filename rb]
+	set bytes [read $f]
+	close $f
+	binary scan $bytes c* x
+	return $x
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {0 1 2 3 4 26 27 13 10 0}
+
+# Tests of foreachLine
+
+test iocmd.foreachLine-1.1 "foreachLine procedure: syntax" -returnCodes error -body {
+    foreachLine
+} -result {wrong # args: should be "foreachLine varName filename body"}
+test iocmd.foreachLine-1.2 "foreachLine procedure: syntax" -returnCodes error -body {
+    foreachLine a b c d
+} -result {wrong # args: should be "foreachLine varName filename body"}
+test iocmd.foreachLine-1.3 "foreachLine procedure: basic errors" -setup {
+    set f [makeFile foreachLine13.txt ""]
+} -body {
+    apply {filename {
+	array set b {1 1}
+        foreachLine b $filename {}
+    }} $f
+} -cleanup {
+    removeFile $f
+} -returnCodes error -result {can't set "line": variable is array}
+set f [makeFile foreachLine14.txt ""]
+removeFile $f
+test iocmd.foreachLine-1.4 "foreachLine procedure: basic errors" -body {
+    apply {filename {
+	foreachLine var $filename {}
+    }} $f
+} -returnCodes error -result "couldn't open \"$f\": no such file or directory"
+
+test iocmd.foreachLine-2.1 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine21.txt "a\nb\nc"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine var $filename {
+	    lappend lines $var
+	}
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {a b c}
+test iocmd.foreachLine-2.2 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine22.txt "a\nbb\nc\ndd"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine var $filename {
+	    if {[string length $var] == 1} continue
+	    lappend lines $var
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {bb dd}
+test iocmd.foreachLine-2.3 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine23.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine var $filename {
+	    if {[string length $var] > 2} break
+	    lappend lines $var
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {a bb}
+test iocmd.foreachLine-2.4 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine24.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+    	set lines {}
+	foreachLine var $filename {
+	    if {[string length $var] > 2} {
+		return $var
+	    }
+	    lappend lines $var
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -result {ccc}
+test iocmd.foreachLine-2.5 "foreachLine procedure: behaviour" -setup {
+    set f [makeFile foreachLine25.txt "a\nbb\nccc\ndd\ne"]
+} -body {
+    apply {filename {
+	set lines {}
+	foreachLine var $filename {
+	    if {[string length $var] > 2} {
+		error "line too long"
+	    }
+	    lappend lines $var
+	}
+	return $lines
+    }} $f
+} -cleanup {
+    removeFile $f
+} -returnCodes error -result {line too long}
+
 # ### ### ### ######### ######### #########
 
 # ### ### ### ######### ######### #########