---

Class ::xo::Chat

::xo::Chat create ... \
           [ -avatar_p (default "t") ] \
           [ -chat_id chat_id ] \
           [ -conf (default "") ] \
           [ -encoder (default "noencode") ] \
           [ -login_messages_p (default "t") ] \
           [ -logout_messages_p (default "t") ] \
           [ -message_relay (default "connchan bgdelivery none") ] \
           [ -mode (default "default") ] \
           [ -session_id session_id ] \
           [ -sweepinterval (default "60") ] \
           [ -timewindow (default "600") ] \
           [ -user_id user_id ]

Class Relations

• class: ::xotcl::Class
• superclass: ::xo::OrderedComposite
• subclass: ::xowiki::Chat

::xotcl::Class create ::xo::Chat \
     -superclass ::xo::OrderedComposite

Methods (to be applied on instances)

• active_user_list (scripted)

  nsv_array get ${:array}-login

• add_msg (scripted)

  # :log "--chat adding $msg"
  set user_id [expr {$uid ne "" ? $uid : ${:user_id}}]
  set color   [:user_color $user_id]
  set msg     [ns_quotehtml $msg]
  
  # :log "-- msg=$msg"
  :broadcast_msg [Message new -volatile -time [clock seconds]  -user_id $user_id -color $color -msg $msg]
  
  :register_nsvs ${:now}.$user_id $user_id $msg $color [clock seconds]
  #
  # This in any case a valid result, but only needed for the polling
  # interface
  #
  if {$get_new} {
    :get_new
  }

• avatar_p (setter)

• broadcast_msg (scripted)

  #:log "--chat broadcast_msg"
  ${:mr} send_to_subscriber chat-${:chat_id} [:json_encode_msg $msg]

• chat_id (setter)

• check_age (scripted)

  if {$ago > ${:timewindow}} {
    ::acs::clusterwide nsv_unset ${:array} $key
    #:log "--c unsetting $key"
    return 0
  }
  return 1

• conf (setter)

• current_message_valid (scripted)

  expr { [info exists :user_id] && ${:user_id} != -1 }

• encode (scripted)

  my [:encoder] $string

• encoder (setter)

• get_all (scripted)

  foreach {key value} [nsv_array get ${:array}] {
    lassign $value timestamp secs user msg color
    if {[:check_age $key [expr {(${:now} - $timestamp) / 1000}]]} {
      :add [Message new -time $secs -user_id $user -msg $msg -color $color]
    }
  }
  #:log "--chat setting session_id ${:session_id}: ${:now}"
  ::acs::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now}
  :render

• get_new (scripted)

  if {![:nsv_get ${:array}-seen ${:session_id} last]} {
    set last 0
  }
  if {[nsv_get ${:array}-seen newest] > $last} {
    #:log "--c must check ${:session_id}: [nsv_get ${:array}-seen newest] > $last"
    foreach {key value} [nsv_array get ${:array}] {
      lassign $value timestamp secs user msg color
      if {$timestamp > $last} {
        #
        # add the message to the ordered composite.
        #
        :add [Message new -time $secs -user_id $user -msg $msg -color $color]
      } else {
        :check_age $key [expr {(${:now} - $timestamp) / 1000}]
      }
    }
    ::acs::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now}
    # :log "--chat setting session_id ${:session_id}: ${:now}"
  } else {
    # :log "--chat nothing new for ${:session_id}"
  }
  :render

• get_users (scripted)

  return [:json_encode_msg [Message new -volatile -type "users" -time [clock seconds]]]

• init (scripted)

  # :log "-- "
  
  #
  # Work through the list of provided message_relays and select a
  # usable one.
  #
  set :mr ::xo::mr::none
  foreach mr ${:message_relay} {
    if {[::xo::mr::$mr can_be_used]} {
      set :mr ::xo::mr::$mr
      break
    }
  }
  
  set :now [clock clicks -milliseconds]
  if {![info exists :user_id]} {
    #
    # Chat may be instantiated outside xowiki, where ::xo::cc is
    # assumed to exist.
    #
    ::xo::ConnectionContext require
  
    set :user_id [ad_conn user_id]
    set :requester [::xo::cc requester]
    if {${:user_id} == 0} {
      #
      # Maybe the user_id was timed out, so fall potentially back to
      # the untrusted_user_id (which might be as well 0).
      #
      set :user_id [::xo::cc get_user_id]
    }
    #
    # Keep always the original user_id
    #
    set :original_user_id ${:user_id}
    if {${:user_id} == 0} {
      #
      # Overwrite the user_id with the requester. This increases
      # backward compatibility and eases handling of the identifier
      # for the user.
      #
      set :user_id ${:requester}
    }
  }
  if {![info exists :session_id]} {
    set :session_id [ad_conn session_id]
  }
  set cls [:info class]
  set :array $cls-${:chat_id}
  
  #
  # The basic nsv (typically ::chat::Chat) is hit quite frequently
  # on busy sites. So reduce these these hits.
  
  # Something to consider: We could/should do this actually in an
  # init-script. The only advantage by this construct is to start
  # the scheduled proc only when a chat is started.
  #
  acs::per_thread_cache eval -key chat-initialized-$cls {
    if {![nsv_exists $cls initialized]} {
      :log "-- initialize $cls"
      $cls initialize_nsvs
      ::acs::clusterwide nsv_set $cls initialized  [ad_schedule_proc  -thread "t" ${:sweepinterval} $cls sweep_all_chats]
    }
  }
  if {![nsv_exists ${:array}-seen newest]} {
    ::acs::clusterwide nsv_set ${:array}-seen newest 0
  }
  if {![nsv_exists ${:array}-color idx]} {
    ::acs::clusterwide nsv_set ${:array}-color idx 0
  }
  if {![nsv_array exists ${:array}-anonymous_ids]} {
    ::acs::clusterwide nsv_set ${:array}-anonymous_ids . .
  }
  if {${:user_id} != 0 || [:session_id] != 0} {
    :init_user_color
  }
  :set_options

