uykumu aldıktan,yemek yiyip, ciğara & kolamı içtikten sonra gelen zihin açıklığıyla gördüm ki; bir güncellemeye daha ihtiyaç var-mışşş...
şöyle ki "kimi sitelerden" alınan </title> başlık, bir takım html kod artıklarını da barındırabildiği ( • , vs vs gibi ) görüldüğünden ;
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
bunları ayıklamak/çözümlemek adına orjinali tcllib htmlparse paketinden olmakla beraber en bilinen kullanımı rus perplexa'nın yıllar evvelki artık çalışmayan ud.tcl scriptinde bu iş için kullandığı prosedür'den faydalanmak , artık "kaçınılmaz bir zorunluluk" olmuştu. (ki kendisinden ,bu tür scriptlerimde, birazda zorunluluk ve yenisini kendim yazmanın ,onca karakteri tek tek bulup tırmalamanın hem zahmetli hemde "gereksiz" olacağını düşünerek,hemde ecnebilerin bu gibi durumlarda kullanmayı sevdiği "tekerleği yeniden icad etmeye uğraşmanın anlamı yok !.. yapılmışı varsa , O'nu kullanacaksın" deyişine uygun olarak kullandığım prosedür) . ki bu InşAllah "son" güncellemeyle ,alınan sonuç istenen/beklenen şekilde oldu...
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir. gazamız mübarek olsun...
Kod: Kodu kopyalamak için üzerine çift tıklayın!
if {[info tclversion] < 8.5} {
putloglev o * "Bu scripti kullanmak icin en az, Tcl8.5.x ve ustu Tcl surumlerinden biri kurulu olmali. Algilanan surum : $tcl_patchLevel"
} else {
putloglev o * "Algilanan Tcl surumu : $tcl_patchLevel shorten.tcl yuklendi.kanal ustunde aktif etmek icin : .chanset #kanal +shorten"
}
package require Tcl 8.5
namespace eval isgd {
package require http
setudef flag shorten
}
bind pubm - "*" ::isgd::is_gd:pubm
bind msgm - "*" ::isgd::is_gd:msgm
proc ::isgd::is_gd:msgm {nick uhost hand text} {
::isgd::is_gd:main $nick $uhost $hand $nick $text
return 0
}
proc ::isgd::is_gd:pubm {nick uhost hand chan text} {
if {![channel get $chan shorten]} { return 0 }
::isgd::is_gd:main $nick $uhost $hand $chan $text
return 0
}
proc ::isgd::is_gd:main {nick uhost hand chan text} {
set veri [::isgd::check_txt $text]
#putlog "$nick -> $veri"
set isurl "http://is.gd/api.php?longurl=$veri"
set url [::http::geturl "$isurl" -timeout [expr {6*1000}]]
set data [split [::http::data $url] \n]
::http::cleanup $url
regexp {(.*)} $data "" output
set titleurl "http://$veri"
set turl [::http::geturl "$titleurl" -timeout [expr {6*1000}]]
set tdata [split [::http::data $turl] \n]
::http::cleanup $turl
regexp {<title>(.*?)</title>} $tdata "" title
if {![info exists title]} {
set title "bilgi yok.."
} elseif {[string match -nocase "*Error*Sorry*" $output]} {
set output "hata oluştu.."
putlog "$title - $output"
return 0
} else {
set cikti ""
lappend cikti \037\00314$output\003\037 \00304->\003 \002 {*}[::isgd::entityToChar $title] \002
puthelp "privmsg $chan :$nick -> $cikti"
return 0
}
}
proc ::isgd::check_txt {text} {
set t [stripcodes bcruag $text]
foreach _ [split $t] {
if {[regexp -nocase -- {http://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {https://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {ftp://([^\s]+)} $_ -> out] || \
[regexp -nocase -- {
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
out]} {
return $out
}
}
}
# perplexa'nın ud.tcl scriptinde kullandığı ,aslı tcllib htmlparse'den alınma,
# html kodları/artıklarını ayıklamakta kullanılan prosedür.
proc ::isgd::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 "ok..."