# $Id: RssReader-0.5d.tcl.txt,v 1.1 2008/01/08 05:53:58 aegrumet Exp $ # RssReader module for Tivo Control Station # version 0.5d -- Experimental # # by aegrumet@alum.mit.edu on 2004-03-20 # # Reads a RSS2.0 feed and displays it on your TV screen. # # Bug reports, comments etc go here: # http://grumet.net/weblog/archives/2004/03/20/rssreader_04d.html # # This code is based loosely on the WebTemplate.tcl file # in tcs/modules/samples. # # You have to have a networked Tivo running Tivo Control Station # (http://www.zirakzigil.net/tivo/TCS.html) for this to work. # # Installation instructions # 1. Copy this file to your hard drive and rename to RssReader.tcl. # 2. Edit the CONSTANTS below. # Optional: edit the remotecommand. # 3. Stop TCS # 4. Copy the edited file to the TCS modules/modules subdirectory on Tivo. # 5. Create a link # cd tcs/modules # ln modules/RssReader.tcl # 6. /var/hack/tcs/starttcs & #Builds a list of lists containing information about the active channels. #Each sub-list is in the following format # # sfsid number CallSign Affiliation # proc RssBuildActiveChannelsInfo {} { global db global RssActiveChannelsInfo set RssActiveChannelsInfo [list] set numbers_checked [list] set added 1 set start 0 #We assume the channel list will be returned in a consistent order each time. while { $added > 0 } { set added 0 RetryTransaction { set Setup [db $db open /Setup] set Source [dbobj $Setup get Source] set channels [dbobj $Source get Channel] for {set i 0} {$i < [llength $channels]} {incr i} { if { $i < $start } continue if { $added > 25 } continue set chan [lindex $channels $i] set number [dbobj $chan get Number] set station [dbobj $chan get Station] set sfsid [dbobj $station fsid] set CallSign [dbobj $station get CallSign] set Affiliation [dbobj $station get Affiliation] lappend RssActiveChannelsInfo [list $sfsid $number $CallSign $Affiliation] incr added } } incr start $added } } # Convert XMLTV date to tivo date. proc RssXmltvToTivoTime {datestr} { set unixdate "[string range $datestr 0 7] [string range $datestr 8 9]:[string range $datestr 10 11]:[string range $datestr 12 13][string range $datestr 14 end]" #'date' is just the GNU date utility that ships with tivo linux. return [exec date -d $unixdate +%s] } # Convert XMLTV codes to ones that Tivo can understand, and # try to schedule a ToDo item. Returns the recording fsid if successful, # 0 otherwise. # # Sample XMLTV codes # channel="C1vod.zap2it.com" # start="20040204020000 EST" # stop="20040204060000 EST" # # Returns: [list "Status String" Fsid] proc RssTryToSchedule {TvChannel TvStart TvStop title subtitle description} { global RssScheduleAttempts global RssRecordingLegalDaysAhead global RssStationFsidCallback #Parse start and stop times. if { [catch { set starttime [RssXmltvToTivoTime $TvStart] set stoptime [RssXmltvToTivoTime $TvStop] }] } { return [list "Bad start or stop time" 0] } #Check start and stop times integrity if { $starttime > $stoptime || $starttime < [clock seconds] } { return [list "Time interval is reversed or in the past" 0] } set startday [expr $starttime / 86400] set nowday [expr [clock seconds] / 86400] if { $startday > ($nowday + $RssRecordingLegalDaysAhead) } { return [list "Start time exceeds Legal Days Ahead from now" 0] } #Check if we've already tried to schedule this one. foreach attemptinfo $RssScheduleAttempts { set att_st [lindex $attemptinfo 0] if { $att_st == $starttime } { return [lrange $attemptinfo 1 2] } } #Look up the fsid for the channel. set sfsid_lookup_info [$RssStationFsidCallback $TvChannel] set sfsid_lookup_success_p [lindex $sfsid_lookup_info 0] set sfsid [lindex $sfsid_lookup_info 1] if { !$sfsid_lookup_success_p } { return [list "Bad TV channel" 0] } #If we get here, it's time to look for conflicts. #RecConflictsList is a Tivoweb proc. set cancellists [RecConflictsList $starttime $stoptime] set cancellist [lindex $cancellists 0] if { [llength $cancellist] > 0 } { #Fail on conflicts -- we're not gonna overwrite normally #scheduled stuff. lappend RssScheduleAttempts [list $starttime "Conflict" 0] return [list "Conflict" 0] } #Cancel conflicting suggestions. #DeleteTodoRec is a Tivoweb proc. set cancellistsug [lindex $cancellists 1] foreach cancelfsid $cancellistsug { DeleteTodoRec $cancelfsid 10 "Deleting to record another program" } #Do the deed. set recfsid [RssMakeTodoRec $sfsid $starttime $stoptime $title $subtitle $description] lappend RssScheduleAttempts [list $starttime "Ok" $recfsid] return [list "Ok" $recfsid] } #Returns a tcl list containing: success_p sfsid proc RssCallSignCallback TvChannel { if { [regexp {^C([0-9]+)([^\.]+)} $TvChannel match snum csign] } { return [RssFindAStationByCallSign $csign] } else { return [list 0 0] } } proc RssFindAStationByNumber { snum } { return [RssFindAStationLookup 1 $snum] } proc RssFindAStationByCallSign { csign } { return [RssFindAStationLookup 2 $csign] } proc RssFindAStationByAffiliation { affil } { return [RssFindAStationLookup 3 "{$affil Affiliate}"] } proc RssFindAStationLookup { offset val } { global RssActiveChannelsInfo foreach info $RssActiveChannelsInfo { if { [string tolower [lindex $info $offset]] == [string tolower $val] } { return [list 1 [lindex $info 0]] } } return [list 0 0] } #See #http://alt.org/forum/index.php?t=msg&goto=666&rid=246&S=8d6619190ab09dd8803c11b44328ba17 proc RssMakeTodoRec { sfsid start stop title subtitle description } { global version3 db if { $title == "" } { set title "unknown title - inserting" } set startdate [expr $start / 86400] set starttime [expr $start % 86400] set stopdate [expr $stop / 86400] set stoptime [expr $stop % 86400] set Duration [expr $stop - $start] RetryTransaction { set recording [db $db create Recording] set recordingfsid [ dbobj $recording fsid ] dbobj $recording set BitRate 0 dbobj $recording set ExpirationTime 0 dbobj $recording set RecordQuality 40 dbobj $recording set Score 100 dbobj $recording set State 6 dbobj $recording set ExpirationDate [expr $startdate + 7] dbobj $recording set SelectionType 3 dbobj $recording set StartDate $startdate dbobj $recording set StopDate $stopdate dbobj $recording set StartTime $starttime dbobj $recording set StopTime $stoptime set station [db $db openid $sfsid] if { $version3 } { dbobj $recording set UsedBy 1 set recordingbehavior [db $db createsub RecordingBehavior $recording] foreach Behavior {DiskBehavior PresentationBehavior ProgramGuideBehavior} { dbobj $recordingbehavior set $Behavior 1 } dbobj $recordingbehavior set TunerBehavior 3 dbobj $recording set RecordingBehavior $recordingbehavior } set showing [db $db createsub Showing $recording] dbobj $showing set Date $startdate dbobj $showing set Duration $Duration dbobj $showing set Station $station dbobj $showing set Time $starttime dbobj $recording set Showing $showing dbobj $recording set StreamFileSize 0 set program [db $db create Program] dbobj $program set Title "*$title" dbobj $program set EpisodeTitle $subtitle dbobj $program set Description $description dbobj $program set OriginalAirDate "$startdate" dbobj $showing set Program $program } return $recordingfsid } ################################### #Remove tags, unescape HTML entities, etc. proc RssCleanContent str { regsub -all {<} $str {<} str regsub -all {>} $str {>} str regsub -all {<[^>]*>} $str {} str regsub -all {"} $str {"} str regsub -all {&} $str {&} str return [string trim $str] } proc ProcessRssLine { s } { global WebFinished global RssStreamBuf global RssChanTitle global RssItems global RssRecordingEnabledP global RssMaxItems # EOF MAY never be set on the socket if {[eof $s] || [catch {gets $s line}]} { set WebFinished 1 catch {close $s} return } append RssStreamBuf $line #Try to get the channel title if we don't have it. if {[string compare $RssChanTitle ""] == 0 } { set StartTitle [string first "" $RssStreamBuf] set EndTitle [string first "" $RssStreamBuf] if { $EndTitle > -1 } { set TitleContent [string range $RssStreamBuf [expr $StartTitle + 7] [expr $EndTitle -1 ]] set RssChanTitle [RssCleanContent $TitleContent] #Discard everything up to and including set RssStreamBuf [string range $RssStreamBuf [expr $EndTitle + 8] end] } } set StartItem [string first "" $RssStreamBuf] set EndItem [string first "" $RssStreamBuf] if { $StartItem > -1 && [string compare $RssChanTitle ""] == 0 } { set RssChanTitle "Error parsing channel title" } while { $StartItem > -1 && $EndItem > -1 && $EndItem > $StartItem } { set ItemContent [string range $RssStreamBuf [expr $StartItem + 6] [expr $EndItem -1 ]] set RssItem "" #Get the title and description. if { [regexp -nocase {(.*)} $ItemContent match ItemTitle] } { append RssItem "[string toupper [RssCleanContent $ItemTitle]] " } if { [regexp -nocase {(.*)} $ItemContent match ItemDesc] } { append RssItem [RssCleanContent $ItemDesc] } #Look for program information. if { $RssRecordingEnabledP && \ [regexp -nocase {(.*)} $ItemContent match TvChannel] && \ [regexp -nocase {(.*)} $ItemContent match TvStart] && \ [regexp -nocase {(.*)} $ItemContent match TvStop] } { if { ![info exists ItemTitle] } { set ItemTitle "Unknown" } if { ![info exists ItemDesc] } { set ItemDesc "Unknown" } if { ![regexp -nocase {(.*)} $ItemContent match ItemSubTitle] } { set ItemSubTitle "" } set schedres [RssTryToSchedule $TvChannel $TvStart $TvStop $ItemTitle $ItemSubTitle $ItemDesc] append RssItem "...Schedule Result: [lindex $schedres 0] ([lindex $schedres 1])" } lappend RssItems $RssItem set RssStreamBuf [string range $RssStreamBuf [expr $EndItem + 6] end] set StartItem [string first "" $RssStreamBuf] set EndItem [string first "" $RssStreamBuf] } #Quit parsing as early as we can. if { [llength $RssItems] >= $RssMaxItems || [string first "" $line] > -1} { set WebFinished 1 } return } proc WriteRssReaderFile {path} { global RssStreamBuf global RssChanTitle global RssItems set f [open $path w 0777] if { [string length $RssChanTitle] > 40} { set RssChanTitle [string range $RssChanTitle 0 39] } PutPaddedLine $f "$RssChanTitle" 40 PutPaddedLine $f [CurrentTime] 40 PutPaddedLine $f "" 40 set maxlines 24 set maxdispline [expr $maxlines-2] set curline 4 set filenum 0 set maxitemlines 4 foreach item $RssItems { set itemlines 0 foreach line [WordSplitLine $item] { if { $itemlines > $maxitemlines } continue if {$curline<=$maxdispline} { PutPaddedLine $f $line 40 incr curline } else { PutPaddedLine $f "" 40 PutPaddedLine $f " --- more ---" 40 flush $f close $f incr filenum set fname "$path$filenum" set f [open $fname w 0777] PutPaddedLine $f "$RssChanTitle" 40 PutPaddedLine $f [CurrentTime] 40 PutPaddedLine $f "" 40 PutPaddedLine $f $line 40 set curline 5 } incr itemlines } puts $f "" incr curline } flush $f close $f #Delete extra files from the last sweep. incr filenum DeleteDisplayFiles $path $filenum return 1 } proc InitializeRssReader {} { global RssStreamBuf global RssChanTitle global RssItems global RssScheduleAttempts global RssActiveChannelsBuildTime global RssActiveChannelsTimeout global RssActiveChannelsInfo global RssRecordingEnabledP set RssStreamBuf "" set RssChanTitle "" set RssItems [list] #Prune old stuff. set now [clock seconds] set pruned [list] foreach attemptinfo $RssScheduleAttempts { set start [lindex $attemptinfo 0] if { $start >= $now } { lappend pruned $attemptinfo } } set RssScheduleAttempts $pruned #Build the active channels if necessary. if { $RssRecordingEnabledP && [expr $now - $RssActiveChannelsBuildTime] > $RssActiveChannelsTimeout } { RssBuildActiveChannelsInfo } } proc GetFreshRss {} { global IP global db global RssFeedHost global RssFeedPath global RssRecordingEnabledP if { $RssRecordingEnabledP } { set db [dbopen] } if { [catch { InitializeRssReader GetWebPage RssReader $IP($RssFeedHost) $RssFeedHost $RssFeedPath ProcessRssLine } errMsg] } { if { [info exists db] } { dbclose $db } error $errMsg } if { [info exists db] } { dbclose $db } global RssReaderFile set result [WriteRssReaderFile $RssReaderFile] dputs "RssReader Complete" dputs "" if {$result} { return 1 } else { puts "[CurrentTime] RssReader timeout" dputs "RssReader Complete" dputs "" return 0 } } proc InstallRssReaderModule {} { ###### GLOBALS global evrc global RssReaderFile global IP global RssScheduleAttempts global RssFeedHost global RssFeedPath global RssRecordingEnabledP global RssRecordingLegalDaysAhead global RssMaxItems global RssActiveChannelsBuildTime global RssActiveChannelsTimeout global RssActiveChannelsInfo #Takes a string representing the TvChannel and returns a tcl list containing: status sfsid global RssStationFsidCallback ###### CONSTANTS set RssFeedHost "www.grumet.net" set RssFeedPath "/rsstv/feeds/pmt" set RssRecordingEnabledP 1 set RssRecordingLegalDaysAhead 10 set RssMaxItems 9 set RssStationFsidCallback RssCallSignCallback # Interval between builds of the cache, in seconds. # This an expensive operation, so the less we have to do it, the better. # 86400 seconds is 1 day. set RssActiveChannelsTimeout [expr 86400 * 1] # Set the directory where we are set directory [file dirname [file dirname [info script]]] # Output file with the RssReader data set RssReaderFile "$directory/displayfiles/RssReader.out" # How often to look up the RssReader data in minutes set updatefrequency 120 ###### INITIALIZE #after 30000 set remotecommand [list $evrc(6) $evrc(7) $evrc(clear)] set periodicupdatefrequency [expr $updatefrequency*60*1000] set periodicupdatecommand "GetFreshRss" set RssReaderDisplayStyle 0 set RssReaderClearScreenStyle 0 set updateisgreedy 1 InstallRemoteCommand "RssReader" \ $remotecommand \ $periodicupdatefrequency \ "DisplayFile $RssReaderFile" \ $periodicupdatecommand \ $RssReaderDisplayStyle \ $RssReaderClearScreenStyle \ $updateisgreedy if {![info exists IP($RssFeedHost)]} { AddNewHost $RssFeedHost } set RssScheduleAttempts [list] # Time of last building of the active channel list. set RssActiveChannelsBuildTime 0 # This list will get rebuilt on the first run. set RssActiveChannelsInfo [list] } InstallRssReaderModule #Tivoweb compatibility global RssRecordingEnabledP if { $RssRecordingEnabledP } { proc base64dec ignore { return {set __RssReaderIgnore 0} } proc defaultval {val1 val2} { if { $val2 != "" } { return $val2 } else { return $val1 } } global TivowebCommand set TivowebPathList [split $TivowebCommand /] set TivowebHome [join [lrange $TivowebPathList 0 [expr [llength $TivowebPathList] - 2]] /] source $TivowebHome/modules/sched.itcl global version3 global version set db [dbopen] RetryTransaction { set swsystem [db $db open /SwSystem/ACTIVE] set tivoswversion [dbobj $swsystem get Name] set version [string index $tivoswversion 0] set setup [db $db open /Setup] if { [string range $tivoswversion 0 2] >= 3.0 } { set version3 1 } else { set version3 0 } } dbclose $db }