# Guide Data Checker (GPL'd)
#
# 01/03/2005 - v1.0.1 - Original version from mrtickle's module
# 23/03/2005 - v1.0.2 - Added support to display gaps and missing data
# 04/04/2003 - v1.0.3 - Now handles channels with no data

set gd_expected 0

proc action_gdchecker {chan path env} {
   if {$path == "/"} {
      puts $chan [html_start "Guide data checker"]
      puts $chan [html_table_start "" "" "ALIGN=TOP"]
      puts $chan [tr "" [th "" "Guide data checker"]]
      puts $chan [tr "" [td [html_link "/gdchecker/datevschannel" "Date vs channel grid"]]]
      puts $chan [tr "" [td [html_link "/gdchecker/orphansps"     "Orphaned Season Passes"]]]
      puts -nonewline $chan [html_table_end]
      puts $chan [html_end]
   } elseif {$path == "/datevschannel"} {
      action_datevschannel $chan
   } elseif {$path == "/orphansps"} {
      action_orphansps $chan
   } else {
      puts $chan "Invalid path: $path"
   }
}

proc action_datevschannel {chan} {
   global channeltablestation channeltablenum
   global db
   
   puts $chan [html_start "Date vs channel grid"]
   
   set overallminday 00000
   set overallmaxday 99999
   
   foreach channum [lsort -real [array names channeltablenum]] {
      set stationid $channeltablenum($channum)
      set data $channeltablestation($stationid)
      set favourite [lindex $data 1]
      
      # get min and max dates for this channel
      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
	 }
      }

      if {[expr $maxday - $minday] < 3} {
	 # exclude stations with less than three days data
	 continue
      }
      
      # compare with overall min and max
      if {$overallminday < $minday} {
	 set overallminday $minday
      }
      if {$overallmaxday > $maxday} {
	 set overallmaxday $maxday
      }
   }

   # overallminday is now the earliest date that they all have data (some
   # may have earlier data, but not all). overallmaxday is now the latest
   # date that they all have data (some may have later data, but not all).

   if {[expr $overallmaxday - $overallminday] >30} {
      set overallmaxday [expr $overallminday + 30]
   }

   puts $chan [html_table_start "" "" ""]
   puts $chan [tr "ALIGN=LEFT"   [th ""]    [th "F"] [th ""] [gdchecker_dateheadermonths $chan $overallminday $overallmaxday]]
   puts $chan [tr "ALIGN=CENTER" [th ""]    [th "a"] [th ""] [gdchecker_dateheaderdates $chan $overallminday $overallmaxday]]
   puts $chan [tr "ALIGN=CENTER" [th "Num"] [th "v"] [th "Callsign"] [gdchecker_dateheaderdays $chan $overallminday $overallmaxday]]
   
   foreach channum [lsort -real [array names channeltablenum]] {
      set stationfsid $channeltablenum($channum)
      set data $channeltablestation($stationfsid)
      set favourite [lindex $data 1]
      set callsign [lindex $data 2]
      if { $favourite == 1 } {
	 set favstr "*"
      } else {
	 set favstr ""
      }
      
      # now call all the work
      puts $chan [tr "ALIGN=CENTER" [td "ALIGN=LEFT" $channum] [td $favstr] [td "ALIGN=LEFT" [html_link "/channel/$stationfsid" $callsign]] [gdchecker_datelinks $chan $overallminday $overallmaxday $stationfsid]]
   }
   puts -nonewline $chan [html_table_end]
   
   # now the key table
   puts $chan "<br>"
   puts $chan [html_table_start "" "" "ALIGN=TOP"]
   puts $chan [tr "" [td ""] [td "ALIGN=left" "Select blobs above to jump to listings for each channel/day"]]
   set imagestr "<FONT COLOR=red><B>#</B></FONT>"
   puts $chan [tr "" [td "ALIGN=left" "<FONT COLOR=red><B>#</B></FONT>"] [td "Schedule ends short"]]
   puts $chan [tr "" [td "ALIGN=left" "<FONT COLOR=orange><B>#</B></FONT>"] [td "Schedule starts late"]]
   puts $chan [tr "" [td "ALIGN=left" "<FONT COLOR=yellow><B>#</B></FONT>"] [td "Gaps in schedule data"]]
   puts $chan [tr "" [td "ALIGN=left" "<FONT COLOR=blue><B>#</B></FONT>"] [td "placeholder"]]
   puts $chan [tr "" [td "ALIGN=left" "<FONT COLOR=green><B>#</B></FONT>"] [td "Normal listings"]]
   puts $chan [html_table_end]
   puts $chan [html_end]
}

