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.1 -r1.2 --- openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl 8 Apr 2006 00:05:49 -0000 1.1 +++ openacs-4/packages/xotcl-core/tcl/bgdelivery-procs.tcl 9 Apr 2006 00:09:51 -0000 1.2 @@ -36,7 +36,7 @@ set ::subscription_count 0 set ::message_count 0 - ::xotcl::Class Subscriber -parameter {key channel user_id} + ::xotcl::Class Subscriber -parameter {key channel user_id mode} Subscriber proc current {-key } { my instvar subscriptions set result [list] @@ -50,15 +50,22 @@ } } } - Subscriber proc send {key msg} { + + Subscriber proc broadcast {key msg} { my instvar subscriptions - ns_log notice "-- [self] send $key $msg subs='[array names subscriptions]' vars=[my info vars]" if {[info exists subscriptions($key)]} { set subs1 [list] foreach s $subscriptions($key) { if {[catch { - ns_log notice "-- sending to subscriber for $key $msg ch=[$s channel]" - puts [$s channel] $msg + if {[$s mode] eq "scripted"} { + set smsg "\n" + } else { + set smsg $msg + } + my log "-- sending to subscriber for $key $smsg ch=[$s channel] \ + mode=[$s mode], user_id [$s user_id]" + puts -nonewline [$s channel] $smsg flush [$s channel] } errmsg]} { ns_log notice "error in send to subscriber (key=$key): $errmsg" @@ -75,7 +82,7 @@ Subscriber instproc init {} { [my info class] instvar subscriptions lappend subscriptions([my key]) [self] - ns_log notice "-- Subscriber init, cl=[my info class], subscriptions([my key]) = $subscriptions([my key])" + #my log "-- cl=[my info class], subscriptions([my key]) = $subscriptions([my key])" fconfigure [my channel] -translation binary incr ::subscription_count } @@ -127,13 +134,15 @@ } ##################################### -bgdelivery proc subscribe {key {initmsg ""}} { - my write_headers 200 text/plain 100000 - ns_write $initmsg +bgdelivery proc subscribe {key {initmsg ""} {mode default} } { + set content_type [expr {$mode eq "scripted" ? "text/html" : "text/plain"}] + ns_write "HTTP/1.0 200 OK\r\nContent-type: $content_type\r\n\r\n[string repeat { } 1024]" set ch [ns_conn channel] thread::transfer [my get_tid] $ch - my do -async ::Subscriber new -channel $ch -key $key -user_id [ad_conn user_id] + my do -async ::Subscriber new -channel $ch -key $key -user_id [ad_conn user_id] -mode $mode + my send_to_subscriber $key $initmsg } + bgdelivery proc send_to_subscriber {key msg} { - my do -async ::Subscriber send $key $msg + my do -async ::Subscriber broadcast $key $msg } \ No newline at end of file Index: openacs-4/packages/xotcl-core/tcl/chat-procs.tcl =================================================================== RCS file: /usr/local/cvsroot/openacs-4/packages/xotcl-core/tcl/Attic/chat-procs.tcl,v diff -u -r1.9 -r1.10 --- openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 8 Apr 2006 00:05:49 -0000 1.9 +++ openacs-4/packages/xotcl-core/tcl/chat-procs.tcl 9 Apr 2006 00:09:51 -0000 1.10 @@ -9,7 +9,7 @@ namespace eval ::xo { Class Message -parameter {time user_id msg color} Class Chat -superclass ::xo::OrderedComposite \ - -parameter {chat_id user_id session_id + -parameter {chat_id user_id session_id {mode default} {encoder urlencode} {timewindow 600} {sweepinterval 600} } @@ -237,6 +237,14 @@ }] } + Chat instproc js_encode_msg {msg} { + set json [my json_encode_msg $msg] + return "\n" + } + Chat instproc broadcast_msg {msg} { bgdelivery send_to_subscriber chat-[my chat_id] [my json_encode_msg $msg] } @@ -247,7 +255,7 @@ bgdelivery subscribe chat-[my chat_id] [my json_encode_msg \ [Message new -volatile -time [clock seconds] \ -user_id $user_id -color $color \ - -msg [_ xotcl-core.has_entered_the_room] ]] + -msg [_ xotcl-core.has_entered_the_room] ]] [my mode] } Chat instproc render {} {