# xlist.itcl ("Blocklists")
#
# Allows for the creation and manipulation of a Blocklists. These are
# compared against entries on the TiVoWeb ToDo list page and matches
# are automatically flagged for deletion.
#
# Very useful in conjunction with auto-recording WishLists that generate
# lots of hits on unwanted programs.
#
# Ported from the TivoWeb code by Denali.
# (denali on tivocomminity.com)
# Based on code from TiVoWeb and psudocode by Stuart Anderton
# (sanderton on tivocommunity.com)
# Coding and TiVoWeb procedure integration by Kevin Reilly
# (denali on tivocommunity.com)
#
# This program is free software; you can redistribute it and/or modify it
# under the terms of the GNU General Public License version 2 as published
# by the Free Software Foundation. See <http://www.fsf.org/copyleft/gpl.txt>
#
# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY, and without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
# Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation Inc.,
# 59 Temple Place, Suite 330, Boston MA 02111-1307 USA.
#
# Save to tivoweb-tcl/modules as 'xlist.itcl' (or anything alphanumerically
# greater than 'ui.itcl'!) and restart TivoWebPlus.
#
# Replaces the procedure 'proc action_todo' within 'ui.itcl'
#
# Additions to the original TivoWebPlus(v1.2) 'ui.itcl' module are highlighted
# in this code using #BLOCKLIST and #\BLOCKLIST markers.
#
# January 12, 2004: v0.1	Initial release.
#
# January 13, 2004: v0.11	Added ability to add and remove Blocklist
#				entries directly from the ToDo list.
#				Some cosmetic changes.
#
# January 15, 2004: v0.2	Addition of episode title and description
#				matching with wildcards.
#				Visual changes to ToDo list integration.
#				Structural changes to code.
#				More cosmetic changes.
#
# January 16, 2004: v0.21	Added code to allow logical ANDing of
#				strings in the Blocking Patterns.
#				Cosmetic changes, mostly to on-screen help.
# January 17, 2004: v0.22	Corrected bug that caused Suggestions list
#				to fail.
#				Added code to deal with ? characters in
#				programme titles.
#				Amended save routine to prevent writing of
#				blank lines to end of file. Thanks LJ :)
#				Removed case-sensitivity of Title Blocklist
#				and changed sort type to -dictionary for
#				ease of finding titles in long lists.
#				Added link to quickly switch between ToDo
#				list and Scheduled Suggestions.
#				Small changes to on-screen text.
# January 26, 2004: v0.23	Corrected problem with AND logic that
#				prevented episode title matches from
#				registering.
# February 24, 2006: v0.24      Ported to TWP v1.2.2
# August    2, 2006: v0.25      Added right-click support

# Same as nth from util.itcl but with superscript
proc nth_sup {number} {
  switch -glob $number {
    1? {return ${number}<small><sup>th</sup></small>}
    { 1} {return "&nbsp;${number}<small><sup>st</sup></small>"}
    { 2} {return " &nbsp;[string trim $number]<small><sup>nd</sup></small>"}
    { 3} {return "&nbsp;${number}<small><sup>rd</sup></small>"}
    { ?} {return "&nbsp;${number}<small><sup>th</sup></small>"}
    *1 {return ${number}<small><sup>st</sup></small>}
    *2 {return ${number}<small><sup>nd</sup></small>}
    *3 {return ${number}<small><sup>rd</sup></small>}
    default { return ${number}<small><sup>th</sup></small>}
  }
}

