2007-Dec-02 Here is a small script which compares two directory trees. It does not only look at the tree, but inspects the content of the files. -- Sarnold


 tddiff /path/to/webapp-1.2 /path/to/webapp-1.0 /path/to/changes/dir/to/be/created

It can compare two application source trees, for example, and put the differences into a changes directory. The changes directory needs to be non-existent before the script is invoked.

After the script terminates successfully, there should be two subdirectories in "changes":

  * 'new' in which the new/modified (source) files are written verbatim
  * 'discarded' in which are written the files that do not exist anymore in the latest source tree.

Fields of interest: some small Linux distros like Puppy Linux need this kind of software: small, simple, require much less resources than C counterparts. There is potientally an interest for Microsoft Windows, where such programs, often written for UNIX, are missing.

The script

 #!/usr/bin/env tclsh

 proc usage {} {
        puts stderr "usage: tddiff dir1/ dir2/ out/"
        exit 1

 proc assert {expr {msg {assertion failed}}} {
        if {![uplevel 1 expr $expr]} {error $msg}

 proc main {argv} {
        if {[llength $argv] != 3} {
        foreach {dir1 dir2 out} $argv {}
        assert {![file isdirectory $out]} "out directory '$out' already exists"
        assert {![file exists $out]} "out directory '$out' is a regular file"
        file mkdir $out
        foreach f [NewIn $dir1 $dir2 .] {Transfer $dir1 $out/new $f}
        foreach f [NewIn $dir2 $dir1 . on] {Transfer $dir2 $out/discarded $f}

 # copy one file, creating directories if they miss
 proc Transfer {in out subpath} {
        set in $in/$subpath
        set dest $out/[file dirname $subpath]
        if {![file isdirectory $dest]} {
                puts "Creating directory $dest"
                file mkdir $dest
        file copy $in $out/$subpath

 proc NewIn {dir1 dir2 sub {deprecated off}} {
        set res ""
        foreach f [Subfiles $dir1 $sub] {
                if {[file isdirectory $dir1/$f]} {
                        set res [concat $res [NewIn $dir1 $dir2 $f $deprecated]]
                } else {
                        if {[NewFile $dir1/$f $dir2/$f $deprecated]} {lappend res $f}
        set res

 # returns true if file2 does not exist or if file1 is different in content
 proc NewFile {file1 file2 {deprecated off}} {
        if {![file exists $file2]} {return true}
        if {$deprecated} {return false}
        return [expr {![BinEqual $file1 $file2]}]

 proc min {a b} {expr {($a>$b)?($b):$a}}
 # compares two files, given their paths f1 and f2
 proc BinEqual {f1 f2} {
        if {[file size $f1] != [file size $f2]} {
                # not the same size -> not equal
                return false
        set sz [file size $f1]
        set a [open $f1]
        set b [open $f2]
        fconfigure $a -translation binary
        fconfigure $b -translation binary
        while {![eof $a] && ![eof $b]} {
                if {![string equal [read $a [min $sz 4096]] [read $b [min $sz 4096]]]} {
                        close $a
                        close $b
                        return false
                incr sz -4096
                if {$sz<0} {
                        close $a
                        close $b
                        return true
        close $a
        close $b
        return true

 proc Subfiles {dir sub} {
        set p [pwd]
        cd $dir
        set res [glob -nocomplain $sub/*]
        cd $p
        set res
 catch {tcldebug::debug}
 main $argv