Attachment "touch.diff" to
ticket [477805ffff]
added by
andreas_kupries
2001-11-07 11:31:46.
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 <[email protected]>
+
+ * fileutil: Accepted Patch #477805.
+ * ftp: Accepted Patch #478478.
+
2001-11-04 Andreas Kupries <[email protected]>
* 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 <[email protected]>
+
+ * fileutil.test:
+ * fileutil.n:
+ * fileutil.tcl: Applied patch #477805 by Glenn Jackman
+ <[email protected]> implementing the unix 'touch'
+ command. Contains documentation and testsuite for the new
+ command too.
+
2001-09-05 Andreas Kupries <[email protected]>
* 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
