# Directory scanning API.
# Rick Smereka, Copyright (C) 2005.

# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.

# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this program; if not, get a copy via the Internet at
# http://gnu.org/copyleft/gpl.html or write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston,
# MA 02111-1307 USA

# This directory scanning module/API will traverse one or more directories
# from a specific entry point matching file/directory names. This API
# does not use recursion to traverse the directory tree and is not subject to 
# stack limitations and excessive memory consumption typical with recursive 
# algorithms.

# This tcl version is different than the 'C' version in that it uses the
# 'glob' command which gets a list of matches instead of one match at a
# time. I use a global list to store the matches and return only one
# match at a time. Since this $&*@ language has no typical data structures
# (ie: records or structures), the list of active directories is stored in
# an array with each element of the array containing a list.

# You can contact the author via email at rsmereka@future-lab.com

# Initial tcl version Apr/2005, Rick Smereka

# module globals
# entity return types
const DSCAN_TYPE_FILE 1
const DSCAN_TYPE_DIR 2

if {$tcl_platform(platform) == "unix"} {
   const DSCAN_TYPE_SYMLINK 3
}

# list delimiter used in 'dscan_hold_list'
const DSCAN_LIST_DELIM "*"

# array dscan_entry holds all the directory information
# list dscan_hold_list contains all items for one directory
set dscan_hold_list ""
set dscan_base_path ""
set dscan_current_path ""
set dscan_fname ""
set dscan_for_files 0
set dscan_for_dirs 0

if {$tcl_platform(platform) == "unix"} {
   set dscan_for_symlinks 0
}

set dscan_descend 0

proc dscan_findfirst {path fname flags pfname} {
   # Find the first occurance of the file 'fname' within the 'path'.
   # The 'flags' can have any combination of 'fdls' where 'f' is
   # scan for files, 'd' is scan for directories, 'l' is scan for
   # sumbolic links (Linux/Unix only) and 's' is descend into
   # sub-directories. If an item is found, its full path and
   # name is loaded into 'pfname'. Returns a type code (file,
   # directory or symlink) upon success. Returns 0 otherwise.
   global dscan_base_path
   upvar $pfname lk
   set lk ""
   set mname "dscan_findfirst"

   dscan_header $mname

   if {$path == ""} {
      logman "$mname:exit(0) empty(path)"
      return 0
   }

   if {$fname == ""} {
      logman "$mname:exit(0):empty(fname)"
      return 0
   }

   if {$flags == ""} {
      logman "$mname:exit(0):empty(flags)"
      return 0
   }

   if {![isdirectory $path]} {
      logman "$mname:$path is not a directory"
      return 0
   }

   logman [format "%s:path=%s(%d),fname=%s(%d),flags=%s(%d)" $mname \
           $path [string length $path] $fname [string length $fname] \
           $flags [string length $flags]]
   dscan_delete_mvars

   if {![dscan_set_mvars $path $fname]} {
      logman "$mname:exit(0) bad rc(0) from dscan_set_mvars"
      return 0
   }

   if {![dscan_set_flags $flags]} {
      logman "$mname:exit(0):bad rc(0) from dscan_set_flags"
      return 0
   }

   if {![dscan_set_current_path $dscan_base_path]} {
      logman "$mname:exit(0):bad rc(0) from dscan_set_current_path"
      return 0
   }

   set ret [dscan_findnext iname]
   set lk $iname
   logman [format "%s:exit(%d):pfname=%s(%d)" $mname $ret $iname \
           [string length $iname]]
   return $ret
}

proc dscan_findnext {pfname} {
   # Find the next occurance of the desired file/directory.
   # 'dscan_findfirst' must be called initially. Returns
   # a type code with the full path and item name in
   # 'pfname' upon success. Returns 0 otherwise.
   global dscan_current_path dscan_descend
   upvar $pfname lk
   set lk ""
   set mname "dscan_findnext"

   logman "$mname:enter:cp=$dscan_current_path"

   while {1} {
      # find next occurance in current directory
      set ret [dscan_find nexto]

      if {$ret != 0} {
         set lk $nexto
         logman [format "%s:exit(%d):pfname=%s(%d)" $mname $ret \
                 $nexto [string length $nexto]]
         return $ret
      }

      if {!$dscan_descend} {
         logman "$mname:exit(0):no subs processed"
         return 0
      }

      if {![dscan_sub]} {
         logman "$mname:exit(0):no more subs"
         return 0
      }
   }

   logman "$mname:exit(0)"
   return 0
}

