egghelp.org community :: View topic - Live Cricket Commentary Script [ Version 1.1.0 ]

[ egghelp.org home | forum home ]

egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.

FAQ

Memberlist

Usergroups

Profile

Live Cricket Commentary Script [ Version 1.1.0 ]
Goto page Previous 1, 2

egghelp.org community Forum Index -> Script Support & Releases

View previous topic :: View next topic

Author

Message

apnihost
Voice

Joined: 23 Jun 2013
Posts: 8

Posted: Tue Feb 17, 2015 3:29 pm Post subject:

dont warry ill update it tomorrow .

ChrisBruce
Voice

Joined: 15 Feb 2015
Posts: 7
Location: Internet

Posted: Tue Feb 17, 2015 4:04 pm Post subject:

apnihost wrote:

dont warry ill update it tomorrow .

much appreciated.
_________________
Entrepreneur

spithash
Master

Joined: 12 Jul 2007
Posts: 248
Location: Libera

Posted: Wed Feb 18, 2015 10:18 am Post subject:

Yeah the download url does not work. why don't you just paste the script here? _________________ Libera ##rtlsdr & ##re - Nick: spithash Click here for troll.tcl

spithash
Master

Joined: 12 Jul 2007
Posts: 248
Location: Libera

Posted: Thu Jun 11, 2015 3:45 pm Post subject:

I found the script, I'm just going to paste it here just in case you guys are still interested in it. I did not test it, I hope it still works Smile

Code:

catch {package require http}

namespace eval ::cricketarchive {

################################################################################################

variable author    "iRoc <apnihost@gmail.com> (c)"
variable version "1.1.1"
variable date    "08-Jul-2010"

set time_up [clock clicks -milliseconds]

variable options
variable feeds
variable token2feed

setudef str cricketarchive-default_lang
setudef str cricketarchive-usecolors

################################################################################################

set options(debug) 2
set options(msg_len) 400
set max_tcl_events 20
set select_timeout 100
set options(fast) 0
set options(default_lang) {bn en}
set options(usecolors) 1
set options(check_time) 30000
set options(url) "http://www.cricketarchive.com/Archive/Scorecards/%s_commentary.html"
set options(stop_no_output) 100

################################################################################################

proc compare_version {version1 version2} {

   set dec1 [split $version1 .]; set dec2 [split $version2 .]
   foreach a1 $dec1 a2 $dec2 {
      if {[string is space [set a1 [string trimleft $a1 0]]]} {set a1 0}
      if {[string is space [set a2 [string trimleft $a2 0]]]} {set a2 0}

      if {$a2 > $a1} {return 1} elseif {$a2 < $a1} {return 0}
   }
   return 0

}

if {[info procs lassign] == ""} {
   proc lassign {values args} {
      set vlen [llength $values]
      set alen [llength $args]
      for {set i $vlen} {$i < $alen} {incr i} {
         lappend values {}
      }
      uplevel 1 [list foreach $args $values break]
      return [lrange $values $alen end]
   }
}

if {[info command lreverse] == ""} {
   proc lreverse l {
      set r {}
      set r {}
      set i [llength $l]
      while {[incr i -1]} {lappend r [lindex $l $i]}
      lappend r [lindex $l 0]
   }
}

proc ladd {varName el} {
   upvar $varName var
   if {![info exists var]} {set var {}}
   if {[ni $var $el]} {
      lappend var $el
      return 1
   }
   return 0
}

if {[compare_version [info pa] 8.5]} {
   proc in {list element} {expr [lsearch -exact $list $element] >= 0}
   proc ni {list element} {expr [lsearch -exact $list $element] < 0}
} else {
   proc in {list element} {expr {$element in $list}}
   proc ni {list element} {expr {$element ni $list}}
}

################################################################################################

proc debug {text {level 1}} {
   variable options
   if {$options(debug) >= $level} {putlog "[namespace current]:: $text"}
}

proc Pop {varname {nth 0}} {
   upvar $varname args
   set r [lindex $args $nth]
   set args [lreplace $args $nth $nth]
   return $r
}

proc get_options_int {param {chan ""}} {
   variable options

   if {[check_isnull $chan] || ![validchan $chan]} {
      if {[info exists options($param)] && [string is digit $options($param)] && $options($param) >= 0} {
         return $options($param)
      }
   } else {
      set cset [channel get $chan cricketarchive-$param]
      if {![string is space $cset] && [string is digit $cset] && $cset >= 0} {return $cset}
      if {[info exists options($param)] && [string is digit $options($param)] && $options($param) >= 0} {
         return $options($param)
      }
   }
   return 0

}

proc importvars {lo} {

   foreach var $lo {
      set value [uplevel 2 "if {\[info exists $var\]} {set $var} else {set $var \"\"}"]
      uplevel [list set $var $value]
   }

}

proc check_isnull {str} {
   if {$str == "" || $str == "*"} {return 1} else {return 0}
}

################################################################################################

proc put_msgdest {args} {
   variable options

   set opts(-type) "privmsg";
   set opts(-speed) 2;

   if {[llength $args] > 2} {
      while {[string match -* [lindex $args 0]]} {
         switch -glob -- [lindex $args 0] {
            -type { set opts(-type) [Pop args 1] }
            -speed { set opts(-speed) [Pop args 1] }
            -- { Pop args; break }
            default {
               set opt [join [lsort [array names opts -*]] ", "]
               return -code error "bad option [lindex $args 0]: must be $opt"
            }
         }
         Pop args
      }
   }

   if {[llength $args] != 2} {
      return -code error "wrong # args: should be \"put_msgdest ?switches? dest text\""
   }

   set dest [lindex $args 0]
   set text [lindex $args 1]

   set text [string map [list {\002} "\002" {\037} "\037" {\026} "\026" {\003} "\003" {\017} "\017"] $text]

   set list_out [list]

   if {[string length $text] <= $options(msg_len)} {
      lappend list_out $text
   } else {

      set str_out ""
      set str_color ""
      set new 1

      set reg_color {(\003\d{1,2}(?:,\d{1,2})?|\003|\037|\026|\017|\002|\d{1,2}(?:,\d{1,2})?|||||)}
      set reg_dcolor {|\037\037||\002\002||\026\026}
      set reg_ccolor {[\017](.*?)$}

      foreach _0 [split $text] {

         if {$new} {set _1 $_0; set new 0} else {set _1 " $_0"}

         if {[string length "$_0"] > $options(msg_len)} {

            set str_tmp "$str_out$_1"
            while {[string length $str_tmp] > $options(msg_len)} {
               set str_out [string range "$str_color$str_tmp" 0 [expr $options(msg_len)-1]]
               set str_tmp [string range "$str_color$str_tmp" $options(msg_len) end]
               lappend list_out "$str_color$str_out"
               foreach {block color} [regexp -all -inline -- $reg_color $str_out] {
                  append str_color $color
               }
               while {[regexp -all -- $reg_ccolor $str_color -> str_color]} {}
               regsub -all -- $reg_dcolor $str_color {} str_color
            }
            set str_out $str_tmp
         } elseif {[string length "$str_color$str_out$_1"] > $options(msg_len)} {

            lappend list_out "$str_color$str_out"
            foreach {block color} [regexp -all -inline -- $reg_color $str_out] {
               append str_color $color
            }
            while {[regexp -all -- $reg_ccolor $str_color -> str_color]} {}
            regsub -all -- $reg_dcolor $str_color {} str_color
            set str_out $_0
         } else {
            append str_out $_1
         }

      }

      if {![string is space $str_out]} {lappend list_out "$str_color$str_out"}

   }

   if {$opts(-type) == "privmsg"} {
      set put_out "PRIVMSG [join $dest ","] :"
   } elseif {$opts(-type) == "notice"} {
      set put_out "NOTICE [join $dest ","] :"
   } elseif {$opts(-type) == "dcc" && [valididx $dest]} {
      set put_out ""
   } else {
      return
   }

   foreach _ $list_out {
      set msg $put_out$_
      if {$opts(-type) == "dcc"} {
         putdcc $dest $msg
      } elseif {$options(fast) || $opts(-speed) == 0} {
         append msg "\n"
         putdccraw 0 [string length $msg] $msg
      } elseif {$opts(-speed) == 1} {
         putquick $msg
      } elseif {$opts(-speed) == 2} {
         putserv $msg
      } elseif {$opts(-speed) == 3} {
         puthelp $msg
      }
   }

}

proc get_text {args} {
   variable text
   variable options

   set opts(-black) 0;
   set opts(-color) 0;
   set opts(-type) "text";
   set opts(-hand) "*";
   set opts(-chan) "";
   set opts(-lang) "";

   while {[string match -* [lindex $args 0]]} {
      switch -glob -- [lindex $args 0] {
         -black { set opts(-black) 1 }
         -color { set opts(-color) 1 }
         -type { set opts(-type) [Pop args 1] }
         -hand { set opts(-hand) [Pop args 1] }
         -chan { set opts(-chan) [Pop args 1] }
         -lang { set opts(-lang) [Pop args 1] }
         -- { Pop args; break }
         default {
            set opt [join [lsort [array names opts -*]] ", "]
            return -code error "bad option [lindex $args 0]: must be $opt"
         }
      }
      Pop args
   }

   if {$opts(-black) && $opts(-color)} {
      return -code error "can't use \"-black -color\" at the same time together"
   } elseif {$opts(-black)} {
      set colors {black}
   } elseif {$opts(-color)} {
      set colors {color}
   } else {
      if {[get_options_int usecolors $opts(-chan)]} {
         set colors {color black}
      } else {
         set colors {black color}
      }
   }

   if {$opts(-lang) == ""} {
      set langs [list]
      if {![check_isnull $opts(-hand)]} {
         foreach _ [getuser $opts(-hand) XTRA cricketarchive-default_lang] {
            if {[string is space $_]} continue
            ladd langs $_
         }
      }
      if {![check_isnull $opts(-chan)] && [validchan $opts(-chan)]} {
         foreach _ [channel get $opts(-chan) cricketarchive-default_lang] {
            if {[string is space $_]} continue
            ladd langs $_
         }
      }
      if {[info exists options(default_lang)]} {
         foreach _ $options(default_lang) {
            if {[string is space $_]} continue
            ladd langs $_
         }
      }
   } else {
      set langs $opts(-lang)
   }

   switch -- $opts(-type) {
      args - help - help2 {
         if {[llength $args] != 1} {
            return -code error "wrong # args: should be \"get_text ?switches? command\""
         }
         foreach color $colors {
            foreach lang $langs {
               if {[info exists text($opts(-type),$color,$lang,[lindex $args 0])]} {
                  return $text($opts(-type),$color,$lang,[lindex $args 0])
               }
            }
         }
      }
      default {
         if {[llength $args] != 2} {
            return -code error "wrong # args: should be \"get_text ?switches? name tag\""
         }
         foreach color $colors {
            foreach lang $langs {
               if {[info exists text($opts(-type),$color,$lang,[lindex $args 0],[lindex $args 1])]} {
                  return $text($opts(-type),$color,$lang,[lindex $args 0],[lindex $args 1])
               }
            }
         }
      }
   }

   return "null"

}

proc set_text {args} {
   variable text

   set opts(-black) 0;
   set opts(-color) 0;
   set opts(-type) "text";

   while {[string match -* [lindex $args 0]]} {
      switch -glob -- [lindex $args 0] {
         -black { set opts(-black) 1 }
         -color { set opts(-color) 1 }
         -type { set opts(-type) [Pop args 1] }
         -- { Pop args; break }
         default {
            set opt [join [lsort [array names opts -*]] ", "]
            return -code error "bad option [lindex $args 0]: must be $opt"
         }
      }
      Pop args
   }

   if {$opts(-black) && $opts(-color)} {
      return -code error "can't use \"-black -color\" at the same time together"
   } elseif {$opts(-black)} {
      set color "black"
   } elseif {$opts(-color)} {
      set color "color"
   } else {
      set color "black"
   }

   switch -- $opts(-type) {
      args - help - help2 {
         if {[llength $args] != 3} {
            return -code error "wrong # args: should be \"set_text ?switches? lang command string\""
         }
         set text($opts(-type),$color,[lindex $args 0],[lindex $args 1]) [lindex $args 2]
      }
      default {
         if {[llength $args] != 4} {
            return -code error "wrong # args: should be \"set_text ?switches? lang name tag string\""
         }
         set text($opts(-type),$color,[lindex $args 0],[lindex $args 1],[lindex $args 2]) [lindex $args 3]
      }
   }

   return

}

proc sprintf {name text args} {

   if {[string index $text 0] == "#"} {
      importvars [list shand schan]
      if {![info exists schan]} {set schan "*"}
      set textlang [get_text -hand $shand -chan $schan -- $name $text]
      if {$textlang == "null"} {
         return "Module \002$name\002, text \002$text\002 not found. Args: [join $args ", "]"
      } else {
         set text $textlang
      }
   }
   set ind 0
   set first [string first "%s" $text]
   while {$first >= 0} {
      set text [string replace $text $first [expr $first+1] [lindex $args $ind]]
      set first [string first "%s" $text [expr $first+[string length [lindex $args $ind]]]]
      incr ind
   }
   return $text

}

################################################################################################

proc http_done {token} {
   variable options
   variable feeds
   variable token2feed

   if {[catch {
   set feed $token2feed($token)

   debug "http_done $feed" 2

   set errid [::http::status $token]
   set errtxt [::http::error $token]
   set ncode [::http::ncode $token]

   debug "http_done $feed ($errid) ($errtxt) ($ncode)" 2

   if { $errid == {ok} && $ncode == 200} {

      upvar #0 $token state
      set data $state(body)
      set data [encoding convertfrom iso8859-1 $data]

      #::ccs::SaveFile test.html $data

      #if {[regexp -- {<div class=\"cf_uf_col3\" style=\"border:none\">(.*?)<br />(.*?)</div>} $data -> a b]} {
      #
      # set a [string trim [string map {{\n} {}} $a]]
      # set b [string trim [string map {{\n} {}} $b]]
      #
      # if {$feeds($feed,header) != [list $a $b]} {
      #    foreach chan $feeds($feed,chan) {
      #       put_msgdest -- $chan [sprintf cricketarchive #109 $a $b]
      #    }
      #    set feeds($feed,header) [list $a $b]
      # }
      #
      #}

      set ldata [regexp -all -inline -- {<tr>(.+?)</tr>} $data]
      #set ldata [regexp -all -inline -- {<div class=\"row([a-z]+?)\">.*<strong>(.+?)</strong>.*?<strong><font .*?>(.+?)</font></strong>(.+?)</font>.*?</div>} $data]

      set temp_live {}
      foreach {-> a} $ldata {

         if {[regexp -- {<td .+?>(\d+)</td><td .+?>([a-z0-9]+)</td><td .+?>([a-z0-9]+)</td><td .+?>(.+?)</td>} $a -> c1 c2 c3 c4]} {

         } elseif {[regexp -- {<td width="100" colspan="3" valign="top">(.*?)</td><td>(.+?)</td>} $a -> c1 c2]} {
            set c3 ""
            set c4 ""
         } elseif {[regexp -- {<td colspan="3" align="center"></td><td><a .+?>(.+?)</a> (.+?)</td>} $a -> c1 c2]} {
            set c3 ""
            set c4 ""
         } else {
            continue
         }
         regsub -all {<.+?>(.*?)</.+?>} $c4 "\00312\\1\00304" c4
         regsub -all {<br>} $c4 { } c4

         if {[lsearch -exact $feeds($feed,live) [list $c1 $c2 $c3 $c4]] < 0} {
            lappend feeds($feed,live) [list $c1 $c2 $c3 $c4]
            lappend temp_live [list $c1 $c2 $c3 $c4]
         }

      }

         if ($feeds($feed,start)) {
            set feeds($feed,start) 0
            set l [lrange $temp_live end end]
         } else {
            set l $temp_live
         }

      foreach _ $l {
         lassign $_ c1 c2 c3 c4
         foreach chan $feeds($feed,chan) {
            if {$c3 == "" && $c4 == ""} {
               put_msgdest -- $chan [sprintf cricketarchive #107 $c1 $c2]
            } else {
               put_msgdest -- $chan [sprintf cricketarchive #106 $c1 $c2 $c3 $c4]
            }
         }
      }
      if {[llength $temp_live] == 0} {
         incr feeds($feed,null)
         if {$feeds($feed,null) >= $options(stop_no_output)} {
            foreach chan $feeds($feed,chan) {
               put_msgdest -- $chan [sprintf cricketarchive #108 $feed]
            }
            timer_stop $feed
         }
      } else {
         set feeds($feed,null) 0
      }

   }

   #set feeds($feed,token) ""
   ::http::cleanup $token
   unset token2feed($token)

   } err]} {
      debug "http_done, error: $err"
   }
}

proc timer_check {feed} {
   variable options
   variable feeds
   variable token2feed

   debug "timer_check $feed" 2

   timer_start $feed
   ::http::config -urlencoding utf-8
   ::http::config -useragent "Opera/9.10 (Windows NT 5.1; U; ru)"

   set url [string map [list %s "[string range $feed 0 2]/$feed/$feed"] $options(url)]

   debug "get url $url" 2
   set token [::http::geturl $url -command [namespace origin http_done] -binary true -timeout 20000]
   set feeds($feed,token) $token
   set token2feed($token) $feed

}

proc timer_start {feed} {
   variable options
   variable feeds

   debug "timer_start $feed" 2

   set feeds($feed,timer) [after $options(check_time) [list [namespace origin timer_check] $feed]]

}

proc timer_stop {feed} {
   variable feeds

   debug "timer_stop $feed" 2

   after cancel $feeds($feed,timer)
   foreach _ [array names feeds "$feed,*"] { unset feeds($_) }

}

proc pub_startmatch {nick uhost hand chan text} {
   variable feeds

   if {![regexp -nocase -- {^(\d+)$} $text -> feed]} {
      put_msgdest -type notice -- $nick [sprintf cricketarchive #101]
      return
   }

   if {[info exists feeds($feed,feed)]} {

      if {[in $feeds($feed,chan) $chan]} {
         put_msgdest -- $chan [sprintf cricketarchive #103 $feed]
      } else {
         lappend feeds($feed,chan) $chan
         put_msgdest -- $chan [sprintf cricketarchive #102 $feed]
      }

   } else {

      set feeds($feed,feed) 1
      set feeds($feed,chan) [list $chan]
      set feeds($feed,timer) 0
      set feeds($feed,token) ""
      set feeds($feed,header) {}
      set feeds($feed,live) {}
      set feeds($feed,null) 0
      set feeds($feed,start) 1
      put_msgdest -- $chan [sprintf cricketarchive #102 $feed]

      timer_check $feed

   }

   debug "<<$nick ($hand)>> !$chan! start match, feed $feed"

}

proc pub_stopmatch {nick uhost hand chan text} {
   variable feeds

   if {![regexp -nocase -- {^(\d+)$} $text -> feed]} {
      put_msgdest -type notice -- $nick [sprintf cricketarchive #101]
      return
   }

   if {[info exists feeds($feed,feed)]} {

      if {[in $feeds($feed,chan) $chan]} {
         set feeds($feed,chan) [lsearch -not -inline -all $feeds($feed,chan) $chan]
         if {[llength $feeds($feed,chan)] == 0} {
            timer_stop $feed
         }
         put_msgdest -- $chan [sprintf cricketarchive #104 $feed]
      } else {
         put_msgdest -- $chan [sprintf cricketarchive #105 $feed]
      }

   } else {

      put_msgdest -- $chan [sprintf cricketarchive #105 $feed]

   }

   debug "<<$nick ($hand)>> !$chan! stop match, feed $feed"

}

proc pub_infomatch {nick uhost hand chan text} {
   set t [::http::geturl http://www.cricketarchive.com/]
   set data [::http::data $t]
   ::http::cleanup $t

   set l [regexp -all -inline -- {<tr><td height="22"><div align="center"><a href="/Archive/Scorecards/.*?/.*?/(.*?)_mini.html">(.*?)</a></div></td></tr>} $data]

   foreach {black a b } $l {

      set a [string trim $a " \n"]
      set b [string trim $b " \n"]

      regsub -all {<.+?>} $a {} a
      regsub -all {<.+?>} $b {} b

      putserv "PRIVMSG $chan :4$b 3Start Command !startmatch $a"
   }
}

################################################################################################

proc prerehash {type} {
   binds_down
}

proc binds_down {} {

   set b [binds "[namespace current]::*"]
   foreach _ $b {unbind [lindex $_ 0] [lindex $_ 1] [lindex $_ 2] [lindex $_ 4]}
   debug "[llength $b] binds is down"

}

proc main {} {

   bind pub -|- !startmatch [namespace origin pub_startmatch]
   bind pub -|- !stopmatch [namespace origin pub_stopmatch]
   bind pub -|- !infomatch [namespace origin pub_infomatch]
   bind evnt -|- prerehash [namespace origin prerehash]

   debug "[llength [binds "[namespace current]::*"]] binds is up"
}

################################################################################################
# \D2\E5\EA\F1\F2\FB

set_text en cricketarchive #101 "\00305You must specify #Id match."
set_text en cricketarchive #102 "\00305Watching the match #Id %s added to display the current channel."
set_text en cricketarchive #103 "\00305Watching the match #Id %s is already added to output for the current channel."
set_text en cricketarchive #104 "\00305Watching the match #Id %s is stopped for the current channel."
set_text en cricketarchive #105 "\00305Watching the match #Id %s is not conducted on the current channel."
set_text en cricketarchive #106 "10Over: %s, 10Ball: %s, 10Runs: %s 4%s"
set_text en cricketarchive #107 "3%s 3%s"
set_text en cricketarchive #108 "\00305Watching the match #Id %s stopped due to lack of output."
# set_text en cricketarchive #109 "\00314%s \017>> \00314%s"
set_text en cricketarchive #109 "12 %s -|- %s %s %s "
################################################################################################
# \C7\E0\EF\F3\F1\EA

main

set time_down [clock clicks -milliseconds]
debug "v$version \[$date\] by $author loaded in [expr ($time_down-$time_up)/1000.0] s"

}

_________________
Libera ##rtlsdr & ##re - Nick: spithash
Click here for troll.tcl

Display posts from previous:

	egghelp.org community Forum Index -> Script Support & Releases	All times are GMT - 4 Hours Goto page Previous 1, 2
Page 2 of 2

You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum