[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 1.5.0.12 (X11/20070604) |
Hi,
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...
Regards,
Jon
#!/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
code!"))
(check-chores))
;;; 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))
(dynamic-wind
(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)))
"/.chores.scm"))
(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)
(hash-set!
chore-table name (make-chore text next-calculator))))
(module-define! m 'interval (lambda (n) (lambda () n)))
(module-use! m (null-environment 5))
m))
;;; 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
chore-table)))
chore-table))
(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)
next-string))
(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)
(or
(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)
(in-another-process
(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"))))
(for-each
(lambda (username)
(if (zero? (primitive-fork))
(execl "/bin/su" "/bin/su" username "-c" "check-chores.scm")))
chore-users))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; 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)
- Chore reminder,
Jon Wilson <=