Annotation of capa/capa51/GUITools/groupemail.tcl, revision 1.5
1.4 albertel 1: #Copyright 2000 by Guy Albertelli
1.1 albertel 2: proc runGroupEmail { capaConfigFile } {
1.2 albertel 3: global gUniqueNumber gFile gWindowMenu gCT
1.1 albertel 4: set num [incr gUniqueNumber]
5: set gFile($num) [file dirname $capaConfigFile]
6: parseCapaConfig $num $gFile($num)
7: parseCapaUtilsConfig $num $gFile($num)
8:
9: set emailwin [toplevel .email$num]
10: $gWindowMenu add command -label "Sending Email $gFile($num)" \
11: -command "capaRaise \"$emailwin\""
1.4 albertel 12: wm title $emailwin [file dirname $capaConfigFile]
1.2 albertel 13:
14: set fileFrame [frame $emailwin.file]
15: set sentFrame [frame $emailwin.sent]
16: set buttonFrame [frame $emailwin.button]
1.4 albertel 17: pack $fileFrame $sentFrame $buttonFrame -side top -anchor w
1.2 albertel 18:
19: label $fileFrame.label -text "Mail Template:"
20: entry $fileFrame.file -textvariable gCT($num.template)
21: button $fileFrame.select -text "Browse" \
1.4 albertel 22: -command "set gCT($num.template) \[tk_getOpenFile\]"
1.2 albertel 23: pack $fileFrame.label $fileFrame.file $fileFrame.select -side left
24:
25: label $sentFrame.text -text "Send To:"
26: set classFrame [frame $sentFrame.class]
27: set sectionFrame [frame $sentFrame.section]
28: set studentFrame [frame $sentFrame.student]
1.4 albertel 29: #unpacked
1.2 albertel 30: set scriptFrame [frame $sentFrame.script]
1.4 albertel 31: pack $sentFrame.text $classFrame $sectionFrame $studentFrame -side top -anchor w
1.2 albertel 32:
33: #class
34: radiobutton $classFrame.class -text "Whole Class" \
35: -variable gCT($num.emailtype) -value "Class"
36: pack $classFrame.class
37:
38: #sections
1.4 albertel 39: set gCT($num.emailsections) "None"
40: set top [frame $sectionFrame.top]
41: set bottom [frame $sectionFrame.bottom]
42: pack $top $bottom -side top -anchor w
43:
44: radiobutton $top.button -text "Sections" \
1.2 albertel 45: -variable gCT($num.emailtype) -value "Sections"
1.4 albertel 46: button $top.select -text "Select Section" -command "emailSelectSections $num"
47: message $bottom.sections -textvariable gCT($num.emailsections) \
48: -relief groove -width 350
49: frame $bottom.spacer -width 20
1.2 albertel 50:
1.4 albertel 51: pack $top.button $top.select -side left -anchor w
52: pack $bottom.spacer $bottom.sections -anchor w -side left
53:
1.2 albertel 54: #student
1.5 ! albertel 55: radiobutton $studentFrame.specific -text "Students from file:" \
1.2 albertel 56: -value "Specific" -variable gCT($num.emailtype)
1.5 ! albertel 57: entry $studentFrame.file -textvariable gCT($num.studentlist)
! 58: button $studentFrame.select -text "Browse" \
! 59: -command "set gCT($num.studentlist) \[tk_getOpenFile\]"
! 60: pack $studentFrame.specific $studentFrame.file $studentFrame.select -side left
1.2 albertel 61:
62: #script
1.4 albertel 63: radiobutton $scriptFrame.label -text "Script Selection:" -value "Script" \
64: -variable gCT($num.emailtype)
65: entry $scriptFrame.file -textvariable gCT($num.emailscript)
1.2 albertel 66: button $scriptFrame.select -text "Browse" \
1.5 ! albertel 67: -command "set gCT($num.emailscript) \[tk_getOpenFile\]"
1.2 albertel 68: pack $scriptFrame.label $scriptFrame.file $scriptFrame.select -side left
69:
70: button $buttonFrame.send -text "Send" -command "emailSend $num"
1.4 albertel 71: frame $buttonFrame.spacer -width 100
72: button $buttonFrame.cancel -text "Close" -command "emailClose $num"
73: pack $buttonFrame.send $buttonFrame.spacer $buttonFrame.cancel -side left
74: Centre_Dialog $emailwin default
75: }
76:
1.5 ! albertel 77: proc emailClose { num } {
! 78: global gFile
! 79: destroy .email$num
! 80: removeWindowEntry "Sending Email $gFile($num)"
! 81: }
! 82:
1.4 albertel 83: proc emailSelectSections { num } {
84: global gCT gFile
85: set pwd [pwd]; cd $gFile($num)
86: set gCT($num.emailsections) [string trim [pickSections [getExistingSections] "Select Sections to send an email to:"]]
87: cd $pwd
88: if { $gCT($num.emailsections) != "" } {
89: set gCT($num.emailtype) Sections
90: } else {
91: set gCT($num.emailsections) "None"
92: }
1.2 albertel 93: }
94:
95: proc emailSend { num } {
96: global gCT gFile
97:
1.4 albertel 98: if { [catch {set fileId [open $gCT($num.template) r]}]} {
99: displayMessage "Unable to open $gCT($num.template)"
100: return
101: }
102: set gCT($num.message) [read $fileId [file size $gCT($num.template)]]
103: close $fileId
104:
1.2 albertel 105: if { "Cancel" == [emailConfirm $num]} { return }
106: emailGetStudents $num
107:
1.4 albertel 108: set max [llength $gCT($num.studentlist)]
109: set i 0
110: displayStatus "Sending Messages" both $num
111: foreach student $gCT($num.studentlist) {
112: incr i
1.2 albertel 113: # foreach {email firstname lastname stunum} $student {break}
1.5 ! albertel 114: set subject ""
! 115: set message [emailMessage $num $student subject]
! 116: emailSendMessage $num $student $message $subject
1.4 albertel 117: updateStatusBar [expr $i/double($max)] $num
1.2 albertel 118: }
1.4 albertel 119: removeStatus $num
120: }
121:
122: proc emailConfirm { num } {
123: global gCT
124: set msg "The message in $gCT($num.template) will be sent to"
125: switch $gCT($num.emailtype) {
126: Class { append msg " the whole class." }
127: Sections { append msg " the sections $gCT($num.emailsections)." }
1.5 ! albertel 128: Specific { append msg " to the student numbers in $gCT($num.studentlist)." }
1.4 albertel 129: Script {
130: append msg " to the students generated by the script $gCT($num.emailscript)."
131: }
132: }
133: append msg "\n\n Continue?"
134: if { "Yes" == [makeSure $msg]} {
135: return "Yes"
136: }
137: return "Cancel"
1.3 albertel 138: }
139:
140: proc emailGetStudents { num } {
141: global gCT gFile
1.4 albertel 142:
143: switch $gCT($num.emailtype) {
1.3 albertel 144: Class { emailGetClass $num }
1.4 albertel 145: Sections { emailGetSections $num }
1.5 ! albertel 146: Specific { emailGetSpecific $num }
1.3 albertel 147: Script { }
148: }
149: }
150:
151: proc emailGetClass { num } {
152: global gCT gFile
153: set classlid [open [file join $gFile($num) classl] r]
1.4 albertel 154:
1.3 albertel 155: set aline [gets $classlid]
156: while { ![eof $classlid] } {
157: set email [string trim [string range $aline 60 99]]
158: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
159: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
160: set stunum [string trim [string range $aline 14 22]]
161: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum]
162: set aline [gets $classlid]
163: }
1.4 albertel 164: }
165:
166: proc emailGetSections { num } {
167: global gCT gFile
168: set classlid [open [file join $gFile($num) classl] r]
169:
170: set aline [gets $classlid]
171: while { ![eof $classlid] } {
172: set section [string trimleft [string trim [string range $aline 10 12]] "0"]
173: if { [lsearch $gCT($num.emailsections) $section] == -1 } {
174: set aline [gets $classlid]
175: continue
176: }
177: set email [string trim [string range $aline 60 99]]
178: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
179: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
180: set stunum [string trim [string range $aline 14 22]]
181: set section [string trimleft [string trim [string range $aline 10 12] ] 0]
182: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
183: set aline [gets $classlid]
184: }
185: }
186:
1.5 ! albertel 187: proc emailGetSpecific { num } {
! 188: global gCT gFile
! 189:
! 190: set fileId [open $gCT($num.studentlist)]
! 191: set temp [split [read $fileId] "\n"]
! 192: set allids ""
! 193: foreach element $temp { if { $element != "" } { lappend allids $element } }
! 194: close $fileId
! 195: puts $allids
! 196: set classlid [open [file join $gFile($num) classl] r]
! 197: set aline [gets $classlid]
! 198: while { ![eof $classlid] } {
! 199: set stunum [string trim [string range $aline 14 22]]
! 200: if { [lsearch $allids $stunum] !=-1 } {
! 201: set section [string trimleft [string trim [string range $aline 10 12]] "0"]
! 202: set email [string trim [string range $aline 60 99]]
! 203: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
! 204: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
! 205: set section [string trimleft [string trim [string range $aline 10 12] ] 0]
! 206: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
! 207: }
! 208: set aline [gets $classlid]
! 209: }
! 210: }
! 211:
! 212: proc emailMessage { num student subjectVar } {
1.4 albertel 213: global gCT gFile gCapaConfig
1.5 ! albertel 214: upvar $subjectVar subject
1.4 albertel 215: set message $gCT($num.message)
216:
217: regsub -all -- \\\$email $message [lindex $student 0] message
218: regsub -all -- \\\$first_name $message [lindex $student 1] message
219: regsub -all -- \\\$last_name $message [lindex $student 2] message
220: regsub -all -- \\\$student_number $message [lindex $student 3] message
221: set stunum [lindex $student 3]
222: set section [lindex $student 4]
223: while { [regexp {\$capaid\(([0-9all\.,]*)\)} $message match set] } {
224: set capaid [getCapaID $set $stunum $section $gFile($num)]
225: regsub -all -- \\\$capaid\\\($set\\\) $message $capaid message
226: }
227: while { [regexp {\$homework_score\(([0-9all\.,]*)\)} $message match set] } {
228: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
229: set max 99;set setmax 99
230: }
231: set scores [getScores $set $stunum $section $gFile($num) $max setmax]
232: regsub -all -- \\\$homework_score\\\($set\\\) $message $scores message
233: if { $set == "all" } {
234: set all(homework.score) $scores
235: set all(setmax.homework.score) $setmax
236: }
237: }
238: while { [regexp {\$homework_total\(([0-9all\.,]*)\)} $message match set] } {
239: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
240: set max 99;set setmax 99
241: }
242: set scores [getTotals $set $stunum $section $gFile($num) $max setmax]
243: regsub -all -- \\\$homework_total\\\($set\\\) $message $scores message
244: if { $set == "all" } {
245: set all(homework.total) $scores
246: set all(setmax.homework.total) $setmax
247: }
248: }
249: foreach {path limit} {quiz quiz_count supp none others none correction \
250: final_exam_set_number exam final_exam_set_number} {
251: if {[catch {set gCapaConfig($num.[set path]_path)}]} {
252: continue
253: } else {
254: if { ![file exists $gCapaConfig($num.[set path]_path)] } { continue }
255: }
256: if { [catch {set setmax [set max $gCapaConfig($num.$limit)]}]} {
257: set max 99 ; set setmax 99
258: }
259: foreach {type call} {score getScores total getTotals} {
260: set exp {\$};append exp $path;append exp _$type
261: append exp {\(([0-9all\.,]*)\)}
262: while { [regexp $exp $message match set]} {
263: set scores [$call $set $stunum $section \
264: $gCapaConfig($num.[set path]_path) $max setmax]
265: set replacexp {\$};append replacexp $path;append replacexp _$type
266: append replacexp {\(};append replacexp $set;append replacexp {\)}
267: regsub -all -- $replacexp $message $scores message
268: if { $set == "all" } {
269: set all($path.$type) $scores
270: set all(setmax.$path.$type) $setmax
271: }
272: }
273: }
274: }
275: if { [regexp {\$grade} $message match] } {
276: #homework
277: foreach {type func} {score getScores total getTotals} {
278: if { [catch {set all(homework.$type)}]} {
279: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
280: set max 99;set setmax 99
281: }
282: set all(homework.$type) [$func "all" $stunum $section $gFile($num) \
283: $max setmax]
284: # set all(setmax.homework.$type) $setmax
285: }
286: }
287: #quizzes
288: foreach {type func} {score getScores total getTotals} {
289: if { [catch {set all(quiz.$type)}]} {
290: if { [catch {set setmax [set max $gCapaConfig($num.quiz_count)]}]} {
291: set max 99;set setmax 99
292: }
293: set all(quiz.$type) [$func "all" $stunum $section \
294: $gCapaConfig($num.quiz_path) $max setmax]
295: # set all(setmax.quiz.$type) $setmax
296: }
297: }
298: #exams and final
299: if { [catch {set setmax [set max $gCapaConfig($num.final_exam_set_number)]}]} {
300: set max 99;set setmax 99
301: }
302: set finalset $setmax
303: set lastexam [expr $finalset - 1]
304: set totalexam 0
305: for { set i 1 } { $i <= $lastexam } { incr i } {
306: set exams [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
307: set examt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
308: set corrs [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
309: set corrt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
1.5 ! albertel 310: if { [catch {set exam [expr $exams/double($examt)]}] } { set exam 0 }
! 311: if { [catch {set corr [expr $corrs/double($corrt)]}] } { set corr 0 }
1.4 albertel 312: if { $corr > $exam } {
313: set totalexam [expr $totalexam + \
314: [expr $exam + $gCapaConfig($num.correction_weight) \
315: * ($corr - $exam)]]
316: } else {
317: set totalexam [expr $totalexam + $exam]
318: }
319: }
1.5 ! albertel 320: if { [catch {set totalexam [expr $totalexam / ($i-1)]}] } { set totalexam 0 }
1.4 albertel 321: set finals [getScores $finalset $stunum $section $gCapaConfig($num.exam_path)]
322: set finalt [getTotals $finalset $stunum $section $gCapaConfig($num.exam_path)]
1.5 ! albertel 323: if { [catch {set final [expr $finals/double($finalt)]}]} {set final 0}
! 324: if { [catch {set homework [expr $all(homework.score)/double($all(homework.total))]}] } { set homework 0 }
! 325: if { [catch {set quiz [expr $all(quiz.score)/double($all(quiz.total))]}] } { set quiz 0 }
1.4 albertel 326: set grade [expr $gCapaConfig($num.homework_weight)*$homework +\
327: $gCapaConfig($num.quiz_weight)*$quiz +\
328: $gCapaConfig($num.exam_weight)*$totalexam +\
329: $gCapaConfig($num.final_weight)*$final]
330: set grade [format "%2.1f" [expr $grade * 100 ]]
331: regsub -all -- \\\$grade $message $grade message
332: }
1.5 ! albertel 333: regexp "^Subject:(\[^\n]*)" $message garbage subject
! 334: regsub "^Subject:(\[^\n]*)" $message {} message
1.4 albertel 335: return $message
336: }
337:
1.5 ! albertel 338: proc emailSendMessage { num student message subject } {
1.4 albertel 339: global gCT gCapaConfig
1.5 ! albertel 340: exec echo $message | $gCapaConfig($num.mail_command) -s $subject [lindex $student 0]
1.4 albertel 341: }
342:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to groupemail.tcl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / capa / capa51 / GUITools