egghelp.org community :: View topic

[ egghelp.org home | forum home ]

egghelp.org community
Discussion of eggdrop bots, shell accounts and tcl scripts.

FAQ

Memberlist

Usergroups

Profile

Ansa.tcl

egghelp.org community Forum Index -> Script Requests

View previous topic :: View next topic

Author

Message

Kaa
Voice

Joined: 31 Oct 2007
Posts: 10
Location: Italy

Posted: Fri Mar 01, 2013 7:14 am Post subject: Ansa.tcl

Code:

### GLOBALS ###
set ansa(version) "3.1"
set ansa(url) "http://www.ansa.it/main/notizie/awnplus/^RUBRICA/synd/ansait_awnplus_^RUBRICA_medsynd_Today_Idx.xml"
set ansa(timeout) 5000
### Percorso di salvataggio dei Database delle news (la directory deve esistere)
set ansa(filepath) "ansa-tmp"

proc ansa:send { str } {
set str "$str\n"
putdccraw 0 [string length $str] $str
}

proc get:rubriche { {char ""} } {
set rubriche { topnews italia mondo calcio sport spettacolo economia cultura scienza internet moda musica cinema }
if { $char != ""} {
   return [ join $rubriche $char ]
} else {
   return $rubriche
}
}
### END GLOBALS ###

### FLAGS ###
setudef flag ansa
foreach rubrica [get:rubriche] {
setudef flag ansa_$rubrica
}
### END FLAGS ###

### BINDS ###
bind time - "00 * * * *" ansa:check
bind time - "15 * * * *" ansa:check
bind time - "30 * * * *" ansa:check
bind time - "45 * * * *" ansa:check
bind pub - !ansa ansa:request
### END BINDS ###

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

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 ansa:mkdir { path } {
set dir ""
foreach folder [ split ${path} "/" ] {
   set dir "${dir}${folder}/"
   if { ! [ file exists ${dir} ] } {
      file mkdir ${dir}
   }
}
}

proc max:privmsg:chars target {
global botname
#:nick!user@host PRIVMSG target :
return [ expr 510 - 1 - [ string length $botname ] - 30 - [ string length $target ] - 2 ]
}

proc ansa:request { nick uhost hand chan arg } {
global ansa
if { [ lsearch [ channel info $chan ] "+ansa" ] == -1 } { return }
putlog "ANSA :: request \"!ansa $arg\" from $nick!$uhost on $chan"

### HELP ###
if { $arg == "" || $arg == "help" } {
   set rubriche [ get:rubriche ", " ]
   ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037HELP\037 - Lo script visualizza le notizie ANSA in canale.\
   Si possono vedere le ultime notizie con \002!ansa list\002 e richiamare la singola notizia con \002!ansa numero\002.\
   Gli operatori del canale possono aggiungere una rubrica con \002!ansa add rubrica\002 o rimuoverla con\
   \002!ansa del rubrica\002."
   ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037HELP\037 - Per avere una lista delle rubriche attualmente seguite\
   \002!ansa info\002. Le rubriche disponibili sono: $rubriche."
   return
}
### END HELP ###

set max_chars [ max:privmsg:chars $chan ]
set argom [ lindex $arg 0 ]
set rubrica [ lindex $arg 1 ]
set rubriche [ ansa:rub $chan ]

### CONTROLLO ARGOMENTI ###
switch -- $argom {
   info {
      if { [ llength $rubriche ] == 0 } { lappend rubriche "nessuna" }
      ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037INFO\037 - Le rubriche ANSA seguite\
      da \002$chan\002 sono: $rubriche"
   }
   add {
      if { ! [ isop $nick $chan ] } {
         ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Devi essere operatore in $chan per aggiungere una rubrica."
         return
      }
      if { [ lsearch -exact [ get:rubriche ] $rubrica ] > -1 } {
         if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
            ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Il canale \002$chan\002 segue già la rubrica\
            \002$rubrica\002. Se si desidera rimuoverla \002!ansa rem $rubrica\002. Per una lista \002!ansa info\002"
         } else {
            # AGGIORNAMENTO RUBRICA
            ansa:update new $rubrica
            channel set $chan +ansa_${rubrica}
            ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037ADD\037 - Ho aggiunto \002$rubrica\002.\
            Ora le rubriche ANSA seguite da \002$chan\002 sono: [ ansa:rub $chan ]."
         }
      } else {
   set rubr [ get:rubriche ", " ]
         ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - \002$rubrica\002 è una rubrica non valida.\
         Devi scegliere tra: $rubr."
      }
   }
   del {
      if { ! [ isop $nick $chan ] } {
         ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Devi essere operatore in $chan per rimuovere una rubrica."
         return
      }
      if { [ lsearch -exact [ get:rubriche ] $rubrica ] > -1 } {
         if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
            channel set $chan -ansa_${rubrica}
            set temp [ lsearch -exact $rubriche $rubrica ]
            set rubriche [ ansa:rub $chan ]
            if { [ llength $rubriche ] == 0 } { set rubriche "nessuna" }
            ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037DEL\037 - Ho rimosso \002$rubrica\002.\
            Ora le rubriche ANSA seguite da \002$chan\002 sono: $rubriche"
         } else {
            ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Il canale \002$chan\002 non segue la rubrica\
            \002$rubrica\002. Se si desidera inserirla \002!ansa add $rubrica\002. Per una lista \002!ansa info\002"
         }
      } else {
   set rubr [ get:rubriche ", " ]
         ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - \002$rubrica\002 è una rubrica non valida.\
         Devi scegliere tra: $rubr."
      }
   }
   list {
      if { $rubrica == "" } {
         ansa:send "PRIVMSG $nick :\037ANSA\037 \002::\002 \037ERROR\037 - Per avere la lista delle news devi specificare la rubrica con\
         \002!ansa list rubrica\002. Le rubriche seguite da $chan sono: [ ansa:rub $chan ]."
      } else {
         set num 1
         set risposta ""
         set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
         if { [ lsearch -exact $rubriche $rubrica ] > -1 } {
            while { [ gets $ansafile linedb ] > -1 } {
               if { [ regexp -all -- {(.+)\t(.+)\t.+_(\d+).html} $linedb all title description refer ] } {
                  set risposta "$risposta - $title (\037$refer\037)"
                  if { $num > 4 } { break }
                  incr num
               }
            }
            if { $risposta != "" } { ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \[\037$rubrica\037\]$risposta" }
         }
         close $ansafile
      }
   }
   url {
      set id [ lindex $arg 1 ]
      if { [ regexp -- {\d+} $id ] } {
         set url ""
         set found 0
         foreach rubrica [ get:rubriche ] {
            set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
            while { [ gets $ansafile linedb ] > -1 && $found != 1 } {
               if { [ regexp -all -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
                  if { [ string match -nocase *_$id.html $link ] } {
         set url $link
                     ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \[\037$rubrica\037\] \002::\002 $url"
                     set found 1
                  }
               }
            }
            close $ansafile
         }
      }
   }
}

if { [ regexp -- {\d+} $argom ] } {
   set url ""
   set found 0
   foreach rubrica [ get:rubriche ] {
      set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
      while { [ gets $ansafile linedb ] > -1 && $found != 1 } {
         if { [ regexp -all -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
            if { [ string match -nocase *_$argom.html $link ] } {
         set url $link
               ### STAMPA NOTIZIA
               set http [ ::http::geturl $url ]
               set html [ ::http::data $http ]
               ::http::cleanup $http
               if { [ regexp -all -- {<div[^>]* id\=\"content-corpo\"[^>]*>(.+?)</div><!\-\-\s/\#corpo\s\-\->} $html all risposta ] } {
                  regsub -all -- {\n} $risposta " " risposta
                  regsub -all -- {\s+} $risposta " " risposta
                  regsub -all -- {\/} $risposta "/" risposta
                  regsub -all -- {\&#\d+;} $risposta "" risposta
                  regsub -all -- {</?[^>]+>} $risposta "" risposta
                  regsub -- {^\s*$ANSA$\s*-?\s*} $risposta "" risposta
                  regsub -- {\s*$ANSA$.*$} $risposta "" risposta
                  regsub -all -- {\s\s+} $risposta " " risposta
                  set risposta "\037ANSA\037 \002::\002 \[\037$rubrica\037\] (\002$argom\002) [ string trim $risposta ]"
                  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 } {
                        ansa:send "PRIVMSG $chan :$risptemp ..."
                     } else {
                        ansa:send "PRIVMSG $chan :$risptemp"
                     }
                  }
                  unset risposta
               }
               set found 1
            }
         }
      }
      close $ansafile
   }
   if { $found != 1 } {
      ansa:send "PRIVMSG $chan :\037ANSA\037 \002::\002 \037ERRORE\037 - Notizia non trovata !"
   }
}
}

proc ansa:rub chan {
set rubriche {}
if { [ validchan $chan ] } {
   foreach rubrica [ get:rubriche ] {
      if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } { lappend rubriche $rubrica }
   }
} else {
   foreach chan [ channels ] {
      foreach rubrica [ get:rubriche ] {
         if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } {
            if { [ lsearch -exact $rubriche $rubrica ] == -1 } { lappend rubriche $rubrica }
         }
      }
   }
}
return $rubriche
}

proc ansa:update { tipo rubrica } {
global ansa
set ansafile [ open "$ansa(filepath)/$rubrica.news" r ]
set ansafilet [ open "$ansa(filepath)/$rubrica.tmp" a ]
while { [ gets $ansafile linedb ] > -1 } {
   if { [ regexp -nocase -- {(.+)\t(.*)\t(.+)} $linedb all title description link ] } {
      if { [ regexp -all -- {.+_(\d+).html} $link all refer ] } {
         lappend riferimenti $refer
      }
   }
}
close $ansafile
set risposta ""

regsub -all -- {\^RUBRICA} $ansa(url) "$rubrica" url
set http [ http::geturl $url ]
set html [ http::data $http ]
::http::cleanup $http
regsub -all -- {\n} $html "" html
regsub -all -- {<item>} $html "\n<item>" html

### Lettura del Feed RSS
foreach line [ split $html "\n" ] {
   if { [ regexp -nocase -- {<item><title><!\[CDATA\[(.+)\]\]></title><description><!\[CDATA\[(.*)\]\]></description><link>(.+)</link>.*</item>} $line all title description link ] } {
      if { [ regexp -all -- {.+_(\d+).html} $link all refer ] } {
         if { [ info exists riferimenti ] && [ lsearch -exact $riferimenti $refer ] == -1 } {
            regsub -all -- {\/} $title "/" title
            regsub -all -- {\"} $title "'" title
            set risposta "$risposta $title (\037$refer\037)"
         }
         puts $ansafilet "$title\t$description\t$link"
      }
   }
}
close $ansafilet

if { $risposta != "" && $tipo == "new" } {
   set risposta "\037ANSA\037 \002::\002 \[\037$rubrica\037\]$risposta"
   foreach chan [ channels ] {
      set max_chars [ max:privmsg:chars $chan ]
      if { [ lsearch -exact [ channel info $chan ] "+ansa_$rubrica" ] > -1 } {
         if { [ string length $risposta ] > $max_chars } {
            set risptemp [ string range $risposta 0 [ expr $max_chars - 8 ] ]
            ansa:send "privmsg $chan :$risptemp\017..."
            set risptemp [ string range $risposta [ expr $max_chars - 7 ] end ]
            ansa:send "privmsg $chan :\017...$risptemp"
         } else {
            ansa:send "privmsg $chan :$risposta"
         }
      }
   }
}

if { [ file exists "$ansa(filepath)/$rubrica.tmp" ] } {
   file rename -force -- "$ansa(filepath)/$rubrica.tmp" "$ansa(filepath)/$rubrica.news"
}
}

proc ansa:check { min ora giorno mese anno } {
set rubriche [ get:rubriche ]
if { [ llength $rubriche ] > 0 } {
   if { $anno == 0 } {
      foreach rubrica $rubriche { ansa:update init $rubrica }
      putlog "\037ANSA\037 \002::\002 \037NEWS\037 - News aggiornate"
   } else {
      foreach rubrica $rubriche { ansa:update new $rubrica }
   }
   if { [ file exists "$::ansa(filepath)/$rubrica.tmp" ] } {
      file rename -force -- "$::ansa(filepath)/$rubrica.tmp" "$::ansa(filepath)/$rubrica.news"
   }
}
}

### END PROCS ###

### CREAZIONE DELLA DIRECTORY DI SALVATAGGIO DEI FILE ###
ansa:mkdir $ansa(filepath)

### PULIZIA FILE TEMPORANEI ###
foreach rubrica [ get:rubriche ] {
if { [ file exists "$ansa(filepath)/$rubrica.tmp" ] } {
   file rename -force -- "$ansa(filepath)/$rubrica.tmp" "$ansa(filepath)/$rubrica.news"
}
if { ![ file exists "$ansa(filepath)/$rubrica.news" ] } {
   set ansafile [ open "$ansa(filepath)/$rubrica.news" w ]
   close $ansafile
}
}

after 1500 ansa:check 0 0 0 0 0

I have this error in partyline: Tcl error [ansa:request]: putdccraw is deprecated. Please use putdcc/putnow instead.

Can you help me to resolve it? Thanks.

caesar
Mint Rubber

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

Posted: Fri Mar 01, 2013 9:13 am Post subject:

The error is self explanatory. How hard it to change an word on your own? Hint:

Code:

putdccraw 0 [string length $str] $str

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

Kaa
Voice

Joined: 31 Oct 2007
Posts: 10
Location: Italy

Posted: Fri Mar 01, 2013 9:52 am Post subject:

caesar wrote:

The error is self explanatory. How hard it to change an word on your own? Hint:

Code:

putdccraw 0 [string length $str] $str

I changed before this post:

putdcc 0 [string length $str] $str
putnow 0 [string length $str] $str

but alway error...

caesar
Mint Rubber

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

Posted: Fri Mar 01, 2013 12:16 pm Post subject:

After doing this change, have you rehashed the bot? _________________ Once the game is over, the king and the pawn go back in the same box.

Kaa
Voice

Joined: 31 Oct 2007
Posts: 10
Location: Italy

Posted: Fri Mar 01, 2013 12:44 pm Post subject:

caesar wrote:

After doing this change, have you rehashed the bot?

putdcc -raw 0 [string length $str] $str

Error: Tcl error [ansa:request]: wrong # args: should be "putdcc idx text ?o ptions?"

putnow 0 [string length $str] $str

Error: Tcl error [ansa:request]: wrong # args: should be "putnow text ?options?"

I do not solve the problem. That's why I made this post.

SpiKe^^
Owner

Joined: 12 May 2006
Posts: 792
Location: Tennessee, USA

Posted: Fri Mar 01, 2013 1:25 pm Post subject:

Try this forum string and see if that helps... http://forum.egghelp.org/viewtopic.php?p=94646 _________________ SpiKe^^ Get BogusTrivia 2.06.4.7 at www.mytclscripts.com or visit the New Tcl Acrhive at www.tclarchive.org .

Display posts from previous:

	egghelp.org community Forum Index -> Script Requests	All times are GMT - 4 Hours
Page 1 of 1

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