Index: openacs-4/packages/xotcl-core/xotcl-core.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/xotcl-core.info,v diff -u -r1.106 -r1.106.2.1 --- openacs-4/packages/xotcl-core/xotcl-core.info 31 Jan 2019 14:32:23 -0000 1.106 +++ openacs-4/packages/xotcl-core/xotcl-core.info 23 Feb 2019 19:02:55 -0000 1.106.2.1 @@ -10,7 +10,7 @@ t xotcl - + Gustaf Neumann

XOTcl library functionality (e.g. thread handling, online documentation, Generic Form and List Classes)

2017-08-06 @@ -43,7 +43,7 @@ BSD-Style 2 - + Index: openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl,v diff -u -r1.68 -r1.68.2.1 --- openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl 16 Nov 2018 18:39:51 -0000 1.68 +++ openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl 23 Feb 2019 19:02:55 -0000 1.68.2.1 @@ -287,7 +287,7 @@ set ::subscription_count 0 set ::message_count 0 - ::xotcl::Class create Subscriber -parameter {key channel user_id mode} + ::xotcl::Class create Subscriber -parameter {key channel user_id mode {start_of_page ""}} Subscriber proc current {-key } { set result [list] if {[info exists key]} { @@ -338,16 +338,8 @@ Subscriber instproc send {msg} { #ns_log notice "SEND <$msg> [:mode]" :log "" - if {[:mode] eq "scripted"} { - ::sec_handler_reset - set emsg [encoding convertto utf-8 $msg] - #ns_log notice "SEND data <$msg> encoded <$emsg>" - set smsg "\n" - set smsg [format %x [string length $smsg]]\r\n$smsg\r\n - } else { - set smsg $msg - } + ::sec_handler_reset + set smsg [::xo::mr::bgdelivery encode_message [:mode] $msg] #my log "-- sending to subscriber for [:key] $smsg ch=[:channel] \ # mode=[:mode], user_id [:user_id]" try { @@ -362,7 +354,7 @@ "POSIX ECONNRESET {connection reset by peer}" } if {$::errorCode in $ok_errors} { - throw {CLIENTDISCONNECT} {client disconnected} + throw {AD_CLIENTDISCONNECT} {client disconnected} } else { throw $::errorCode $errorMsg } @@ -376,7 +368,7 @@ foreach s [set :subscriptions($key)] { try { $s $method $argument - } trap {CLIENTDISCONNECT} {errMsg} { + } trap {AD_CLIENTDISCONNECT} {errMsg} { ns_log warning "$method to subscriber $s (key=$key): $errMsg" $s destroy } on error {errMsg} { @@ -411,22 +403,8 @@ #my log "-- cl=[:info class], subscriptions([:key]) = $subscriptions([:key])" fconfigure [:channel] -translation binary - if {[:mode] eq "scripted"} { - set content_type "text/html;charset=utf-8" - set encoding "Cache-Control: no-cache\r\nTransfer-Encoding: chunked\r\n" - set body "[string repeat { } 1024]\r\n" - set body [format %x [string length $body]]\r\n$body\r\n - } else { - # Chrome refuses to expose partial response to ajax unless we - # set content_type to octet stream. Drawback is we have to - # force the translation on the channel. - set content_type "application/octet-stream" - set encoding "" - fconfigure [:channel] -encoding utf-8 - set body "" - } - - puts -nonewline [:channel] "HTTP/1.1 200 OK\r\nContent-type: $content_type\r\n$encoding\r\n$body" + fconfigure [:channel] -encoding utf-8 + puts -nonewline [:channel] ${:start_of_page} flush [:channel] } @@ -769,14 +747,14 @@ } ##################################### -bgdelivery proc subscribe {key {initmsg ""} {mode default} } { +bgdelivery proc -deprecated subscribe {key {initmsg ""} {mode default} } { set ch [ns_conn channel] thread::transfer [:get_tid] $ch #my do ::Subscriber sweep $key :do ::Subscriber new -channel $ch -key $key -user_id [ad_conn user_id] -mode $mode } -bgdelivery proc send_to_subscriber {key msg} { +bgdelivery proc -deprecated send_to_subscriber {key msg} { :do -async ::Subscriber broadcast $key $msg } ##################################### Fisheye: Tag 1.1 refers to a dead (removed) revision in file `openacs-4/packages/xotcl-core/tcl/message-relay-procs.tcl'. Fisheye: No comparison available. Pass `N' to diff? Index: openacs-4/packages/xowiki/xowiki.info =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/xowiki.info,v diff -u -r1.180 -r1.180.2.1 --- openacs-4/packages/xowiki/xowiki.info 9 Feb 2019 00:18:28 -0000 1.180 +++ openacs-4/packages/xowiki/xowiki.info 23 Feb 2019 19:02:55 -0000 1.180.2.1 @@ -10,7 +10,7 @@ t xowiki - + Gustaf Neumann

A xotcl-based enterprise wiki system with multiple object types

2017-08-06 @@ -55,8 +55,8 @@ BSD-Style 2 - - + + Index: openacs-4/packages/xowiki/tcl/chat-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/tcl/chat-procs.tcl,v diff -u -r1.54 -r1.54.2.1 --- openacs-4/packages/xowiki/tcl/chat-procs.tcl 18 Jan 2019 16:39:36 -0000 1.54 +++ openacs-4/packages/xowiki/tcl/chat-procs.tcl 23 Feb 2019 19:02:55 -0000 1.54.2.1 @@ -16,14 +16,28 @@ {mode default} {encoder noencode} {timewindow 600} - {sweepinterval 5} + {sweepinterval 60} {login_messages_p t} {logout_messages_p t} {conf {}} + {message_relay {bgdelivery connchan none}} } Chat instproc init {} { # :log "-- " + + # + # Work through the list of provided message_relays an 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]} { set :user_id [ad_conn user_id] @@ -79,17 +93,19 @@ 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 [list -msg $msg]] - if {[info commands ::thread::mutex] ne "" && - [info commands ::bgdelivery] ne ""} { - # we could use the streaming interface - :broadcast_msg [Message new -volatile -time [clock seconds] \ - -user_id $user_id -color $color [list -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} + # + # This in any case a valid result, but only needed for the polling + # interface + # + if {$get_new} { + :get_new + } } Chat instproc current_message_valid {} { @@ -134,9 +150,9 @@ } } ::xo::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now} - # :log "--c setting session_id ${:session_id}: ${:now}" + # :log "--chat setting session_id ${:session_id}: ${:now}" } else { - # :log "--c nothing new for ${:session_id}" + # :log "--chat nothing new for ${:session_id}" } :render } @@ -148,26 +164,24 @@ :add [Message new -time $secs -user_id $user -msg $msg -color $color] } } - #my log "--c setting session_id ${:session_id}: ${:now}" + #my log "--chat setting session_id ${:session_id}: ${:now}" ::xo::clusterwide nsv_set ${:array}-seen ${:session_id} ${:now} :render } Chat instproc sweeper {} { #:log "--core-chat starting" foreach {user timestamp} [nsv_array get ${:array}-last-activity] { - #ns_log notice "--core-chat at user $user with $timestamp" set ago [expr {(${:now} - $timestamp) / 1000}] #ns_log notice "--core-chat Checking: now=${:now}, timestamp=$timestamp, ago=$ago" - # was 1200 if {$ago > 300} { :logout -user_id $user -msg "auto logout" # ns_log warning "-user_id $user auto logout" - try {::bgdelivery do ::Subscriber sweep chat-[:chat_id]} + ${:mr} sweep chat-[:chat_id] } } :broadcast_msg [Message new -volatile -type "users" -time [clock seconds]] - :log "-- ending" + #:log "-- ending" } Chat instproc logout {{-user_id ""} {-msg ""}} { @@ -209,12 +223,12 @@ Chat instproc user_active {user_id} { # was the user already active? - :log "--chat login already avtive? [nsv_exists ${:array}-last-activity $user_id]" + #:log "--chat login already avtive? [nsv_exists ${:array}-last-activity $user_id]" return [nsv_exists ${:array}-last-activity $user_id] } Chat instproc login {} { - :log "--chat login" + :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}]} { @@ -224,7 +238,7 @@ ::xo::clusterwide nsv_set ${:array}-last-activity ${:user_id} ${:now} } :encoder noencode - :log "--c setting session_id ${:session_id}: ${:now}" + #:log "--chat setting session_id ${:session_id}: ${:now} mode=${:mode}" return [:get_all] } @@ -305,14 +319,14 @@ Chat instproc broadcast_msg {msg} { #:log "--chat broadcast_msg" - ::xo::clusterwide \ - bgdelivery send_to_subscriber chat-[:chat_id] [:json_encode_msg $msg] + ${:mr} send_to_subscriber chat-[:chat_id] [:json_encode_msg $msg] } Chat instproc subscribe {-uid} { set user_id [expr {[info exists uid] ? $uid : ${:user_id}}] set color [:user_color $user_id] - bgdelivery subscribe chat-[:chat_id] "" [:mode] + #ns_log notice "--CHAT [self] subscribe chat-${:chat_id} -mode ${:mode} via <${:mr}>" + ${:mr} subscribe chat-${:chat_id} -mode ${:mode} } Chat instproc render {} { @@ -339,7 +353,7 @@ :new -volatile -chat_id $chat_id -user_id 0 -session_id 0 -init -sweeper } } - :log "-- ending" + #:log "-- ending" } ChatClass method initialize_nsvs {} { @@ -394,7 +408,7 @@ set mode polling # # Check, whether we have the tcllibthread and a sufficiently new - # aolserver/NaviServer supporting bgdelivery transfers. + # AOLserver/NaviServer supporting bgdelivery transfers. # if {[info commands ::thread::mutex] ne "" && ![catch {ns_conn contentsentlength}]} { @@ -403,10 +417,12 @@ # set mode scripted-streaming if {![regexp msie|opera [string tolower [ns_set get [ns_conn headers] User-Agent]]]} { - # Explorer doesn't expose partial response until request state != 4, while Opera fires - # onreadystateevent only once. For this reason, for every browser except them, we could - # use the nice mode without the spinning load indicator. # + # Explorer doesn't expose partial response until request state + # != 4, while Opera fires onreadystateevent only once. For + # this reason, for every browser except them, we could use the + # nice mode without the spinning load indicator. + # set mode streaming } } @@ -473,11 +489,11 @@ switch -- $mode { polling { set jspath /resources/xowiki/chat.js - set subscribe_url ${base_url}&m=get_new + set subscribe_url ${base_url}&m=get_new&=polling } streaming { set jspath /resources/xowiki/streaming-chat.js - set subscribe_url ${base_url}&m=subscribe + set subscribe_url ${base_url}&m=subscribe&mode=streaming } scripted-streaming { set jspath /resources/xowiki/scripted-streaming-chat.js @@ -551,6 +567,7 @@ -session_id $session_id \ -mode $mode \ -conf $conf + #:log "--CHAT created c1 with mode=$mode" set data [c1 login] if {$data ne ""} { @@ -584,6 +601,8 @@ }] + #:log "--CHAT create HTML for mode=$mode" + switch -- $mode { "polling" { append html [subst -nocommands { Index: openacs-4/packages/xowiki/www/chat.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xowiki/www/Attic/chat.tcl,v diff -u -r1.2 -r1.2.2.1 --- openacs-4/packages/xowiki/www/chat.tcl 20 Nov 2018 18:41:05 -0000 1.2 +++ openacs-4/packages/xowiki/www/chat.tcl 23 Feb 2019 19:02:55 -0000 1.2.2.1 @@ -1,9 +1,10 @@ ad_page_contract { - a tiny chat client + A tiny chat client @author Gustaf Neumann (gustaf.neumann@wu-wien.ac.at) @creation-date Jan 31, 2006 @cvs-id $Id$ + } -query { m:word id:integer @@ -15,32 +16,37 @@ if {![::xo::ChatClass is_chat_p $class]} { ns_returnnotfound - ad_script_abort -} -#ns_log notice "--chat m=$m session_id=$s [clock format [lindex [split $s .] 1] -format %H:%M:%S] mode=$mode" -$class create c1 -destroy_on_cleanup -chat_id $id -session_id $s -mode $mode -switch -- $m { - add_msg { - #ns_log notice "--c call c1 $m '$msg'" - ns_return 200 application/json [c1 $m $msg] - ad_script_abort - #ns_log notice "--c add_msg returns '$_'" +} else { + + #ns_log notice "### chat.tcl mode <$mode> class <$class>" + #ns_log notice "--chat m=$m session_id=$s [clock format [lindex [split $s .] 1] -format %H:%M:%S] mode=$mode" + + $class create c1 -destroy_on_cleanup -chat_id $id -session_id $s -mode $mode + switch -- $m { + add_msg { + #ns_log notice "--c call c1 $m '$msg'" + ns_return 200 application/json [c1 $m $msg] + } + get_new { + ns_return 200 application/json [c1 $m] + } + login - + subscribe - + get_all { + set _ [c1 $m] + ns_return 200 text/html [subst {$_}] + } + default { + ns_log error "--c unknown method $m called." + } } - get_new { - ns_return 200 application/json [c1 $m] - ad_script_abort - } - login - - subscribe - - get_all {set _ [c1 $m]} - default {ns_log error "--c unknown method $m called."} } +ad_script_abort + #ns_log notice "--chat.tcl $m: returns '$_'" -ns_return 200 text/html [subst {$_}] - # Local variables: # mode: tcl # tcl-indent-level: 2