proc gdchecker_dateheadermonths {chan minday maxday} {
   set minseconds [expr $minday * 86400]
   set maxseconds [expr $maxday * 86400]
   set outputstr  ""
   set monthcount 0
   set monthlast  ""
   
   # month, in header cells
   for {set i $minseconds} {$i <= $maxseconds} {incr i 86400} {
      set timestr [clock format $i -format "%b"]
      if {$timestr != $monthlast} {
	 if {$monthcount != 0} {
	    # print block of cells for previous month, reset count
	    append outputstr [th "colspan=$monthcount" $monthlast]
	    set monthcount 0
	 }
      }
      set monthlast $timestr
      incr monthcount
   }
   # print final block of cells
   append outputstr [th "colspan=$monthcount" $monthlast]
   
   return $outputstr
}


proc gdchecker_dateheaderdates {chan minday maxday} {
   set minseconds [expr $minday * 86400]
   set maxseconds [expr $maxday * 86400]
   set outputstr  ""
   
   # date, in a header cell
   for {set i $minseconds} {$i <= $maxseconds} {incr i 86400} {
      set timestr [clock format $i -format "%e"]
      append outputstr [th $timestr]
   }
   
   return $outputstr
}

proc gdchecker_dateheaderdays {chan minday maxday} {
   set minseconds [expr $minday * 86400]
   set maxseconds [expr $maxday * 86400]
   set outputstr  ""
   
   # weekday, in a header cell, only want 1st char
   for {set i $minseconds} {$i <= $maxseconds} {incr i 86400} {
      set timestr [clock format $i -format "%a"]
      set timestr [string index $timestr 0]
      append outputstr [th $timestr]
   }
   
   return $outputstr
}

proc gdchecker_datelinks {chan minday maxday stationfsid} {
   global channeltablestation
   global gd_expected
   
   # puts $chan "DEBUG: STATIONFSID $stationfsid<br>"

   if {[string index $stationfsid 0] == "/"} {
      set stationfsid [string range $stationfsid 1 end]
   }
   set firstslash [string first "/" $stationfsid]
   set seconds ""
   if { $firstslash != -1 } {
      set stationid [string range $stationfsid 0 [expr $firstslash - 1]]
      set seconds   [string range $stationfsid [expr $firstslash + 1] end]
   } else {
      set stationid $stationfsid
   }
   
   set minseconds [expr $minday * 86400]
   set maxseconds [expr $maxday * 86400]
   
   set outputstr   ""
   set gd_expected 0

   # output a line of cells
   for {set i $minseconds} {$i <= $maxseconds} {incr i 86400} {
      set timestr [clock format $i -format "%e"]
      
      # now check the station for known patterns
      if { [catch {set data $channeltablestation($stationid)}] != 1 } {
	 set blobstr [split [gdchecker_listings $chan $stationid $i] "|"]
	 # IE: regsub {,} $blobstr "\n" blobstr
	 set imagestr "<FONT COLOR=[lindex $blobstr 0] TITLE=\"[lindex $blobstr 1]\"><B>#</B></FONT>"
      } else {
	 # SEVERE error - unknown channel, couldn't read callsign
	 set imagestr "<FONT COLOR=red TITLE=\"Unknown Channel\"><B>X</B></FONT>"
      }
      append outputstr [td [html_link "/listings/$stationid/$i" $imagestr]]
   }

   return $outputstr
}


proc gdchecker_listings {chan stationid seconds} {
   global db
   global channeltablestation
   global channeltablenum
   
   set listingsoutputstr ""
   
   set day       [expr $seconds / 86400]
   set startsecs $seconds
   set endsecs   [expr $startsecs + 86400]
   
   ForeachMfsFileTrans fsid name type "/Schedule" "$stationid:$day:" 10 {
      append listingsoutputstr [gdchecker_listingsrow $chan $fsid $startsecs $endsecs]
   }
   
   if {$listingsoutputstr == ""} {
      return "blue|No guide data"
   } else {
      return $listingsoutputstr
   }
}

