9. Directories

Introduction

# feat. Bob Techentin
#-----------------------------
if {[catch {file stat /usr/bin/vi entry} err]} {error "Couldn't stat /usr/bin/vi : $err"}
#-----------------------------
if {[catch {file stat /usr/bin entry} err]} {error "Couldn't stat /usr/bin : $err"}
#-----------------------------
# can't [file stat] a filehandle
#-----------------------------
file stat /usr/bin/vi inode
set ctime $inode(ctime)
set size $inode(size)

# or you can use specific [file] subcommands
set size [file size /usr/bin/vi]
#-----------------------------
#  You have to read the file to test for binary data
if {![catch {open $filename r} F]} {
        set data [read $F]
        close $F
        if {![string is ascii $data]} {
                error "$filename doesn't have text in it."
        }
} else {
        error "Opening $filename: $F"
}
#-----------------------------
set files [glob /usr/bin/*]
foreach f $files {
    puts "Inside /usr/bin is something called [file tail $f]"
}
#-----------------------------

Getting and Setting Timestamps

# feat. Bob Techentin
#-----------------------------
set READTIME [file atime $filename]
set WRITETIME [file mtime $filename]

file atime $filename $NEWREADTIME
file mtime $filename $NEWWRITETIME
#-----------------------------
set atime [file atime $filename]
set mtime [file mtime $filename]

set atime [clock scan "- 1 week" -base $atime]
set mtime [clock scan "- 1 week" -base $mtime]

if {[catch {
        file atime $filename $atime
        file mtime $filename $mtime
} err]} {
        error "couldn't backdate $filename by a week w/ file (a|m)time: $err"
}
#-----------------------------
file atime $file [clock seconds]
#-----------------------------
#!/bin/sh
# uvi - vi a file without changing its access times
# the next line restarts using tclsh \
exec tclsh "$0" "$@"
if {[llength $argv] != 1} {
        error "usage: uvi filename"
}
set file [lindex $argv 0]
file stat $file statinfo
if {[info exists env(EDITOR)]} {
        exec $env(EDITOR) $file
} else {
        exec vi $file
}
file atime $file $statinfo(atime)
file mtime $file $statinfo(mtime)
#-----------------------------

Deleting a File

# feat. Bob Techentin
#-----------------------------
file delete $filename
eval file delete $filenames
#-----------------------------
if {[catch {file delete $file}]} {
        error "Can't unlink $file"
}
#-----------------------------

#  Tcl's [file delete] command doesn't return a count,
#  so we have to count files before and after deletion.
set existing 0
foreach f $filelist {
        if {[file exists $f]} {incr existing}
}
catch {eval file delete $filelist}
set remaining 0
foreach f $filelist {
        if {[file exists $f]} {incr remaining}
}
if {$remaining > 0} {
        set count [expr {$existing-$remaining}]
        puts stderr "could only delete $count of $existing files"
}
#-----------------------------# feat. Bob Techentin
#-----------------------------
file delete $filename
eval file delete $filenames
#-----------------------------
if {[catch {file delete $file}]} {
        error "Can't unlink $file"
}
#-----------------------------

if {[catch {eval file delete $filelist}]} {
        set remaining 0
        foreach f $filelist {
                if {[file exists $f]} {incr remaining}
        }
        set count [expr {[llength $filelist] - $remaining}]
        puts stderr "could only delete $count of $existing files"
}
#  Tcl's [file delete] command doesn't return a count,
#  so we have to count files before and after deletion.
set existing 0
foreach f $filelist {
        if {[file exists $f]} {incr existing}
}
catch {eval file delete $filelist}
set remaining 0
foreach f $filelist {
        if {[file exists $f]} {incr remaining}
}
if {$remaining > 0} {
        set count [expr {$existing-$remaining}]
        puts stderr "could only delete $count of $existing files"
}
#-----------------------------

Copying or Moving a File

# feat. Bob Techentin
#-----------------------------
file copy $oldfile $newfile
#-----------------------------
if {[catch {open $oldfile "r"} IN]}  {error "can't open $oldfile: $IN"}
if {[catch {open $newfile "w"} OUT]} {error "can't open $newfile: $OUT"}

set blksize [fconfigure $IN -buffersize]
fcopy $IN $OUT -size $blksize
close $IN
close $OUT

#-----------------------------
#  Tcl file operations are portable
file copy $oldfile $newfile
#-----------------------------
file copy datafile.dat datafile.bak
file rename -force datafile.new datafile.dat
#-----------------------------

Recognizing Two Names for the Same File

# feat. Bob Techentin
#-----------------------------

unset seen
foreach filename $argv {
        file stat $filename statinfo
        set dev $statinfo(dev)
        set ino $statinfo(ino)
        if {![info exists seen($dev,$ino)]} {
                #  do something with $filename because
                #  we haven't seen it before

                lappend seen($dev,$ino) $filename
                #  seen($dev,$ino) is a list of filenames for the same file
        }
}

#-----------------------------

Processing All Files in a Directory

# feat. Bob Techentin
#-----------------------------
foreach file [glob [file join $dirname "*"]] {
        # do something with $file
}
#-----------------------------
set dir /usr/local/bin
puts "Text files in $dir are:"
foreach file [glob [file join $dir "*"]] {
        set fp [open $file "r"]
        if {[string is ascii [read $fp]]} {
                puts $file
        }
        close $fp
}
#-----------------------------
foreach file [glob [file join $dir "*"]] {
        if {$file eq ".." || $file eq "."} continue
        # ...
}
#-----------------------------
proc plainfiles {dir} {
        set result [list]
        foreach file [lsort [glob [file join $dir "*"]]] {
                if {[string index [file tail $file] 0] eq "."} continue
                if {[file type $file] eq "file"} {
                        lappend result $file
                }
        }
        return $result
}
#-----------------------------

Globbing, or Getting a List of Filenames Matching a Pattern

# List of regular files in current directory - file names only in list
set files [glob -nocomplain -type f -- *.c]

# -------------

# As above, but with full path
set files [glob -directory [pwd] -nocomplain -type f -- *.c]

# -------------

# As previous [which is more compact, so preferred], showing use of 'file' to build file names
set pwd [pwd] ; set files [glob -nocomplain -type f -- *.c]

# Assemble full path names from list entries
foreach f $files {
  puts [file nativename [file join "$pwd" "$f"]]
}

# -------------

# Variants of the *NIX, 'find', command from the 'fileutil' package
package require fileutil

# Set search path to current directory. Could have also have used either of ~,
# for the user's HOME directory, or a relative / absolute path
set path .

# -----

# 1. Similar to, 'glob', but also allows 'regexp'-based globbing
set files [fileutil::findByPattern $path -glob -- *.c]

# -----

# 2. Makes use of a 'filter' procedure
proc is_c {name} { return [string match *.c $name] }

set files [fileutil::find $path is_c]

# -----

# In both cases:
# * Search is recursive
# * Full path names printed
foreach f $files {
  puts $f
}

# -----------------------------

# Two lists generated, first one filtered by file extension, second one by file type
package require fileutil

proc is_c_or_h {name} { return [string match -nocase *.\[ch\] $name] }

set path . ; set files [fileutil::find $path is_c_or_h]

foreach f $files {
  if {[string match "text" [fileutil::fileType $f]]} { lappend textfiles $f }
}

foreach f $textfiles {
  puts $f
}

# -------------

# As above, but both file extension and file type considered in filter procedure, so
# only a single list is generated
package require fileutil

proc is_c_or_h_and_text {name} {
  if {[string match -nocase *.\[ch\] $name] && ![catch {fileutil::fileType $name} filetype]} {
    return [expr [string compare "text" $filetype] == 0]
  }
  return 0
}

set path . ; set files [fileutil::find $path is_c_or_h_and_text]

foreach f $files {
  puts $f
}

# -----------------------------

# Sorted list of all subdirectories in the current directory which commence with the
# digits 0-9
set dirs [lsort [glob -directory [pwd] -nocomplain -type d -- \[0-9\]*]]

Processing All Files in a Directory Recursively

# Minimal-code approach to this problem is to generate a list of paths using the
# 'find' or 'findByPattern' commands of the 'fileutil' package, then traverse that
# list processing each file in turn. A variation is to write a filter procedure for
# 'find' that processes each selected file whilst still retaining its expected 
# behaviour. Whilst the latter is likely to be better-performing, it isn't generally
# recommended to have a filter procedure possess side-effecting behaviour

package require fileutil

# Conventional filter procedures for use with, fileutil::find
proc is_dir {name} { return [expr [fileutil::test $name {d}] != 0] }

# -----

# Generate list of directories in a directory
set path . ; set files [fileutil::find $path is_dir]

# -------------

# Side-effecting filter procedures
proc accum_filesize {name} {
  global filesize
  if [fileutil::test $name {f}] { set filesize [expr $filesize + [file size $name]] }
  return 0
}

proc biggest_file {name} {
  global biggest
  if {[fileutil::test $name {f}] && [file size $name] > $biggest} {
    set biggest [file size $name]
  }
  return 0
}

proc youngest_file {name} {
  global youngest
  if {[fileutil::test $name {f}] && [file mtime $name] < $youngest} {
    set youngest [file mtime $name]
  }
  return 0
}

# -----

# Obtain total size of all files in a directory and its subdirectories
set path . ; set filesize 0 ; set files [fileutil::find $path accum_filesize]
puts $filesize

# Find biggest size file in a directory and its subdirectories
set path . ; set biggest 0 ; set files [fileutil::find $path biggest_file]
puts $biggest

# Find most recent file in a directory and its subdirectories
set youngest 2147483647 ; set files [fileutil::find $path youngest_file]
puts [clock format $youngest -format %D]

# Alternatively, one could implement a procedure that actually recurses through
# directories performing required processing. One approach would see the intermixing
# of recursing and processing code; another would see a generic recursing procedure
# passed the name of a processing procedure which is then applied to each selected
# file via the 'eval' command. The latter approach has the advanatage of being flexible,
# though performance is hampered due to the use of 'eval'; the former approach is more
# 'one-shot', but most likely, better performing

proc processDirectory {baseDir proc} {
  set pwd [pwd] ; if [catch {cd $baseDir} result] { return }

  foreach dir [glob -nocomplain -type d -- *] {
    processDirectory $dir $proc
  }

  eval "$proc [pwd]" ; cd $pwd
}

# -------------

proc show {dir} { puts $dir }

proc accum_filesize {dir} {
  global filesize
  foreach file [glob -directory $dir -nocomplain -type f -- *] {
    set filesize [expr $filesize + [file size $file]]
  }
}

proc biggest_file {dir} {
  global biggest
  foreach file [glob -directory $dir -nocomplain -type f -- *] {
    if {[file size $file] > $biggest} { set biggest [file size $file]}
  }
}

proc youngest_file {dir} {
  global youngest
  foreach file [glob -directory $dir -nocomplain -type f -- *] {
    if {[file mtime $file] < $youngest} { set youngest [file mtime $file]}
  }
}

# -------------

# Obtain total size of all files in a directory and its subdirectories
set filesize 0 ; processDirectory [pwd] "accum_filesize" ; puts $filesize

# Find biggest size file in a directory and its subdirectories
set biggest 0 ; processDirectory [pwd] "biggest_file" ; puts $biggest

# Find most recent file in a directory and its subdirectories
set youngest 2147483647 ; processDirectory [pwd] "youngest_file"
puts [clock format $youngest -format %D]

# -----------------------------

# Generate list of directories in a list of directories

if {$argc < 1} { puts stderr "usage: $argv0 dir..." ; exit 1 }

foreach dirname $argv {
  processDirectory $dirname "show"
}

Removing a Directory and Its Contents

# The 'file delete' command can:
# * Delete both files and subdirectories
# * Recursively delete the latter
# Therefore, it is not necessary to construct a tree-traversing [recursive or otherwise]
# procedure in order to remove a directory tree. It may be, however, useful to use such
# an approach should it be necessary to implement special processing [e.g. interactive
# prompting]. The use of a custom procedure that intermixes recursing and processing code
# [as shown in the previous section] is probably the simplest, best performing approach,
# to this latter task.

# 'rmtree1' - straightforward implementation 

if {$argc < 1} { puts stderr "usage: $argv0 dir..." ; exit 1 }

foreach dirname $argv {
  if [catch {file delete -force -- $dirname} result] {
    puts "Error deleting $dirname \[$result\]"
  }
}

# -----------------------------

# 'rmtree2' - recursive, tree-traversing implementation 

# Recurser - recursively traverses directory tree
proc rmtree_ {baseDir} {
  set pwd [pwd] ; if [catch {cd $baseDir} result] { return }

  foreach dir [glob -nocomplain -type d -- *] {
    rmtree_ $dir
  }

  # Let's delete the regular files in, 'baseDir'
  foreach filename [glob -nocomplain -type f -- *] {
    if [catch {file delete -force -- $filename} result] {
      puts "Error deleting $filename \[$result\]"
    }
  }

  # Let's move up, out of, 'baseDir', so as to allow it's deletion
  cd $pwd

  # Let's delete, 'baseDir'
  set dirname [file join $pwd $baseDir]

  if [catch {file delete -force -- $dirname} result] {
    puts "Error deleting $dirname \[$result\]"
  }
}

# -----

# Launcher - performs validation, then starts recursive routine
proc rmtree {baseDir} {
  if {![file exists $baseDir]} {
    puts stderr "Directory does not exist" ; return
  }

  if [string match $baseDir* [pwd]] {
    puts stderr "Cannot remove current directory or its parent" ; return
  }

  # Validation passed, so start recursing through subdirectories 
  return [rmtree_ $baseDir]
}

# -------------

if {$argc < 1} { puts stderr "usage: $argv0 dir..." ; exit 1 }

foreach dirname $argv {
  rmtree $dirname
}

Renaming Files

set names [list x y z]

foreach file $names {
  # This deliberately atempts to rename an existing file to it's own, same name,
  # thus forcing an error [unless the -force option is used]
  set newname file

  # Error display mimics Perl example
  ## if [catch {file rename $file $newname} result] {
  ##   puts stderr "Couldn't rename $file to $newname"
  ## }

  # However, approach shown here is preferable as it furnishes more relevant
  # diagnostic message(s)
  if [catch {file rename $file $newname} result] {
    puts stderr $result
  }
}

# -----------------------------

#
# A modified implementation of Larry's Filename Fixer. Rather than passing
# a single expression, a 'from' regexp is passed; each match in the file
# name(s) is changed to the value of 'to'. It otherwise behaves the same
# 
if {$argc < 2} { puts stderr "usage: $argv0 from to \[files...\]" ; exit 1 }

set from [lrange $argv 0 0] ; set to [lrange $argv 1 1]
set argv [lrange $argv 2 [llength $argv]]

if {$argv == {}} {
  while {[gets stdin line] >= 0} {lappend argv $line}
} 

foreach f $argv {
  set was $f ; regsub $from $f $to file
  if {[string compare $was $file] != 0} {
    if [catch {file rename $was $file} result] {
      puts stderr $result
    }
  }
}

Splitting a Filename into Its Component Parts

set path {/usr/lib/libc.a}

# -----

set basename [file tail $path]
set dirname [file dirname $path]

# No equivalent to Perl's, 'fileparse', so must do:
set base [file tail $path]
set dir [file dirname $path]
set ext [file extension $path]

# -------------

set path {/usr/lib/libc.a}

# -----

set file [file tail $path]
set dir [file dirname $path]

puts "dir is $dir, file is $file"

# -----

set name [file tail $path]
set dir [file dirname $path]
set ext [file extension $path]

puts "dir is $dir, name is $name, extension is $ext"

# -------------

# According to the Tcl documentation, the 'file' command is platform-independant, so
# should correctly work for platforms such as MacOS. Code below assumes this, but is
# otherwise untested
set path {Hard%20Drive:System%20Folder:README.txt}

# -----

set name [file tail $path]
set dir [file dirname $path]
set ext [file extension $path]

puts "dir is $dir, name is $name, extension is $ext"

Program: symirror

# @@INCOMPLETE@@
# @@INCOMPLETE@@

Program: lst

# @@INCOMPLETE@@
# @@INCOMPLETE@@