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: 

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.