proc action_todo {chan todotype env} {
  global db
  global channeltablestation
  global channeltablestation_alt
  global show_tivor

  #BLOCKLIST
  global blocklist blockpatt calling_todotype
  set calling_todotype $todotype
  set blocklist [gbl_load "/var/hack/etc/blocklist.txt"]
  set blockpatt [gbl_load "/var/hack/etc/blockpatt.txt"]
  #/BLOCKLIST

  if {[string index $todotype 0] == "/"} {
    set todotype [string range $todotype 1 end]
  }
  if {$todotype == 0} {
    puts $chan [html_start "To Do"]
    puts $chan [html_table_start "width=98%" "" ""]
    puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Chan"] [th "Program"] [th "Episode"]]
    set path "/Recording/Active"
    set prefix "4"
  } elseif {$todotype == 1} {
    puts $chan [html_start "Scheduled Suggestions"]
    puts $chan [html_table_start "width=98%" "" ""]
    puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Chan"] [th "Program"] [th "Episode"] [th "Score"]]
    set path "/Recording/Active"
    set prefix "4"
  } elseif {$todotype == 2} {
    puts $chan [html_start "Suggestions"]
    puts $chan [html_table_start "width=98%" "" ""]
    puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Chan"] [th "Program"] [th "Episode"] [th "Score"]]
    set path "/Recording/Pending"
    set prefix ""
  } elseif {$todotype == 7} {
    puts $chan [html_start "To Do"]

    #BLOCKLIST
    puts $chan [gbl_header $todotype]
    #/BLOCKLIST

    puts $chan "
<script defer language=\"JavaScript\">
<!--
function CheckAll(x, y) {
  for (var i=0; i < document.form.elements.length; i++) {
    var c = document.form.elements\[i\];
    if ((c.name.substr(0,x.length) == x) && (c.type == 'checkbox')) {
      c.checked = y;
    }
  }
}

function init() {
  if (!(document.getElementById || document.all || document.layers)) return;
  //document.oncontextmenu=new Function(\"return false\");
  for (i=0;i<document.links.length;i++) {
    link = document.links\[i\];
    if (link.tagName == \"A\" && link.href.indexOf('gbl_addremove/1/') !=-1) {
      document.links\[i\].onmouseover = function() {document.oncontextmenu=function() {return false}};
      document.links\[i\].onmousedown = checkIt;
      document.links\[i\].onmouseup = function() {return false};
      document.links\[i\].onmouseout = function() {document.oncontextmenu=null};
    }
  }
}

function checkIt(e) {
  if (window.Event) {
    butt = (e.which == 3);
    href = \"\" + e.target;
  } else {
    butt = (window.event.button == 2);
    href = \"\" + window.event.srcElement;
  }
  if (butt) {
    i = href.indexOf('gbl_addremove/1/');
    if (i!=-1) {
      location.href = href.substr(0,i+13) + '/2/' + href.substr(i+16);
    }
  }
  return false;
}

window.onload = init;
//-->
</script>"
    puts $chan [html_form_start "POST" "/confirmdelete/7/" "name=\"form\""]
    puts $chan [html_table_start "width=98%" "" ""]
    puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Chan"] [th "Program"] [th "Episode"] [th "<SMALL>BL</SMALL>"] [th "<input name=\"selectall\" type=\"checkbox\" value=\"Check All\" title=\"Select/Deselect All\" onClick=\"CheckAll('fsid_', selectall.checked);\">"]]
    set path "/Recording/Active"
    set prefix "4"
  } elseif {$todotype == 8} {
    puts $chan [html_start "Scheduled Suggestions"]

    #BLOCKLIST
    puts $chan [gbl_header $todotype]
    #/BLOCKLIST

    puts $chan "
<script language=\"JavaScript\">
<!--
function CheckAll(x, y) {
  for (var i=0; i < document.form.elements.length; i++) {
    var c = document.form.elements\[i\];
    if ((c.name.substr(0,x.length) == x) && (c.type == 'checkbox')) {
      c.checked = y;
    }
  }
}
//-->
</script>"
    puts $chan [html_form_start "POST" "/confirmdelete/8/" "name=\"form\""]
    puts $chan [html_table_start "width=98%" "" ""]
    puts $chan [tr "ALIGN=CENTER" [th "COLSPAN=2" "Date"] [th "Time"] [th "Chan"] [th "Program"] [th "Episode"] [th "Score"] [th "<SMALL>BL</SMALL>"] [th "<input name=\"selectall\" type=\"checkbox\" value=\"Check All\" title=\"Select/Deselect All\" onClick=\"CheckAll('fsid_', selectall.checked);\">"]]
    set path "/Recording/Active"
    set prefix "4"
  } else {
    puts "Error: invalid todo type"
    return 1
  }

  set rcount 0
  ForeachMfsFileTrans fsid name type $path $prefix 15 {
    set rec [db $db openid $fsid]
    set manual 0
    set suggestion 0
    if {$::version >= 3} {
      set recbeh [dbobj $rec get RecordingBehavior]
      set presbeh [dbobj $recbeh get PresentationBehavior]
      set progbeh [dbobj $recbeh get ProgramGuideBehavior]
      if { $presbeh == 10 || $presbeh == 9 } {
         set manual 1
      }
      if { $progbeh == 3 || $progbeh == 8 } {
         set manual 1
      }
      if { $presbeh == 6 } {
         set suggestion 1
      }
    } else {
      set seltype [dbobj $rec get SelectionType]
      if { $seltype == 10 || $seltype == 5 } {
         set manual 1
      }
      if { $seltype == 6 } {
         set suggestion 1
      }
    }
    if {($todotype == 0 || $todotype == 7) ^ ($suggestion == 1)} {
      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 description [strim [dbobj $program get Description]]

      if { $manual } {
        if { $title == "" } {
          set title "Manual Recording"
        } else {
          set title "Manual: $title"
        }
        set series ""
      } else {
        set series [dbobj $program get Series]
      }

      if {$series != ""} {
        set episodic [defaultval 1 [dbobj $series get Episodic]]
        set seriesfsid [dbobj $series fsid]
      } else {
        set episodic 0
        set manual 1
      }
      set eptitle [get_verbose_title $program $episodic 0]
      set originalairdate [dbobj $program get OriginalAirDate]
      if { $originalairdate != "" } {
        set originalairdatesecs [expr $originalairdate * 86400]
        if {$::lang == "en"} {
          set daystr [nth [clock format $originalairdatesecs -format "%e"]]
          set airdatestr [clock format $originalairdatesecs -format "$daystr %b %Y"]
        } else {
          set airdatestr [clock format $originalairdatesecs -format "%1m/%1d/%Y"]
        }
      } else {
        set airdatestr ""
      }
      if { $airdatestr != "" } {
        set hovertext "($airdatestr) $description"
      } else {
        set hovertext $description
      }
      set attrs [CreateHover $hovertext]
      if { [catch {set data $channeltablestation($stationfsid)}] != 1 || [catch {set data $channeltablestation_alt($stationfsid)}] != 1 } {
        set callsign [lindex $data 2]
      } else {
        set callsign [dbobj $station get CallSign]
      }
      set seconds [expr [dbobj $showing get Date] * 86400 + [dbobj $showing get Time]]
      set day [ftime $seconds "%a"]
      if {$::lang == "en"} {
        set daystr [nth_sup [ftime $seconds "%e"]]
        set date [ftime $seconds "$daystr&nbsp;%b"]
        set time [ftime $seconds "%H:%M"]
      } else {
        set date [ftime $seconds "%1m/%1d"]
        set time [ftime $seconds "%l:%M&nbsp;%P"]
      }
      set scorestr ""
      if {$todotype != 0 && $todotype != 7} {
        if {$::version >= 3} {
          set score [dbobj $rec get SubPriority]
        } else {
          set score [dbobj $rec get Score]
        }
        set scorestr [td "nowrap" [html_link "/thumbs/$seriesfsid" [ReadableThumbs $score]]]
      }

      set delete_td ""

      #BLOCKLIST
      set gbl_td ""
      #/BLOCKLIST

      if {$todotype == 7 || $todotype == 8} {
        # set delete_td [td "ALIGN=CENTER" [html_form_checkbox "fsid_${rcount}_$fsid" ""]]

	#BLOCKLIST
	set pattmatch 0
	set andmatch  0
	foreach element $blockpatt {
	  if {[string match "*+*" $element]} {
	    set andmatch [gbl_andlogic $element "[ftime $seconds "%a %H:%M"] $callsign $title $eptitle$description"]
	    if {$andmatch != 0} {
	      set pattmatch $andmatch
	    }
	  } elseif {[string match [string tolower *$element*] [string tolower "[ftime $seconds "%a %H:%M"] $callsign $title $eptitle$description"]] == 1} {
	    set pattmatch $element
	  }
	}
	if {[lsearch [string tolower $blocklist] [string tolower $title]] >= 0} {
	  set delete_td [td "ALIGN=CENTER" [html_form_checkbox "fsid_${rcount}_$fsid" "1"]]	
	  set gbl_td [td "ALIGN=CENTER" [html_link "/gbl_addremove/0/del/[gbl_queryparse $title]" "x" "title=\"Click to remove '$title'\rfrom the Title Blocklist\""]]
	} elseif {$pattmatch != 0} {
	  set delete_td [td "ALIGN=CENTER" [html_form_checkbox "fsid_${rcount}_$fsid" "1"]]	
	  set gbl_td [td "ALIGN=CENTER" [html_link "/gbl_edit" "?" "title=\"Matched with '$pattmatch'.\rClick to edit the Blocking Patterns.\""]]
	} else {				
          set delete_td [td "ALIGN=CENTER" [html_form_checkbox "fsid_${rcount}_$fsid" ""]]
	  set gbl_td [td "ALIGN=CENTER" [html_link "/gbl_addremove/1/$day%20$time%2B$callsign/[gbl_queryparse $title]" "+" "title=\"Click to add '$title'\rto the Title Blocklist\""]]
	}
	#/BLOCKLIST

        incr rcount
      }

      if { $callsign != "TIVOR" || $show_tivor == 1 } {
        ## Added desc_show -- SteveT
        if { $manual } {
          puts $chan [tr "" [td $day] [td $date] [td "NOWRAP ALIGN=RIGHT" $time] [td [html_link "/channel/$stationfsid" $callsign]] [td [html_link "/showing/$showingfsid" $title]] [td [html_link "/showing/$showingfsid" $eptitle $attrs][desc_show $hovertext]] $scorestr $gbl_td $delete_td]
        } else {
          puts $chan [tr "" [td $day] [td $date] [td "NOWRAP ALIGN=RIGHT" $time] [td [html_link "/channel/$stationfsid" $callsign]] [td [html_link "/series/$seriesfsid" $title]] [td [html_link "/showing/$showingfsid" $eptitle $attrs][desc_show $hovertext]] $scorestr $gbl_td $delete_td]
        }
      }
    }
  }

  puts -nonewline $chan [html_table_end]
    if {$todotype == 7 || $todotype == 8} {
      puts $chan [html_form_input "submit" "submit" "Delete Shows"]
      puts $chan [html_form_end]
    }
  puts $chan [html_end]
}


