Return to printstudent.1.2.tcl CVS log

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

- fixed license notices the reference the GNU GPL rather than the GNU LGPL

#!/usr/local/bin/tclsh7.6
# Script to print a single student's assignment
#  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.

# By G. Albertelli II 1998

proc clearScreen {} {
    puts "\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n"
}
clearScreen
puts "CAPA Printing script Ver 1.2"
after 1000

proc class { classname path args } {
    global classList
    set classList($classname.path) $path
    set classList($classname.sets) $args
}

proc config { var value args } {
    global config
    set config($var) $value
}

proc getSettings { classListVar configVar } {
    upvar $classListVar classList
    upvar $configVar config
    source printstudent.settings
}

proc saveSettings { } {
    global classList config
    if { [ catch { set fileId [open printstudent.settings "w"] } ] } {
	puts "Unable to save settings. Please contact CAPA adminstrator."
	quit "UnableToSaveSettings"
    }
    puts $fileId "# Settings file for printstudent.tcl\n#\n# set up the configuration options\n#\n# the used values are qzparse_command, latex_command, dvips_command, and\n# lpr_command\n\n"
    foreach value [array names config] {
	puts $fileId "config $value \t\"$config($value)\""
    }

    puts $fileId "\n# List of classes, their path, and the sets that can be printed"
    set validClass ""
    foreach name [array names classList] {
	if { ! [string match *.path $name] } { 
	    lappend validClass [lindex [split $name .] 0]
	}
    }
    set validClass [ lsort $validClass]
    foreach class $validClass {
	puts $fileId "class $class  $classList($class.path) \t$classList($class.sets)"
    }
    close $fileId
}

proc getStringFromList { validStrings } {
    gets file0 aline
    set error [catch {set try [lindex $aline 0] } ]
    if { $error } { return "" }
    set found false
    foreach valid $validStrings {
	set valid [string tolower $valid]
	set try [ string tolower [ string trim $try ] ]
	if { $valid == $try } {
	    set found true
	    break
	}
    }
    if { $found } {
	return $try
    } else {
	return ""
    }
}

proc addClass { classVar } {
    upvar $classVar class
    
    clearScreen
    puts "Enter \"quit\" at any time to stop adding a class."
    set done 0
    while { ! $done } {
	puts -nonewline "Please enter the name of the class you wish to add:"
	flush file1
	gets file0 aline
	set class [lindex $aline 0]
	if { $class == "quit" } { return quit }
	puts "You entered $class, is this name correct? (y or n)"
        set finished [getStringFromList "yes y Y quit"]
	if { $finished == "quit" } { return quit }
	if { $finished != "" } { set done 1 }
    }
    set done 0
    while { ! $done } {
	puts -nonewline "Please enter the path of $class:"
	flush file1
	gets file0 aline
	set path [lindex $aline 0]
	if { $path == "quit" } { return quit }
	puts "You entered $path, is this path correct? (y or n)"
        set finished [getStringFromList "yes y Y quit"]
	if { $finished == "quit" } { return quit }
	if { $finished != "" } { set done 1 }
    }
    set done 0
    while { ! $done } {
	puts "Please enter a space seperated list of valid set numbers for $class:"
	gets file0 aline
	set sets $aline
	if { $sets == "quit" } { return quit }
	puts "You entered $sets, is this list correct? (y or n)"
        set finished [getStringFromList "yes y Y quit"]
	if { $finished == "quit" } { return quit }
	if { $finished != "" } { set done 1 }
    }
    global classList
    set classList($class.sets) $sets
    set classList($class.path) $path
    saveSettings
    global machine
    logInformation Added $class $path "$sets" $machine
    set class ""
}

