diff --git a/collects/handin-server/doc.txt b/collects/handin-server/doc.txt index 9216be707e..aa055c758b 100644 --- a/collects/handin-server/doc.txt +++ b/collects/handin-server/doc.txt @@ -966,19 +966,28 @@ 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." file ("" 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. +separators. A possible confusion is that every submission is a +complete set of files that overwrites any existing submission -- but +students may think that the server accumulates incoming files. To +avoid such confusion, when a submission arrives an there is already an +existing previous submission, the contents is compared, and if there +are files that existed in the old submission but not in the new ones, +the student will see a warning pop-up that allows aborting the +submission. -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. +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 (but PLT Scheme is still required, so it cannot be +uninstalled). *** Auto-updater diff --git a/collects/handin-server/extra-utils.ss b/collects/handin-server/extra-utils.ss index a078409187..dc70879c2e 100644 --- a/collects/handin-server/extra-utils.ss +++ b/collects/handin-server/extra-utils.ss @@ -48,11 +48,11 @@ (let* ([m (regexp-match-positions #rx"{([^{}]+)}" str)] [s (and m (substring str (caadr m) (cdadr m)))]) (if m - (subst (string-append (substring str 0 (caar m)) - (cond [(assoc s substs) => cdr] - [else (error 'subst - "unknown substitution: ~s" s)]) - (substring str (cdar m))) + (subst (string-append + (substring str 0 (caar m)) + (cond [(assoc s substs) => cdr] + [else (error 'subst "unknown substitution: ~s" s)]) + (substring str (cdar m))) substs) str)))) @@ -244,42 +244,65 @@ ;; ============================================================================ ;; Dealing with multi-file submissions -(define ((unpack-multifile-submission names-checker) - submission maxwidth textualize? untabify? - markup-prefix prefix-re) +(define (read-multifile . port) + (define magic #"<<>>") (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 #"<<>>") - (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 (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)) + (cond [(procedure? names-checker) (names-checker names)] + [(or (regexp? names-checker) + (string? names-checker) (bytes? names-checker)) + (cond [(ormap (lambda (n) + (and (not (regexp-match names-checker n)) n)) + names) + => (lambda (file) (error* "bad filename: ~e" file))])] + [names-checker (error* "bad names-checker specification: ~e" + names-checker)]) + ;; problem: students might think that submitting files one-by-one will keep + ;; them all; solution: if there is already a submission, then warn against + ;; files that disappear. + (let* ([raw (build-path 'up raw-file-name)] + [old (and (file-exists? raw) + (with-handlers ([void (lambda _ #f)]) + (with-input-from-file raw read-multifile)))] + [removed (and old (remove* names (map car old)))]) + (when (and (pair? removed) + (not (eq? 'ok (message + (apply string-append + "The following file" + (if (pair? (cdr removed)) "s" "") + " will be lost:" + (map (lambda (n) (string-append " " n)) + removed)) + '(ok-cancel caution))))) + (error* "Aborting..."))) ;; This will create copies of the original files ;; (for-each (lambda (file) ;; (with-output-to-file (car file) @@ -448,6 +471,7 @@ (define (prefix-line str) (printf "~a~a\n" markup-prefix str)) (define (write-text) + (current-run-status "creating text file") (with-output-to-file text-file (lambda () (for-each (lambda (user) @@ -461,11 +485,13 @@ 'truncate)) (define submission-text (and create-text? - ((if multi-file - (unpack-multifile-submission names-checker) - submission->bytes) - submission maxwidth textualize? untabify? - markup-prefix prefix-re))) + (begin (current-run-status "reading submission") + ((if multi-file + (unpack-multifile-submission + names-checker output-file) + submission->bytes) + submission maxwidth textualize? untabify? + markup-prefix prefix-re)))) (when create-text? (make-directory "grading") (write-text)) (when value-printer (current-value-printer value-printer)) (when coverage? (coverage-enabled #t))