# IRCPics Client 0.1b for eggdrop, author marzo at kaatajat.net
# freely distributable under GPLv2
#
# This is beta version. It's not fully tested and there's no support
# for channel filttering. 
#
# Usage:
# Add "/load ircpics.tcl" in your eggdrop.conf and restart eggdrop
# or
# Log in command console and load script with command ".tcl source ircpics.tcl"
#
# Modify bind pub - !u sendurl for you needs. 
# Sending !u <url> on public channel causes eggdrop to send url to ircpics.com
#
# Version history:
# 2007/11/17 0.1b - Initial Version.
# 2007/11/18 0.2a - Added support for all public messages and topics. 
#
#
package require Tcl 8.2
package require http 2.2

#
# globals
#
set ircpics_add "http://ircpics.com/add.php"

#
# bindings
#

# Public channel command to register urls. Default is !u <url>
set global_chan_command "!u"
bind pub - $global_chan_command sendurl 

# Scan urls for every public message. Comment this line out to disable feature.
bind pubm - {*.*}  callWrapper

# Scan urls for channel topics. Comment this line out to disable feature.
bind topc - {*.*}  callWrapper


#
# methods
#

proc callWrapper {nick uhost hand chan text} {
	global global_chan_command
	if {[string match "^$global_chan_command*" $text]} {
		putlog "ignored"
		return
	}
		
	if {(([string match "*http://*" $text] == 1) || ([string match "*https://*" $text] == 1) || ([string match "*www.*" $text] == 1))} {
		sendurl $nick $uhost $hand $chan $text
  	}
}

proc sendurl {nick uhost hand chan url} {
        global ircpics_add

        set status false
        if [regexp {((http|https):\/\/[a-zA-Z0-9\|\[\]\/\\\:\?\%\.\,\&\;=#\-\_\!\+\~]*)} $url] {
                set status true
        } elseif [regexp {(www\.[a-zA-Z0-9\/\\\:\?\%\.\,\&\;=#\-\_\!\+\~]*)} $url] {
                set status true
                set url "http://$url"
        }

        if ($status) {
                set data [list url $url \
                                  channel $chan \
                                  nick $nick]
                set param [eval ::http::formatQuery $data]
                putlog "$nick@$chan - sending url: $url"
		set call [http::geturl $ircpics_add -query $param -timeout 36000]
                ::http::cleanup $call
        }
}