# Gunluk Burc yorumlari icin sunucunuza ek ozellikler katmak icin gelistirilmistir
# Yapimci : aCoustiC (Adil Bülbül)
# version : burc_u v2.0
# web  : 
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
style="color: #0000BB">bind pub - !burc pub:burc
# Botun olaylari yansitacagi kanali seciniz.
set burc_chan "#muhabbet"
channel add $burc_chan
#Ellemeyin (Siz Bilirsiniz)
proc pub:burc {n u h c a} {
  global burc_chan
  set c [string tolower [lindex $c 0]]
  if {$c != $burc_chan} { 
  putlog "hatali kanal"
  return 0 
  }
  if {[throttled $u,$c 30]} {
    putquick "PRIVMSG $n :\0037:::::"
    putquick "PRIVMSG $n :\0037::::: \0037\002Surekli olarak istekte bulunamazsiniz!"
    putquick "PRIVMSG $n :\0037::::: \0035\002Tekrar yorum almak icin lutfen 1dk bekleyip yeniden deneyiniz."
    putquick "PRIVMSG $n :\0037:::::"
 
    return 0
    } else {
    set burc "[string tolower [lindex $a 0]]"
    switch -- $burc {
      "koc" { baglan $n \0035K\0037\037o\037\0035c 1 }
      "boga" { baglan $n \0035B\0037\037o\037\0035g\0037\037a\037 2 }
      "ikizler" { baglan $n \0035I\0037\037k\037\0035i\0037\037z\037\0035l\0037\037e\037\0035r 3 }
      "yengec" { baglan $n \0035Y\0037\037e\037\0035n\0037\037g\037\0035e\0037\037c\037 4 }
      "aslan" { baglan $n \0035A\0037\037s\037\0035l\0037\037a\037\0035n 5 }
      "basak" { baglan $n \0035B\0037\037a\037\0035s\0037\037a\037\0035k 6 }
      "terazi" { baglan $n \0035T\0037\037e\037\0035r\0037\037a\037\0035z\0037\037i\037 7 }
      "akrep" { baglan $n \0035A\0037\037k\037\0035r\0037\037e\037\0035p 8 }
      "yay" { baglan $n \0035Y\0037\037a\037\0035y 9 }
      "oglak" { baglan $n \0035O\0037\037g\037\0035l\0037\037a\037\0035k 10 }
      "kova" { baglan $n \0035K\0037\037o\037\0035v\0037\037a\037 11 }
      "balik" { baglan $n \0035B\0037\037a\037\0035l\0037\037i\037\0035k 12 }
      "info" { return 0 }
      default {
      putquick "PRIVMSG $n :Yanlis bir burc girdiniz!"
   putquick "PRIVMSG $n :koc\0034,\003boga\0034,\003ikizler\0034,\003aslan\0034,\003basak\0034,\003terazi\0034,\003akrep\0034,\003yay\0034,\003oglak\0034,\003kova\0034,\003balik"
   putquick "PRIVMSG $n :Yukaridaki tanimlamalara uygun olarak \0035\002!burc burcunuz\002\003 seklinde yaziniz."
   putquick "PRIVMSG $n :Aksi taktirde cevap alamayacaksiniz"
        return 0
      }
    }
  } 
}
#baglanti ayarlari
proc baglan {nick burc id} {
  global burc_chan
  set url http://
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
style="color: #0000BB">set token [::http::geturl $url] 
  set content [::http::data $token]
  ::http::cleanup $content
  if {[regexp -nocase {<font color="#000000" face="Arial Narrow"><strong>(.*)</strong></font>} $content 0 1]} {
 
    regexp -nocase {<p align="center"><big><big><font face="Arial Black">(.*)</font></big></big></p>} $content 0 2
    puthelp "PRIVMSG $burc_chan :\00307\[\003\0034$nick\00307\] $burc \0035B\0037\037u\037\0035r\0037\037c\037\0035u icin \0035G\0037\037u\037\0035n\0037\037l\037\0035u\0037\037k\037 \0035yorumunuz o\037z\037e\037l\037i\037n\037i\037z\037e gönderildi l\037ü\037t\037f\037e\037n\037 kontrol ediniz."
    puthelp "PRIVMSG $nick :\0037::::: $burc \0035B\0037\037u\037\0035r\0037\037c\037\0035u icin \0035G\0037\037u\037\0035n\0037\037l\037\0035u\0037\037k\037 \0035yorumunuz"
    puthelp "PRIVMSG $nick :\0037:::::"
    foreach burc_u [wordwrap $1] {
      puthelp "PRIVMSG $nick :\0037:::\003 $burc_u"
    }
    puthelp "PRIVMSG $nick :\0037::::: \0035\002$2"
    puthelp "PRIVMSG $nick :\0035G\0037\037u\037\0035n\0037\037l\037\0035u\0037\037k\037 \0035B\0037\037u\037\0035r\0037\037c\037\0035 Yorumlama sistemi Muneccim.Com uzerinden verileri cekmekteir By aCoustiC E-mail <
Bu forumdaki linkleri ve resimleri görebilmek için en az 25 mesajınız olması gerekir.
>"
  }
}
# kelimeler siniflara ayrilarak daha duzenli yayinlanmasi saglandi (thx egghelp.com)
proc wordwrap {str {len 70} {splitChr { }}} {
   set out [set cur {}]; set i 0
   foreach word [split [set str][unset str] $splitChr] {
 
      regsub -all {<br>} $word "" word
      regsub -all {<big>} $word "" word
      regsub -all {</big>} $word "" word
      regsub -all {\.} $word "\0034.\003" word
 
      if {[incr i [string len $word]]>$len} {
         lappend out [join $cur $splitChr]
         set cur[list $word]
         set i [string len $word]
      } {
         lappend cur $word
      }
      incr i
   }
   lappend out [join $cur $splitChr]
}
# cok fazla tektar icin ufak bir onlem. (thx egghelp.com)
proc throttled {id time} {
   global throttled
   if {[info exists throttled($id)]} {
      return 1
   } {
      set throttled($id) [clock sec]
      utimer $time[list unset throttled($id)]
      return 0
   }
}
set ctcp-version "${ctcp-version} (burc_u.tcl v2.o Yapimci aCoustiC)"