mservtk: mservtk.tcl comparison

comparison mservtk.tcl @ 5:b6c495b5eeda

- 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.

author	darius
date	Tue, 03 Oct 2000 10:18:34 +0000
parents	32f624fc18cc
children	b370e0bbe050

comparison

equal deleted inserted replaced

-:32f624fc18cc
+:b6c495b5eeda
-#!/usr/bin/env wish8.0
+#!/usr/bin/env wish8.2
 #
 # This software is copyright Daniel O'Connor (darius@dons.net.au) 2000
 #
 # Redistribution and use in source and binary forms, with or without
 	if {$state(rtlist) != ""} {
 	    # Copy it so we don't stomp any new additions
 	    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];
 	    }
 	}
 	if {$state(exit) == 1} {
 # Add the File menu
 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";
 pack .menubar.file -side left;
 pack .top.tlist.list -side left -fill both -expand 1;
 scrollbar .top.tlist.scr -command ".top.tlist.list yview";
 pack .top.tlist.scr -side right -fill y;
 bind .top.tlist.list <Double-Button-1> {
 	queue_song [.top.tlist.list curselection];
+	gui_updatequeue;
 }
 # Trackinfo
 frame .top.tinfo -relief raised -bd 1;
 pack .top.tinfo -side right -fill both -expand 0;
 if {$rtn(code) != 247} {
 	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))";
 	}
 }
 }
 proc msg_box {title msg} {
 }
 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))";
 }
 }
 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))";
 }
 }
 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)";
 }
 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";
 foreach t $rtn(lines) {
 	set tmp [split $t \011];
 }
 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;
 con_getqueue queue;
 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} {
 global queue;
 if {$id == ""} {
 	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";
 }
 }
 proc gui_updateinfo {} {
 global state;
+set cookie [acquire_lock];
 n_write "VOLUME";
 n_getrtn rtn;
+release_lock $cookie;
 if {$rtn(code) != 235} {
 	set vol "??";
 } else {
 	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"];
 	set author [lindex $data 4];
 	set title [lindex $data 5];
 	if {$rtn(code) != 401} {
 	    log "%s" "Failed to get track info ($rtn(code) $rtn(data))";
 	}
 }
+set cookie [acquire_lock];
 n_write "STATUS";
 n_getrtn rtn;
+release_lock $cookie;
 if {$rtn(code) != 222} {
 	set left "x:xx";
 	set played "x:xx";
 } else {
 .top.tinfo.sub.album configure -text "Album: $album";
 .top.tinfo.sub.misc configure -text "Misc: $misc";
 .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} {
 upvar $queuevar queue;
 global state;
 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) {
 	    set foo [split $line \011];
 	    set id "[lindex $foo 1]:[lindex $foo 2]";
 global state;
 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))";
 	}
 	foreach trk $rtn(lines) {
 global state;
 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))";
 }
 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)'";
 }
 }
 proc update_timer {} {
 }
 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";
 }
 proc n_write {text} {
 global state;
 puts $state(serv_fd) $text;
+flush $state(serv_fd);
+if {[eof $state(serv_fd)]} {
+	log "%s" "Server went away on write";
+	exit 1;
+}
 #    log "%s" "Wrote - $text";
-flush $state(serv_fd);
 }
 proc n_rthandler {code data} {
 global songs;
-#    log "%s" "Got RT - $code $data";
+log "%s" "Got RT - $code $data";
 switch -- $code {
 	600 {
 	    log "%s" "User '$data' connected";
 	}
 	601 {
 	    log "%s" "User '$data' disconnected";
 	}
+	240 -
 	618 -
 	619 -
+	620 -
 	622 -
+	623 -
 	627 -
-	623 {
+	628 -
-	    after idle gui_updatequeue;
+	629 {
+	    log "%s" "Updating queue on idle";
+	    gui_updatequeue;
+	}
+	default {
+	    log "%s" "Got unhandled RT event $code $data";
 	}
 }
 }
 proc n_rtinput {} {
 global state;
 set rth "";
-set line [gets $state(serv_fd)];
+while {1} {
-#    log "%s" "Read - $line";
+	set line [gets $state(serv_fd)];
+	if {[eof $state(serv_fd)]} {
-# Check for RT text
+	    log "%s" "Server went away on read";
-set foo [split $line "\t"];
+	    exit 1;
-if {[string index $line 0] == "="} {
+	}
-	set rth [list [string range [lindex $foo 0] 1 3] [lrange $foo 1 end]];
+	#    log "%s" "Read - $line";
-} else {
+	if {$line == ""} {
-	lappend state(tmpphrase) $line
+	    return;
-	if {$line == "."} {
+	}
-	    set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
+	# Check for RT text
-	    set state(tmpphrase) "";
+	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";
-if {$rth != ""} {
+	} else {
-#	n_rthandler [lindex $rth 0] [lindex $rth 1];
+	    lappend state(tmpphrase) $line
-	lappend state(rtlist) $rth;
+	    if {$line == "."} {
-}
+		set state(pushbuf) [linsert $state(pushbuf) 0 $state(tmpphrase)];
+		#	    log "%s" "push buffer - '$state(tmpphrase)'";
+		set state(tmpphrase) "";
+	    }
+	}
+}
 }
 proc n_getrtn {var} {
 upvar $var rtn;
 global state;
 catch {unset rtn(code)};
 catch {unset rtn(data)};
 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];
 while {1} {
 	if {[llength $buf] == 0} {
 	lappend rtn(lines) $line;
 }
 if {$gotcode == 0} {
-	log "%s" "Failed to parse phrase (got . before server responce)";
+	log "%s" "Failed to parse phrase (got . before server response)";
 }
 }
 ##################################################################
 # Log a message to stderr
 if {[catch {set csm [eval format {$format} $args]} msg]} {
 set csm "bad log message. format='$format' args='$args'";
 }
 # Emit the message
-puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
+catch {
-flush stderr;
+	puts stderr "[clock format [clock seconds] -format {%y/%m/%d %H:%M:%S} -gmt yes]:$fname: $csm";
-}
+	flush stderr;
+}
-main;
+}
+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;
+}
+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"};
+}

Mercurial > ~darius > hgwebdir.cgi > mservtk

comparison mservtk.tcl @ 5:b6c495b5eeda