# This bit of code creates a "find" command with most of the important features 
# of the unix find.  It is decompsed into a scanner and a couple of filters.

# There are two ways the result can be presented:
# 1) as in the ::fileutil::find a list of all files and dirs
#    that qualify or (exclusive)
# 2) a call back, one file at a time, of each qualifying file.
# 
#
# Set up involves setting up the options to filter for by calling:

# To call:

# ::realfind::realFind basedir filterList ?incremental-Call-Back?
# 
# 'filterList' is a list of filters of the sort found in the *nix find man page
# At this time the following are available:
#
# -P -L -H -iname -name -regex -iregex -path -maxdepth 
#          -mindepth -lname -ilname -true -false -type -xtype 
# Operators:  ( expr )  ! expr  -not expr expr1 expr2 expr1 -a expr2 expr1
#             -and expr2 expr1 -o expr2 expr1 -or expr2 
#             Note that -o and -or are the same and that -a, -and and " "
#             are the same
#
# The result is as in -print either as a call back or in the returned list.
#
# Possible future additions which seem easy:  
#  -amin -anewer -atime -cmin -cnewer -ctime -empty -executable -fstype?
#  -inum -ipath -iwholename -links -mmin -mtime -newer -nogroup -nousr
#  -gid -group-path -perm -readable -samefile -size -uid -used -wholename
#  -writable 
#                                           
#
#
# These options should be arranged as in the *nix command, i.e.:
#
#   [-H] [-L] [-P] [expression]
#
# If the filterList is empty all files are returned. ::realfind::realFind
# follows  links (but see -L) and is careful to not get into loops in doing so.
#
# incremental-Call-Back if provided, is a call back function that is called
#                      once with each file that passes the filter.

# If the incremental-Call-Back is not provided,::realfind::realFind  returns
#                              a list of all files that pass the filter test.

# If the incremental-Call-Back is provided ::realfind::realFind  returns
#                             a list of errors (not readable dirs) only.



package require Tcl 8.4
package provide realfind 15.10

namespace eval ::realfind {
  namespace export realFinc
}

proc ::realfind::realFind {basedir filterList {incCallBack {1}}} {
  # puts "$filterList"
  # build and parse the options and expression
  set openP 0
  set expAnd 0
  set expOr  0
  set state 1
  set depth 0
  set PLH "P"
  set exp {}
  #
  while {[llength $filterList] > 0} {
    set filterList [lassign $filterList expOp]
    switch -exact $expOp {
      -P -
      -L -
      -H {
	if {$exp != {}} {error "-P or -L or -H after expression"}
	set PLH [string index $expOp 1]
      }
      \(  -
      \)  {
      	incr openP [expr {$expOp == "(" ? 1 : -1}]
	if {$expOp == ")" && $state != 3} {error "Negate followed by \)"}
	if {$expOp == "("} set $state 1
	lappend exp $expOp
      }
      -true     -
      -false    -
      -iname    -
      -name     -
      -regex    -
      -iregex   -
      -path     -
      -mindepth -
      -maxdepth -
      -lname    -
      -type     -
      -xtype    -
      -ilname  {
	set fun [string range $expOp 1 2]
	if {$fun == "fa" || $fun == "tr"} {
	  set val [expr {$expOp ? 1 : 0}]
	} else {
	  set filterList [lassign $filterList val]
	}
	if {$val == {}} {error "No value following $expOp"}
	if {$state == 3} {
	  lappend exp &
	  incr expAnd
	}
	lappend exp  [list $fun $val]
	if {[string index $expOp 1] == "m" && \
		! [string is integer -strict $val]} {
	  error "Non-integer value for min or max depth"
	}
	set state 3
      }
      ! -
      -not {
	if {$state == 2} {error "Double negative found in expression"}
	if {$state == 3} {
	  lappend exp & !
	  incr expAnd
	} else {
	  lappend exp !
	}
	set state 2
      }
      -o   -
      -or  -
      -a   -
      -and {
	if {$state == 2} {error "Negate followed by operator"}
	set op [expr {[string index $expOp 1] == "o" ? "|" : "&"}]
	lappend exp $op
	if {$op == "&"} {
	  incr expAnd
	} else {
	  incr expOr
	}
	set state 4
      }
      default {error "$expOp not handled -- yet."}
    }
  }
  if {$openP != 0} {error "Missed matched parentheses."}

  # ok, we now have a parsed and more or less valid set of expressions.
  # convert to RPN (reverse polish notation)

  #puts "exp is $exp"
  set exp [shuntingYard $exp]
  #puts "RPNexp is $exp"
  
  set filename $basedir

  # lets start the scan
  # We catch here so we can rename ACCESS to what it was
  #puts "realFind level [info level]"
  set r [catch "::realfind::findScanner  $basedir 1\
                [list [list localfilter $exp $incCallBack] [list dirFilter]]"\
	     rtn]

  # if we have an error, pass it up the line...
  if {$r != 0} {error $rtn $::errorInfo}

  return $rtn
}

