aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rwxr-xr-xwalk.scm101
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)