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

Added rudimentary support for multi-file submissions.

Browse Source 
svn: r2210
This commit is contained in:
Eli Barzilay 2006-02-13 17:39:02 +00:00
parent 797b023216
commit af6b88d062
3 changed files with 207 additions and 57 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -417,7 +417,9 @@ sub-directories:
from the status interface. from the status interface.
The checker should return a string, such as "handin.scm", to use The checker should return a string, such as "handin.scm", to use
in naming the submission file. in naming the submission file, or #f to indicate that he file
should be deleted (eg, when the checker alrady created the
submission file(s) in a different place).
Alternatively, the module can bind `checker' to a list of three Alternatively, the module can bind `checker' to a list of three
procedures: a pre-checker, a checker, and a post-checker. All procedures: a pre-checker, a checker, and a post-checker. All
@ -739,7 +741,15 @@ Keywords for configuring `check:':
* :output -- the name of the original handin file (unrelated to the * :output -- the name of the original handin file (unrelated to the
text-converted files). Defaults to "hw.scm". (The suffix changes text-converted files). Defaults to "hw.scm". (The suffix changes
the defaults of the following two entries.) the defaults of the following two entries.) Can be #f for removing
the original file after processing.
* :multi-file -- by default, this is set to #f, which means that only
DrScheme is used to send submissions as usual. See "Multiple-file
submissions" below for setting up multi-file submissions.
* :names-checker -- used for multi-file submissions; see
"Multiple-file submissions" below for details.
* :markup-prefix -- used as the prefix for :student-lines and * :markup-prefix -- used as the prefix for :student-lines and
:extra-lines below. The default is ";;> " or "//> ", depending on :extra-lines below. The default is ";;> " or "//> ", depending on
@ -927,3 +937,45 @@ value from the submission code.
error with source information if some code is left uncovered. The error with source information if some code is left uncovered. The
collected information includes only execution coverage by submission collected information includes only execution coverage by submission
code, excluding additional checker tests. code, excluding additional checker tests.
*** Multiple-file submissions
By default, the system is set up for submissions of single a single
file, straight fom DrScheme using the handin-client. There is some
support for multi-file submissions in "extra-utils.ss" and in the
handin-client -- it is possible to submit multiple files, and have the
system generate a single file that is the concatenation of all
submission files (used only with text files). To set up multi-file
submissions, do the following:
* Add a `:multi-file' keyword in `check:', and as a value, use the
suffix that should be used for the single concatenated output file.
* You can also add a `:names-checker' keyword -- the value can be a
regexp that all submitted files must follow (eg, ".*[.]scm$").
Alternatively, it can be a 1-argument procedure that will receive
the (sorted) list of submitted files and can throw an error if some
files are missing or some files are forbidden.
* In the "info.ss" file of the handin-client you need to set
`enable-multifile-handin' to #t, and adjust `selection-default' to
patterns that are common to your course. (It can be a single
pattern, or a list of them.)
On the server side, each submission is saved in a file called "raw",
which contains all submitted files. In the "grading" directory, you
will get a "text.<sfx>" file ("<sfx>" is the suffix that is used as a
value for `:multi-file') that contains all submitted files with clear
separators. On the client side, students will have an additional
file-menu entry for submitting multiple files, which pops up a dialog
that can be used to submit multiple files. In this dialog, students
choose their working directory, and the `selection-default' entry from
the "handin-client/info.ss" file specifies a few patterns that can be
used to automatically select files.
The dialog provides all handin-related functionality that is available
in DrScheme. For further convenience, it can be used as a standalone
application: in the account management dialog, the "Un/Install" tab
has a button that will ask for a directory where it will create an
executable for the multi-file submission utility -- the resulting
executable can be used outside of DrScheme.

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

@ -67,9 +67,10 @@
(let ([line (bytes->string/utf-8 line)]) (let ([line (bytes->string/utf-8 line)])
(unless (or (< (string-length line) len) (unless (or (< (string-length line) len)
(< (string-width line) len)) (< (string-width line) len))
(error* "~a \"~a\" is longer than ~a characters" (error* "~a \"~a\" in ~a is longer than ~a characters"
(if n (format "Line #~a" n) "The line") (if n (format "Line #~a" n) "The line")
(regexp-replace #rx"^[ \t]*(.*?)[ \t]*$" line "\\1") (regexp-replace #rx"^[ \t]*(.*?)[ \t]*$" line "\\1")
(currently-processed-file-name)
len))))) len)))))
;; ============================================================================ ;; ============================================================================
@ -136,31 +137,48 @@
strs))) strs)))
(apply bytes-append (reverse! (cons (subbytes str idx) strs))))))) (apply bytes-append (reverse! (cons (subbytes str idx) strs)))))))
(define (submission->string submission maxwidth textualize? untabify?) (define current-processed-file ; set when processing multi-file submissions
(make-parameter #f))
(define (currently-processed-file-name)
(or (current-processed-file) "your code"))
(define (input->process->output maxwidth textualize? untabify? bad-re)
(let loop ([n 1])
(let ([line (if textualize?
(read-bytes-line (current-input-port) 'any)
(with-handlers ([void
(lambda (e)
(error* "The submission must not ~a"
"have non-textual items"))])
(read-bytes-line (current-input-port) 'any)))])
(unless (eof-object? line)
(let* ([line (regexp-replace #rx#"[ \t]+$" line #"")]
[line (if (and untabify?
(regexp-match-positions #rx"\t" line))
(untabify line) line)])
(when (and bad-re (regexp-match bad-re line))
(error* "You cannot use \"~a\" in ~a!~a"
(if (regexp? bad-re) (object-name bad-re) bad-re)
(currently-processed-file-name)
(if textualize? "" (format " (line ~a)" n))))
(when maxwidth
(verify-line-length line (and (not textualize?) n) maxwidth))
(display line) (newline) (loop (add1 n)))))))
(define (submission->bytes submission maxwidth textualize? untabify?
markup-prefix bad-re)
(define magic #"WXME")
(unless (equal? magic (subbytes submission 0 (bytes-length magic)))
(error* "bad submission format, expecting a single DrScheme submission"))
(let-values ([(defs inters) (unpack-submission submission)]) (let-values ([(defs inters) (unpack-submission submission)])
(parameterize ([current-output-port (open-output-string)] (parameterize ([current-input-port
[current-input-port
(if textualize? (if textualize?
(input-port->text-input-port (input-port->text-input-port (open-input-text-editor
(open-input-text-editor defs 0 'end snip->text)) defs 0 'end snip->text))
(open-input-text-editor defs))]) (open-input-text-editor defs))]
(let loop ([n 1]) [current-output-port (open-output-string)])
(let ([line (if textualize? (input->process->output maxwidth textualize? untabify? bad-re)
(read-bytes-line) (get-output-bytes (current-output-port)))))
(with-handlers ([void
(lambda (e)
(error* "The submission must not ~a"
"have non-textual items"))])
(read-bytes-line)))])
(unless (eof-object? line)
(let* ([line (regexp-replace #rx#"[ \t]+$" line #"")]
[line (if (and untabify?
(regexp-match-positions #rx"\t" line))
(untabify line) line)])
(when maxwidth
(verify-line-length line (and (not textualize?) n) maxwidth))
(display line) (newline) (loop (add1 n))))))
(get-output-string (current-output-port)))))
;; --------------------------------------------------------- ;; ---------------------------------------------------------
;; This code will hack textualization of test and text boxes ;; This code will hack textualization of test and text boxes
@ -223,6 +241,73 @@
(send text-box-sc set-version 2) (send text-box-sc set-version 2)
(send (get-the-snip-class-list) add text-box-sc) (send (get-the-snip-class-list) add text-box-sc)
;; ============================================================================
;; Dealing with multi-file submissions
(define ((unpack-multifile-submission names-checker)
submission maxwidth textualize? untabify?
markup-prefix prefix-re)
(define (assert-format b)
(unless b
(error* "bad submission format, expecting a multi-file submission -- ~a"
"use the multi-file submission tool")))
(let ([files
(parameterize ([current-input-port (open-input-bytes submission)])
(define magic #"<<<MULTI-SUBMISSION-FILE>>>")
(assert-format (equal? magic (read-bytes (bytes-length magic))))
(let loop ([files '()])
(let ([f (with-handlers ([void void]) (read))])
(if (eof-object? f)
(quicksort files (lambda (x y) (string<? (car x) (car y))))
(loop (cons f files))))))])
(assert-format (and (list? files)
(andmap (lambda (x)
(and (list? x) (= 2 (length x))
(string? (car x)) (bytes? (cadr x))))
files)))
(cond [(ormap (lambda (f)
(and (regexp-match #rx"^[.]|[/\\ ]" (car f)) (car f)))
files)
=> (lambda (file) (error* "bad filename: ~e" file))])
((cond [(procedure? names-checker) names-checker]
[(or (regexp? names-checker)
(string? names-checker) (bytes? names-checker))
(lambda (names)
(cond [(ormap (lambda (n)
(and (not (regexp-match names-checker n)) n))
names)
=> (lambda (file) (error* "bad filename: ~e" file))]))]
[(not names-checker) void]
[else (error* "bad names-checker specification: ~e" names-checker)])
(map car files))
;; This will create copies of the original files
;; (for-each (lambda (file)
;; (with-output-to-file (car file)
;; (lambda () (display (cadr file)) (flush-output))))
;; files)
(let* ([pfx-len (string-length markup-prefix)]
[line-len (- maxwidth pfx-len)]
[=s (lambda (n) (make-string n #\=))]
[=== (format "~a~a\n" markup-prefix (=s line-len))])
(define (sep name)
(newline)
(display ===)
(let ([n (/ (- line-len 4 (string-length name)) 2)])
(printf "~a~a< ~a >~a\n"
markup-prefix (=s (floor n)) name (=s (ceiling n))))
(display ===)
(newline))
(parameterize ([current-output-port (open-output-bytes)])
(for-each (lambda (file)
(sep (car file))
(parameterize ([current-input-port
(open-input-bytes (cadr file))]
[current-processed-file (car file)])
(input->process->output
maxwidth textualize? untabify? prefix-re)))
files)
(get-output-bytes (current-output-port))))))
;; ============================================================================ ;; ============================================================================
;; Checker function ;; Checker function
@ -255,16 +340,16 @@
(loop #'(x ...) (cons (list (syntax-e #'key) #'key #'val) keyvals))] (loop #'(x ...) (cons (list (syntax-e #'key) #'key #'val) keyvals))]
[(body ...) [(body ...)
(with-syntax (with-syntax
([users* (get ':users #'#f)] ([users* (get ':users #'#f)]
[eval?* (get ':eval? #'#t)] [eval?* (get ':eval? #'#t)]
[language* (get ':language #'#f)] [language* (get ':language #'#f)]
[teachpacks* (get ':teachpacks #''())] [teachpacks* (get ':teachpacks #''())]
[create-text?* (get ':create-text? #'#t)] [create-text?* (get ':create-text? #'#t)]
[untabify?* (get ':untabify? #'#t)] [untabify?* (get ':untabify? #'#t)]
[textualize?* (get ':textualize? #'#f)] [textualize?* (get ':textualize? #'#f)]
[maxwidth* (get ':maxwidth #'79)] [maxwidth* (get ':maxwidth #'79)]
[markup-prefix* (get ':markup-prefix #'#f)] [markup-prefix* (get ':markup-prefix #'#f)]
[prefix-re* (get ':prefix-re #'#f)] [prefix-re* (get ':prefix-re #'#f)]
[student-line* [student-line*
(get ':student-line (get ':student-line
#'"Student: {username} ({Full Name} <{Email}>)")] #'"Student: {username} ({Full Name} <{Email}>)")]
@ -272,8 +357,10 @@
(get ':extra-lines (get ':extra-lines
#''("Maximum points for this assignment: <+100>"))] #''("Maximum points for this assignment: <+100>"))]
[value-printer* (get ':value-printer #'#f)] [value-printer* (get ':value-printer #'#f)]
[coverage?* (get ':coverage? #'#f)] [coverage?* (get ':coverage? #'#f)]
[output* (get ':output #'"hw.scm")] [output* (get ':output #'"hw.scm")]
[multi-file* (get ':multi-file #'#f)]
[names-checker* (get ':names-checker #'#f)]
[user-error-message* [user-error-message*
(get ':user-error-message #'"Error in your code --\n~a")] (get ':user-error-message #'"Error in your code --\n~a")]
[checker (id 'checker)] [checker (id 'checker)]
@ -313,6 +400,8 @@
[value-printer value-printer*] [value-printer value-printer*]
[coverage? coverage?*] [coverage? coverage?*]
[output-file output*] [output-file output*]
[multi-file multi-file*]
[names-checker names-checker*]
[user-error-message user-error-message*] [user-error-message user-error-message*]
[execute-counts #f]) [execute-counts #f])
;; ======================================== ;; ========================================
@ -320,7 +409,11 @@
(define suffix (define suffix
(let ([sfx (string->symbol (let ([sfx (string->symbol
(string-downcase (string-downcase
(regexp-replace #rx"^.*[.]" output-file "")))]) (if multi-file
(format "~a" multi-file)
(and output-file
(regexp-replace
#rx"^.*[.]" output-file "")))))])
(case sfx (case sfx
[(java c cc c++) [(java c cc c++)
(unless markup-prefix (set! markup-prefix "//> ")) (unless markup-prefix (set! markup-prefix "//> "))
@ -357,26 +450,23 @@
(define (write-text) (define (write-text)
(with-output-to-file text-file (with-output-to-file text-file
(lambda () (lambda ()
(define added (or (thread-cell-ref added-lines) '())) (for-each (lambda (user)
(for-each (prefix-line
(lambda (user) (user-substs user student-line)))
(prefix-line (user-substs user student-line))) users)
users)
(for-each prefix-line extra-lines) (for-each prefix-line extra-lines)
(for-each prefix-line added) (for-each prefix-line
(or (thread-cell-ref added-lines) '()))
(display submission-text)) (display submission-text))
'truncate)) 'truncate))
(define submission-text (define submission-text
(and create-text? (and create-text?
(submission->string ((if multi-file
submission maxwidth textualize? untabify?))) (unpack-multifile-submission names-checker)
(when create-text? submission->bytes)
(make-directory "grading") submission maxwidth textualize? untabify?
(when (regexp-match prefix-re submission-text) markup-prefix prefix-re)))
(error* "You cannot use \"~a\" in your code!" (when create-text? (make-directory "grading") (write-text))
(if (regexp? prefix-re)
(object-name prefix-re) prefix-re)))
(write-text))
(when value-printer (current-value-printer value-printer)) (when value-printer (current-value-printer value-printer))
(when coverage? (coverage-enabled #t)) (when coverage? (coverage-enabled #t))
(current-run-status "checking submission") (current-run-status "checking submission")
@ -434,7 +524,7 @@
"`textualize?' and `coverage?'"] "`textualize?' and `coverage?'"]
[else #f])]) [else #f])])
(when bad (when bad
(error* "bad checker specifications: cannot use ~a" bad))) (error* "bad checker specifications: ~a" bad)))
;; ======================================== ;; ========================================
(list pre check post))))]))) (list pre check post))))])))

14
collects/handin-server/handin-server.ss
View File

@ -302,7 +302,9 @@
(begin (begin
(LOG "saving ~a for ~a" assignment users) (LOG "saving ~a for ~a" assignment users)
(parameterize ([current-directory ATTEMPT-DIR]) (parameterize ([current-directory ATTEMPT-DIR])
(rename-file-or-directory "handin" part)) (cond [part (unless (equal? part "handin")
(rename-file-or-directory "handin" part))]
[(file-exists? "handin") (delete-file "handin")]))
;; Shift successful-attempt directories so that there's ;; Shift successful-attempt directories so that there's
;; no SUCCESS-0: ;; no SUCCESS-0:
(make-success-dir-available 0) (make-success-dir-available 0)
@ -327,6 +329,8 @@
(error 'handin "no ~a submission directory for ~a" assignment users)) (error 'handin "no ~a submission directory for ~a" assignment users))
(LOG "retrieving assignment for ~a: ~a" users assignment) (LOG "retrieving assignment for ~a: ~a" users assignment)
(parameterize ([current-directory (build-path "active" assignment dirname)]) (parameterize ([current-directory (build-path "active" assignment dirname)])
(define magics '(#"WXME" #"<<<MULTI-SUBMISSION-FILE>>>"))
(define mlen (apply max (map bytes-length magics)))
(define file (define file
;; find the newest wxme file ;; find the newest wxme file
(let loop ([files (directory-list)] [file #f] [time #f]) (let loop ([files (directory-list)] [file #f] [time #f])
@ -334,8 +338,12 @@
file file
(let ([f (car files)]) (let ([f (car files)])
(if (and (file-exists? f) (if (and (file-exists? f)
(equal? #"WXME" (with-input-from-file f (let ([m (with-input-from-file f
(lambda () (read-bytes 4)))) (lambda () (read-bytes mlen)))])
(ormap (lambda (magic)
(equal? magic
(subbytes m 0 (bytes-length magic))))
magics))
(or (not file) (or (not file)
(> (file-or-directory-modify-seconds f) time))) (> (file-or-directory-modify-seconds f) time)))
(loop (cdr files) f (file-or-directory-modify-seconds f)) (loop (cdr files) f (file-or-directory-modify-seconds f))