[LON-CAPA-cvs] cvs: loncom / loncapa_apache.conf lond /interface lonchat.pm lonchatfetch.pm longroupchat.pm /lonnet/perl lonnet.pm
raeburn
lon-capa-cvs@mail.lon-capa.org
Wed, 29 Mar 2006 19:56:40 -0000
This is a MIME encoded message
--raeburn1143662200
Content-Type: text/plain
raeburn Wed Mar 29 14:56:40 2006 EDT
Added files:
/loncom/interface longroupchat.pm
Modified files:
/loncom lond loncapa_apache.conf
/loncom/interface lonchatfetch.pm lonchat.pm
/loncom/lonnet/perl lonnet.pm
Log:
Course groups have chat with access restricted to group members hwo have group chat privilege for the group.
--raeburn1143662200
Content-Type: text/plain
Content-Disposition: attachment; filename="raeburn-20060329145640.txt"
Index: loncom/lond
diff -u loncom/lond:1.323 loncom/lond:1.324
--- loncom/lond:1.323 Fri Mar 3 19:59:59 2006
+++ loncom/lond Wed Mar 29 14:56:10 2006
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.323 2006/03/04 00:59:59 albertel Exp $
+# $Id: lond,v 1.324 2006/03/29 19:56:10 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -61,7 +61,7 @@
my $lastlog='';
my $lond_max_wait_time = 13;
-my $VERSION='$Revision: 1.323 $'; #' stupid emacs
+my $VERSION='$Revision: 1.324 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid="default";
my $currentdomainid;
@@ -3240,15 +3240,17 @@
®ister_handler("restore", \&restore_handler, 0,1,0);
#
-# Add a chat message to to a discussion board.
+# Add a chat message to a synchronous discussion board.
#
# Parameters:
# $cmd - Request keyword.
# $tail - Tail of the command. A colon separated list
# containing:
# cdom - Domain on which the chat board lives
-# cnum - Identifier of the discussion group.
-# post - Body of the posting.
+# cnum - Course containing the chat board.
+# newpost - Body of the posting.
+# group - Optional group, if chat board is only
+# accessible in a group within the course
# $client - Socket open on the client.
# Returns:
# 1 - Indicating caller should keep on processing.
@@ -3263,8 +3265,8 @@
my $userinput = "$cmd:$tail";
- my ($cdom,$cnum,$newpost)=split(/\:/,$tail);
- &chat_add($cdom,$cnum,$newpost);
+ my ($cdom,$cnum,$newpost,$group)=split(/\:/,$tail);
+ &chat_add($cdom,$cnum,$newpost,$group);
&Reply($client, "ok\n", $userinput);
return 1;
@@ -3272,7 +3274,7 @@
®ister_handler("chatsend", \&send_chat_handler, 0, 1, 0);
#
-# Retrieve the set of chat messagss from a discussion board.
+# Retrieve the set of chat messages from a discussion board.
#
# Parameters:
# $cmd - Command keyword that initiated the request.
@@ -3282,6 +3284,8 @@
# chat id - Discussion thread(?)
# domain/user - Authentication domain and username
# of the requesting person.
+# group - Optional course group containing
+# the board.
# $client - Socket open on the client program.
# Returns:
# 1 - continue processing
@@ -3294,9 +3298,9 @@
my $userinput = "$cmd:$tail";
- my ($cdom,$cnum,$udom,$uname)=split(/\:/,$tail);
+ my ($cdom,$cnum,$udom,$uname,$group)=split(/\:/,$tail);
my $reply='';
- foreach (&get_chat($cdom,$cnum,$udom,$uname)) {
+ foreach (&get_chat($cdom,$cnum,$udom,$uname,$group)) {
$reply.=&escape($_).':';
}
$reply=~s/\:$//;
@@ -5875,10 +5879,16 @@
}
sub get_chat {
- my ($cdom,$cname,$udom,$uname)=@_;
+ my ($cdom,$cname,$udom,$uname,$group)=@_;
my @entries=();
- my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
+ my $namespace = 'nohist_chatroom';
+ my $namespace_inroom = 'nohist_inchatroom';
+ if (defined($group)) {
+ $namespace .= '_'.$group;
+ $namespace_inroom .= '_'.$group;
+ }
+ my $hashref = &tie_user_hash($cdom, $cname, $namespace,
&GDBM_READER());
if ($hashref) {
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
@@ -5886,7 +5896,7 @@
}
my @participants=();
my $cutoff=time-60;
- $hashref = &tie_user_hash($cdom, $cname, 'nohist_inchatroom',
+ $hashref = &tie_user_hash($cdom, $cname, $namespace_inroom,
&GDBM_WRCREAT());
if ($hashref) {
$hashref->{$uname.':'.$udom}=time;
@@ -5901,10 +5911,16 @@
}
sub chat_add {
- my ($cdom,$cname,$newchat)=@_;
+ my ($cdom,$cname,$newchat,$group)=@_;
my @entries=();
my $time=time;
- my $hashref = &tie_user_hash($cdom, $cname, 'nohist_chatroom',
+ my $namespace = 'nohist_chatroom';
+ my $logfile = 'chatroom.log';
+ if (defined($group)) {
+ $namespace .= '_'.$group;
+ $logfile = 'chatroom_'.$group.'.log';
+ }
+ my $hashref = &tie_user_hash($cdom, $cname, $namespace,
&GDBM_WRCREAT());
if ($hashref) {
@entries=map { $_.':'.$hashref->{$_} } sort(keys(%$hashref));
@@ -5927,7 +5943,7 @@
}
{
my $proname=&propath($cdom,$cname);
- if (open(CHATLOG,">>$proname/chatroom.log")) {
+ if (open(CHATLOG,">>$proname/$logfile")) {
print CHATLOG ("$time:".&unescape($newchat)."\n");
}
close(CHATLOG);
Index: loncom/loncapa_apache.conf
diff -u loncom/loncapa_apache.conf:1.123 loncom/loncapa_apache.conf:1.124
--- loncom/loncapa_apache.conf:1.123 Wed Mar 29 13:08:40 2006
+++ loncom/loncapa_apache.conf Wed Mar 29 14:56:11 2006
@@ -1,7 +1,7 @@
##
## loncapa_apache.conf -- Apache HTTP LON-CAPA configuration file
##
-## $Id: loncapa_apache.conf,v 1.123 2006/03/29 18:08:40 raeburn Exp $
+## $Id: loncapa_apache.conf,v 1.124 2006/03/29 19:56:11 raeburn Exp $
##
#
@@ -814,6 +814,14 @@
ErrorDocument 500 /adm/errorhandler
</Location>
+<Location /adm/groupchat>
+PerlAccessHandler Apache::lonacc
+SetHandler perl-script
+PerlHandler Apache::longroupchat
+ErrorDocument 403 /adm/login
+ErrorDocument 500 /adm/errorhandler
+</Location>
+
<Location /adm/evaluate>
PerlAccessHandler Apache::lonacc
SetHandler perl-script
Index: loncom/interface/lonchatfetch.pm
diff -u loncom/interface/lonchatfetch.pm:1.20 loncom/interface/lonchatfetch.pm:1.21
--- loncom/interface/lonchatfetch.pm:1.20 Thu Mar 23 17:32:10 2006
+++ loncom/interface/lonchatfetch.pm Wed Mar 29 14:56:28 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Chat Fetching
#
-# $Id: lonchatfetch.pm,v 1.20 2006/03/23 22:32:10 albertel Exp $
+# $Id: lonchatfetch.pm,v 1.21 2006/03/29 19:56:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -37,7 +37,27 @@
sub handler {
my $r = shift;
- if (! &Apache::lonnet::allowed('pch',$env{'request.course.id'}.
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid',
+ 'group']);
+ my ($group,$grouptitle);
+ my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
+ my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
+ if (defined($env{'form.group'})) {
+ $group = $env{'form.group'};
+ if (! &Apache::lonnet::allowed('pgc',$env{'request.course.id'}.'/'.
+ $group) ) {
+ return HTTP_NOT_ACCEPTABLE;
+ }
+ my %curr_groups;
+ my $numgroups = &Apache::loncommon::coursegroups(\%curr_groups,$cdom,
+ $cnum,$group);
+ if ($numgroups) {
+ my %group_info = &Apache::loncommon::get_group_settings(
+ $curr_groups{$group});
+ $grouptitle = '<b>'.&Apache::lonnet::unescape(
+ $group_info{description}).'</b><br />';
+ }
+ } elsif (! &Apache::lonnet::allowed('pch',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))
) {
return HTTP_NOT_ACCEPTABLE;
@@ -56,13 +76,12 @@
# ------------------------------------------------------------ retrieve entries
- my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
- my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $chome=$env{'course.'.$env{'request.course.id'}.'.home'};
my @entries=split(/\:/,
&Apache::lonnet::reply(
- "chatretr:$cdom:$cnum:$env{'user.domain'}:$env{'user.name'}",$chome));
+ "chatretr:$cdom:$cnum:$env{'user.domain'}:$env{'user.name'}:$group",
+ $chome));
# Figure out what the last valid entry-id is
my ($lastid,$thentime,$idnum);
foreach (@entries) {
@@ -73,14 +92,8 @@
}
}
# ----------------------------------------------------------- Can see identity?
- my $crs='/'.$env{'request.course.id'};
- if ($env{'request.course.sec'}) {
- $crs.='_'.$env{'request.course.sec'};
- }
- $crs=~s/\_/\//g;
- my $seeid=&Apache::lonnet::allowed('rin',$crs);
+ my $seeid = &get_seeid_status();
# -------------------------------------------------------- see which ones apply
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid']);
my $include=0;
my $newstuff='';
my $bottomid='';
@@ -153,9 +166,13 @@
}
}
my $participant_output=join('<br />',sort @participants);
+ my $refresh_cmd = "/adm/chatfetch?lastid=$lastid";
+ if (defined($group)) {
+ $refresh_cmd .= "&group=$group";
+ }
my $start_page =
&Apache::loncommon::start_page('Chat',undef,
- {'redirect' => [5,"/adm/chatfetch?lastid=$lastid"],
+ {'redirect' => [5,$refresh_cmd],
'only_body' => 1,});
my $end_page = &Apache::loncommon::end_page();
$r->print(<<ENDDOCUMENT);
@@ -164,11 +181,27 @@
parent.chatout.document.writeln('$newstuff');
parent.chatout.scroll(0,10000000);
</script>
+$grouptitle
$participant_output
$end_page
ENDDOCUMENT
return OK;
-}
+}
+
+sub get_seeid_status{
+ my $crs='/'.$env{'request.course.id'};
+ my $seeid;
+ if (exists($env{'form.group'})) {
+ $seeid = &Apache::lonnet::allowed('rci',$crs.'/'.$env{'form.group'});
+ } else {
+ if ($env{'request.course.sec'}) {
+ $crs.='_'.$env{'request.course.sec'};
+ }
+ $crs=~s/\_/\//g;
+ $seeid=&Apache::lonnet::allowed('rin',$crs);
+ }
+ return $seeid;
+}
1;
__END__
Index: loncom/interface/lonchat.pm
diff -u loncom/interface/lonchat.pm:1.11 loncom/interface/lonchat.pm:1.12
--- loncom/interface/lonchat.pm:1.11 Sun Mar 19 17:48:53 2006
+++ loncom/interface/lonchat.pm Wed Mar 29 14:56:28 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Chat
#
-# $Id: lonchat.pm,v 1.11 2006/03/19 22:48:53 albertel Exp $
+# $Id: lonchat.pm,v 1.12 2006/03/29 19:56:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -38,14 +38,26 @@
&Apache::loncommon::content_type($r,'text/html');
$r->send_http_header;
return OK if $r->header_only;
- if (! &Apache::lonnet::allowed('plc',$env{'request.course.id'}.
+
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['group']);
+ my ($group,$group_elem);
+ if (defined($env{'form.group'})) {
+ $group = $env{'form.group'};
+ $group_elem = '<input type="hidden" name="group" value="'.$group.'" />';
+ if (! &Apache::lonnet::allowed('pgc',$env{'request.course.id'}.'/'.
+ $group) ) {
+ return HTTP_NOT_ACCEPTABLE;
+ }
+ } else {
+ if (! &Apache::lonnet::allowed('plc',$env{'request.course.id'}.
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')
)) {
- return HTTP_NOT_ACCEPTABLE;
+ return HTTP_NOT_ACCEPTABLE;
+ }
}
if ($env{'form.newchat'}) {
- &Apache::lonnet::chatsend(&Apache::lonfeedback::clear_out_html($env{'form.newchat'}),$env{'form.anonymous'});
+ &Apache::lonnet::chatsend(&Apache::lonfeedback::clear_out_html($env{'form.newchat'}),$env{'form.anonymous'},$group);
}
# --------------------------------------------------- Print login screen header
my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
@@ -62,6 +74,7 @@
<input type="text" size="60" name="newchat">
<input value="Post Anonymous" name="anonymous" type="submit">
<input value="Post" name="newentry" type="submit">
+$group_elem
</form>
$end_page
ENDDOCUMENT
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.723 loncom/lonnet/perl/lonnet.pm:1.724
--- loncom/lonnet/perl/lonnet.pm:1.723 Mon Mar 27 18:43:43 2006
+++ loncom/lonnet/perl/lonnet.pm Wed Mar 29 14:56:36 2006
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.723 2006/03/27 23:43:43 banghart Exp $
+# $Id: lonnet.pm,v 1.724 2006/03/29 19:56:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1004,13 +1004,13 @@
# -------------------------------------------------------------------- New chat
sub chatsend {
- my ($newentry,$anon)=@_;
+ my ($newentry,$anon,$group)=@_;
my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my $chome=$env{'course.'.$env{'request.course.id'}.'.home'};
&reply('chatsend:'.$cdom.':'.$cnum.':'.
&escape($env{'user.domain'}.':'.$env{'user.name'}.':'.$anon.':'.
- &escape($newentry)),$chome);
+ &escape($newentry)).':'.$group,$chome);
}
# ------------------------------------------ Find current version of a resource
Index: loncom/interface/longroupchat.pm
+++ loncom/interface/longroupchat.pm
# The LearningOnline Network
# "Group Chat Frame" Personal Information
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
package Apache::longroupchat;
use strict;
use Apache::lonnet;
use Apache::loncommon;
use Apache::lonlocal;
sub handler {
my $r = shift;
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['group']);
my $group = $env{'form.group'};
my $grouptitle;
if (defined($group)) {
my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
my %curr_groups;
my $numgroups = &Apache::loncommon::coursegroups(\%curr_groups,$cdom,
$cnum,$group);
if ($numgroups) {
my %group_info = &Apache::loncommon::get_group_settings(
$curr_groups{$group});
$grouptitle = &mt('Group Chat:').' '.&Apache::lonnet::unescape(
$group_info{description});
}
}
$r->print(<<"END");
<html>
<head>
<title>$grouptitle</title>
</head>
<frameset border="0" rows="80,100,*">
<frame name="chatacc" src="/adm/chatfetch?group=$group">
<frame name="chatpost" src="/adm/chat?group=$group">
<frame name="chatout" src="/adm/rat/empty.html">
</frameset>
</html>
END
}
1;
--raeburn1143662200--