#!/usr/bin/env tclsh8.4
#Copyright 2004 (c) George Peter Staplin

proc build.tree.stat.info {ar_ptr dir} {
 upvar $ar_ptr ar
 array set ar {}
 foreach f [glob -nocomplain [file join $dir *]] {
  if {[file isdirectory $f]} {
   build.tree.stat.info ar $f
  } elseif {[file isfile $f]} {
   set ar($f) [file size $f]
  }
 }
}

proc copy.from.to {from to} {
 puts "COPYING $from $to"
 file mkdir [file dirname $to]
 file copy -force $from $to
}

proc sync.tree {a_ptr FROM_DIR b_ptr TO_DIR} {
 upvar $a_ptr a
 upvar $b_ptr b

 foreach {f size} [array get a] {
  if {![info exists b($f)]} {
   copy.from.to [file join $FROM_DIR $f] [file join $TO_DIR $f]
  } elseif {$size != [set b($f)]} {
    puts stderr "The size for $f in $FROM_DIR doesn't match $TO_DIR."
  }
 }
}

proc sync.tree.caseless {from FROM_DIR to TO_DIR} {
 foreach {f size} $from {
  set do_copy 1
  foreach {tof tosize} $to {
   if {[string equal -nocase $f $tof]} {
    set do_copy 0
    break
   }
  }
  if {$do_copy} {
   copy.from.to [file join $FROM_DIR $f] [file join $TO_DIR $f]
  } elseif {$tosize != $size} {
   puts stderr "The size for $f in $FROM_DIR doesn't match $TO_DIR."
  }
 }
}

proc syntax {} {
 puts stderr "syntax: ?-nocase? tree-a tree-b"
}

proc main {argc argv} {

 set caseless 0

 switch -- $argc {
  2 {
   foreach {tree_a tree_b} $argv {}
  }

  3 {
   foreach {flag tree_a tree_b} $argv {}
   if {![string match -nocase -noc* $flag]} {
    syntax
    return 1
   }
   set caseless 1
  }
 
  default {
   syntax
   return 1
  } 
 }

 set oldwd [pwd]
 cd [set DIR_A [file normalize $tree_a]]
 build.tree.stat.info a {}

 cd $oldwd
 cd [set DIR_B [file normalize $tree_b]]
 build.tree.stat.info b {}

 if {$caseless} {
  sync.tree.caseless [array get a] $DIR_A [array get b] $DIR_B
  sync.tree.caseless [array get b] $DIR_B [array get a] $DIR_A
 } else {
  sync.tree a $DIR_A b $DIR_B
  sync.tree b $DIR_B a $DIR_A
 }
 return 0
}
exit [main $::argc $::argv]