#1 Çevrimdışı
Kullanıcıların profil bilgileri misafirlere kapatılmıştır.
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.
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir. Kod: Kodu kopyalamak için üzerine çift tıklayın!
# 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"
23 Eylül 2014, 20:31
Normal
