#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

;(kdb t)

(setq arglist
  (getopts
    "mksdir  source-dir destination-dirs...
creates destination dirs as shadows of source dir, by symbolic links
It creates directories and in each of them, a SRC symbolic link points to the 
shadowed dir, and files in this dir are accessed via this SRC link.
All SRC  are relative to the topmost one, so only the top one needs to be 
changed if source dir is moved
"
    ("-v" 0 Verbose "prints directory names as they are created")
    ("-vv" 0 Verbose2 "prints directory and file names")
))

(if (< (length arglist) 2)
  (fatal-error 1
      "mksdir: must have at least two arguments. type mksdir -? for help"
))

(setq page-width 80)
(if Verbose2 (setq Verbose t))
(setq Absolute t)
(setq source-dir (getn arglist 0))
(setq dest-dir-list (subseq arglist 1))
(setq curdir-orig *current-directory*)

;; expand the source dir path if needed
(setq source-dir (expand-filename source-dir))
;; trim optional / at the end
(with (res (match "^(.*)[/]$" source-dir 1))
  (if res (setq source-dir res))
)

(setq autodir-exists (if (file-stats "/auto") t ()))

(if
  (not (file-type source-dir))
  (fatal-error 1 "mksdir: source-dir %0 not found" source-dir)

  (/= 'directory (file-type source-dir))
  (fatal-error 1 "mksdir: source-dir %0 not a directory but a %1"
    source-dir (file-type source-dir))
)

;; no we strip by hand automont prefixes added by the local automounter system, 
;; which can be of the form:
;; /auto/u/hostname/N or /auto/hostname/u/hostname/N for a local disk of /N
;; and we prepend /u/hostname/ to local disks of type /N, N being a number
;;
;; also /0/x re tranformed to /u/hostname/0/x

(if (and (/= #\/ (getn source-dir 0))	;relative path
    Absolute
  )
  (progn
    (setq old-source-dir source-dir)
    (setq source-dir
      (with (*current-directory* source-dir) *current-directory*))
    (if autodir-exists
      (if
	(match "^[/]auto[/]u[/]" source-dir)
	(setq source-dir (match "^[/]auto([/].*)$" source-dir 1))
	
	(match "^[/]auto[/][a-zA-Z0-9_-]+[/]u[/]" source-dir)
	(setq source-dir (match "^[/]auto[/][a-zA-Z0-9_-]+([/].*)$"
	    source-dir 1))
	
	(match "^[/][0-9][/]?" source-dir)
	(setq source-dir (+ "/u/" *hostname* source-dir))
    ) )
    
    (print-format *standard-error*
      "mksdir: using: %1\n   instead of: %0\n"
      old-source-dir source-dir)
))

(defun main ()
  (dolist (dest-dir dest-dir-list)
    ;; trim optional / at the end
    (with (res (match "^(.*)[/]$" dest-dir 1))
      (if res (setq dest-dir res))
    )
    (setq *current-directory* curdir-orig)
    (make-shadow-dir source-dir dest-dir)
))

(defmacrod mkdir (name)
  `(if (/= 0 (wait (system (list "mkdir" ,name))))
    (fatal-error 1 "mksdir: cannot create directory %0" ,name)
))

;; the main function
(defun make-shadow-dir (source-dir dest-dir)
  (setq level "")
  (mkdir dest-dir)
  (wait (system (list "ln" "-s" source-dir (+ dest-dir "/SRC"))))
  (make-shadow-subdir dest-dir (get (file-stats source-dir) 'nlink 10000000)
   "SRC")
)

;; in a newly created dest dir with an already existing SRC link, make all
;; the symlinks and recurse

(defun make-shadow-subdir (dest-dir subdir-number dot-dot &aux
    (*current-directory* dest-dir)
    (flist (directory "SRC"))
    fname
    (level (+ level "    "))
    (files-to-link (list))
  )
  (if Verbose (progn
      (print-format *standard-error*
	(+  (subseq level 4) "*** %0:\n") dest-dir)
      (if (and Verbose2 flist) (print-list-of-files level flist))
  ))
  
  (if (> subdir-number 2) 
    (dolist (name flist)
      (setq fname (+ "SRC/" name))
      (if (and (> subdir-number 2)	;still need to test?
	  (= 'directory (file-type fname)))
	(progn
	  (incf subdir-number -1)
	  (create-subdir name fname (getn file-type:stats 'nlink)
	    (+ "../" dot-dot "/" name)
	  )
	)
	(progn
	  (put files-to-link -1 (+ fname))
	)
      )
    )
    (dolist (name flist)(put files-to-link -1 (+ "SRC/" name)))
  )
  (if files-to-link
    (wait (system `("ln" "-s" ,@files-to-link ".") :nohup t))
  )
)

;; recursively called to create dir

(defun create-subdir (name fname subdir-number dot-dot)
  (mkdir name)
  (wait (system (list "ln" "-s" dot-dot (+ name "/SRC"))))
  (make-shadow-subdir name subdir-number dot-dot)
)

;; when tracing, pretty-print of an indented group of words

(defun print-list-of-files (level flist &aux
    (line-length (length level))
    non-start
  )
  (sort flist compare)
  (write level *standard-error*)
  (dolist (f flist)
    (if (> (+ line-length (length f) 1) page-width)
      (progn (write-char 10 *standard-error*)
	(setq line-length (length level))
	(setq non-start ())
	(write level *standard-error*)
    ))
    (if non-start (write-char #\space *standard-error*)
      (setq non-start t)
    )
    (write f *standard-error*)
    (incf line-length (+ 1 (length f)))
  )
  (write-char 10 *standard-error*)
)

(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***
