kamus.tcl

abah · Post by **abah** » Mon Mar 09, 2020 1:48 pm

script kamus.tcl

bind pub - !a msg_bahasa

proc msg_bahasa {nick uhost hand chan text} {
  global botnick
  set time_setting "%Y/%m/%d"
  set tanggalharini [clock format [clock seconds] -format $time_setting]
  set text [string tolower $text]
  if {$text == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}
  set bahasa [lindex $text 0]
  set artikan [lindex $text 1]

  if {$bahasa == "" || $artikan == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}

set bahasa [string tolower $bahasa]
switch $bahasa {
        padang { set bhs2 k }
        aceh { set bhs2 o }
        bali { set bhs2 g }
        banjar { set bhs2 h }
        bugis { set bhs2 r }
        jawa { set bhs2 i }
        lampung { set bhs2 s }
        makassar { set bhs2 j }
        palembang { set bhs2 l }
        pontianak { set bhs2 n }
        sunda { set bhs2 m}
        default { set bhs2 k }
}

if {$bhs2 == ""} { return }

###putserv "PRIVMSG $chan : $bahasa -- $artikan -- $bhs2"

  if {[string match "*" $text]} {
  set connect [::http::geturl http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan]
  set files [::http::data $connect]
  ::http::cleanup $files

    set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $files]

if {[llength $l] != 0} {
     set m 0
     foreach {black a b} $l {
         incr m
         set a [string trim $a " \n"]
         set b [string trim $b " \n"]

         regsub -all {<.+?>} $a {} a
         regsub -all {<.+?>} $b {} b


        striphtml $a
        striphtml $b
        set kumpulin "$m. $a "
        append muncrat $kumpulin
        }
       putserv "PRIVMSG $chan : Translate $artikan dalam bahasa [string toupper $bahasa]: $muncrat"

} else { putserv "NOTICE $nick :\[\002[string toupper $bahasa]\002\] Kami tidak menemukan bahasa lainnya" }


        }
}


