#!/usr/local/bin/scsh \
-lel dir-streams/load.scm -o dir-streams -e main -s
Works with scsh 0.6.7 and sunterlib dir-streams 1.0.
USAGE: clonedirskelt FROM-DIR TO-DIR
Clone the directory skeleton (the bare subdir tree without leaves)
of source directory FROM-DIR as target directory TO-DIR. I.e.
afterwards the names of the source and clone root may differ,
but the names of the (strict) subdirs relative to FROM-DIR resp.
TO-DIR will coincide. Forget symlinks (due to lack of ambition).
The TO-DIR must not contain (hard-linked) cycles.
The TO-DIR may preexist and live on --directories will not be
creatively destroyed. Ich verstehe mich.
Examples
clonedirskelt /foo/bar /ph/oo/bar
clonedirskelt /foo/bar /foo/baz
clonedirskelt /foo/bar ../baz
Don't expect checks, error messages, quality.
It would be nice to translate inward-pointing and to copy outward-
pointing symlinks, but I do not need and did not do this.
!#
;; simplify and remove trailing "/." (forgetting about symlinks)
(define (simplerify-file-name fn)
(let ((sn (simplify-file-name fn)))
(cond ((string-suffix? "/." sn)
(string-drop-right sn 2))
((string= sn ".") "")
(else sn))))
;; SRC-ROOT, %CLONE-ROOT : String --directory paths
(define (clone-dir-skeleton src-root %clone-root)
(define clone-root (file-name-as-directory (resolve-file-name %clone-root
(cwd))))
(with-cwd src-root
(dir-stream-for-each
(dir-stream-from-dir-name "." #f)
(lambda (fso-file) #f)
(lambda (fso-dir)
(let ((path-clone-dir (simplerify-file-name
(string-append clone-root
(fs-object-file-name fso-dir)))))
(format #t "~a~%" path-clone-dir)
(if (file-not-exists? path-clone-dir)
(create-directory path-clone-dir)))))))
;; no usage check tonite
(define (main args)
(clone-dir-skeleton (second args) (third args)))
