[Tkabber-dev] r1748 - in trunk/tkabber-plugins: georoster receipts tclchat

tkabber-svn at jabber.ru tkabber-svn at jabber.ru
Fri Mar 27 19:11:00 MSK 2009


Author: sergei
Date: 2009-03-27 19:11:00 +0300 (Fri, 27 Mar 2009)
New Revision: 1748

Modified:
   trunk/tkabber-plugins/georoster/georoster.tcl
   trunk/tkabber-plugins/receipts/receipts.tcl
   trunk/tkabber-plugins/tclchat/tclchat.tcl
Log:
	* georoster/georoster.tcl: Use new proxied HTTP query for downloading
	  US locations data.

	* receipts/receipts.tcl: Made receipts plugin unloadable.

	* tclchat/tclchat.tcl: Use new proxied HTTP query for downloading
	  Tclers' chat history.


Modified: trunk/tkabber-plugins/georoster/georoster.tcl
===================================================================
--- trunk/tkabber-plugins/georoster/georoster.tcl	2009-03-27 16:08:04 UTC (rev 1747)
+++ trunk/tkabber-plugins/georoster/georoster.tcl	2009-03-27 16:11:00 UTC (rev 1748)
@@ -595,11 +595,12 @@
 		set query [eval ::http::formatQuery $args]
 
 		if {![catch {
-		    ::http::geturl \
-		      http://www.census.gov/cgi-bin/gazetteer?$query \
-		      -timeout 300 \
-		      -command [list [namespace current]::parse_vcard_aux $w \
-				     $xlib $jid [array get info]] }]} {
+		    ::proxy::http::geturl \
+			http://www.census.gov/cgi-bin/gazetteer?$query \
+			-timeout 300 \
+			-command [list [namespace current]::parse_vcard_aux $w \
+				       $xlib $jid [array get info]]
+		      }]} {
 		    debugmsg georoster "async http: $xlib $jid"
 		    return
 		}

Modified: trunk/tkabber-plugins/receipts/receipts.tcl
===================================================================
--- trunk/tkabber-plugins/receipts/receipts.tcl	2009-03-27 16:08:04 UTC (rev 1747)
+++ trunk/tkabber-plugins/receipts/receipts.tcl	2009-03-27 16:11:00 UTC (rev 1748)
@@ -8,25 +8,24 @@
 package require msgcat
 
 namespace eval receipts {
-    set ::NS(receipts) urn:xmpp:receipts
-
     ::msgcat::mcload [file join [file dirname [info script]] msgs]
 
-    foreach item {confirmed unconfirmed} {
-	image create photo receipts/$item \
-	    -file [file join [file dirname [info script]] images $item.gif]
+    if {![::plugins::is_registered receipts]} {
+	::plugins::register receipts \
+			    -namespace [namespace current] \
+			    -source [info script] \
+			    -description [::msgcat::mc \
+					    "Whether the Message Receipts plugin is\
+					     loaded."] \
+			    -loadcommand \
+				    [namespace code \
+					       [list load \
+						     [file dirname \
+							   [info script]]]] \
+			    -unloadcommand [namespace code unload]
+	return
     }
-    unset item
 
-    hook::add process_message_hook \
-	[namespace current]::process_message
-    hook::add chat_send_message_xlist_hook \
-	[namespace current]::attach_confirmation_request
-    hook::add draw_message_hook \
-	[namespace current]::add_receipt_icon 5
-
-    disco::register_feature $::NS(receipts)
-
     variable options
 
     custom::defgroup Plugins [::msgcat::mc "Plugins options."] -group Tkabber
@@ -48,6 +47,41 @@
 	-type boolean
 }
 
+proc receipts::load {dir} {
+    set ::NS(receipts) urn:xmpp:receipts
+
+    foreach item {confirmed unconfirmed} {
+	image create photo receipts/$item \
+	      -file [file join $dir images $item.gif]
+    }
+
+    hook::add process_message_hook \
+	      [namespace current]::process_message
+    hook::add chat_send_message_xlist_hook \
+	      [namespace current]::attach_confirmation_request
+    hook::add draw_message_hook \
+	      [namespace current]::add_receipt_icon 5
+
+    disco::register_feature $::NS(receipts)
+}
+
+proc receipts::unload {} {
+    disco::register_feature $::NS(receipts)
+
+    foreach item {confirmed unconfirmed} {
+	image delete photo receipts/$item
+    }
+
+    hook::remove process_message_hook \
+		 [namespace current]::process_message
+    hook::remove chat_send_message_xlist_hook \
+		 [namespace current]::attach_confirmation_request
+    hook::remove draw_message_hook \
+		 [namespace current]::add_receipt_icon 5
+
+    unset ::NS(receipts)
+}
+
 # Receipts are only sent when all these conditions hold:
 # * They aren't disabled via Customize options.
 # * Receipt request is attached to a groupchat private

Modified: trunk/tkabber-plugins/tclchat/tclchat.tcl
===================================================================
--- trunk/tkabber-plugins/tclchat/tclchat.tcl	2009-03-27 16:08:04 UTC (rev 1747)
+++ trunk/tkabber-plugins/tclchat/tclchat.tcl	2009-03-27 16:11:00 UTC (rev 1748)
@@ -37,6 +37,8 @@
 source [file join [file dirname [info script]] tclchat_messages.tcl]
 source [file join [file dirname [info script]] tclchat_commands.tcl]
 
+package require http
+
 proc tclchat::load {} {
     load_commands
     load_messages
@@ -76,40 +78,13 @@
     }
 
     array set Options {
-        auth          {}
         HistoryLines  0
         url           "http://tclers.tk/conferences/tcl"
         sel           "/?pattern=*.tcl"
         RE            {<A HREF="([0-9\-%d]+\.tcl)">.*\s([0-9]+) bytes}
     }
-    package require http
-    if {![info exists loginconf(proxyuseragent)]} {
-        set loginconf(proxyuseragent) [http::config -useragent]
-    }
-    http::config \
-        -proxyfilter [namespace origin proxyfilter] \
-        -useragent $loginconf(proxyuseragent)
-
-    if {$loginconf(proxy) == "https"} {
-        if {[string length $loginconf(proxyusername)] > 0} {
-            set Options(auth) [list Proxy-Authorization \
-                [concat Basic [base64::encode \
-                     "$loginconf(proxyusername):$loginconf(proxypassword)"]]]
-        }
-    }
 }
 
-proc tclchat::proxyfilter {host} {
-    global loginconf
-    if {[string match "localhost*" $host] || [string match "127.*" $host]} {
-        return {}
-    }
-    if {$loginconf(proxy) == "https"} {
-        return [list $loginconf(proxyhost) $loginconf(proxyport)]
-    }
-    return {}
-}
-
 proc tclchat::on_open_chat {chatid type} {
     variable Options
     if {[string equal $type "groupchat"]} {
@@ -147,7 +122,7 @@
     variable Options
 
     set loglist {}
-    set tok [::http::geturl ${url}$Options(sel) -headers $Options(auth)]
+    set tok [::proxy::http::geturl ${url}$Options(sel)]
     switch -- [::http::status $tok] {
         ok {
             if {[::http::ncode $tok] >= 500} {
@@ -190,7 +165,7 @@
     # fetch log
     set url "$Options(url)/$log"
     debugmsg tclchat "fetch log \"$url\""
-    set tok [::http::geturl $url -headers $Options(auth)]
+    set tok [::proxy::http::geturl $url]
 
     debugmsg tclchat "status [::http::status $tok] [::http::code $tok]"
     switch -- [::http::status $tok] {



More information about the Tkabber-dev mailing list