Lösung zu Blatt 5 --- Implementierung kleiner Datenbanken unter UNIX (SS 2001)

5 Speichert die Punkte

#!/usr/local/bin/tclsh

# Usage: insert.tcl <blattnr> <student> <punkte>
# login:kl,100:1,10:2,20:3,10:4,10:5,20:6,20

set DB "~/vorlesung/5/punkte"
set TEMP "~/vorlesung/5/temp_punkte"
# Number of Arguments correct?
if { $argc != 3 } {
   puts stderr "Wrong number of arguments! "
   puts stderr "Usage: $argv0 <blattnr> <student> <punkte>"
   exit 1
}
set blattnr [lindex $argv 0]
set student [lindex $argv 1]
set punkte [lindex $argv 2]
# -1 Pkt. bei der Klausur als nicht mitgeschrieben erlaubt.
if { $punkte < -1 || $punkte < 0 && ![string match kl $blattnr] } {
   puts stderr "Wenigstens 0 Punkte hat er schon verdient :-)"
   exit 1
}
# Argument seems to be correct, check if existing and open DB
set f [open $DB r]
set f_out [open $TEMP w]
# Immer bis zum ersten Doppelpunkt abhacken
set seastr {^([^:]*):?(.*$)}
gets $f header
puts $f_out $header
set pos 0
# Get position of login name and maximum number of points
while { [string length $header] > 0} {
   regexp $seastr $header match hit header
   if { [string match $hit login] } {
      set loginpos $pos
      set order [lappend order login]
   } elseif { [regexp {^kl,([0-9]+)$} $hit match max] } {
      set points(kl) $max
      set order [lappend order kl]
   } else {
      regexp {^([0-9]+),([0-9]+)$} $hit match nr max
      set points($nr) $max
      set order [lappend order $nr]
   }
   incr pos
}
if { ![ info exists points($blattnr) ] } {
   puts stderr "Das Blatt $blattnr gibt es gar nicht"
   exit 1
}
while { [gets $f nextline] >= 0} {
   set namecheck $nextline
   # Check login name
   for { set i 0 } { $i < $loginpos } { incr i } {
      regexp {^[^:]*:(.*$)} $namecheck match namecheck
   }
   # Wrong student, just print line
   if { [string first $student $namecheck] != 0 } {
      puts $f_out $nextline
      continue 
   }
   set pos 0
   set outputline ""
   # Position to change
   while { [string length $nextline] > 0 || $notdone} {
      set notdone [regexp {:$} $nextline]
      regexp $seastr $nextline match hit nextline
      # Skip login name
      if { $loginpos == $pos } {
	 incr pos
	 append outputline $hit
	 if { $notdone } {
	    append outputline :
	 }
	 continue 
      }
      regexp {^([^,]*[,])([0-9]*)$} $hit match tutor pts
      set aktb [lindex $order $pos]
      if { [string match $aktb $blattnr] } {
	 puts "To change $blattnr from $pts to $punkte"
	 if { [ string length $pts ] != 0 } {
	    puts "Bisher waren es $pts Punkte. Auf wieviele soll dies"
	    puts "geaendert werden :"
	    gets stdin punkte
	 }
	 if { $punkte > $points($blattnr) } {
	    puts stderr "Das Blatt $blattnr gab nur $points($blattnr) her."
	    exit 1
	 }
	 set pts $punkte
	 set tutor "$env(LOGNAME)\,"
      } 
      append outputline $tutor $pts 
      incr pos
      if { [string length $nextline] > 0 || $notdone } {
	 append outputline :
      }
   }
   puts $f_out $outputline
}
close $f
close $f_out
exec mv [glob $TEMP] [glob $DB]