• init_user_color (scripted)

  if { [nsv_exists ${:array}-color ${:user_id}] } {
    return
  } else {
    set colors [::parameter::get -parameter UserColors -default [[:info class] set colors]]
    # ns_log notice "getting colors of [:info class] = [info exists colors]"
    set color [lindex $colors [expr { [nsv_get ${:array}-color idx] % [llength $colors] }]]
    ::acs::clusterwide nsv_set ${:array}-color ${:user_id} $color
    ::acs::clusterwide nsv_incr ${:array}-color idx
  }

• js_encode_msg (scripted)

  set json [string trim [:json_encode_msg $msg]]
  if {$json ne ""} {
    return [subst {
      <script nonce='[security::csp::nonce]'>
         let data = $json;
         parent.getData(data);
      </script>\n
    }]
  } else {
    return
  }

• json_encode (scripted)

  string map [list \n \\n \" \\\" ' {\\'} \\ \\\\] $string

• json_encode_msg (scripted)

  set type [$msg type]
  switch $type {
    "message" {
      set message   [$msg msg]
      set user_id   [$msg user_id]
      set user      [:user_name $user_id]
      set color     [$msg color]
      set timestamp [clock format [$msg time] -format {[%H:%M:%S]}]
      foreach var {message user timestamp color user_id} {
        set $var [:json_encode [set $var]]
      }
      return [subst {{"type": "$type", "message": "$message", "timestamp": "$timestamp", "user": "$user", "color": "$color", "user_id": "$user_id"}\n}]
    }
    "users" {
      set message [list]
      foreach {user_id timestamp} [:active_user_list] {
        if {$user_id < 0} continue
        set timestamp [clock format [expr {[clock seconds] - $timestamp}] -format "%H:%M:%S" -gmt 1]
        set user      [:user_name $user_id]
        set color     [:user_color $user_id]
        foreach var {user timestamp color user_id} {
          set $var [:json_encode [set $var]]
        }
        lappend message [subst {{"timestamp": "$timestamp", "user": "$user", "color": "$color", "user_id": "$user_id"}}]
      }
      set message "\[[join $message ,]\]"
      return [subst {{"type": "$type", "chat_id": "${:chat_id}", "message": $message}\n}]
    }
  }

• last_activity (scripted)

  if { [:nsv_get ${:array}-seen last ts]} {
    return [clock format $ts -format "%d.%m.%y %H:%M:%S"]
  } else {
    return "-"
  }

• login (scripted)

  :log "--chat login mode=${:mode}"
  if {${:login_messages_p} && ![:user_active ${:user_id}]} {
    :add_msg -uid ${:user_id} -get_new false [_ xotcl-core.has_entered_the_room]
  } elseif {${:user_id} > 0 && ![nsv_exists ${:array}-login ${:user_id}]} {
    # give some proof of our presence to the chat system when we
    # don't issue the login message
    ::acs::clusterwide nsv_set ${:array}-login ${:user_id} [clock seconds]
    ::acs::clusterwide nsv_set ${:array}-last-activity ${:user_id} ${:now}
  }
  :encoder noencode
  #:log "--chat setting session_id ${:session_id}: ${:now} mode=${:mode}"
  return [:get_all]

• login_messages_p (setter)

• logout (scripted)

  set user_id [expr {$user_id ne "" ? $user_id : ${:user_id}}]
  ns_log notice "--core-chat User $user_id logging out of chat"
  if {${:logout_messages_p}} {
    if {$msg eq ""} {set msg [_ chat.has_left_the_room].}
    :add_msg -uid $user_id -get_new false $msg
  }
  
  # These values could already not be here. Just ignore when we don't
  # find them
  try {
    ::acs::clusterwide nsv_unset -nocomplain ${:array}-login $user_id
  }
  try {
    ::acs::clusterwide nsv_unset -nocomplain ${:array}-color $user_id
  }
  try {
    ::acs::clusterwide nsv_unset -nocomplain ${:array}-last-activity $user_id
  }

• logout_messages_p (setter)

• message_relay (setter)

• mode (setter)

• noencode (scripted)

  set string

• nr_active_users (scripted)

  expr { [llength [nsv_array get ${:array}-login]] / 2 }

• nsv_get (scripted)

  :upvar $v_value value
  return [::nsv_get $array $key value]

• register_nsvs (scripted)

  # Tell the system we are back again, in case we were auto logged out
  if { ![nsv_exists ${:array}-login $user_id] } {
    ::acs::clusterwide nsv_set ${:array}-login $user_id [clock seconds]
  }
  ::acs::clusterwide nsv_set ${:array} $msg_id [list ${:now} $secs $user_id $msg $color]
  ::acs::clusterwide nsv_set ${:array}-seen newest ${:now}
  ::acs::clusterwide nsv_set ${:array}-seen last $secs
  ::acs::clusterwide nsv_set ${:array}-last-activity $user_id ${:now}

• render (scripted)

  :orderby time
  set result [list]
  # Piggyback the users list in every rendering, this way we don't
  # need a separate ajax request for the polling interface.
  :add [Message new -type "users" -time [clock seconds]]
  foreach child [:children] {
    lappend result [:json_encode_msg $child]
  }
  return "\[[join $result ,]\]"

• session_id (setter)

• set_options (scripted)

  # Any supplied conf we are going to save and apply to any other
  # instance of this chat created in the future.
  if {[llength ${:conf}] > 0} {
    ::acs::clusterwide nsv_array set ${:array}-conf ${:conf}
  }
  dict for {key value} [nsv_array get ${:array}-conf] {
    ::acs::clusterwide nsv_set ${:array}-options $key $value
    set :$key $value
  }

• subscribe (scripted)

  set user_id [expr {[info exists uid] ? $uid : ${:user_id}}]
  set color [:user_color $user_id]
  #ns_log notice "--CHAT [self] subscribe chat-${:chat_id} -mode ${:mode} via <${:mr}>"
  ${:mr} subscribe chat-${:chat_id} -mode ${:mode}

• sweeper (scripted)

  #:log "--core-chat starting"
  foreach {user timestamp} [nsv_array get ${:array}-last-activity] {
    set ago [expr {(${:now} - $timestamp) / 1000}]
    #ns_log notice "--core-chat Checking: now=${:now}, timestamp=$timestamp, ago=$ago"
    if {$ago > 300} {
      :logout -user_id $user -msg "auto logout"
      # ns_log warning "-user_id $user auto logout"
      ${:mr} sweep chat-${:chat_id}
    }
  }
  :broadcast_msg [Message new -volatile -type "users" -time [clock seconds]]
  #:log "-- ending"

• sweepinterval (setter)

• timewindow (setter)

• urlencode (scripted)

  ns_urlencode $string

• usable_screen_name (scripted)

  if {[nsv_get ${:array}-anonymous_ids $screen_name seenRequester]} {
    if {$seenRequester eq $requester} {
      #
      # We have this screen name already assigned to this requester.
      #
      #ns_log notice "check screen name for $requester in ${:array}-anonymous_ids -> later time"
      return 1
    } else {
      #ns_log notice "check screen name for $requester in ${:array}-anonymous_ids -> not usable <$seenRequester != $requester>"
      return 0
    }
  }
  #
  # We saw this screen name the first time.
  #
  #ns_log notice "check screen name for $requester in ${:array}-anonymous_ids -> first time"
  nsv_set ${:array}-anonymous_ids $screen_name $requester
  return 1

• user_active (scripted)

  # was the user already active?
  #:log "--chat login already active? [nsv_exists ${:array}-last-activity $user_id]"
  return [nsv_exists ${:array}-last-activity $user_id]

• user_color (scripted)

  if { ![:nsv_get ${:array}-color $user_id color] } {
    :log "warning: Cannot find user color for chat (${:array}-color $user_id)!"
    set color [lindex [[:info class] set colors] 0]
  }
  return $color

• user_id (setter)

• user_name (scripted)

  #
  # Map the provided user_id (which might be numeric or an IP
  # address) to a screen name, which might be the configured screen
  # name, the username, or of the form userXXX.
  #
  #:log "user_name for $user_id"
  if {![nsf::is int32 $user_id]} {
    #
    # The user_id is a requester (e.g. IPv4 or IPv6 address)
    #
    set requester $user_id
    if {[::acs::icanuse "ns_hash"]} {
      set hash [ns_hash $requester]
      set screen_name user[expr {$hash % 1000}]
      if {![:usable_screen_name $screen_name $requester]} {
        #
        # Collision: we have this screen_name already for a
        # different requester.
        #
        for {set i 1} {$i < 200} {incr i} {
          set screen_name user[expr {$hash % 1000}]$i
          if {[:usable_screen_name $screen_name $requester]} {
            break
          }
        }
      }
    } else {
      set screen_name $requester
    }
  } elseif {$user_id > 0} {
    #
    # True user_id
    #
    set screen_name [acs_user::get_user_info -user_id $user_id -element screen_name]
    if {$screen_name eq ""} {
      set screen_name [person::name -person_id $user_id]
    }
  } elseif { $user_id == 0 } {
    set screen_name "Nobody"
  } else {
    #
    # This might be triggered during background processing.
    #
    set screen_name "System"
  }
  #:log "user_name for $user_id -> $screen_name"
  return $screen_name

---