1# $Id$
2
3namespace eval cache_categories {
4#   {server1 {category1 type1} server2 {category2 type2}}
5    custom::defvar category_and_subtype_list {} \
6	[::msgcat::mc "Cached service categories and types (from disco#info)."] \
7	-type string -group Hidden
8
9    variable requested_categories
10}
11
12##############################################################################
13
14proc cache_categories::fill_cached_categories_and_subtypes {xlib} {
15    variable category_and_subtype_list
16    variable requested_categories
17
18    catch { array set tmp $category_and_subtype_list }
19    set requested_categories($xlib) [array names tmp]
20    foreach jid [array names tmp] {
21	lassign $tmp($jid) category subtype
22	roster::override_category_and_subtype $xlib $jid \
23					      $category $subtype
24    }
25}
26
27hook::add connected_hook \
28    [namespace current]::cache_categories::fill_cached_categories_and_subtypes 5
29
30##############################################################################
31
32proc cache_categories::free_cached_categories_and_subtypes {xlib} {
33    variable category_and_subtype_list
34    variable requested_categories
35
36    catch { unset requested_categories($xlib) }
37}
38
39hook::add disconnected_hook \
40    [namespace current]::cache_categories::free_cached_categories_and_subtypes
41
42##############################################################################
43
44proc cache_categories::request_category_and_subtype {xlib jid} {
45    variable category_and_subtype_list
46    variable requested_categories
47
48    set server [::xmpp::jid::server $jid]
49    if {[lsearch -exact $requested_categories($xlib) $server] >= 0} {
50	return
51    }
52
53    lappend requested_categories($xlib) $server
54
55    ::disco::request_info $xlib $server \
56	    -cache yes \
57	    -command [namespace code [list parse_requested_categories \
58					   $xlib $server]]
59}
60
61##############################################################################
62
63proc cache_categories::parse_requested_categories \
64     {xlib server status identities features extras} {
65    variable category_and_subtype_list
66
67    if {$status != "ok"} return
68
69    foreach identity $identities {
70	set category [::xmpp::xml::getAttr $identity category]
71	set type     [::xmpp::xml::getAttr $identity type]
72
73	roster::override_category_and_subtype $xlib $server $category $type
74	lappend category_and_subtype_list $server [list $category $type]
75
76	::redraw_roster
77	break
78    }
79}
80
81###############################################################################
82
83
84