# $Id: mpd.tcl 65 2007-10-01 18:07:20Z kostix $
# Sample code to get "now playing" info from MPD.

namespace eval plugins::tune {
	proc publish args   { puts [info level 0] }
	proc unpublish args { puts [info level 0] }
}

namespace eval now_playing {
	variable connections [list 1]
	variable lasttime 0
	variable options
	array set options {
		media_player      mpd
		check_timeout     3
		update_threshold  5

		sock_host              localhost
		sock_port              6600
		sock_connect_timeout   2
		sock_reconnect_timeout 5
		sock_user              ""
		sock_password          ""
	}

	proc my what {
		return [uplevel 1 namespace current]::$what
	}

	proc mycmd args {
		lset args 0 [uplevel 1 namespace current]::[lindex $args 0]
	}

	proc debugmsg {topic msg} {
		puts "$topic: $msg"
	}

	proc warn {topic msg} {
		puts $msg
	}

	proc monitoring args {
		debugmsg tune [info level 0]
	}

	# Schelte Bron's implementation of [lassign] (appeared in Tcl 8.5)
	# from http://wiki.tclers.tk/1530
	# Note that Tclx also has [lassign] so we check for the existence of
	# this command instead of checking the Tcl's version.
	if {[info procs ::lassign] == ""} {
		proc ::lassign {values args} {
			uplevel 1 [list foreach $args [linsert $values end {}] break]
			lrange $values [llength $args] end
		}
	}

	proc 1000x sec { expr {$sec * 1000} }

	interp alias {} [mycmd die] {} return -code error
}

#### Polling:

proc now_playing::poll {op {script ""}} {
	variable repollid

	switch -- $op {
		using {
			[mycmd poller] $script
		}
		cancel {
			if {[info exists repollid]} {
				after cancel $repollid
				unset repollid
			}
		}
		default {
			return -code error "Bad operation \"$op\":\
				must be one of using or cancel"
		}
	}

}

proc now_playing::poller script {
	variable options
	variable repollid

	debugmsg tune [info level 0]

	namespace eval :: $script

	if {$options(check_timeout) > 0} {
		set repollid [after \
			[1000x $options(check_timeout)] [info level 0]]
	}
}

#### Socket:

proc now_playing::sock_connect {host port args} {
	set timeout 0
	set async   [list]
	foreach {opt val} $args {
		switch -- $opt {
			-timeout { set timeout $val }
			-async   { set async $val }
			default  {
				return -code error "Bad option \"$opt\":\
					must be one of -timeout or -async"
			}
		}
	}

	set sock [socket -async $host $port]
	variable $sock
	upvar 0 $sock state

	if {$timeout > 0} {
		set state(on_timeout) [after $timeout \
			[mycmd OnSockTimeout $sock]]
	}

	fileevent $sock readable [mycmd OnSockConnected $sock]

	if {[llength $async] > 0} {
		set state(async) $async

		return $sock
	} else {
		vwait [my $sock](connected)

		if {$state(connected)} {
			unset state
			return $sock
		} else {
			set msg $state(error)
			unset state
			return -code error $msg
		}
	}
}

proc now_playing::OnSockConnected sock {
	set error [fconfigure $sock -error]
	set connected [expr {$error == ""}]

	SockFinalizeConnectionAttempt $sock $connected $error
}

proc now_playing::OnSockTimeout sock {
	SockFinalizeConnectionAttempt $sock 0 "Connection timed out"
}

proc now_playing::SockFinalizeConnectionAttempt {sock connected error} {
	variable $sock
	upvar 0 $sock state

	fileevent $sock readable {}
	if {[info exists state(on_timeout)]} {
		after cancel $state(on_timeout)
	}

	if {!$connected} { close $sock }

	if {[info exists state(async)]} {
		set async $state(async)
		unset state
		namespace eval :: $async [list $sock $connected $error]
	} else {
		set state(connected) $connected
		set state(error)     $error
	}
}

#### MPD:

proc now_playing::laststate {op {val ""}} {
	variable mpd

	switch -- $op {
		get {
			set mpd(laststate)
		}
		is {
			string equal $mpd(laststate) $val
		}
		set {
			set mpd(laststate) $val
		}
		default {
			return -code error "Bad operation \"$op\":\
				must be one of get, is or set"
		}
	}
}

proc now_playing::mpd_connect {} {
	debugmsg tune [info level 0]

	variable options
	variable mpd

	set mpd(sock) [sock_connect $options(sock_host) $options(sock_port) \
		-timeout [1000x $options(sock_connect_timeout)] \
		-async [mycmd mpd_on_connected]]
}

proc now_playing::mpd_cleanup {} {
	debugmsg tune [info level 0]

	variable repollid
	if {[info exists repollid]} {
		after cancel $repollid
	}

	variable mpd

	if {[array exists mpd]} {
		close $mpd(sock)
		interp alias {} [mycmd $mpd(sock)] {}
		unset mpd
	}
}

proc now_playing::mpd_handle_error {} {
	mpd_cleanup
	monitoring off
}

proc now_playing::mpd_schedule_reconnect {} {
	debugmsg tune [info level 0]

	variable options
	variable repollid

	set repollid [after [1000x $options(sock_reconnect_timeout)] \
		[mycmd mpd_connect]]
}

