[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
cron-walk.scm
From: |
thi |
Subject: |
cron-walk.scm |
Date: |
Fri, 5 Jan 2001 18:42:22 -0800 |
#!/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
[Prev in Thread] |
Current Thread |
[Next in Thread] |