Annotation of capa/capa51/GUITools/groupemail.tcl, revision 1.6

1.6     ! albertel    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 Library 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: #  Library General Public License for more details.
        !            13: #
        !            14: #  You should have received a copy of the GNU Library 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
1.1       albertel   25: proc runGroupEmail { capaConfigFile } {
1.2       albertel   26:     global gUniqueNumber gFile gWindowMenu gCT
1.1       albertel   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\""
1.4       albertel   35:     wm title $emailwin [file dirname $capaConfigFile]
1.2       albertel   36:     
                     37:     set fileFrame [frame $emailwin.file]
                     38:     set sentFrame [frame $emailwin.sent]
                     39:     set buttonFrame [frame $emailwin.button]
1.4       albertel   40:     pack $fileFrame $sentFrame $buttonFrame -side top -anchor w
1.2       albertel   41: 
                     42:     label $fileFrame.label -text "Mail Template:"
                     43:     entry $fileFrame.file -textvariable gCT($num.template)
                     44:     button $fileFrame.select -text "Browse" \
1.4       albertel   45: 	-command "set gCT($num.template) \[tk_getOpenFile\]"
1.2       albertel   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]
1.4       albertel   52:     #unpacked
1.2       albertel   53:     set scriptFrame [frame $sentFrame.script]
1.4       albertel   54:     pack $sentFrame.text $classFrame $sectionFrame $studentFrame -side top -anchor w
1.2       albertel   55:     
                     56:     #class
                     57:     radiobutton $classFrame.class -text "Whole Class" \
                     58: 	-variable gCT($num.emailtype) -value "Class"
                     59:     pack $classFrame.class
                     60: 
                     61:     #sections
1.4       albertel   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" \
1.2       albertel   68: 	-variable gCT($num.emailtype) -value "Sections"
1.4       albertel   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
1.2       albertel   73: 
1.4       albertel   74:     pack $top.button $top.select -side left -anchor w
                     75:     pack $bottom.spacer $bottom.sections -anchor w -side left
                     76:     
1.2       albertel   77:     #student
1.5       albertel   78:     radiobutton $studentFrame.specific -text "Students from file:" \
1.2       albertel   79: 	    -value "Specific" -variable gCT($num.emailtype)
1.5       albertel   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
1.2       albertel   84: 
                     85:     #script
1.4       albertel   86:     radiobutton $scriptFrame.label -text "Script Selection:" -value "Script" \
                     87: 	-variable gCT($num.emailtype)
                     88:     entry $scriptFrame.file -textvariable gCT($num.emailscript)
1.2       albertel   89:     button $scriptFrame.select -text "Browse" \
1.5       albertel   90: 	-command "set gCT($num.emailscript) \[tk_getOpenFile\]"
1.2       albertel   91:     pack $scriptFrame.label $scriptFrame.file $scriptFrame.select -side left
                     92: 
                     93:     button $buttonFrame.send -text "Send" -command "emailSend $num"
1.4       albertel   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: 
1.5       albertel  100: proc emailClose { num } {
                    101:     global gFile
                    102:     destroy .email$num
                    103:     removeWindowEntry "Sending Email $gFile($num)"
                    104: }
                    105: 
