Return to groupemail.tcl CVS log

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

- saved email to email.list

# allow mass emailing to students
#  Copyright (C) 1992-2000 Michigan State University
#
#  The CAPA system is free software; you can redistribute it and/or
#  modify it under the terms of the GNU General Public License as
#  published by the Free Software Foundation; either version 2 of the
#  License, or (at your option) any later version.
#
#  The CAPA system is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
#  General Public License for more details.
#
#  You should have received a copy of the GNU General Public
#  License along with the CAPA system; see the file COPYING.  If not,
#  write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
#  Boston, MA 02111-1307, USA.
#
#  As a special exception, you have permission to link this program
#  with the TtH/TtM library and distribute executables, as long as you
#  follow the requirements of the GNU GPL in regard to all of the
#  software in the executable aside from TtH/TtM.

#Created 2000 by Guy Albertelli
proc runGroupEmail { capaConfigFile } {
    global gUniqueNumber gFile gWindowMenu gCT
    set num [incr gUniqueNumber]
    set gFile($num) [file dirname $capaConfigFile]
    parseCapaConfig $num $gFile($num)
    parseCapaUtilsConfig $num $gFile($num)
    
    set emailwin [toplevel .email$num]
    $gWindowMenu add command -label "Sending Email $gFile($num)" \
	-command "capaRaise \"$emailwin\""
    wm title $emailwin [file dirname $capaConfigFile]
    
    set fileFrame [frame $emailwin.file]
    set sentFrame [frame $emailwin.sent]
    set buttonFrame [frame $emailwin.button]
    pack $fileFrame $sentFrame $buttonFrame -side top -anchor w

    label $fileFrame.label -text "Mail Template:"
    entry $fileFrame.file -textvariable gCT($num.template)
    button $fileFrame.select -text "Browse" \
	-command "set gCT($num.template) \[tk_getOpenFile\]"
    pack $fileFrame.label $fileFrame.file $fileFrame.select -side left
    
    label $sentFrame.text -text "Send To:"
    set classFrame [frame $sentFrame.class]
    set sectionFrame [frame $sentFrame.section]
    set studentFrame [frame $sentFrame.student]
    #unpacked
    set scriptFrame [frame $sentFrame.script]
    pack $sentFrame.text $classFrame $sectionFrame $studentFrame -side top -anchor w
    
    #class
    radiobutton $classFrame.class -text "Whole Class" \
	-variable gCT($num.emailtype) -value "Class"
    pack $classFrame.class

    #sections
    set gCT($num.emailsections) "None"
    set top [frame $sectionFrame.top]
    set bottom [frame $sectionFrame.bottom]
    pack $top $bottom -side top -anchor w

    radiobutton $top.button -text "Sections" \
	-variable gCT($num.emailtype) -value "Sections"
    button $top.select -text "Select Section" -command "emailSelectSections $num"
    message $bottom.sections -textvariable gCT($num.emailsections) \
	-relief groove -width 350
    frame $bottom.spacer -width 20

    pack $top.button $top.select -side left -anchor w
    pack $bottom.spacer $bottom.sections -anchor w -side left
    
    #student
    radiobutton $studentFrame.specific -text "Students from file:" \
	    -value "Specific" -variable gCT($num.emailtype)
    entry $studentFrame.file -textvariable gCT($num.studentlist)
    button $studentFrame.select -text "Browse" \
	-command "set gCT($num.studentlist) \[tk_getOpenFile\]"
    pack $studentFrame.specific $studentFrame.file $studentFrame.select -side left

    #script
    radiobutton $scriptFrame.label -text "Script Selection:" -value "Script" \
	-variable gCT($num.emailtype)
    entry $scriptFrame.file -textvariable gCT($num.emailscript)
    button $scriptFrame.select -text "Browse" \
	-command "set gCT($num.emailscript) \[tk_getOpenFile\]"
    pack $scriptFrame.label $scriptFrame.file $scriptFrame.select -side left

    button $buttonFrame.send -text "Send" -command "emailSend $num"
    frame $buttonFrame.spacer -width 100
    button $buttonFrame.cancel -text "Close" -command "emailClose $num"
    pack $buttonFrame.send $buttonFrame.spacer $buttonFrame.cancel -side left
    Centre_Dialog $emailwin default
}

proc emailClose { num } {
    global gFile
    destroy .email$num
    removeWindowEntry "Sending Email $gFile($num)"
}

proc emailSelectSections { num } {
    global gCT gFile
    set pwd [pwd]; cd $gFile($num)
    set gCT($num.emailsections) [string trim [pickSections [getExistingSections] "Select Sections to send an email to:"]]
    cd $pwd
    if { $gCT($num.emailsections) != "" } { 
	set gCT($num.emailtype) Sections 
    } else {
	set gCT($num.emailsections) "None"
    }
}

