diff options
| -rwxr-xr-x | walk.scm | 101 |
1 files changed, 101 insertions, 0 deletions
diff --git a/walk.scm b/walk.scm new file mode 100755 index 0000000..4e53dca --- /dev/null +++ b/walk.scm @@ -0,0 +1,101 @@ +#!/usr/bin/guile \ +-s +!# +(use-modules (ice-9 popen) + (logging logger) + (logging port-log) + (ice-9 ftw) + (ice-9 match) + (oop goops) + (term ansi-color)) + +(define (expand-file f) + ;; https://irreal.org/blog/?p=83 + (cond ((absolute-file-name? f) f) + ((string=? (substring f 0 2) "~/") + (let ((prefix (passwd:dir (getpwuid (geteuid))))) + (string-append prefix (substring f 1 (string-length f))))) + ((char=? (string-ref f 0) #\~) + (let* ((user-end (string-index f #\/)) + (user (substring f 1 user-end)) + (prefix (passwd:dir (getpwnam user)))) + (string-append prefix (substring f user-end (string-length f))))) + (else (string-append (getcwd) "/" f)))) + +(define (symlink? path) + (false-if-exception + (eq? 'symlink (stat:type (lstat path))))) + +(define (clean-file full-dest) + (when (false-if-exception (lstat full-dest)) + (display (string-append "\nDeleting previous file: " full-dest)) + ;(delete-file full-dest) + )) + +(define (config-links src target) + (let ((src-path (expand-file src)) + (target-path (expand-file target))) + (unless (and (symlink? target-path) (equal? (readlink target-path) src-path)) + (clean-file target-path) + ;(symlink src-path target-path) + (display (string-append "\n Symlink: " src " -> " target))))) + +(define (total-file-size file-name target-path) + "Return the size in bytes of the files under FILE-NAME (similar + to `du --apparent-size' with GNU Coreutils.)" + (define src-len (string-length file-name)) + + (define (enter? name stat result) + ;; Skip version control directories. + (let* ((subdir (substring name src-len)) + (target-subdir (string-append target-path subdir))) + (format #t "~%~a: ~a | ~a ~a" name subdir target-subdir (stat:type stat)) + (false-if-exception (eq? 'directory (stat:type (lstat target-subdir)))) + )) + + (define (leaf name stat result) + ;; Return RESULT plus the size of the file at NAME. + (let* ((subfile (substring name src-len)) + (target-subfile (string-append target-path subfile))) + (config-links name target-subfile)) + + (set-car! result (1+ (car result))) + result) + + ;; Count zero bytes for directories. + (define (down name stat result) + (format #t "~% down on ~a" name) + (cons 0 result)) + (define (up name stat result) + (let* ((subdir (substring name src-len)) + (target-subdir (string-append target-path subdir)) + (target-subdir-file-count (length (scandir target-subdir + (lambda (x) + (not (member x (list "." "..")))))))) + (format #t "~% up on ~a ~a ~a ~a " result name target-subdir target-subdir-file-count) + (when (= (car result) target-subdir-file-count) + ;(format #t "~% Clear ~a because is identical to source" name) + (leaf name stat result))) + + (list-set! result 1 (1+ (cadr result))) + (cdr result)) + ;; Likewise for skipped directories. + (define skip leaf) + + ;; Ignore unreadable files/directories but warn the user. + (define (error name stat errno result) + (format (current-error-port) "warning: ~a: ~a~%" + name (strerror errno)) + result) + + (file-system-fold enter? leaf down up skip error + (list 0) + file-name)) + + +(total-file-size "config" "/home/titan/.config") + +(let ((di "/home/titan/.config/you")) + (false-if-exception (eq? 'directory (stat:type (lstat di))))) + +(error "hci" #f) |