IRCForumu.ORG - Güncel Deprem Kodu Socket

Daha önce Telegram Botum için yazdığım script - IRCd sunucum olmadığı için test edemedim. Şimdi göz gezdirdim çalışır gibi duruyor.. :)
Kod:
# ================================================

# Kandilli Son Depremler Botu - Eggdrop TCL

# Güncellenme: 12 Kasım 2024 | No_FeaR

# Telegram Bot System | DevelOper (Orda No_FeaR Değilim) ^_^

# Eggdrop'unuzda tcllib veya http paketi kurulu olmalı: 

# source scripts/deprem.tcl (atılacak klasör)

# ================================================



# Ayarlanabilir kısım

set deprem(kanal) "#Sohbet"

set deprem(url) "http://www.koeri.boun.edu.tr/scripts/lst9.asp"

set deprem(interval) 60

set deprem(dbfile) "scripts/deprem.db"



# Renk kodları

set renk(bold) "\002"

set renk(reset) "\003"



# İlk çalıştırma

if {![info exists deprem_timer_running]} {

    timer $deprem(interval) deprem_kontrol

    set deprem_timer_running 1

    putlog "Kandilli Deprem Botu aktif - $deprem(interval) saniyede bir kontrol."

}



proc deprem_kontrol {} {

    global deprem renk

    

    # HTTP paketi kontrolü

    if {[catch {package require http} err]} {

        putlog "HATA: http paketi yok! tcllib kurun."

        timer $deprem(interval) deprem_kontrol

        return 0

    }

    

    # Veri çekme

    if {[catch {::http::geturl $deprem(url) -timeout 15000} token]} {

        putlog "Deprem verisi alınamadı."

        timer $deprem(interval) deprem_kontrol

        return 0

    }

    

    set data [::http::data $token]

    set status [::http::status $token]

    ::http::cleanup $token

    

    if {$status ne "ok"} {

        putlog "HTTP hatası: $status"

        timer $deprem(interval) deprem_kontrol

        return 0

    }

    

    # Bugünün tarihi (GMT+3 için manuel ayar)

    set su_an [clock seconds]

    set bugun [clock format [expr {$su_an + 10800}] -format "%Y.%m.%d" -gmt 1]

    

    set bulunan 0

    foreach line [split $data "\n"] {

        set line [string trim $line]

        if {$line eq ""} { continue }

        

        # KOERI formatı: 2024.11.16 14:23:45  38.1234  27.5678  5.2  -.-  3.4  IZMIR (KARABURUN)

        if {![regexp {^(\d{4}\.\d{2}\.\d{2})\s+(\d{2}:\d{2}:\d{2})\s+([\d\.\-]+)\s+([\d\.\-]+)\s+([\d\.]+)\s+[\d\.\-]+\s+([0-9\.]+)\s+(.+)$} $line -> tarih saat enlem boylam derinlik _ siddet yer]} {

            continue

        }

        

        # Sadece bugünün depremlerini kontrol et

        if {$tarih ne $bugun} { continue }

        

        set detay "$tarih $saat $siddet $yer"

        set hash [dep_simple_hash $detay]

        

        if {[dep_db_goruldu_mu $hash]} {

            continue

        }

        

        # Yeni deprem kaydet

        dep_db_kaydet $hash $detay

        

        # Mesaj gönder

        set mesaj "${renk(bold)}\0030,4\[DEPREM\]${renk(reset)} \0037Tarih:\003 $tarih \0037Saat:\003 $saat \0037Derinlik:\003 $derinlik km \0037Büyüklük:\003 $siddet \0037Yer:\003 $yer"

        putquick "PRIVMSG $deprem(kanal) :$mesaj"

        incr bulunan

    }

    

    # Tekrar çalıştır

    timer $deprem(interval) deprem_kontrol

    return 1

}



# Basit hash fonksiyonu (MD5 yerine)

proc dep_simple_hash {str} {

    set hash 0

    foreach char [split $str ""] {

        scan $char %c ascii

        set hash [expr {(($hash << 5) - $hash + $ascii) & 0xFFFFFFFF}]

    }

    return [format %x $hash]

}



# Veritabanı işlemleri

proc dep_db_kaydet {hash detay} {

    global deprem

    if {[catch {

        set fp [open $deprem(dbfile) a]

        puts $fp "$hash [clock seconds] $detay"

        close $fp

    } err]} {

        putlog "Veritabanına yazma hatası: $err"

    }

}



proc dep_db_goruldu_mu {hash} {

    global deprem

    if {![file exists $deprem(dbfile)]} { return 0 }

    

    if {[catch {

        set fp [open $deprem(dbfile) r]

        set data [read $fp]

        close $fp

    } err]} {

        putlog "Veritabanı okuma hatası: $err"

        return 0

    }

    

    foreach line [split $data "\n"] {

        if {[string match "$hash *" $line]} {

            return 1

        }

    }

    return 0

}



# Manuel komut (opsiyonel)

bind pub -|- !deprem deprem_manuel_kontrol

proc deprem_manuel_kontrol {nick host hand chan arg} {

    global deprem

    if {$chan eq $deprem(kanal)} {

        putquick "PRIVMSG $chan :Deprem kontrolü yapılıyor..."

        deprem_kontrol

    }

}



# Yeniden yükleme

bind evnt -|- prerehash deprem_temizle

proc deprem_temizle {type} {

    global deprem_timer_running

    catch {killtimer deprem_kontrol}

    set deprem_timer_running 0

}



putlog "Kandilli Deprem TCL Script yüklendi - by No_FeaR"
Bir hata alan olursa, Yazsın sorunu çözeriz.
Ama Dediğim Gibi IRCd Serverim Yok. Test Edemedim.. (;