File:
[LON-CAPA] /
capa /
capa51 /
GUITools /
groupemail.tcl
Revision
1.8:
download - view:
text,
annotated -
select for diffs
Mon Nov 13 21:36:17 2000 UTC (23 years, 10 months ago) by
albertel
Branches:
MAIN
CVS tags:
version_2_9_X,
version_2_9_99_0,
version_2_9_1,
version_2_9_0,
version_2_8_X,
version_2_8_99_1,
version_2_8_99_0,
version_2_8_2,
version_2_8_1,
version_2_8_0,
version_2_7_X,
version_2_7_99_1,
version_2_7_99_0,
version_2_7_1,
version_2_7_0,
version_2_6_X,
version_2_6_99_1,
version_2_6_99_0,
version_2_6_3,
version_2_6_2,
version_2_6_1,
version_2_6_0,
version_2_5_X,
version_2_5_99_1,
version_2_5_99_0,
version_2_5_2,
version_2_5_1,
version_2_5_0,
version_2_4_X,
version_2_4_99_0,
version_2_4_2,
version_2_4_1,
version_2_4_0,
version_2_3_X,
version_2_3_99_0,
version_2_3_2,
version_2_3_1,
version_2_3_0,
version_2_2_X,
version_2_2_99_1,
version_2_2_99_0,
version_2_2_2,
version_2_2_1,
version_2_2_0,
version_2_1_X,
version_2_1_99_3,
version_2_1_99_2,
version_2_1_99_1,
version_2_1_99_0,
version_2_1_3,
version_2_1_2,
version_2_1_1,
version_2_1_0,
version_2_12_X,
version_2_11_X,
version_2_11_5_msu,
version_2_11_5,
version_2_11_4_uiuc,
version_2_11_4_msu,
version_2_11_4,
version_2_11_3_uiuc,
version_2_11_3_msu,
version_2_11_3,
version_2_11_2_uiuc,
version_2_11_2_msu,
version_2_11_2_educog,
version_2_11_2,
version_2_11_1,
version_2_11_0_RC3,
version_2_11_0_RC2,
version_2_11_0_RC1,
version_2_11_0,
version_2_10_X,
version_2_10_1,
version_2_10_0_RC2,
version_2_10_0_RC1,
version_2_10_0,
version_2_0_X,
version_2_0_99_1,
version_2_0_2,
version_2_0_1,
version_2_0_0,
version_1_99_3,
version_1_99_2,
version_1_99_1_tmcc,
version_1_99_1,
version_1_99_0_tmcc,
version_1_99_0,
version_1_3_X,
version_1_3_3,
version_1_3_2,
version_1_3_1,
version_1_3_0,
version_1_2_X,
version_1_2_99_1,
version_1_2_99_0,
version_1_2_1,
version_1_2_0,
version_1_1_X,
version_1_1_99_5,
version_1_1_99_4,
version_1_1_99_3,
version_1_1_99_2,
version_1_1_99_1,
version_1_1_99_0,
version_1_1_3,
version_1_1_2,
version_1_1_1,
version_1_1_0,
version_1_0_99_3,
version_1_0_99_2,
version_1_0_99_1,
version_1_0_99,
version_1_0_3,
version_1_0_2,
version_1_0_1,
version_1_0_0,
version_0_99_5,
version_0_99_4,
version_0_99_3,
version_0_99_2,
version_0_99_1,
version_0_99_0,
version_0_6_2,
version_0_6,
version_0_5_1,
version_0_5,
version_0_4,
stable_2002_spring,
stable_2002_july,
stable_2002_april,
stable_2001_fall,
loncapaMITrelate_1,
language_hyphenation_merge,
language_hyphenation,
conference_2003,
bz6209-base,
bz6209,
STABLE,
HEAD,
GCI_3,
GCI_2,
GCI_1,
CAPA_5-1-6,
CAPA_5-1-5,
BZ4492-merge,
BZ4492-feature_horizontal_radioresponse,
BZ4492-feature_Support_horizontal_radioresponse,
BZ4492-Support_horizontal_radioresponse
- saved email to email.list
1: # allow mass emailing to students
2: # Copyright (C) 1992-2000 Michigan State University
3: #
4: # The CAPA system is free software; you can redistribute it and/or
5: # modify it under the terms of the GNU General Public License as
6: # published by the Free Software Foundation; either version 2 of the
7: # License, or (at your option) any later version.
8: #
9: # The CAPA system is distributed in the hope that it will be useful,
10: # but WITHOUT ANY WARRANTY; without even the implied warranty of
11: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12: # General Public License for more details.
13: #
14: # You should have received a copy of the GNU General Public
15: # License along with the CAPA system; see the file COPYING. If not,
16: # write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
17: # Boston, MA 02111-1307, USA.
18: #
19: # As a special exception, you have permission to link this program
20: # with the TtH/TtM library and distribute executables, as long as you
21: # follow the requirements of the GNU GPL in regard to all of the
22: # software in the executable aside from TtH/TtM.
23:
24: #Created 2000 by Guy Albertelli
25: proc runGroupEmail { capaConfigFile } {
26: global gUniqueNumber gFile gWindowMenu gCT
27: set num [incr gUniqueNumber]
28: set gFile($num) [file dirname $capaConfigFile]
29: parseCapaConfig $num $gFile($num)
30: parseCapaUtilsConfig $num $gFile($num)
31:
32: set emailwin [toplevel .email$num]
33: $gWindowMenu add command -label "Sending Email $gFile($num)" \
34: -command "capaRaise \"$emailwin\""
35: wm title $emailwin [file dirname $capaConfigFile]
36:
37: set fileFrame [frame $emailwin.file]
38: set sentFrame [frame $emailwin.sent]
39: set buttonFrame [frame $emailwin.button]
40: pack $fileFrame $sentFrame $buttonFrame -side top -anchor w
41:
42: label $fileFrame.label -text "Mail Template:"
43: entry $fileFrame.file -textvariable gCT($num.template)
44: button $fileFrame.select -text "Browse" \
45: -command "set gCT($num.template) \[tk_getOpenFile\]"
46: pack $fileFrame.label $fileFrame.file $fileFrame.select -side left
47:
48: label $sentFrame.text -text "Send To:"
49: set classFrame [frame $sentFrame.class]
50: set sectionFrame [frame $sentFrame.section]
51: set studentFrame [frame $sentFrame.student]
52: #unpacked
53: set scriptFrame [frame $sentFrame.script]
54: pack $sentFrame.text $classFrame $sectionFrame $studentFrame -side top -anchor w
55:
56: #class
57: radiobutton $classFrame.class -text "Whole Class" \
58: -variable gCT($num.emailtype) -value "Class"
59: pack $classFrame.class
60:
61: #sections
62: set gCT($num.emailsections) "None"
63: set top [frame $sectionFrame.top]
64: set bottom [frame $sectionFrame.bottom]
65: pack $top $bottom -side top -anchor w
66:
67: radiobutton $top.button -text "Sections" \
68: -variable gCT($num.emailtype) -value "Sections"
69: button $top.select -text "Select Section" -command "emailSelectSections $num"
70: message $bottom.sections -textvariable gCT($num.emailsections) \
71: -relief groove -width 350
72: frame $bottom.spacer -width 20
73:
74: pack $top.button $top.select -side left -anchor w
75: pack $bottom.spacer $bottom.sections -anchor w -side left
76:
77: #student
78: radiobutton $studentFrame.specific -text "Students from file:" \
79: -value "Specific" -variable gCT($num.emailtype)
80: entry $studentFrame.file -textvariable gCT($num.studentlist)
81: button $studentFrame.select -text "Browse" \
82: -command "set gCT($num.studentlist) \[tk_getOpenFile\]"
83: pack $studentFrame.specific $studentFrame.file $studentFrame.select -side left
84:
85: #script
86: radiobutton $scriptFrame.label -text "Script Selection:" -value "Script" \
87: -variable gCT($num.emailtype)
88: entry $scriptFrame.file -textvariable gCT($num.emailscript)
89: button $scriptFrame.select -text "Browse" \
90: -command "set gCT($num.emailscript) \[tk_getOpenFile\]"
91: pack $scriptFrame.label $scriptFrame.file $scriptFrame.select -side left
92:
93: button $buttonFrame.send -text "Send" -command "emailSend $num"
94: frame $buttonFrame.spacer -width 100
95: button $buttonFrame.cancel -text "Close" -command "emailClose $num"
96: pack $buttonFrame.send $buttonFrame.spacer $buttonFrame.cancel -side left
97: Centre_Dialog $emailwin default
98: }
99:
100: proc emailClose { num } {
101: global gFile
102: destroy .email$num
103: removeWindowEntry "Sending Email $gFile($num)"
104: }
105:
106: proc emailSelectSections { num } {
107: global gCT gFile
108: set pwd [pwd]; cd $gFile($num)
109: set gCT($num.emailsections) [string trim [pickSections [getExistingSections] "Select Sections to send an email to:"]]
110: cd $pwd
111: if { $gCT($num.emailsections) != "" } {
112: set gCT($num.emailtype) Sections
113: } else {
114: set gCT($num.emailsections) "None"
115: }
116: }
117:
118: proc emailSend { num } {
119: global gCT gFile
120:
121: if { [catch {set fileId [open $gCT($num.template) r]}]} {
122: displayMessage "Unable to open $gCT($num.template)"
123: return
124: }
125: set gCT($num.message) [read $fileId [file size $gCT($num.template)]]
126: close $fileId
127:
128: if { "Cancel" == [emailConfirm $num]} { return }
129: emailGetStudents $num
130:
131: set max [llength $gCT($num.studentlist)]
132: set i 0
133: displayStatus "Sending Messages" both $num
134: foreach student $gCT($num.studentlist) {
135: incr i
136: # foreach {email firstname lastname stunum} $student {break}
137: set subject ""
138: set message [emailMessage $num $student subject]
139: emailSendMessage $num $student $message $subject
140: updateStatusBar [expr $i/double($max)] $num
141: }
142: removeStatus $num
143: }
144:
145: proc emailConfirm { num } {
146: global gCT
147: set msg "The message in $gCT($num.template) will be sent to"
148: switch $gCT($num.emailtype) {
149: Class { append msg " the whole class." }
150: Sections { append msg " the sections $gCT($num.emailsections)." }
151: Specific { append msg " to the student numbers in $gCT($num.studentlist)." }
152: Script {
153: append msg " to the students generated by the script $gCT($num.emailscript)."
154: }
155: }
156: append msg "\n\n Continue?"
157: if { "Yes" == [makeSure $msg]} {
158: return "Yes"
159: }
160: return "Cancel"
161: }
162:
163: proc emailGetStudents { num } {
164: global gCT gFile
165:
166: switch $gCT($num.emailtype) {
167: Class { emailGetClass $num }
168: Sections { emailGetSections $num }
169: Specific { emailGetSpecific $num }
170: Script { }
171: }
172: }
173:
174: proc emailGetClass { num } {
175: global gCT gFile
176: set classlid [open [file join $gFile($num) classl] r]
177:
178: set aline [gets $classlid]
179: while { ![eof $classlid] } {
180: set email [string trim [string range $aline 60 99]]
181: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
182: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
183: set stunum [string trim [string range $aline 14 22]]
184: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum]
185: set aline [gets $classlid]
186: }
187: }
188:
189: proc emailGetSections { num } {
190: global gCT gFile
191: set classlid [open [file join $gFile($num) classl] r]
192:
193: set aline [gets $classlid]
194: while { ![eof $classlid] } {
195: set section [string trimleft [string trim [string range $aline 10 12]] "0"]
196: if { [lsearch $gCT($num.emailsections) $section] == -1 } {
197: set aline [gets $classlid]
198: continue
199: }
200: set email [string trim [string range $aline 60 99]]
201: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
202: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
203: set stunum [string trim [string range $aline 14 22]]
204: set section [string trimleft [string trim [string range $aline 10 12] ] 0]
205: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
206: set aline [gets $classlid]
207: }
208: }
209:
210: proc emailGetSpecific { num } {
211: global gCT gFile
212:
213: set fileId [open $gCT($num.studentlist)]
214: set temp [split [read $fileId] "\n"]
215: set allids ""
216: foreach element $temp { if { $element != "" } { lappend allids $element } }
217: close $fileId
218: # puts $allids
219: set gCT($num.studentlist) ""
220: set classlid [open [file join $gFile($num) classl] r]
221: set aline [gets $classlid]
222: while { ![eof $classlid] } {
223: set stunum [string trim [string range $aline 14 22]]
224: if { [lsearch $allids $stunum] !=-1 } {
225: set section [string trimleft [string trim [string range $aline 10 12]] "0"]
226: set email [string trim [string range $aline 60 99]]
227: set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
228: set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
229: set section [string trimleft [string trim [string range $aline 10 12] ] 0]
230: lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
231: }
232: set aline [gets $classlid]
233: }
234: }
235:
236: proc emailMessage { num student subjectVar } {
237: global gCT gFile gCapaConfig
238: upvar $subjectVar subject
239: set message $gCT($num.message)
240:
241: regsub -all -- \\\$email $message [lindex $student 0] message
242: regsub -all -- \\\$first_name $message [lindex $student 1] message
243: regsub -all -- \\\$last_name $message [lindex $student 2] message
244: regsub -all -- \\\$student_number $message [lindex $student 3] message
245: set stunum [lindex $student 3]
246: set section [lindex $student 4]
247: while { [regexp {\$capaid\(([0-9all\.,]*)\)} $message match set] } {
248: set capaid [getCapaID $set $stunum $section $gFile($num)]
249: regsub -all -- \\\$capaid\\\($set\\\) $message $capaid message
250: }
251: while { [regexp {\$homework_score\(([0-9all\.,]*)\)} $message match set] } {
252: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
253: set max 99;set setmax 99
254: }
255: set scores [getScores $set $stunum $section $gFile($num) $max setmax]
256: regsub -all -- \\\$homework_score\\\($set\\\) $message $scores message
257: if { $set == "all" } {
258: set all(homework.score) $scores
259: set all(setmax.homework.score) $setmax
260: }
261: }
262: while { [regexp {\$homework_total\(([0-9all\.,]*)\)} $message match set] } {
263: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
264: set max 99;set setmax 99
265: }
266: set scores [getTotals $set $stunum $section $gFile($num) $max setmax]
267: regsub -all -- \\\$homework_total\\\($set\\\) $message $scores message
268: if { $set == "all" } {
269: set all(homework.total) $scores
270: set all(setmax.homework.total) $setmax
271: }
272: }
273: foreach {path limit} {quiz quiz_count supp none others none correction \
274: final_exam_set_number exam final_exam_set_number} {
275: if {[catch {set gCapaConfig($num.[set path]_path)}]} {
276: continue
277: } else {
278: if { ![file exists $gCapaConfig($num.[set path]_path)] } { continue }
279: }
280: if { [catch {set setmax [set max $gCapaConfig($num.$limit)]}]} {
281: set max 99 ; set setmax 99
282: }
283: foreach {type call} {score getScores total getTotals} {
284: set exp {\$};append exp $path;append exp _$type
285: append exp {\(([0-9all\.,]*)\)}
286: while { [regexp $exp $message match set]} {
287: set scores [$call $set $stunum $section \
288: $gCapaConfig($num.[set path]_path) $max setmax]
289: set replacexp {\$};append replacexp $path;append replacexp _$type
290: append replacexp {\(};append replacexp $set;append replacexp {\)}
291: regsub -all -- $replacexp $message $scores message
292: if { $set == "all" } {
293: set all($path.$type) $scores
294: set all(setmax.$path.$type) $setmax
295: }
296: }
297: }
298: }
299: if { [regexp {\$grade} $message match] } {
300: #homework
301: foreach {type func} {score getScores total getTotals} {
302: if { [catch {set all(homework.$type)}]} {
303: if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} {
304: set max 99;set setmax 99
305: }
306: set all(homework.$type) [$func "all" $stunum $section $gFile($num) \
307: $max setmax]
308: # set all(setmax.homework.$type) $setmax
309: }
310: }
311: #quizzes
312: foreach {type func} {score getScores total getTotals} {
313: if { [catch {set all(quiz.$type)}]} {
314: if { [catch {set setmax [set max $gCapaConfig($num.quiz_count)]}]} {
315: set max 99;set setmax 99
316: }
317: set all(quiz.$type) [$func "all" $stunum $section \
318: $gCapaConfig($num.quiz_path) $max setmax]
319: # set all(setmax.quiz.$type) $setmax
320: }
321: }
322: #exams and final
323: if { [catch {set setmax [set max $gCapaConfig($num.final_exam_set_number)]}]} {
324: set max 99;set setmax 99
325: }
326: set finalset $setmax
327: set lastexam [expr $finalset - 1]
328: set totalexam 0
329: for { set i 1 } { $i <= $lastexam } { incr i } {
330: set exams [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
331: set examt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
332: set corrs [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
333: set corrt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
334: if { [catch {set exam [expr $exams/double($examt)]}] } { set exam 0 }
335: if { [catch {set corr [expr $corrs/double($corrt)]}] } { set corr 0 }
336: if { $corr > $exam } {
337: set totalexam [expr $totalexam + \
338: [expr $exam + $gCapaConfig($num.correction_weight) \
339: * ($corr - $exam)]]
340: } else {
341: set totalexam [expr $totalexam + $exam]
342: }
343: }
344: if { [catch {set totalexam [expr $totalexam / ($i-1)]}] } { set totalexam 0 }
345: set finals [getScores $finalset $stunum $section $gCapaConfig($num.exam_path)]
346: set finalt [getTotals $finalset $stunum $section $gCapaConfig($num.exam_path)]
347: if { [catch {set final [expr $finals/double($finalt)]}]} {set final 0}
348: if { [catch {set homework [expr $all(homework.score)/double($all(homework.total))]}] } { set homework 0 }
349: if { [catch {set quiz [expr $all(quiz.score)/double($all(quiz.total))]}] } { set quiz 0 }
350: set grade [expr $gCapaConfig($num.homework_weight)*$homework +\
351: $gCapaConfig($num.quiz_weight)*$quiz +\
352: $gCapaConfig($num.exam_weight)*$totalexam +\
353: $gCapaConfig($num.final_weight)*$final]
354: set grade [format "%2.1f" [expr $grade * 100 ]]
355: regsub -all -- \\\$grade $message $grade message
356: }
357: regexp "^Subject:(\[^\n]*)" $message garbage subject
358: regsub "^Subject:(\[^\n]*)" $message {} message
359: return $message
360: }
361:
362: proc emailSendMessage { num student message subject } {
363: global gCT gCapaConfig
364: exec echo $message | $gCapaConfig($num.mail_command) -s $subject [lindex $student 0]
365: }
366:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>