proc emailSend { num } {
    global gCT gFile

    if { [catch {set fileId [open $gCT($num.template) r]}]} {
	displayMessage "Unable to open $gCT($num.template)"
	return
    }
    set gCT($num.message) [read $fileId [file size $gCT($num.template)]]
    close $fileId

    if { "Cancel" == [emailConfirm $num]} { return }
    emailGetStudents $num

    set max [llength $gCT($num.studentlist)]
    set i 0
    displayStatus "Sending Messages" both $num
    foreach student $gCT($num.studentlist) {
	incr i
#	foreach {email firstname lastname stunum} $student {break}
	set subject ""
	set message [emailMessage $num $student subject]
	emailSendMessage $num $student $message $subject
	updateStatusBar [expr $i/double($max)] $num
    }
    removeStatus $num
}

proc emailConfirm { num } {
    global gCT
    set msg "The message in $gCT($num.template) will be sent to"
    switch $gCT($num.emailtype) {
	Class { append msg " the whole class." }
	Sections { append msg " the sections $gCT($num.emailsections)." }
	Specific { append msg " to the student numbers in $gCT($num.studentlist)." }
	Script { 
	    append msg " to the students generated by the script $gCT($num.emailscript)."
	}
    }
    append msg "\n\n Continue?"
    if { "Yes" == [makeSure $msg]} {
	return "Yes"
    } 
    return "Cancel"
}

proc emailGetStudents { num } {
    global gCT gFile

    switch $gCT($num.emailtype) {
	Class { emailGetClass $num }
  	Sections { emailGetSections $num }
	Specific { emailGetSpecific $num }
	Script { }
    }
}

proc emailGetClass { num } {
    global gCT gFile
    set classlid [open [file join $gFile($num) classl] r]

    set aline [gets $classlid]
    while { ![eof $classlid] } {
	set email [string trim [string range $aline 60 99]]
	set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
	set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
	set stunum [string trim [string range $aline 14 22]]
	lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum]
	set aline [gets $classlid]
    }
}

proc emailGetSections { num } {
    global gCT  gFile
    set classlid [open [file join $gFile($num) classl] r]

    set aline [gets $classlid]
    while { ![eof $classlid] } {
	set section [string trimleft [string trim [string range $aline 10 12]] "0"]
	if { [lsearch $gCT($num.emailsections) $section] == -1 } {
	    set aline [gets $classlid]
	    continue
	}
	set email [string trim [string range $aline 60 99]]
	set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
	set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
	set stunum [string trim [string range $aline 14 22]]
	set section [string trimleft [string trim [string range $aline 10 12] ] 0]
	lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
	set aline [gets $classlid]
    }
}

proc emailGetSpecific { num } {
    global gCT gFile
    
    set fileId [open $gCT($num.studentlist)]
    set temp [split [read $fileId] "\n"]
    set allids ""
    foreach element $temp { if { $element != "" } { lappend allids $element } }
    close $fileId
#    puts $allids
    set gCT($num.studentlist) ""
    set classlid [open [file join $gFile($num) classl] r]
    set aline [gets $classlid]
    while { ![eof $classlid] } {
	set stunum [string trim [string range $aline 14 22]]
	if { [lsearch $allids $stunum] !=-1 } {
	    set section [string trimleft [string trim [string range $aline 10 12]] "0"]
	    set email [string trim [string range $aline 60 99]]
	    set firstname [string trim [lindex [lindex [split [string range $aline 24 59] ","] 1] 0]]
	    set lastname [string trim [lindex [split [string range $aline 24 59] ","] 0]]
	    set section [string trimleft [string trim [string range $aline 10 12] ] 0]
	    lappend gCT($num.studentlist) [list $email $firstname $lastname $stunum $section]
	}
	set aline [gets $classlid]
    }
}

