Return to groupemail.tcl CVS log

Up to [LON-CAPA] / capa / capa51 / GUITools

- 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: