# $Id: cache_categories.tcl 1681 2009-02-23 13:56:14Z sergei $

namespace eval cache_categories {
#   {server1 {category1 type1} server2 {category2 type2}}
    custom::defvar category_and_subtype_list {} \
	[::msgcat::mc "Cached service categories and types (from disco#info)."] \
	-type string -group Hidden

    variable requested_categories
}

##############################################################################

proc cache_categories::fill_cached_categories_and_subtypes {xlib} {
    variable category_and_subtype_list
    variable requested_categories

    catch { array set tmp $category_and_subtype_list }
    set requested_categories($xlib) [array names tmp]
    foreach jid [array names tmp] {
	lassign $tmp($jid) category subtype
	roster::override_category_and_subtype $xlib $jid \
					      $category $subtype
    }
}

hook::add connected_hook \
    [namespace current]::cache_categories::fill_cached_categories_and_subtypes 5

##############################################################################

proc cache_categories::free_cached_categories_and_subtypes {xlib} {
    variable category_and_subtype_list
    variable requested_categories

    catch { unset requested_categories($xlib) }
}

hook::add disconnected_hook \
    [namespace current]::cache_categories::free_cached_categories_and_subtypes

##############################################################################

proc cache_categories::request_category_and_subtype {xlib jid} {
    variable category_and_subtype_list
    variable requested_categories

    set server [::xmpp::jid::server $jid]
    if {[lsearch -exact $requested_categories($xlib) $server] >= 0} {
	return
    }

    lappend requested_categories($xlib) $server

    ::disco::request_info $xlib $server \
	    -cache yes \
	    -command [namespace code [list parse_requested_categories \
					   $xlib $server]]
}

##############################################################################

proc cache_categories::parse_requested_categories \
     {xlib server status identities features extras} {
    variable category_and_subtype_list

    if {$status != "ok"} return

    foreach identity $identities {
	set category [::xmpp::xml::getAttr $identity category]
	set type     [::xmpp::xml::getAttr $identity type]

	roster::override_category_and_subtype $xlib $server $category $type
	lappend category_and_subtype_list $server [list $category $type]

	::redraw_roster
	break
    }
}

###############################################################################


