# $Id: roster.tcl 1477 2008-07-16 17:04:45Z sergei $

namespace eval roster {
    variable undef_group_name [::msgcat::mc "Undefined"]
    variable chats_group_name [::msgcat::mc "Active Chats"]
    variable own_resources_group_name [::msgcat::mc "My Resources"]
}

proc roster::process_item {connid jid name groups subsc ask} {
    variable roster
    variable undef_group_name
    variable chats_group_name
    variable own_resources_group_name

    debugmsg roster "ROSTER_ITEM: $connid; $jid; $name; $groups; $subsc; $ask"

    set jid [tolower_node_and_domain $jid]

    if {$subsc != "remove"} {
	if {![lcontain $roster(jids,$connid) $jid]} {
	    lappend roster(jids,$connid) $jid
	}
	set groups [lrmdups $groups]
	foreach group [list "" $undef_group_name $chats_group_name $own_resources_group_name] {
	    set ind [lsearch -exact $groups $group]
	    if {$ind >= 0} {
		set groups [lreplace $groups $ind $ind]
	    }
	}
	set roster(group,$connid,$jid)    $groups
	set roster(name,$connid,$jid)     $name
	set roster(subsc,$connid,$jid)    $subsc
	set roster(ask,$connid,$jid)      $ask

	catch {unset roster(cached_category_and_subtype,$connid,$jid)}
	get_category_and_subtype $connid $jid
    } else {
	lvarpop roster(jids,$connid) [lsearch -exact $roster(jids,$connid) $jid]

	catch {unset roster(group,$connid,$jid)}
	catch {unset roster(name,$connid,$jid)}
	catch {unset roster(subsc,$connid,$jid)}
	catch {unset roster(ask,$connid,$jid)}
	catch {unset roster(cached_category_and_subtype,$connid,$jid)}
    }
}

hook::add roster_item_hook [namespace current]::roster::process_item
hook::add roster_push_hook [namespace current]::roster::process_item

proc client:roster_item {connid jid name groups subsc ask} {
    hook::run roster_item_hook $connid $jid $name $groups $subsc $ask 
}

proc client:roster_push {connid jid name groups subsc ask} {
    hook::run roster_push_hook $connid $jid $name $groups $subsc $ask
    ::redraw_roster
}

proc client:roster_cmd {connid status} {
    debugmsg roster "ROSTER_CMD: $status"
    
    if {[cequal $status END_ROSTER]} {
	hook::run roster_end_hook $connid
	::redraw_roster
    }
}

proc roster::request_roster {connid} {
    variable roster

    set roster(jids,$connid) {}
    jlib::roster_get -command client:roster_cmd -connection $connid
}

hook::add connected_hook [namespace current]::roster::request_roster 15

proc roster::get_group_jids {connid group args} {
    variable roster
    variable undef_group_name

    if {![info exists roster(jids,$connid)]} {
	return {}
    }

    set nested 0
    set delim "::"
    foreach {opt val} $args {
	switch -- $opt {
	    -nested { set nested $val }
	    -delimiter { set delim $val }
	}
    }

    set jids {}
    if {[cequal $group $undef_group_name]} {
	foreach jid $roster(jids,$connid) {
	    if {[lempty [::roster::itemconfig $connid $jid -group]]} {
		lappend jids $jid
	    }
	}
    } else {
	foreach jid $roster(jids,$connid) {
	    foreach jgroup [::roster::itemconfig $connid $jid -group] {
		if {($nested && \
			[string first "$group$delim" "$jgroup$delim"] == 0) || \
			[cequal $group $jgroup]} {
		    lappend jids $jid
		    break
		}
	    }
	}
    }
    return $jids
}

proc roster::get_jids {connid} {
    variable roster

    if {[info exists roster(jids,$connid)]} {
	return [lsort -dictionary $roster(jids,$connid)]
    } else {
	return {}
    }
}

proc roster::get_groups {connid args} {
    variable roster
    variable undef_group_name

    if {![info exists roster(jids,$connid)]} {
	return {}
    }

    set nested 0
    set delimiter "::"
    set undefined 0
    set groups {}

    foreach {opt val} $args {
	switch -- $opt {
	    -nested { set nested $val }
	    -delimiter { set delimiter $val }
	    -raw {
		if {$val} {
		    foreach jid $roster(jids,$connid) {
			set groups [concat $groups $roster(group,$connid,$jid)]
		    }		    
		    return [lrmdups $groups]
		}
	    }
	    -undefined { set undefined $val }
	}
    }

    set empty 0
    foreach jid $roster(jids,$connid) {
	set jid_groups [::roster::itemconfig $connid $jid -group]
	if {![lempty $jid_groups]} {
	    foreach group $jid_groups {
		if {$nested} {
		    set sgroup [msplit $group $delimiter]
		} else {
		    set sgroup [list $group]
		}
		set deep [llength $sgroup]
		for {set i 0} {$i < $deep} {incr i} {
			set sgr [lrange $sgroup 0 $i]
			lappend groups [join $sgr "\u0000"]
		}
	    }
	} else {
	    set empty 1
	}
    }
    set res {}
    foreach sgroup [lsort -unique -dictionary $groups] {
	lappend res [join [split $sgroup "\u0000"] $delimiter]
    }
    if {$empty && $undefined} {
	lappend res $undef_group_name
    }

    return $res
}

proc roster::itemconfig {connid jid args} {
    variable roster

    if {[llength $args] == 1} {
	lassign $args attr
	switch -- $attr {
	    -group    {set param group}
	    -name     {set param name}
	    -subsc    {set param subsc}
	    -ask      {set param ask}
	    -category {
		return [lindex [get_category_and_subtype $connid $jid] 0]
	    }
	    -subtype  {
		return [lindex [get_category_and_subtype $connid $jid] 1]
	    }
	    -isuser   {
		return [cequal [lindex [get_category_and_subtype $connid $jid] 0] "user"]
	    }
	    default   {
		return -code error "Bad option \"$attr\":\
		    must be one of: -group, -name, -subsc, -ask,\
		    -category, -subtype or -isuser"
	    }
	}
	if {[info exists roster($param,$connid,$jid)]} {
	    return $roster($param,$connid,$jid)
	} else {
	    return ""
	}
    } else {
	foreach {attr val} $args {
	    switch -- $attr {
		-group    {set param group}
		-name     {set param name}
		-subsc    {set param subsc}
		-ask      {set param ask}
		-category {
		    override_category $connid $jid $val
		    continue
		}
		-subtype  {
		    override_subtype $connid $jid $val
		    continue
		}
		default   {return -code error "Illegal option"}
	    }
	    set roster($param,$connid,$jid) $val
	}
    }
}

# Returns true if $jid is allowed to receive our presence information,
# false otherwise.
proc roster::is_trusted {connid jid} {
    set subsc [itemconfig $connid [find_jid $connid $jid] -subsc]

    if {[node_and_server_from_jid $jid] == [jlib::connection_bare_jid $connid]} {
	return 1
    } elseif {$subsc == "both" || $subsc == "from"} {
	return 1
    } else {
	return 0
    }
}

proc roster::on_change_jid_presence {connid jid type x args} {
    variable roster

    switch -- $type {
	error -
	unavailable -
	available {}
	default { return }
    }

    set rjid [find_jid $connid $jid]
    debugmsg roster "$jid $rjid"

    if {$rjid != ""} {
	lassign [get_category_and_subtype $connid $rjid] category subtype
	
	if {$category == "user"} {
	    set status [get_user_status $connid $rjid]
	    set label [get_label $connid $rjid]
	    if {![catch {set desc [::get_long_status_desc $status]}]} {
		set_status [format "%s $desc" $label]
	    }
	    hook::run on_change_user_presence_hook $label $status
	}
    }
    ::redraw_roster
}

hook::add client_presence_hook roster::on_change_jid_presence 60

proc roster::find_jid {connid jid} {
    variable roster

    if {![info exists roster(jids,$connid)]} {
	return ""
    }

    if {[lsearch -exact $roster(jids,$connid) $jid] >= 0} {
	return $jid
    }

    lassign [get_category_and_subtype $connid $jid] category subtype
    if {$category == "user"} {
	set rjid [node_and_server_from_jid $jid]
	if {[lsearch -exact $roster(jids,$connid) $rjid] >= 0} {
	    lassign [get_category_and_subtype $connid $rjid] rcategory rsubtype
	    if {$category == $rcategory} {
		return $rjid
	    }
	}
    }
    return ""
}

proc roster::get_label {connid jid} {
    set name [itemconfig $connid $jid -name]
    if {[string equal $name ""]} {
	return $jid
    } else {
	return $name
    }
}

proc roster::override_category_and_subtype {connid jid category subtype} {
    variable roster

    set roster(overridden_category_and_subtype,$connid,$jid) \
	[list $category $subtype]
}

proc roster::override_category {connid jid category} {
    variable roster

    if {![info exists roster(overridden_category_and_subtype,$connid,$jid)]} {
	lassign [get_category_and_subtype $connid $jid] category1 subtype
	set roster(overridden_category_and_subtype,$connid,$jid) \
	    [list $category $subtype]
    } else {
	set roster(overridden_category_and_subtype,$connid,$jid) \
	    [list $category \
		  [lindex \
		       $roster(overridden_category_and_subtype,$connid,$jid) 1]]
    }
}

proc roster::override_subtype {connid jid subtype} {
    variable roster

    if {![info exists roster(overridden_category_and_subtype,$connid,$jid)]} {
	lassign [get_category_and_subtype $connid $jid] category subtype1
	set roster(overridden_category_and_subtype,$connid,$jid) \
	    [list $category $subtype]
    } else {
	set roster(overridden_category_and_subtype,$connid,$jid) \
	    [list [lindex \
		       $roster(overridden_category_and_subtype,$connid,$jid) 0] \
		  $subtype]
    }
}

proc roster::get_category_and_subtype {connid jid} {
    variable roster

    if {[info exists roster(overridden_category_and_subtype,$connid,$jid)]} {
	return $roster(overridden_category_and_subtype,$connid,$jid)
    }

    set server [server_from_jid $jid]
    if {[info exists roster(overridden_category_and_subtype,$connid,$server)]} {
	catch { unset roster(cached_category_and_subtype,$connid,$jid) }
	set cs [heuristically_get_category_and_subtype $connid $jid]
	set roster(overridden_category_and_subtype,$connid,$jid) $cs
	return $cs
    }

    if {[info exists roster(cached_category_and_subtype,$connid,$jid)]} {
	return $roster(cached_category_and_subtype,$connid,$jid)
    }

    catch { plugins::cache_categories::request_category_and_subtype $connid $jid }

    set cs [heuristically_get_category_and_subtype $connid $jid]
    set roster(cached_category_and_subtype,$connid,$jid) $cs
    return $cs
}

proc roster::heuristically_get_category_and_subtype {connid jid} {
    variable roster

    set node [node_from_jid $jid]
    set server [server_from_jid $jid]
    set resource [resource_from_jid $jid]

    if {$node == "" && $resource == ""} {
	set updomain [lindex [split $server .] 0]
	set category service

	switch -- $updomain {
	    aim        -
	    icq        -
	    irc        -
	    jabber     -
	    jud        -
	    msn        -
	    mrim       -
	    pager      -
	    rss        -
	    serverlist -
	    sms	       -
	    smtp       -
	    yahoo {
		set subtype $updomain
	    }
	    gg {
		set subtype gadu-gadu
	    }
	    pogoda -
	    weather {
		set subtype x-weather
	    }
	    default {
		set subtype ""
	    }
	}

	return [list $category $subtype]
    }

    if {$node == ""} {
	return [get_category_and_subtype $connid $server]
    }

    if {[resource_from_jid $jid] == ""} {
	lassign [get_category_and_subtype $connid $server] scategory ssubtype

	switch -glob -- $scategory/$ssubtype {
	    conference/irc {
		if {[string first "%" $node] >= 0} {
		    set category conference
		    set subtype irc
		} else {
		    set category user
		    set subtype ""
		}
	    }
	    conference/* {
		set category conference
		set subtype ""
	    }
	    default {
		set category user
		set subtype ""
	    }
	}

	return [list $category $subtype]
    }

    return {user client}
}

proc roster::clean {} {
    variable roster

    array unset roster jids,*
    array unset roster group,*
    array unset roster name,*
    array unset roster subsc,*
    array unset roster ask,*
    array unset roster subtype,*
    array unset roster cached_category_and_subtype,*
    array unset roster overridden_category_and_subtype,*
    ::redraw_roster
}

proc roster::clean_connection {connid} {
    variable roster

    array unset roster jids,$connid
    array unset roster group,$connid,*
    array unset roster name,$connid,*
    array unset roster subsc,$connid,*
    array unset roster ask,$connid,*
    array unset roster subtype,$connid,*
    array unset roster cached_category_and_subtype,$connid,*
    array unset roster overridden_category_and_subtype,$connid,*

    ::redraw_roster
}

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

proc roster::item_to_xml {connid jid} {
    variable roster
    variable undef_group_name
    variable chats_group_name
    variable own_resources_group_name

    set grtags {}
    foreach group $roster(group,$connid,$jid) {
	if {![cequal $group ""] && \
		![cequal $group $undef_group_name] && \
		![cequal $group $chats_group_name] && \
		![cequal $group $own_resources_group_name]} {
	    lappend grtags [jlib::wrapper:createtag group -chdata $group]
	}
    }

    set vars [list jid $jid]

    if {$roster(name,$connid,$jid) != ""} {
	lappend vars name $roster(name,$connid,$jid)
    }

    return [jlib::wrapper:createtag item -vars $vars -subtags $grtags]
}

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

proc roster::send_item {connid jid} {
    hook::run roster_send_item_hook $connid $jid
}

proc roster::send_item_fallback {connid jid} {

    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars {xmlns jabber:iq:roster} \
	     -subtags [list [roster::item_to_xml $connid $jid]]] \
	-connection $connid
}

hook::add roster_send_item_hook roster::send_item_fallback 100

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

proc roster::remove_item {connid jid} {
    hook::run roster_remove_item_hook $connid $jid
}

proc roster::remove_item_fallback {connid jid} {

    jlib::send_iq set \
	[jlib::wrapper:createtag query \
	     -vars [list xmlns $::NS(roster)] \
	     -subtags [list [jlib::wrapper:createtag item \
				 -vars [list jid $jid \
					     subscription remove]]]] \
	-connection $connid
	
    jlib::send_presence -to $jid -type unsubscribe -connection $connid
    jlib::send_presence -to $jid -type unsubscribed -connection $connid

    lassign [get_category_and_subtype $connid $jid] category subtype

    if {(($category == "service") || \
	 ($category == "server") || \
	 ($category == "gateway")) && \
	[string compare -nocase [node_and_server_from_jid $jid] \
				[jlib::connection_server $connid]]} {
	jlib::send_iq set \
	    [jlib::wrapper:createtag query \
		 -vars [list xmlns $::NS(register)] \
		 -subtags [list [jlib::wrapper:createtag remove]]] \
	    -to $jid \
	    -connection $connid
    }
}

hook::add roster_remove_item_hook roster::remove_item_fallback 100

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

proc roster::send_rename_group {connid name new_name} {
    variable roster
    variable undef_group_name

    if {[string equal $new_name $name]} return

    hook::run roster_rename_group_hook $connid $name $new_name

    set items {}

    foreach jid $roster(jids,$connid) {
	switch -- [itemconfig $connid $jid -subsc] {
	    none - from - to - both { }
	    default { continue }
	}

	if {[lcontain $roster(group,$connid,$jid) $name] || \
		($name == $undef_group_name && \
		     $roster(group,$connid,$jid) == {})} {
	    set idx [lsearch -exact $roster(group,$connid,$jid) $name]
	    if {$new_name != ""} {
		set roster(group,$connid,$jid) \
		    [lreplace $roster(group,$connid,$jid) $idx $idx $new_name]
	    } else {
		set roster(group,$connid,$jid) \
		    [lreplace $roster(group,$connid,$jid) $idx $idx]
	    }
	    set roster(group,$connid,$jid) [lrmdups $roster(group,$connid,$jid)]
	    lappend items [item_to_xml $connid $jid]
	}
    }

    if {$items != {}} {
	jlib::send_iq set \
	    [jlib::wrapper:createtag query \
		 -vars {xmlns jabber:iq:roster} \
		 -subtags $items] \
	    -connection $connid
    }
}

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

proc roster::send_remove_users_group {connid name} {
    variable roster
    variable undef_group_name

    hook::run roster_remove_users_group_hook $connid $name

    set items {}

    foreach jid $roster(jids,$connid) {
	switch -- [itemconfig $connid $jid -subsc] {
	    none - from - to - both { }
	    default { continue }
	}

	set groups $roster(group,$connid,$jid)
	if {(([llength $groups] == 1) && [lcontain $groups $name]) || \
		(($name == $undef_group_name) && ($groups == {}))} {
	    remove_item $connid $jid
	} elseif {[lcontain $groups $name]} {
	    set idx [lsearch -exact $groups $name]
	    set roster(group,$connid,$jid) [lreplace $groups $idx $idx]
	    lappend items [item_to_xml $connid $jid]
	}
    }

    if {$items != {}} {
	jlib::send_iq set \
	    [jlib::wrapper:createtag query \
		 -vars {xmlns jabber:iq:roster} \
		 -subtags $items] \
	    -connection $connid
    }
}

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

proc roster::resubscribe_group {connid name} {
    variable roster
    variable undef_group_name

    foreach jid $roster(jids,$connid) {
	if {[lcontain $roster(group,$connid,$jid) $name] || \
		($name == $undef_group_name && \
		     $roster(group,$connid,$jid) == {})} {
	    lassign [get_category_and_subtype $connid $jid] category type
	    if {$category == "user"} {
		jlib::send_presence \
		    -to $jid \
		    -connection $connid \
		    -type subscribe
	    }
	}
    }
}

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

proc roster::send_custom_presence_group {connid name status} {
    variable roster
    variable undef_group_name

    foreach jid $roster(jids,$connid) {
	if {[lcontain $roster(group,$connid,$jid) $name] || \
		($name == $undef_group_name && \
		     $roster(group,$connid,$jid) == {})} {
	    lassign [get_category_and_subtype $connid $jid] category type
	    if {$category == "user"} {
		send_custom_presence $jid $status -connection $connid
	    }
	}
    }
}

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

proc roster::add_group_by_jid_regexp {name regexp} {
    variable roster

    # TODO: connid
    if {$name == ""} return

    foreach connid [jlib::connections] {
	set items {}

	foreach jid $roster(jids,$connid) {
	    if {[regexp -- $regexp $jid]} {
		set idx [lsearch -exact $roster(group,$connid,$jid) $name]
		lappend roster(group,$connid,$jid) $name
		set roster(group,$connid,$jid) \
		    [lrmdups $roster(group,$connid,$jid)]
		lappend items [item_to_xml $connid $jid]
	    }
	}

	if {$items != {}} {
	    jlib::send_iq set \
		[jlib::wrapper:createtag query \
		     -vars {xmlns jabber:iq:roster} \
		     -subtags $items] \
		-connection $connid
	}
    }
}

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

proc roster::export_to_file {connid} {
    variable roster

    set filename [tk_getSaveFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid].roster \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .roster] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename != ""} {
	set items {}

	foreach jid $roster(jids,$connid) {
	    lappend items [item_to_xml $connid $jid]
	}

	set fd [open $filename w]
	fconfigure $fd -encoding utf-8
	puts $fd $items
	close $fd
    }
}

proc roster::import_from_file {connid} {
    variable roster

    set filename [tk_getOpenFile \
		      -initialdir $::configdir \
		      -initialfile [jlib::connection_user $connid].roster \
		      -filetypes [list \
				      [list [::msgcat::mc "Roster Files"] \
					   .roster] \
				      [list [::msgcat::mc "All Files"] *]]]
    if {$filename != ""} {
	set fd [open $filename r]
	fconfigure $fd -encoding utf-8
	set items [read $fd]
	close $fd

	if {$items != {}} {
	    jlib::send_iq set \
		[jlib::wrapper:createtag query \
		     -vars [list xmlns "jabber:iq:roster"] \
		     -subtags $items] \
		-connection $connid
	}
    }
}

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

# vim:ts=8:sw=4:sts=4:noet