proc gdchecker_listingsrow {chan fsid startsecs endsecs} {
   global db
   global tzoffset
   global gd_expected

   set secs     0
   set duration 0
   set colour   "green"
   set info     ""

   set stationday [db $db openid $fsid]
   set showings   [dbobj $stationday get Showing]
   foreach showing $showings {
      set time [dbobj $showing get Time]
      set secs [expr [dbobj $showing get Date] * 86400 + $time + $tzoffset]
      if { $secs >= $startsecs && $secs < $endsecs } {
	 if {$gd_expected > 0 && $duration == 0 && $secs > $gd_expected && $secs > $startsecs} {
	    set timestr [clock format $secs -format "%H:%M"]
	    set info   "${info},Day starts late: $timestr"
	    set colour "orange"
	 }
	 if {$gd_expected > 0 && $duration > 0 && $secs != $gd_expected} {
	    set timestr [clock format $secs -format "%H:%M"]
	    set timeexp [clock format $gd_expected -format "%H:%M"]
	    set info   "${info},Gap in data: $timeexp-$timestr"
	    set colour "yellow"
	 }
	 set duration    [dbobj $showing get Duration]
	 set gd_expected [expr $secs + $duration]
      }
   }
   if { [expr $secs + $duration] < $endsecs } {
      set timestr [clock format [expr $secs + $duration] -format "%H:%M"]
      set info   "${info},Day ends short: $timestr"
      set colour "red"
   }
   
   if {[string index $info 0] == ","} {
      set info [string range $info 1 end]
   }

   return "$colour|$info"
}

# #############################################################
proc action_orphansps {chan} {
   global db
   global tzoffset
   global seasonpassdir
   
   puts $chan [html_start "Orphaned Season Pass episodes"]
   set priority 0
   set splist ""
   ForeachMfsFileTrans fsid name type $seasonpassdir "" 20 {
      set sp [db $db openid $fsid]
      set type [defaultval 1 [dbobj $sp get Type]]
      incr priority
      lappend splist $priority
      if { $type == 1 } {
	 set series [dbobj $sp get Series]
	 set spfsid [dbobj $sp fsid]
	 set seriesfsid [dbobj $series fsid]
	 set title [strim [dbobj $series get Title]]
	 lappend splist $seriesfsid $title
	 set station [dbobj $sp get Station]
	 set stationfsid [dbobj $station fsid]
	 set callsign [dbobj $station get CallSign]
	 lappend splist $stationfsid $callsign
      } elseif { $type == 2 } {
	 set station [dbobj $sp get Station]
	 set stationfsid [dbobj $station fsid]
	 set starttimelocal [defaultval 0 [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 [expr $rectime / 86400]
	 set schedlist [get_fsidbyprefix "/Schedule" "$stationfsid:$datestr:"]
	 if { [scan [lindex $schedlist 1] "%d:%d:%d:%d:" dummy dummy2 starttimesched duration] == 4 } {
	    regsub {^0+([1-9])} $starttimesched {\1} starttimesched
	    regsub {^0+([1-9])} $duration {\1} duration
	    if {$starttimesched > $starttime} {
	       set datestr [expr ($rectime / 86400) - 1]
	       set schedlist [get_fsidbyprefix "/Schedule" "$stationfsid:$datestr:"]
	       if { [scan [lindex $schedlist 1] "%d:%d:%d:%d:" dummy dummy2 starttimesched duration] != 4 } {
		  error "Invalid /Schedule format: '[lindex $schedlist 1]'"
	       }
	       regsub {^0+([1-9])} $starttimesched {\1} starttimesched
	       regsub {^0+([1-9])} $duration {\1} duration
	    }
	    if { $::dtivo } {
	       if {$starttimesched + $duration <= $starttime} {
		  set stoptimestr [format "%05d" [expr $starttimesched + $duration]]
		  set schedlist [get_fsidbyprefix "/Schedule" "$stationfsid:$datestr:$stoptimestr:"]
	       }
	    }
	 } else {
	    #error "Invalid /Schedule format: '[lindex $schedlist 1]'"
	 }
	 set callsign [dbobj $station get CallSign]
	 set spfsid [dbobj $sp fsid]
	 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]
	       lappend splist $seriesfsid $title
	    } else {
	       lappend splist 0 "Manual Recording"
	       # puts "Error finding manual recording"
	    }
	 } else {
	    lappend splist 0 "Manual Recording"
	    # puts "Error finding manual recording"
	 }
	 lappend splist $stationfsid $callsign
      } elseif { $type == 3 } {
	 #wishlist
	 set theme [dbobj $sp get Theme]
	 set spfsid [dbobj $sp fsid]
	 set themefsid [dbobj $theme fsid]
	 set title [strim [dbobj $theme get Name]]
	 lappend splist 0 $title 0 ""
      }
   }
   
   # do this once here, rather than once per search
   update_sp_cache
   
   # now print the table from the list, and do searches against each title
   puts $chan [html_table_start "" "" ""]
   puts $chan [tr "ALIGN=CENTER" [th "Pri"] [th "Title"] [th "Channel"] [th "Matches found from title search"]]
   foreach {priority seriesid title stationfsid callsign} $splist {
      set rowstr ""
      append rowstr [td $priority]
      if {$stationfsid == 0} {
	 # wishlist
	 append rowstr [td $title] [td "<SMALL>(wishlist)</SMALL>"]
      } elseif {$seriesid == 0} {
	 # some manual SPs
	 append rowstr [td $title]
	 append rowstr [td [html_link "/channel/$stationfsid" $callsign]]
      } else {
	 # normal SPs and manual SPs
	 append rowstr [td [html_link "/series/$seriesid" $title]]
	 append rowstr [td [html_link "/channel/$stationfsid" $callsign]]
      }
      # now search for this title, and see how many results we get
      # more than one result could be bad! let the user decide
      if {$seriesid == 0} {
	 # don't do the search for wishlists
	 append rowstr [td "<SMALL><I>(search not performed)</I></SMALL>"]
      } else {
	 append rowstr [td [action_spsearch $title]]
      }
      puts $chan [tr "" $rowstr]
   }
   puts $chan [html_table_end]
   puts $chan [html_end]
}

