Skip to content

Instantly share code, notes, and snippets.

@hiiamboris
Last active June 17, 2018 20:37
Show Gist options
  • Save hiiamboris/605a4ab6831a247ac987789f4d578ef1 to your computer and use it in GitHub Desktop.
Save hiiamboris/605a4ab6831a247ac987789f4d578ef1 to your computer and use it in GitHub Desktop.
list files recursively, with a pattern
Red [title: "glob func test script"]
#include %glob.red
unless value? 'input [input: none]
root: %globtest-temp-dir.$$$
if exists? root [print ["please remove the" root "from" what-dir "first"] input quit]
change-dir make-dir root
files: compose [
%123
%234
%345
%456
%file.ext
%file.ex2
%file2.ex3
%.file3
%dir1/dir2/dir3/
%dir1/dir4/
%dir1/file5
; trailing period:
(either 'Windows = system/platform
[ to-file rejoin ["\\?\" to-local-file what-dir %file4.] ]
[ %file4. ]
)
; 100 items:
%0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/9/
]
foreach f files [
either dir? f [make-dir/deep f][write f ""]
]
ntotal: nsucc: 0
=>: make op! func [code rslt /local r] [
ntotal: ntotal + 1
prin ["testing" pad mold/flat code 40 "... "]
r: try code
either error? r [
print ["^/" mold r]
print "FAILED^/"
][
either r <> rslt
[ print ["^/ exp" mold/flat rslt]
print [" got" mold/flat r]
print "FAILED^/" ]
[ print "OK" nsucc: nsucc + 1 ]
]
]
big-tree: collect [foreach x split last files #"/" [unless empty? x [keep copy append %"" dirize x]]]
[sort glob/limit 0] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %0/]
[sort glob/limit 1] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir4/ %dir1/file5 %0/ %0/1/]
[sort glob/limit 2] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir2/dir3/ %dir1/dir4/ %dir1/file5 %0/ %0/1/ %0/1/2/]
[sort glob/limit 3] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir2/dir3/ %dir1/dir4/ %dir1/file5 %0/ %0/1/ %0/1/2/ %0/1/2/3/]
[sort glob] => sort compose [
%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir2/dir3/ %dir1/dir4/ %dir1/file5
(big-tree)
]
[sort glob/only "123"] => [%123]
[sort glob/only ["123" "234" "345"]] => [%123 %234 %345]
[sort glob/only "*23*"] => [%123 %234]
[sort glob/only "*23"] => [%123]
[sort glob/only "23*"] => [%234]
[sort glob/only "*2*3*"] => sort [%123 %234 %file2.ex3]
[sort glob/only "*il*ex*"] => sort [%file.ext %file.ex2 %file2.ex3]
[sort glob/only "*il*ex?"] => sort [%file.ext %file.ex2 %file2.ex3]
[sort glob/only "**123"] => [%123]
[sort glob/only "**123**"] => [%123]
[sort glob/only "123**"] => [%123]
[sort glob/only "???"] => [%123 %234 %345 %456]
[sort glob/only "??"] => []
[sort glob/only "?*?"] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir2/dir3/ %dir1/dir4/ %dir1/file5]
[sort glob/only "?"] => sort big-tree
[sort glob/only "5"] => sort collect [foreach f big-tree [if #"5" = pick tail f -2 [keep f]]]
[sort glob/only ["*0" "5*"]] => sort collect [foreach f big-tree [if find "05" pick tail f -2 [keep f]]]
[sort glob/only "*."] => [%file4.]
[sort glob/only/omit "?" "?"] => []
[sort glob/only/omit "?" "5"] => sort collect [foreach f big-tree [if #"5" <> pick tail f -2 [keep f]]]
[sort glob/only/omit "?" ["*0" "5*"]] => sort collect [foreach f big-tree [unless find "05" pick tail f -2 [keep f]]]
[sort glob/omit "?"] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/ %dir1/dir2/ %dir1/dir2/dir3/ %dir1/dir4/ %dir1/file5]
[sort glob/omit "*"] => []
[sort glob/omit ["*.?*" "???" "????" "?"]] => sort [%file4. %dir1/file5]
[sort glob/only/omit "*il*ex?" "*t"] => sort [%file.ex2 %file2.ex3]
[sort glob/files] => sort [%123 %234 %345 %456 %file.ext %file.ex2 %file2.ex3 %.file3 %file4. %dir1/file5]
[sort glob/files/only "*.*"] => sort [%file.ext %file.ex2 %file2.ex3 %.file3 %file4.]
[sort glob/files/omit "*.*"] => sort [%123 %234 %345 %456 %dir1/file5]
[sort glob/from copy/part last files skip tail last files -9] => sort [%6/ %6/7/ %6/7/8/ %6/7/8/9/]
[sort glob/from copy/part last files skip tail last files -4] => sort [%8/ %8/9/]
[sort glob/from last files] => []
[sort glob/files/from %0/] => []
print ["--- total" nsucc "of" ntotal "test succeeded ---"]
change-dir %..
input
if nsucc > 0 [
call either 'Windows = system/platform
[ rejoin [{rmdir /q /s "} to-local-file root {"}] ]
[ rejoin [{rm -rf "} to-local-file root {"}] ]
]
quit
Red [title: "glob func" author: @hiiamboris version: 0.3.1 license: 'MIT]
; TODO: an option not to follow symlinks, somehow?
; TODO: allow time! as /limit ? like, abort if takes too long..
; TODO: asynchronous/concurrent listing (esp. of different physical devices)
; BUG: in Windows some masks have special meaning (8.3 filenames legacy)
; these special cases are not replicated in `glob`:
; "*.*" is an equivalent of "*"
; use "*" instead or better leave out the /only refinement
; "*." historically meant any name with no extension, but now also matches filenames ending in a period
; use `/omit "*.?*"` instead of it
; "name?" matches "name1", "name2" ... but also "name"
; use ["name" "name?"] set instead
glob: function [
"Recursively list all files"
/from "starting from a given path"
root [file!] "CWD by default"
/limit "recursion depth (otherwise limited by the maximum path size)"
sublevels [integer!] "0 = root directory only"
/only "include only files matching the mask or block of masks"
imask [string! block!] "* and ? wildcards are supported"
/omit "exclude files matching the mask or block of masks"
xmask [string! block!] "* and ? wildcards are supported"
/files "list only files, not directories"
] bind [
; ^ tip: by binding the func to a context I can use a set of helper funcs
; without recreating them on each `glob` invocation
prefx: tail root: either from [clean-path dirize to-red-file root][copy %./]
; prep masks for bulk parsing
if only [imask: compile imask]
if omit [xmask: compile xmask]
; lessen the number of conditions to check by defaulting sublevels to 1e9
; with maximum path length about 2**15 it is guaranteed to work
unless sublevels [sublevels: 1 << 30]
; requested file exclusion conditions:
; tip: any [] = none, works even if no condition is provided
excl-conds: compose [
(either files [ [dir? f] ][ [] ]) ;-- it's a dir but only files are requested?
(either only [ [not match imask f] ][ [] ]) ;-- doesn't match the provided imask?
(either omit [ [match xmask f] ][ [] ]) ;-- matches the provided xmask?
]
r: copy []
subdirs: append [] %"" ;-- dirs to list right now
nextdirs: [] ;-- will be filled with the next level dirs
until [
foreach d subdirs [ ;-- list every subdir of this level
; path structure, in `glob/from /some/path`:
; /some/path/some/sub-path/files
; ^=root.....^=prefx
; `prefx` gets replaced by `d` every time, which is also relative to `root`:
append clear prefx d
unless error? fs: try [read root] [ ;-- catch I/O (access denied?) errors, ignore silently
foreach f fs [
; `f` is only the last path segment
; but excl-conds should be tested before attaching the prefix to it:
if dir? f [append nextdirs f]
unless any excl-conds [append r f]
; now is able to attach...
insert f prefx
]
]
]
; swap the 2 directory sets, also clearing the used one:
subdirs: also nextdirs nextdirs: clear subdirs
any [
0 > sublevels: sublevels - 1 ;-- exit upon reaching the limit
0 = length? subdirs ;-- exit when nothing more to list
]
]
clear subdirs ;-- cleanup
r
] context [ ;-- helper funcs container
; test if file matches a mask (any of)
match: func [mask [block!] file /local end] [
; shouldn't try to match against the trailing slash:
{end: skip tail file pick [-1 0] dir? file
forall mask [if parse/part file mask/1 end [return yes]]
no}
; (parse/part is buggy, have to modify the file)
end: either dir? file [take/last file][""]
; do [...] is for the buggy compiler only
also do [forall mask [if parse file mask/1 [break/return yes] no]]
append file end
]
; compile single/multiple masks
compile: func [mask [string! block!]] [
either string? mask [reduce [compile1 mask]] [
also mask: copy/deep mask
forall mask [mask/1: compile1 mask/1]
]
]
; compiles a wildcard-based mask into a parse dialect block
compile1: func [mask [string!] /local rule] [
parse mask rule: [ collect [any [
keep some non-wild
| #"?" keep ('skip)
| #"*" keep ('thru) [
; "*" is a backtracking wildcard
; to support it we have to wrap the whole next expr in a `thru [...]`
mask: keep (parse mask rule) thru end
]
] end keep ('end)] ]
]
non-wild: charset [not "*?"]
]
@hiiamboris
Copy link
Author

I ditched the recursive version, that, due to limited stack size was able to look only ~20 subdirectories deep. This one grows the result level by level, and was tested to perform on 127 levels (current Red limitation).

@hiiamboris
Copy link
Author

Tested glob-test.red on W7 x64 & ubuntu x64 VM - 37/37 tests OK

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment