Index: ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/ChangeLog,v
retrieving revision 1.70
diff -u -r1.70 ChangeLog
--- ChangeLog	2001/11/07 02:48:29	1.70
+++ ChangeLog	2001/11/07 04:29:21
@@ -1,3 +1,8 @@
+2001-11-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* fileutil: Accepted Patch #477805.
+	* ftp:      Accepted Patch #478478.
+
 2001-11-04  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
 	* ftp: Fixed bug #476729.
Index: modules/fileutil/ChangeLog
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/ChangeLog,v
retrieving revision 1.7
diff -u -r1.7 ChangeLog
--- modules/fileutil/ChangeLog	2001/09/05 23:53:52	1.7
+++ modules/fileutil/ChangeLog	2001/11/07 04:29:22
@@ -1,3 +1,12 @@
+2001-11-06  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
+
+	* fileutil.test:
+	* fileutil.n:
+	* fileutil.tcl: Applied patch #477805 by Glenn Jackman
+	  <glennjnn@users.sourceforge.net> implementing the unix 'touch'
+	  command. Contains documentation and testsuite for the new
+	  command too.
+
 2001-09-05  Andreas Kupries  <andreas_kupries@users.sourceforge.net>
 
 	* fileutil.tcl: Restricted export list to public API.
Index: modules/fileutil/fileutil.n
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.n,v
retrieving revision 1.5
diff -u -r1.5 fileutil.n
--- modules/fileutil/fileutil.n	2001/08/24 17:01:00	1.5
+++ modules/fileutil/fileutil.n	2001/11/07 04:29:22
@@ -24,6 +24,8 @@
 \fB::fileutil::foreachLine\fR \fIvar filename cmd\fR
 .sp
 \fB::fileutil::grep\fR \fIpattern\fR ?\fIfiles\fR?
+.sp
+\fB::fileutil::touch\fR ?\fI-a\fR? ?\fI-c\fR? ?\fI-m\fR? ?\fI-r ref_file\fR? ?\fI-t time\fR? \fIfilename\fR ?\fI...\fR?
 .BE
 .SH DESCRIPTION
 .PP
@@ -75,6 +77,14 @@
 is a list containing the matches. Each match is a single element of
 the list and contains filename, number and contents of the matching
 line, separated by a colons.
+.TP
+\fB::fileutil::touch\fR ?\fI-a\fR? ?\fI-c\fR? ?\fI-m\fR? ?\fI-r ref_file\fR? ?\fI-t time\fR? \fIfilename\fR ?\fI...\fR?
+Implementation of touch. Alter the atime and mtime of the specified
+files. If \fI-c\fR, do not create files if they do not already
+exist. If \fI-r\fR, use the atime and mtime from \fIref_file\fR. If
+\fI-t\fR, use the integer clock value \fItime\fR. It is illegal to 
+specify both \fI-r\fR and \fI-t\fR. If \fI-a\fR, only change the 
+atime. If \fI-m\fR, only change the mtime. 
 
 .SH KEYWORDS
 file utilities
Index: modules/fileutil/fileutil.tcl
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.tcl,v
retrieving revision 1.9
diff -u -r1.9 fileutil.tcl
--- modules/fileutil/fileutil.tcl	2001/09/05 23:53:52	1.9
+++ modules/fileutil/fileutil.tcl	2001/11/07 04:29:22
@@ -10,10 +10,11 @@
 # RCS: @(#) $Id: fileutil.tcl,v 1.9 2001/09/05 23:53:52 andreas_kupries Exp $
 
 package require Tcl 8
+package require cmdline
 package provide fileutil 1.2
 
 namespace eval ::fileutil {
-    namespace export grep find findByPattern cat foreachLine
+    namespace export grep find findByPattern cat foreachLine touch
 }
 
 # ::fileutil::grep --
@@ -327,4 +328,69 @@
 		$result
     }
     return -code $code $result