1.4       albertel  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:     }
1.2       albertel  116: }
                    117: 
                    118: proc emailSend { num } {
                    119:     global gCT gFile
                    120: 
1.4       albertel  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: 
1.2       albertel  128:     if { "Cancel" == [emailConfirm $num]} { return }
                    129:     emailGetStudents $num
                    130: 
1.4       albertel  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
1.2       albertel  136: #	foreach {email firstname lastname stunum} $student {break}
1.5       albertel  137: 	set subject ""
                    138: 	set message [emailMessage $num $student subject]
                    139: 	emailSendMessage $num $student $message $subject
1.4       albertel  140: 	updateStatusBar [expr $i/double($max)] $num
1.2       albertel  141:     }
1.4       albertel  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)." }
1.5       albertel  151: 	Specific { append msg " to the student numbers in $gCT($num.studentlist)." }
1.4       albertel  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"
1.3       albertel  161: }
                    162: 
                    163: proc emailGetStudents { num } {
                    164:     global gCT gFile
1.4       albertel  165: 
                    166:     switch $gCT($num.emailtype) {
1.3       albertel  167: 	Class { emailGetClass $num }
1.4       albertel  168:   	Sections { emailGetSections $num }
1.5       albertel  169: 	Specific { emailGetSpecific $num }
1.3       albertel  170: 	Script { }
                    171:     }
                    172: }
                    173: 
                    174: proc emailGetClass { num } {
                    175:     global gCT gFile
                    176:     set classlid [open [file join $gFile($num) classl] r]
1.4       albertel  177: 
1.3       albertel  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:     }
1.4       albertel  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: 
1.5       albertel  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 classlid [open [file join $gFile($num) classl] r]
                    220:     set aline [gets $classlid]
                    221:     while { ![eof $classlid] } {
                    222: 	set stunum [string trim [string range $aline 14 22]]
                    223: 	if { [lsearch $allids $stunum] !=-1 } {
                    224: 	    set section [string trimleft [string trim [string range $aline 10 12]] "0"]
                    225: 	    set email [string trim [string range $aline 60 99]]
                    226: 	    set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
                    227: 	    set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
                    228: 	    set section [string trimleft [string trim [string range $aline 10 12] ] 0]
                    229: 	    lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
                    230: 	}
                    231: 	set aline [gets $classlid]
                    232:     }
                    233: }
                    234: 
                    235: proc emailMessage { num student subjectVar } {
1.4       albertel  236:     global gCT gFile gCapaConfig
1.5       albertel  237:     upvar $subjectVar subject
1.4       albertel  238:     set message $gCT($num.message)
                    239: 
                    240:     regsub -all -- \\\$email $message [lindex $student 0] message
                    241:     regsub -all -- \\\$first_name $message [lindex $student 1] message
                    242:     regsub -all -- \\\$last_name $message [lindex $student 2] message
                    243:     regsub -all -- \\\$student_number $message [lindex $student 3] message
                    244:     set stunum [lindex $student 3]
                    245:     set section [lindex $student 4]
                    246:     while { [regexp {\$capaid\(([0-9all\.,]*)\)} $message match set] } {
                    247: 	set capaid [getCapaID $set $stunum $section $gFile($num)]
                    248: 	regsub -all -- \\\$capaid\\\($set\\\) $message $capaid message
                    249:     }
                    250:     while { [regexp {\$homework_score\(([0-9all\.,]*)\)} $message match set] } {
                    251: 	if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
                    252: 	    set max 99;set setmax 99
                    253: 	}
                    254: 	set scores [getScores $set $stunum $section $gFile($num) $max setmax]
                    255: 	regsub -all -- \\\$homework_score\\\($set\\\) $message $scores message
                    256: 	if { $set == "all" } { 
                    257: 	    set all(homework.score) $scores
                    258: 	    set all(setmax.homework.score) $setmax
                    259: 	}
                    260:     }
                    261:     while { [regexp {\$homework_total\(([0-9all\.,]*)\)} $message match set] } {
                    262: 	if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
                    263: 	    set max 99;set setmax 99
                    264: 	}
                    265: 	set scores [getTotals $set $stunum $section $gFile($num) $max setmax]
                    266: 	regsub -all -- \\\$homework_total\\\($set\\\) $message $scores message
                    267: 	if { $set == "all" } { 
                    268: 	    set all(homework.total) $scores 
                    269: 	    set all(setmax.homework.total) $setmax
                    270: 	}
                    271:     }
                    272:     foreach {path limit} {quiz quiz_count supp none others none correction \
                    273: 			      final_exam_set_number exam final_exam_set_number} {
                    274: 	if {[catch {set gCapaConfig($num.[set path]_path)}]} {
                    275: 	    continue
                    276: 	} else {
                    277: 	    if { ![file exists $gCapaConfig($num.[set path]_path)] } { continue }
                    278: 	}
                    279: 	if { [catch {set setmax [set max $gCapaConfig($num.$limit)]}]} { 
                    280: 	    set max 99 ; set setmax 99
                    281: 	}
                    282: 	foreach {type call} {score getScores total getTotals} {
                    283: 	    set exp {\$};append exp $path;append exp _$type
                    284: 	    append exp {\(([0-9all\.,]*)\)}
                    285: 	    while { [regexp $exp $message match set]} {
                    286: 		set scores [$call $set $stunum $section \
                    287: 				$gCapaConfig($num.[set path]_path) $max setmax]
                    288: 		set replacexp {\$};append replacexp $path;append replacexp _$type
                    289: 		append replacexp {\(};append replacexp $set;append replacexp {\)}
                    290: 		regsub -all -- $replacexp $message $scores message
                    291: 		if { $set == "all" } { 
                    292: 		    set all($path.$type) $scores 
                    293: 		    set all(setmax.$path.$type) $setmax
                    294: 		}
                    295: 	    }
                    296: 	}
                    297:     }
                    298:     if { [regexp {\$grade} $message match] } {
                    299: 	#homework
                    300: 	foreach {type func} {score getScores total getTotals} {
                    301: 	    if { [catch {set all(homework.$type)}]} {
                    302: 		if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
                    303: 		    set max 99;set setmax 99
                    304: 		}
                    305: 		set all(homework.$type) [$func "all" $stunum $section $gFile($num) \
                    306: 					     $max setmax]
                    307: #		set all(setmax.homework.$type) $setmax
                    308: 	    }
                    309: 	}
                    310: 	#quizzes
                    311: 	foreach {type func} {score getScores total getTotals} {
                    312: 	    if { [catch {set all(quiz.$type)}]} {
                    313: 		if { [catch {set setmax [set max $gCapaConfig($num.quiz_count)]}]} { 
                    314: 		    set max 99;set setmax 99
                    315: 		}
                    316: 		set all(quiz.$type) [$func "all" $stunum $section  \
                    317: 					 $gCapaConfig($num.quiz_path) $max setmax]
                    318: #		set all(setmax.quiz.$type) $setmax
                    319: 	    }
                    320: 	}
                    321: 	#exams and final
                    322: 	if { [catch {set setmax [set max $gCapaConfig($num.final_exam_set_number)]}]} { 
                    323: 	    set max 99;set setmax 99
                    324: 	}
                    325: 	set finalset $setmax
                    326: 	set lastexam [expr $finalset - 1]
                    327: 	set totalexam 0
                    328: 	for { set i 1 } { $i <= $lastexam } { incr i } {
                    329: 	    set exams [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
                    330: 	    set examt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
                    331: 	    set corrs [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
                    332: 	    set corrt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
1.5       albertel  333: 	    if { [catch {set exam [expr $exams/double($examt)]}] } { set exam 0 }
                    334: 	    if { [catch {set corr [expr $corrs/double($corrt)]}] } { set corr 0 }
1.4       albertel  335: 	    if { $corr > $exam } {
                    336: 		set totalexam [expr $totalexam + \
                    337: 				   [expr $exam + $gCapaConfig($num.correction_weight) \
                    338: 					* ($corr - $exam)]]
                    339: 	    } else {
                    340: 		set totalexam [expr $totalexam + $exam]
                    341: 	    }
                    342: 	}
1.5       albertel  343: 	if { [catch {set totalexam [expr $totalexam / ($i-1)]}] } { set totalexam 0 }
1.4       albertel  344: 	set finals [getScores $finalset $stunum $section $gCapaConfig($num.exam_path)]
                    345: 	set finalt [getTotals $finalset $stunum $section $gCapaConfig($num.exam_path)]
1.5       albertel  346: 	if { [catch {set final [expr $finals/double($finalt)]}]} {set final 0}
                    347: 	if { [catch {set homework [expr $all(homework.score)/double($all(homework.total))]}] } { set homework 0 }
                    348: 	if { [catch {set quiz [expr $all(quiz.score)/double($all(quiz.total))]}] } { set quiz 0 }
1.4       albertel  349: 	set grade [expr $gCapaConfig($num.homework_weight)*$homework +\
                    350: 		       $gCapaConfig($num.quiz_weight)*$quiz +\
                    351: 		       $gCapaConfig($num.exam_weight)*$totalexam +\
                    352: 		       $gCapaConfig($num.final_weight)*$final]
                    353: 	set grade [format "%2.1f" [expr $grade * 100 ]]
                    354: 	regsub -all -- \\\$grade $message $grade message
                    355:     }
1.5       albertel  356:     regexp "^Subject:(\[^\n]*)" $message garbage subject
                    357:     regsub "^Subject:(\[^\n]*)" $message {} message
1.4       albertel  358:     return $message
                    359: }
                    360: 
1.5       albertel  361: proc emailSendMessage { num student message subject } {
1.4       albertel  362:     global gCT gCapaConfig
1.5       albertel  363:     exec echo $message | $gCapaConfig($num.mail_command) -s $subject [lindex $student 0]
1.4       albertel  364: }
                    365: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>