xtcl

This is a (currently) small script that does magic to run Tcl against large number of files. It's loosely based on idea of xargs and perl's flags.

Sample usages would be:

 $ xtcl -line 'set line [format "%3d> %s" $linenumber $line]' file1.txt file2.txt ; # add line numbers to each line of file1.txt and file2.txt
 $ xtcl -file 'set contents "# [file tail $filename] --\n#\n#\tSome comment\n#\n\n$contents"' file1.tcl file2.tcl ; # add some comments at the beginning of the file

 $ xtcl -line 'set line [string map {cvs.sourceforge.net FOOBAR.cvs.sourceforge.net}]' -find CVS/Root ; # 1-liner to handle SourceForge cvs changes :-)

Code:

 #!/bin/sh
 # \
 exec tclsh "$0" ${1+"$@"}
 
 namespace eval xtcl {}
 
 proc xtcl::usage {} {
    set s [file tail [info script]]
    return "Usages:
 $s ?-debug? -line tcl_command <file switches>
    Iterate through each line in each file found and call the script
 
 $s -file tcl_command <file switches>
    Iterate through each line in each file found and
 
 $s -match <file switches>
    Finds files and prints out filenames
 
 <file switches>:
    -find glob_pattern1 ?glob_pattern2? ?glob_pattern3? ?...?
    -glob glob_pattern1 ?glob_pattern2? ?glob_pattern3? ?...?
    -files ?file1 ?file2? ?..??
 "
 }
 
 proc xtcl::showUsage {} {
    puts stderr [xtcl::usage]
    exit 1
 }
 
 #
 # file matching
 #
 
 proc xtcl::findFiles {directory relative matchProc} {
    set rc [list]
 
    foreach g [lsort -unique [concat [glob -type hidden -nocomplain -directory $directory *] [glob -nocomplain -directory $directory *]]] {
         set gt [file tail $g]
         file stat $g st
         set rt [file join $relative $gt]
         switch -- $st(type) {
             file {
                 if {[eval [concat $matchProc [list $rt]]]} {
                     lappend rc $g
                 }
             }
             directory {
                 set rc [concat $rc [findFiles $g $rt $matchProc]]
             }
         }
    }
    return $rc
 }
 
 proc xtcl::_matchGlobs {patterns filename} {
    set rc false
 
    set fs [file split $filename]
    foreach p $patterns {
         set ps [file split $p]
         set psl [llength $ps]
         if {[string match [join [lrange $p end-$psl end] /] [join [lrange $fs end-$psl end] /]]} {
             set rc true
         }
    }
 
    return $rc
 }
 
 proc xtcl::matchFiles {argv} {
    switch -glob -- [lindex $argv 0] {
        -f - -fi - -fil - -file - -files {
            return [lrange $argv 1 end]
        }
        -exec {
            set rc [list]
            if {[catch [concat [list exec --] [lrange $argv 1 end]] filelist]} {
                return -code error $filelist
            }
            foreach line [split $filelist \r\n] {
                if {$line != ""} {
                    lappend rc $line
                }
            }
            return $rc
        }
         -find - -glob {
             return [findFiles [pwd] "" [concat [list xtcl::_matchGlobs [lrange $argv 1 end]]]]
         }
        -* {
            showUsage
        }
    }
    return $argv
 }
 
 proc xtcl::foreachFile {filelist body} {
    # some standard variables
    upvar 1 contents contents filename filename filenumber filenumber
 
    set filenumber 0
 
    foreach filename $filelist {
        incr filenumber
 
        set fh [open $filename r]
        set origcontents [read $fh]
        close $fh
 
        set contents $origcontents
        uplevel 1 $body
 
        if {![string equal $origcontents $contents]} {
            set fh [open $filename w]
            puts -nonewline $fh $contents
            close $fh
        }
    }
 }
 
 #
 # main code
 #
 
 # match global flags
 
 while {[llength $argv] > 0} {
    switch -- [lindex $argv 0] {
        -to {
            set xtcl::toDirectory [lindex $argv 1]
            set argv [lrange $argv 2 end]
            incr argc -2
            continue
        }
        default {
            break
        }
    }
 }
 
 # if we don't have any mode, throw the usage
 if {[llength $argv] == 0} {
    xtcl::showUsage
 }
 
 # match usage mode
 switch -- [lindex $argv 0] {
    -m - -ma - -mat - -matc - -match {
        # find files matching the criteria
        set files [xtcl::matchFiles [lrange $argv 1 end]]
        puts [join $files \n]
        exit 0
    }
    -l - -li - -lin - -line {
        set command [lindex $argv 1]
        set files [xtcl::matchFiles [lrange $argv 2 end]]
 
        xtcl::foreachFile $files {
            set newcontents [list]
            set linenumber 0
            foreach line [split $contents \n] {
                incr linenumber
                eval $command
                lappend newcontents $line
            }
            set contents [join $newcontents \n]
        }
    }
    -f - -fi - -fil - -file {
        set command [lindex $argv 1]
        set files [xtcl::matchFiles [lrange $argv 2 end]]
        xtcl::foreachfile contents $files {
            eval $command
        }
    }
    default {
        xtcl::showUsage
    }
 }
 
 exit 0

Category File