9. Directories

(define entry (stat "/usr/bin/vi"))
(define entry (stat "/usr/bin"))
(define entry (stat port))

(use-modules (ice-9 posix))

(define inode (stat "/usr/bin/vi"))
(define ctime (stat:ctime inode))
(define size (stat:size inode))

(define F (open-input-file filename))
;; no equivalent - what defines -T?
; unless (-s F && -T _) {
;     die "$filename doesn't have text in it.\n";
; }

(define dir (opendir "/usr/bin"))
(do ((filename (readdir dir) (readdir dir)))
    ((eof-object? filename))
  (format #t "Inside /usr/bin is something called ~A\n" filename))
(closedir dir)

(define inode (stat filename))
(define readtime (stat:atime inode))
(define writetime (stat:mtime inode))

(utime newreadtime newwritetime filename)

(define seconds-per-day (* 60 60 24))
(define inode (stat file))
(define atime (stat:atime inode))
(define mtime (stat:mtime inode))
(set! atime (- atime (* 7 seconds-per-day)))
(set! mtime (- mtime (* 7 seconds-per-day)))
(utime file atime mtime)

;; mtime is optional
(utime file (current-time))
(utime file (stat:atime (stat file)) (current-time))

#!/usr/local/bin/guile -s
!#
;; uvi - vi a file without changing its access times

(define file (cadr (command-line)))
(define inode (stat file))
(define atime (stat:atime inode))
(define mtime (stat:mtime inode))
(system (string-append (or (getenv "EDITOR")  "vi") " " file))
(utime file atime mtime)

(delete-file file)

(let ((count 0))
  (for-each
   (lambda (x)
     (catch #t
       (lambda () (delete-file x) (set! count (1+ count)))
       (lambda (err . args) #f)))
   file-list)
  (if (not (= count (length file-list)))
    (format (current-error-port) "could only delete ~A of ~A files"
            count (length file-list))))

;; use builtin copy-file
(copy-file oldfile newfile)
(rename-file oldfile newfile)

;; or do it by hand (clumsy, error-prone)
(use-modules (ice-9 rw) (ice-9 posix))
(with-input-from-file oldfile
  (lambda ()
    (call-with-output-file newfile
      (lambda (p)
        (let* ((inode (stat oldfile))
               (blksize (if inode (stat:size inode) 16384))
               (buf (make-string blksize)))
          (let loop ((len (read-string!/partial buf)))
            (cond ((and len (> len 0))
                   (write-string/partial buf p 0 len)
                   (loop (read-string!/partial buf))))))))))

;; or call out to the system (non-portable, insecure)
(system (string-append "cp " oldfile " " newfile))    ; unix
(system (string-append "copy " oldfile " " newfile))  ; dos, vms

;; use a hash lookup of inodes
(use-modules (ice-9 posix))
(let ((seen (make-hash-table 31)))
  (for-each
   (lambda (file)
     (let* ((stats (stat file))
            (key (cons (stat:dev stats) (stat:ino stats)))
            (val (hash-ref seen key 0)))
       (cond ((= val 0)
              ;; do something with new file
              ))
       (hash-set! seen key (1+ val))))
   file-names))

(let ((seen (make-hash-table 31)))
  (for-each
   (lambda (file)
     (let* ((stats (stat file))
            (key (cons (stat:dev stats) (stat:ino stats)))
            (val (hash-ref seen key '())))
       (hash-set! seen key (cons file val))))
   file-names)
  (hash-fold
   (lambda (key value prior)
     ;; process key == (dev . inode), value == list of filenames
     )
   '() seen))

;; use opendir, readdir, closedir
(let ((p (opendir dir)))
  (let loop ((file (readdir p)))
    (if (eof-object? file)
      (close p)
      ;; do something with file
      )))

;; or define a utility function for this
(define (directory-files dir)
  (if (not (access? dir R_OK))
    '()
    (let ((p (opendir dir)))
      (do ((file (readdir p) (readdir p))
           (ls '()))
          ((eof-object? file) (closedir p) (reverse! ls))
        (set! ls (cons file ls))))))

;; to skip . and ..
(cddr (directory-files dir))

;; probably better to implement full Emacs style directory-files
(use-modules (ice-9 posix))
(define plain-files
  (let ((rx (make-regexp "^\\.")))
    (lambda (dir)
      (sort (filter (lambda (x) (eq? 'regular (stat:type (stat x))))
                    (map (lambda (x) (string-append dir "/" x))
                         (remove (lambda (x) (regexp-exec rx x))
                                 (cddr (directory-files dir)))))
            string<))))

(define (glob->regexp pat)
  (let ((len (string-length pat))
        (ls '("^"))
        (in-brace? #f))
    (do ((i 0 (1+ i)))
        ((= i len))
      (let ((char (string-ref pat i)))
        (case char
          ((#\*) (set! ls (cons "[^.]*" ls)))
          ((#\?) (set! ls (cons "[^.]" ls)))
          ((#\[) (set! ls (cons "[" ls)))
          ((#\]) (set! ls (cons "]" ls)))
          ((#\\)
           (set! i (1+ i))
           (set! ls (cons (make-string 1 (string-ref pat i)) ls))
           (set! ls (cons "\\" ls)))
          (else
           (set! ls (cons (regexp-quote (make-string 1 char)) ls))))))
    (string-concatenate (reverse (cons "$" ls)))))

(define (glob pat dir)
  (let ((rx (make-regexp (glob->regexp pat))))
    (filter (lambda (x) (regexp-exec rx x)) (directory-files dir))))

(define files (glob "*.c" "."))
(define files (glob "*.[ch]" "."))

;; Not sure if the Schwartzian Transform would really be more
;; efficient here... perhaps with a much larger directory where very
;; few files matched.
(define dirs (filter
              (lambda (x) (eq? 'directory (stat:type (stat x))))
              (map (lambda (x) (string-append dir "/" x))
                   (sort (filter (lambda (x) (string-match "^[0-9]+$" x))
                                 (directory-files dir))
                         (lambda (a b)
                           (< (string->number a) (string->number b)))))))

(define (find proc . dirs)
  (cond ((pair? dirs)
         (for-each proc (map (lambda (x) (string-append (car dirs) "/" x))
                             (directory-files (car dirs))))
         (apply find proc (cdr dirs)))))

(find (lambda (x) (format #t "~A~A\n" x
                          (if (equal? (stat:type (stat x)) 'directory)
                            "/" ""))) ".")

(define saved-size -1)
(define saved-name "")
(define (biggest file)
  (let ((stats (stat file)))
    (if (eq? (stat:type stats) 'regular)
      (let ((size (stat:size (stat file))))
        (cond ((> size saved-size)
               (set! saved-size size)
               (set! saved-name file)))))))
(apply find biggest (cdr (command-line)))
(format #t "Biggest file ~A in ~A is ~A bytes long.\n"
        saved-name (cdr (command-line)) saved-size)

#!/usr/local/bin/guile -s
!#
;; fdirs - find all directories
(define (print-dirs f)
  (if (eq? (stat:type (stat f)) 'directory)
    (write-line f)))
(apply find print-dirs (cdr (command-line)))

#!/usr/local/bin/guile -s
!#
;; rmtree - remove whole directory trees like rm -f
(define (finddepth proc . dirs)
  (cond ((pair? dirs)
         (apply finddepth proc (cdr dirs))
         (for-each proc (map (lambda (x) (string-append (car dirs) "/" x))
                             (directory-files (car dirs)))))))
(define (zap f)
  (let ((rm (if (eq? (stat:type (stat f)) 'directory) rmdir delete-file)))
    (format #t "deleting ~A\n" f)
    (catch #t
      (lambda () (rm f))
      (lambda args (format #t "couldn't delete ~A\n" f)))))
(let ((args (cdr (command-line))))
  (if (null? args)
    (error "usage: rmtree dir ..\n")
    (apply finddepth zap args)))

(for-each
 (lambda (file)
   (let ((newname (function-of file)))
     (catch #t
       (lambda () (rename-file file newname))
       (lambda args (format (current-error-port)
                            "couldn't rename ~A to ~A\n" file newname)))))
 names)

#!/usr/local/bin/guile -s
!#
;; rename - Guile's filename fixer
(use-modules (ice-9 regex)) ; not needed, but often useful here
(define args (cdr (command-line)))
(if (null? args) (error "usage: rename expr [files]\n"))
(define proc (eval-string (car args)))
(for-each
 (lambda (old)
   (let ((new (proc old)))
     (if (not (string=? old new))
       (catch #t
         (lambda () (rename-file old new))
         (lambda args (format (current-error-port)
                              "couldn't rename ~A to ~A\n" old new))))))
 (cdr args))

;; command-line examples:
;; rename '(lambda (x) (regexp-substitute/global
                        #f "\\.orig\$" x (quote pre)))' *.orig
;; rename string-downcase *
;; rename '(lambda (x) (if (string-match "^Make" x)
                           x
                           (string-downcase x)))' *
;; rename '(lambda (x) (string-append x ".bad"))' *.pl
;; rename '(lambda (x) (format #t "~a: ") (read-line))' *

(define base (basename path))
(define base (dirname path ext))
(define dir (dirname path))

(define path "/usr/lib/libc.a")
(define file (basename path))
(define dir (dirname path))

(format #t "dir is ~A, file is ~A\n" dir file)

(basename path ".a") ; libc

(use-modules (ice-9 regex))
(define (file-parse path . args)
  (let* ((ext (if (null? args) "\\..*" (car args)))
         (rx1 (string-append "^((.*)/)?(.*)?(" ext ")$"))
         (rx2 (string-append "^((.*)/)?(.*)?()$")))
    (let ((m (or (string-match rx1 path) (string-match rx2 path))))
      (list (match:substring m 2) (match:substring m 3)
            (match:substring m 4)))))

(define (extension path . args)
  (caddr (apply file-parse path args)))