proc dscan_end {} {
   # Remove 'dscan_entry' array and wipe globals.
   set mname "dscan_end"

   dscan_header $mname
   dscan_delete_mvars
   logman "$mname:exit"
}

proc dscan_find {fname} {
   # Find an item in the current path. Returns a type code with
   # the item name in 'fname' upon success, 0 otherwise.
   upvar $fname lk
   global dscan_current_path dscan_hold_list DSCAN_LIST_DELIM
   set lk ""
   set mname "dscan_find"

   logman "$mname:enter:cp=$dscan_current_path"

   # locate the current path in the array or add if not found
   set rov [dscan_ll_find $dscan_current_path]

   if {!$rov} {
      logman "$mname:not found from dscan_ll_find,will add"
      set rov [dscan_ll_add $dscan_current_path]

      if {!$rov} {
         logman "$mname:exit(0):bad rc(empty) from dscan_ll_add"
         return 0
      }
   }

   # if there is an item in the hold list, return it
   if {$dscan_hold_list != ""} {
      set fitem [lindex $dscan_hold_list 0]
 
      if {[ll_words $fitem $DSCAN_LIST_DELIM] < 2} {
         logman "$mname:exit(0):hold list item does not contain 2 words"
         return 0
      }

      set ret [ll_word $fitem iname 1 $DSCAN_LIST_DELIM]
       
      if {!$ret} {
         logman "$mname:exit(0):bad rc from ll_word(item name)"
         return 0
      }

      set ret [ll_word $fitem type 2 $DSCAN_LIST_DELIM]

      if {!$ret} {
         logman "$mname:exit(0):bad rc from ll_word(type code)"
         return 0
      }

      # remove the item from the hold list
      set dscan_hold_list [lreplace $dscan_hold_list 0 0]
      dscan_ll_debug
      set lk $iname
      logman [format "%s:normal exit(%d):fname=%s(%d)" $mname $type \
              $iname [string length $iname]]
      return $type
   }
   
   return 0
}
      
proc dscan_sub {} {
   # Locate a subdirectory of the current or go back up one
   # level in the directory tree. Returns 1 if another
   # directory was found, 0 otherwise.
   global dscan_current_path dscan_base_path dscan_entry
   set mname "dscan_sub"

   dscan_header $mname
   logman "$mname:cp=$dscan_current_path"

   # pull out next sub (if present) from list set the current path to it and 
   # remove it from array list
   if {$dscan_entry($dscan_current_path) != ""} {
      set p [lindex $dscan_entry($dscan_current_path) 0]
      set dscan_entry($dscan_current_path) [lreplace \
          $dscan_entry($dscan_current_path) 0 0]
      logman [format "%s:pick sub:new cp=%s(%d)" $mname $p [string length $p]]

      if {![dscan_set_current_path $p]} {
         logman "$mname:exit(0):bad rc(0) from dscan_set_current_path"
         return 0
      }

      logman "$mname:exit(1)"
      return 1   
   }

   # no more subs, delete array entry to current path
   dscan_ll_delete $dscan_current_path
   
   # if current path is the same as base path, we are done
   if {$dscan_base_path == $dscan_current_path} {
      dscan_end
      logman "$mname:exit(0):back at base path,assuming done"
      return 0
   }

   # if all else fails, chop one level from current path
   if {![dscan_chop_path]} {
      logman "$mname:exit:bad rc(0) from dscan_chop_path"
      return 0
   }

   logman "$mname:exit(1)"
   return 1
}

proc dscan_chop_path {} {
   # Remove one level from the current path. Returns 1 upon
   # success, 0 otherwise.
   global dscan_current_path PATH_SEP
   set mname "dscan_chop_path"
   
   dscan_header $mname
   set nwords [ll_words $dscan_current_path $PATH_SEP]

   if {![ll_worddel $dscan_current_path p $nwords $PATH_SEP]} {
      logman "$mname:exit(0):bad rc(0) from ll_worddel"
      return 0
   }

   # if the path is reduced to an empty string, set to root
   if {![string length $p]} {
      set p $PATH_SEP
   }

   logman [format "%s:reduce from current,new=%s(%d)" $mname $p \
           [string length $p]]

   if {![dscan_set_current_path $p]} {
      logman "$mname:exit(0):bad rc(0) from dscan_set_current_path"
      return 0
   }

   logman [format "%s:exit(1):new cp=%s(%d)" $mname $dscan_current_path \
           [string length $dscan_current_path]]
   return 1
}