proc removeClass { classListVar classVar } {
    upvar $classListVar classList
    upvar $classVar class

    clearScreen
    set done 0
    while { ! $done } {
	set validClass ""
	foreach name [array names classList] {
	    if { ! [string match *.path $name] } { 
		lappend validClass [lindex [split $name .] 0]
	    }
	}
	set validClass [ lsort $validClass]
	puts "Valid classnames are: $validClass"
	puts "Enter \"quit\" to stop removing a class."
	puts -nonewline "Enter class name to remove:"
	flush file1
	set class [getStringFromList [concat $validClass quit] ]
	if { $class == "quit" } { 
	    set class ""
	    return
	}
	if { $class != "" } { 
	    puts "You entered $class, are you sure you wish to remove this class? (y or n)"
	    set finished [getStringFromList "yes y Y quit"]
	    if { $finished == "quit" } { return quit }
	    if { $finished != "" } { set done 1 }
	} else { 
	    puts "Invalid classname"
	}
    }
    if { $done } {
	global classList 
	global machine
	logInformation Removed $class $classList($class.path) "$classList($class.sets)" $machine
	catch { unset classList($class.path) }
	catch { unset classList($class.sets) }
	saveSettings
    }
    set class ""
}

proc getClass { classListVar classVar } {
    upvar $classListVar classList
    upvar $classVar class

    clearScreen
    set done 0
    while { ! $done } {
	set validClass ""
	foreach name [array names classList] {
	    if { ! [string match *.path $name] } { 
		lappend validClass [lindex [split $name .] 0]
	    }
	}
	set validClass [ lsort $validClass]
	puts "Valid classnames are: [lindex $validClass 0]"
	foreach otherClass [lrange $validClass 1 end] {
	    puts "                      $otherClass"
	}
	puts "Other commands available: new remove restart quit"
	puts -nonewline "Enter class name to print:"
	flush file1
	set class [getStringFromList \
		[concat $validClass new remove quit restart] ]
	if       { $class == "new"     } { addClass class 
	                                   clearScreen
	} elseif { $class == "remove"  } { removeClass classList class 
                                           clearScreen
	} elseif { $class == "quit"    } { quit "ClassEarlyOut" 
	} elseif { $class == "restart" } { return restart 
	} elseif { $class != ""        } { set done 1
	} else   {                         puts "Invalid classname"
	}
    }
}

proc addSet { class setVar } {
    upvar $setVar setWanted
    global classList 

    clearScreen
    set done 0
    puts "Enter \"quit\" at any time to stop changing set availability."
    while { ! $done } {
	puts "Please enter a space seperated list of valid set numbers for $class:"
	gets file0 aline
	set sets $aline
	if { $sets == "quit" } { return quit }
	puts -nonewline "You entered $sets, which would have $class have set(s) $sets available, rather than set(s) $classList($class.sets).\n Is this correct? (y or n)"
	flush file1
        set finished [getStringFromList "yes y Y quit"]
	if { $finished == "quit" } { return quit }
	if { $finished != "" } { set done 1 }
    }
    global classList
    global machine
    logInformation ChangedSets $class $classList($class.path) "\"$classList($class.sets)\" to \"$sets\"" $machine
    set classList($class.sets) $sets
    saveSettings
    return ""
}
    
proc getSet { classListVar class setVar } {
    upvar $classListVar classList
    upvar $setVar setWanted

    clearScreen
    set done 0
    while { ! $done } {
	puts "Valid set numbers for $class are: $classList($class.sets) "
	puts "Other commands available: new restart quit"
	puts -nonewline "Enter set number to print:"
	flush file1
	set setWanted [getStringFromList \
		[concat $classList($class.sets) new quit restart] ]
	if       { $setWanted == "new"     } { addSet $class setWanted 
                                               clearScreen
        } elseif { $setWanted == "quit"    } { quit "SetEarlyOut" 
	} elseif { $setWanted == "restart" } { return restart 
        } elseif { $setWanted != ""        } { set done 1
	} else   {                             puts "Invalid setnumber."
	}
    }
}

