# HG changeset patch
# User darius
# Date 970568314 0
# Node ID b6c495b5eeda56fbc04940b2d58dc504ecdaa72c
# Parent  32f624fc18ccc46d5af6db6a09ebd576fc32152b
- Use wish8.2
- Ack, use the temp variable we copied the rtlist into! (not the
  recently blanked out rtlist state variable)
- Add some locking to try and fix out of sync problems.. Still broken.

diff -r 32f624fc18cc -r b6c495b5eeda mservtk.tcl
--- a/mservtk.tcl	Fri Aug 11 17:46:47 2000 +0000
+++ b/mservtk.tcl	Tue Oct 03 10:18:34 2000 +0000
@@ -1,4 +1,4 @@
-#!/usr/bin/env wish8.0
+#!/usr/bin/env wish8.2
 
 #
 # This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
@@ -82,7 +82,8 @@
 	    set tmp $state(rtlist);
 	    set state(rtlist) "";
 
-	    foreach t $state(rtlist) {
+	    foreach t $tmp {
+#		log "%s" "Handle $t";
 		n_rthandler [lindex $t 0] [lindex $t 1];
 	    }
 	}
@@ -257,6 +258,7 @@
     menubutton .menubar.file -text "File" -menu .menubar.file.m -underline 0;
     menu .menubar.file.m -tearoff 0;
     .menubar.file.m add command -label " Top" -command "gui_top"
+    .menubar.file.m add command -label " Update Queue" -command "gui_updatequeue"
     .menubar.file.m add separator;
     .menubar.file.m add command -label " Quit" -command "quit_now" \
 	-underline 2 -accelerator "Alt-q";
@@ -340,6 +342,7 @@
     pack .top.tlist.scr -side right -fill y;
     bind .top.tlist.list <Double-Button-1> {
 	queue_song [.top.tlist.list curselection];
+	gui_updatequeue;
     }
     
     # Trackinfo
@@ -424,7 +427,7 @@
 	if {$rtn(code) == 510} {
 	    msg_box "Queue" "You can't have the same\nsong in the queue twice!";
 	} else {
-	    log  "Failed to queue track ($rtn(code) $rtn(data))";
+	    log "%s" "Failed to queue track ($rtn(code) $rtn(data))";
 	}
     }
 }
