[plt-scheme] best servlet development approach?
On Mon, May 19, 2003, Shriram Krishnamurthi wrote:
> Don Felgar wrote:
>
...
> > Fourth and most important: don't judge web-server by the example
> > servlets. [...]
>
> This is interesting feedback. We have some significant applications
> that have been built using the server, such as a conference paper
> submission and review manager. These are probably too large to be
> provided as "examples", though. Can you think of something that is
> useful (convincing) yet accessible that would have saved you six
> months?
...
I think the attached quiz servlet fits the bill.
As I stated before, it is relatively easy to use continuations to
interrupt the production of a page, and then finish it later using the
return from the continuation, as in add.ss. PLT goes beyond this by
allowing every page to have a normal return value. This is the part I
wish I'd caught right away. My quiz servlet presents a series of five
questions, one question per page. It collects user responses with a
normal loop, rather than a global table of some sort.
The sample quiz I included is on the English system of weights and
measures, which means that it is very hard.
Probably the data file should not be in the servlets directory, but I
didn't know a better place. To avoid any configuration, copy both
attached files to default-web-root/servlets/examples/.
--Don
-------------- next part --------------
'("This is a quiz on English weights and measures. Good luck!"
(
("How many imperial gallons in a firkin?"
("4" "5" "8" "9")
3
"The firkin is a liquor volume, equalling nine imperial gallons.
An imperial gallon is equals 1.20095 gallons, by the way.
Alternatively te firkin is one-fourth of a barrel.")
("How many tablespoons in a cup?"
("4" "6" "8" "16")
3
"Recipes in the US most often use tablespoons, teaspoons, and
cups.")
("How many teacups in a cup?"
("1/2" "3/4" "1" "1.5")
1
"")
("A magnum is how many gallons?"
("0.5" "1" "1.5" "2")
3
"Wine bottles, in order of size, are: bottle, magnum, jeroboam,
rehoboam, methuselah, salmanazar, balthazar, and nebuchadnezzar, which
holds 5 gallons.")
("A kilderkin is how many gallons?"
("5" "18" "20" "25")
1
"")
("How many magnums in a rehoboam?"
("3" "4" "5" "10")
0
"Wine bottles, in order of size, are: bottle, magnum, jeroboam,
rehoboam, methuselah, salmanazar, balthazar, and nebuchadnezzar, which
holds 5 gallons.")
("How many scruples in a Troy ounce?"
("8" "24" "48" "196")
1
"20 grains in a scruple, 24 scruples in a Troy ounce. The scruple is an apothecary measurement.")
("How many cups are in a quart?"
("2" "2.5" "3" "4")
3
"Two cups in a pint, two pints in a quart, four quarts in a gallon.")
("How many cups in a pint?"
("2" "2.5" "3" "4")
0
"Two cups in a pint, two pints in a quart, four quarts in a gallon.")
("How many pecks in a bushel?"
("4" "5" "8" "10")
0
"Note: The Winchester bushel, formerly used in England,
contained 2150.42 cubic inches, being the volume of a cylinder 181/2
inches in internal diameter and eight inches in depth. The standard
bushel measures, prepared by the United States Government and
distributed to the States, hold each 77.6274 pounds of distilled
water, at 39.8[deg] Fahr. and 30 inches atmospheric pressure, being
the equivalent of the Winchester bushel. The imperial bushel now in
use in England is larger than the Winchester bushel, containing 2218.2
cubic inches, or 80 pounds of water at 62[deg] Fahr.")
("A jigger is:"
("1/3 of a tablespoon" "2 tablespoons" "3 tablespoons" "4 tablespoons")
2
"A jigger is the amount a shot glass contains. The pony is
another drink volume measure, equalling half a jigger. There's also
the English beer gallon.")
("How many grains in a pound:"
("400" "500" "512" "7000")
3
"According to Webster's: \"The unit of the English system of
weights; -- so called because considered equal to the average of
grains taken from the middle of the ears of wheat. 7,000 grains
constitute the pound avoirdupois, and 5,760 grains the pound troy. A
grain is equal to .0648 gram.\"")
("How many tablespoons in a fluid ounce:"
("0.5" "1" "2" "4")
2
"Recipes in the US most often use tablespoons, teaspoons, and
cups.")
("At standard temperature and pressure, one fluid ounce of water
weighs:"
("1.04158 ounces avoirdupois" "1 ounce avoirdupois" "1 troy ounce" "none of the above")
0
"Good question.")
("A person who weighs 10 stone weighs how many pounds:"
("90" "100" "120" "140")
3
"One stone for human weight is 14 pounds. Note: The stone of
butchers' meat or fish is reckoned at 8 lbs.; of cheese, 16 lbs.; of
hemp, 32 lbs.; of glass, 5 lbs. (Webster's). Time to go metric.")
("How many cord foot are in a cord?"
("2" "4" "8" "9")
2
"According to Webster's, a cord is \"A solid measure,
equivalent to 128 cubic feet; a pile of wood, or other coarse
material, eight feet long, four feet high, and four feet broad; --
originally measured with a cord or line.\"")
("A teacup is how many fluid ounces?"
("4" "5" "6" "8")
0
"")
("A mile is how many feet?"
("4,000" "5,120" "5,280" "6,000")
2
"5,280 feet, 1,760 yards.")
("How many acres in a square mile?"
("320" "400" "500" "640")
3
"")
("How many fluid ounces in a gallon?"
("32" "64" "128" "256")
2
"")
("In the US we refer to oil quantities in barrels. How many
gallons in an oil barrel (also known as petroleum barrel)?"
("42" "120" "128" "150")
0
"Alternatively, one oil barrel equals 896 tea cups.")
("How many teaspoons in a tablespoon?"
("2" "2.5" "3" "4")
2
"")
("One fluid dram equals how many fluid ounces:"
("0.1" "0.125" "0.5" "0.75")
1
"As with the ounce, there is a fluid dram and a weight dram. A
weight dram is 0.0625 of an ounce. What's worse, there is a Troy
ounce as well as an avoirdupois ounce.")
("One Troy carat is equal to:"
("3.2 grains Troy" "5 grains Troy" "7.5 grains Troy" "10 grains Troy")
0
"\"Note: The carat equals three and one fifth grains Troy, and is
divided into four grains, sometimes called carat grains. Diamonds and
other precious stones are estimated by carats and fractions of carats,
and pearls, usually, by carat grains. --Tiffany\" (As quoted from
Webster's). Additionally, carat can mean 24th part; 22 carat gold is
22/24's gold.")
("How many Troy ounces are in a pound?"
("8" "10" "12" "16")
2
"According to Webster's: \"Troy weight, the weight which gold and
silver, jewels, and the like, are weighed. It was so named from
Troyes, in France, where it was first adopted in Europe. The troy
ounce is supposed to have been brought from Cairo during the
crusades. In this weight the pound is divided into 12 ounces, the
ounce into 20 pennyweights, and the pennyweight into 24 grains; hence,
the troy ounce contains 480 grains, and the troy pound contains 5760
grains. The avoirdupois pound contains 7000 troy grains; so that 175
pounds troy equal 144 pounds avoirdupois, or 1 pound troy = 0.82286 of
a pound avoirdupois, and 1 ounce troy = 117/175 or 1.09714 ounce
avoirdupois. Troy weight when divided, the pound into 12 ounces, the
ounce into 8 drams, the dram into 3 scruples, and the scruple into 20
grains, is called apothecaries' weight, used in weighing medicines,
etc. In the standard weights of the United States, the troy ounce is
divided decimally down to the 1/10000 part.\"")
))
-------------- next part --------------
;;
;; Multiple-choice quiz PLT servlet sample.
;;
;;
;; Question sexp interface:
;; Questions = (listof intro-text (listof question))
;; intro-text = string explaining what test is about
;; question = (question-text choices correct-answer explanation)
;; question-text = string, the actual question
;; choices = (listof string), possible answers to the question
;; correct-answer = integer, index into choices
;;
;; Configuration
(define *base-url* "/servlets/examples/quiz.ss")
(define *data-file* "./english-measure-questions.ss")
(define *questions-per-quiz* 5)
(require (lib "unitsig.ss")
(lib "servlet-sig.ss" "web-server")
(lib "servlet-helpers.ss" "web-server")
(lib "date.ss")
(lib "pretty.ss")
(lib "list.ss"))
(unit/sig () (import servlet^)
;; Accessors into question sexp's
(define question-text car)
(define question-choices cadr)
(define question-answer caddr)
(define question-explanation cadddr)
(define quiz (load *data-file*))
(define quiz-intro (car quiz))
(define all-questions (cadr quiz))
;; Return the first value for key in bindings, if it at least one
;; exists, otherwise #f.
(define (binding-value key bindings)
(let* ((key (if (symbol? key) key (string->symbol key)))
(v (extract-bindings key bindings)))
(if (pair? v)
(car v)
#f)))
;; Create XML for a page posing one question
(define (ask-question question-sexp question-number n-questions)
(lambda (k-url)
(let ((answer-num -1))
`(html
(head
(title "Quiz Servlet")
(body
(p ,(format "Question ~A of ~A" (add1 question-number)
n-questions))
(p ,(question-text question-sexp))
(form ((method "post") (action ,k-url))
,@(map (lambda (choice)
(set! answer-num (add1 answer-num))
`(p
,(choice-descriptor answer-num) ". "
(input ((type "radio")
(name "answer")
(value ,(number->string
answer-num))))
,choice))
(cadr question-sexp))
(input ((type "hidden") (name "action")
(value "question")))
(input ((type "submit")
(value "Next"))))))))))
;; ((listof question-sexp) size) -> (listof question-sexp)
(define (random-question-set questions subset-size)
(define (numbers-list start end)
(if (< start end)
(cons start (numbers-list (add1 start) end))
'()))
(define (choose-question-numbers question-numbers chosen-numbers size)
(if (or (= (length chosen-numbers) size) (null? question-numbers))
chosen-numbers
(let* ((rnd (random (length question-numbers)))
(question-num (list-ref question-numbers rnd)))
(choose-question-numbers
(filter
(lambda (n)
(not (eq? question-num n)))
question-numbers)
(cons question-num chosen-numbers) size))))
(let ((question-numbers
(choose-question-numbers
(numbers-list 0 (min (length questions) subset-size))
'() subset-size)))
(map (lambda (n)
(list-ref questions n))
question-numbers)))
;; Map 0 to "A", 1 to "B", etc
(define (choice-descriptor number)
(string (integer->char (+ 65 number))))
(define (begin-quiz k-url)
`(html
(head
(title "Quiz Servlet"))
(body
(p ,quiz-intro)
(form ((method "post") (action ,k-url))
(input ((type "hidden") (name "action") (value "question")))
(input ((type "submit")
(value "Begin Quiz")))))))
;; Compare list of questions to answers.
;; ((listof question-sexp) (listof integer|false)) ->
;; (listof integer)
(define (score-quiz questions answers)
(let ((skipped 0)
(correct 0)
(wrong 0))
(map (lambda (question answer)
(let ((correct-answer (question-answer question)))
(cond
((not answer)
(set! skipped (add1 skipped)))
((= answer correct-answer)
(set! correct (add1 correct)))
(else
(set! wrong (add1 wrong))))))
questions answers)
;; (display "map1 end\n")
(list correct skipped wrong)))
;; Create XML showing quiz results.
(define (end-quiz questions answers)
(lambda (k-url)
(let* ((score (score-quiz questions answers))
(correct (car score))
(skipped (cadr score))
(wrong (caddr score))
(xml
`(html
(head
(title "Quiz Servlet"))
(body
(p ,(format "Your score: ~A/~A"
correct
(+ correct wrong skipped)))
(p ,(format "Correct: ~A" correct))
(p ,(format "Skipped: ~A" skipped))
(p ,(format "Wrong: ~A" wrong))
(table ((border "5"))
(tr (td "Question") (td "Correct Answer")
(td "Your Answer") (td "Explanation"))
,@(map
(lambda (q a)
`(tr
(td ,(question-text q))
(td ,(format "~A. ~A"
(choice-descriptor
(question-answer q))
(list-ref (question-choices q)
(question-answer q))))
(td ,(if a
(format "~A. ~A" (choice-descriptor a)
(list-ref
(question-choices q) a))
"Skipped"))
(td ,(question-explanation q))))
questions answers))
(form ((method "get")
(action ,*base-url*))
(input ((type "submit")
(value "New Quiz"))))))))
;; (pretty-print xml)
xml)))
;; Entry point into servlet.
;;
(if (> *questions-per-quiz* (length all-questions))
(begin
(display (format "~A ~A ~A ~A\n"
"Configuration error. *questions-per-quiz*:"
*questions-per-quiz*
"for a question list of size"
(length all-questions)))
(set! *questions-per-quiz* (length all-questions))))
(let* ((questions (random-question-set all-questions
*questions-per-quiz*))
(answers (make-vector (length questions) #f)))
(let loop ((bindings '())
(question-number #f))
(let ((action (binding-value 'action bindings)))
(cond
((not action)
(loop (request-bindings (send/suspend begin-quiz)) 0))
((string=? action "question")
(if (>= question-number (length questions))
(request-bindings
(send/suspend (end-quiz questions (vector->list answers))))
(let* ((bindings
(request-bindings
(send/suspend (ask-question
(list-ref questions question-number)
question-number
*questions-per-quiz*))))
(answer (binding-value 'answer bindings)))
(vector-set! answers question-number
(if answer (string->number answer) answer))
(loop
bindings
(add1 question-number)))))))))
)
![[logo]](/logo.png){kind=logo}