## dir-tree.pkg
## Author: Matthias Blume (blume@cs.princeton.edu)
# Compiled by:
# src/lib/std/standard.lib# Compare to:
# src/lib/src/dir.pkg# src/lib/src/symlink-tree.pkg# Just like dir from
# src/lib/src/dir.pkg# except that we process all entries in
# an entire directory tree, instead of
# in just one directory.
stipulate
package lms = list_mergesort; # list_mergesort is from src/lib/src/list-mergesort.pkg package psx = posix_1003_1b; # posix_1003_1b is from src/lib/std/src/posix-1003.1b/posix-1003-1b.pkgherein
package dir_tree
: Dir_Tree # Dir_Tree is from src/lib/src/dir-tree.api {
fun is_dir filename
=
psx::stat::is_directory
(psx::stat filename)
except
_ = FALSE;
fun is_file filename
=
psx::stat::is_file
(psx::stat filename)
except
_ = FALSE;
fun is_symlink filename
=
psx::stat::is_symlink
(psx::lstat filename)
except
_ = FALSE;
fun canonicalize directory_name
=
{ # Drop any leading "./":
#
directory_name
=
regex::replace_first "^\\./" "" directory_name;
# Change "." to "":
#
directory_name
=
directory_name == "." ?? ""
:: directory_name;
# Make relative paths absolute by
# prepending current working directory:
#
directory_name
=
if (string::length directory_name == 0)
winix::file::current_directory ();
else
if (string::get (directory_name, 0) != '/')
cwd = winix::file::current_directory ();
cwd + "/" + directory_name;
else
directory_name;
fi;
fi;
# Delete any foo/.. subsequences:
#
directory_name'
=
regex::replace_first "[^/]+/\\.\\." "" directory_name;
if (directory_name == directory_name')
directory_name;
else
canonicalize directory_name';
fi;
};
# For all directory entries in given directory tree do
# results = result_fn( path, dir, file, results );
# (where path == dir + "/" + file)
# and then return the resulting list.
#
fun filter_directory_subtree_contents
(
(directory_name: String),
(result_fn: (String, String, String, List(X)) -> List(X)),
(results: List(X))
)
=
{
results
=
safely::do
{
open_it => .{ psx::open_directory_stream directory_name; },
close_it => psx::close_directory_stream,
cleanup => fn _ = ()
}
.{ loop results
where
fun loop results
=
case (psx::read_directory_entry #directory_stream)
#
NULL => results;
#
THE entry_name
=>
{ path = directory_name + "/" + entry_name;
#
results = result_fn( path, directory_name, entry_name, results );
#
results
=
if (entry_name != "."
and entry_name != ".."
and is_dir path
and not (is_symlink path))
#
filter_directory_subtree_contents
(path, result_fn, results);
else
results;
fi;
loop results;
};
esac;
end;
};
results;
};
# Return alphabetically sorted list of paths
# for all entries in directory subtree whose
# names do not start with a dot:
#
# [ "/home/jcb/foo", ... ]
#
fun entries (directory_name: String)
=
{ fun ignore_dot_initial_entries (path, dir, file, results)
=
if (string::length file > 0
and string::get (file, 0) == '.')
results;
else
path ! results;
fi;
results
=
filter_directory_subtree_contents
(
canonicalize directory_name,
ignore_dot_initial_entries,
[]
);
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all entries in directory subtree whose
# names are not "." or "..":
#
# [ "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", ... ]
#
fun entries' (directory_name: String)
=
{ fun ignore_dot_and_dotdot (path, dir, file, results)
=
if (file == "."
or file == "..")
#
results;
else
path ! results;
fi;
results
=
filter_directory_subtree_contents
(
canonicalize directory_name,
ignore_dot_and_dotdot,
[]
);
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all entries in directory subtree:
#
# [ "/home/jcb/.", "/home/jcb/..", "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", ... ]
#
fun entries'' (directory_name: String)
=
{ fun accept_everything (path, dir, file, results)
=
path ! results;
results
=
filter_directory_subtree_contents
(
canonicalize directory_name,
accept_everything,
[]
);
lms::sort_list string::(>) results;
};
# Return alphabetically sorted list of paths
# for all plain files in directory subtree:
#
# [ "/home/jcb/.bashrc", "/home/jcb/.emacs", "/home/jcb/foo", "/home/jcb/src/test.c", "/home/jcb/zot" ]
#
fun files (directory_name: String)
=
{ fun accept_only_plain_files (path, dir, file, results)
=
is_file path ?? path ! results
:: results;
results
=
filter_directory_subtree_contents
(
canonicalize directory_name,
accept_only_plain_files,
[]
);
lms::sort_list string::(>) results;
};
};
end;
## Copyright (c) 1999, 2000 by Lucent Bell Laboratories
## Subsequent changes by Jeff Prothero Copyright (c) 2010-2011,
## released under Gnu Public Licence version 3.