No_FeaR
30 Ağustos 2015, 22:12
(COL-CL) : Alianza Petrolera 2-1 Deportivo Cali -> Devre Arası.
(MEX-AP) : Tigres UANL 2-2 Guadalajara-Chivas -> Gol Atan Guadalajara-Chivas
Yapımcısı ; nrt
if 0 {
Soccer live Scores
To activate on a #channel
.chanset #channel +scores
on Partyline
}
if 0 {
Canlı Futbol Skorları
Kanal üstünde aktive etmek için:
Botunuza bağlanın (telnet /dcc /ctcp chat)
.chanset #kanal +scores
Komutu verin.
}
# 18.05.2015
# Bu script Tcl8.6 sürümleriyle çalışır. Daha eski sürümlerle çalıştırmaya kalkmayınız.
if {[info tclversion] < "8.6"} {
return -code error "\00305[lindex [split [info script] /] end]\003 \00306requires\003 \00304Tcl8.6.x\003 .\
\00306Your Tcl version is\003 \00304[info patchlevel]\003"
}
if {[join [split [string range [lindex [set ::version] 0] 0 5] "."] ""] >= "1620"} {
putloglev o * "\00305[lindex [split [info script] /] end]\003 \00306successfuly loaded.\003"
} else {
return -code error "\00305[info script]\003 \00306works with\003 \00304eggdrop1.6.20\003 or\
\00306greater versions. Your eggdrop version is\003 \00304$::version\003"
}
package present Tcl 8.6
package require eggdrop 1.6.20
if {[info commands scores::remove] eq "::scores::remove"} {
scores::remove
}
namespace eval scores {
namespace export check_score killer reader_f writer_f get_dt remove
bind cron - "*" [namespace current]::check_score
bind evnt - prerehash [namespace current]::remove
# Türkçe tercüme kullanılmak isteniyorsa , ( 1 ) olarak ayarlayın.
# Orjinal dil için ( 0 ) olarak bırakın.
variable trans 1
# bilgi alınacak adrestir.
variable link "[Only Registered Users Can See Links]"
# Alınan bilginin saklanacağı dosyadır.
variable fpath "goal.txt"
# Siteye bağlantıda bejklenecek maksimum gecikme süresi ,saniye cinsinden.
variable timeout "15"
# Bağlantıda kullanılacak useragent.
variable ua "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5"
variable transarray
# Tercüme kullanmayı tercih etmişseniz,kullanılacak çeviriler ve orjinal çıktıları.
array set transarray {
"Halftime" "Devre Arası."
"Goal for" "Gol Atan"
"Match Finished" "Maç Sonlandı."
"2nd Half Started" "İkinci Yarı Başladı."
"Kick Off" "Maç Başladı."
}
# siteye bağlantıda proxy kullanılmak isteniyorsa, bu ayarda belirtin. Kullanım şekli:
# proxy.hostu-yada.IP:portu ... gibidir. (http proxy)
# kullanılmayacaksa boş "" olarak bırakın
variable proxy "203.190.251.114:80"
# Ayarların sonu...
# Dosya yoksa oluşturulup ilk bilgiler çekilip ,yazılıyor.
if {![file exists $fpath] || ![file readable $fpath]} {
catch { ::scores::writer_f $fpath "[[namespace current]::get_dt $link] |" }
}
}
namespace eval scores {
setudef flag scores
package require http
proc check_score {minute hour day month weekday} {
foreach _ [utimers] {
if {[string match *[namespace current]::* $_]} {
killutimer [lindex $_ end-1]
}
}
set dt [[namespace current]::reader_f $::scores::fpath]
#set ext [lindex [split $dt |] 1] kullanmaya gerek yoktu. es geçildi.
set exscore [lindex [split $dt |] 0]
foreach chan [channels] {
if {[channel get $chan scores]} {
set out [[namespace current]::get_dt $::scores::link]
if {![string match *$out* $exscore]} {
putserv "privmsg $chan :$out"
[namespace current]::writer_f $::scores::fpath "$out|"
}
} else {
catch { [namespace current]::killer $chan }
}
utimer 30
[list [namespace current]::check_score $minute $hour $day $month $weekday]
}
return 0
}
# herhangi bir kanal üstünde aktif olmadığı sürece bind cron ve utimer'ın arka planda
# çalışıp botu yormamasını sağlamak için yazılmış prosedürdür.
# script aktif olmadığı sürece bind ve utimer çalışması bloke ediliyor.
proc killer {chan} {
if {![channel get $chan scores]} {
set i 0
foreach str [utimers] {
if {[string match *[namespace current]::* $str]} {
killutimer [lindex $str end-1]
incr i
}
}
set j 0
foreach _ [binds cron] {
if {[string match *check_score* $_]} {
unbind [lindex $_ 0] [lindex $_ 1] [lindex $_ 2] [lindex $_ end]
incr j
}
}
}
}
proc reader_f {file} {
if {![file exists $file] || ![file readable $file]} { return 0 }
set fp [open $file r]
try {
set i 0
while {[gets $fp line] >= 0} {
incr i
return $line
}
} finally {
close $fp
}
}
proc get_dt {link} {
if {[string match {*:*} $::scores::proxy] eq 1} {
set use_proxy [split $::scores::proxy ":"]
}
if {[info exists use_proxy] eq 1} {
set t [::[Only Registered Users Can See Links] -urlencoding "utf-8" -useragent $::scores::ua -proxyhost [lindex $use_proxy 0] -proxyport [lindex $use_proxy 1]]
} else {
set t [::[Only Registered Users Can See Links] -urlencoding "utf-8" -useragent $::scores::ua]
}
set d [::[Only Registered Users Can See Links] [set t [::[Only Registered Users Can See Links] $::scores::link -timeout [expr {round(1000 * $::scores::timeout)}]]]]
::[Only Registered Users Can See Links] $t
# bağlantı hata kontrollerini es geçtim. gerek görmedim şimdilik. denemelerde sıkıntı yaşanırsa ilerde, eklerim
regsub -all -- {(?:\n|\t|\v|\r|\x01)} $d " " d
set i 0; set out ""; set o ""; set s ""; set j 0
foreach {n o s} [regexp -all -inline -- {<\/title><description>([^<]+)<\/.+<pubDate>([^<]+)<\/} $d] {
#putlog "$o - $s"
if {[info exists s] && [info exists o]} {
# kullanmaktan vaz geçtiğim saat:dakika:saniye değerleri.
# gerek olmadığı görüldü. olmasada birşey fark etmiyor.
#regexp {:?([0-9]+):(\d+):(\d+)} $s - hour min sec
#set time "$hour:$min:$sec"
incr i
regexp -- {\(([^\)]+)\)} $o - lig
regexp -- {\)(.+?)\svs\s(.+?):} $o - home visit
regexp -- {:\s(\d+)-(\d+)} $o - ilk son
regexp -- {\-\s([^\|]+)} $o - desc
} else { return 0 }
# trans / çeviri isteniyorsa ingilizce kısımların çevirisi postalanacak.
variable transarray
if {($::scores::trans eq "1") && ([array size transarray] >= "1")} {
foreach {orj tur} [array get transarray] {
set desc [string map
[list $orj $tur] [join $desc]]
}
}
lappend out "\00304(\003\002$lig\002\00304)\003" : "\00312$home\003" "\00303$ilk\003\00304-\003\00303$son\003"\
"\00312$visit\003" "\00304\002->\002\003" "\00314$desc\003"
set out [string map
[list "&" "&"] $out]
if {$j eq 20} break
return [join $out]
incr j
}
}
proc writer_f {file data} {
set fp [open $file w]
try {
puts -nonewline $fp $data
} finally {
close $fp
}
}
# bu prosedür, script kaldırılmak istendiğinde .restart yada kill etmeye gerek kalmadan,
# namesapace prosedür ve değişkenlerini , utimer ve bindlerini botun hafızasından silinmesi sağlanıyor.
proc remove {args} {
set i 0
foreach runnin [utimers] {
if {[string match *[namespace current]::* $runnin]} {
killutimer [lindex $runnin end-1]
incr i
}
}
set j 0
foreach bindin [binds] {
if {[string match *[namespace current]::* $bindin]} {
unbind [lindex $bindin 0] [lindex $bindin 1] [lindex $bindin 2] [lindex $bindin 4]
incr j
}
}
namespace forget {*}[namespace export]
namespace delete [namespace current]
}
putlog "[file tail [info script]] ok..."
}
# EOF
(MEX-AP) : Tigres UANL 2-2 Guadalajara-Chivas -> Gol Atan Guadalajara-Chivas
Yapımcısı ; nrt
if 0 {
Soccer live Scores
To activate on a #channel
.chanset #channel +scores
on Partyline
}
if 0 {
Canlı Futbol Skorları
Kanal üstünde aktive etmek için:
Botunuza bağlanın (telnet /dcc /ctcp chat)
.chanset #kanal +scores
Komutu verin.
}
# 18.05.2015
# Bu script Tcl8.6 sürümleriyle çalışır. Daha eski sürümlerle çalıştırmaya kalkmayınız.
if {[info tclversion] < "8.6"} {
return -code error "\00305[lindex [split [info script] /] end]\003 \00306requires\003 \00304Tcl8.6.x\003 .\
\00306Your Tcl version is\003 \00304[info patchlevel]\003"
}
if {[join [split [string range [lindex [set ::version] 0] 0 5] "."] ""] >= "1620"} {
putloglev o * "\00305[lindex [split [info script] /] end]\003 \00306successfuly loaded.\003"
} else {
return -code error "\00305[info script]\003 \00306works with\003 \00304eggdrop1.6.20\003 or\
\00306greater versions. Your eggdrop version is\003 \00304$::version\003"
}
package present Tcl 8.6
package require eggdrop 1.6.20
if {[info commands scores::remove] eq "::scores::remove"} {
scores::remove
}
namespace eval scores {
namespace export check_score killer reader_f writer_f get_dt remove
bind cron - "*" [namespace current]::check_score
bind evnt - prerehash [namespace current]::remove
# Türkçe tercüme kullanılmak isteniyorsa , ( 1 ) olarak ayarlayın.
# Orjinal dil için ( 0 ) olarak bırakın.
variable trans 1
# bilgi alınacak adrestir.
variable link "[Only Registered Users Can See Links]"
# Alınan bilginin saklanacağı dosyadır.
variable fpath "goal.txt"
# Siteye bağlantıda bejklenecek maksimum gecikme süresi ,saniye cinsinden.
variable timeout "15"
# Bağlantıda kullanılacak useragent.
variable ua "Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.9.0.5) Gecko/2008120122 Firefox/3.0.5"
variable transarray
# Tercüme kullanmayı tercih etmişseniz,kullanılacak çeviriler ve orjinal çıktıları.
array set transarray {
"Halftime" "Devre Arası."
"Goal for" "Gol Atan"
"Match Finished" "Maç Sonlandı."
"2nd Half Started" "İkinci Yarı Başladı."
"Kick Off" "Maç Başladı."
}
# siteye bağlantıda proxy kullanılmak isteniyorsa, bu ayarda belirtin. Kullanım şekli:
# proxy.hostu-yada.IP:portu ... gibidir. (http proxy)
# kullanılmayacaksa boş "" olarak bırakın
variable proxy "203.190.251.114:80"
# Ayarların sonu...
# Dosya yoksa oluşturulup ilk bilgiler çekilip ,yazılıyor.
if {![file exists $fpath] || ![file readable $fpath]} {
catch { ::scores::writer_f $fpath "[[namespace current]::get_dt $link] |" }
}
}
namespace eval scores {
setudef flag scores
package require http
proc check_score {minute hour day month weekday} {
foreach _ [utimers] {
if {[string match *[namespace current]::* $_]} {
killutimer [lindex $_ end-1]
}
}
set dt [[namespace current]::reader_f $::scores::fpath]
#set ext [lindex [split $dt |] 1] kullanmaya gerek yoktu. es geçildi.
set exscore [lindex [split $dt |] 0]
foreach chan [channels] {
if {[channel get $chan scores]} {
set out [[namespace current]::get_dt $::scores::link]
if {![string match *$out* $exscore]} {
putserv "privmsg $chan :$out"
[namespace current]::writer_f $::scores::fpath "$out|"
}
} else {
catch { [namespace current]::killer $chan }
}
utimer 30
[list [namespace current]::check_score $minute $hour $day $month $weekday]
}
return 0
}
# herhangi bir kanal üstünde aktif olmadığı sürece bind cron ve utimer'ın arka planda
# çalışıp botu yormamasını sağlamak için yazılmış prosedürdür.
# script aktif olmadığı sürece bind ve utimer çalışması bloke ediliyor.
proc killer {chan} {
if {![channel get $chan scores]} {
set i 0
foreach str [utimers] {
if {[string match *[namespace current]::* $str]} {
killutimer [lindex $str end-1]
incr i
}
}
set j 0
foreach _ [binds cron] {
if {[string match *check_score* $_]} {
unbind [lindex $_ 0] [lindex $_ 1] [lindex $_ 2] [lindex $_ end]
incr j
}
}
}
}
proc reader_f {file} {
if {![file exists $file] || ![file readable $file]} { return 0 }
set fp [open $file r]
try {
set i 0
while {[gets $fp line] >= 0} {
incr i
return $line
}
} finally {
close $fp
}
}
proc get_dt {link} {
if {[string match {*:*} $::scores::proxy] eq 1} {
set use_proxy [split $::scores::proxy ":"]
}
if {[info exists use_proxy] eq 1} {
set t [::[Only Registered Users Can See Links] -urlencoding "utf-8" -useragent $::scores::ua -proxyhost [lindex $use_proxy 0] -proxyport [lindex $use_proxy 1]]
} else {
set t [::[Only Registered Users Can See Links] -urlencoding "utf-8" -useragent $::scores::ua]
}
set d [::[Only Registered Users Can See Links] [set t [::[Only Registered Users Can See Links] $::scores::link -timeout [expr {round(1000 * $::scores::timeout)}]]]]
::[Only Registered Users Can See Links] $t
# bağlantı hata kontrollerini es geçtim. gerek görmedim şimdilik. denemelerde sıkıntı yaşanırsa ilerde, eklerim
regsub -all -- {(?:\n|\t|\v|\r|\x01)} $d " " d
set i 0; set out ""; set o ""; set s ""; set j 0
foreach {n o s} [regexp -all -inline -- {<\/title><description>([^<]+)<\/.+<pubDate>([^<]+)<\/} $d] {
#putlog "$o - $s"
if {[info exists s] && [info exists o]} {
# kullanmaktan vaz geçtiğim saat:dakika:saniye değerleri.
# gerek olmadığı görüldü. olmasada birşey fark etmiyor.
#regexp {:?([0-9]+):(\d+):(\d+)} $s - hour min sec
#set time "$hour:$min:$sec"
incr i
regexp -- {\(([^\)]+)\)} $o - lig
regexp -- {\)(.+?)\svs\s(.+?):} $o - home visit
regexp -- {:\s(\d+)-(\d+)} $o - ilk son
regexp -- {\-\s([^\|]+)} $o - desc
} else { return 0 }
# trans / çeviri isteniyorsa ingilizce kısımların çevirisi postalanacak.
variable transarray
if {($::scores::trans eq "1") && ([array size transarray] >= "1")} {
foreach {orj tur} [array get transarray] {
set desc [string map
[list $orj $tur] [join $desc]]
}
}
lappend out "\00304(\003\002$lig\002\00304)\003" : "\00312$home\003" "\00303$ilk\003\00304-\003\00303$son\003"\
"\00312$visit\003" "\00304\002->\002\003" "\00314$desc\003"
set out [string map
[list "&" "&"] $out]
if {$j eq 20} break
return [join $out]
incr j
}
}
proc writer_f {file data} {
set fp [open $file w]
try {
puts -nonewline $fp $data
} finally {
close $fp
}
}
# bu prosedür, script kaldırılmak istendiğinde .restart yada kill etmeye gerek kalmadan,
# namesapace prosedür ve değişkenlerini , utimer ve bindlerini botun hafızasından silinmesi sağlanıyor.
proc remove {args} {
set i 0
foreach runnin [utimers] {
if {[string match *[namespace current]::* $runnin]} {
killutimer [lindex $runnin end-1]
incr i
}
}
set j 0
foreach bindin [binds] {
if {[string match *[namespace current]::* $bindin]} {
unbind [lindex $bindin 0] [lindex $bindin 1] [lindex $bindin 2] [lindex $bindin 4]
incr j
}
}
namespace forget {*}[namespace export]
namespace delete [namespace current]
}
putlog "[file tail [info script]] ok..."
}
# EOF