1	# $Id: RssReader-numbered.tcl.txt,v 1.1 2005/07/17 04:46:18 aegrumet Exp $
     2	# RssReader module for Tivo Control Station
     3	# version 0.5d -- Experimental
     4	#
     5	# by aegrumet@alum.mit.edu on 2004-03-20
     6	#
     7	# Reads a RSS2.0 feed and displays it on your TV screen.
     8	#
     9	# Bug reports, comments etc go here:
    10	# http://grumet.net/weblog/archives/2004/03/20/rssreader_04d.html
    11	#
    12	# This code is based loosely on the WebTemplate.tcl file
    13	# in tcs/modules/samples.
    14	#
    15	# You have to have a networked Tivo running Tivo Control Station
    16	# (http://www.zirakzigil.net/tivo/TCS.html) for this to work.
    17	#
    18	# Installation instructions
    19	# 1. Copy this file to your hard drive and rename to RssReader.tcl.
    20	# 2. Edit the CONSTANTS below.
    21	#    Optional: edit the remotecommand.
    22	# 3. Stop TCS
    23	# 4. Copy the edited file to the TCS modules/modules subdirectory on Tivo.
    24	# 5. Create a link
    25	#    cd tcs/modules
    26	#    ln modules/RssReader.tcl
    27	# 6. /var/hack/tcs/starttcs &
       

    28	#Builds a list of lists containing information about the active channels.
    29	#Each sub-list is in the following format
    30	#
    31	#    sfsid number CallSign Affiliation
    32	#
    33	proc RssBuildActiveChannelsInfo {} {
    34	    global db
    35	    global RssActiveChannelsInfo
    36	    set RssActiveChannelsInfo [list]
    37	    set numbers_checked [list]
    38	    set added 1
    39	    set start 0
       

    40	    #We assume the channel list will be returned in a consistent order each time.
    41	    while { $added > 0 } {
    42		set added 0
    43		RetryTransaction {
    44		    set Setup [db $db open /Setup]
    45		    set Source [dbobj $Setup get Source]
    46		    set channels [dbobj $Source get Channel]
    47	            for {set i 0} {$i < [llength $channels]} {incr i} {
    48	                if { $i < $start } continue
    49			if { $added > 25 } continue
    50	                set chan [lindex $channels $i]
    51			set number [dbobj $chan get Number]
    52			set station [dbobj $chan get Station]
    53			set sfsid [dbobj $station fsid] 
    54			set CallSign [dbobj $station get CallSign]
    55			set Affiliation [dbobj $station get Affiliation]
    56			lappend RssActiveChannelsInfo [list $sfsid $number $CallSign $Affiliation]
    57			incr added
    58		    }
    59		}
    60		incr start $added
    61	    }
    62	}
       

    63	# Convert XMLTV date to tivo date.
    64	proc RssXmltvToTivoTime {datestr} {
    65	    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]"
    66	    #'date' is just the GNU date utility that ships with tivo linux.
    67	    return [exec date -d $unixdate +%s]
    68	}
       

    69	# Convert XMLTV codes to ones that Tivo can understand, and
    70	# try to schedule a ToDo item.  Returns the recording fsid if successful,
    71	# 0 otherwise.
    72	#
    73	# Sample XMLTV codes
    74	#  channel="C1vod.zap2it.com"
    75	#  start="20040204020000 EST"
    76	#  stop="20040204060000 EST"
    77	#
    78	# Returns: [list "Status String" Fsid]
    79	proc RssTryToSchedule {TvChannel TvStart TvStop title subtitle description} {
       

    80	    global RssScheduleAttempts
    81	    global RssRecordingLegalDaysAhead
    82	    global RssStationFsidCallback
       

    83	    #Parse start and stop times.
    84	    if { [catch {
    85	      set starttime [RssXmltvToTivoTime $TvStart]
    86	      set stoptime [RssXmltvToTivoTime $TvStop]
    87	    }] } {
    88		return [list "Bad start or stop time" 0]
    89	    }
       

    90	    #Check start and stop times integrity
    91	    if { $starttime > $stoptime || $starttime < [clock seconds] } {
    92		return [list "Time interval is reversed or in the past" 0]
    93	    }
    94	    set startday [expr $starttime / 86400]
    95	    set nowday [expr [clock seconds] / 86400]
    96	    if { $startday > ($nowday + $RssRecordingLegalDaysAhead) } {
    97		return [list "Start time exceeds Legal Days Ahead from now" 0]
    98	    }
       

    99	    #Check if we've already tried to schedule this one.
   100	    foreach attemptinfo $RssScheduleAttempts {
   101		set att_st [lindex $attemptinfo 0]
   102		if { $att_st == $starttime } {
   103		    return [lrange $attemptinfo 1 2]
   104		}
   105	    }
       

   106	    #Look up the fsid for the channel.
   107	    set sfsid_lookup_info [$RssStationFsidCallback $TvChannel]
   108	    set sfsid_lookup_success_p [lindex $sfsid_lookup_info 0]
   109	    set sfsid [lindex $sfsid_lookup_info 1]
       

   110	    if { !$sfsid_lookup_success_p } {
   111		return [list "Bad TV channel" 0]
   112	    }
       

   113	    #If we get here, it's time to look for conflicts.
   114	    #RecConflictsList is a Tivoweb proc. 
   115	    set cancellists [RecConflictsList $starttime $stoptime]
   116	    set cancellist [lindex $cancellists 0]
   117	    if { [llength $cancellist] > 0 } {
   118		#Fail on conflicts -- we're not gonna overwrite normally
   119	        #scheduled stuff.
   120		lappend RssScheduleAttempts [list $starttime "Conflict" 0]
   121		return [list "Conflict" 0]
   122	    }
       

   123	    #Cancel conflicting suggestions.
   124	    #DeleteTodoRec is a Tivoweb proc.
   125	    set cancellistsug [lindex $cancellists 1]
   126	    foreach cancelfsid $cancellistsug {
   127		DeleteTodoRec $cancelfsid 10 "Deleting to record another program"
   128	    }
       

   129	    #Do the deed.
   130	    set recfsid [RssMakeTodoRec $sfsid $starttime $stoptime $title $subtitle $description]
       

   131	    lappend RssScheduleAttempts [list $starttime "Ok" $recfsid]
       

   132	    return [list "Ok" $recfsid]
   133	}
       

   134	#Returns a tcl list containing: success_p sfsid
   135	proc RssCallSignCallback TvChannel {
   136	    if { [regexp {^C([0-9]+)([^\.]+)} $TvChannel match snum csign] } {
   137		return [RssFindAStationByCallSign $csign]
   138	    } else {
   139		return [list 0 0]
   140	    }
   141	}
       

   142	proc RssFindAStationByNumber { snum } {
   143	    return [RssFindAStationLookup 1 $snum]
   144	}
       

   145	proc RssFindAStationByCallSign { csign } {
   146	    return [RssFindAStationLookup 2 $csign]
   147	}
       

   148	proc RssFindAStationByAffiliation { affil } {
   149	    return [RssFindAStationLookup 3 "{$affil Affiliate}"]
   150	}
       

   151	proc RssFindAStationLookup { offset val } {
   152	    global RssActiveChannelsInfo
   153	    foreach info $RssActiveChannelsInfo {
   154		if { [string tolower [lindex $info $offset]] == [string tolower $val] } {
   155		    return [list 1 [lindex $info 0]]
   156		}
   157	    }
   158	    return [list 0 0] 
   159	}
       

   160	#See #http://alt.org/forum/index.php?t=msg&goto=666&rid=246&S=8d6619190ab09dd8803c11b44328ba17
   161	proc RssMakeTodoRec { sfsid start stop title subtitle description } {
   162	    global version3 db
   163	    if { $title == "" } { set title "unknown title - inserting" }
   164	    set startdate [expr $start / 86400]
   165	    set starttime [expr $start % 86400]
   166	    set stopdate [expr $stop / 86400]
   167	    set stoptime [expr $stop % 86400]
   168	    set Duration [expr $stop - $start]
   169	    RetryTransaction {
   170		set recording [db $db create Recording]
   171		set recordingfsid [ dbobj $recording fsid ]
   172		dbobj $recording set BitRate 0
   173		dbobj $recording set ExpirationTime 0
   174		dbobj $recording set RecordQuality 40
   175		dbobj $recording set Score 100
   176		dbobj $recording set State 6
   177		dbobj $recording set ExpirationDate [expr $startdate + 7]
   178		dbobj $recording set SelectionType 3
   179		dbobj $recording set StartDate $startdate
   180		dbobj $recording set StopDate $stopdate
   181		dbobj $recording set StartTime $starttime
   182		dbobj $recording set StopTime $stoptime
   183		set station [db $db openid $sfsid]
   184		if { $version3 } {
   185		    dbobj $recording set UsedBy 1
   186		    set recordingbehavior [db $db createsub RecordingBehavior $recording]
   187		    foreach Behavior {DiskBehavior PresentationBehavior ProgramGuideBehavior} { dbobj $recordingbehavior set $Behavior 1 }
   188		    dbobj $recordingbehavior set TunerBehavior 3
   189		    dbobj $recording set RecordingBehavior $recordingbehavior
   190		}
   191		set showing [db $db createsub Showing $recording]
   192		dbobj $showing set Date $startdate
   193		dbobj $showing set Duration $Duration
   194		dbobj $showing set Station $station
   195		dbobj $showing set Time $starttime
   196		dbobj $recording set Showing $showing
   197		dbobj $recording set StreamFileSize 0
   198		set program [db $db create Program]
   199		dbobj $program set Title "*$title"
   200		dbobj $program set EpisodeTitle $subtitle
   201	        dbobj $program set Description $description
   202		dbobj $program set OriginalAirDate "$startdate"
   203		dbobj $showing set Program $program
   204	    }
   205	    return $recordingfsid
   206	}
   207	###################################
       

   208	#Remove tags, unescape HTML entities, etc.
   209	proc RssCleanContent str {
   210	    regsub -all {&lt;} $str {<} str
   211	    regsub -all {&gt;} $str {>} str
   212	    regsub -all {<[^>]*>} $str {} str
   213	    regsub -all {&quot;} $str {"} str
   214	    regsub -all {&amp;} $str {&} str
   215	    return [string trim $str]
   216	}
       

   217	proc ProcessRssLine { s } {
       

   218	    global WebFinished
   219	    global RssStreamBuf
   220	    global RssChanTitle
   221	    global RssItems
   222	    global RssRecordingEnabledP
   223	    global RssMaxItems
       

   224	    # EOF MAY never be set on the socket 
   225	    if {[eof $s] || [catch {gets $s line}]} {
   226		set WebFinished 1
   227		catch {close $s}
   228		return
   229	    }
       

   230	    append RssStreamBuf $line
       

   231	    #Try to get the channel title if we don't have it.
   232	    if {[string compare $RssChanTitle ""] == 0 } {
   233		set StartTitle [string first "<title>" $RssStreamBuf]
   234		set EndTitle [string first "</title>" $RssStreamBuf]
   235		if { $EndTitle > -1 } {
   236		    set TitleContent [string range $RssStreamBuf [expr $StartTitle + 7] [expr $EndTitle -1 ]]
   237		    set RssChanTitle [RssCleanContent $TitleContent]
   238		    #Discard everything up to and including </title>
   239		    set RssStreamBuf [string range $RssStreamBuf [expr $EndTitle + 8] end]
   240		}
   241	    }
       

   242	    set StartItem [string first "<item>" $RssStreamBuf]
   243	    set EndItem [string first "</item>" $RssStreamBuf]
       

   244	    if { $StartItem > -1 && [string compare $RssChanTitle ""] == 0 } {
   245		set RssChanTitle "Error parsing channel title"
   246	    }
       

   247	    while { $StartItem > -1 && $EndItem > -1 && $EndItem > $StartItem } {
   248		set ItemContent [string range $RssStreamBuf [expr $StartItem + 6] [expr $EndItem -1 ]]
   249		set RssItem ""
       

   250	        #Get the title and description.
   251		if { [regexp -nocase {<title>(.*)</title>} $ItemContent match ItemTitle] } {
   252		    append RssItem "[string toupper [RssCleanContent $ItemTitle]] "
   253		}
   254		if { [regexp -nocase {<description>(.*)</description>} $ItemContent match ItemDesc] } {
   255		    append RssItem [RssCleanContent $ItemDesc]
   256		}
       

   257	        #Look for program information.
   258		if { $RssRecordingEnabledP && \
   259	             [regexp -nocase {<tv:tvchannel>(.*)</tv:tvchannel>} $ItemContent match TvChannel] && \
   260	             [regexp -nocase {<tv:start>(.*)</tv:start>} $ItemContent match TvStart] && \
   261	             [regexp -nocase {<tv:stop>(.*)</tv:stop>} $ItemContent match TvStop] } {
   262	            if { ![info exists ItemTitle] } { set ItemTitle "Unknown" }
   263	            if { ![info exists ItemDesc] } { set ItemDesc "Unknown" }
   264		    if { ![regexp -nocase {<tv:sub-title>(.*)</tv:sub-title>} $ItemContent match ItemSubTitle] } {
   265			set ItemSubTitle ""
   266		    }
   267		    set schedres [RssTryToSchedule $TvChannel $TvStart $TvStop $ItemTitle $ItemSubTitle $ItemDesc]
   268		    append RssItem "...Schedule Result: [lindex $schedres 0] ([lindex $schedres 1])"
   269	            
   270	        }
   271		lappend RssItems $RssItem
       

   272		set RssStreamBuf [string range $RssStreamBuf [expr $EndItem + 6] end]
   273		set StartItem [string first "<item>" $RssStreamBuf]
   274		set EndItem [string first "</item>" $RssStreamBuf]
   275	    }
       

   276	    #Quit parsing as early as we can.
   277	    if {  [llength $RssItems] >= $RssMaxItems  || [string first "</rss>" $line] > -1} {
   278		set WebFinished 1
   279	    } 
       

   280	    return
       

   281	}
       

   282	proc WriteRssReaderFile {path} {
       

   283	    global RssStreamBuf
   284	    global RssChanTitle
   285	    global RssItems
       

   286	    set f [open $path w 0777]
   287	    if { [string length $RssChanTitle] > 40} {
   288		set RssChanTitle [string range $RssChanTitle 0 39]
   289	    }
   290	    PutPaddedLine $f "$RssChanTitle" 40
   291	    PutPaddedLine $f [CurrentTime] 40
   292	    PutPaddedLine $f "" 40
       

   293	    set maxlines 24
   294	    set maxdispline [expr $maxlines-2]
   295	    set curline 4
   296	    set filenum 0
   297	    set maxitemlines 4
       

   298	    foreach item $RssItems {
   299		set itemlines 0
   300		foreach line [WordSplitLine $item] {
       

   301		    if { $itemlines > $maxitemlines } continue
       

   302		    if {$curline<=$maxdispline} {
   303			PutPaddedLine $f $line 40
   304			incr curline
   305		    } else {
   306			PutPaddedLine $f "" 40
   307			PutPaddedLine $f "               --- more ---" 40
   308			flush $f
   309			close $f
   310			incr filenum
   311			set fname "$path$filenum"
   312			set f [open $fname w 0777]
   313			PutPaddedLine $f "$RssChanTitle" 40
   314			PutPaddedLine $f [CurrentTime] 40
   315			PutPaddedLine $f "" 40
   316			PutPaddedLine $f $line 40
   317			set curline 5
   318		    }
   319		    incr itemlines
   320		}
   321		puts $f ""
   322		incr curline
   323	    }
       

   324	    flush $f
   325	    close $f
       

   326	    #Delete extra files from the last sweep.
   327	    incr filenum
   328	    DeleteDisplayFiles $path $filenum
       

   329	    return 1
   330	}
       

   331	proc InitializeRssReader {} {
       

   332	    global RssStreamBuf
   333	    global RssChanTitle
   334	    global RssItems
   335	    global RssScheduleAttempts
   336	    global RssActiveChannelsBuildTime
   337	    global RssActiveChannelsTimeout
   338	    global RssActiveChannelsInfo
   339	    global RssRecordingEnabledP
       

   340	    set RssStreamBuf ""  
   341	    set RssChanTitle ""
   342	    set RssItems [list]
       

   343	    #Prune old stuff.
   344	    set now [clock seconds]
   345	    set pruned [list]
   346	    foreach attemptinfo $RssScheduleAttempts {
   347		set start [lindex $attemptinfo 0]
   348		if { $start >= $now } {
   349		    lappend pruned $attemptinfo
   350		}
   351	    }
   352	    set RssScheduleAttempts $pruned
       

   353	    #Build the active channels if necessary. 
   354	    if { $RssRecordingEnabledP && [expr $now - $RssActiveChannelsBuildTime] >  $RssActiveChannelsTimeout } {
   355		RssBuildActiveChannelsInfo
   356	    }
   357	}
       

   358	proc GetFreshRss {} {
       

   359	    global IP
   360	    global db
   361	    global RssFeedHost
   362	    global RssFeedPath
   363	    global RssRecordingEnabledP
       

   364	    if { $RssRecordingEnabledP } {
   365		set db [dbopen]
   366	    }
       

   367	    if { [catch {
   368		InitializeRssReader
   369		GetWebPage RssReader $IP($RssFeedHost) $RssFeedHost $RssFeedPath ProcessRssLine
   370	    } errMsg] } {
   371		if { [info exists db] } {
   372		    dbclose $db
   373		}
   374		error $errMsg
   375	    }
       

   376	    if { [info exists db] } {
   377		dbclose $db
   378	    }
       

   379	    global RssReaderFile
   380	    set result [WriteRssReaderFile $RssReaderFile]
   381	    dputs "RssReader Complete"
   382	    dputs ""
   383	    if {$result} {
   384		return 1
   385	    } else {
   386		puts "[CurrentTime] RssReader timeout"
   387		dputs "RssReader Complete"
   388		dputs ""
   389		return 0
   390	    }
   391	}
       

   392	proc InstallRssReaderModule {} {
       

   393	    ###### GLOBALS
       

   394	    global evrc
   395	    global RssReaderFile
   396	    global IP
   397	    global RssScheduleAttempts
       

   398	    global RssFeedHost
   399	    global RssFeedPath
   400	    global RssRecordingEnabledP
   401	    global RssRecordingLegalDaysAhead
   402	    global RssMaxItems
       

   403	    global RssActiveChannelsBuildTime
   404	    global RssActiveChannelsTimeout
   405	    global RssActiveChannelsInfo
       

   406	    #Takes a string representing the TvChannel and returns a tcl list containing: status sfsid
   407	    global RssStationFsidCallback
       

   408	    ###### CONSTANTS
       

   409	    set RssFeedHost "www.grumet.net"
   410	    set RssFeedPath "/rsstv/feeds/pmt"
   411	    set RssRecordingEnabledP 1
   412	    set RssRecordingLegalDaysAhead 10
   413	    set RssMaxItems 9
   414	    set RssStationFsidCallback RssCallSignCallback
       

   415	    # Interval between builds of the cache, in seconds.
   416	    # This an expensive operation, so the less we have to do it, the better.
   417	    # 86400 seconds is 1 day.
   418	    set RssActiveChannelsTimeout [expr 86400 * 1]
       

   419	    # Set the directory where we are
       

   420	    set directory [file dirname [file dirname [info script]]]
       

   421	    # Output file with the RssReader data
       

   422	    set RssReaderFile	"$directory/displayfiles/RssReader.out"	
       

   423	    # How often to look up the RssReader data in minutes
       

   424	    set updatefrequency 120
       

   425	    ###### INITIALIZE
       

   426	    #after 30000
       

   427	    set remotecommand [list $evrc(6) $evrc(7) $evrc(clear)]
   428	    set periodicupdatefrequency [expr $updatefrequency*60*1000]
   429	    set periodicupdatecommand "GetFreshRss"
   430	    set RssReaderDisplayStyle 0
   431	    set RssReaderClearScreenStyle 0
   432	    set updateisgreedy 1
       

   433	    InstallRemoteCommand "RssReader" \
   434		$remotecommand \
   435		$periodicupdatefrequency \
   436		"DisplayFile $RssReaderFile" \
   437		$periodicupdatecommand \
   438		$RssReaderDisplayStyle \
   439		$RssReaderClearScreenStyle \
   440		$updateisgreedy
       

   441	    if {![info exists IP($RssFeedHost)]} {
   442		AddNewHost $RssFeedHost
   443	    }
   444	    set RssScheduleAttempts [list]
       

   445	    # Time of last building of the active channel list.
   446	    set RssActiveChannelsBuildTime 0
       

   447	    # This list will get rebuilt on the first run.
   448	    set RssActiveChannelsInfo [list]
       

   449	}
       

   450	InstallRssReaderModule
       

   451	#Tivoweb compatibility
   452	global RssRecordingEnabledP
   453	if { $RssRecordingEnabledP } {
   454	    proc base64dec ignore { return {set __RssReaderIgnore 0} }
   455	    proc defaultval {val1 val2} {
   456		if { $val2 != "" } {
   457		    return $val2
   458		} else {
   459		    return $val1
   460		}
   461	    }
   462	    global TivowebCommand
   463	    set TivowebPathList [split $TivowebCommand /]
   464	    set TivowebHome [join [lrange $TivowebPathList 0 [expr [llength $TivowebPathList] - 2]] /]
   465	    source $TivowebHome/modules/sched.itcl
   466	    global version3
   467	    global version
   468	    set db [dbopen]
   469	    RetryTransaction {
   470		set swsystem [db $db open /SwSystem/ACTIVE]
   471		set tivoswversion [dbobj $swsystem get Name]
   472	        set version [string index $tivoswversion 0]
   473		set setup [db $db open /Setup]
   474		
   475		if { [string range $tivoswversion 0 2] >= 3.0 } {
   476		    set version3 1
   477		} else {
   478		    set version3 0
   479		}
   480	    }
   481	    dbclose $db
   482	}