proc emailMessage { num student subjectVar } {
    global gCT gFile gCapaConfig
    upvar $subjectVar subject
    set message $gCT($num.message)

    regsub -all -- \\\$email $message [lindex $student 0] message
    regsub -all -- \\\$first_name $message [lindex $student 1] message
    regsub -all -- \\\$last_name $message [lindex $student 2] message
    regsub -all -- \\\$student_number $message [lindex $student 3] message
    set stunum [lindex $student 3]
    set section [lindex $student 4]
    while { [regexp {\$capaid\(([0-9all\.,]*)\)} $message match set] } {
	set capaid [getCapaID $set $stunum $section $gFile($num)]
	regsub -all -- \\\$capaid\\\($set\\\) $message $capaid message
    }
    while { [regexp {\$homework_score\(([0-9all\.,]*)\)} $message match set] } {
	if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
	    set max 99;set setmax 99
	}
	set scores [getScores $set $stunum $section $gFile($num) $max setmax]
	regsub -all -- \\\$homework_score\\\($set\\\) $message $scores message
	if { $set == "all" } { 
	    set all(homework.score) $scores
	    set all(setmax.homework.score) $setmax
	}
    }
    while { [regexp {\$homework_total\(([0-9all\.,]*)\)} $message match set] } {
	if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
	    set max 99;set setmax 99
	}
	set scores [getTotals $set $stunum $section $gFile($num) $max setmax]
	regsub -all -- \\\$homework_total\\\($set\\\) $message $scores message
	if { $set == "all" } { 
	    set all(homework.total) $scores 
	    set all(setmax.homework.total) $setmax
	}
    }
    foreach {path limit} {quiz quiz_count supp none others none correction \
			      final_exam_set_number exam final_exam_set_number} {
	if {[catch {set gCapaConfig($num.[set path]_path)}]} {
	    continue
	} else {
	    if { ![file exists $gCapaConfig($num.[set path]_path)] } { continue }
	}
	if { [catch {set setmax [set max $gCapaConfig($num.$limit)]}]} { 
	    set max 99 ; set setmax 99
	}
	foreach {type call} {score getScores total getTotals} {
	    set exp {\$};append exp $path;append exp _$type
	    append exp {\(([0-9all\.,]*)\)}
	    while { [regexp $exp $message match set]} {
		set scores [$call $set $stunum $section \
				$gCapaConfig($num.[set path]_path) $max setmax]
		set replacexp {\$};append replacexp $path;append replacexp _$type
		append replacexp {\(};append replacexp $set;append replacexp {\)}
		regsub -all -- $replacexp $message $scores message
		if { $set == "all" } { 
		    set all($path.$type) $scores 
		    set all(setmax.$path.$type) $setmax
		}
	    }
	}
    }
    if { [regexp {\$grade} $message match] } {
	#homework
	foreach {type func} {score getScores total getTotals} {
	    if { [catch {set all(homework.$type)}]} {
		if { [catch {set setmax [set max $gCapaConfig($num.homework_count)]}]} { 
		    set max 99;set setmax 99
		}
		set all(homework.$type) [$func "all" $stunum $section $gFile($num) \
					     $max setmax]
#		set all(setmax.homework.$type) $setmax
	    }
	}
	#quizzes
	foreach {type func} {score getScores total getTotals} {
	    if { [catch {set all(quiz.$type)}]} {
		if { [catch {set setmax [set max $gCapaConfig($num.quiz_count)]}]} { 
		    set max 99;set setmax 99
		}
		set all(quiz.$type) [$func "all" $stunum $section  \
					 $gCapaConfig($num.quiz_path) $max setmax]
#		set all(setmax.quiz.$type) $setmax
	    }
	}
	#exams and final
	if { [catch {set setmax [set max $gCapaConfig($num.final_exam_set_number)]}]} { 
	    set max 99;set setmax 99
	}
	set finalset $setmax
	set lastexam [expr $finalset - 1]
	set totalexam 0
	for { set i 1 } { $i <= $lastexam } { incr i } {
	    set exams [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
	    set examt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
	    set corrs [getScores $i $stunum $section $gCapaConfig($num.exam_path)]
	    set corrt [getTotals $i $stunum $section $gCapaConfig($num.exam_path)]
	    if { [catch {set exam [expr $exams/double($examt)]}] } { set exam 0 }
	    if { [catch {set corr [expr $corrs/double($corrt)]}] } { set corr 0 }
	    if { $corr > $exam } {
		set totalexam [expr $totalexam + \
				   [expr $exam + $gCapaConfig($num.correction_weight) \
					* ($corr - $exam)]]
	    } else {
		set totalexam [expr $totalexam + $exam]
	    }
	}
	if { [catch {set totalexam [expr $totalexam / ($i-1)]}] } { set totalexam 0 }
	set finals [getScores $finalset $stunum $section $gCapaConfig($num.exam_path)]
	set finalt [getTotals $finalset $stunum $section $gCapaConfig($num.exam_path)]
	if { [catch {set final [expr $finals/double($finalt)]}]} {set final 0}
	if { [catch {set homework [expr $all(homework.score)/double($all(homework.total))]}] } { set homework 0 }
	if { [catch {set quiz [expr $all(quiz.score)/double($all(quiz.total))]}] } { set quiz 0 }
	set grade [expr $gCapaConfig($num.homework_weight)*$homework +\
		       $gCapaConfig($num.quiz_weight)*$quiz +\
		       $gCapaConfig($num.exam_weight)*$totalexam +\
		       $gCapaConfig($num.final_weight)*$final]
	set grade [format "%2.1f" [expr $grade * 100 ]]
	regsub -all -- \\\$grade $message $grade message
    }
    regexp "^Subject:(\[^\n]*)" $message garbage subject
    regsub "^Subject:(\[^\n]*)" $message {} message
    return $message
}

proc emailSendMessage { num student message subject } {
    global gCT gCapaConfig
    exec echo $message | $gCapaConfig($num.mail_command) -s $subject [lindex $student 0]
}

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.