(* file-finding for ocaml
   Copyright (C) 2002 Shawn Wagner <raevnos@pennmush.org>

   This library is free software; you can redistribute it and/or
   modify it under the terms of the GNU Lesser General Public
   License as published by the Free Software Foundation; either
   version 2.1 of the License, or (at your option) any later version.
	 
   This library 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
   Lesser General Public License for more details.
	 
   You should have received a copy of the GNU Lesser General Public
   License along with this library; if not, write to the Free Software
   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*)

open Unix

(** Type that describes file sizes *)
type size = [ `Bytes of int | `Kilobytes of int | `Megabytes of int ]

(** Type that describes file size tests *)
type size_test = [ `LargerThan of size | `SmallerThan of size | `EqualTo of size ]
type rsize_test = RLargerThan of int | RSmallerThan of int | REqualTo of int

let convert_bytes = function
  | `Bytes b -> b
  | `Kilobytes k -> k * 1024
  | `Megabytes m -> m * 1024 * 1024

let convert_size = function
  | `LargerThan s -> RLargerThan (convert_bytes s)
  | `SmallerThan s -> RSmallerThan (convert_bytes s)
  | `EqualTo s -> REqualTo (convert_bytes s)

(** Type that describes file timestamp tests *)
type time_test = [ `Before of int32 | `After of int32 | `At of int32 ]

(** The type of file tests *)
type test = [
    `Name of string (** Name is wildcard matched *)
  | `IName of string (** Name is wildcase matched, case-insensitively *)
  | `Regexp of string (** Name is PCRE-regexp matched *)
  | `Type of file_kind (** Only files of the given type *)
  | `Owner of int (** File owned by the given UID *)
  | `Group of int (** File group is the given GID *)
  | `Perms of Unix.file_perm (** File's permissions overlap the mask *)
  | `Size of size_test (** Check the file's size *)
  | `Modified of time_test (** Check the file's last-modified date *)
  | `Created of time_test (** Check the file's statuc change date *)
  | `Accessed of time_test (** Check the file's last-accessed date *)
  | `Eval of (string -> Unix.stats -> bool) (** Call a user-defined function for the file. *)
  | `And of test list (** True if all of the sub-tests are true. *)
  | `Or of test list (** True if one of the sub-tests is true *)
  | `True | `False
]

type rtest =
    RName of Glob.t (** Name is wildcard matched *)
  | RIName of Glob.t (** Name is wildcase matched, case-insensitively *)
  | RRegexp of Pcre.regexp (** Name is PCRE-regexp matched *)
  | RType of file_kind (** Only files of the given type *)
  | ROwner of int (** File owned by the given UID *)
  | RGroup of int (** File group is the given GID *)
  | RPerms of Unix.file_perm (** File's permissions overlap the mask *)
  | RSize of rsize_test (** Check the file's size *)
  | RModified of time_test (** Check the file's last-modified date *)
  | RCreated of time_test (** Check the file's statuc change date *)
  | RAccessed of time_test (** Check the file's last-accessed date *)
  | REval of (string -> stats -> bool) (** Call a user-defined function for the file. *)
  | RAnd of rtest list (** True if all of the sub-tests are true. *)
  | ROr of rtest list (** True if one of the sub-tests is true *)
  | RTrue | RFalse

let rec test_to_rtest = function
  | `Name n -> RName (Glob.compile n)
  | `IName n -> RIName (Glob.compile ~cs:false n)
  | `Regexp r -> RRegexp (Pcre.regexp ~study:true r)
  | `Type t -> RType t
  | `Owner t -> ROwner t
  | `Group t -> RGroup t
  | `Perms t -> RPerms t
  | `Size t -> RSize (convert_size t)
  | `Modified t -> RModified t
  | `Created t -> RCreated t
  | `Accessed t -> RAccessed t
  | `Eval f -> REval f
  | `And t -> RAnd (List.map test_to_rtest t) 
  | `Or t -> ROr (List.map test_to_rtest t)
  | `True -> RTrue
  | `False -> RFalse

type t = {
  tests: rtest;
}

let make tst = { tests = test_to_rtest tst; }

let check_size wanted actual =
  match wanted with
    | RSmallerThan bytes -> actual < bytes
    | RLargerThan bytes -> actual > bytes
    | REqualTo bytes -> actual = bytes
	   

let check_time wanted actual =
  match wanted with
    | `Before t -> actual < t
    | `After t -> actual > t
    | `At t -> t = actual

let rec run_test filename st test =
  let name = Filename.basename filename in
  match test with
    | RTrue -> true
    | RFalse -> false
    | RName pat | RIName pat -> Glob.exec pat name
    | RRegexp rex -> Pcre.pmatch ~rex name
    | RType t -> t = st.st_kind
    | ROwner uid -> uid = st.st_uid
    | RGroup gid -> gid = st.st_gid
    | RPerms p -> p land st.st_perm <> 0
    | RSize s -> check_size s st.st_size
    | RModified t -> check_time t (Int32.of_float st.st_mtime)
    | RCreated t -> check_time t (Int32.of_float st.st_ctime)
    | RAccessed t -> check_time t (Int32.of_float st.st_atime)
    | REval f -> f filename st
    | RAnd tests ->
	let rec do_and = function
	  | [] -> true
	  | car :: cdr ->
	      if run_test filename st car then do_and cdr else false in
	  do_and tests
    | ROr tests ->
	let rec do_or = function
	  | [] -> false
	  | car :: cdr ->
	      if run_test filename st car then true else do_or cdr in
	  do_or tests

	

let run find = false
  

let dotdir = Pcre.regexp ~study:true "(?:\\.|\\.\\.)$"
  
let rec find t dirname = 
  let dir = opendir dirname 
  and res = ref ([]:string list) in
    try
      while true do
	let fname = readdir dir in
	let file = Filename.concat dirname fname in
	  if not (Pcre.pmatch ~rex:dotdir file) then 
	    let st = Unix.lstat file in
	      if run_test file st t.tests then res := file :: !res;
	      if st.st_kind = S_DIR then begin
		let nest_res = find t file in
		  res := List.concat [nest_res; !res]	    
	      end
      done;
      !res
    with
      | End_of_file -> !res
      | x -> flush Pervasives.stderr; raise x