# This code filters does the "-L" filtering as well as
# computing the depth for that option.

proc ::realfind::dirFilter {arg} {
  upvar 1 PLH PLH basedir basedir depth depth
  #puts "dirFilter level [info level]"
  #frputs "ACCESS called with  " arg
  if {$PLH != "L" && [file type $arg] == "link"} {
    frputs PLH arg
    return 0
  }
  set depth 0
  set this $arg
  
  set rootL [string length $basedir]
  while {$basedir != $this && [string length $this] > $rootL} {
    incr depth
    set this [file dirname $this]
  }
  return 1
}

proc ::realfind::pushls {val} {
  upvar 1 stack stack
  lappend stack $val
}

proc ::realfind::popls {} {
  upvar 1 stack stack
  if {$stack == {}} {error "pop on empty stack in ::realfind::localfilter"}
  set r [lindex $stack end]
  set stack [lreplace $stack end end]
  return $r
}

# ::fileutil::find process the filter (this command) on the callers stack
# so we have access to the dir name left there by the ACCESS code above.

proc ::realfind::localfilter {exp callBack arg} {
  upvar 1 depth depth
  # puts "localFilter level [info level]"
  # Here the arg is a file or dir name
  # we evaluate the RPN expression to see if it qualifies
  set stack {}
  update
  set stopFlag [lindex $callBack end-1]
  if {[info exists $stopFlag] && [set $stopFlag] != 0} {
    error "User stop requested at $arg"
  }
  set tail [file tail $arg]
  foreach ent $exp {
    if {[llength $ent] > 1} {
      # It is an operand (function to preform with parms)
      lassign $ent fun pat
      # set isDir [file isdirectory $arg]
      # if {$isDir} {
      # 	# Directory tests have to do with level and links
      # 	return 0
      # }
      switch -exact $fun {
	tr -
	fa {lappend stack $pat}
	in {pushls [string match -nocase $pat $tail]}
	na {pushls [string match $pat $tail]}
	re {pushls [regexp $pat $tail]}
	ir {pushls [regexp "(?i)$pat" $tail]}
	pa {pushls [string match $pat $arg]}
	ty {
	  pushls [expr {[string index \
			     [string map {fifo p} [file type $arg]] 0] == $pat}]
	}
	xt {
	  if {[catch "file link $arg" lf] != 0} {
	    set lf $arg
	  } else {
	    set lf [file join [file dir $arg] $lf]
	  }
	  pushls [expr {[string index \
			     [string map {fifo p} [file type $lf]] 0] == $pat}]
	}
	mi -
	ma {pushls [expr {$fun == "mi" ? $depth >= $pat : $depth <= $pat}]}
	il -
	ln {
	  set pa [expr {$fun == "il" ? "-nocase $pat" : "$pat"}]
	  pushls [expr {[catch [file link $arg] an] == 0 \
			    && [string match $pa $an] ? 1 : 0}]
	}
	default {error "Unexpect reference '$ent' found in RPN list."}
      }
    } else {
      # It is an operation to peform on either the top (uinary op)
      # or top two operands on the stack

      switch -exact $ent {
	! {pushls [expr ! [popls]]}
	& - 
	| {pushls [expr [popls] $ent [popls]]}
	default {error "Ilegal operand '$ent' found in RPN list."}
      }
    }
  }
  if {[llength $stack] != 1} {
    error "End of RPN expression with '$stack' on the stack."
  }
  if {! $stack} {return 0}
  #puts "levelc [info level]"

  if {$callBack != 1} {
    eval [linsert $callBack end $arg\n]
  }
  return [popls]
}

# We shamlessly lifted the following code from fileutil (in particular
# the ::fileutil::find and its support and then fixed the issues...

#
# ::realfind::findScanner basedir ?file-filter-call-back? ?dir-filter-callback?
#
# This function is a support routine that scanns the files under 'basedir'
# in the directory tree and facilitates the required filtering.
#
# If 'noResult' is 1 only errors are returned, otherwise all files that pass
#               the filter are returned.

# fCallBack, if provided, should be a call back function which will have
#            appended to its call the name of file under consideration. 
#            If this file is to be returned, this should return true (this will
#            cause this file to be in the list  returned by
#            ::findfile::findFile).  This call does not affect the scan.
#            If this function is not provided (or {}) all files are returned.
#
# bCallBack, if provided, is used to filter directories.  It is called with
#            the name of the directory about to be scanned.  If this function
#           returns false, the given directory will not be scanned
#           (nor will any below it). If this call back is not provided
#           (or {}) all directories are scanned.