proc now_playing::mpd_on_connected {sock connected error} {
	debugmsg tune [info level 0]

	if {$connected} {
		fconfigure $sock -blocking no -buffering line -translation lf -encoding utf-8

		interp alias {} [mycmd $sock] {} fileevent $sock readable

		$sock [mycmd mpd_read_hello $sock]
	} else {
		mpd_schedule_reconnect
	}
}

proc now_playing::mpd_on_disconnected sock {
	debugmsg tune [info level 0]

	mpd_cleanup
	mpd_schedule_reconnect
}

proc now_playing::mpd_read_hello sock {
	debugmsg tune [info level 0]

	if {[gets $sock line] < 0} {
		mpd_on_disconnected $sock
		return
	}

	variable options
	if {$options(sock_password) != ""} {
		puts $sock "password $options(sock_password)"
		$sock [mycmd mpd_process_login $sock]
	} else {
		mpd_start_harvesting $sock
	}
}

proc now_playing::mpd_process_login sock {
	debugmsg tune [info level 0]

	if {[gets $sock line] < 0} {
		mpd_on_disconnected $sock
		return
	}

	switch -- $line {
		ACK* {
			mpd_handle_error
			die $line
		}
		OK {
			mpd_start_harvesting $sock
		}
	}
}

proc now_playing::mpd_start_harvesting sock {
	debugmsg tune [info level 0]

	variable mpd

	laststate set unknown
	array set mpd {
		playlist -1
		songid   -1
	}

	mpd_yield $sock
}

proc now_playing::mpd_yield sock {
	debugmsg tune [info level 0]

	puts $sock status
	$sock [mycmd mpd_yield_status $sock [list]]
}

proc now_playing::mpd_schedule_next_yield sock {
	debugmsg tune [info level 0]

	variable options
	variable repollid

	set repollid [after [1000x $options(check_timeout)] \
		[mycmd mpd_yield $sock]]
}

proc now_playing::mpd_yield_status {sock status} {
	debugmsg tune [info level 0]

	if {[gets $sock line] < 0} {
		mpd_on_disconnected $sock
		return
	}

	switch -glob -- $line {
		state:*    -
		playlist:* -
		songid:*   {
			mpd_getval $line status
			$sock [mycmd mpd_yield_status $sock $status]
		}
		ACK*       {
			mpd_handle_error
			die $line
		}
		OK         {
			switch -- [mpd_process_status $status] {
				stop {
					mpd_schedule_next_yield $sock
				}
				proceed {
					puts $sock currentsong
					$sock [mycmd mpd_yield_songinfo $sock [list]]
				}
			}
		}
	}
}

proc now_playing::mpd_process_status status {
	debugmsg tune [info level 0]

	variable options
	variable lasttime

	array set {} $status

	switch -- $(state) {
		stop  -
		pause {
			if {[laststate is inactive]} { return stop }
			set newstate inactive
		}
		play {
			if {[laststate is active]} {
				variable mpd

				if {$mpd(playlist) == $(playlist)
				&& $mpd(songid)    == $(songid)} { return stop }

				set mpd(playlist) $(playlist)
				set mpd(songid)   $(songid)
			}
			set newstate active
		}
		default {
			warn parsing "unknown player state \"$state\", ignored"
			return
		}
	}

	debugmsg tune $status

	if {[clock seconds] - $lasttime < $options(update_threshold)} { return stop }

	laststate set $newstate

	switch -- $newstate {
		inactive {
			variable connections
			foreach connid $connections {
				::plugins::tune::unpublish $connid
			}
			return stop
		}
		active {
			return proceed
		}
	}
}

proc now_playing::mpd_yield_songinfo {sock info} {
	debugmsg tune [info level 0]

	if {[gets $sock line] < 0} {
		mpd_on_disconnected $sock
		return
	}

	switch -glob -- $line {
		Artist:* -
		Title:*  -
		Track:*  -
		Time:*   -
		Album:*  {
			mpd_getval $line info
			$sock [mycmd mpd_yield_songinfo $sock $info]
		}
		ACK*     {
			mpd_handle_error
			die $line
		}
		OK       {
			mpd_process_songinfo $sock $info
		}
	}
}

proc now_playing::mpd_process_songinfo {sock info} {
	debugmsg tune [info level 0]

	variable lasttime
	variable connections

	set opts [list]
	foreach {key val} $info {
		lappend opts -$key $val
	}

	foreach connid $connections {
		eval [list ::plugins::tune::publish $connid] $opts
	}

	set lasttime [clock seconds]

	mpd_schedule_next_yield $sock
}

proc now_playing::split_at {s delim} {
	set ix [string first $delim $s]
	if {$ix < 0} {
		list $s
	} else {
		list \
			[string range $s 0 [expr {$ix - 1}]] \
			[string range $s [expr {$ix + [string length $delim]}] end]
	}
}

proc now_playing::mpd_getval {from toName} {
	debugmsg tune [info level 0]

	upvar 1 $toName to

	foreach {key val} [split_at $from ": "] {
		lappend to [string tolower $key] $val
	}
}

#### Action:

now_playing::mpd_connect

vwait forever

