Rebuilding TivoWebPlus's Channel Cache from MFS, please wait......
" init_channelindex puts $chan "COMPLETE
"
##--- call proc to save flags to file if Save clicked -----------------------------------------
} elseif { $path == "backup" } {
SaveFlagsToFile $chan $savefilename
##--- clicked -----------------------------------------
} elseif { $path == "blacklist" } {
set channelnumlist [array names channeltablenum]
## now loop through the channels
foreach channum [lsort -real $channelnumlist] {
if { $channum > 999 } {
continue
}
## find each channel's data in either the two received lists or the not-rcved lists (_alt)
if { [catch {set stationfsid $channeltablenum($channum)}] != 1 } {
#set rcv 1
catch {set data $channeltablestation($stationfsid) }
} else {
#set rcv 0
set stationfsid $channeltablenum_alt($channum)
catch {set data $channeltablestation_alt($stationfsid) }
}
if {[info exists data]} {
set channel [lindex $data 5]
## if channel already written once, skip this duplicate
if { [info exists dupcheck($channel)] } {
continue
} else {
set dupcheck($channel) "1"
}
set favorite [lindex $data 1]
set channum [join [split $channum .] -]
set callsign [lindex $data 2]
set channame [lindex $data 3]
# set signal_text to SignalType (more stuff added later if available)
#set signal_text [lindex $data 6]
if { [info exists black_nums] && [llength $black_nums] > 0 } {
foreach black_num $black_nums {
if { $channum == $black_num } {
puts $chan "Found BlackNum
"
puts $chan "stationfsid : $stationfsid
"
puts $chan "callsign : $callsign
"
puts $chan "channum : $channum
"
puts $chan "channame : $channame
"
RmvFromRcv $chan $stationfsid
puts $chan "
"
}
}
}
if { [info exists black_calls] && [llength $black_calls] > 0 } {
foreach black_call $black_calls {
if { $callsign == $black_call } {
puts $chan "Found BlackCall
"
puts $chan "stationfsid : $stationfsid
"
puts $chan "callsign : $callsign
"
puts $chan "channum : $channum
"
puts $chan "channame : $channame
"
RmvFromRcv $chan $stationfsid
puts $chan "
"
}
}
}
if { [info exists black_names] && [llength $black_names] > 0 } {
foreach black_name $black_names {
if { [regexp -nocase "^$black_name$" [strim $channame]] } {
puts $chan "Found BlackName
"
puts $chan "stationfsid : $stationfsid
"
puts $chan "callsign : $callsign
"
puts $chan "channum : $channum
"
puts $chan "channame : $channame
"
RmvFromRcv $chan $stationfsid
puts $chan "
"
}
}
}
}
}
##--- process all, fav, rcv and restore -------------------------------------------------------
##--- stop processing if page called directly with no path (show menu only) -----------------
} elseif { $path != "" } {
## add checkall client-side function to page
puts $chan "
"
## put everything in a form, so submit button will collect checkboxes
puts $chan [html_form_start "POST" "/channelprefs/update" "name=\"form\""]
puts $chan [html_table_start "width=96%" "" ""]
set th_rcv "Rcv"
set th_fav "Fav"
set temp_row [th $th_rcv][th $th_fav][th "Logo"][th "Number"][th "Callsign"][th "Name"]
set temp_row $temp_row[th "Description"][th "Signal"]
puts $chan [tr "ALIGN=CENTER" $temp_row ]
## include _alt array if showing all or restore options
if { $path == "all" || $path == "restore"} {
set channelnumlist "[array names channeltablenum] [array names channeltablenum_alt]"
} else {
set channelnumlist [array names channeltablenum]
}
## if requested, execute the saved file to populate the savefile_rcv and savefile_fav arrays
if { $path == "restore" } {
source $savefilename
}
## now loop through the channels
foreach channum [lsort -real $channelnumlist] {
if { $channum > 999 } {
continue
}
## find each channel's data in either the two received lists or the not-rcved lists (_alt)
if { [catch {set stationfsid $channeltablenum($channum)}] != 1 } {
set rcv 1
catch {set data $channeltablestation($stationfsid) }
} else {
set rcv 0
set stationfsid $channeltablenum_alt($channum)
catch {set data $channeltablestation_alt($stationfsid) }
}
if {[info exists data]} {
set channel [lindex $data 5]
## if channel already written once, skip this duplicate
if { [info exists dupcheck($channel)] } {
continue
} else {
set dupcheck($channel) "1"
}
set favorite [lindex $data 1]
## skip not-fav if fav-only requested
if { $path == "fav" && $favorite == 0 } {
continue
}
## set values for checkboxes and hidden values
if {$rcv > 0} {
set sv_rcv "on"
} else {
set sv_rcv ""
}
if {$favorite > 0} {
set sv_fav "on"
} else {
set sv_fav ""
}
## set checkboxes to restored values if specified
if { $path == "restore"} {
if {[info exists savefile_rcv($channum)]} {
set cb_rcv $savefile_rcv($channum)
} else {
set cb_rcv ""
}
if {[info exists savefile_fav($channum)]} {
set cb_fav $savefile_fav($channum)
} else {
set cb_fav ""
}
} else {
set cb_rcv $sv_rcv
set cb_fav $sv_fav
}
## set html for checkboxes and hidden values
set td_rcv [td [html_form_checkbox "cb_rcv_$stationfsid" $cb_rcv][html_form_hidden "sv_rcv_$stationfsid" $sv_rcv]]
set td_fav [td [html_form_checkbox "cb_fav_$stationfsid" $cb_fav][html_form_hidden "sv_fav_$stationfsid" $sv_fav]]
## format and write channel row out to html
set channum [join [split $channum .] -]
set callsign [lindex $data 2]
set td_callsign [td [html_link "/channel/$stationfsid" $callsign "title=\"See channel details for $channum\""]]
set channame [lindex $data 3]
set td_channame [td [html_link "/object/$channel" $channame "title=\"See MFS details for channel $channum\""]]
set logoindex [lindex $data 4]
if {$::version < 6} {
set td_channum [td [html_link "/channelprefs_change/$channum" $channum "title=\"Change LiveTV to channel $channum\"" "target=_new"]]
} else {
set td_channum [td $channum]
}
## try now-showing logo 1st, then channel logo 2nd, then none
set logoname [lindex $logotablename(2) [lsearch $logotableindex(2) $logoindex]]
if { $logoname != "" } {
set logostr [img "alt=\"\"" "$logoname-s2-p2.png"]
} else {
set logoname [lindex $logotablename(1) [lsearch $logotableindex(1) $logoindex]]
if { $logoname != "" } {
set logostr [img "alt=\"\"" "$logoname-s1-p1.png"]
} else {
set logostr ""
}
}
# set signal_text to SignalType (more stuff added later if available)
set signal_text [lindex $data 6]
## get long description and signaltext from apg data
set chandesc ""
set apgchannel ""
regexp {([0-9]*)/(.*)} $channel junk channelid channelsubid
RetryTransaction {
catch { set channelobj [db $db openidconstruction $channelid $channelsubid] }
catch { set apgchannel [dbobj $channelobj get ApgChannel] }
if { $apgchannel != "" } {
set chandesc [strim [dbobj $apgchannel get AboutText]]
set chandef [dbobj $apgchannel get ChannelDefinition]
set frameheader [dbobj $apgchannel get "FrameHeaderNetworkId"]
# set descriptions for known satellites
if {$frameheader == 0 } {
set sat_text "A(101)"
} elseif {$frameheader == 2} {
set sat_text "C(110)"
} elseif {$frameheader == 3} {
set sat_text "B(119)"
} else {
set sat_text $frameheader
}
set transponder [dbobj $chandef get "FrequencyIndex"]
set transponder [expr $transponder + 1]
# append sat and transponder info to signal_text
set signal_text $signal_text-$sat_text-$transponder
}
}
set signal_html " [td nowrap $signal_text] "
set chandesc "$chandesc"
## actually write the html row out to the web browser
puts $chan [tr "" $td_rcv $td_fav [td $logostr] $td_channum $td_callsign $td_channame [td $chandesc] $signal_html ]
}
}
puts $chan [html_table_end]
puts $chan [html_form_input "submit" "update" "Update Changes"]
}
puts $chan [html_end]
}
########################################################################
## this proc creates a file of tcl commands to set up rcv and fav flags
## for any that are turned on. If off, variable won't exist. This
## file will be "executed" (sourced) during the restore process.
proc SaveFlagsToFile {chan fname} {
global channeltablestation channeltablenum
puts $chan "
Saving current Receive and Favorite flag settings to \"$fname\", please wait......
" # create directory if it doesn't exist set fname_path [file dirname $fname] if {![file isdirectory $fname_path]} { catch {file mkdir $fname_path} } # backup the previous backup if {[file exists $fname]} { catch [file copy -force $fname "$fname.old"] } # open file writable and start writing out tcl code set fd 0 if !{[catch {set fd [open $fname "w"]}]} { puts $fd "# Save file created by ChannelPrefs TWP module." set todaystr [clock format [clock seconds] -format "%a %b %d %Y %H:%M:%S"] puts $fd "# Created at $todaystr" ## get array of Rcv'd channels set channelnumlist [array names channeltablenum] ## loop through all of them and write statements to save file foreach channum [lsort -real $channelnumlist] { if { $channum > 999 } { continue } puts $fd " set savefile_rcv($channum) \"on\" " ## write out statement for fav if on set stationfsid $channeltablenum($channum) catch { set data $channeltablestation($stationfsid) } if {[info exists data]} { set favorite [lindex $data 1] if {$favorite > 0} { puts $fd " set savefile_fav($channum) \"on\" " } } } puts $fd "################### End of data ########################" close $fd puts $chan "SUCCESS!
" } else { puts $chan "ERROR - Could not open file \"$fname\" for writing
"
}
}
#################################################################################
# ADD CHANNEL TO FAVORITES
# remember that the Favorite attribute is only present when it is 1, or "In Favorites"
proc AddToFavorites {chan stationfsid} {
global channeltablestation
global channeltablestation_alt
global channeltablenum
global channeltablenum_alt
global db
puts $chan "ADDING "
# get data from either table, and remember which one
set rcv "1"
if { [catch {set data $channeltablestation($stationfsid)}] == 1 } {
set data $channeltablestation_alt($stationfsid)
set rcv "0"
}
set msg ""
if {[info exists data]} {
set num [lindex $data 0]
puts -nonewline $chan "Channel $num to \"Favorite Channels\" --"
set channel [lindex $data 5]
regexp {([0-9]*)/(.*)} $channel junk channelid channelsubid
set channelobj ""
## make sure value doesn't exist before adding it
RetryTransaction {
catch { set channelobj [db $db openidconstruction $channelid $channelsubid] }
catch { set favorite [dbobj $channelobj get Favorite] }
}
if { $channelobj != "" } {
if { $favorite == "" } {
## execute change by removing the Favorite value from mfs
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
dbobj $channelobj add Favorite "1"
}
} else {
set msg " Already Set "
}
if { $msg == "" } {
## check to make sure it changed
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
set favorite [dbobj $channelobj get Favorite]
}
if { $favorite == "1" } {
## if it did change, replace the Favorite flag in the appropriate data array to reflect change
if { $rcv == "1" } {
set channeltablestation($stationfsid) [lreplace $data 1 1 "1"]
} else {
set channeltablestation_alt($stationfsid) [lreplace $data 1 1 "1"]
}
set msg " SUCCESS! "
} else {
set msg " NOT CHANGED "
}
}
} else {
set msg " NOT CHANGED, problem rtving channelobj from MFS "
}
} else {
set msg " NOT CHANGED, problem rtving data from channeltablestation($stationfsid) "
}
puts -nonewline $chan "$msg
"
}
#################################################################################
# REMOVE CHANNEL FROM FAVORITES
# remember that the Favorite attribute is only present when it is 1, or "In Favorites"
proc RmvFromFavorites {chan stationfsid} {
global channeltablestation
global channeltablestation_alt
global channeltablenum
global channeltablenum_alt
global db
puts $chan "REMOVING "
# get data from either table, and remember which one
set rcv "1"
if { [catch {set data $channeltablestation($stationfsid)}] == 1 } {
set data $channeltablestation_alt($stationfsid)
set rcv "0"
}
set msg ""
if {[info exists data]} {
set num [lindex $data 0]
puts -nonewline $chan "Channel $num from \"Favorite Channels\" --"
set channel [lindex $data 5]
regexp {([0-9]*)/(.*)} $channel junk channelid channelsubid
set channelobj ""
## make sure value exists before removing it
RetryTransaction {
catch { set channelobj [db $db openidconstruction $channelid $channelsubid] }
catch { set favorite [dbobj $channelobj get Favorite] }
}
if { $channelobj != "" } {
if { $favorite == "1" } {
## execute change by removing the Favorite value from mfs
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
dbobj $channelobj remove Favorite
}
} else {
set msg " Already Set "
}
if { $msg == "" } {
## check to make sure it changed
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
set favorite [dbobj $channelobj get Favorite]
}
if { $favorite == "" } {
## if it did change, replace the Favorite flag in the appropriate data array to reflect change
if { $rcv == "1" } {
set channeltablestation($stationfsid) [lreplace $data 1 1 "0"]
} else {
set channeltablestation_alt($stationfsid) [lreplace $data 1 1 "0"]
}
set msg " SUCCESS! "
} else {
set msg " NOT CHANGED "
}
}
} else {
set msg " NOT CHANGED, problem rtving channelobj from MFS "
}
} else {
set msg " NOT CHANGED, problem rtving data from channeltablestation($stationfsid) "
}
puts -nonewline $chan "$msg
"
}
#################################################################################
# ADD CHANNEL TO RECEIVE LIST
# remember that the Record attribute is only present when it is 0, or "don't rcv"
proc AddToRcv {chan stationfsid} {
global channeltablestation
global channeltablestation_alt
global channeltablenum
global channeltablenum_alt
global db
puts $chan "ADDING "
# get data from either table
if { [catch {set data $channeltablestation($stationfsid)}] == 1 } {
set data $channeltablestation_alt($stationfsid)
}
set msg ""
if {[info exists data]} {
set num [lindex $data 0]
puts -nonewline $chan "Channel $num to \"Channels You Receive\" --"
set channel [lindex $data 5]
regexp {([0-9]*)/(.*)} $channel junk channelid channelsubid
set channelobj ""
## make sure value doesn't exist before adding it
RetryTransaction {
catch { set channelobj [db $db openidconstruction $channelid $channelsubid] }
catch { set record [dbobj $channelobj get Record] }
}
if { $channelobj != "" } {
if { $record == "0" } {
## execute change by removing the Record=0 and Surf=0 values from mfs
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
dbobj $channelobj remove Record
dbobj $channelobj remove Surf
}
} else {
set msg " Already Set "
}
if { $msg == "" } {
## check to make sure it changed
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
set record [dbobj $channelobj get Record]
}
if { $record == "" } {
## if it did change, adjust the four global arrays to reflect change
unset channeltablenum_alt($num)
set channeltablenum($num) $stationfsid
unset channeltablestation_alt($stationfsid)
set channeltablestation($stationfsid) $data
set msg " SUCCESS! "
} else {
set msg " NOT CHANGED "
}
}
} else {
set msg " NOT CHANGED, problem rtving channelobj from MFS "
}
} else {
set msg " NOT CHANGED, problem rtving data from channeltablestation($stationfsid) "
}
puts -nonewline $chan "$msg
"
}
#################################################################################
# REMOVE CHANNEL FROM RECEIVE LIST
# remember that the Record attribute is only present when it is 0, or "don't rcv"
proc RmvFromRcv {chan stationfsid} {
global channeltablestation
global channeltablestation_alt
global channeltablenum
global channeltablenum_alt
global db
puts $chan "REMOVING "
# get data from either table
if { [catch {set data $channeltablestation($stationfsid)}] == 1 } {
set data $channeltablestation_alt($stationfsid)
}
set msg ""
if {[info exists data]} {
set num [lindex $data 0]
puts -nonewline $chan "Channel $num from \"Channels You Receive\" --"
set channel [lindex $data 5]
regexp {([0-9]*)/(.*)} $channel junk channelid channelsubid
set channelobj ""
## make sure value doesn't exist before adding it
RetryTransaction {
catch { set channelobj [db $db openidconstruction $channelid $channelsubid] }
catch { set record [dbobj $channelobj get Record] }
}
if { $channelobj != "" } {
if { $record == "" } {
## execute change by adding the Record=0 and Surf=0 values to mfs
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
dbobj $channelobj add Record "0"
dbobj $channelobj add Surf "0"
}
} else {
set msg " Already Set "
}
if { $msg == "" } {
## check to make sure it changed
RetryTransaction {
set channelobj [db $db openidconstruction $channelid $channelsubid]
set record [dbobj $channelobj get Record]
}
if { $record == "0" } {
## if it did change, adjust the four global arrays to reflect change
unset channeltablenum($num)
set channeltablenum_alt($num) $stationfsid
unset channeltablestation($stationfsid)
set channeltablestation_alt($stationfsid) $data
set msg " SUCCESS! "
} else {
set msg " NOT CHANGED "
}
}
} else {
set msg " NOT CHANGED, problem rtving channelobj from MFS "
}
} else {
set msg " NOT CHANGED, problem rtving data from channeltablestation($stationfsid) "
}
puts -nonewline $chan "$msg
"
}
#########################################################################
## process link for changing channel on livetv ##
proc action_channelprefs_change {chan path env} {
## only do this for version with supported SendKey
if {$::version < 6} {
## remove the leading slash
if {[string index $path 0] == "/"} {
set path [string range $path 1 end]
}
# send each digit of number as keystroke, followed by the enter key
foreach s [ split $path {} ] {
if {$s == "-" } {
set s "delimiter"
}
SendKey $s
}
SendKey enter
# close browser window when work is done
puts $chan ""
}
}
########################################################################
register_module "channelprefs" "Channel Prefs" "Set Channel Preferences"