This is the new home of the egghelp.org community forum.
All data has been migrated (including user logins/passwords) to a new phpBB version.


For more information, see this announcement post. Click the X in the top right-corner of this box to dismiss this message.

problem tcl horoscope

Requests for complete scripts or modifications/fixes for scripts you didn't write. Response not guaranteed, and no thread bumping!
Post Reply
K
Kaa
Voice
Posts: 10
Joined: Wed Oct 31, 2007 8:02 am
Location: Italy

problem tcl horoscope

Post by Kaa »

The author is gone and doesn't respond to emails.

Code: Select all

### GLOBALS ###
set oroscopo(version) 1.5

package require http
http::config -useragent "Mozilla/1.0"
### END GLOBALS ###

### FLAGS ###
setudef flag oroscopo
### END FLAGS###

### BINDS ###
bind pub - !oroscopo oroscopo:request
bind msgm - * oroscopo:pvt:request
### END BINDS ###

### PROCS ###
proc strlastpos { string char {max 0} } {
        if { $max == 0} { set max [ string length $string ] }
        if { [ string length $string ] <= $max } { return [ string length $string ] }
        for { set i 0 } { $i < $max } { incr i } {
                if { [ string index $string [ expr $max - $i ] ] == $char } {
                        return [ expr $max - $i ]
                }
        }
        return $max
}

proc max:privmsg:chars { target } {
        return [ expr 500 - 1 - [ string length $::nick ] - 30 - [ string length $target ] - 2 ]
}

proc oroscopo:pvt:request { nick uhost hand arg } {
        set arg [ lindex $arg 0 ]
        if { [ lsearch -exact {ariete toro gemelli cancro leone vergine bilancia scorpione sagittario capricorno acquario pesci} [ string tolower $arg ] ] == -1 } { return }
        regsub -all -- " " $arg "%20" args
        set url "http://it.horoscopofree.com/rss/horoscopofree-it.rss"
        set http [ http::geturl $url ]
        set html [ http::data $http ]
        set flag 0
        if { [ regexp -nocase -all -- "<item>\[^<\]*<title>($arg)</title>\[^<\]*<link>\[^<\]*</link>\[^<\]*<guid \[^<\]*</guid>\[^<\]*<description><!\[^a-z\]CDATA\[^a-z\](\[^<\]*?)" $html all segno testo ] } {
                set testosegno [lindex $testo [lsearch -exact $segno $args]]
                set risposta "\037OROSCOPO\037 \002::\002 \037[ string toupper $args ]\037 $testo"
                set flag 1
        }
        if { $flag == 0 } {
                putserv "PRIVMSG $nick :\037OROSCOPO\037 \002::\002 \037[strupr $arg]\037 Segno zodiacale non trovato"
        } else {
                set max_chars [ max:privmsg:chars $nick ]
                while { [ string length $risposta ] > 0 } {
                        set limit [ strlastpos $risposta " " $max_chars ]
                        set risptemp [ string range $risposta 0 $limit ]
                        set risposta [ string range $risposta $limit end ]
                        if { [ string length $risposta ] != 0 } {
                                putserv "PRIVMSG $nick :$risptemp ..."
                        } else {
                                putserv "PRIVMSG $nick :$risptemp"
                        }
                }
        }
}

proc oroscopo:request { nick uhost hand chan arg } {
        if { [ lsearch -exact [ channel info $chan ] "+oroscopo" ] == -1 } { return }
        putlog "OROSCOPO :: request \"!oroscopo $arg\" from $nick!$uhost on $chan"
        if { $arg == "" || $arg == "help" } {
                 putserv "NOTICE $nick :\037OROSCOPO\037 \002::\002 \037HELP\037 Mostra l'oroscopo per un dato segno zodiacale\037Utilizzo:\037 !oroscopo segno"
                 return
        }
        regsub -all -- " " $arg "%20" args
        set url "http://it.horoscopofree.com/rss/horoscopofree-it.rss"
        set http [ http::geturl $url ]
        set html [ http::data $http ]
        set flag 0
        if { [ regexp -nocase -all -- "<item>\[^<\]*<title>($arg)</title>\[^<\]*<link>\[^<\]*</link>\[^<\]*<guid \[^<\]*</guid>\[^<\]*<description><!\[^a-z\]CDATA\[^a-z\](\[^<\]*?)" $html all segno testo ] } {
                set testosegno [lindex $testo [lsearch -exact $segno $args]]
                set risposta "\037OROSCOPO\037 \002::\002 \037[ string toupper $args ]\037 $testo"
                set flag 1
        }
        if { $flag == 0 } {
                putserv "PRIVMSG $chan :\037OROSCOPO\037 \002::\002 \037[strupr $arg]\037 Segno zodiacale non trovato"
        } else {
                set max_chars [ max:privmsg:chars $chan ]
                while { [ string length $risposta ] > 0 } {
                        set limit [ strlastpos $risposta " " $max_chars ]
                        set risptemp [ string range $risposta 0 $limit ]
                        set risposta [ string range $risposta $limit end ]
                        if { [ string length $risposta ] != 0 } {
                                putserv "PRIVMSG $chan :$risptemp ..."
                        } else {
                                putserv "PRIVMSG $chan :$risptemp"
                        }
                }
        }
}
### END PROCS ###
The problem is that the tcl show bad hyphenated words. Can you help me? I don't know where to fix. please. Thank you.
Post Reply