proc dscan_set_flags {flags} {
   # Load scan flags into globals. Returns 1 upon success,
   # 0 otherwise.
   global dscan_for_files dscan_for_dirs dscan_descend
   global tcl_platform

   if {$tcl_platform(platform) == "unix"} {
      global dscan_for_symlinks
      set dscan_for_symlinks 0
   }

   set mname "dscan_set_flags"
   set dscan_for_files 0
   set dscan_for_dirs 0
   set dscan_descend 0

   dscan_header $mname

   if {$flags == ""} {
      logman "$mname:exit(0) empty(flags)"
      return 0
   }

   set uflags [ucase $flags]
   set len [string length $flags]

   for {set i 0} {$i < $len} {incr i} {
      set flag [string index $uflags $i]

      switch $flag {
         F {
            set dscan_for_files 1
         }

         D {
            set dscan_for_dirs 1
         }

         S {
            set dscan_descend 1
         }

         L {
            if {$tcl_platform(platform) == "unix"} {
               set dscan_for_symlinks 1
            } else {
               logman "$mname:exit(0):can only scan for symlinks in unix"
               return 0
            }
         }

         default {
            logman "$mname:exit(0):unknown flag($flag)"
            return 0
         }
      }
   }

   if {$tcl_platform(platform) == "unix"} {
      if {!$dscan_for_files && !$dscan_for_dirs && !$dscan_for_symlinks} {
         logman "$mname:exit(0):one of scan for files(f),scan for \
                 dirs(d) or scan for symlinks(l) must be given"
         return 0
      }
   } else {
      if {!$dscan_for_files && !$dscan_for_dirs} {
         logman "$mname:exit(0):one of scan for files(f) or scan for \
                 dirs(d) must be given"
         return 0
      }
   }

   if {$tcl_platform(platform) == "unix"} {
      logman [format "%s:exit(1):sff=%d,sfd=%d,sfl=%d,sd=%d" $mname \
              $dscan_for_files $dscan_for_dirs $dscan_for_symlinks \
              $dscan_descend]
   } else {
      logman [format "%s:exit(1):sff=%d,sfd=%d,sd=%d" $mname \
              $dscan_for_files $dscan_for_dirs $dscan_descend]
   }

   return 1
}
    
proc dscan_set_current_path {p} {
   # Save the current path. Returns 1 upon success, 0 otherwise.
   global dscan_current_path
   set mname "dscan_set_current_path"

   dscan_header $mname

   if {$p == ""} {
      logman "$mname:exit(0):empty(p)"
      return 0
   }

   set dscan_current_path $p
   logman "$mname:exit(1):cp=$dscan_current_path"
   return 1
}

proc dscan_ll_delete {p} {
   # Delete an array entry by it's path.
   global dscan_entry
   set mname "dscan_ll_delete"

   dscan_header $mname
   logman "$mname:array before delete"
   dscan_ll_debug

   if {$p == ""} {
      logman "$mname:exit:empty(p)"
      return
   }

   logman [format "%s:p=%s(%d)" $mname $p [string length $p]]

   if {![dscan_ll_find $p]} {
      logman "$mname:exit:entry not found"
      return
   }

   array unset dscan_entry $p
   logman "$mname:normal exit:array after"
   dscan_ll_debug
}

proc dscan_set_mvars {path fname} {
   # Set the global base path and the file search string.
   global dscan_base_path dscan_fname
   set mname "dscan_set_mvars"

   dscan_header $mname

   if {$path == "" || $fname == ""} {
      logman "$mname:exit(0) parm error"
      return 0
   }

   if {$dscan_base_path != ""} {
      logman "$mname:exit(0):base path already assigned"
      return 0
   }

   set dscan_base_path $path

   if {$dscan_fname != ""} {
      logman "$mname:exit(0):target files name already assigned"
      return 0
   }

   set dscan_fname $fname
   logman "$mname:normal exit(1)"
   return 1
}
   
proc dscan_delete_mvars {} {
   # Wipe the globals.
   global dscan_base_path dscan_current_path dscan_fname
   global dscan_hold_list dscan_entry
   set mname "dscan_delete_mvars"

   dscan_header $mname

   set dscan_base_path ""
   set dscan_current_path ""
   set dscan_fname ""
   set dscan_hold_list ""

   if {[array exists dscan_entry]} {
      array unset dscan_entry
   }
   
   logman "$mname:normal exit"
}
   
