# Copyright (c) 2001 Josha Foust (tivoweb@lightn.org) # $Id: ui.itcl,v 1.25.2.1 2001/12/05 08:01:21 lightn Exp $ # try with regsub? proc PrintNames {names} { set str "" foreach name $names { if { [regexp {(.*)\|(.*)} $name junk last first] } { if { $str == "" } { set str "$first $last" } else { set str "$str, $first $last" } } } return $str } proc action_channellist {chan type env} { global db global channeltablestation global channeltablenum global channeltablebits if {[string index $type 0] == "/"} { set type [string range $type 1 end] } puts $chan [html_start "Channel Guide"] if { $type == "" } { puts $chan [html_table_start "" "" "ALIGN=TOP"] puts $chan [tr "" [th "" "Channel Guide"]] puts $chan [tr "" [td [html_link "/channellist/1" "All"]]] puts $chan [tr "" [td [html_link "/channellist/2" "Watch"]]] puts $chan [tr "" [td [html_link "/channellist/3" "Favorite"]]] puts -nonewline $chan [html_table_end] } else { puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Num"] [th "Callsign"] [th "Name"]] set numchannels [llength $channeltablebits] set incrsize 50 for {set channelcount 0} {$channelcount < $numchannels} {incr channelcount $incrsize} { set maxchannelcount [expr ($numchannels > $channelcount+$incrsize) ? ($channelcount+$incrsize) : $numchannels] RetryTransaction { for {set count $channelcount} {$count < $maxchannelcount} {incr count} { set channelbit [lindex $channeltablebits $count] set watch [expr $channelbit & 0x1] set favorite [expr $channelbit & 0x2] if { $type == "2" && $watch == 0 } { continue } elseif { $type == "3" && $favorite == 0 } { continue } set channum [lindex $channeltablenum $count] set stationfsid [lindex $channeltablestation $count] set station [db $db openid $stationfsid] set callsign [dbobj $station get CallSign] set channame [strim [dbobj $station get Name]] puts $chan [tr "" [td $channum] [td [html_link "/channel/$stationfsid" $callsign]] [td $channame]] } } } puts -nonewline $chan [html_table_end] } puts $chan [html_end] } proc action_channel {chan objectid env} { global db global channeltablestation global channeltablenum global channeltablecallsign global cache_sp_fsid global cache_sp_moddate global cache_sp_key if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } puts $chan [html_start "Channel"] set stationmatch [lsearch $channeltablestation $objectid] if { $stationmatch != -1 } { set channum [lindex $channeltablenum $stationmatch] set callsign [lindex $channeltablecallsign $stationmatch] puts $chan [h1 "$channum $callsign"] puts -nonewline $chan [html_link "/listings/$objectid" "Upcoming Listings"] puts $chan "
" } else { puts $chan "Error: Unknown Station '$objectid'
" } # RetryTransaction { # if { ! [catch {mfs find "/SeasonPass"} spfsid] } { # set spmoddate [mfs moddate $spfsid] # } # } # if {$spmoddate != "" && $spmoddate != $cache_sp_moddate} { # update_sp_cache $spmoddate # } # # set first 1 # set lsize [llength $cache_sp_key] # set i 0 # while {$i < $lsize} { # set index [lsearch [lrange $cache_sp_key $i end] "*|$objectid"] # if { $index == -1 } { # break # } else { # incr i $index # RetryTransaction { # # HERE # set series [dbobj $sp get Series] # if { $first == 1 } { # puts $chan [h2 "Season Pass"] # puts $chan [html_table_start "" "" ""] # puts $chan [tr "" [th "Title"]] # set first 0 # } # set seriesfsid [dbobj $series fsid] # set title [strim [dbobj $series get Title]] # puts $chan [tr "" [td [html_link "/series/$seriesfsid" $title]]] # } # } # } # if { $first == 0 } { # puts -nonewline $chan [html_table_end] # } set first 1 ForeachMfsFileTrans fsid name type "/SeasonPass" "" 20 { set sp [db $db openid $fsid] set type [defaultval 1 [dbobj $sp get Type]] if { $type == 1 } { set station [dbobj $sp get Station] set stationfsid [dbobj $station fsid] if { $stationfsid == $objectid } { set series [dbobj $sp get Series] if { $first == 1 } { puts $chan [h2 "Season Pass"] puts $chan [html_table_start "" "" ""] puts $chan [tr "" [th "Title"]] set first 0 } set seriesfsid [dbobj $series fsid] set title [strim [dbobj $series get Title]] puts $chan [tr "" [td [html_link "/series/$seriesfsid" $title]]] } } } if { $first == 0 } { puts -nonewline $chan [html_table_end] } puts $chan [html_end] } proc do_listingsrow {chan fsid startsecs endsecs} { global db global tzoffset set stationday [db $db openid $fsid] set showings [dbobj $stationday get Showing] foreach showing $showings { set secs [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] if { $secs >= $startsecs && $secs < $endsecs } { set showingfsid "[dbobj $showing fsid]/[dbobj $showing subobjid]" set program [dbobj $showing get Program] set series [dbobj $program get Series] set seriesfsid "" set episodic 0 if { $series != "" } { set seriesfsid [dbobj $series fsid] set episodic [dbobj $series get Episodic] } set timestr [clock format $secs -format "%l:%M %P"] set title [strim [dbobj $program get Title]] set eptitle [strim [dbobj $program get EpisodeTitle]] set partindex [dbobj $showing get PartIndex] set partcount [dbobj $showing get PartCount] if { $partcount != "" && $partindex != "" } { append eptitle " ($partindex/$partcount)" } if { $eptitle == "" } { if { $episodic == 1 } { set eptitle "UNKNOWN" } else { set eptitle $title } } if { $seriesfsid != "" } { set title [html_link "/series/$seriesfsid" $title] } puts $chan [tr "" [td $timestr] [td $title] [td [html_link "/showing/$showingfsid" $eptitle]]] } } } proc action_listings {chan path env} { global db global tzoffset global channeltablestation global channeltablenum global channeltablecallsign puts $chan [html_start "Listings"] if {[string index $path 0] == "/"} { set path [string range $path 1 end] } set firstslash [string first "/" $path] set seconds "" if { $firstslash != -1 } { set stationid [string range $path 0 [expr $firstslash - 1]] set seconds [string range $path [expr $firstslash + 1] end] } else { set stationid $path } set stationmatch [lsearch $channeltablestation $stationid] if { $stationmatch != -1 } { set channum [lindex $channeltablenum $stationmatch] set callsign [lindex $channeltablecallsign $stationmatch] } else { puts $chan "Error: Unknown Station '$stationid'" puts $chan [html_end] return 0 } if { $seconds == "" } { puts $chan [h1 "$channum $callsign"] set minday "99999" set maxday "00000" ForeachMfsFile fsid name type "/Schedule" "$stationid:" { scan $name "%d:%d:" schedsid schedday if {$minday > $schedday} { set minday $schedday } if {$maxday < $schedday} { set maxday $schedday } } set minseconds [expr ($minday - 1) * 86400 - $tzoffset] set maxseconds [expr $maxday * 86400 - $tzoffset] puts $chan [html_table_start "" "" ""] puts $chan [tr "" [th "Day"]] for {set i $minseconds} {$i <= $maxseconds} {incr i 86400} { set timestr [clock format $i -format "%a %1m/%1d"] puts $chan [tr "" [td [html_link "/listings/$stationid/$i" $timestr]]] } puts -nonewline $chan [html_table_end] puts $chan "
" } else { set day [expr ($seconds - $tzoffset) / 86400] set startsecs [expr $seconds + $tzoffset] set endsecs [expr $startsecs + 86400] set timestr [clock format $startsecs -format "%a %1m/%1d"] puts $chan [h1 "$channum $callsign - $timestr"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Time"] [th "Series"] [th "Episode"]] set firstday 1 ForeachMfsFileTrans fsid name type "/Schedule" "$stationid:$day:" 25 { if {[catch [do_listingsrow $chan $fsid $startsecs $endsecs] error]} { puts "do_listingrow $fsid $startsecs $endsecs" puts "$error" } set firstday 0 } incr day set lastday 1 ForeachMfsFileTrans fsid name type "/Schedule" "$stationid:$day:" 25 { if {[catch [do_listingsrow $chan $fsid $startsecs $endsecs] error]} { puts "do_listingrow $fsid $startsecs $endsecs" puts "$error" } set lastday 0 } puts -nonewline $chan [html_table_end] puts $chan "
" set yesterday [expr $seconds - 86400] set tommorow [expr $seconds + 86400] set timestr [clock format $yesterday -format "%a %1m/%1d"] set timestr2 [clock format $tommorow -format "%a %1m/%1d"] if { !$firstday } { puts $chan [html_link "/listings/$stationid/$yesterday" "<< $timestr"] } if { !$lastday } { puts $chan [html_link "/listings/$stationid/$tommorow" "$timestr2 >>"] } } puts $chan [html_end] } proc action_saveprogram {chan path env} { puts $chan [html_start "Edit Program"] eval $env updaterec $objectid $title $eptitle $description puts $chan "Program Updated Successfully" puts $chan [html_end] } proc action_editprogram {chan objectid env} { global db if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } puts $chan [html_start "Edit Program"] RetryTransaction { set rec [db $db openid $objectid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set description [strim [dbobj $program get Description]] set isepisode [dbobj $program get IsEpisode] puts $chan [html_form_start "POST" "/saveprogram"] puts $chan [html_form_hidden "objectid" $objectid] puts $chan [html_table_start "" "" ""] puts $chan [tr "" [td "Title"] [td [html_form_text 1 40 "title" $title]]] if { $isepisode == 1 } { set eptitle [strim [dbobj $program get EpisodeTitle]] puts $chan [tr "" [td "Episode Title"] [td [html_form_text 1 40 "eptitle" $eptitle]]] } else { puts $chan [html_form_hidden "eptitle" ""] } puts $chan [tr "" [td "Description"] [td [html_form_text 3 40 "description" $description]]] puts $chan [html_table_end] puts $chan [html_form_input "submit" "Save" "Save"] puts $chan [html_form_end] puts $chan "
" puts $chan "Cancel" } puts $chan [html_end] } proc updaterec { id newtitle neweptitle newdesc } { global db RetryTransaction { set rec [db $db openid $id] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set serverid [dbobj $program get ServerId] if { $serverid != "" } { set newpobj [db $db create Program] dbobj $newpobj copyfrom $program dbobj $newpobj remove ServerId dbobj $showing set Program $newpobj } else { set newpobj $program } dbobj $newpobj set Title $newtitle set isepisode [dbobj $newpobj get IsEpisode] if { $isepisode == 1 } { dbobj $newpobj set EpisodeTitle $neweptitle } dbobj $newpobj set Description $newdesc } } proc action_showing {chan objectid env} { global db global tzoffset global cancelreasons global selectiontypes global states global showtypes global channeltablestation global channeltablenum global channeltablecallsign global genrenums global genrevals global tvratingnums global tvratingvals global tystreams global showingbitnums global showingbitvals global advisorynums global advisoryvals global mpaaratingnums global mpaaratingvals global premieretypes global images global cache_sp_fsid global cache_sp_moddate global cache_sp_key if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } puts $chan [html_start "Showing"] RetryTransaction { if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } { set showing [db $db openidconstruction $fsid $subobjid] } else { set showing [db $db openid $objectid] } set rec [dbobj $showing get IndexUsedBy] set day [dbobj $showing get Date] set time [dbobj $showing get Time] set timestr [format "%05d" $time] set recfsid "" if { $rec == "" } { set recfsid [get_fsidbyprefix "/Recording/Active" "4:$day:$timestr:"] } set spmoddate "" if { ! [catch {mfs find "/SeasonPass"} spfsid] } { set spfsid [lindex $spfsid 0] set spmoddate [mfs moddate $spfsid] } } # set recfsid "" # if { $rec == "" } { # ForeachMfsFile fsid name type "/Recording/Active" "4:$day:$timestr:" { # set recfsid $fsid # } # } if {$spmoddate != "" && $spmoddate != $cache_sp_moddate} { update_sp_cache $spmoddate } RetryTransaction { if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } { set showing [db $db openidconstruction $fsid $subobjid] } else { set showing [db $db openid $objectid] } set rec [dbobj $showing get IndexUsedBy] set station [dbobj $showing get Station] set stationid [dbobj $station fsid] if { $rec == "" && $recfsid != "" } { set rec [db $db openid $recfsid] set showing2 [dbobj $rec get Showing] set station2 [dbobj $showing2 get Station] set stationfsid2 [dbobj $station2 fsid] if { $stationid != $stationfsid2 } { set rec "" } else { set showing $showing2 } } if { $rec != "" && $recfsid == "" } { set recfsid [dbobj $rec fsid] } set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set series [dbobj $program get Series] set seriesfsid "" set thumbs "" if { $series != "" } { set seriesfsid [dbobj $series fsid] set score [dbobj $series get ThumbData] if { $score != "" } { set imagenum [get_thumbimage $score] if { $imagenum >= 0} { set imagef [lindex $images $imagenum] set thumbs [img "" $imagef] } } } if { $seriesfsid != "" } { set title [html_link "/series/$seriesfsid" $title] } if { $rec != "" } { set seltype [dbobj $rec get SelectionType] if { $seltype == 10 || $seltype == 5 } { if { $title == "" } { set title "Manual Recording" } else { set title "Manual: $title" } } } puts $chan [h1 "$thumbs$title"] puts $chan [html_table_start "" "" ""] set episodic 0 if { $series != "" } { set episodic [dbobj $series get Episodic] } set tmstype 1 set tmsid [dbobj $program get TmsId] if { [string range $tmsid 0 1] == "MV" } { set tmstype 0 } if { [string length $tmsid] == 0 } { set tmstype $episodic } if { $tmstype == 1 } { set partindex [dbobj $showing get PartIndex] set partcount [dbobj $showing get PartCount] set partstr "" if { $partcount != "" && $partindex != "" } { set partstr " ($partindex/$partcount)" } puts $chan "
" } set actionstr "" set nowtime [clock seconds] if { $rec != "" } { if { $state == 6 } { # append actionstr [tr "" [td [html_link "/deletetodo/$recfsid" "Cancel Recording"]]] append actionstr [tr "" [td [html_link "/confirmdelete/2/$recfsid" "Cancel Recording"]]] append actionstr "\n" } elseif { $state == 4 } { append actionstr [tr "" [td [html_link "/editprogram/$recfsid" "Edit Program"]]] # append actionstr [tr "" [td [html_link "/deletens/$recfsid" "Delete Recording"]]] append actionstr [tr "" [td [html_link "/confirmdelete/1/$recfsid" "Delete Recording"]]] append actionstr "\n" } elseif { $state == 2 } { if { $nowtime < $showingstart } { append actionstr [tr "" [td [html_link "/recoptions/$objectid" "Record"]]] append actionstr "\n" } } } else { if { $nowtime < $showingstart } { append actionstr [tr "" [td [html_link "/recoptions/$objectid" "Record"]]] append actionstr "\n" } } if { $rec != "" && $programsourcefsid != "" && $programsourcetype == 1 } { append actionstr [tr "" [td [html_link "/editseasonpass/$programsourcefsid" "Edit Season Pass"]]] append actionstr "\n" } else { set sp_index [lsearch $cache_sp_key "$seriesfsid|$stationid"] if { $sp_index != -1 } { append actionstr [tr "" [td [html_link "/editseasonpass/[lindex $cache_sp_fsid $sp_index]" "Edit Season Pass"]]] append actionstr "\n" } elseif { $episodic == 1 } { append actionstr [tr "" [td [html_link "/getseasonpass/$objectid" "Get Season Pass"]]] append actionstr "\n" } } if { $actionstr != "" } { puts $chan [html_table_start "" "" ""] puts $chan [tr "" [th "Actions"]] puts $chan $actionstr puts -nonewline $chan [html_table_end] puts $chan "
" } puts $chan [html_end] } proc action_record {chan path env} { eval $env if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } puts $chan [html_start "Record"] set value [MakeTodoRecording $objectid $quality 3 $startearly $endlate $kal $conflictslist] if { $value > 0 } { puts $chan "Scheduling Successful [html_link /showing/$value Recording]" } else { puts $chan "Scheduling Failed '$value'" } puts $chan [html_end] } proc print_recoptions {chan type quality kal startearly endlate kam showtype keepuntil } { set qualvals "0 40 75 100" set quallabs "Basic Medium High Best" set kalvals "0 1 2 3 4 5 6 7" set kallabs "{Until I delete} {1 day} {2 days} {3 days} {4 days} {5 days} {6 days} {7 days}" set kamvals "1 2 3 4 5 0" set kamlabs "{1 episode} {2 episodes} {3 episodes} {4 episodes} {5 episodes} {All Episodes}" set showtvals "0 1" set showtlabs "{Repeats & first run} {First run only}" set keepuvals "0 1" set keepulabs "{Until I delete} {Space needed}" set startvals "0 1 2 3 4 5 10" set startlabs "{On-time} {1 minute early} {2 minutes early} {3 minutes early} {4 minutes early} {5 minutes early} {10 minutes early}" set endvals "0 1 2 5 15 30 60 90 180" set endlabs "{On-time} {1 minute longer} {2 minutes longer} {5 minutes longer} {15 minutes longer} {30 minutes longer} {1 hour longer} {1 1/2 hours longer} {3 hours longer}" puts $chan [tr "" [td "Record Quality"] [td [html_form_select "quality" $qualvals $quallabs $quality]]] if { $type == 0 } { puts $chan [tr "" [td "Keep At Least"] [td [html_form_select "kal" $kalvals $kallabs $kal]]] } if { $type == 1 || $type == 2 } { puts $chan [tr "" [td "Keep At Most"] [td [html_form_select "kam" $kamvals $kamlabs $kam]]] if { $type == 1 } { puts $chan [tr "" [td "Show Type"] [td [html_form_select "showtype" $showtvals $showtlabs $showtype]]] } puts $chan [tr "" [td "Keep Until"] [td [html_form_select "keepuntil" $keepuvals $keepulabs $keepuntil]]] } puts $chan [tr "" [td "Start Recording"] [td [html_form_select "startearly" $startvals $startlabs $startearly]]] puts $chan [tr "" [td "Stop Recording"] [td [html_form_select "endlate" $endvals $endlabs $endlate]]] } proc action_recoptions {chan objectid env} { global defrecquality puts $chan [html_start "Recording Options"] puts $chan [h1 "Recording Options"] puts $chan [html_form_start "POST" "/conflicts"] puts $chan [html_table_start "" "" ""] print_recoptions $chan 0 $defrecquality 2 0 0 0 0 0 puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [html_form_hidden "objectid" $objectid] puts $chan [html_form_input "submit" "Conflicts" "Conflicts"] puts $chan [html_form_end] puts $chan "
" puts $chan "Cancel" puts $chan [html_end] } proc do_conflictsrow {chan showing startearly endlate} { global db global tzoffset global channeltablestation global channeltablenum set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set showingfsid "[dbobj $showing fsid]/[dbobj $showing subobjid]" #set eptitle [strim [dbobj $program get EpisodeTitle]] set showingsecs [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] set showingendsecs [expr $showingsecs + [dbobj $showing get Duration] + $endlate] set showingsecs [expr $showingsecs - $startearly] set timestr [clock format $showingsecs -format "%1m/%1d"] set timestr2 [clock format $showingsecs -format "%l:%M %P"] set timestr3 [clock format $showingendsecs -format "%l:%M %P"] set station [dbobj $showing get Station] set callsign [dbobj $station get CallSign] set stationid [dbobj $station fsid] set index [lsearch $channeltablestation $stationid] if { $index != -1 } { set channum [lindex $channeltablenum $index] } puts $chan [tr "" [td [html_link "/showing/$showingfsid" $title]] [td $timestr] [td "$timestr2-$timestr3"] [td $channum] [td $callsign]] } proc action_conflicts {chan path env} { global db eval $env if { $objectid != "" } { if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } } else { puts $chan [html_start "Conflicts"] puts $chan "Error: no objectid in form data" puts $chan [html_end] return 1 } set conflictslist [GetConflictsList $objectid $startearly $endlate] if { [llength $conflictslist] > 0 } { puts $chan [html_start "Conflicts"] puts $chan [h1 "Conflicts"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Program"] [th "Date"] [th "Time"] [th "COLSPAN=2" "Channel"]] RetryTransaction { foreach conflict $conflictslist { set rec [db $db openid $conflict] set showing [dbobj $rec get Showing] set startearlysecs [dbobj $rec get StartPadding] if { $startearlysecs == "" } { set startearlysecs 0 } set endlatesecs [dbobj $rec get EndPadding] if { $endlatesecs == "" } { set endlatesecs 0 } if {[catch [do_conflictsrow $chan $showing $startearlysecs $endlatesecs] error]} { puts $chan [html_table_end] print_html_error $chan "do_conflictsrow $showing $startearlysecs $endlatesecs" $error puts $chan [html_end] return 1 } } } puts -nonewline $chan [html_table_end] puts $chan "
" } else { puts $chan [html_start "Conflicts"] puts $chan [h1 "No Conflicts"] } puts $chan [html_table_start "" "" "ALIGN=TOP"] RetryTransaction { if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } { set showing [db $db openidconstruction $fsid $subobjid] } else { set showing [db $db openid $objectid] } if {[catch [do_conflictsrow $chan $showing [expr $startearly * 60] [expr $endlate * 60]] error]} { puts $chan [html_table_end] print_html_error $chan "do_conflictsrow $showing [expr $startearly * 60] [expr $endlate * 60]" $error puts $chan [html_end] return 1 } } puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [html_form_start "POST" "/record"] puts $chan [html_form_hidden "quality" $quality] puts $chan [html_form_hidden "kal" $kal] puts $chan [html_form_hidden "startearly" $startearly] puts $chan [html_form_hidden "endlate" $endlate] puts $chan [html_form_hidden "objectid" $objectid] puts $chan [html_form_hidden "conflictslist" $conflictslist] puts $chan [html_form_input "submit" "Record" "Record"] puts $chan [html_form_end] puts $chan "Cancel" puts $chan [html_end] } proc action_confirmdelete {chan path env} { global db if {[string index $path 0] == "/"} { set path [string range $path 1 end] } set firstslash [string first "/" $path] set type [string range $path 0 [expr $firstslash - 1]] set recfsid [string range $path [expr $firstslash + 1] end] puts $chan [html_start "Confirm Deletion"] RetryTransaction { set rec [db $db openid $recfsid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set episodetitle [strim [dbobj $program get EpisodeTitle]] } if { $episodetitle != "" } { puts $chan "Delete '$title' '$episodetitle' ?" } else { puts $chan "Delete '$title' ?" } puts $chan "
" switch $type { 1 {puts $chan [html_link "/deletens/$recfsid" "Yes"]} 2 {puts $chan [html_link "/deletetodo/$recfsid" "Yes"]} } puts $chan "No" puts $chan [html_end] } proc action_deletens {chan recfsid env} { global db if {[string index $recfsid 0] == "/"} { set recfsid [string range $recfsid 1 end] } puts $chan [html_start "Delete Recording"] RetryTransaction { set rec [db $db openid $recfsid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set episodetitle [strim [dbobj $program get EpisodeTitle]] } if { $episodetitle != "" } { set deletestr "Deletion of '$title' '$episodetitle'" } else { set deletestr "Deletion of '$title'" } set success [DeleteNowShowingRec $recfsid] if { $success == 1 } { puts $chan "$deletestr Successful" } else { puts $chan "$deletestr Failed" } puts $chan "
" puts $chan "Back" puts $chan [html_end] } proc action_deletetodo {chan recfsid env} { global db if {[string index $recfsid 0] == "/"} { set recfsid [string range $recfsid 1 end] } puts $chan [html_start "Cancel Recording"] RetryTransaction { set rec [db $db openid $recfsid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set episodetitle [strim [dbobj $program get EpisodeTitle]] } if { $episodetitle != "" } { set deletestr "Deletion of '$title' '$episodetitle'" } else { set deletestr "Deletion of '$title'" } set success [DeleteTodoRec $recfsid 24 "Cancelled by user"] if { $success == 1 } { puts $chan "$deletestr Successful" } else { puts $chan "$deletestr Failed" } puts $chan "
" puts $chan "Back" puts $chan [html_end] } proc decode_vector {vector} { set largesti 0 set largestn 0 set first 1 set count 0 foreach val $vector { if { $val > $largestn } { set first 0 set largestn $val set largesti $count } incr count } if {$first == 1} { return 0 } else { return [expr $largesti - 3] } } proc get_thumbimage {score} { set thumbdata [ReadableThumbs $score] scan $thumbdata "%s %d" thumbtype numthumbs if {$thumbtype == "Predicted"} { switch -- $numthumbs { -3 {set imagenum 14} -2 {set imagenum 15} -1 {set imagenum 16} 1 {set imagenum 17} 2 {set imagenum 18} 3 {set imagenum 19} default {set imagenum -1} } } else { switch -- $numthumbs { -3 {set imagenum 9} -2 {set imagenum 6} -1 {set imagenum 4} 1 {set imagenum 12} 2 {set imagenum 2} 3 {set imagenum 7} default {set imagenum -1} } } return $imagenum } proc do_seriesrow {chan fsid objectid type} { global db global tzoffset global images global cache_ns_rec global cache_ns_series set index [lsearch $cache_ns_rec $fsid] if { $index != -1 } { set seriesfsid [lindex $cache_ns_series $index] if {$seriesfsid != $objectid} { return } } RetryTransaction { if { $index == -1 } { set rec [db $db openid $fsid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set series [dbobj $program get Series] set seriesfsid "" if {$series != ""} { set seriesfsid [dbobj $series fsid] lappend cache_ns_rec $fsid lappend cache_ns_series $seriesfsid } } if {$seriesfsid == $objectid} { if { $index != -1 } { set rec [db $db openid $fsid] set showing [dbobj $rec get Showing] set program [dbobj $showing get Program] set series [dbobj $program get Series] } set showingfsid [dbobj $rec gettarget Showing] set seltype [dbobj $rec get SelectionType] set eptitle [strim [dbobj $program get EpisodeTitle]] if { $eptitle == "" } { set eptitle "UNKNOWN" } set partindex [dbobj $showing get PartIndex] set partcount [dbobj $showing get PartCount] set partstr "" if { $partcount != "" && $partindex != "" } { set partstr " ($partindex/$partcount)" } append eptitle $partstr set station [dbobj $showing get Station] set callsign [dbobj $station get CallSign] set epnum [dbobj $program get EpisodeNum] set seconds [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] set day [clock format $seconds -format "%a"] set date [clock format $seconds -format "%1m/%1d"] set time [clock format $seconds -format "%l:%M %P"] if {$seltype == 6} { set imagenum 10 set imagef [lindex $images $imagenum] set imageh [img "" $imagef] } else { set imageh "" } if { $type == 2 } { puts $chan [tr "" [td $imageh] [td [html_link "/showing/$showingfsid" $eptitle]] [td $epnum] [td $callsign] [td $day] [td $date] [td $time]] } else { puts $chan [tr "" [td $imageh] [td [html_link "/showing/$showingfsid" $eptitle]] [td $epnum] [td $callsign] [td $day] [td $date]] } } } } proc do_seriesrow2 {chan showing recfsid} { global db global tzoffset global images set showingfsid "[dbobj $showing fsid]/[dbobj $showing subobjid]" set program [dbobj $showing get Program] set eptitle [strim [dbobj $program get EpisodeTitle]] if { $eptitle == "" } { set eptitle "UNKNOWN" } set partindex [dbobj $showing get PartIndex] set partcount [dbobj $showing get PartCount] set partstr "" if { $partcount != "" && $partindex != "" } { set partstr " ($partindex/$partcount)" } append eptitle $partstr set station [dbobj $showing get Station] set stationfsid [dbobj $station fsid] set callsign [dbobj $station get CallSign] set epnum [dbobj $program get EpisodeNum] set seconds [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] set day [clock format $seconds -format "%a"] set date [clock format $seconds -format "%1m/%1d"] set time [clock format $seconds -format "%l:%M %P"] set imagenum -1 if {$recfsid != ""} { set rec [db $db openid $recfsid] set recshowing [dbobj $rec get Showing] set recstation [dbobj $recshowing get Station] set recstationfsid [dbobj $recstation fsid] if {$recstationfsid == $stationfsid} { set seltype [dbobj $rec get SelectionType] set state [dbobj $rec get State] if {$state == 6} { if {$seltype == 6} { set imagenum 10 } elseif {$seltype == 9} { set imagenum 11 } else { set imagenum 1 } } } } if {$imagenum >= 0} { set imagef [lindex $images $imagenum] set imageh [img "" $imagef] } else { set imageh "" } puts $chan [tr "" [td $imageh] [td [html_link "/showing/$showingfsid" $eptitle]] [td $epnum] [td $callsign] [td $day] [td $date] [td $time]] } proc action_series {chan objectid env} { global db global tzoffset global images global programindexstartday if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } puts $chan [html_start "Series"] RetryTransaction { set series [db $db openid $objectid] set title [strim [dbobj $series get Title]] set score [dbobj $series get ThumbData] set thumbs "" if { $score != "" } { set imagenum [get_thumbimage $score] if { $imagenum >= 0} { set imagef [lindex $images $imagenum] set thumbs [img "" $imagef] } } puts $chan [h1 "$thumbs $title"] } puts $chan [h2 "Now Showing"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th ""] [th "Episode"] [th "Num"] [th "Channel"] [th "COLSPAN=2" "Date"]] ForeachMfsFile fsid name type "/Recording/NowShowing" "" { if {[catch [do_seriesrow $chan $fsid $objectid 1] error]} { puts "do_seriesrow $fsid $objectid 1" puts $error } } puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [h2 "Upcoming Showings"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th ""] [th "Episode"] [th "Num"] [th "Channel"] [th "COLSPAN=2" "Date"] [th "Time"]] set slists [get_programshowings $objectid 1] foreach slist $slists { set seconds [lindex $slist 0] set stationfsid [lindex $slist 1] set date [expr $seconds / 86400] set time [expr $seconds % 86400] set timestr [format "%05d" $time] set recfsid "" RetryTransaction { set recfsid [get_fsidbyprefix "/Recording/Active" "4:$date:$timestr:"] } # ForeachMfsFile fsid name type "/Recording/Active" "4:$date:$timestr:" { # set recfsid $fsid # } ForeachMfsFileTrans fsid name type "/Schedule" "$stationfsid:$date:" 20 { set stationday [db $db openid $fsid] set showings [dbobj $stationday get Showing] set slen [llength $showings] set current [expr int($time/86400.0 * $slen)] set top $slen set bottom 0 set count 0 set match 0 while { $top >= $bottom } { set showing [lindex $showings $current] set stime [dbobj $showing get Time] if { $time == $stime } { if {[catch [do_seriesrow2 $chan $showing $recfsid] error]} { puts "do_seriesrow2 $showing $recfsid" puts $error } set match 1 break } elseif { $time > $stime } { set bottom [expr $current + 1] } else { set top [expr $current - 1] } set current [expr int($bottom + ($top - $bottom) / 2.0)] incr count if { $count > $slen } { puts "Error: infinite loop in binary search ($bottom $top $current $slen $stationfsid $date $time)" break } } if { $match == 0 } { puts "Error: binary search didn't find showing ($stationfsid $date $time)" } } } puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [html_end] } proc action_todo {chan todotype env} { global db global tzoffset if {[string index $todotype 0] == "/"} { set todotype [string range $todotype 1 end] } if {$todotype == 0} { puts $chan [html_start "Todo"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Channel"] [th "Program"]] set path "/Recording/Active" set prefix "4" } elseif {$todotype == 1} { puts $chan [html_start "Scheduled Suggestions"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Channel"] [th "Program"] [th "Score"]] set path "/Recording/Active" set prefix "4" } elseif {$todotype == 2} { puts $chan [html_start "Suggestions"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Channel"] [th "Program"] [th "Score"]] set path "/Recording/Pending" set prefix "" } else { puts "Error: invalid todo type" return 1 } ForeachMfsFileTrans fsid name type $path $prefix 20 { set rec [db $db openid $fsid] set seltype [dbobj $rec get SelectionType] if {($todotype == 0) ^ ($seltype == 6)} { set showing [dbobj $rec get Showing] set showingfsid [dbobj $rec gettarget Showing] set station [dbobj $showing get Station] set stationfsid [dbobj $station fsid] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set seltype [dbobj $rec get SelectionType] if { $seltype == 10 || $seltype == 5 } { if { $title == "" } { set title "Manual Recording" } else { set title "Manual: $title" } } set callsign [dbobj $station get CallSign] set seconds [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] set day [clock format $seconds -format "%a"] set date [clock format $seconds -format "%1m/%1d"] set time [clock format $seconds -format "%l:%M %P"] set scorestr "" if {$todotype != 0} { set score [dbobj $rec get Score] set scorestr [td [ReadableThumbs $score]] } puts $chan [tr "" [td $day] [td $date] [td "ALIGN=RIGHT" $time] [td [html_link "/channel/$stationfsid" $callsign]] [td [html_link "/showing/$showingfsid" $title]] $scorestr] } } puts -nonewline $chan [html_table_end] puts $chan [html_end] } proc action_nowshowing {chan path env} { global db global tzoffset global images global cache_ns_rec global cache_ns_series puts $chan [html_start "Now Showing"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th ""] [th "Program"] [th "COLSPAN=2" "Date"]] ForeachMfsFileTrans fsid name type "/Recording/NowShowing" "" 20 { set rec [db $db openid $fsid] set seltype [dbobj $rec get SelectionType] set showing [dbobj $rec get Showing] set showingfsid [dbobj $rec gettarget Showing] set station [dbobj $showing get Station] set program [dbobj $showing get Program] set title [strim [dbobj $program get Title]] set seltype [dbobj $rec get SelectionType] if { $seltype == 10 || $seltype == 5 } { if { $title == "" } { set title "Manual Recording" } else { set title "Manual: $title" } } set state [dbobj $rec get State] set index [lsearch $cache_ns_rec $fsid] if { $index == -1 } { set series [dbobj $program get Series] if {$series != ""} { set seriesfsid [dbobj $series fsid] lappend cache_ns_rec $fsid lappend cache_ns_series $seriesfsid } } set seconds [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time] + $tzoffset] set day [clock format $seconds -format "%a"] set date [clock format $seconds -format "%1m/%1d"] set expdate [dbobj $rec get ExpirationDate] set expsecs [expr $expdate * 86400 + [dbobj $rec get ExpirationTime]] set nowsecs [clock seconds] if {$state == 3} { set imagenum 8 } elseif {$seltype == 6} { set imagenum 10 } elseif {$expdate == 24855} { set imagenum 0 } elseif {$expsecs < $nowsecs} { set imagenum 5 } elseif {$expsecs < [expr $nowsecs + 24*60*60]} { set imagenum 3 } else { set imagenum -1 } if { $imagenum >= 0} { set imagef [lindex $images $imagenum] set imageh [img "" $imagef] } else { set imageh "" } puts $chan [tr "" [td $imageh] [td [html_link "/showing/$showingfsid" $title]] [td $day] [td $date]] } puts -nonewline $chan [html_table_end] puts $chan [html_end] } proc action_saveseasonpass {chan path env} { global db eval $env if { $action == "Delete" } { puts $chan [html_start "Delete Season Pass"] DeleteSeasonPass $objectid puts $chan "Deletion of Season Pass Successful" puts $chan [html_end] } elseif { $action == "Save" } { puts $chan [html_start "Save Season Pass"] RetryTransaction { set sp [db $db openid $objectid] set type [defaultval 1 [dbobj $sp get Type]] if { $type == 1 } { set oldfirstrun [defaultval 0 [dbobj $sp get FirstRun]] if { $oldfirstrun != $showtype } { if { $showtype == 1 } { dbobj $sp set FirstRun $showtype } else { dbobj $sp remove FirstRun } } } set oldstarttime [defaultval 0 [dbobj $sp get StartTimePadding]] if { $oldstarttime != $startearly } { if { $startearly == 0 } { dbobj $sp remove StartTimePadding } else { dbobj $sp set StartTimePadding $startearly } } set oldendtime [defaultval 0 [dbobj $sp get EndTimePadding]] if { $oldendtime != $endlate } { if { $endlate == 0 } { dbobj $sp remove EndTimePadding } else { dbobj $sp set EndTimePadding $endlate } } set oldrecquality [defaultval 100 [dbobj $sp get RecordQuality]] if { $oldrecquality != $quality } { dbobj $sp set RecordQuality $quality } set oldkeepatmost [defaultval 0 [dbobj $sp get MaxRecordings]] if { $oldkeepatmost != $kam } { dbobj $sp set MaxRecordings $kam } set oldkeepuntil [defaultval 1 [dbobj $sp get KeepTime]] if { $oldkeepuntil != $keepuntil } { dbobj $sp set KeepTime $keepuntil } } event send 23 4 $objectid puts $chan "Updated Season Pass Successfully" puts $chan [html_end] } elseif { $action == "Create" } { puts $chan [html_start "Create Season Pass"] if { $type == 1 } { set spfsid [CreateSeasonPass $type $stationfsid $seriesfsid $quality $startearly $endlate $kam $showtype $keepuntil] } # event send 23 4 $spfsid puts $chan "Creation of Season Pass Successful" puts $chan [html_end] } } proc action_editseasonpass {chan objectid env} { global db global channeltablestation global channeltablenum global channeltablecallsign if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } RetryTransaction { set sp [db $db openid $objectid] set priority [dbobj $sp get Priority] incr priority set type [defaultval 1 [dbobj $sp get Type]] if { $type == 1 } { set series [dbobj $sp get Series] set title [strim [dbobj $series get Title]] set firstrun [defaultval 0 [dbobj $sp get FirstRun]] } elseif { $type == 2 } { set dow [dbobj $sp get DayOfWeekLocal] if { $dow == "0 1 2 3 4 5 6" } { set dow 7 } elseif { $dow == "1 2 3 4 5" } { set dow 8 } set duration [dbobj $sp get Duration] set starttimelocal [dbobj $sp get StartTimeLocal] } set starttime [defaultval 0 [dbobj $sp get StartTimePadding]] set endtime [defaultval 0 [dbobj $sp get EndTimePadding]] set station [dbobj $sp get Station] set stationfsid [dbobj $station fsid] set index [lsearch $channeltablestation $stationfsid] if { $index != -1 } { set channum [lindex $channeltablenum $index] set callsign [lindex $channeltablecallsign $index] } set recquality [defaultval 100 [dbobj $sp get RecordQuality]] set keepatmost [defaultval 0 [dbobj $sp get MaxRecordings]] set keepuntil [defaultval 1 [dbobj $sp get KeepTime]] } set dowvals "Sun Mon Tue Wed Thu Fri Sat {Daily} {M-F}" puts $chan [html_start "Edit Season Pass"] if { $type == 1 } { puts $chan [h1 "$title ($channum $callsign)"] } elseif { $type == 2 } { puts $chan [h1 "[lindex $dowvals $dow] [clock format $starttimelocal -format "%1I:%M %p"] - [clock format [expr $starttimelocal + $duration] -format "%1I:%M %p"] ($channum $callsign)"] } puts $chan [html_form_start "POST" "/saveseasonpass"] puts $chan [html_table_start "" "" ""] # puts $chan [tr "" [td "Priority"] [td $priority]] print_recoptions $chan $type $recquality 0 $starttime $endtime $keepatmost $firstrun $keepuntil puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [html_form_hidden "objectid" $objectid] puts $chan [html_form_input "submit" "action" "Save"] puts $chan [html_form_input "submit" "action" "Delete"] puts $chan [html_form_end] puts $chan "
" puts $chan "Don't Change" puts $chan [html_end] } proc action_getseasonpass {chan objectid env} { global db global channeltablestation global channeltablenum global channeltablecallsign global defrecquality if {[string index $objectid 0] == "/"} { set objectid [string range $objectid 1 end] } RetryTransaction { if { [regexp {([0-9]*)/(.*)} $objectid junk fsid subobjid] } { set showing [db $db openidconstruction $fsid $subobjid] } else { set showing [db $db openid $objectid] } set program [dbobj $showing get Program] set series [dbobj $program get Series] set seriesfsid [dbobj $series fsid] set title [strim [dbobj $series get Title]] set station [dbobj $showing get Station] set stationfsid [dbobj $station fsid] set index [lsearch $channeltablestation $stationfsid] if { $index != -1 } { set channum [lindex $channeltablenum $index] set callsign [lindex $channeltablecallsign $index] } } set type 1 puts $chan [html_start "Create Season Pass"] puts $chan [h1 "$title ($channum $callsign)"] puts $chan [html_form_start "POST" "/saveseasonpass"] puts $chan [html_table_start "" "" ""] # puts $chan [tr "" [td "Priority"] [td $priority]] print_recoptions $chan $type $defrecquality 0 0 0 5 0 1 puts -nonewline $chan [html_table_end] puts $chan "
" puts $chan [html_form_hidden "objectid" $objectid] puts $chan [html_form_hidden "type" $type] puts $chan [html_form_hidden "seriesfsid" $seriesfsid] puts $chan [html_form_hidden "stationfsid" $stationfsid] puts $chan [html_form_input "submit" "action" "Create"] puts $chan [html_form_end] puts $chan "
" puts $chan "Cancel" puts $chan [html_end] } proc get_nextmanualrectime {dowlocal starttime} { global tzoffset set nowsecs [clock seconds] if { $starttime > 86400 } { set dow [expr $dowlocal + 1] } elseif { $starttime < 0 } { set dow [expr $dowlocal - 1] } else { set dow $dowlocal } set nowtime [expr ($nowsecs / 86400) * 86400 + $starttime] set downow [clock format $nowtime -format "%w"] if { $downow > $dow } { set rectime [expr $nowtime + ($dow - $downow + 7) * 86400] } elseif { $dow > $downow } { set rectime [expr $nowtime + ($dow - $downow) * 86400] } else { if { $starttime > [expr $nowsecs % 86400] } { set rectime $nowtime } else { set rectime [expr $nowtime + (86400 * 7)] } } return $rectime } proc action_seasonpass {chan path env} { global db global images global tzoffset puts $chan [html_start "Season Passes"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th ""] [th "Pri"] [th "Title"] [th "Channel"] [th "KAM"] [th "First Run"]] set priority 0 ForeachMfsFileTrans fsid name type "/SeasonPass" "" 20 { set sp [db $db openid $fsid] set type [defaultval 1 [dbobj $sp get Type]] incr priority set rowstr "" if { $type == 1 } { set series [dbobj $sp get Series] set imagef [lindex $images 11] set spfsid [dbobj $sp fsid] append rowstr [td [html_link "/editseasonpass/$spfsid" [img "" $imagef]]] [td $priority] set seriesfsid [dbobj $series fsid] set title [strim [dbobj $series get Title]] append rowstr [td [html_link "/series/$seriesfsid" $title]] set station [dbobj $sp get Station] set stationfsid [dbobj $station fsid] set callsign [dbobj $station get CallSign] append rowstr [td [html_link "/channel/$stationfsid" $callsign]] } elseif { $type == 2 } { set station [dbobj $sp get Station] set stationfsid [dbobj $station fsid] set starttimelocal [dbobj $sp get StartTimeLocal] set starttime [expr $starttimelocal - $tzoffset] set dowlocal [dbobj $sp get DayOfWeekLocal] if { [llength $dowlocal] > 1 } { set rectime "" foreach dowl $dowlocal { set tmprectime [get_nextmanualrectime $dowl $starttime] if { $rectime == "" || $tmprectime < $rectime } { set rectime $tmprectime } } } else { set rectime [get_nextmanualrectime $dowlocal $starttime] } set datestr [format "%d:%d:" $stationfsid [expr $rectime / 86400]] # puts $datestr set schedlist [get_fsidbyprefix "/Schedule" $datestr] set timestr "" scan [lindex $schedlist 1] "%d:%d:%d:" dummy dummy2 timestr if { $timestr > $starttime } { set datestr [format "%d:%05d:" $stationfsid [expr ($rectime / 86400) - 1]] set schedlist [get_fsidbyprefix "/Schedule" $datestr] } set station [dbobj $sp get Station] set stationfsid [dbobj $station fsid] set callsign [dbobj $station get CallSign] set imagef [lindex $images 11] set spfsid [dbobj $sp fsid] append rowstr [td [html_link "/editseasonpass/$spfsid" [img "" $imagef]]] [td $priority] if { $schedlist != "" } { set stationday [db $db openid [lindex $schedlist 0]] set showings [dbobj $stationday get Showing] set mshowing "" foreach showing $showings { set stime [dbobj $showing get Time] set sdur [dbobj $showing get Duration] if { $stime <= $starttime && $starttime < [expr $stime + $sdur] } { set mshowing $showing break } } if { $mshowing != "" } { set program [dbobj $mshowing get Program] set series [dbobj $program get Series] set seriesfsid [dbobj $series fsid] set title [strim [dbobj $series get Title]] set title [html_link "/series/$seriesfsid" $title] append rowstr [td "Manual: $title"] } else { append rowstr [td "Manual Recording"] # puts "Error finding manual recording" } } else { append rowstr [td "Manual Recording"] # puts "Error finding manual recording" } append rowstr [td [html_link "/channel/$stationfsid" $callsign]] } elseif { $type == 3 } { set theme [dbobj $sp get Theme] set imagef [lindex $images 13] append rowstr [td [img "" $imagef]] [td $priority] set themefsid [dbobj $theme fsid] set title [strim [dbobj $theme get Name]] # append rowstr [td [html_link "/theme/$themefsid" $title]] [td ""] append rowstr [td $title] [td ""] } set kam [dbobj $sp get MaxRecordings] if {$kam == ""} { set kam "All" } set firstrun [dbobj $sp get FirstRun] if {$firstrun == 1} { set firstrun "Yes" } append rowstr [td $kam] [td $firstrun] puts $chan [tr "" $rowstr] } puts -nonewline $chan [html_table_end] puts $chan [html_end] } proc action_preferences {chan path env} { global db global genrenums global genrevals if {[string index $path 0] == "/"} { set path [string range $path 1 end] } set firstslash [string first "/" $path] set prefix "" if { $firstslash != -1 } { set preftype [string range $path 0 [expr $firstslash - 1]] set prefix [string range $path [expr $firstslash + 1] end] } else { set preftype $path } puts $chan [html_start "Preferences"] if { $preftype == "" } { puts $chan [html_table_start "" "" "ALIGN=TOP"] puts $chan [tr "" [th "" "Preferences"]] puts $chan [tr "" [td [html_link "/preferences/14" "Genre"]]] puts $chan [tr "" [td [html_link "/preferences/15" "Series"]]] puts $chan [tr "" [td [html_link "/preferences/17" "Actor"]]] puts $chan [tr "" [td [html_link "/preferences/19" "Director"]]] puts $chan [tr "" [td [html_link "/preferences/22" "Writer"]]] puts -nonewline $chan [html_table_end] } elseif { $preftype == 14 } { # redo sort? set newgenrelist "" set count 0 foreach genrenum $genrenums { lappend newgenrelist [list $genrenum [strim [lindex $genrevals $count]]] incr count } set newgenrelist2 [lsort -index 1 $newgenrelist] puts $chan [h1 "Genres"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Genre"] [th "Thumbs"] [th "Type"] [th "Confidence"]] RetryTransaction { foreach genrel $newgenrelist2 { set genrenum [lindex $genrel 0] set genrestr [strim [lindex $genrel 1]] set path "/Preference/a/$preftype/$genrenum" if { [catch {set pref [db $db open $path]}] } { continue } set thumbs [dbobj $pref get Thumbsness] set vector [dbobj $pref get Vector] set thtype "" set numthumbs "" set confidence "" if { $thumbs != "" } { set thumbslist [ReadableThumbs $thumbs] if { [llength $thumbslist] == 3 } { set thtype [lindex $thumbslist 0] if { $thtype == "Void" } { set thtype "" } else { set numthumbs [lindex $thumbslist 1] set confidence [lindex $thumbslist 2] } } } if { $numthumbs == "" } { set numthumbs [decode_vector $vector] set thtype "Implied" } puts $chan [tr "" [td $genrestr] [td $numthumbs] [td $thtype] [td $confidence]] } } puts -nonewline $chan [html_table_end] } elseif { $preftype == 15 } { set programlist "" ForeachMfsFileTrans fsid name type "/Preference/a/$preftype" "" 25 { set orphan 0 set pref [db $db openid $fsid] set item [dbobj $pref get Item] set thumbs [dbobj $pref get Thumbsness] set vector [dbobj $pref get Vector] set seriesfsid "" if { $item != "" } { set title [strim [dbobj $item get Title]] set seriesfsid [dbobj $item fsid] } else { set title [strim [dbobj $pref get StringKeyValue]] if { [regexp {^[0-9]+$} $title dummy] == 1 } { if { [catch {set series [db $db open "/Server/$title"]}] } { set orphan 1 } else { set title [strim [dbobj $series get Title]] set seriesfsid [dbobj $series fsid] } } else { regsub {^(.*), (A|The)$} $title {\2 \1} title } } if { $seriesfsid != "" } { set program [html_link "/series/$seriesfsid" $title] } else { set program $title } regsub {^(A |The )} $title "" sortstr set thtype "" set numthumbs "" set confidence "" if { $thumbs != "" } { set thumbslist [ReadableThumbs $thumbs] if { [llength $thumbslist] == 3 } { set thtype [lindex $thumbslist 0] if { $thtype == "Void" } { set thtype "" } else { set numthumbs [lindex $thumbslist 1] set confidence [lindex $thumbslist 2] } } } if { $numthumbs == "" } { set numthumbs [decode_vector $vector] set thtype "Implied" } if {!$orphan} { lappend programlist [list $sortstr $program $numthumbs $thtype $confidence] } } set programlist2 [lsort -index 0 $programlist] puts $chan [h1 "Series"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Series"] [th "Thumbs"] [th "Type"] [th "Confidence"]] foreach programl $programlist2 { puts $chan [tr "" [td [lindex $programl 1]] [td [lindex $programl 2]] [td [lindex $programl 3]] [td [lindex $programl 4]]] } puts -nonewline $chan [html_table_end] } elseif { $preftype == 16 } { puts $chan [h1 "Programs"] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th "Program"] [th "Thumbs"] [th "Type"] [th "Confidence"]] ForeachMfsFileTrans fsid name type "/Preference/a/$preftype" "" 25 { set pref [db $db openid $fsid] set item [dbobj $pref get Item] set thumbs [dbobj $pref get Thumbsness] set vector [dbobj $pref get Vector] set seriesfsid "" if { $item == "" } { set intkey [dbobj $pref get IntKeyValue] if { [catch {set item [db $db open "/Server/$intkey"]}] } { # continue } } if { $item != "" } { set title [strim [dbobj $item get Title]] set series [dbobj $item get Series] if { $series != "" } { set seriesfsid [dbobj $series fsid] } } if { $title == "" } { set title [strim [dbobj $pref get StringKeyValue]] } if { $seriesfsid != "" } { set program [html_link "/series/$seriesfsid" $title] } else { set program $title } set thtype "" set numthumbs "" set confidence "" if { $thumbs != "" } { set thumbslist [ReadableThumbs $thumbs] if { [llength $thumbslist] == 3 } { set thtype [lindex $thumbslist 0] if { $thtype == "Void" } { set thtype "" } else { set numthumbs [lindex $thumbslist 1] set confidence [lindex $thumbslist 2] } } } if { $numthumbs == "" } { set numthumbs [decode_vector $vector] set thtype "Implied" } puts $chan [tr "" [td $program] [td $numthumbs] [td $thtype] [td $confidence]] } puts -nonewline $chan [html_table_end] } elseif { $preftype == 17 || $preftype == 19 || $preftype == 22 } { if { $preftype == 17 } { set preftypestr "Actor" set role 8 } elseif { $preftype == 19 } { set preftypestr "Director" set role 9 } else { set preftypestr "Writer" set role 12 } set preftypestr2 $preftypestr append preftypestr2 "s" set breakbyletter 0 if { [catch { RetryTransaction { set dirsize [mfs scancount "/Preference/a/$preftype"]}}] } { } else { if { $dirsize > 120 } { set breakbyletter 1 } } set alphabet "ABCDEFGHIJKLMNOPQRSTUVWXYZ" if { $prefix == "" && $breakbyletter == 1 } { puts $chan [h1 $preftypestr2] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th $preftypestr]] for {set i 0} {$i < 26} {incr i} { set letter [string index $alphabet $i] puts $chan [tr "" [td [html_link "/preferences/$preftype/$letter" $letter]]] } puts -nonewline $chan [html_table_end] } else { puts $chan [h1 $preftypestr2] puts $chan [html_table_start "" "" ""] puts $chan [tr "ALIGN=CENTER" [th $preftypestr] [th "Thumbs"] [th "Type"] [th "Confidence"]] ForeachMfsFileTrans fsid name type "/Preference/a/$preftype" $prefix 25 { set orphan 0 set pref [db $db openid $fsid] set thumbs [dbobj $pref get Thumbsness] set vector [dbobj $pref get Vector] set person "" if { [catch {set person [db $db open "/Person/$role/$name"]}] } { set orphan 1 } set namestr "" if { $person != "" } { set pname [strim [dbobj $person get Name]] regsub {^(.*)\|(.*)$} $pname {\1, \2} namestr # set namestr [PrintNames $pname] } set thtype "" set numthumbs "" set confidence "" if { $thumbs != "" } { set thumbslist [ReadableThumbs $thumbs] if { [llength $thumbslist] == 3 } { set thtype [lindex $thumbslist 0] if { $thtype == "Void" } { set thtype "" } else { set numthumbs [lindex $thumbslist 1] set confidence [lindex $thumbslist 2] } } } if { $numthumbs == "" } { set numthumbs [decode_vector $vector] set thtype "Implied" } if {!$orphan} { puts $chan [tr "" [td $namestr] [td $numthumbs] [td $thtype] [td $confidence]] } } puts -nonewline $chan [html_table_end] if { $breakbyletter == 1 } { if { $prefix != "A" } { set index [string first $prefix $alphabet] set prevletter [string index $alphabet [expr $index - 1]] puts $chan [html_link "/preferences/$preftype/$prevletter" "<< $prevletter"] } if { $prefix != "Z" } { set index [string first $prefix $alphabet] set nextletter [string index $alphabet [expr $index + 1]] puts $chan [html_link "/preferences/$preftype/$nextletter" "$nextletter >>"] } } } } puts $chan [html_end] } proc action_ui {chan path env} { global db global tzoffset if {[string index $path 0] == "/"} { set path [string range $path 1 end] } if {$path == ""} { puts $chan [html_start "User Interface"] puts $chan [html_table_start "" "" "ALIGN=TOP"] puts $chan [tr "" [th "" "User Interface"]] puts $chan [tr "" [td [html_link "/ui/seasonpass" "Season Pass"]]] puts $chan [tr "" [td [html_link "/ui/nowshowing" "Now Showing"]]] puts $chan [tr "" [td [html_link "/ui/todo" "ToDo"]]] puts $chan [tr "" [td [html_link "/ui/suggestions" "Scheduled Suggestions"]]] puts $chan [tr "" [td [html_link "/ui/pending" "Suggestions"]]] puts $chan [tr "" [td [html_link "/ui/preferences" "Preferences"]]] puts $chan [tr "" [td [html_link "/ui/channellist" "Channel Guide"]]] puts -nonewline $chan [html_table_end] puts $chan [html_end] } elseif {$path == "todo"} { action_todo $chan 0 $env } elseif {$path == "suggestions"} { action_todo $chan 1 $env } elseif {$path == "pending"} { action_todo $chan 2 $env } elseif {$path == "nowshowing"} { action_nowshowing $chan "" $env } elseif {$path == "seasonpass"} { action_seasonpass $chan "" $env } elseif {$path == "channellist"} { action_channellist $chan "" $env } elseif {$path == "preferences"} { action_preferences $chan "" $env } } proc get_tzoffset {mfstz dst} { if { $mfstz <= 0 } { set tz $mfstz } else { set tzlist "-5 -6 -7 -8 -9 -10 0 1 2 3 4 5 6 7 8 9 10 11 12 -1 -2 -3 -4 -11 -12" set tz [lindex $tzlist [expr $mfstz - 1]] } if { $dst == 2 || $dst == "" } { set date [clock format [clock seconds] -format "%1d %u %1m %1H %1M"] scan $date "%d %d %d %d %d" dom dow month hour min if {$month > 4 && $month < 10} { set dlsval 1 } elseif {$month == 4 && $dom > 7} { set dlsval 1 } elseif {$month == 4 && $dom <= 7 && $dow == 0 && $hour >= 2} { set dlsval 1 } elseif {$month == 4 && $dom <= 7 && $dow != 0 && ($dom-$dow > 0)} { set dlsval 1 } elseif {$month == 10 && $dom < 25} { set dlsval 1 } elseif {$month == 10 && $dom >= 25 && $dow == 0 && $hour < 2} { set dlsval 1 } elseif {$month == 10 && $dom >= 25 && $dow != 0 && ($dom-24-$dow < 1) } { set dlsval 1 } else { set dlsval 0 } if {$dlsval == 1} { return [expr ($tz+1)*60*60] } else { return [expr $tz*60*60] } } else { return [expr $tz*60*60] } } proc GetResourceData { refid startid endid startindex bits } { global db set keys "" set vals "" RetryTransaction { set sws [db $db open /SwSystem/ACTIVE] set offset [expr $refid/65536 - 1] set resource [lindex [dbobj $sws get ResourceGroup] $offset] set id [dbobj $resource get Id] if { $id == $refid } { set items [dbobj $resource get Item] foreach item $items { set id [dbobj $item get Id] if { $id >= $startid && $id <= $endid } { if { $bits == 1 } { set value [expr 1 << ($id - $startid + $startindex)] } else { set value [expr $id - $startid + $startindex] } set strval [dbobj $item get String] if { [string compare $strval "{}"] != 0 } { lappend keys $value lappend vals $strval } } } } else { puts "Error: refid didn't match" } } return [list $keys $vals] } proc init_db {} { global db global genrenums global genrevals global tvratingnums global tvratingvals global showingbitnums global showingbitvals global advisorynums global advisoryvals global mpaaratingnums global mpaaratingvals global tzoffset global defrecquality global tivoswversion global cancelreasons global selectiontypes global states global showtypes global premieretypes global images RetryTransaction { set setup [db $db open /Setup] set defrecquality [dbobj $setup get RecordQuality] set setuptz [dbobj $setup get TimeZone] set daylightsavings [dbobj $setup get DaylightSavingsPolicy] } set tzoffset [get_tzoffset $setuptz $daylightsavings] set cancelreasons "SwitchToLiveTv RecordDifferentShowing StayOnLiveTv InternalError PowerWasOff Expired GotBetterSuggestion DemoMode UnexpectedConflict UserRequestedRecording UserRequestedSeasonPass ExplicitlyDeleted ChannelLineupChanged ProgramGuideChanged RecorderEmergency UserCancelledSeasonPass FuzziesTurnedOff FuzzyStoppedEarly Unknown ProgramSourceConflict ConvertedLiveCache LiveCacheOnlySuccessful ProgramSourceDiskConflict ExplicitlyDeletedFromToDo ProgramSourceModified NotAuthorized NoReRecord NoSignal MaxRecordingsExceeded CaptureRequestExpired NoSignalTunerOne NoSignalTunerTwo MaxRecordingsNowShowing VideoMgrDeniedTuner" set selectiontypes "{Show Recommendation} {Package Recommendation} {By Name} {By Channel} Timer {Suggestion} {Fuzzy Package} Bookmark {Season Pass} {Manual Season Pass} Guide IPreview WishListPass Extended ManualExtended CaptureRequest" set states "{To Do} Cancelled {In Progress} {Now Showing} Deleted {To Do} Allocated" set showtypes "Serial {Short Film} Special {Limited Series} Series Miniseries {Paid Programming}" set premieretypes "{Season Finale} {Series Finale} Premiere {Season Premiere} {Series Premiere}" set images "ExpireNever-256.8.png SelectIcon-256.9.png ThumbUp2-256.8.png ExpireSoon-256.8.png ThumbDn1-256.8.png Expired-256.8.png ThumbDn2-256.8.png ThumbUp3-256.9.png Recording-256.9.png ThumbDn3-256.8.png TivoSuggest-256.8.png SeasonPass.9.png ThumbUp1-256.8.png WishListPass.2.png LargeSquarePredicted3DownThumbs.3.png LargeSquarePredicted2DownThumbs.3.png LargeSquarePredicted1DownThumbs.3.png LargeSquarePredicted1UpThumbs.3.png LargeSquarePredicted2UpThumbs.3.png LargeSquarePredicted3UpThumbs.3.png" if { [PrefixMatches "2.5.1" $tivoswversion] } { set genres [GetResourceData 655360 655377 655495 1 0] } else { set genres [GetResourceData 720896 720913 721031 1 0] } set genrenums [lindex $genres 0] set genrevals [lindex $genres 1] if { [PrefixMatches "2.5.1" $tivoswversion] } { set tvratings [GetResourceData 851968 851993 851998 1 0] } else { set tvratings [GetResourceData 983040 983065 983070 1 0] } set tvratingnums [lindex $tvratings 0] set tvratingvals [lindex $tvratings 1] if { [PrefixMatches "2.5.1" $tivoswversion] } { set showingbits [GetResourceData 1441792 1441843 1441863 0 1] } else { set showingbits [GetResourceData 1572864 1572915 1572935 0 1] } set showingbitnums [lindex $showingbits 0] set showingbitvals [lindex $showingbits 1] if { [PrefixMatches "2.5.1" $tivoswversion] } { set advisorys [GetResourceData 917504 917533 917542 1 0] } else { set advisorys [GetResourceData 1048576 1048605 1048614 1 0] } set advisorynums [lindex $advisorys 0] set advisoryvals [lindex $advisorys 1] set mpaaratings [GetResourceData 65536 65567 65578 1 0] set mpaaratingnums [lindex $mpaaratings 0] set mpaaratingvals [lindex $mpaaratings 1] } if { $reload == 0 } { init_db } register_module "ui" "User Interface" "A Web-based Clone of the TiVo UI"