#!/usr/local/bin/siod -v0,-m3 -*-mode:lisp-*-

;; name:    homes-scm.cgi
;; purpose: illustrate chunks of html cgi application
;; author:  george j. carrette
;; $Id: homes-scm.smd,v 1.3 1996/12/06 17:21:29 gjc Exp $

(define (get-homes)
  (let ((item nil)
	(homes nil)
	(gecos nil))
    (while (set! item (getpwent))
      (if (not (access-problem? (string-append (cdr (assq 'dir item))
					       "/public_html")
				"r"))
	  (begin (set! gecos (cdr (assq 'gecos item)))
		 (set! homes (cons (list (cdr (assq 'name item))
					 (substring
					  gecos
					  0
					  (string-search "," gecos)))
				   homes)))))
    (qsort homes string-lessp car)))

(define (main)
  (let ((h (cons-array 10))
	(l (get-homes))
	(form (cond ((or (access-problem? "homes.html-bin" 'r)
			 (access-problem? "homes.html" 'r)
			 (> (apply max (file-times "homes.html"))
			    (apply max (file-times "homes.html-bin"))))
		     (require'chtml.scm)
		     (load-chtml "homes.html"))
		    ('else
		     (set! write-chtml swrite)
		     (car (load "homes.html-bin" t))))))
    (hset h 'usercount (length l))
    (hset h 'username (mapcar car l))
    (hset h 'fullname (mapcar cadr l))
    (hset h 'querytime (car (runtime)))
    (hset h 'sitename (getenv "SERVER_NAME"))
    (writes nil "Content-type: text/html\n\n")
    (write-chtml nil h form)))