Code: Select all
# Author: tomekk
# e-mail: tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.3.1
#
# 16.07.09 - changed parsing code and added country and city to quote info.
#
# New html tag by username@forum.egghelp.org
# Wordwrap proc from this post by user http://forum.egghelp.org/viewtopic.php?p=81741#81741
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html
# channels for !fmylife
set fmylife_channels {#egghelp #erotic}
# time between use !fmylife (seconds)
set fmylife_reuse_time 20
# auto query
# 0 - off, 1 - on
set fmylife_auto_query 0
# set auto query interval (minutes)
set fmylife_auto_interval 10
###########################################################
bind pub - !fmylife fm_main_proc
package require http
proc get_fmylife { } {
set f_http_uagent "Opera/9.61 (Windows i686; U; en) Presto/2.1.1"
set f_http_token [http::config -useragent $f_http_uagent]
if {[catch {set f_http_token [::http::geturl "http://www.fmylife.com/random" -timeout 15000]}]} {
return "error"
} {
return [http::data $f_http_token]
}
}
set fmylife_reuse 1
proc fmylife_timer { } {
global fmylife_auto_interval
fm_auto_proc
if {[string match *fmylife_timer* [timers]] != 1} {
timer $fmylife_auto_interval fmylife_timer
}
}
proc fm_auto_proc { } {
global fmylife_channels
set fm_quote ""
set fm_quote [get_fmylife]
if {($fm_quote == "error") || ($fm_quote == "")} {
putlog "auto-quote-fmylife: problem with connection"
return
}
foreach fm_each_chan [split $fmylife_channels] {
if {$fm_each_chan != ""} {
set fm_each_chan [string trim $fm_each_chan]
if {[botonchan $fm_each_chan]} {
fmylife_print $fm_quote $fm_each_chan
}
}
}
}
proc fm_main_proc { nick uhost hand chan arg } {
global fmylife_channels fmylife_reuse fmylife_reuse_time
if {[expr [clock seconds] - $fmylife_reuse] <= $fmylife_reuse_time} {
putquick "PRIVMSG $chan :$nick: to fast, sorry"
return
}
if {[lsearch $fmylife_channels $chan] == -1} {
return
}
set fm_quote ""
set fm_quote [get_fmylife]
if {($fm_quote == "error") || ($fm_quote == "")} {
putquick "PRIVMSG $chan :problem with connection, try again later, sorry"
return
}
fmylife_print $fm_quote $chan
}
proc fmylife_print { fm_data fm_chan } {
global fmylife_reuse
set fm_link ""
regsub -all -nocase "\n" $fm_data "" fm_data
regsub -all -nocase "\r" $fm_data "" fm_data
regsub -all -nocase "\t" $fm_data "" fm_data
# 1st quote
regsub -nocase {.*<div\s+class=\"clear\"><\/div><\/div>(.+)<div\s+class=\"more\">.*} $fm_data {\1} fm_data
# 1st link
regsub -nocase {.*<a\s+href=\"([a-z0-9\/ ]+)\"\s+class="fmllink">.*} $fm_data {\1} fm_link
# del rest of links from quote
regsub -all -nocase {<a\s+href=\"[a-z0-9\/ ]+\"\s+class=\"fmllink\">} $fm_data "" fm_data
# voting result
regsub -nocase {.*sucks<\/a>\s+(.+)<\/span>\s+-.*} $fm_data {\1} fm_fckd
regsub -nocase {.*it<\/a>\s+(.+)<\/span>.*} $fm_data {\1} fm_dsrv
# date and name
regsub -nocase {.*<p\s+style=\"margin-top\:2px\;\">(.+)\s+-\s+<a\s+class=\"liencat\".*} $fm_data {\1} fm_date
regsub -nocase {.*<a\s+class=\"liencat\"\s+href="/[a-z0-9\/ ]+\">[a-z0-9\/ ]+<\/a>\s+-\s+by\s+(.*?)\s+-\s+<a\s+href=\"\/country\/.*} $fm_data {\1} fm_name
regsub -all -nocase {<a href="/gender/woman" class="light">} $fm_name "" fm_name
regsub -all -nocase {<a href="/gender/man" class="light">} $fm_name "" fm_name
regsub -all -nocase {</a>} $fm_name "" fm_name
# country and city
regsub -nocase {.*<a\s+href=\"\/country\/(.*?)\"\s+class=\"liencat\">.*} $fm_data {\1} fm_coun
regsub -nocase {.*<a\s+href=\"\/region\/(.*?)"\s+class=\"light\">.*} $fm_data {\1} fm_city
# fml text
regsub -nocase {.*<div\s+class=\"post\"><p>(.*?)<div\s+class=\"date\">.*} $fm_data {\1} fm_data
# the rest of useless tags
regsub -all -nocase "<\/a>" $fm_data "" fm_data
regsub -all -nocase "<\/p>" $fm_data "" fm_data
regsub -all -nocase "<\/div>" $fm_data "" fm_data
regsub -all -nocase ""e;" $fm_data "\"" fm_data
regsub -all -nocase "<div.*>" $fm_data "\"" fm_data
regsub -all -nocase """ $fm_data "\"" fm_data
set fm_link "http://www.fmylife.com$fm_link"
if {[regexp -nocase {http:\/\/www\.fmylife\.com[a-z0-9\/ ]+} $fm_link]} {
fm_msg $fm_chan \00310$fm_data
putquick "PRIVMSG $fm_chan :\00314I agree, your life sucks \00303$fm_fckd \00314- you totally deserved it \00303$fm_dsrv\00314. Added \00303$fm_date \00314by \00303$fm_name\00314, \00303$fm_coun \00314(\00303$fm_city\00314)."
putquick "PRIVMSG $fm_chan :\00304--| \00312\037$fm_link\037\003"
set fmylife_reuse [clock seconds]
} {
putquick "PRIVMSG $fm_chan :some problem with data, try again later, sorry"
}
}
if {$fmylife_auto_query != 0} {
if {[string match *fmylife_timer* [timers]] != 1} {
timer $fmylife_auto_interval fmylife_timer
}
}
proc fm_msg {dest data} {
set len [expr {512-[string len ":$::botname PRIVMSG $dest :\r\n"]}]
foreach line [fm_wordwrap $data $len] {
puthelp "PRIVMSG $dest :$line"
}
}
proc fm_wordwrap {data len} {
set out {}
foreach line [split [string trim $data] \n] {
set curr {}
set i 0
foreach word [split [string trim $line]] {
if {[incr i [string len $word]]>$len} {
lappend out [join $curr]
set curr [list $word]
set i [string len $word]
} {
lappend curr $word
}
incr i
}
if {[llength $curr]} {
lappend out [join $curr]
}
}
set out
}
putlog "fmylife-quote.tcl ver 0.3.1 by tomekk and username loaded"
Code: Select all
# Author: tomekk
# e-mail: tomekk/@/oswiecim/./eu/./org
# home page: http://tomekk.oswiecim.eu.org/
#
# Version 0.3.1
#
# 16.07.09 - changed parsing code and added country and city to quote info.
#
# New html tag by username@forum.egghelp.org
# Wordwrap proc from this post by user http://forum.egghelp.org/viewtopic.php?p=81741#81741
#
# This file is Copyrighted under the GNU Public License.
# http://www.gnu.org/copyleft/gpl.html
# channels for !fmylife
set fmylife_channels {#egghelp #erotic}
# time between use !fmylife (seconds)
set fmylife_reuse_time 20
# auto query
# 0 - off, 1 - on
set fmylife_auto_query 0
# set auto query interval (minutes)
set fmylife_auto_interval 10
###########################################################
bind pub - !fmylife fm_main_proc
package require http
proc get_fmylife { } {
set f_http_uagent "Opera/9.61 (Windows i686; U; en) Presto/2.1.1"
set f_http_token [http::config -useragent $f_http_uagent]
if {[catch {set f_http_token [::http::geturl "http://www.fmylife.com/random" -timeout 15000]}]} {
return "error"
} {
return [http::data $f_http_token]
}
}
set fmylife_reuse 1
proc fmylife_timer { } {
global fmylife_auto_interval
fm_auto_proc
if {[string match *fmylife_timer* [timers]] != 1} {
timer $fmylife_auto_interval fmylife_timer
}
}
proc fm_auto_proc { } {
global fmylife_channels
set fm_quote ""
set fm_quote [get_fmylife]
if {($fm_quote == "error") || ($fm_quote == "")} {
putlog "auto-quote-fmylife: problem with connection"
return
}
foreach fm_each_chan [split $fmylife_channels] {
if {$fm_each_chan != ""} {
set fm_each_chan [string trim $fm_each_chan]
if {[botonchan $fm_each_chan]} {
fmylife_print $fm_quote $fm_each_chan
}
}
}
}
proc fm_main_proc { nick uhost hand chan arg } {
global fmylife_channels fmylife_reuse fmylife_reuse_time
if {[expr [clock seconds] - $fmylife_reuse] <= $fmylife_reuse_time} {
putquick "PRIVMSG $chan :$nick: to fast, sorry"
return
}
if {[lsearch $fmylife_channels $chan] == -1} {
return
}
set fm_quote ""
set fm_quote [get_fmylife]
if {($fm_quote == "error") || ($fm_quote == "")} {
putquick "PRIVMSG $chan :problem with connection, try again later, sorry"
return
}
fmylife_print $fm_quote $chan
}
proc fmylife_print { fm_data fm_chan } {
global fmylife_reuse
set fm_link ""
regsub -all -nocase "\n" $fm_data "" fm_data
regsub -all -nocase "\r" $fm_data "" fm_data
regsub -all -nocase "\t" $fm_data "" fm_data
# 1st quote
regsub -nocase {.*<div\s+class=\"clear\"><\/div><\/div>(.+)<div\s+class=\"more\">.*} $fm_data {\1} fm_data
# 1st link
regsub -nocase {.*<a\s+href=\"([a-z0-9\/ ]+)\"\s+class="fmllink">.*} $fm_data {\1} fm_link
# del rest of links from quote
regsub -all -nocase {<a\s+href=\"[a-z0-9\/ ]+\"\s+class=\"fmllink\">} $fm_data "" fm_data
# voting result
regsub -nocase {.*sucks<\/a>\s+(.+)<\/span>\s+-.*} $fm_data {\1} fm_fckd
regsub -nocase {.*it<\/a>\s+(.+)<\/span>.*} $fm_data {\1} fm_dsrv
# date and name
regsub -nocase {.*<p\s+style=\"margin-top\:2px\;\">(.+)\s+-\s+<a\s+class=\"liencat\".*} $fm_data {\1} fm_date
regsub -nocase {.*<a\s+class=\"liencat\"\s+href="/[a-z0-9\/ ]+\">[a-z0-9\/ ]+<\/a>\s+-\s+by\s+(.*?)\s+-\s+<a\s+href=\"\/country\/.*} $fm_data {\1} fm_name
regsub -all -nocase {<a href="/gender/woman" class="light">} $fm_name "" fm_name
regsub -all -nocase {<a href="/gender/man" class="light">} $fm_name "" fm_name
regsub -all -nocase {</a>} $fm_name "" fm_name
# country and city
regsub -nocase {.*<a\s+href=\"\/country\/(.*?)\"\s+class=\"liencat\">.*} $fm_data {\1} fm_coun
regsub -nocase {.*<a\s+href=\"\/region\/(.*?)"\s+class=\"light\">.*} $fm_data {\1} fm_city
# fml text
regsub -nocase {.*<div\s+class=\"post\"><p>(.*?)<div\s+class=\"date\">.*} $fm_data {\1} fm_data
# the rest of useless tags
regsub -all -nocase "<\/a>" $fm_data "" fm_data
regsub -all -nocase "<\/p>" $fm_data "" fm_data
regsub -all -nocase "<\/div>" $fm_data "" fm_data
regsub -all -nocase ""e;" $fm_data "\"" fm_data
regsub -all -nocase "<div.*>" $fm_data "\"" fm_data
regsub -all -nocase """ $fm_data "\"" fm_data
set fm_link "http://www.fmylife.com$fm_link"
if {[regexp -nocase {http:\/\/www\.fmylife\.com[a-z0-9\/ ]+} $fm_link]} {
fm_msg $fm_chan $fm_data
putquick "PRIVMSG $fm_chan :I agree, your life sucks $fm_fckd - you totally deserved it $fm_dsrv. Added $fm_date by $fm_name, $fm_coun ($fm_city)."
#putquick "PRIVMSG $fm_chan :--| $fm_link"
set fmylife_reuse [clock seconds]
} {
putquick "PRIVMSG $fm_chan :some problem with data, try again later, sorry"
}
}
if {$fmylife_auto_query != 0} {
if {[string match *fmylife_timer* [timers]] != 1} {
timer $fmylife_auto_interval fmylife_timer
}
}
proc fm_msg {dest data} {
set len [expr {512-[string len ":$::botname PRIVMSG $dest :\r\n"]}]
foreach line [fm_wordwrap $data $len] {
puthelp "PRIVMSG $dest :$line"
}
}
proc fm_wordwrap {data len} {
set out {}
foreach line [split [string trim $data] \n] {
set curr {}
set i 0
foreach word [split [string trim $line]] {
if {[incr i [string len $word]]>$len} {
lappend out [join $curr]
set curr [list $word]
set i [string len $word]
} {
lappend curr $word
}
incr i
}
if {[llength $curr]} {
lappend out [join $curr]
}
}
set out
}
putlog "fmylife-quote.tcl ver 0.3.1 by tomekk and username loaded"
Code: Select all
# 1st quote
regsub -nocase {.*<div\s+class=\"clear\"><\/div><\/div>(.+)<div\s+class=\"more\">.*} $fm_data {\1} fm_data
Code: Select all
<div\s+class=\"more\">.*
Code: Select all
<div\s+class=\"more\".*
Code: Select all
#putquick "PRIVMSG $fm_chan :I agree, your life sucks $fm_fckd - you totally deserved it $fm_dsrv. Added $fm_date by $fm_name, $fm_coun ($fm_city)."
#putquick "PRIVMSG $fm_chan :--| $fm_link"