;;; Scheme program to extract a directory entry from a faculty database, ;;; based upon first and last names ;;; Program assumes the directory is located in ;;; /home/walker/public_html/cgi-bin/math-cs.faculty.98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Procedures for searching for the name in the file (define directory-name "/home/walker/public_html/cgi-bin/math-cs.faculty.98") (define readline (lambda (source) (let loop ((line-list '()) (char (read-char source))) (if (or (eof-object? char) (char=? #\newline char)) (list->string (reverse line-list)) (loop (cons char line-list) (read-char source)))))) (define find-first ;;; return first name of the given name; ;;; the first name is assumed to be all characters up to the first space (lambda (name) (let loop ((position 0)) (if (equal? #\space (string-ref name position)) (substring name 0 position) (loop (+ position 1)))))) (define find-last ;;; return last name of the given name; ;;; the last name is assumed to be all characters after the last space (lambda (name) (let loop ((position (- (string-length name) 1))) (if (equal? #\space (string-ref name position)) (substring name (+ position 1) (string-length name)) (loop (- position 1)))))) (define writeln (lambda args (for-each display args) (newline) )) (define pretty-print (lambda (name title e-mail telephone office) (writeln "

") (writeln "Name: " name) (writeln "
") (writeln "Title: " title) (writeln "
") (writeln "e-mail address: " e-mail) (writeln "
") (writeln "Office Telephone: " telephone) (writeln "
") (writeln "Office Location: " office))) (define read-directory (lambda (first last) (let ((source (open-input-file directory-name))) (readline source) (readline source) (let loop ((next-char (peek-char source))) (if (eof-object? next-char) (begin ;; directory searched and no match found (close-input-port source) (writeln first " " last " not found in directory.")) (let* ((name (readline source)) (first-name (find-first name)) (last-name (find-last name)) (title (readline source)) (e-mail (readline source)) (telephone (readline source)) (office (readline source)) (blankline (readline source))) (if (and (string-ci=? first first-name) (string-ci=? last last-name)) (begin ;; name found: print and quit (pretty-print name title e-mail telephone office) (close-input-port source)) (loop (peek-char source))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Procedures for processing a query string from a cgi script ;;; The following package was written by John David Stone (load "/home/walker/public_html/cgi-bin/cgi-utilities.scm") ;;; In particular, procedure extract-attributes takes a query string (from ;;; a cgi environment) as argument and returns an association list of ;;; attribute-value pairs. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; Steps to produce html output to respond to a web-based name query ;;; Write headers (writeln "Content-type: text/html") (newline) (writeln "") (writeln "") (newline) (writeln "") (writeln "Directory Search") (writeln "") (writeln "") (writeln "") (writeln "

Mathematics/Computer Science Directory Search

") (newline) (writeln "

") (newline) ;;; identify desired name and search in directory (let* ((data (extract-attributes (getenv "QUERY_STRING"))) (first-name (cdr (assoc "firstname" data))) (last-name (cdr (assoc "lastname" data)))) (writeln "Results of your search for " first-name " " last-name ":") (newline) (writeln "

") (newline) (read-directory first-name last-name) ) ;;; Write final formatting tags (writeln "") (writeln "") (newline) (exit)