[Tkabber-dev] r52 - in trunk/plugins/now_playing: . contrib/tkamarok

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Sun Sep 23 04:55:48 MSD 2007


Author: kostix
Date: 2007-09-23 04:55:47 +0400 (Sun, 23 Sep 2007)
New Revision: 52

Modified:
   trunk/plugins/now_playing/TODO
   trunk/plugins/now_playing/contrib/tkamarok/tkamarok.tcl
   trunk/plugins/now_playing/now_playing.tcl
Log:
now_playing/contrib/tkamarok/tkamarok.tcl: Brought in sync with the current state of now_playing plugin.

now_playing/now_playing.tcl: Several fixes. "send" method now works.
  Preliminary support for MPD (and the "sockpull" method in general).

now_playing/TODO: tasks sorted by prios and updated.



Modified: trunk/plugins/now_playing/TODO
===================================================================
--- trunk/plugins/now_playing/TODO	2007-09-22 12:40:49 UTC (rev 51)
+++ trunk/plugins/now_playing/TODO	2007-09-23 00:55:47 UTC (rev 52)
@@ -2,27 +2,43 @@
 
 HIGH:
 
-* Double-check timings. Probably [yield] is triggered each second
-  on non-existing files.
+* MPD: when the player goes paused/stopped, pep node is deleted
+  on each poll, i.e. we must remember that the player is already
+  stopped.
 
-* Implement publishing of "stopped" playing status in Tkabber
-  then implement handling of the "stopped" state in this plugin.
+* Implement socket selection options in Customize.
 
-* Fix regexp to allow empty data in some tags for foobar_np_simple.
+* For MPD: implement login support.
 
-* For some reason updates to the node wasn't propagated
-  from jabbus.org to 007spb.ru during tests.
-  Need to check.
+LOW:
 
+* Internal interfaces look somewhat flaky. Need improvements.
+
+* Implement WMP support.
+
+* Reading of info using "sockpull" must be asynchronous.
+
 * Implement some means for banning certain connections from
   publishing. This should be a user-supplied regexp probably.
 
+* The plugin must provide for some mechanism so that only one
+  instance of Tkabber is "active" when processing now-playing info.
+
+* When the "sockpull" provider disconnects, we should schedule
+  (possibly infinite) chain of reconnection attempts to hook back
+  to it when it's back online.
+
 * Improve README.
 
 * Support for message catalogs and Russian message catalog.
 
-LOW:
+* Fix regexp to no not warn on empty data when reading Foobar2000 file.
 
+WIBNIs:
+
+* Implement publishing of "stopped" playing status in Tkabber
+  then implement handling of the "stopped" state in this plugin.
+
 * Study if it's possible to open a named pipe using Tcl
   and specify it as NP file in foobar_np_simple.
   Will this at all work?

Modified: trunk/plugins/now_playing/contrib/tkamarok/tkamarok.tcl
===================================================================
--- trunk/plugins/now_playing/contrib/tkamarok/tkamarok.tcl	2007-09-22 12:40:49 UTC (rev 51)
+++ trunk/plugins/now_playing/contrib/tkamarok/tkamarok.tcl	2007-09-23 00:55:47 UTC (rev 52)
@@ -147,7 +147,7 @@
 
 proc notify args {
 	foreach app [lsearch -all -inline [winfo interps] tkabber*] {
-		eval [list send -async $app ::plugins::np_send::now_playing $args]
+		eval [list send -async $app ::plugins::now_playing::now_playing $args]
 	}
 }
 

Modified: trunk/plugins/now_playing/now_playing.tcl
===================================================================
--- trunk/plugins/now_playing/now_playing.tcl	2007-09-22 12:40:49 UTC (rev 51)
+++ trunk/plugins/now_playing/now_playing.tcl	2007-09-23 00:55:47 UTC (rev 52)
@@ -15,6 +15,10 @@
 	variable monitoring off
 	variable nwarns
 
+	proc my what {
+		return [uplevel 1 namespace current]::$what
+	}
+
 	proc mycmd args {
 		lset args 0 [uplevel 1 namespace current]::[lindex $args 0]
 	}
@@ -44,14 +48,14 @@
 
 	custom::defvar options(check_timeout) 1 \
 		[::msgcat::mc "Timeout (in seconds) between checks\
-			for modification of the now-playing file."] \
+			for modification of the available now-playing information."] \
 		-type integer \
 		-group "Now Playing"
 
 	custom::defvar options(update_threshold) 30 \
 		[::msgcat::mc "Minimal amount of time (in seconds) that must tick\
-			between adjacent now-playing file modifications\
-			for its contents to be used."] \
+			between adjacent changes in the now-playing information\
+			for it to be noticed and used."] \
 		-type integer \
 		-command [mycmd on_update_thresh_changed] \
 		-group "Now Playing"
