# Showcase (Inside TiVo / Channel Highlights) module for TiVoWeb.
#
# Based very heavily on other parts of TiVoWeb!
#
# LJ @ http://www.tivocommunity.com/   and   http://www.ljay.org.uk
#
# WARNING: This code comes with absolutely no warranty.  Use it at your own risk.
# If it turns your TiVo into a pumpkin don't say you weren't warned.  I'd be interested to know if it does though... ;)
#
# 12Jul03 13:55  v1.0
# 13Jul03 07:41  v1.1 Adds modify date on first screen as a tooltip; uses the package graphics and lists the channels
#                     in the tooltip for series where you have season passes.
# 13Jul03 15:25  v1.2 Add filtering: default to displaying series with future showing on channels I watch.
# 15Jul03 14:08  v1.3 Reduce areas covered by RetryTransaction so I can use (an almost standard ;) get_programshowings
#                     and the calls it makes to init_* don't fail as we're already in a transaction.
# 02Aug03 11:37  v1.4 Add an option to show matches in all subcategories on lower level screens. Tidy tables and imgs.
# 22Dec03        v1.4+ Mods by Freakeao aka Dan: "I beefed up some error handling (looking for Program object when
#                                                not always there) and added support of displaying Mugshots
#                                                and Descriptions in more places.

