tvprog2.tcl

[wiva]

This is a updated and modifed version of tvprog.tcl v0.1 by greenbear.

Code: Select all

############################################
# tvprog.tcl v0.2 by wiva.spam at gmail.com
# Updated to thefutoncritic's new layout
# and some other changes I wanted to limit
# the output.
#
# tvprog.tcl v0.1 by greenbear at gmail.com 
# 
# Parse the tv-program for yesterday, today and 
# tomorrow from thefutoncritic.com. 
# 
# Enable with .chanset #channel +tv 
#
#Max shows per line
set showsperline 3

bind pub - !today pub:tfctoday 
bind pub - !tomorrow pub:tfctomorrow 
bind pub - !yesterday pub:tfcyesterday

package require http

setudef flag tv 

proc pub:tfctoday {nick uhost hand chan text} { 
 if ![channel get $chan tv] return 
 parse:tfc $chan 0
} 

proc pub:tfctomorrow {nick uhost hand chan text} { 
 if ![channel get $chan tv] return 
 parse:tfc $chan 1
} 

proc pub:tfcyesterday {nick uhost hand chan text} {
 if ![channel get $chan tv] return
 parse:tfc $chan 2
}

proc parse:tfc {chan type} { 
 global showsperline
 set data [http::data [http::geturl http://www.thefutoncritic.com/cgi/calendar.cgi?view=whatsnew]]

 set data [string map {"\n" ""} $data] 
 set data [string map {"bigorange'>" "bigorange'>\n"} $data]
 set data [string map {"</li>" "</li>\n"} $data]
 set data [string map {"<ul>" "<ul>\n"} $data]

 if {$type==1} { 
  scan [clock format [clock scan tomorrow] -format "%m/%d/%y"] %d/%d/%d m d y 
 } elseif {$type==2} {
  scan [clock format [clock scan yesterday] -format "%m/%d/%y"] %d/%d/%d m d y
 } { 
  scan [strftime "%m/%d/%y"] %d/%d/%d m d y 
 } 
 set when "$m/$d/0$y" 

 set parse 0 
 set start 0
 foreach line [split $data \n] { 
  #Correct day found
  if {!$parse&&[string match -noc "*$when*" $line]} {
    set parse 1
    regsub -all {<(.|\n)*?>} $line {} clean
    set out [join $clean]
    putservmc "PRIVMSG $chan :$out"
    continue
  } 
  if {$parse&&[string match -noc "*middle*content*ends*" $line]} {return} 
  #Skip unwanted shows/channels
  if {$parse&&[string match -noc "*(lifetime)*" $line]} {continue}
  if {$parse&&[string match -noc "*(vh1)*" $line]} {continue}
  if {$parse&&[string match -noc "*(espn)*" $line]} {continue}
  if {$parse&&[string match -noc "*(mtv)*" $line]} {continue}
  if {$parse&&[string match -noc "*mlb*playoffs*" $line]} {continue}
  if {$parse&&[string match -noc "*(a&e)*" $line]} {continue}
  if {$parse&&[string match -noc "*(spike_tv)*" $line]} {continue}
  if {$parse} { 
   regsub -all {<(.|\n)*?>} $line {} clean 
   set out [join $clean] 
   #Gather all shows that start at the same time before outputting
   if {[string first "-" $out] != -1 && $when != [string range $out 0 [string first "-" $out ]]} {
    if {$start} {
        print:tfc $longstring $when $chan
    }
    set when [string range $out 0 [string first "-" $out ]]
    set longstring ""
    set start 1
    set nbr 1
   }

   if {$start} {
    set epnamestart [string first "-" $out]
    set epnamestop    [string first "(" $out]
    set epnbrstart  [string first "#" $out]
    # Check for FOX numbering
    if { $epnbrstart == -1 && [string match "*new?episode*(*-*)*" $out]} {
        set epnbrstart [expr 1+$epnamestop+[string first "-" [string range $out [expr 1+$epnamestop] end]]]
    }
    set epnbrstop    [string first ")" [string range $out $epnbrstart end]]
    if { $epnbrstart != -1 } {
        append longstring [string range $out [expr $epnamestart + 2] [expr $epnamestop - 1]]
        #Another FOX numbering fix
        if { [string index $out $epnbrstart] == "-"} {
            append longstring "#"
            append longstring [string range $out [expr 1+$epnbrstart] [expr $epnbrstart + $epnbrstop - 1] ]
        } else {
            append longstring [string range $out $epnbrstart [expr $epnbrstart + $epnbrstop - 1] ]
        }
        #Start on a new line after 'showsperline' shows
        if { [expr $nbr % $showsperline] == 0} {
            append longstring "\n"
        } else {
            append longstring " :: "
        }
        incr nbr

    }
   }
   if {$out==""} {
    print:tfc $longstring $when $chan
    return
   } 
  } 
 } 
} 

proc print:tfc {longstring when chan} {
    if { [string compare $longstring ""] != 0} {
        #Adjust for extra show separator added at the end of the line
        if { [expr 4+[string last " :: " $longstring]] == [string length $longstring] } {
            set longstring [string range $longstring 0 [string last " :: " $longstring]]
        }
        #Pad times to same length
        if { [string first ":" $when] == 1 } {
            set when 0$when
        }
        #Output each non-empty line with the time added
        foreach line [split $longstring \n] {
            if { [string length $line] > 1} {
                putserv "PRIVMSG $chan :$when $line"
            }
        }
    }
}

putlog "* tvprog2.tcl loaded." 

[JAFO]

Indeed the old version dont work no more

But this version gives an error coz of "putservmc"

I replaced it with putserv , works now , but ...................

In the old version i got loads of TV-Show , now i only get 1 or 2

Thx for updating tho wiva , but might need some more finetuning ????

[Sparky]

any chance of another update?
as they've changed their site yet again, would be appreciated.