musiclog.tcl

Tcl

No description

ManiacTwister

Download Edit

# Musiclog - Post current / next song titles of some radio stations
# to a particular IRC Channel.
# Copyright (C) 2014 ManiacTwister < twister@s7t.de >
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation, either version 3 of the License, or
# (at your option) any later version.
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
package require http
package require json
package require tdom
set lastsong_886 ""
set lastsong_oe3 ""
set lastsong_wdr2 ""
set lastsong_gotv ""
set standalone false
proc bgerror {s} {
puthelp "PRIVMSG #musiclog :An error occured: $s"
}
proc sleep {N} {
after [expr {int($N * 1000)}]
}
# Enable timer
proc enable {} {
global standalone
if {!$standalone} {
timer 1 run
} else {
sleep 5
run
}
}
# Execution loop
proc run {} {
886check
oe3check
wdr2check
gotvcheck
enable
}
proc 886check {} {
global lastsong_886
set url [http::geturl http://www.radio886.at/cache/r886_joa.js]
if {[http::status $url] == "ok"} {
set data [string map {"window.r886_joa = " ""} [http::data $url]]
set dict [json::json2dict $data]
if {[dict exists $dict "next"]} {
set next [saveGet $dict "next"]
set currentsong [string trim [saveGet $next "titel"]]
set interpret [string trim [saveGet $next "interpret"]]
set start [saveGet $next "sec"]
if { $lastsong_886 != $currentsong } {
set lastsong_886 $currentsong
postSong "\0030888.6\00300" $currentsong $interpret $start
}
}
} else {
return 1
}
http::cleanup $url
}
proc oe3check {} {
global lastsong_oe3
set url [http::geturl http://ms01.oe3.fm/oe3metafiles/RMX/RMWEB.PHP?Res=200&Format=json]
if {[http::status $url] == "ok"} {
#set data [string map {"\}]\})" "\}]\}"} [string map {"onair(" ""} [http::data $url]]]
set data [http::data $url]
set dict [json::json2dict $data]
if {[dict exists $dict "SPIELLISTENELEMENT"]} {
#set elements [dict get $dict "SPIELLISTENELEMENT"]
#set song [lindex $elements end]
foreach {songl} [saveGet $dict "SPIELLISTENELEMENT"] {
if { [saveGet $songl "HINWEIS"] eq "ES FOLGT "} {
set song $songl
break
}
}
if {[info exists song]} {
set currentsong [string trim [saveGet $song "TITEL"]]
set interpret [string trim [saveGet $song "INTERPRET"]]
set start [saveGet $song "ZEIT"]
if { $lastsong_oe3 != $currentsong } {
set lastsong_oe3 $currentsong
postSong "\00302OE3\00300" $currentsong $interpret $start
}
}
}
} else {
return 1
}
http::cleanup $url
}
proc wdr2check {} {
global lastsong_wdr2
set url [http::geturl http://www.wdr2.de/musik/playlist_neu100-akkordeon-playlist.html]
if {[http::status $url] == "ok"} {
#set data [string map {"\}]\})" "\}]\}"} [string map {"onair(" ""} [http::data $url]]]
set data [http::data $url]
set doc [ dom parse -html $data ]
set root [$doc documentElement]
set node [$root selectNodes {//p}]
set interpret [string map {":" ""} [$node selectNodes {string(//strong)}]]
set currentsong [string trim [[$node lastChild] asHTML]]
if { $lastsong_wdr2 != $currentsong } {
set lastsong_wdr2 $currentsong
postSong "\00304WDR2\00300" $currentsong $interpret 0
}
} else {
return 1
}
http::cleanup $url
}
proc gotvcheck {} {
global lastsong_gotv
set url [http::geturl http://www.gotv.at/titel_load_data.asp]
if {[http::status $url] == "ok"} {
set data [http::data $url]
set lines [split $data "\n"]
foreach line $lines {
## Split into fields on colons
set fields [split $line ":"]
## Assign fields to variables and print some out...
lassign $fields \
key val
if {$key eq "Artist_Next"} {
set interpret $val
continue
}
if {$key eq "Title_Next"} {
set currentsong $val
continue
}
}
if {[info exists currentsong] && [info exists interpret]} {
if { $lastsong_gotv != $currentsong } {
set lastsong_gotv $currentsong
postSong "\00314go\00315TV\00300" $currentsong $interpret 0
}
}
} else {
return 1
}
http::cleanup $url
}
proc postSong {station title interpret start} {
global standalone
if {$standalone} {
puts stdout "$station: $title - $interpret (Starts: ~$start)"
} else {
puthelp "PRIVMSG #musiclog :$station: $title - $interpret (Starts: ~$start)"
}
}
proc saveGet { dict key } {
if { [catch { dict exists $dict $key } exist] } {
bgerror "Invalid data received."
return ""
} else {
if { $exist } {
return [dict get $dict $key]
}
}
return ""
}
if {!$standalone} {
putlog "Musiclog geladen!"
}
# Start first execution
enable