suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

added a substitution for the submission directory

Browse Source 
svn: r2247
This commit is contained in:
Eli Barzilay 2006-02-15 23:11:15 +00:00
parent aacbf0c5a5
commit 0bfecf5fb5
2 changed files with 27 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
collects/handin-server/doc.txt
View File

@ -772,7 +772,8 @@ Keywords for configuring `check:':
* :extra-lines -- a list of lines to add after the student lines, all
with a ";;> " or :markup-prefix too. Defaults to a single line:
"Maximum points for this assignment: <+100>".
"Maximum points for this assignment: <+100>". (Can use
"{submission}" for the submission directory.)
* :user-error-message -- a string that is used to report an error that
occurred during evaluation of the submitted code (not during
@ -869,7 +870,7 @@ value from the submission code.
information (see above) and then substitute field names in {braces}
by the corresponding value. An error will be signaled if a field
name is missing. Also, "{username}" will always be replaced by the
username.
username and "{submission}" by the current submission directory.
This is used to process the `:student-line' value in the checker,
but it is provided for additional uses. See the above sample code

29
collects/handin-server/extra-utils.ss
View File

@ -32,6 +32,18 @@
(map car (get-preference 'extra-fields (lambda () #f) #f
(build-path server-dir "config.ss"))))
(provide submission-dir)
(define submission-dir-re
(regexp (string-append "[/\\]active[/\\]([^/\\]+)[/\\](?:[^/\\]+)"
"[/\\](?:SUCCESS-[0-9]+|ATTEMPT)[/\\]?$")))
(define (submission-dir)
(let ([m (regexp-match submission-dir-re
(path->string (current-directory)))])
(if m
(cadr m)
(error* "internal error: unexpected directory name: ~a"
(current-directory)))))
(provide user-data)
(define (user-data user)
;; the student always assumed to exist
@ -40,7 +52,8 @@
(provide user-substs)
(define (user-substs user str)
(subst str `(("username" . ,user) ,@(map cons fields (user-data user)))))
(subst str `(("username" . ,user) ("submission" . ,submission-dir)
,@(map cons fields (user-data user)))))
(define (subst str substs)
(if (list? str)
@ -50,7 +63,10 @@
(if m
(subst (string-append
(substring str 0 (caar m))
(cond [(assoc s substs) => cdr]
(cond [(assoc s substs)
=> (lambda (x)
(let ([s (cdr x)])
(if (procedure? s) (s) s)))]
[else (error 'subst "unknown substitution: ~s" s)])
(substring str (cdar m)))
substs)
@ -310,7 +326,7 @@
;; files)
(let* ([pfx-len (string-length markup-prefix)]
[line-len (- maxwidth pfx-len)]
[=s (lambda (n) (make-string n #\=))]
[=s (lambda (n) (if (<= 0 n) (make-string n #\=) ""))]
[=== (format "~a~a\n" markup-prefix (=s line-len))])
(define (sep name)
(newline)
@ -470,6 +486,9 @@
(define text-file (format "grading/text.~a" suffix))
(define (prefix-line str)
(printf "~a~a\n" markup-prefix str))
(define generic-substs `(("submission" . ,submission-dir)))
(define (prefix-line/substs str)
(prefix-line (subst str generic-substs)))
(define (write-text)
(current-run-status "creating text file")
(with-output-to-file text-file
@ -478,8 +497,8 @@
(prefix-line
(user-substs user student-line)))
users)
(for-each prefix-line extra-lines)
(for-each prefix-line
(for-each prefix-line/substs extra-lines)
(for-each prefix-line/substs
(or (thread-cell-ref added-lines) '()))
(display submission-text))
'truncate))