@@ -59,7 +63,7 @@
 	custom::defvar options(file) [file join $::configdir now_playing] \
 		[::msgcat::mc "Pathname of the now playing file.\
 			(This setting is only relevant to those media players that\
-			serve the information about their user tune using a text file."] \
+			serve the information about their user tune using a text file.)"] \
 		-type file \
 		-group "Now Playing"
 
@@ -96,6 +100,15 @@
 	set options(method,$options(media_player))
 }
 
+proc now_playing::player {action args} {
+	variable options
+	upvar 0 options($action,$options(media_player)) script
+
+	if {$script != ""} {
+		namespace eval :: [linsert $args 0 $script]
+	}
+}
+
 proc now_playing::monitoring {op {val ""}} {
 	variable monitoring
 
@@ -129,12 +142,18 @@
 	variable options
 	variable players
 
+	set init    ""
+	set cleanup ""
+	set yield   ""
+
 	foreach {opt val} $args {
 		switch -- $opt {
-			-tag    { set tag $val }
-			-name   { set name $val }
-			-method { set method $val }
-			-parser { set parser $val }
+			-tag     { set tag $val }
+			-name    { set name $val }
+			-method  { set method $val }
+			-init    { set init $val }
+			-cleanup { set cleanup $val }
+			-yield   { set yield $val }
 			default {
 				return -code error "Bad option \"$opt\":\
 					must be one of -tag, -name or -parser"
@@ -142,23 +161,25 @@
 		}
 	}
 
-	foreach v {tag name method parser} {
+	foreach v {tag name method} {
 		if {![info exists $v]} {
 			return -code error "Required option missing: -$v"
 		}
 	}
 
 	switch -- $method {
-		none - file - registry - send {}
+		none - file - registry - send - sockpull {}
 		default {
 			return -code error "Bad method \"$method\":\
 				must be one of file, registry or send"
 		}
 	}
 
-	set options(name,$tag)   $name
-	set options(method,$tag) $method
-	set options(parser,$tag) $parser
+	set options(name,$tag)    $name
+	set options(method,$tag)  $method
+	set options(init,$tag)    $init
+	set options(cleanup,$tag) $cleanup
+	set options(yield,$tag)   $yield
 
 	lappend players $tag $name
 }
@@ -167,16 +188,20 @@
 	variable options
 	variable players
 
-	foreach {tag name method parser} [list \
+	foreach {tag name method yield} [list \
 		none       [::msgcat::mc "None"]  none     {} \
 		amarok     "Amarok"               send     {} \
 		foobar     "Foobar2000"           file     [mycmd foobar_yield] \
 		QL         "Quod Libet"           file     [mycmd quodlibet_yield] \
 		wmp        "Windows Media Player" registry [mycmd wmp_yield]  \
 	] {
-		add_media_player -tag $tag -name $name -method $method -parser $parser
+		add_media_player -tag $tag -name $name -method $method -yield $yield
 	}
 
+	add_media_player -tag mpd -name "MPD" -method sockpull \
+		-init [mycmd mpd_init] -cleanup [mycmd mpd_cleanup] \
+		-yield [mycmd mpd_yield]
+
 	hook::run now_playing_enumerate_media_players
 
 	custom::configvar [namespace current]::options(media_player) -values $players
@@ -212,14 +237,18 @@
 	variable lastmethod
 	variable connections
 
-	set method [method]
-
-	if {![string equal $lastmethod $method]} {
+	if {![string equal $lastmethod [method]]} {
 		method_stop_$lastmethod
 	}
-	set lastmethod $method
+	set lastmethod [method]
 
 	monitoring set [expr {[enabled] && [llength $connections] > 0}]
+
+	if {![enabled]} {
+		foreach connid $connections {
+			::plugins::tune::unpublish $connid
+		}
+	}
 }
 
 proc now_playing::on_update_thresh_changed args {
@@ -231,48 +260,39 @@
 	}
 }
 
-proc now_playing::now_playing args {
-	variable connections
+proc now_playing::poll {op {script ""}} {
+	variable repollid
 
-	# TODO check options for sanity
-
-	set state ""
-	set opts [list]
-	foreach {opt val} $args {
-		if {[string equal $opt -state]} {
-			set state $val
-		} else {
-			if {$val != ""} {
-				lappend opts $opt $val
-			}
+	switch -- $op {
+		using {
+			[mycmd poller] $script
 		}
-	}
-
-	switch -- $state {
-		inactive {
-			foreach connid $connections {
-				::plugins::tune::unpublish $connid
+		cancel {
+			if {[info exists repollid]} {
+				after cancel $repollid
+				unset repollid
 			}
 		}
-		active {
-			foreach connid $connections {
-				eval [list ::plugins::tune::publish $connid] $opts
-			}
-		}
 		default {
-			return -code error "Bad playing status: \"$state\":\
-				must be active or inactive"
+			return -code error "Bad operation \"$op\":\
+				must be one of using or cancel"
 		}
 	}
-}
 
-proc now_playing::polling_start with {
 }
 
-proc now_playing::polling_cancel {} {
+proc now_playing::poller script {
+	variable options
 	variable repollid
 
-	if {$repollid != ""} { after cancel $repollid }
+	debugmsg tune [info level 0]
+
+	namespace eval :: $script
+
+	if {$options(check_timeout) > 0} {
+		set repollid [after \
+			[expr {$options(check_timeout) * 1000}] [info level 0]]
+	}
 }
 
 #### Method: none
@@ -285,12 +305,12 @@
 
 proc now_playing::method_start_file {} {
 	debugmsg tune [info level 0]
-	[mycmd file_poll]
+	poll using [mycmd file_yield]
 }
 
 proc now_playing::method_stop_file {} {
 	debugmsg tune [info level 0]
-	polling_cancel
+	poll cancel
 }
 
 proc now_playing::read_utf8 fname {
@@ -299,28 +319,12 @@
 	K [string trimleft [read $fd] \uFEFF] [close $fd]
 }
 
-proc now_playing::file_poll {} {
-	variable options
-	variable repollid
-
-	debugmsg tune [info level 0]
-
-	file_yield
-
-	if {$options(check_timeout) > 0} {
-		set repollid [after \
-			[expr {$options(check_timeout) * 1000}] [info level 0]]
-	}
-}
-
 proc now_playing::file_yield {} {
 	variable options
 	variable lasttime
-	variable monitoring
-	variable connections
 
-	if {![file exists $options(file)]} {
-		warn missing "file \"$options(file)\" doesn't exist"
+	if {![file readable $options(file)]} {
+		warn missing "file \"$options(file)\" doesn't exist or is not readable"
 		return
 	}
 
@@ -329,7 +333,7 @@
 	set lasttime $mtime
 
 	upvar 0 options(media_player) tag
-	set failed [catch [list $options(parser,$tag) $options(file)]]
+	set failed [catch [list $options(yield,$tag) $options(file)]]
 	if {$failed} {
 		global errorInfo
 		set monitoring false
@@ -488,19 +492,281 @@
 #### Method: send
 
 proc now_playing::method_start_send {} {
+	debugmsg tune [info level 0]
+	interp alias {} [mycmd now_playing] {} [mycmd process_sent]
 }
 
 proc now_playing::method_stop_send {} {
+	debugmsg tune [info level 0]
+	interp alias {} [mycmd now_playing] {} [mycmd no_op]
 }
 
+proc now_playing::no_op args {
+	debugmsg tune [info level 0]
+}
+
+proc now_playing::process_sent args {
+	variable options
+	variable lasttime
+
+	set now [clock seconds]
+	if {$now - $lasttime < $options(update_threshold)} return
+	set lasttime $now
+
+	eval process $args
+}
+
+# TODO finally make it the endpoint for all methods of processing,
+# argument checking and PEP stuff should be done here only.
+proc now_playing::process args {
+	variable connections
+
+	debugmsg tune [info level 0]
+
+	# TODO check options for sanity
+
+	set state ""
+	set opts [list]
+	foreach {opt val} $args {
+		if {[string equal $opt -state]} {
+			set state $val
+		} else {
+			if {$val != ""} {
+				lappend opts $opt $val
+			}
+		}
+	}
+
+	switch -- $state {
+		inactive {
+			foreach connid $connections {
+				::plugins::tune::unpublish $connid
+			}
+		}
+		active {
+			foreach connid $connections {
+				eval [list ::plugins::tune::publish $connid] $opts
+			}
+		}
+		default {
+			return -code error "Bad playing status: \"$state\":\
+				must be active or inactive"
+		}
+	}
+}
+
 #### Method: registry
 
 proc now_playing::method_start_registry {} {
+	debugmsg tune [info level 0]
 }
 
 proc now_playing::method_stop_registry {} {
+	debugmsg tune [info level 0]
 }
 
+#### Method: sockpull
+
+proc now_playing::method_start_sockpull {} {
+	debugmsg tune [info level 0]
+	player init
+}
+
+proc now_playing::method_stop_sockpull {} {
+	debugmsg tune [info level 0]
+	poll cancel
+	player cleanup
+}
+
+proc now_playing::sock_connect {host port {timeout ""}} {
+	set sock [socket -async $host $port]
+	variable $sock
+	upvar 0 $sock state
+
+	if {$timeout != ""} {
+		set state(on_timeout) [after [expr {$timeout * 1000}] \
+			[mycmd OnSockTimeout $sock]]
+	}
+
+	fileevent $sock readable [mycmd OnSockConnected $sock]
+
+	vwait [my $sock](result)
+
+	lassign $state(result) status msg
+	unset state
+
+	switch -- $status {
+		OK {
+			return $sock
+		}
+		ERROR {
+			return -code error $msg
+		}
+	}
+}
+
+proc now_playing::OnSockConnected sock {
+	variable $sock
+	upvar 0 $sock state
+
+	fileevent $sock readable {}
+	if {[info exists state(on_timeout)]} {
+		after cancel $state(on_timeout)
+	}
+
+	set err [fconfigure $sock -error]
+	if {$err == ""} {
+		set state(result) [list OK ""]
+	} else {
+		set state(result) [list ERROR $err]
+	}
+}
+
+proc now_playing::OnSockTimeout sock {
+	variable $sock
+	upvar 0 $sock state
+
+	set state(result) [list ERROR "Connection timed out"]
+}
+
+#### MPD:
+
+proc now_playing::mpd_init {} {
+	variable mpd
+	upvar 0 mpd(sock) sock
+
+	# TODO make host and port tunable:
+	set sock [sock_connect localhost 6600 5]
+	gets $sock ;# read hello string from mpd
+
+	# TODO provide for login, if needed...
+
+	fconfigure $sock -buffering line -translation lf -encoding utf-8
+
+	poll using [mycmd mpd_yield $sock]
+}
+
+proc now_playing::mpd_cleanup {} {
+	variable mpd
+
+	if {[array exists mpd]} {
+		close $mpd(sock)
+		unset mpd
+	}
+}
+
+proc now_playing::mpd_yield sock {
+	variable mpd
+	variable options
+	variable lasttime
+	variable connections
+
+	debugmsg tune [info level 0]
+
+	puts $sock status
+
+	set state    unknown
+	set playlist -1
+	set songid   -1
+
+	while 1 {
+		if {[gets $sock line] < 0} {
+			# EOF => mpd closed
+			# TODO ideally, we should schedule connection retries here
+			# instead of just giving up
+			monitoring off
+			return
+		}
+		switch -glob -- $line {
+			OK      break
+			state:* {
+				set state    [mpd_getval $line state]
+			}
+			playlist:* {
+				set playlist [mpd_getval $line playlist]
+			}
+			songid:* {
+				set songid   [mpd_getval $line songid]
+			}
+		}
+	}
+
+	switch -- $state {
+		stop  -
+		pause {
+			foreach connid $connections {
+				::plugins::tune::unpublish $connid
+			}
+		}
+		play {
+			set unseen no
+			if {![info exists mpd(playlist)]} {
+				set mpd(playlist) $playlist
+				set unseen yes
+			}
+			if {![info exists mpd(songid)]} {
+				set mpd(songid) $songid
+				set unseen yes
+			}
+
+			if {!$unseen
+			&& $mpd(playlist) == $playlist
+			&& $mpd(songid) == $songid} return
+
+			set mpd(playlist) $playlist
+			set mpd(songid)   $songid
+		}
+		default {
+			warn parsing "unknown player state \"$state\", ignored"
+			return
+		}
+	}
+
+	set now [clock seconds]
+	if {$now - $lasttime < $options(update_threshold)} return
+	set lasttime $now
+
+	puts $sock currentsong
+
+	set opts [list]
+
+	while 1 {
+		if {[gets $sock line] < 0} {
+			# EOF => mpd closed
+			# TODO ideally, we should schedule connection retries here
+			# instead of just giving up
+			monitoring off
+			return
+		}
+		switch -glob -- $line {
+			OK      break
+			Artist:* {
+				lappend opts -artist [mpd_getval $line Artist]
+			}
+			Title:* {
+				lappend opts -title  [mpd_getval $line Title]
+			}
+			Track:* {
+				lappend opts -track  [mpd_getval $line Track]
+			}
+			Time:* {
+				lappend opts -length [mpd_getval $line Time]
+			}
+			Album:* {
+				lappend opts -source [mpd_getval $line Album]
+			}
+		}
+	}
+
+	foreach connid $connections {
+		eval [list ::plugins::tune::publish $connid] $opts
+	}
+}
+
+proc now_playing::mpd_getval {s key} {
+	string trim [string range $s [string length $key:] end]
+}
+
 #### Final startup
 
 now_playing::enumerate_media_players



More information about the Tkabber-dev mailing list