[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Chore reminder

From: Jon Wilson
Subject: Chore reminder
Date: Sat, 07 Jul 2007 11:01:42 -0400
User-agent: Thunderbird (X11/20070604)

I've written a little bitty (~100 loc) program which pops up a reminder when chores need redoing. They don't start counting down to timeout again until you indicate (by clicking on the "Completed" button) that you have finished them. If anybody would have a use for it, they are welcome to use it, but mostly I'm looking for comments. If you think there is a better way to do something that I've done, I'm very much interested in hearing about it. I've decided that I've still got one foot in java/c/c++ styles, and that the best way to develop a sense of what is "best" in lispy languages is to write some code that I think is good and ask for comments.

To use, put the file check-chores.scm somewhere in the system $PATH, and make it executable. Then run the file chore from an [ana]cron job (on debian based systems, put it in /etc/cron.daily). Make a chore group and put any users who have chores into it. Make a directory /var/spool/chore owned by root.chore, with permissions drwxrwxr-T. Finally, put example.chores.scm into ~/.chores.scm, and modify it to your heart's content.

You can run check-chores.scm yourself, or wait for the cron job to run chore. Running check-chores.scm yourself will just check the chores for the user you run it as, the cron job simply runs check-chores.scm for all users in the chore group.

It won't be any use unless there is an X display on :0 at the time the cron job runs. I've toyed with the idea of using email instead of gmessage, but decided that for right now, gmessage was good enough. Should work just fine on a single user system. Oh yeah, and if you don't have gxmessage installed, then just change "gmessage" to "xmessage" in check-chores.scm. Unless you don't have xmessage either...

#!/usr/bin/guile \
-e main -s
(use-modules (ice-9 r5rs) (ice-9 optargs) ((srfi srfi-19) :renamer 
(symbol-prefix-proc 'tm:)))

(define (main args)
  (if (zero? (getuid)) (error "Do not run this as root!  We execute untrusted 

;;; Some utility functions to manipulate dates
(define (local-julian-day jdn)
  (+ jdn (/ (tm:date-zone-offset (tm:current-date)) (* 24 60 60))))

(define (universal-julian-day local-jdn)
  (- local-jdn (/ (tm:date-zone-offset (tm:current-date)) (* 24 60 60))))

(define (julian-local-midnight jdn)
  (universal-julian-day (- (floor (+ (local-julian-day jdn) (/ 2))) (/ 2))))

;;; Some utlity functions involving processes and file loading
(define (process-exists? PID)
  (access? (string-append "/proc/" (number->string PID)) F_OK))

(define (in-another-process thunk)
  (if (zero? (primitive-fork))
        (begin (thunk) (exit))))

(define (load-with-env filename env)
  (let ((real-current-module #f))
          (lambda () (set! real-current-module (current-module)) 
(set-current-module env))
          (lambda () (load filename))
          (lambda () (set-current-module real-current-module)))))

;;; Make the chore record type and functions to use it
(define chore-type (make-record-type "chore-type" '(text when-next)))
(define make-chore (record-constructor chore-type '(text when-next)))
(define chore-text (record-accessor chore-type 'text))
(define chore-when-next (record-accessor chore-type 'when-next))

;;; a couple of defaults, and a convenience function for making filenames from 
chore names
(define (*default-chore-file*) (string-append (passwd:dir (getpwuid (geteuid))) 
(define *spool-dir* "/var/spool/chore")
(define (spool-filename name)
  (string-append *spool-dir* "/" (passwd:name (getpwuid (geteuid))) "." name))

(define (chore-file-module chore-table)
  (let ((m (make-module)))
        (module-define! m 'chore (lambda (name text next-calculator)
chore-table name (make-chore text next-calculator))))
        (module-define! m 'interval (lambda (n) (lambda () n)))
        (module-use! m (null-environment 5))

;;; Read in the chore list
(define* (get-chore-table #:optional (filename (*default-chore-file*)))
                 (let ((chore-table (make-hash-table)))
                   (if (access? filename R_OK)
                         (load-with-env filename (chore-file-module 

(define (update-chore name chore)
  (let* ((spool-file (open-output-file (spool-filename name)))
                 (next (+ (julian-local-midnight (tm:current-julian-day))
                                  ((chore-when-next chore))))
                 (next-string (tm:date->string (tm:julian-day->date next))))
        (write (list name next next-string) spool-file)
        (close spool-file)

(define (lock-chore name)
  (let ((spool-file (open-output-file (spool-filename name))))
        (write (list name 'LOCKED (getpid)) spool-file)
        (close spool-file)))

(define (chore-expired? name)
  (or (not (access? (spool-filename name) R_OK))
        (let* ((spool-file (open-input-file (spool-filename name)))
                   (data (read spool-file)))
          (close spool-file)
                (not (list? data)) ; We expect only a list in the spool file
                (not (= 3 (length data))) ; of length 3
                (if (eq? 'LOCKED (cadr data))
                  (not (process-exists? (caddr data))) ; We only consider the 
chore to be locked if the locking process is still running.
                  (> (julian-local-midnight (tm:current-julian-day)) (cadr 
data))))))) ; Finally, check to see if today is later than the date in the 
spool file.

(define (remind-chore name chore)
  (setenv "DISPLAY" ":0")
  (system* "gmessage"
                   "-buttons" "Completed:0"
                   "-name" (string-append "chore " name)
                   (chore-text chore)))

(define (check-chore name chore) ;; Check one single chore
  (if (chore-expired? name)
          (lambda ()
                (close (current-output-port))
                (close (current-error-port))
                (lock-chore name)
                (if (zero? (remind-chore name chore))
                  (update-chore name chore))))))

(define (check-chores) ;; Check all the chores in the chore table
  (hash-for-each check-chore (get-chore-table)))
#!/usr/bin/guile -s
;;; This file gets a list of all the users in the chore group, and then, for 
each user, makes a new process to check each one of that user's tasks, as that 
user (su).
(let ((chore-users (group:mem (getgrnam "chore"))))
  (lambda (username)
   (if (zero? (primitive-fork))
        (execl "/bin/su" "/bin/su" username "-c" "check-chores.scm")))
;;; Put this file in your home directory under the name ".chores.scm"

(chore "bath-up" "Clean the upstairs bathroom" #:interval 7)
(chore "bath-down" "Clean the downstairs bathroom" #:interval 14)
(chore "kitchen-sweep" "Sweep the kitchen floor" #:interval 3)
(chore "kitchen-mop" "Mop the kitchen floor" #:interval 14)
(chore "sheets-up" "Change the sheets in the upstairs bedroom" #:interval 7)

reply via email to

[Prev in Thread] Current Thread [Next in Thread]