Blame src/FileUtilFIND.ml

Packit 9ff65e
(******************************************************************************)
Packit 9ff65e
(*  ocaml-fileutils: files and filenames common operations                    *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  Copyright (C) 2003-2014, Sylvain Le Gall                                  *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  This library is free software; you can redistribute it and/or modify it   *)
Packit 9ff65e
(*  under the terms of the GNU Lesser General Public License as published by  *)
Packit 9ff65e
(*  the Free Software Foundation; either version 2.1 of the License, or (at   *)
Packit 9ff65e
(*  your option) any later version, with the OCaml static compilation         *)
Packit 9ff65e
(*  exception.                                                                *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  This library is distributed in the hope that it will be useful, but       *)
Packit 9ff65e
(*  WITHOUT ANY WARRANTY; without even the implied warranty of                *)
Packit 9ff65e
(*  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the file         *)
Packit 9ff65e
(*  COPYING for more details.                                                 *)
Packit 9ff65e
(*                                                                            *)
Packit 9ff65e
(*  You should have received a copy of the GNU Lesser General Public License  *)
Packit 9ff65e
(*  along with this library; if not, write to the Free Software Foundation,   *)
Packit 9ff65e
(*  Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA             *)
Packit 9ff65e
(******************************************************************************)
Packit 9ff65e
Packit 9ff65e
open FileUtilTypes
Packit 9ff65e
open FilePath
Packit 9ff65e
open FileUtilMisc
Packit 9ff65e
open FileUtilTEST
Packit 9ff65e
open FileUtilSTAT
Packit 9ff65e
open FileUtilREADLINK
Packit 9ff65e
Packit 9ff65e
Packit 9ff65e
let find ?(follow=Skip) ?match_compile tst fln exec user_acc =
Packit 9ff65e
Packit 9ff65e
  let user_test = compile_filter ?match_compile tst in
Packit 9ff65e
Packit 9ff65e
  let skip_action =
Packit 9ff65e
    match follow with
Packit 9ff65e
      | Skip | AskFollow _ | Follow -> ignore
Packit 9ff65e
      | SkipInform f -> f
Packit 9ff65e
  in
Packit 9ff65e
Packit 9ff65e
  let should_skip fln already_followed =
Packit 9ff65e
    match follow with
Packit 9ff65e
      | Skip | SkipInform _ -> true
Packit 9ff65e
      | AskFollow f ->
Packit 9ff65e
          if not already_followed then
Packit 9ff65e
            f fln
Packit 9ff65e
          else
Packit 9ff65e
            true
Packit 9ff65e
      | Follow ->
Packit 9ff65e
          if already_followed then
Packit 9ff65e
            raise (RecursiveLink fln)
Packit 9ff65e
          else
Packit 9ff65e
            false
Packit 9ff65e
  in
Packit 9ff65e
Packit 9ff65e
  let already_read = ref SetFilename.empty in
Packit 9ff65e
Packit 9ff65e
  let rec find_aux acc fln =
Packit 9ff65e
    let st_opt =
Packit 9ff65e
      try
Packit 9ff65e
        Some (stat fln)
Packit 9ff65e
      with FileDoesntExist _ ->
Packit 9ff65e
        None
Packit 9ff65e
    in
Packit 9ff65e
    let stL_opt =
Packit 9ff65e
      match st_opt with
Packit 9ff65e
        | Some st when st.is_link ->
Packit 9ff65e
            begin
Packit 9ff65e
              try
Packit 9ff65e
                Some (stat ~dereference:true fln)
Packit 9ff65e
              with FileDoesntExist _ ->
Packit 9ff65e
                None
Packit 9ff65e
            end
Packit 9ff65e
        | _ ->
Packit 9ff65e
            st_opt
Packit 9ff65e
    in
Packit 9ff65e
    let acc =
Packit 9ff65e
      if user_test ?st_opt ?stL_opt fln then
Packit 9ff65e
        exec acc fln
Packit 9ff65e
      else
Packit 9ff65e
        acc
Packit 9ff65e
    in
Packit 9ff65e
      match st_opt with
Packit 9ff65e
        | Some st ->
Packit 9ff65e
            if st.kind = Symlink then begin
Packit 9ff65e
              follow_symlink stL_opt acc fln
Packit 9ff65e
            end else if st.kind = Dir then begin
Packit 9ff65e
              enter_dir acc fln
Packit 9ff65e
            end else begin
Packit 9ff65e
              acc
Packit 9ff65e
            end
Packit 9ff65e
        | None -> acc
Packit 9ff65e
Packit 9ff65e
  and enter_dir acc drn =
Packit 9ff65e
    Array.fold_left
Packit 9ff65e
      (fun acc rfln ->
Packit 9ff65e
         if is_parent rfln || is_current rfln then
Packit 9ff65e
           acc
Packit 9ff65e
         else
Packit 9ff65e
           find_aux acc (concat drn rfln))
Packit 9ff65e
      acc
Packit 9ff65e
      (Sys.readdir drn)
Packit 9ff65e
Packit 9ff65e
  and follow_symlink stL_opt acc fln =
Packit 9ff65e
      match stL_opt with
Packit 9ff65e
        | Some stL when stL.kind = Dir ->
Packit 9ff65e
            let cur_link = readlink fln in
Packit 9ff65e
            let already_followed =
Packit 9ff65e
              try
Packit 9ff65e
                already_read := prevent_recursion !already_read cur_link;
Packit 9ff65e
                false
Packit 9ff65e
              with RecursiveLink _ ->
Packit 9ff65e
                true
Packit 9ff65e
            in
Packit 9ff65e
              if should_skip fln already_followed then begin
Packit 9ff65e
                skip_action fln;
Packit 9ff65e
                acc
Packit 9ff65e
              end else begin
Packit 9ff65e
                enter_dir acc fln
Packit 9ff65e
              end
Packit 9ff65e
        | _ ->
Packit 9ff65e
            acc
Packit 9ff65e
  in
Packit 9ff65e
    find_aux user_acc (reduce fln)