proc ::realfind::findScanner {{basedir .} {noResult {0}} \
				  {filtercmd {}} {dirfiltercmd {}}} {
  upvar 1 incCallBack incCallBack
  set result {}
  set filt   [string length $filtercmd]
  set dfilt   [string length $dirfiltercmd]

  if {[file isfile $basedir]} {
    # The base is a file, and therefore only possible result,
    # modulo filtering.

    FADD $basedir

  } elseif {[file isdirectory $basedir]} {

    # For a directory as base we do an iterative recursion through
    # the directory hierarchy starting at the base. We use a queue
    # (Tcl list) of directories we have to check. We access it by
    # index, and stop when we have reached beyond the end of the
    # list. This is faster than removing elements from the be-
    # ginning of the list, as that entails copying down a possibly
    # large list of directories, making it O(n*n). The index is
    # faster, O(n), at the expense of memory. Nothing is deleted
    # from the list until we have processed all directories in the
    # hierarchy.
    #
    # We scan each directory at least twice. First for files, then
    # for directories. The scans may internally make several
    # passes (normal vs hidden files).
    #
    # Looped directory structures due to symbolic links are
    # handled by _fully_ normalizing directory paths and checking
    # if we encountered the normalized form before. The array
    # 'known' is our cache where we record the known normalized
    # paths.

    set pending [list $basedir]
    set at      0
    array unset   known

    while {$at < [llength $pending]} {
      # Get next directory not yet processed.
      set current [lindex $pending $at]
      incr at

      # It would be nice to return something about this but it
      # is not clear how...
      if {![file readable $current]} {
	lappend result "$current is not readable..........."
	continue
      }
      # Files first, then the sub-directories ...
      # First report which dir we are working on
     
      set callBack [lindex $filtercmd 2]
      if {$callBack != 1} {
	# The call back function should seperate this call from the data
	# call by the absence of the "\n" on the value retuned.
	
	eval [linsert $callBack end $current]
      }

      set res [concat\
		   [glob -nocomplain -directory $current -types f          -- *] \
		   [glob -nocomplain -directory $current -types {hidden f} -- *]]
      
      # Look for broken links (They are reported as neither file nor directory).
      foreach l [concat \
		     [glob -nocomplain -directory $current -types l          -- *] \
		     [glob -nocomplain -directory $current -types {hidden l} -- *] ] {
	if {[file isfile      $l]} continue
	if {[file isdirectory $l]} continue
	lappend res $l
      }
      foreach f $res { FADD $f }

      foreach f [concat \
		     [glob -nocomplain -directory $current\
			  -types d          -- *] \
		     [glob -nocomplain -directory $current\
			  -types {hidden d} -- *]] {

	# Ignore current and parent directory, this needs
	# explicit filtering outside of the filter command.
	if {[file tail $f] in {"." ".."}} {continue}

	# Extend result, modulo filtering.
	FADD $f

	# Detection of symlink loops via a portable path
	# normalization computing a canonical form of the path
	# followed by a check if that canonical form was
	# encountered before. If ok, record directory for
	# expansion in future iterations.

	# Is the directory accessible? Continue if not.
	ACCESS $f
      
	set norm [file dirname [file normalize $f/foo]]
	if {[info exists known($norm)]} {
	  frputs norm "[array get known] "
	  continue
	}
	set known($norm) .
	lappend pending $f
      }
    }
  } else {
    return -code error "$basedir does not exist"
  }

  return $result
}
# Helper command for fileutil::find. Performs the filtering of the
# result per a filter command for the candidates found by the
# traversal core, see above. 

# The ACCESS function checks for a directory call back and returns
# "continue" if that call back returns false. Otherwise the directory
# is good and a normal return is made.

proc ::realfind::ACCESS {dir} {
  upvar 1 dfilt dfilt dirfiltercmd dirfiltercmd
  if {$dfilt && ! [uplevel 2 [linsert $dirfiltercmd end $dir]]} {
    frputs dir
    return -code continue
  }
}

# This function calls the filter call back with the resulting file
# name (unlike the ::fileutil::find which only passes the tail and
# cd's to the directory. This way filtering on the path is possible.

proc ::realfind::FADD {filename} {
  upvar 1 result result filt filt filtercmd filtercmd noResult noResult
  if {!$filt || [uplevel 2 [linsert $filtercmd end $filename]]} {
    if {! $noResult} {
      lappend result $filename
    }
  }
}

  # cd [file dirname $filename]

  # if {[uplevel 2 [linsert $filtercmd end [file tail $filename]]]} {
  #   lappend result $filename
  # }

  # cd $here
  # return