@@ -486,9 +489,11 @@
 proc set_vol {vol} {
     global state;
 
+    set cookie [acquire_lock];
     n_write "VOLUME $vol"
     n_getrtn rtn;
-    
+    release_lock $cookie;
+
     if {$rtn(code) != 255} {
 	log "%s" "Couldn't set volume ($rtn(code) $rtn(data))";
     }
@@ -497,8 +502,10 @@
 proc rate_song {rate} {
     global state;
 
+    set cookie [acquire_lock];
     n_write "RATE $rate";
     n_getrtn rtn;
+    release_lock $cookie;
 
     if {$rtn(code) != 270} {
 	log "%s" "Failed to get rate song ($rtn(code) $rtn(data))";
@@ -509,8 +516,11 @@
 proc control_player {cmd} {
     global state;
 
+    set cookie [acquire_lock];
+    log "%s" "Writing $cmd";
     n_write "$cmd";
     n_getrtn rtn;
+    release_lock $cookie;
 
     log "%s" "Control Got $rtn(code) $rtn(data)";
 }
@@ -518,8 +528,10 @@
 proc gui_top {} {
     global state;
 
+    set cookie [acquire_lock];
     n_write "TOP"
     n_getrtn rtn;
+    release_lock $cookie;
 
     set msg "List of songs most likely to be played next\n\n";
     
@@ -577,12 +589,6 @@
 proc gui_updatequeue {} {
     global state songs queue;
 
-    if {[info exists state(queuelock)]} {
-	return;
-    }
-
-    set state(queuelock) "";
-
     log "%s" "Updating queue";
 
     .bot.queue.list delete 0 end;
@@ -592,8 +598,6 @@
     foreach tag [lsort [array names queue]] {
 	.bot.queue.list insert end "'$songs($queue($tag):name)' by '$songs($queue($tag):author)' on '$songs($queue($tag):albumname)'";
     }
-
-    unset state(queuelock);
 }
 
 proc gui_delqueue {id} {
@@ -603,9 +607,11 @@
 	return;
     }
 
+    set cookie [acquire_lock];
     n_write "UNQUEUE [split $queue($id) {:}]";
     n_getrtn rtn;
-    
+    release_lock $cookie;
+
     if {$rtn(code) != 254} {
 	log "%s" "Failed to remove $id ($queue($id))";
 	msg_box "Queue" "Failed to dequeue the song";
@@ -615,8 +621,10 @@
 proc gui_updateinfo {} {
     global state;
 
+    set cookie [acquire_lock];
     n_write "VOLUME";
     n_getrtn rtn;
+    release_lock $cookie;
 
     if {$rtn(code) != 235} {
 	set vol "??";
@@ -624,8 +632,10 @@
 	set vol "[lindex [lindex $rtn(lines) 0] 0]";
     }
 
+    set cookie [acquire_lock];
     n_write "INFO";
     n_getrtn rtn;
+    release_lock $cookie;
 
     if {$rtn(code) == 246} {
 	set data [split [lindex $rtn(lines) 0] "\t"];
@@ -649,8 +659,10 @@
 	}
     }
 
+    set cookie [acquire_lock];
     n_write "STATUS";
     n_getrtn rtn;
+    release_lock $cookie;
 
     if {$rtn(code) != 222} {
 	set left "x:xx";
@@ -677,6 +689,7 @@
     .top.tinfo.sub.rate1 configure -text "Rating: $rate1";
     .top.tinfo.sub.rate2 configure -text "Temporally Adjusted: $rate2";
     .top.tinfo.sub.vol configure -text "Volume: $vol";
+    
 }
 
 proc con_getqueue {queuevar} {
@@ -686,9 +699,11 @@
 
     catch {unset queue};
 
+    set cookie [acquire_lock];
     n_write "QUEUE"
     n_getrtn rtn;
-
+    release_lock $cookie;
+    
     if {$rtn(code) == 225} {
 	set i 0;
 	foreach line $rtn(lines) {
@@ -714,8 +729,11 @@
     catch { unset songs };
 
     foreach i [array names albums "*:"] {
+	set cookie [acquire_lock];
 	n_write "TRACKS $albums($i)";
 	n_getrtn rtn;
+	release_lock $cookie;
+
 	if {$rtn(code) != "228"} {
 	    error "Got bogus response to track request ($rtn(code) $rtn(data))";
 	}
@@ -746,8 +764,11 @@
 
     catch {unset albums};
     
+    set cookie [acquire_lock];
     n_write "ALBUMS";
     n_getrtn rtn;
+    release_lock $cookie;
+
     if {$rtn(code) != 227} {
 	error "Server gave bogus response to album request ($rtn(code) $rtn(data))";
     }
@@ -755,11 +776,14 @@
     foreach alb $rtn(lines) {
 	set foo [split $alb \011];
 	set id [lindex $foo 0];
-	set albums($id:) [lindex $foo 0];
+	if {$id == ""} {
+	    continue;
+	}
+	set albums($id:) $id;
 	set albums($id:author) [lindex $foo 1];
 	set albums($id:name) [lindex $foo 2];
 
-#	log "%s" "Album $i, ID $albums($i:id) called $albums($i:name) by $albums($i:author)";
+#	log "%s" "Album $id, ID '$albums($id:)' called '$albums($id:name)' by '$albums($id:author)'";
     }
 }
 
@@ -806,7 +830,10 @@
     if {$rtn(code) != "202"} {
 	error "Unknown response to PASS command - $rtn(code) $rtn(data)"
     }	
-    
+
+    set state(lock) "";
+#    trace variable state(lock) rw foobar;
+
     log "%s" "Logged in";
 }
 
@@ -814,15 +841,19 @@
     global state;
 
     puts $state(serv_fd) $text;
-#    log "%s" "Wrote - $text";
+    flush $state(serv_fd);
 
-    flush $state(serv_fd);
+    if {[eof $state(serv_fd)]} {
+	log "%s" "Server went away on write";
+	exit 1;
+    }
+#    log "%s" "Wrote - $text";
 }
 
 proc n_rthandler {code data} {
     global songs;
 
-#    log "%s" "Got RT - $code $data";
+    log "%s" "Got RT - $code $data";
 
     switch -- $code {
 	600 {
@@ -833,12 +864,21 @@
 	    log "%s" "User '$data' disconnected";
 	}
 
+	240 -
 	618 -
 	619 -
+	620 -
 	622 -
+	623 -
 	627 -
-	623 {
-	    after idle gui_updatequeue;
+	628 -
+	629 {
+	    log "%s" "Updating queue on idle";
+	    gui_updatequeue;
+	}
+
+	default {
+	    log "%s" "Got unhandled RT event $code $data";
 	}
     }
 }
@@ -848,25 +888,30 @@
 
     set rth "";
 
-    set line [gets $state(serv_fd)];
-#    log "%s" "Read - $line";
-
-    # Check for RT text
-    set foo [split $line "\t"];
-    if {[string index $line 0] == "="} {
-	set rth [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
-    } else {
-	lappend state(tmpphrase) $line
-	if {$line == "."} {
-	    set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
-	    set state(tmpphrase) "";
+    while {1} {
+	set line [gets $state(serv_fd)];
+	if {[eof $state(serv_fd)]} {
+	    log "%s" "Server went away on read";
+	    exit 1;
+	}
+	#    log "%s" "Read - $line";
+	if {$line == ""} {
+	    return;
 	}
-    }
-
-    if {$rth != ""} {
-#	n_rthandler [lindex $rth 0] [lindex $rth 1];
-	lappend state(rtlist) $rth;
-    }
+	# Check for RT text
+	set foo [split $line "\t"];
+	if {[string index $line 0] == "="} {
+	    lappend state(rtlist) [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
+	    #	log "%s" "RT event";
+	} else {
+	    lappend state(tmpphrase) $line
+	    if {$line == "."} {
+		set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
+		#	    log "%s" "push buffer - '$state(tmpphrase)'";
+		set state(tmpphrase) "";
+	    }
+	}
+    } 
 }
 
 proc n_getrtn {var} {
@@ -879,9 +924,12 @@
     catch {unset rtn(lines)}
 
     while {[llength $state(pushbuf)] == 0} {
+#	log "%s" "Sleeping for data";
 	vwait state(pushbuf);
     }
-	
+
+#    log "%s" "Waking up, got $state(pushbuf)";
+
     set buf [lindex $state(pushbuf) 0];
     set state(pushbuf) [lrange $state(pushbuf) 1 end];
     
@@ -908,7 +956,7 @@
     }
 
     if {$gotcode == 0} {
-	log "%s" "Failed to parse phrase (got . before server responce)";
+	log "%s" "Failed to parse phrase (got . before server response)";
     }
 }
 
@@ -927,8 +975,77 @@
     }
 
     # Emit the message
-    puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
-    flush stderr;
+    catch {
+	puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
+	flush stderr;
+    }
+}
+
+proc acquire_lock {} {
+    global state;
+
+    # Extract the calling function's name
+    if {[catch {set fname [lindex [info level -1] 0]}]} {
+	set fname "unknown";
+    }
+
+#    log "%s" "Acquiring lock for $fname";
+
+    set foo 0;
+
+    if {[info exists state(lock)]} {
+	while {$state(lock) != ""} {
+	    set foo 1;
+	    log "%s" "$fname waiting for lock (held by [lindex $state(lock) 1])";
+	    vwait state(lock);
+	}
+
+	if {$foo == 1} {
+	    log "%s" "Lock released";
+	}
+
+    }
+
+    set cookie [clock clicks];
+    set state(lock) [list $cookie $fname];
+#    log "%s" "Lock acquired";
+    return $cookie;
 }
 
-main;
+proc release_lock {cookie} {
+    global state;
+
+    # Extract the calling function's name
+    if {[catch {set fname [lindex [info level -1] 0]}]} {
+	set fname "unknown";
+    }
+
+    if {$cookie == ""} {
+	log "%s" "$fname trying to unlock without being locked";
+	exit 1;
+    }
+
+    if {$cookie != [lindex $state(lock) 0]} {
+	log "%s" "Lock cookie not matched!";
+	exit 1;
+    }
+
+    if {$fname != [lindex $state(lock) 1]} {
+	log "%s" "$fname tried to free [lindex $state(lock) 1]'s lock!";
+	exit 1;
+    }
+
+    set state(lock) "";
+#    log "%s" "Lock for $fname now free";
+}
+
+proc foobar {n1 n2 op} {
+    global state;
+
+    log "%s" "$op, now $state(lock)";
+}
+
+if {[catch {main} msg]} {
+    catch {tk_dialog .dummy "Error!" $msg error 0 "OK"};
+}
+