proc action_showcase {chan path env} {
	global db
	global cache_sp_key
	global images
	global channeltablestation
	global tzoffset

	set showcasedir "/Showcase"

	if {[string index $path 0] == "/"} {
		set path [string range $path 1 end]
	}
	set firstslash [string first "/" $path]
	if { $firstslash != -1 } {
		set sc [string range $path 0 [expr $firstslash - 1]]
	}

	set future ""
	set watch ""
	set pkg ""
	set dispval 1
	eval $env

	set all [info vars "all_*"]
	if { $all != "" } {
		set all [lindex [split $all "_"] 1]
	}

	set displabels "{Only display series with future showings on channels I watch} {Display all series with future showings} {Display all series}"
	set dispvalues "1 2 3"

	if { $pkg == "" } {
		puts $chan [html_start "Showcase"]
		puts $chan [html_form_start "GET" "/showcase" "name=\"shwcform\""]
		puts $chan [html_table_start "" "" ""]

		puts $chan [tr "ALIGN=CENTER" [th "colspan=3" "Showcases"]]

		set firsttime 1
		ForeachMfsFileTrans fsid name type $showcasedir "" 2 {
			set sc [db $db openid $fsid]
			#dbobj $sc set ExpirationDate 19999
			set scName [dbobj $sc get Name]
			set item [dbobj $sc get Item]
			if {[catch {set seconds [expr [mfs moddate $fsid] + $tzoffset]}] != 0} {
				set upddate ""
			} else {
				if {$::uktivo} {
					set daystr [string trim [nth [clock format $seconds -format "%e"]]]
					set upddate "Updated [clock format $seconds -format "%a $daystr %b"]"
				} else {
					set upddate "Updated [clock format $seconds -format "%a %1m/%1d"]"
				}
			}
			if {![catch {dbobj $sc get Icon} icon]} {
				if { $icon != "" } {
					set icnNm "[dbobj $icon get Name].png"
				}
			}

			if { $icon == "" } {
				if {![catch {dbobj $sc get Banner} banner]} {
					set banNm "[dbobj $banner get Name].png"
				}
				if { $banner == "" } {
					set icon [lindex $scName 0]
				} else {
					set icon [img "height=34" $banNm]
				}
			} else {
				set icon [img "" "[dbobj $icon get Name].png"]
			}

			foreach itm $item {
				#dbobj $itm set ExpirationDate 19999
				set itmName [dbobj $itm get Name]
				set package [dbobj $itm get Package]
				set itmDesc [lindex [dbobj $itm get Description] 0]
				set itmMugshot ""
				if {![catch {dbobj $itm get Mugshot} itmMugshot]} {
					if { $itmMugshot != "" } {
						set mugshotNm "[dbobj $itmMugshot get Name].png"
						set imgMugshot [img "align=left" $mugshotNm]
					} else {
						set imgMugshot ""
					}
				}
				
				if {[catch {dbobj $package get Item} pkgItem]} {
					set items ""
				} else {
					set itmCnt [llength $pkgItem]
					set items "<font size=2>(max $itmCnt item[expr {$itmCnt == 1 ? "" : "s"}])</font>"
				}
				set pkgTgt [lindex [split [dbobj $itm gettarget Package] "/"] 0]
				if { $firsttime == 1 } {
					set firsttime 0
					puts $chan [tr "" [td "align=center title=\"$upddate\"" $icon] [td "$imgMugshot <INPUT TYPE=\"radio\" NAME=\"pkg\" VALUE=\"$pkgTgt\" CHECKED> [lindex $itmName 0]"] [td "$items"]]
				} else {
					puts $chan [tr "" [td "align=center title=\"$upddate\"" $icon] [td "$imgMugshot [html_form_input "radio" "pkg" "$pkgTgt"] [lindex $itmName 0] <P/> [strim $itmDesc]" ] [td "$items"]]
				}
			}
		}
		puts -nonewline $chan [html_table_end]
		puts $chan [html_form_select "dispval" $dispvalues $displabels $dispval]
		puts $chan "[html_form_input "submit" "submit" " Go "]<p>"
		puts $chan [html_form_end]

#set seconds [clock seconds]
#puts $chan "clock secs: $seconds /86400 [expr $seconds / 86400] % 86400 [expr $seconds % 86400]<br>"
	} else {

	  set gotany 0
	  set first 1

	  if { $all != "" } {
	      set pkg ""
		RetryTransaction {
			set sc [db $db openid $all]
			set item [dbobj $sc get Item]
			set scName [dbobj $sc get Name]
			foreach oi $item {
				set sPack [dbobj $oi gettarget Package]
				regexp {(.*)/(.*)} $sPack junk sPack junk
				lappend pkg $sPack
			}
			if {![catch {dbobj $sc get Banner} banner]} {
				set banNm "[dbobj $banner get Name].png"
			}
	  		puts $chan [html_start "Showcase - [lindex $scName 0]"]
			set first 0
			if { $banner == "" } {
				puts $chan "<h2>[lindex $scName 0]</h2>"
			} else {
				puts $chan [img "" $banNm]
				puts $chan "<p>"
			}
		}
		puts $chan [html_table_start "" "" ""]
	  }
	    
      	  foreach cpkg $pkg {
      
      		set firsttime 1
      		set gotone 0
      		set anysubs 0
      		RetryTransaction {
      			set sc [db $db openid $cpkg]
      			set scName [dbobj $sc get Name]
      			if {$first == 1 } {
      				puts $chan [html_start "Showcase - [lindex $scName 0]"]
      				set first 0
      			}
       			if {![catch {dbobj $sc get Banner} banner]} {
                          	if {$banner != ""} {                                 
         			  	set banNm "[dbobj $banner get Name].png"
				}
  			}  
    		set item [dbobj $sc gettarget Item]
    		}
  
		foreach itm $item {
			regexp {(.*)/(.*)} $itm junk pkiobjid pkisubobjid
			RetryTransaction {
				set pki [db $db openidconstruction $pkiobjid $pkisubobjid]
				catch {dbobj $pki gettarget Package} subpkg
			}
			if {$subpkg != ""} {
				if { $firsttime == 1 } {
					if { $banner == "" } {
						puts $chan [html_table_start "" "" ""]
						puts $chan [html_form_start "GET" "/showcase" "name=\"shwcform\""]
						puts $chan [tr "ALIGN=CENTER" [th "colspan=2" "[lindex $scName 0]"]]
					} else {
						puts $chan [img "" $banNm]
						puts $chan "<p>"
						puts $chan [html_form_start "GET" "/showcase" "name=\"shwcform\""]
						puts $chan [html_table_start "" "" ""]
					}
				}
				RetryTransaction {
					set pki [db $db openidconstruction $pkiobjid $pkisubobjid]
					set subpkg [dbobj $pki get Package]
					set sPkLk [lindex [split [dbobj $pki gettarget Package] "/"] 0]
					set name [dbobj $subpkg get Name]
					set pkiDesc [lindex [dbobj $pki get Description] 0]

					set pkiMugshot ""
					if {![catch {dbobj $pki get Mugshot} pkiMugshot]} {
						if { $pkiMugshot != "" } {
							set mugshotNm "[dbobj $pkiMugshot get Name].png"
							set imgMugshot [img "align=left" $mugshotNm]
						} else {
							set imgMugshot ""
						}
					}
				

					set subItms [dbobj $subpkg get Item]
					if {[catch {dbobj $subpkg get Item} ssItms]} {
						set items ""
					} else {
						set itmCnt [llength $ssItms]
						set items "<font size=2>(max $itmCnt item[expr {$itmCnt == 1 ? "" : "s"}])</font>"
						if { $anysubs == 0 } {
							foreach ssitm $ssItms {
								catch {dbobj $ssitm gettarget Package} ssPkg
								if {$ssPkg != ""} {
									incr anysubs 1
									break
								}
							}
						}
					}
				}

				if { $firsttime == 1 } {
					set firsttime 0
					puts $chan [tr "" [td "$imgMugshot <INPUT TYPE=\"radio\" NAME=\"pkg\" VALUE=\"$sPkLk\" CHECKED> [lindex $name 0] <P/> $pkiDesc"] [td "$items"]]
				} else {
					puts $chan [tr "" [td "$imgMugshot [html_form_input "radio" "pkg" "$sPkLk"] [lindex $name 0] <P/> $pkiDesc"] [td "$items"]]
				}
			} else {
				RetryTransaction {
					set pki [db $db openidconstruction $pkiobjid $pkisubobjid]
					#dbobj $pki set ExpirationDate 19999
					set iDesc [lindex [dbobj $pki get Description] 0]
					catch {dbobj $pki get Program} iProg
					set pTitle ""
					if { $iProg != "" } {
						set iSeries [lindex [split [dbobj $iProg gettarget Series] "/"] 0]
						catch {dbobj $iProg get Title} pTitle
					}
				}

				if { $pTitle != "" } {
					if { ($dispval == "1" && [llength [ljget_programshowings $iSeries 1]] > 0) || ($dispval == "2" && [llength [ljget_programshowings $iSeries 0]] > 0) || $dispval == "3" } {
						set pTitle [lindex $pTitle 0]
						RetryTransaction {
							set pki [db $db openidconstruction $pkiobjid $pkisubobjid]
							set iProg [dbobj $pki get Program]
							set pEp [lindex [dbobj $iProg get EpisodeTitle] 0]
							if { $iDesc == "" } {
								set iDesc [dbobj $iProg get Description]
							}
						}

						set spst 0
						set altst ""
						set spmtch ""
						set spm [lsearch $cache_sp_key "$iSeries|*"]

						while { ($spm != -1) && ([expr $spst + $spm] < [llength $cache_sp_key]) } {
							incr spst $spm
							set spmatch [lindex $cache_sp_key $spst]
							set chn [lindex [split $spmatch "|"] 1]
							if { [catch {set data $channeltablestation($chn)}] != 1 } {
								set altst "$altst, [lindex $data 2]"
							}
							incr spst 1
							set spm [lsearch [lrange $cache_sp_key $spst end] "$iSeries|*"]
						}

						if {$altst != ""} {
							set altst [string range $altst 2 end]
							set stcomma [string last "," $altst]
							if { $stcomma != -1 } {
								set altst "[string range $altst 0 [expr $stcomma - 1]] &[string range $altst [expr $stcomma + 1] end]"
								set altst "You have season passes for this series on $altst"
							} else {
								set altst "You have a season pass for this series on $altst"
							}
							set spimg [img "alt=\"$altst\"" [lindex $images 11]]
						} else {
							set spimg ""
						}
						if { $gotone == "0" } {
							set gotone 1
							set gotany 1

							if { $banner == "" || $all != "" } {
								if { $all == "" } {
									puts $chan [html_table_start "" "" ""]
								}
								puts $chan [tr "ALIGN=CENTER" [th "colspan=4" "<h3>[lindex $scName 0]</h3>"]]
								puts $chan [tr "align=center" [th ""] [th "Series"] [th "Episode"] [th "Description"]]
							} else {
								puts $chan [img "" $banNm]
								puts $chan "<p>"
								puts $chan [html_table_start "" "" ""]
								puts $chan [tr "align=center" [th ""] [th "Series"] [th "Episode"] [th "Description"]]
							}
						}
						puts $chan [tr "" [td $spimg] [td [html_link "/series/$iSeries" "$pTitle"]] [td "$pEp"] [td "$iDesc"]]
					}
				}
			}
		}
		if { $subpkg != "" } {
			puts -nonewline $chan [html_table_end]
			if { $anysubs == 0 } {
				puts $chan "Show matches in all subcategories [html_form_checkbox "all_$pkg" $all]<br>"
			}
			puts $chan [html_form_select "dispval" $dispvalues $displabels $dispval]
			puts $chan "[html_form_input "submit" "submit" " Go "]<p>"
			puts $chan [html_form_end]
		} elseif { $gotone == 0 } {
			if { $all == "" } {
				if { $banner == "" } {
					puts $chan [html_table_start "" "" ""]
					puts $chan [tr "ALIGN=CENTER" [th "colspan=4" "[lindex $scName 0]"]]
					puts $chan [tr "align=center" [td "colspan=4" "No Matching Series"]]
				} else {
					puts $chan [img "" $banNm]
					puts $chan "<p>"
					puts $chan "No Matching Series"
				}
			}
		}
		if { $all == "" } {
			puts -nonewline $chan [html_table_end]
		} elseif { $gotone != 0 } {
			puts $chan [tr "" [td "colspan=4" "<h3>&nbsp;</h3>"]]
		}
	  }
	  if { $all != "" } {
		if { $gotany == 0 } {
			puts $chan [tr "align=center" [td "colspan=4" "No Matching Series"]]
		}
		puts $chan [html_table_end]
	  }
	}
	puts $chan [html_end]
}

