#!/bin/sh
exec ${GUILE-guile} -e '(ttn-do refresh-hardlinks)' -s $0 "$@" # -*- scheme -*-
!#
;;; refresh-hardlinks

;; Copyright (C) 2004, 2005, 2007, 2009, 2010, 2011 Thien-Thi Nguyen
;;
;; This file is part of ttn-do, released under the terms of the
;; GNU General Public License as published by the Free Software
;; Foundation; either version 3, or (at your option) any later
;; version.  There is NO WARRANTY.  See file COPYING for details.

;;; Commentary:

;; Usage: refresh-hardlinks [--quiet] DESTDIR
;;
;; Find files in DESTDIR matching regexp "[A-Z][A-Za-z0-9]*" and refresh them
;; by replacing them with hardlinks to same-named files in the current working
;; directory.  If cwd file is a symlink, chase it to find a non-symlink file.
;;
;; Additionally for every FILE found, if there exists FILE.txt, refresh that
;; as well.  Files in DESTDIR that do not exist in the cwd are silently left
;; alone.  Option ‘--quiet’ (‘-q’ for short) suppresses output.

;;; Code:

(define-module (ttn-do refresh-hardlinks)
  #:export (main)
  #:use-module ((ttn-do zzz banalities) #:select (check-hv
                                                  qop<-args))
  #:use-module ((ttn-do zzz personally) #:select (FE))
  #:use-module ((ttn-do zzz filesystem) #:select (directory-vicinity
                                                  dir-exists?
                                                  expand-file-name
                                                  filtered-files)))

(define (chase filename)
  (case (stat:type (lstat filename))
    ((symlink) (chase (readlink filename)))
    (else filename)))

(define (hardlink-proc destdir quiet?)
  (or (dir-exists? destdir)
      (error "bad DESTDIR:" destdir))
  (let ((under-destdir (directory-vicinity destdir))
        (under-cwd (directory-vicinity (getcwd)))
        (spew (if quiet?
                  (lambda (name) #t)
                  (lambda (name) (display name) (newline)))))
    ;; rv
    (lambda (file)
      (let ((src (under-cwd file))
            (dest (under-destdir file)))
        (cond ((file-exists? src)
               (delete-file dest)
               (link (chase src) dest)
               (spew dest)
               (let ((txt (string-append dest ".txt")))
                 (cond ((file-exists? txt)
                        (delete-file txt)
                        (link (chase src) txt)
                        (spew txt))))))))))

(define (main/qop qop)
  (let* ((rx (make-regexp "^[A-Z][-A-Za-z0-9]*"))
         (destdir (expand-file-name
                   (or (false-if-exception (car (qop '())))
                       (error "no DESTDIR specified"))))
         (hlink (hardlink-proc destdir (qop 'quiet))))
    (FE (filtered-files (lambda (name)
                          (and (regexp-exec rx name) name))
                        destdir)
        hlink)))

(define (main args)
  (check-hv args '((package . "ttn-do")
                   ;; 1.0 -- plain
                   ;; 1.1 -- cwd symlinks chased
                   ;; 1.2 -- hypen allowed in filenames
                   (version . "1.2")
                   (help . commentary)))
  (main/qop
   (qop<-args
    args '((quiet (single-char #\q))))))

;;; refresh-hardlinks ends here