proc getStudentInfo { studentNumberVar } {
    upvar $studentNumberVar studentNumber
    global class set

    puts "Other commands available: restart quit"
    puts -nonewline "For class: $class, set $set, enter student number:"
    flush file1
    gets file0 aline
    catch { set studentNumber [lindex $aline 0]}
    if { $studentNumber == "quit" } { quit "StudentInfoEarlyOut" }
    if { $studentNumber == "restart" } { return restart }
}

proc verifyStudent { class set studentNumber } {
    if { [ catch { set fileId [open $class/classl "r" ] } ] } {
	puts "Unable to find a classl file. This class may not be ready for printing right now."
	quit "UnableToAccesClassl"
    }
    set result 0
    while { 1 } {
	gets $fileId aline
	if { [eof $fileId] } { break }
	if { [string tolower $studentNumber] == [string tolower [ string range $aline 14 22] ] } {
	    set result 1
	    break
	}
    }
    close $fileId
    return $result
}

proc printSet { class set studentnumber configVar } {
    upvar $configVar config
    
    puts "Parsing Set"
    if { [catch { eval "exec $config(qzparse_command) -c $class -Set $set -Stu $studentnumber -o [pwd]/printstudent.[pid].tex " } errorMsg ] } {
	puts "Unable to prepare tex file: $errorMsg"
	return failed
    } 
    puts "Creating Set description"
    if { [catch { eval "exec $config(latex_command) ./printstudent.[pid].tex < /dev/null " } errorMsg ] } {
	puts "Unable to prepare dvi file: $errorMsg"
	return failed
    }
    puts "Creating postscript file"
    if { [ catch { eval "exec $config(dvips_command) -o ./printstudent.[pid].ps ./printstudent.[pid].dvi < /dev/null >& /dev/null " } errorMsg ] } {
	puts "Unable to prepare ps file: $errorMsg"
	return failed
    }
    puts "Sending file to printer"
    if { [ catch { eval "exec $config(lpr_command) ./printstudent.[pid].ps < /dev/null " } errorMsg ] } {
	puts "Unable to print ps file: $errorMsg"
	return failed
    }
    return success
}

proc logInformation { result class set student args } {
    set fileId [open "printstudent.log" "a"]
    puts $fileId "$result $class $set $student $args [clock format [clock seconds] -format %m/%d/%Y-%H:%M:%S ]"
    close $fileId
}

proc cleanup {} {
    exec rm -f ./printstudent.[pid].ps ./printstudent.[pid].dvi ./printstudent.[pid].tex ./printstudent.[pid].aux ./printstudent.[pid].log
}

proc goAgain {} {
    puts "Would you like to print another assignment (y or n) ?"
    set setWanted [getStringFromList "yes y Y quit"]
    if { $setWanted != "" } { 	return 1
    } else { 	return 0
    }
}

proc quit { args } {
    global class set studentnumber machine
    logInformation $args $class $set $studentnumber $machine
    exit
}

set another 1
set class "unknown"
set set "unknown"
set studentnumber "unknown"
if { [ catch { set machine [lindex [exec /usr/bin/who -mM ] end ] } ] } {
    set machine "UnableToRunWho"
}

while { $another } {
    getSettings classList config
    if { "restart" == [getClass classList class] } { continue }
    if { "restart" == [getSet classList $class set] } { continue }
    clearScreen
    set done 0
    while { ! $done } {
	if { "restart" == [getStudentInfo studentnumber] } { 
	    set studentnumber restart
	    break
	}
	if { ! [set done [verifyStudent $classList($class.path) \
		$set $studentnumber] ] } {
	    puts "Student number: $studentnumber, does not appear to belong in the class- $class."
	    logInformation "NotFound" $class $set $studentnumber $machine
	}
    }
    if { $studentnumber == "restart" } { continue }
    logInformation [printSet $classList($class.path) $set \
	    $studentnumber config] $class $set $studentnumber $machine
    cleanup
    set another [goAgain]
}