| saywhat | 23 Eylül 2014 20:31 |
stackoverflow Tcl
programlama , scripting ile ilgilenen kişilerin işine yarayabilecek türden "ingilizce" bir scripttir. kendime özel, diye yapıp aylardır kullandığım scriptlerden biridir.
stackoverflow sitesinden sorgulama yapar. [Üye Olmadan Linkleri Göremezsiniz. Üye Olmak için TIKLAYIN...] Kod:
# tcllib http paketi gerektirir.
package require http
# .chanset #kanal +over , komutu ile aktif edilir.
setudef flag over
# komuta erişimi olacak kullanıcı flagları
set overflag "-|-"
# komut başına gelecek sembol.
set oversemb "."
# kaç arama sonucu vermeli:
set oversay "3"
# kanal ve özelde kullanılacak komutlar.
set overkmt "stack over flow sof"
# özelde de işlesin mi : 1 = evet 0 = hayır.
set overmsg 1
# komutlar arası beklenmesi gereken süre (saniye)
set overkontr "10"
# ayarlar sonu...
foreach bind [split $overkmt " "] {
bind pub $overflag $oversemb$bind over_flow_pub
if {$overmsg >= 1} {
bind msg $overflag $oversemb$bind over_flow_msg
}
}
proc over_flow_pub {nick uhost hand chan text} {
if {![channel get $chan over]} { return 0 }
over_flow_main $nick $uhost $hand $chan $text
}
proc over_flow_msg {nick uhost hand text} {
over_flow_main $nick $uhost $hand $nick $text
}
proc over_flow_main {nick uhost hand chan text} {
set q [join [lrange [split [string tolower $text]] 0 end]]
set host [lindex [split $uhost @] 1]
if {[throttled $host,$chan $::overkontr]} {
puthelp "notice $nick :\002Flood detected !!!\002 - \
\00314you have to wait, [expr {[clock seconds] - $::throttled($host,$chan)}] seconds ...\003"
return 0
}
if {[llength $q] eq "0"} {
puthelp "notice $nick :\00304Usage:\003 \002$::lastbind <your search>\002"
return 0
}
set overurl "http://stackoverflow.com/search?"
set query [http::formatQuery q $q]
putlog "$overurl$query"
::http::config -useragent "Mozilla/4.0 (compatible; MSIE 4.01; Windows CE; PPC; 240x320)"
set url [::http::geturl $overurl[join $query "+"] -timeout [expr {6*1000}]]
set data [split [::http::data $url] "\n"]
::http::cleanup $url
# putserv "privmsg $chan :\026\"$q\"\026 searching...please wait..."
regsub -all -- "\n" $data "" data
regsub -all -- "\r" $data "" data
regsub -all -- "\b" $data "" data
regsub -all -- "\t" $data "" data
regsub -all -- "\v" $data "" data
regsub -all -- "\f" $data "" data
regexp {results-header">(.*?)</span>.+page-description">(.*?)</p>} $data "" arat sonuc
if {[info exists sonuc] eq "1"} {
regsub -all -- "<.*?>" $sonuc "" sonuc
regsub -all -- \} $sonuc "" sonuc
regsub -all -- \{ $sonuc "" sonuc
regsub -all -- "<.*?>" $arat "" arat
regsub -all -- \} $arat "" arat
regsub -all -- \{ $arat "" arat
puthelp "privmsg $chan :\00303[string trim $arat]\003 \00314[string trim $sonuc]\003 \026$q\026"
return
}
regexp {results-header">(.*?)</span>} $data "" result
if {[info exists result] eq "1"} {
regsub -all -- "<.*?>" $result "" result
regsub -all -- \} $result "" result
regsub -all -- \{ $result "" result
puthelp "privmsg $chan :\00303[string trim $result] found :\003"
}
set i 0
set ans "";set vote ""; set page ""; set int "" ; set yazar ""
while {[regexp -line {votes answered">(.*?)</div>.+<a href="(.*?)" title=".*?">(.*?)</a>.+excerpt">(.*?)</div>.+started fr">(.*?)</a>} $data g vote page ans int yazar]} {
regsub -line {votes answered">(.*?)</div>.+<a href="(.*?)" title=".*?">(.*?)</a>.+excerpt">(.*?)</div>.+started fr">(.*?)</a>} $data "" data
set cikti "\00312$ans\003 \00304$vote\003 \00302$yazar\003"
regsub -all -- "<.*?>" $cikti "" cikti
regsub -all -- "<.*?>" $int "" int
regsub -all -- \} $cikti "" cikti
regsub -all -- \{ $cikti "" cikti
if {[info exists page] && $page ne ""} {
lappend cikti \037http://stackoverflow.com$page\037
}
set int [string map {\\ ""} $int]
set cikti [string map {\\ ""} $cikti]
if {$i == $::oversay} break
putserv "privmsg $chan :[string trim [entityToChar $cikti]]"
putserv "privmsg $chan :\00314[string trim [string map -nocase {\} "" \{ ""} [entityToChar $int]]]\003"
incr i
}
return 0
}
set authr "\00300,04 \u262A \003 \002\026\u006E\u0072\u0074 \u0028\u0053\u0061\u0079\u0057\u0068\u0061\u0074\u0029\002"
# http://is.gd/SVU9r1
# credits to user for this proc
proc throttled {id time} {
global throttled
if {[info exists throttled($id)]} {
return 1
} {
set throttled($id) [clock seconds]
utimer $time [list unset throttled($id)]
return 0
}
}
# i have to say thank you, to speechles and perplexa ..
# also creators of htmlparse for this useful proc.
proc entityToChar {text {char utf-8}} {
if {![string match *&* $text]} {return $text}
set escapes {
\xa0 ¡ \xa1 ¢ \xa2 £ \xa3 ¤ \xa4
¥ \xa5 ¦ \xa6 § \xa7 ¨ \xa8 © \xa9
ª \xaa « \xab ¬ \xac * \xad ® \xae
¯ \xaf ° \xb0 ± \xb1 ² \xb2 ³ \xb3
´ \xb4 µ \xb5 ¶ \xb6 · \xb7 ¸ \xb8
¹ \xb9 º \xba » \xbb ¼ \xbc ½ \xbd
¾ \xbe ¿ \xbf À \xc0 Á \xc1 Â \xc2
à \xc3 Ä \xc4 Å \xc5 Æ \xc6 Ç \xc7
È \xc8 É \xc9 Ê \xca Ë \xcb Ì \xcc
Í \xcd Î \xce Ï \xcf Ð \xd0 Ñ \xd1
Ò \xd2 Ó \xd3 Ô \xd4 Õ \xd5 Ö \xd6
× \xd7 Ø \xd8 Ù \xd9 Ú \xda Û \xdb
Ü \xdc Ý \xdd Þ \xde ß \xdf à \xe0
á \xe1 â \xe2 ã \xe3 ä \xe4 å \xe5
æ \xe6 ç \xe7 è \xe8 é \xe9 ê \xea
ë \xeb ì \xec í \xed î \xee ï \xef
ð \xf0 ñ \xf1 ò \xf2 ó \xf3 ô \xf4
õ \xf5 ö \xf6 ÷ \xf7 ø \xf8 ù \xf9
ú \xfa û \xfb ü \xfc ý \xfd þ \xfe
ÿ \xff ƒ \u192 Α \u391 Β \u392 Γ \u393 Δ \u394
Ε \u395 Ζ \u396 Η \u397 Θ \u398 Ι \u399
Κ \u39A Λ \u39B Μ \u39C Ν \u39D Ξ \u39E
Ο \u39F Π \u3A0 Ρ \u3A1 Σ \u3A3 Τ \u3A4
Υ \u3A5 Φ \u3A6 Χ \u3A7 Ψ \u3A8 Ω \u3A9
α \u3B1 β \u3B2 γ \u3B3 δ \u3B4 ε \u3B5
ζ \u3B6 η \u3B7 θ \u3B8 ι \u3B9 κ \u3BA
λ \u3BB μ \u3BC ν \u3BD ξ \u3BE ο \u3BF
π \u3C0 ρ \u3C1 ς \u3C2 σ \u3C3 τ \u3C4
υ \u3C5 φ \u3C6 χ \u3C7 ψ \u3C8 ω \u3C9
ϑ \u3D1 ϒ \u3D2 ϖ \u3D6 • \u2022
… \u2026 ′ \u2032 ″ \u2033 ‾ \u203E
⁄ \u2044 ℘ \u2118 ℑ \u2111 ℜ \u211C
™ \u2122 ℵ \u2135 ← \u2190 ↑ \u2191
→ \u2192 ↓ \u2193 ↔ \u2194 ↵ \u21B5
⇐ \u21D0 ⇑ \u21D1 ⇒ \u21D2 ⇓ \u21D3 ⇔ \u21D4
∀ \u2200 ∂ \u2202 ∃ \u2203 ∅ \u2205
∇ \u2207 ∈ \u2208 ∉ \u2209 ∋ \u220B ∏ \u220F
∑ \u2211 − \u2212 ∗ \u2217 √ \u221A
∝ \u221D ∞ \u221E ∠ \u2220 ∧ \u2227 ∨ \u2228
∩ \u2229 ∪ \u222A ∫ \u222B ∴ \u2234 ∼ \u223C
≅ \u2245 ≈ \u2248 ≠ \u2260 ≡ \u2261 ≤ \u2264
≥ \u2265 ⊂ \u2282 ⊃ \u2283 ⊄ \u2284 ⊆ \u2286
⊇ \u2287 ⊕ \u2295 ⊗ \u2297 ⊥ \u22A5
⋅ \u22C5 ⌈ \u2308 ⌉ \u2309 ⌊ \u230A
⌋ \u230B ⟨ \u2329 ⟩ \u232A ◊ \u25CA
♠ \u2660 ♣ \u2663 ♥ \u2665 ♦ \u2666
" \x22 & \x26 < \x3C > \x3E O&Elig; \u152 œ \u153
Š \u160 š \u161 Ÿ \u178 ˆ \u2C6
˜ \u2DC   \u2002   \u2003   \u2009
‌ \u200C ‍ \u200D ‎ \u200E ‏ \u200F – \u2013
— \u2014 ‘ \u2018 ’ \u2019 ‚ \u201A
“ \u201C ” \u201D „ \u201E † \u2020
‡ \u2021 ‰ \u2030 ‹ \u2039 › \u203A
€ \u20AC ' \u0027 ‎ ""
};
set text [string map [list "\]" "\\\]" "\[" "\\\[" "\$" "\\\$" "\\" "\\\\"] [string map $escapes $text]]
regsub -all -- {&#([[:digit:]]{1,5});} $text {[format %c [string trimleft "\1" "0"]]} text
regsub -all -- {&#x([[:xdigit:]]{1,4});} $text {[format %c [scan "\1" %x]]} text
return [subst "$text"]
}
putlog "\00304Tcl Surumu\003 :\00311 $tcl_patchLevel \003- \00304Tcl Dizin\003 :\00311 $tcl_library \003- \00304Eggdrop Surumu\003 :\00311 [lindex $version 0] \003 $authr"
putlog "\00304Http Paket Surumu\003 :\00311 [package present http] \003- \00304Sistem Encoding\003 :\00311 [encoding system] \003"
putlog "\00304Host\003 :\00311 [info hostname] \003- \00304OS\003 :\00311 $::tcl_platform(os) $::tcl_platform(osVersion)/$::tcl_platform(machine) \003"
putlog "\00304PID Numarasi\003 :\00311 [pid] \003- \00304Sunucuya Bagli Oldugu Sure\003 :\00311 [duration [expr {[clock seconds] - ${server-online}}]] \003"
putlog "\00304Bot Uptime\003 :\00311 [duration [expr {[clock seconds] - $::uptime}]] \003- \00304Tarih\003 :\00311 [ctime [unixtime]] $::timezone \003"
putlog "\00304Irc Gorunumu\003 :\00311 $::botname $::realname \003- \00304Bagli Oldugu Sunucu\003 :\00311 $::serveraddress \003- \00304.Conf Dosyasi\003 :\00311 $::config \003"
| 