Attachment "fileutil.tcl.diff" to
ticket [477805ffff]
added by
glennjnn
2001-11-04 00:02:55.
*** fileutil.tcl~ Sat Nov 3 11:56:22 2001
--- fileutil.tcl Sat Nov 3 11:57:42 2001
***************
*** 328,330 ****
--- 328,392 ----
}
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
+ #
+ # Errors:
+ # Both of "-r" and "-t" cannot be specified.
+
+ proc ::fileutil::touch {args} {
+ # Don't bother catching errors, just let them propagate up
+
+ package require cmdline
+ 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} {
+ 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}
+ }
+ }