proc action_spsearch {title} {
   global cache_sp_key
   global images
   
   # Now output search results. This was a search action
   regsub -nocase {^(a|the) } $title {} modq
   regsub -all {\$} $modq {} modq
   regsub -all {\*} $modq {} modq
   regsub -all {\,} $modq {} modq
   
   regsub -all {[^A-Za-z0-9\*\", 	]} $modq {} modq
   regsub -all {\"} $modq {} modq
   regsub "\t$" $modq {} dispq
   if {[string length $dispq] == 0} {
      return [h2 "Error, empty search query"]
   }
   if {[string length $dispq] < 2} {
      return [h2 "Error, require at least 2 characters in query"]
   }
   set searchResultsTitle [htmlEncode $dispq]
   #set searchResultsTitle "Search Results for \"$searchResultsTitle\""
   
   set fsids [get_textindexsearch $modq 0]
   
   if {[lindex $fsids 0] == -1} {
      return "No matches found in the current Guide Data"
   } elseif {[lindex $fsids 0] == -2} {
      return "Error running search [lrange $fsids 1 end]"
   } else {
      set spsearch_output ""
      
      # update_sp_cache
      foreach item [lrange $fsids 1 end] {
	 set seriestitle [lindex $item 0]
	 set fsid [lindex $item 1]
	 set fsid [expr 0x$fsid]
	 set genres [lindex $item 2]
	 regsub {^(.*), (A|The)$} $seriestitle {\2 \1} seriestitle
	 set slists [get_programshowings $fsid 1]
	 if {$slists != ""} {
	    set index [lsearch $cache_sp_key "$fsid|*"]
	    if {$index > -1} {
	       set imagestr [img "alt=\"\"" [lindex $images 11]]
	    } else {
	       set imagestr "<FONT COLOR=red><B>X</B></FONT>"
	    }
	    set link "/series/$fsid"
	    if {$spsearch_output != ""} {
	       set spsearch_output "$spsearch_output<BR>$imagestr [html_link $link [htmlEncode $seriestitle]]"
	    } else {
	       set spsearch_output "$imagestr [html_link $link [htmlEncode $seriestitle]]"
	    }
	 }
      }
      if {$spsearch_output != ""} {
	 return "$spsearch_output"
      } else {
	 return "No matches found in the current Guide Data"
      }
   }
}

register_module "gdchecker" "GDchecker" "Check Guide Data"