egghelp.org community Forum Index
[ egghelp.org home | forum home ]
egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

kamus.tcl

 
Post new topic   Reply to topic    egghelp.org community Forum Index -> Scripting Help
View previous topic :: View next topic  
Author Message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Mon Mar 09, 2020 1:48 pm    Post subject: kamus.tcl Reply with quote

script kamus.tcl
Code:
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
Quote:
Tcl error [msg_bahasa]: invalid command name "::http::geturl"
can help me fix that script tq
Back to top
View user's profile Send private message
caesar
Mint Rubber


Joined: 14 Oct 2001
Posts: 3608
Location: Mint Factory

PostPosted: Tue Mar 10, 2020 7:26 am    Post subject: Reply with quote

At the top add:
Code:

package require http

_________________
Once the game is over, the king and the pawn go back in the same box.
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Fri Mar 20, 2020 8:56 am    Post subject: Reply with quote

can you teach how tcl can use the command +chanset
Back to top
View user's profile Send private message
willyw
Revered One


Joined: 15 Jan 2009
Posts: 1065

PostPosted: Fri Mar 20, 2020 9:00 am    Post subject: Reply with quote

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
_________________
For a fun (and popular) Trivia game, visit us at: irc.librairc.net #science-fiction . Over 300K Q & A to play in BogusTrivia !
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Fri Mar 20, 2020 9:34 am    Post subject: Reply with quote

Quote:
setudef flag bahasa

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


correct ?
Back to top
View user's profile Send private message
willyw
Revered One


Joined: 15 Jan 2009
Posts: 1065

PostPosted: Fri Mar 20, 2020 10:30 am    Post subject: Reply with quote

abah wrote:
Quote:
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.
_________________
For a fun (and popular) Trivia game, visit us at: irc.librairc.net #science-fiction . Over 300K Q & A to play in BogusTrivia !
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Sun Mar 22, 2020 8:33 am    Post subject: Reply with quote

Code:
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
Back to top
View user's profile Send private message
caesar
Mint Rubber


Joined: 14 Oct 2001
Posts: 3608
Location: Mint Factory

PostPosted: Sun Mar 22, 2020 10:53 am    Post subject: Reply with quote

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:

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:

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

returns 1 if the channel had +bahasa set.

Edit: Fixed the code.
_________________
Once the game is over, the king and the pawn go back in the same box.


Last edited by caesar on Wed Mar 25, 2020 1:56 am; edited 1 time in total
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Tue Mar 24, 2020 12:53 pm    Post subject: Reply with quote

Quote:
[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
Back to top
View user's profile Send private message
caesar
Mint Rubber


Joined: 14 Oct 2001
Posts: 3608
Location: Mint Factory

PostPosted: Wed Mar 25, 2020 1:55 am    Post subject: Reply with quote

That's most likely cos I forgot to add:
Code:

setudef flag bahasa

under the:
Code:

package require http

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

[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

_________________
Once the game is over, the king and the pawn go back in the same box.
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Wed Mar 25, 2020 2:21 am    Post subject: Reply with quote

But not running os openbsd or freebsd
Back to top
View user's profile Send private message
caesar
Mint Rubber


Joined: 14 Oct 2001
Posts: 3608
Location: Mint Factory

PostPosted: Wed Mar 25, 2020 3:18 am    Post subject: Reply with quote

Use the code I posted.
_________________
Once the game is over, the king and the pawn go back in the same box.
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Wed Mar 25, 2020 4:12 am    Post subject: Reply with quote

where code u posted please show me
Back to top
View user's profile Send private message
abah
Halfop


Joined: 01 Dec 2013
Posts: 58
Location: Indonesia

PostPosted: Wed Mar 25, 2020 4:36 am    Post subject: Reply with quote

if the script is correct, it will definitely work and will show as shown
[img]https://www.picpasteplus.com/v.php?i=17306f6049[/img]
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    egghelp.org community Forum Index -> Scripting Help All times are GMT - 4 Hours
Page 1 of 1

 
Jump to:  
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum


Forum hosting provided by Reverse.net

Powered by phpBB © 2001, 2005 phpBB Group
subGreen style by ktauber