+}
+
+# ::fileutil::touch --
+#
+#	Tcl implementation of the UNIX "touch" command.
+#
+#	touch [-a] [-m] [-c] [-r ref_file] [-t time] filename ...
+#
+# Arguments:
+#	-a		change the access time only, unless -m also specified
+#	-m		change the modification time only, unless -a also specified
+#	-c		silently prevent creating a file if it did not previously exist
+#	-r ref_file	use the ref_file's time instead of the current time
+#	-t time		use the specified time instead of the current time
+#			("time" is an integer clock value, like [clock seconds])
+#	filename ...	the files to modify
+#
+# Results
+#	None.
+#
+# Errors:
+#	Both of "-r" and "-t" cannot be specified.
+
+proc ::fileutil::touch {args} {
+    # Don't bother catching errors, just let them propagate up
+
+    set options {
+        {a          "set the atime only"}
+        {m          "set the mtime only"}
+        {c          "do not create non-existant files"}
+        {r.arg  ""  "use time from ref_file"}
+        {t.arg  -1  "use specified time"}
+    }
+    array set params [::cmdline::getoptions args $options]
+
+    # process -a and -m options
+    set set_atime [set set_mtime "true"]
+    if {  $params(a) && ! $params(m)} {set set_mtime "false"}
+    if {! $params(a) &&   $params(m)} {set set_atime "false"}
+
+    # process -r and -t
+    set has_t [expr {$params(t) != -1}]
+    set has_r [expr {[string length $params(r)] > 0}]
+    if {$has_t && $has_r} {
+        return -code error "Cannot specify both -r and -t"
+    } elseif {$has_t} {
+        set atime [set mtime $params(t)]
+    } elseif {$has_r} {
+        file stat $params(r) stat
+        set atime $stat(atime)
+        set mtime $stat(mtime)
+    } else {
+        set atime [set mtime [clock seconds]]
+    }
+
+    # do it
+    foreach filename $args {
+        if {! [file exists $filename]} {
+            if {$params(c)} {continue}
+            close [open $filename w]
+        }
+        if {$set_atime} {file atime $filename $atime}
+        if {$set_mtime} {file mtime $filename $mtime}
+    }
+    return
 }
Index: modules/fileutil/fileutil.test
===================================================================
RCS file: /cvsroot/tcllib/tcllib/modules/fileutil/fileutil.test,v
retrieving revision 1.5
diff -u -r1.5 fileutil.test
--- modules/fileutil/fileutil.test	2001/08/24 17:01:00	1.5
+++ modules/fileutil/fileutil.test	2001/11/07 04:29:22
@@ -129,5 +129,150 @@
     set res
 } {/foo/bar/baz}
 
+
+
+catch {removeDirectory touchTest} ; # start with a clean structure!
+makeDirectory touchTest
+makeFile "blah" [file join $dir touchTest file1]
+
+test touch-1.1 {create file} {
+    set f [file join $dir touchTest here]
+    fileutil::touch $f
+    # reap this file on cleanup
+    lappend ::tcltest::filesmade $f
+    file exists $f
+} 1
+test touch-1.2 {'-c' prevents file creation} {
+    set f [file join $dir touchTest nothere]
+    fileutil::touch -c $f
+    file exists $f
+} 0
+test touch-1.3 {'-c' has no effect on existing files} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch -c $f
+    file exists $f
+} 1
+test touch-1.4 {test relative times} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    after 1001
+    fileutil::touch $f
+    set a2 [file atime $f]
+    set m2 [file mtime $f]
+    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
+} [list 1 1 1 1]
+test touch-1.5 {test relative times using -a} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    after 1001
+    fileutil::touch -a $f
+    set a2 [file atime $f]
+    set m2 [file mtime $f]
+    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
+} [list 1 0 1 0]
+test touch-1.6 {test relative times using -m} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    after 1001
+    fileutil::touch -m $f
+    set a2 [file atime $f]
+    set m2 [file mtime $f]
+    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
+} [list 1 0 0 1]
+test touch-1.7 {test relative times using -a and -m} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    after 1001
+    fileutil::touch -a -m $f
+    set a2 [file atime $f]
+    set m2 [file mtime $f]
+    list [expr {$a1 == $m1}] [expr {$a2 == $m2}] [expr {$a1 < $a2}] [expr {$m1 < $m2}]
+} [list 1 1 1 1]
+test touch-1.8 {test -t} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -t 42 $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == 42}] [expr {$m1 == 42}]
+} [list 1 1]
+test touch-1.9 {test -t with -a} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -t 42 -a $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == 42}] [expr {$m1 == 42}]
+} [list 1 0]
+test touch-1.10 {test -t with -m} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -t 42 -m $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == 42}] [expr {$m1 == 42}]
+} [list 0 1]
+test touch-1.11 {test -t with -a and -m} {
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -t 42 -a -m $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == 42}] [expr {$m1 == 42}]
+} [list 1 1]
+test touch-1.12 {test -r} {
+    set r [info script]
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -r $r $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
+} [list 1 1]
+test touch-1.13 {test -r with -a} {
+    set r [info script]
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -r $r -a $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
+} [list 1 0]
+test touch-1.14 {test -r with -m} {
+    set r [info script]
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -r $r -m $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
+} [list 0 1]
+test touch-1.15 {test -r with -a and -m} {
+    set r [info script]
+    set f [file join $dir touchTest file1]
+    fileutil::touch $f
+    after 1001
+    fileutil::touch -r $r -m -a $f
+    set a1 [file atime $f]
+    set m1 [file mtime $f]
+    list [expr {$a1 == [file atime $r]}] [expr {$m1 == [file mtime $r]}]
+} [list 1 1]
+
+
 ::tcltest::cleanupTests
 return
