1: proc parseScorerOutputLine { aline studentVar } {
2: upvar $studentVar student
3: set student(stunum) [lindex $aline 0]
4: set aline [string range $aline 40 end]
5: set length [llength [split [lrange $aline 3 end] ,] ]
6: set student(response) [lrange [split [lrange $aline 3 end] ,] 0 [expr {$length-2}]]
7: set student(question) [lindex [lindex [split $aline ,] end] 0]
8: # parray student
9: }
10:
11: proc getQuestions { num pid set questnum questionVar } {
12: upvar $questionVar question
13: global gCapaConfig
14: catch {unset question}
15: set result [exec $gCapaConfig($num.answers_command) $pid {} 1 $set]
16: set capture [set i 0]
17: puts "$questnum:$i"
18: foreach line [split $result "\n"] {
19: switch [lindex [split $line :] 0] {
20: BQES {
21: incr i
22: if { [lsearch $questnum $i] != -1 } { set capture 1 }
23: }
24: EQES { set capture 0 }
25: ANS {
26: if { [lsearch $questnum $i] != -1 } {
27: set question($i.ans) [split [lindex [split $line :] 1] {} ]
28: }
29: }
30: default { if { $capture } { lappend question($i.text) $line } }
31: }
32: }
33: foreach quest $questnum {
34: foreach line $question($quest.text) {
35: if { [regexp {^ *([A-Z])\)(.*)} $line temp letter rest] } {
36: set question($quest.$letter) $rest
37: if { [lsearch $question($quest.ans) $letter] != -1} {
38: set question($quest.correct.$letter) 1
39: } else {
40: set question($quest.correct.$letter) 0
41: }
42: }
43: }
44: }
45: parray question
46: }
47:
48: #FIXME not parsing all student responses?
49: proc getStudentResponses { responses which questionVar responseArVar } {
50: upvar $questionVar question $responseArVar responseAr
51: set i 0
52: foreach response [split $responses {}] {
53: if { $response == "" || $response == " "} { continue }
54: incr i
55: if { [catch {incr responseAr($which.$question($which.$response))}] } {
56: if {[catch {set responseAr($which.$question($which.$response)) 1}]} {
57: set responseAr($which.Illegal\ Bubble) 1
58: }
59: }
60: }
61: puts $i
62: }
63:
64: set fileId [open "records/scorer.output.1" r]
65: set setId 1
66: set questionNum "1"
67: source /nfs/capa1/capadvt/CAPA_SRC/5.0/GUITools/common.tcl
68: set aline [gets $fileId]
69: set aline [gets $fileId]
70: parseCapaConfig 1 .
71: set k 0
72: while { ! [eof $fileId] } {
73: parseScorerOutputLine $aline student
74: getQuestions 1 $student(question) $setId $questionNum question
75: foreach which $questionNum {
76: getStudentResponses [lindex $student(response) [expr $which-1]] $which question \
77: responses
78: }
79: foreach which $questionNum {
80: foreach elem [array names responses "$which.*"] {
81: puts -nonewline "$responses($elem) "
82: }
83: }
84: incr k
85: if { $k%20 == 0 } { parray responses }
86: puts ""
87: set aline [gets $fileId]
88: }
89: parray responses
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>