proc action_gbl_edit {chan path env} {
	global blocklist
	global blockpatt

	puts $chan [html_start "Edit Title Blocklist and Blocking Patterns"]
	puts $chan "<b>Title Blocklist and Blocking Patterns</b><p>"

	puts $chan {
    Entries in the Title Blocklist (left) are compared against <i>titles</i> in
    the To-Do and Scheduled Suggestions lists, and any matches are flagged for
    deletion. Manual entries need not be case-sensitive (although those added
    automatically will be capitalised as per TiVo's database).<p>
	  Entries in the Blocking Patterns (right) are compared against <i>episode
    names</i>, <i>descriptions</i> and showing <i>day/time</i> in the same
    lists, and any matches are also flagged. Entries in this list may include
    the <i>wildcards</i> <b>?</b> for matching any character and <b>*</b> for
    matching any string; logical AND combinations may be expressed as
    <i>"string1<b>+</b>string2"</i> (eg "Everwood+Thu 13:" will match Everwood
    at 1pm on Thursdays); patterns can be negated with a <b>!</b> (eg
    "Rugby+!TV1" would match Rugby only if it was not on TV1). Entries on this
    list are <i>NOT</i> case-sensitive and there are implicit <b>*</b>
    wildcards around the patterns when matching against the lists.<p>
	  If spaces are required in an entry or pattern then the string should be
    enclosed by quotes, otherwise it will be interpreted as multiple
    single-word entries. If the entry <i>is</i> a single word or spaceless
    string then the quotes may be ignored; they will be added automatically
    when saving.<p>}

	puts $chan [html_form_start "POST" "/gbl_update" ""]
	puts $chan [html_form_text "20" "35" "blocklist_new" $blocklist]
	puts $chan [html_form_text "20" "35" "blockpatt_new" $blockpatt]
	puts $chan "<p>"
	puts $chan [html_form_input "submit" "Save changes" "Save changes"]
	puts $chan [html_form_end]
	puts $chan [html_end]
}

proc action_gbl_update {chan path env} {
	eval $env
	global blocklist
	global blockpatt
	global calling_todotype

	puts $chan [html_start "Update Title Blocklist and Blocking Patterns"]

	set blocklist [gbl_savefile "/var/hack/etc/blocklist.txt" $blocklist_new]
	set blockpatt [gbl_savefile "/var/hack/etc/blockpatt.txt" $blockpatt_new]

	puts $chan "<b>Title Blocklist and Blocking Patterns updated.</b>"
	puts $chan [blocklist_status $calling_todotype]
}

proc action_gbl_addremove {chan path env} {
	global blocklist blockpatt
	global calling_todotype

  # 0=delete, 1=add, 2=add pattern
  set idx [string range $path 1 1]

  set path [string range $path 3 end]
  set pos [string first "/" $path]
  if {$pos != -1} {
    incr pos -1
    set str "+[string range $path 0 $pos]"
    incr pos 2
	  set title [string range $path $pos end]
  } else {
    set str ""
    set title $path
  }

	set title_quoted \"$title\"

  if {$idx == 2} {
		append blockpatt "\"$title$str\""

    action_gbl_edit $chan "" $env
    return
  }

	puts $chan [html_start "Add / Remove from Title Blocklist"]
	puts $chan "<b>$title_quoted</b><br>has been"

	if {[lsearch [string tolower $blocklist] [string tolower $title]] >= 0} {
		set blocklist [gbl_trimlist $blocklist $title]
		puts $chan " removed from"
	} else {
		append blocklist $title_quoted
		puts $chan " added to"
	}

	puts $chan " the Title Blocklist."
	set blocklist [gbl_savefile "/var/hack/etc/blocklist.txt" $blocklist]
	puts $chan [blocklist_status $calling_todotype]
	puts $chan [html_end]
}

proc blocklist_status {type} {
	global blocklist
	global blockpatt

	set ret "<br><br>"
	if {$type == 7} {
		append ret [html_link "/ui/todo" "Back to To-Do"]
	} else {
		append ret [html_link "/ui/suggestions" "Back to Scheduled Suggestions"]
	}
	append ret "<p>"
	append ret [html_table_start "" "" ""]
	append ret [tr "ALIGN=CENTER" [th "WIDTH=50%" "Title Blocklist"] [th "Blocking Patterns"]]
	append ret [tr "ALIGN=CENTER" [td [htmlEncode $blocklist]] [td [htmlEncode $blockpatt]]]
	append ret [html_table_end]
}

proc gbl_savefile {filename list} {
	set list [gbl_trimlist $list ""]
	set writefile [open $filename w]
	puts -nonewline $writefile $list
	close $writefile
	return $list
}

proc gbl_trimlist {list unwanted} {
   set newlist ""
   set list [lsort -dictionary $list]
   foreach element $list {
      if {[string tolower $element] != [string tolower $unwanted]} {
	 append newlist \"$element\"\n
      }
   }
   return $newlist
}

proc gbl_load {filename} {
   if {![file exists $filename]} {
      set openfile [open $filename w]
      close $openfile
   }
   set openfile [open $filename r]
   set ret [read $openfile]
   close $openfile
   return $ret
}

proc gbl_header {type} {
   set ret "Titles, episode titles and descriptions matching entries in the Title Blocklist or Blocking Patterns are<br>"
   append ret "pre-selected for deletion. Mouse-over the symbols in the Block column for context-sensitive help."
   append ret "<br>To manually edit Title Blocklist and Blocking Patterns click "
   append ret [html_link "/gbl_edit" "here"]
   append ret ".<br>"
}

proc gbl_andlogic {element description} {
   set ret $element
   while {[string match "*+*" $element] == 1} {
      set sliceright [string first "+" $element]
      set sliceleft [expr {$sliceright - 1}]
      incr sliceright
      set stringbit [string range $element 0 $sliceleft]
      set element [string range $element $sliceright end]
      if {[string range $stringbit 0 0] == "!"} {
	 set stringbit [string range $stringbit 1 end]
	 set neg 1
      } else {
	 set neg 0
      }
      if {[string match [string tolower *$stringbit*] [string tolower $description]] == $neg} {
	 set ret 0
      }
   }
   if {[string range $element 0 0] == "!"} {
      set element [string range $element 1 end]
      set neg 1
   } else  {
      set neg 0
   }
   if {[string match [string tolower *$element*] [string tolower $description]] == $neg} {
      set ret 0
   }	
   return $ret
}

proc gbl_queryparse {title} {
   set sliceright [string first "?" $title]
   while {$sliceright >= 0} {
      set sliceleft [expr {$sliceright -1}]
      incr sliceright
      set leftstring [string range $title 0 $sliceleft]
      set rightstring [string range $title $sliceright end]
      set title $leftstring
      append title "%3F"
      append title $rightstring
      set sliceright [string first "?" $title]
   }
   return $title
}

#BLOCKLIST
# Ensure /var/hack/etc exists
file mkdir /var/hack/etc

# Load up the block lists
set blocklist [gbl_load "/var/hack/etc/blocklist.txt"]
set blockpatt [gbl_load "/var/hack/etc/blockpatt.txt"]
#/BLOCKLIST