Posted to tcl by kostix at Sun Nov 18 22:41:26 GMT 2007view pretty

#!/usr/bin/env tclsh

set use_external_tclxml on
package require -exact jabberlib 0.10.1

array set opts {
	-from     kostix@007spb.ru/Autobot
	-password жопасручкой
	-to       {kostix@007spb.ru/Home brennon1303@jabber.ru}
	-type     chat
	-subject  Test
	-body     Yo!
	-host     jabber.007spb.ru
	-tls      true
	-verbose  true
	-debug    true
}

if {![info exists opts(-debug)] || !$opts(-debug)} {
	proc ::LOG args {}
}

proc client:errmsg err {
	return -code error $err
}

proc client:status status {
	upvar #0 opts(-verbose) vb
	if {[info exists vb] && $vb} {
		puts $status
	}
}

proc on_login {result args} { set ::logged_in [list $result $args] }

regexp {^(?:([^@]*)@)?([^/]*)(?:/(.*))?$} $opts(-from) -> user server resource

set cmd [list jlib::new]
foreach var {user server resource} {
	if {[info exists $var]} {
		lappend cmd -$var [set $var]
	}
}
set connid [eval $cmd]

if {[info exists opts(-tls)] && $opts(-tls)} {
	package require tls
	set transport tls
	if {![info exists opts(-port)]} {
		set opts(-port) 5223
	}
} else {
	set transport tcp
	if {![info exists opts(-port)]} {
		set opts(-port) 5222
	}
}

jlib::connect $connid \
	-transport $transport \
	-host [idna::domain_toascii $opts(-host)] \
	-port $opts(-port) \
	-password $opts(-password)

client:status Connected
    
jlib::login $connid ::on_login

client:status "Logging in..."

vwait ::logged_in

client:status "Logged in"
    
if {![string eq [lindex $::logged_in 0] OK]} {
	puts stderr [lindex $::logged_in 1]
	exit 1
}

foreach jid [split [regsub -all {\s+} $opts(-to) " "]] {
	if {$jid == ""} {
		puts stderr "No jids to send message to"
		exit 2
	}
	client:status "Sending msg to $jid..."
	set cmd [list jlib::send_msg $jid -connection $connid]
	foreach var {type subject body} {
		if {[info exists opts(-$var)]} {
			lappend cmd -$var [set opts(-$var)]
		}
	}
	set res [eval $cmd]
	if {$res == -1} {
		puts stderr "Failed sending message to $jid, bailing out..."
		exit 3
	}
}

jlib::disconnect $connid
client:status Disconnected