proc dscan_ll_find {p} {
   # Locate an array entry by the path. Returns 1 if the element
   # was found, 0 otherwise.
   global dscan_entry
   set mname "dscan_ll_find"

   dscan_header $mname
   
   if {![string length $p]} {
      logman "$mname:exit(0):empty(p)"
      return 0
   }

   logman [format "%s:attempting to locate %s(%d)" $mname $p \
           [string length $p]]

   if {![array exists dscan_entry]} {
      logman "$mname:exit(0):array empty"
      return 0
   }

   # search array for path
   set id [array startsearch dscan_entry]

   while {[array anymore dscan_entry $id]} {
      set element [array nextelement dscan_entry $id]

      if {$element == $p} {
         array donesearch dscan_entry $id
         logman "$mname:exit(1):found entry"
         return 1
      }
   }

   # not found
   array donesearch dscan_entry $id
   logman "$mname:exit(0):not found"
   return 0
} 

proc dscan_ll_add {p} {
   # Load the holding list ('dscan_hold_list') with the contents 
   # of the current directory with item types and add the 
   # current path to the 'dscan_entry' array if 'dscan_descend'
   # is active. Returns 1 if the add was successful, 0 
   # otherwise.
   global tcl_platform dscan_current_path
   global dscan_entry dscan_hold_list dscan_fname
   global dscan_for_files dscan_for_dirs dscan_descend
   global DSCAN_TYPE_FILE DSCAN_TYPE_DIR

   if {$tcl_platform(platform) == "unix"} {
      global dscan_for_symlinks DSCAN_TYPE_SYMLINK
   }

   set mname "dscan_ll_add"

   dscan_header $mname
   dscan_ll_debug

   if {$p == ""} {
      logman "$mname:exit(0):empty(p)"
      return 0
   }

   # build list of items in the current directory, each
   # element of the list is in two parts consisting of
   # the element name followed by a delimiter ('DSCAN_LIST_DELIM')
   # and a type code
   set dscan_hold_list ""
   set fullspec "$dscan_current_path/$dscan_fname"

   if {$dscan_for_files} {
      set items [glob -nocomplain -types f $fullspec]

      if {$items != ""} {
         dscan_set_hold $items $DSCAN_TYPE_FILE
      }
   }

   if {$dscan_for_dirs} {
      set items [glob -nocomplain -types d $fullspec]

      if {$items != ""} {
         dscan_set_hold $items $DSCAN_TYPE_DIR
      }
   }

   if {$tcl_platform(platform) == "unix"} {
      if {$dscan_for_symlinks} {
         set items [glob -nocomplain -types l $fullspec]

         if {$items != ""} {
            dscan_set_hold $items $DSCAN_TYPE_SYMLINK
         }
      }
   }

   set fullspec "$dscan_current_path/*"
   set items [glob -nocomplain -types d $fullspec]
   set dscan_entry($p) $items
   dscan_ll_debug
   logman "$mname:normal exit(1)"
   return 1
}

proc dscan_set_hold {glist type} {
   # Add the items in 'glist' to 'dscan_hold_list'.
   global dscan_hold_list DSCAN_LIST_DELIM
   set mname "dscan_set_hold"

   dscan_header $mname

   if {$glist == ""} {
      logman "$mname:exit:empty(glist)"
      return
   }

   if {$type == ""} {
      logman "$mname:exit:empty:type"
      return
   }

   set nitems [llength $glist]

   for {set i 0} {$i < $nitems} {incr i} {
      set item [lindex $glist $i]
      append item $DSCAN_LIST_DELIM$type
      lappend dscan_hold_list $item
   }

   logman "$mname:normal exit:dscan_hold_list=$dscan_hold_list"
}

proc dscan_ll_debug {} {
   # Output the current contents of the 'dscan_entry' array
   # and the 'dscan_hold_list' list to the log (if active).
   global dscan_entry dscan_hold_list
   set mname "dscan_ll_debug"

   dscan_header $mname
   logman "$mname:dscan_hold_list=$dscan_hold_list"

   if {![array exists dscan_entry]} {
      logman "$mname:exit:array 'dscan_entry' is empty"
      return
   }
      
   set id [array startsearch dscan_entry]

   while {[array anymore dscan_entry $id]} {
      set element [array nextelement dscan_entry $id]
      logman "$mname:dscan_entry:$element=$dscan_entry($element)"
   }

   array donesearch dscan_entry $id
   logman "$mname:normal exit"
}

proc dscan_header {mname} {
   # Log the entrance into a procedure.

   logman "$mname:enter"
}
