let rec compile_filter flt =
let wrapper f fln =
try
let stats = stat fln
in
f stats
with FileDoesntExist ->
false
in
let res_filter =
match flt with
Is_dev_block -> wrapper (fun st -> st.kind = Dev_block)
| Is_dev_char -> wrapper (fun st -> st.kind = Dev_char)
| Is_dir -> wrapper (fun st -> st.kind = Dir)
| Is_file -> wrapper (fun st -> st.kind = File)
| Is_socket -> wrapper (fun st -> st.kind = Socket)
| Is_pipe -> wrapper (fun st -> st.kind = Fifo)
| Is_link -> wrapper (fun st -> st.is_link)
| Exists -> wrapper (fun st -> true)
| Is_set_group_ID -> wrapper (fun st -> st.permission.group.sticky)
| Has_sticky_bit -> wrapper (fun st -> st.permission.other.sticky)
| Has_set_user_ID -> wrapper (fun st -> st.permission.user.sticky)
| Is_readable -> wrapper (
fun st -> st.permission.user.read || st.permission.group.read || st.permission.other.read
)
| Is_writeable -> wrapper (
fun st -> st.permission.user.write || st.permission.group.write || st.permission.other.write
)
| Is_exec -> wrapper (
fun st -> st.permission.user.exec || st.permission.group.exec || st.permission.other.exec
)
| Size_not_null -> wrapper (
fun st -> (size_compare st.size (B 0.0) ) > 0
)
| Size_bigger_than sz -> wrapper (
fun st -> (size_compare st.size sz) > 0
)
| Size_smaller_than sz -> wrapper (
fun st -> (size_compare st.size sz) < 0
)
| Size_equal_to sz -> wrapper (
fun st -> (size_compare st.size sz) = 0
)
| Size_fuzzy_equal_to sz -> wrapper (
fun st -> (size_compare ~fuzzy:true st.size sz) = 0
)
| True -> fun x -> true
| False -> fun x -> false
| Is_owned_by_user_ID -> wrapper (
fun st -> Unix.geteuid () = st.owner
)
| Is_owned_by_group_ID -> wrapper (
fun st -> Unix.getegid () = st.group_owner
)
| Is_newer_than(f1) ->
begin
try
let st1 = stat f1
in
wrapper (fun st2 -> st1.modification_time < st2.modification_time)
with FileDoesntExist ->
fun x -> false
end
| Is_older_than(f1) ->
begin
try
let st1 = stat f1
in
wrapper (fun st2 -> st2.modification_time > st2.modification_time)
with FileDoesntExist ->
fun x -> false
end
| Is_newer_than_date(dt) -> wrapper (fun st -> st.modification_time > dt)
| Is_older_than_date(dt) -> wrapper (fun st -> st.modification_time < dt)
| And(flt1,flt2) ->
let cflt1 = (compile_filter flt1)
in
let cflt2 = (compile_filter flt2)
in
fun x -> (cflt1 x) && (cflt2 x)
| Or(flt1,flt2) ->
let cflt1 = (compile_filter flt1)
in
let cflt2 = (compile_filter flt2)
in
fun x -> (cflt1 x) || (cflt2 x)
| Not(flt1) ->
let cflt1 = (compile_filter flt1)
in
fun x -> not (cflt1 x)
| Match(r) ->
let reg = OperationRegexp.compile r
in
fun x -> OperationRegexp.test reg x
| Has_extension(ext) ->
begin
fun x ->
try
check_extension x (extension_of_string ext)
with FilePathNoExtension ->
false
end
| Has_no_extension ->
begin
fun x ->
try
let _ = chop_extension x
in
false
with FilePathNoExtension ->
true
end
| Is_current_dir ->
fun x -> (is_current (basename x))
| Is_parent_dir ->
fun x -> (is_parent (basename x))
| Basename_is s ->
let rs = reduce s
in
fun x -> (reduce (basename x)) = rs
| Dirname_is s ->
let rs = reduce s
in
fun x -> (reduce (dirname x)) = rs
| Custom f ->
f
in
fun x -> res_filter x