proc striphtml { text } {

     # filter out scripts, stylesheets, tags, and most escaped characters
     set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
     set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
     set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
     set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
     set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
     set text [regsub -all -nocase {&(amp|#38);} $text "&"]
     set text [regsub -all -nocase {&(lt|#60);} $text "<"]
     set text [regsub -all -nocase {&(gt|#62);} $text ">"]
     set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
     set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
     set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
     set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
     set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

     # and last, catch arbitrary sequences
     set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
     set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
     set text [subst $text]

     return $text

}

putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"

and i run but i get error messege

Tcl error [msg_bahasa]: invalid command name "::http::geturl"

can help me fix that script tq

Post by **caesar** » Tue Mar 10, 2020 7:26 am

At the top add:

Code: Select all

package require http

abah · Post by **abah** » Fri Mar 20, 2020 8:56 am

can you teach how tcl can use the command +chanset

Post by **willyw** » Fri Mar 20, 2020 9:00 am

abah wrote:can you teach how tcl can use the command +chanset

Not sure what you mean. Is this it?

http://forum.egghelp.org/viewtopic.php?p=98054#98054

abah · Post by **abah** » Fri Mar 20, 2020 9:34 am

setudef flag bahasa

proc msg_bahasa {nick uhost hand chan text} {
if {![channel get $chan bahasa]} { return 0 }

correct ?

Post by **willyw** » Fri Mar 20, 2020 10:30 am

abah wrote:
setudef flag bahasa

proc msg_bahasa {nick uhost hand chan text} {
if {![channel get $chan bahasa]} { return 0 }
correct ?

If you are wanting to have:
.chanset #channel +bahasa
as an On switch for that proc, for #channel - yes.

Try it.
Test it with both:
.chanset #channel +bahasa
and
.chanset #channel -bahasa

You can see it's current value any time, with:
.chaninfo #channel

I hope this helps.

abah · Post by **abah** » Sun Mar 22, 2020 8:33 am

Code: Select all

bind pub - !a msg_bahasa

package require http << added

proc msg_bahasa {nick uhost hand chan text} {
if {[channel get $chan bahasa]} { return 0 } < please comment my edit right or wrong ?
  global botnick
  set time_setting "%Y/%m/%d"
  set tanggalharini [clock format [clock seconds] -format $time_setting]
  set text [string tolower $text]
  if {$text == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}
  set bahasa [lindex $text 0]
  set artikan [lindex $text 1]

  if {$bahasa == "" || $artikan == "" } {putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda";return}

set bahasa [string tolower $bahasa]
switch $bahasa {
        padang { set bhs2 k }
        aceh { set bhs2 o }
        bali { set bhs2 g }
        banjar { set bhs2 h }
        bugis { set bhs2 r }
        jawa { set bhs2 i }
        lampung { set bhs2 s }
        makassar { set bhs2 j }
        palembang { set bhs2 l }
        pontianak { set bhs2 n }
        sunda { set bhs2 m}
        default { set bhs2 k }
}

if {$bhs2 == ""} { return }

###putserv "PRIVMSG $chan : $bahasa -- $artikan -- $bhs2"

  if {[string match "*" $text]} {
  set connect [::http::geturl http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan]
  set files [::http::data $connect]
  ::http::cleanup $files

    set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $files]

if {[llength $l] != 0} {
     set m 0
     foreach {black a b} $l {
         incr m
         set a [string trim $a " \n"]
         set b [string trim $b " \n"]

         regsub -all {<.+?>} $a {} a
         regsub -all {<.+?>} $b {} b


        striphtml $a
        striphtml $b
        set kumpulin "$m. $a "
        append muncrat $kumpulin
        }
       putserv "PRIVMSG $chan : Translate $artikan dalam bahasa [string toupper $bahasa]: $muncrat"

} else { putserv "NOTICE $nick :\[\002[string toupper $bahasa]\002\] Kami tidak menemukan bahasa lainnya" }


        }
}


proc striphtml { text } {

     # filter out scripts, stylesheets, tags, and most escaped characters
     set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
     set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
     set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
     set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
     set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
     set text [regsub -all -nocase {&(amp|#38);} $text "&"]
     set text [regsub -all -nocase {&(lt|#60);} $text "<"]
     set text [regsub -all -nocase {&(gt|#62);} $text ">"]
     set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
     set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
     set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
     set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
     set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

     # and last, catch arbitrary sequences
     set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
     set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
     set text [subst $text]

     return $text

}

putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"

I added but still error

Post by **caesar** » Sun Mar 22, 2020 10:53 am

Same error? A new one? Be more specific.

I took the liberty to fix your code a bit. Haven't tested anything so let me know if it works or you get any errors.

Code: Select all

namespace eval bahasa {

	package require http
	setudef flag bahasa
	bind pub - !a [namespace current]::public

	proc public {nick uhost hand chan text} {
		if {![channel get $chan bahasa]} return
		set lang {Padang Aceh Bali Banjar Bugis Jawa Lampung Makassar Palembang Pontianak Sunda}
		if {[scan $text {%s%s} bahasa artikan] != 2} {
			putserv "NOTICE $nick :Command: !a bahasa kata - Bahasanya: [join $lang ", "]"
			return
		}
		
		if {[lsearch -nocase $lang $bahasa]} {
			set bhs2 "k"
		} else {
			set bhs2 [string map [list "padang" "k" "aceh" "o" "bali" "g" "banjar" "h" "jawa" "i" "lampung" "s" "makassar" "j" "palembang" "l" "pontianak" "n" "sunda" "m"] $bahasa]
		}
		
		set http [::http::geturl "http://www.kamusdaerah.com/?bhs=a&bhs2=$bhs2&q=$artikan"]
		set data [::http::data $http]
		::http::cleanup $http

		set l [regexp -all -inline -- {<div class='arti'>Artinya: </div>(.*?)<div class='bahasa'>(.*?)</div>} $data]

		set bahasa [string toupper $bahasa]
		if {[llength $l]} {
			set m 0
			foreach {black a b} $l {
				incr m
				set a [string trim $a " \n"]
				set b [string trim $b " \n"]
				regsub -all {<.+?>} $a {} a
				regsub -all {<.+?>} $b {} b
				striphtml $a
				striphtml $b
				set kumpulin "$m. $a "
				append muncrat $kumpulin
			}
			putserv "PRIVMSG $chan :Translate $artikan dalam bahasa $bahasa: $muncrat"
		} else {
			putserv "NOTICE $nick :\[\002$bahasa\002\] Kami tidak menemukan bahasa lainnya"
		}
	}

	proc striphtml { text } {
		# filter out scripts, stylesheets, tags, and most escaped characters
		set text [regsub -all -nocase {<script[^>]*?>.*?</script>} $text " "]
		set text [regsub -all -nocase {<style[^>]*?>.*?</style>} $text " "]
		set text [regsub -all -nocase {<[\/\!]*?[^<>]*?>} $text " "]
		set text [regsub -all -nocase {([\r\n])[\s]+} $text "\\1"]
		set text [regsub -all -nocase {%&(quot|#34);} $text "\""]
		set text [regsub -all -nocase {&(amp|#38);} $text "&"]
		set text [regsub -all -nocase {&(lt|#60);} $text "<"]
		set text [regsub -all -nocase {&(gt|#62);} $text ">"]
		set text [regsub -all -nocase {&(nbsp|#160);} $text " "]
		set text [regsub -all -nocase {&(iexcl|#161);} $text "\xa1"]
		set text [regsub -all -nocase {&(cent|#162);} $text "\xa2"]
		set text [regsub -all -nocase {&(pound|#163);} $text "\xa3"]
		set text [regsub -all -nocase {&(copy|#169);} $text "\xa9"]

		# and last, catch arbitrary sequences
		set text [string map {[ \\[ ] \\] $ \\$ \\ \\\\} $text]
		set text [regsub -all -nocase {&#(\d+);} $text {[format c \1]}]
		set text [subst $text]

		return $text
	}

	putlog "\00303[string range [info script] 0 end]\00303 \002loaded...\002"
}

Oh, and you didn't get any errors since this:

Code: Select all

if {[channel get $chan bahasa]} { return 0 }

returns 1 if the channel had +bahasa set.

Edit: Fixed the code.

abah · Post by **abah** » Tue Mar 24, 2020 12:53 pm

[25:12:37:33:am] -> *agnes* set #makmur +bahasa
[25:12:37:20:am] -agnes- Set +bahasa for #makmur
[25:12:37:41:am] <abi> !a
[25:12:37:50:am] <abi> !a aku

not respon from bot

Post by **caesar** » Wed Mar 25, 2020 1:55 am

That's most likely cos I forgot to add:

Code: Select all

setudef flag bahasa

under the:

Code: Select all

package require http

Edited the above code to add the line and it's working:

[07:53:05] (@cez): !a
[07:53:07] -Bot- Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda
[07:53:23] (@cez): !a aku
[07:53:25] -Bot- Command: !a bahasa kata - Bahasanya: Padang, Aceh, Bali, Banjar, Bugis, Jawa, Lampung, Makassar, Palembang, Pontianak, Sunda
[07:53:43] (@cez): !a bali bahasanya
[07:53:44] -Bot- [BALI] Kami tidak menemukan bahasa lainnya

abah · Post by **abah** » Wed Mar 25, 2020 2:21 am

But not running os openbsd or freebsd

Post by **caesar** » Wed Mar 25, 2020 3:18 am

Use the code I posted.

abah · Post by **abah** » Wed Mar 25, 2020 4:12 am

where code u posted please show me

abah · Post by **abah** » Wed Mar 25, 2020 4:36 am

if the script is correct, it will definitely work and will show as shown