cron-walk.scm

[thi]

#!/bin/sh
# -*- scheme -*-
exec guile -s $0 "$@"
!#

;;; ID: cron-walk.scm,v 1.4 2001/01/03 16:39:19 ttn Exp
;;;
;;; Copyright (C) 2001 Thien-Thi Nguyen
;;; This program is released under GNU General Public License, Version 2.

;;; Commentary:

;; Usage: cron-walk WHEN DIR [DIR...]
;; Find executable .cron files under DIR(s) and call them w/ single arg WHEN,
;; first changing to that directory.  Output is collected and displayed only
;; on failure.
;;
;; This program calls locate(1).

;;; Code:

(use-modules (ttn echo))

(or (< 2 (length (command-line)))
    (begin
      (echo "usage:" (car (command-line)) "when dir [dir...]")
      (error "bad usage")))

(define job-type (cadr (command-line)))
(define root-dirs (cddr (command-line)))

(use-modules (ttn shell-command-to-string) (ttn dirutils))

(define (sys! . args)
  (system (with-output-to-string (lambda () (apply echo args)))))

(define log-file (string-append "/tmp/cron-walk.log."
                                (number->string (getpid))))

(define (execute-dot-cron-in-dir dir)
  (save-cwd
   (chdir dir)
   (or (= 0 (sys! "./.cron" job-type ">" log-file "2>&1"))
       (let ((subj (string-append "-s" (getcwd))))
         (sys! "mail" subj "ttn" "<" log-file)))))

(define (cron-job-dirs-under root)
  (map (lambda (file)
         (substring file 0 (- (string-length file) 6)))
       (shell-command->list (string-append "locate '" root "*/.cron'"))))

(define (cron-walk dirs)
  (for-each (lambda (dir)
              (for-each execute-dot-cron-in-dir (cron-job-dirs-under dir)))
            dirs))

;; do it!
(cron-walk root-dirs)
(and (file-exists? log-file)
     (delete-file log-file))

;;; cron-walk.scm,v1.4 ends here