https://github.com/dlnetworks/multi-server-shoutcast-listener-stats-tcl-for-eggdrop
tcl script for eggdrop irc bots with multi server totals, bandwidth totals, and record/peak tracking.
triggers: .stat .record
output: bitrate – current/max/bandwidth
Radio Name Stats: (24 Kbps – 0/100/0.00 Mbps) (64 Kbps – 2/100/0.12 Mbps) (128 Kbps – 8/200/1.00 Mbps) (256 Kbps – 52/400/13.00 Mbps) (Total – 62/800/14.12 Mbps)
## original script by Niels Roosen (niels at okkernoot dot net)
## modified for dnas v2 and other fixes by dlnetworks.net
## Set some configuration options
## Shoutcast configuration
## Stream servers, format: { host_or_ip port stream_id }
set shoutcast_relays {
{ 127.0.0.1 80 1 }
{ host.domain.com 8000 1 }
{ 127.0.0.1 8030 1 }
{ 127.0.0.1 8050 1 }
{ host.domain.com 80 2 }
{ 127.0.0.1 8000 2 }
{ host.domain.com 8030 2 }
{ 127.0.0.1 8050 2 }
}
## Channel to show shoutcast stats on
set shoutcast_channels { "#channel" }
## Interval for showing stats
set shoutcast_show_interval 60
## Name of the radio station
set shoutcast_station_name "Radio Station"
## End of shoutcast configuration
package require http
package require tdom
bind pub - ".record" show_listener_record
bind msg - ".stat" msg_show_stats
bind pub - ".stat" pub_show_stats
bind msg - ".stats" msg_show_stats
bind pub - ".stats" pub_show_stats
bind time - "?? * * * *" timer_show_stats
### CODE STARTS HERE ###
# Set show_stats semaphore
set sem_show_shoutstats 0
# Set show_stats counter
set counter_show_shoutstats $shoutcast_show_interval
proc test_stats {n m h c a} {
after 0 [timer_show_stats 0 0 0 0 0]
}
proc pub_show_stats {nick mask hand channel args} {
after 0 [show_shoutstats $channel "requested"]
}
proc msg_show_stats {nick mask hand channel args} {
after 0 [show_shoutstats $nick "requested"]
}
proc timer_show_stats {mi ho da mo ye} {
after 0 [show_shoutstats "#" "timer"]
}
proc show_listener_record {nick hand channel args} {
after 0 [show_shoutstats $channel "record"]
}
set shoutcast_station_name2 "$shoutcast_station_name"
proc show_shoutstats {channel mode} {
global shoutcast_relays sem_show_shoutstats shoutcast_show_interval \
shoutcast_station_name2 shoutcast_station_name counter_show_shoutstats shoutcast_channels \
homedir
set run_allowed 0
## First wait for any other show functions to complete w/ some test-and-set instruction
while { $run_allowed == 0 } {
if { ( $sem_show_shoutstats == 0 ) && ( [set sem_show_shoutstats 1] ) && ( [set run_allowed 1] ) } {
## Continue the function
} else {
vwait $sem_show_shoutstats
putserv "PRIVMSG $channel: I was delayed for execution"
}
}
# Initialize the total stats
# Per relay: { quality { current max bandwidth }}
set total_stats {}
# Totals current max bandwidth
set t_unique 0
set t_maxlst 0
set t_bw 0.0
# Extract data per relay
foreach relay $shoutcast_relays {
# Get attributes
set server [lindex $relay 0]
set port [lindex $relay 1]
set sid [lindex $relay 2]
set mark [lindex $relay 3]
# Get the actual data
if { [catch {::http::geturl "http://$server:$port/7.html?sid=$sid" \
-timeout 5000 -headers "User-Agent: Mozilla (The King Kong of Lawn Care)"} stats_token] } {
continue
} else {
# DO NOTHING
set status [::http::status $stats_token]
if { $status != "ok" } {
continue
}
}
set stats_data [::http::data $stats_token]
# Get the stats from the html body
set begin [expr [string first "<body>" $stats_data] + 6]
set end [expr [string first "</body>" $stats_data] - 1]
set relay_rawstats [string range $stats_data $begin $end]
# Now extract the max-allowed and unique listener stats from the string
set relay_liststats [split $relay_rawstats ","]
set relay_unique [lindex $relay_liststats 1]
set relay_maxlst [lindex $relay_liststats 3]
set quality [lindex $relay_liststats 5]
set relay_bw [expr ($quality * $relay_unique) / 1024 ]
# Accumulate this to the totals
# First check if this quality already appears in the totals list
# And eventually search for the index where it should be inserted then
set length [llength $total_stats]
if { $length == 0 } {
# The list is yet empty
set q_totals [list $quality [list $relay_unique $relay_maxlst $relay_bw]]
set total_stats [concat $total_stats $q_totals]
} else {
# Search for the right quality in the index
# First try to find it in the list
for { set q_index 0 } { $q_index <= $length } { set q_index [expr $q_index + 2] } {
if { [lindex $total_stats $q_index] == $quality } {
break
}
}
if { $q_index > $length } {
# It doesnt exist yet
# Now we have to insert it in the list
for { set q_index 0 } { ($quality > [lindex $total_stats $q_index]) \
&& ($q_index < $length) } { set q_index [expr $q_index + 2] } {
}
if { $q_index > $length } {
# We have to append it to the list
set q_totals [list $quality [list $relay_unique $relay_maxlst $relay_bw]]
set total_stats [concat $total_stats $q_totals]
} else {
# We have to insert it in the list
set q_totals [list $quality [list $relay_unique $relay_maxlst $relay_bw]]
# First put it behind the first part of the list
set total_stats_first [lrange $total_stats 0 [expr $q_index - 1]]
set total_stats_last [lrange $total_stats $q_index end]
set total_stats [concat $total_stats_first $q_totals]
set total_stats [concat $total_stats $total_stats_last]
}
} else {
# The stats for this quality already exist, add it to them
# First get the current stats
set cq_totals [lindex $total_stats [expr $q_index + 1]]
# Add them together
set q_unique [expr $relay_unique + [lindex $cq_totals 0]]
set q_maxlst [expr $relay_maxlst + [lindex $cq_totals 1]]
set q_bw [expr $relay_bw + [lindex $cq_totals 2]]
# Replace the qurrent values in the totals
set q_totals [list $q_unique $q_maxlst $q_bw]
set total_stats [lreplace $total_stats [expr $q_index + 1] [expr $q_index + 1] $q_totals]
}
}
# And accumulate this to the absolute totals
set t_unique [expr $t_unique + $relay_unique]
set t_maxlst [expr $t_maxlst + $relay_maxlst]
set t_bw [expr $t_bw + $relay_bw]
::http::cleanup $stats_token
}
# Reset the show_stats_now var
set show_stats_now 0
# Truncate the bandwidth
set t_bw [format "%.2f" $t_bw]
# Now, before we display anything, check if the record is broken
# If so, we dont display the stats but display a new record notice instead
# Format of the file:
#
# Date\tListeners\tBw
# First try to open the file
if { [file exists "./$shoutcast_station_name.record"] == 1 } {
set statfile [open "./$shoutcast_station_name.record" r]
set record [read $statfile]
close $statfile
set frecord [split $record "\t"]
# Now check if there was already something in the file
if { [llength $frecord] != 4 } {
set record_broken 1
} elseif { [lindex $frecord 2] < $t_unique } {
set record_broken 1
} else {
set record_broken 0
}
} else {
# The file didnt exist
set record_broken 1
}
# Now, check if we are gonna show the stats or the new record
if { $record_broken == 1 } {
# Re-open the statfile
set statfile [open "./$shoutcast_station_name.record" w]
# Insert the new data in the file
set current_time [clock seconds]
set ctime [clock format $current_time -format "%A %m-%d-%Y %H:%M"]
set current_song [lindex $shoutcast_now_playing 0]
puts -nonewline $statfile "$ctime\t$t_unique\t$t_bw"
## Be sure to close the file
close $statfile
set outputs "$shoutcast_station_name2 new record - Listener record broken on $ctime with $t_unique listeners."
# Now print the record to the chat
if { $mode == "timer" } {
# For each shoutcast channel
foreach chan $shoutcast_channels {
putquick "PRIVMSG $chan :$outputs"
}
} else {
# For the specified channel
putquick "PRIVMSG $channel :$outputs"
}
} else {
# Perform the command requested (timer, requested or record)
if { $mode == "record" } {
set rsong [lindex $frecord 0]
set rtime [lindex $frecord 1]
set rlst [lindex $frecord 2]
set rbw [lindex $frecord 3]
set outputs "$shoutcast_station_name2 record - Current record was set on $rtime with $rlst listeners."
putquick "PRIVMSG $channel :$outputs"
} else {
# Format all stats in one line
set outputs "$shoutcast_station_name2 Stats:"
foreach {q s} $total_stats {
set current [lindex $s 0]
set max [lindex $s 1]
set bw [format "%.2f" [lindex $s 2]]
set outputs "$outputs ($q Kbps - $current/$max/$bw Mbps)"
}
set outputs "$outputs (Total - $t_unique/$t_maxlst/$t_bw Mbps)"
if { $mode == "requested" } {
# It seems we have a normal channel
putquick "PRIVMSG $channel :$outputs"
} else {
# Just assume this is a timer thing
set counter_show_shoutstats [expr $counter_show_shoutstats - 1]
# putserv "PRIVMSG $channel :Decreasing counter to $counter_show_shoutstats"
if { $counter_show_shoutstats <= 0 } {
set counter_show_shoutstats $shoutcast_show_interval
# Now display those stats
foreach chan $shoutcast_channels {
putquick "PRIVMSG $chan :$outputs"
}
}
}
}
}
## Free the semaphore
set sem_show_shoutstats 0
}
###############################
# Execute the show_stats
show_shoutstats "#" "timer"
putlog "multi server shoutcast listener stats tcl for eggdrop loaded..."