proc ljget_programshowings {progfsid watch args} {
# LJ: The only difference between this and the standard proc is that this one returns as soon as a future
#     program match is found.  Waiting around for all future matches to be found takes too long!
   global db
   global guideindexdir
   global programindexstartday
   global channeltablefsid
   global channeltablestation
   global channeltablenum
   global channeltableindex
   global version3

   set nowsecs [clock seconds]

   if {[llength $args] > 0} {
      set genres [lindex $args 0]
   } else {
      set genres ""
   }

   set reload_index 0
   RetryTransaction {
      set channelfsid [lindex [mfs find $guideindexdir/ChannelTable] 0]
      if { $channeltablefsid != $channelfsid } {
         set reload_index 1
      }
      if {$genres != ""} {
         set showingkeyfsid [lindex [mfs find $guideindexdir/Showing.key] 0]
         set showingindex [lindex [mfs find $guideindexdir/Showing.index] 0]
         set showingkeydata [mfs getpart $showingkeyfsid 0x0 0x18]
      }
      set programkeyfsid [lindex [mfs find $guideindexdir/Program.key] 0]
      set programindex [lindex [mfs find $guideindexdir/Program.index] 0]
      set programkeydata [mfs getpart $programkeyfsid 0x0 0x18]
   }
   binary scan [string range $programkeydata 0x00 0x03] I recsize
   binary scan [string range $programkeydata 0x04 0x07] I totalnumkeys
   binary scan [string range $programkeydata 0x08 0x0B] I incrsize
   binary scan [string range $programkeydata 0x10 0x13] I numkeys
   binary scan [string range $programkeydata 0x14 0x17] I programindexstartday
   if {$genres != ""} {
      binary scan [string range $showingkeydata 0x00 0x03] I showingrecsize
      binary scan [string range $showingkeydata 0x04 0x07] I showingtotalnumkeys
      binary scan [string range $showingkeydata 0x08 0x0B] I showingincrsize
      binary scan [string range $showingkeydata 0x10 0x13] I showingnumkeys
   }

   if { $reload_index } {
      init_channelindex
      init_genreindex
      init_ns_cache
   }

   set fsidbin [binary format I $progfsid]

   set startoffset 24
   set maxoffset [expr $startoffset + $recsize * $numkeys]
   set first [get_recordindexsearch $programkeyfsid $startoffset $maxoffset $recsize $incrsize $fsidbin 0 3]
   if { $first == -1 } {
      error "Error couldn't find starting offset in program key"
   }
   set startoffset [expr $first * $incrsize]
   set maxoffset [expr $startoffset + $incrsize]
   if { $maxoffset > $recsize * $totalnumkeys } {
      set maxoffset [expr $recsize * $totalnumkeys]
   }
   set current [get_recordindexsearch $programindex $startoffset $maxoffset $recsize $incrsize $fsidbin 1 3]

   set showings ""
   if {$current >= 0} {
      if {$watch == 0} {
         RetryTransaction {
            set channeltabledata [mfs get $channeltablefsid]
         }
      }

      set i [expr ($current-1) * $recsize]
      set compare 0
      set offset $startoffset
      set init 1
      set prevstation ""
      set prevsecs ""
      while { $compare == 0 } {
         incr i $recsize
         if { $init == 1 || ($i >= $end && $compare == 0) } {
            if { $init == 0 } {
               set i 0
               incr offset $incrsize
            }
            set end $incrsize
            if { $offset + $end > $recsize * $totalnumkeys } {
               set end [expr $recsize * $totalnumkeys - $offset]
            }
            RetryTransaction {
               set programdata [mfs getpart $programindex $offset $end]
            }
            set init 0
         }

         set data [string range $programdata $i [expr $i + $recsize - 1]]
         set fsiddata [string range $data 0 3]
         set compare [string compare $fsiddata $fsidbin]
         if {$compare == 0} {
            binary scan $data x4H8 showingdata
            if {$version3} {
               set channel [expr 0x$showingdata & 0x07FF]
            } else {
               set channel [expr 0x$showingdata & 0x03FF]
            }
            if {$watch == 0} {
               binary scan [string range $channeltabledata [expr $channel*8 + 4] [expr $channel*8 + 7]] I station
            } else {
               if {[catch {set station $channeltableindex($channel)}]} {
                  continue
               }
            }
            if {$version3} {
               set time [expr 0x$showingdata >> 11]
            } else {
               set time [expr 0x$showingdata >> 10]
            }
            set seconds [expr $programindexstartday * 86400 + $time]
            if { $seconds < $nowsecs } {
               continue
            }
            if {$seconds == $prevsecs && $prevstation == $station} {
               continue
            }
            set prevstation $station
            set prevsecs $seconds
            if {$genres != ""} {
               set showingdata2 [string range $data 4 7]
               set startoffset 24
               set maxoffset [expr $startoffset + $showingrecsize * $showingnumkeys]
               set first [get_recordindexsearch $showingkeyfsid $startoffset $maxoffset $showingrecsize $showingincrsize $showingdata2 0 3]
               if { $first == -1 } {
                  error "Error couldn't find starting offset in showing key"
               }
               set startoffset [expr $first * $showingincrsize]
               set maxoffset [expr $startoffset + $showingincrsize]
               if { $maxoffset > $showingrecsize * $showingtotalnumkeys } {
                  set maxoffset [expr $showingrecsize * $showingtotalnumkeys]
               }
               set sdata [get_recordindexsearch $showingindex $startoffset $maxoffset $showingrecsize $showingincrsize $showingdata2 2 3]
               binary scan $sdata H16 sdata
               if {$sdata != ""} {
                  if {[genrematch $sdata $genres] == 0} {
                     continue
                  }
               }
            }
            lappend showings [list $seconds $station]
# LJ added the next line: return as soon as we find a match.
		return $showings
            # puts "$seconds $station"
         } elseif {$compare == 1} {
            break
         } else {
            error "Error: fsid is less that search param"
         }
      }
      if {$watch == 0} {
         unset channeltabledata
      }

   }

   return $showings

}


register_module "showcase\" title=\" ...module written by LJ - www.ljay.org.uk " "Showcase" "Inside TiVo and Channel Highlights"