version 1.13, 2004/06/27 17:14:28
|
version 1.32, 2006/11/29 19:45:55
|
Line 33 use Apache::Constants qw(:common :http);
|
Line 33 use Apache::Constants qw(:common :http);
|
use Apache::lontexconvert; |
use Apache::lontexconvert; |
use Apache::loncommon; |
use Apache::loncommon; |
use Apache::lonnet; |
use Apache::lonnet; |
|
use Apache::longroup; |
|
use Apache::lonlocal; |
|
use lib '/home/httpd/lib/perl/'; |
|
use LONCAPA; |
|
|
|
|
sub handler { |
sub handler { |
my $r = shift; |
my $r = shift; |
|
|
if (! &Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:'')) |
['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)) && |
|
(! &Apache::lonnet::allowed('vcg',$env{'request.course.id'}. |
|
($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) { |
|
return HTTP_NOT_ACCEPTABLE; |
|
} |
|
my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum,$group); |
|
if (%curr_groups) { |
|
my %group_info = |
|
&Apache::longroup::get_group_settings($curr_groups{$group}); |
|
$grouptitle = |
|
'<b>'.&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; |
return HTTP_NOT_ACCEPTABLE; |
} |
} |
Line 47 sub handler {
|
Line 73 sub handler {
|
if ($loaderror) { return $loaderror; } |
if ($loaderror) { return $loaderror; } |
$loaderror= |
$loaderror= |
&Apache::lonnet::overloaderror($r, |
&Apache::lonnet::overloaderror($r, |
$ENV{'course.'.$ENV{'request.course.id'}.'.home'}); |
$env{'course.'.$env{'request.course.id'}.'.home'}); |
if ($loaderror) { return $loaderror; } |
if ($loaderror) { return $loaderror; } |
|
|
$r->content_type('text/html'); |
&Apache::loncommon::content_type($r,'text/html'); |
$r->send_http_header; |
$r->send_http_header; |
return OK if $r->header_only; |
return OK if $r->header_only; |
|
|
# ------------------------------------------------------------ retrieve entries |
# ------------------------------------------------------------ retrieve entries |
|
|
my $cnum=$ENV{'course.'.$ENV{'request.course.id'}.'.num'}; |
my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; |
my $cdom=$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; |
|
my $chome=$ENV{'course.'.$ENV{'request.course.id'}.'.home'}; |
|
|
|
my @entries=split(/\:/, |
my @entries=split(/\:/, |
&Apache::lonnet::reply( |
&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 |
# Figure out what the last valid entry-id is |
my ($lastid,$thentime,$idnum); |
my ($lastid,$thentime,$idnum); |
foreach (@entries) { |
foreach my $entry (@entries) { |
$_=~/^(\w+)/; |
$entry =~/^(\w+)/; |
if ($1 ne 'active_participant') { |
if ($1 ne 'active_participant') { |
$lastid=$1; |
$lastid=$1; |
($thentime,$idnum)=split(/\_/,$lastid); |
($thentime,$idnum)=split(/\_/,$lastid); |
} |
} |
} |
} |
# ----------------------------------------------------------- Can see identity? |
# ----------------------------------------------------------- Can see identity? |
my $crs='/'.$ENV{'request.course.id'}; |
my $seeid = &get_seeid_status(); |
if ($ENV{'request.course.sec'}) { |
|
$crs.='_'.$ENV{'request.course.sec'}; |
|
} |
|
$crs=~s/\_/\//g; |
|
my $seeid=&Apache::lonnet::allowed('rin',$crs); |
|
# -------------------------------------------------------- see which ones apply |
# -------------------------------------------------------- see which ones apply |
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid']); |
|
my $include=0; |
my $include=0; |
|
my $header; |
my $newstuff=''; |
my $newstuff=''; |
my $bottomid=''; |
my $bottomid=''; |
unless ($ENV{'form.lastid'}) { |
unless ($env{'form.lastid'}) { |
$include=1; |
$include=1; |
$newstuff='<html><body bgcolor="#FFFFFF">'; |
$header = |
|
&Apache::loncommon::start_page(undef,undef, |
|
{'only_body' => 1, |
|
'bgcolor' => '#FFFFFF', |
|
'js_ready' => 1,}); |
} |
} |
my @participants=(); |
my @participants=(); |
foreach (@entries) { |
foreach my $entry (@entries) { |
my ($id,$msg,$udom)=split(/\:/,&Apache::lonnet::unescape($_)); |
my ($id,$msg,$udom)=split(/\:/,&unescape($entry)); |
if ($id eq 'active_participant') { |
if ($id eq 'active_participant') { |
chomp($udom); |
chomp($udom); |
$participants[$#participants+1]= |
my $participant= &Apache::loncommon::nickname($msg,$udom); |
&Apache::loncommon::nickname($msg,$udom); |
unless ($participant=~/\w/) { $participant=$msg.':'.$udom; } |
|
$participants[$#participants+1]=$participant; |
} elsif ($include) { |
} elsif ($include) { |
chomp($msg); |
chomp($msg); |
my ($msgtime,$msgnum)=split(/\_/,$id); |
my ($msgtime,$msgnum)=split(/\_/,$id); |
my ($sdom,$snum,$anon,$contrib)=split(/\:/, |
my ($sdom,$snum,$anon,$contrib)=split(/\:/, |
&Apache::lonnet::unescape($msg)); |
&unescape($msg)); |
$contrib=&Apache::lonnet::unescape($contrib); |
$contrib=&unescape($contrib); |
$contrib=~s/\n/\<br \/\>/g; |
&Apache::lonfeedback::newline_to_br(\$contrib); |
($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); |
($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); |
if ($errors) { $contrib.="[Message not fully displayed due to incorrect embedded TeX]"; } |
if ($errors) { $contrib.=&mt('[Message not fully displayed due to incorrect embedded TeX]'); } |
if ($errors && $snum eq $ENV{'user.name'} && |
if ($errors && $snum eq $env{'user.name'} && |
$sdom eq $ENV{'user.domain'} ) { |
$sdom eq $env{'user.domain'} ) { |
$contrib.="<br />[TeX error message: $errors]"; |
$contrib.='<br />'.&mt('[TeX error message: [_1]',$errors); |
} |
} |
$contrib=~s/\n/ /g; |
$contrib=~s/\n/ /g; |
$contrib=~s/\'/\&\#39\;/g; |
$contrib=~s/\'/\&\#39\;/g; |
Line 117 sub handler {
|
Line 142 sub handler {
|
if (($nick) && ($nick ne $sender)) { |
if (($nick) && ($nick ne $sender)) { |
$sender.=' '.$nick; |
$sender.=' '.$nick; |
} |
} |
|
unless ($sender) { $sender=$snum.':'.$sdom; } |
if ($anon) { $sender.=' [Anon]' }; |
if ($anon) { $sender.=' [Anon]' }; |
} elsif (!$anon) { |
} elsif (!$anon) { |
$sender=&Apache::loncommon::nickname($snum,$sdom); |
$sender=&Apache::loncommon::nickname($snum,$sdom); |
|
unless ($sender) { $sender=$snum.':'.$sdom; } |
} else { |
} else { |
$sender=&Apache::loncommon::screenname($snum,$sdom); |
$sender=&Apache::loncommon::screenname($snum,$sdom); |
unless ($sender) { $sender="Anonymous"; } |
unless ($sender) { $sender=&mt("Anonymous"); } |
} |
} |
$sender=~s/\'/\&\#39\;/g; |
$sender=~s/\'/\&\#39\;/g; |
my $color=$sender; |
my $color=$sender; |
Line 136 sub handler {
|
Line 163 sub handler {
|
$color=substr($color,0,6); |
$color=substr($color,0,6); |
my $timestamp=localtime($msgtime); |
my $timestamp=localtime($msgtime); |
my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); |
my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); |
$newstuff.='<font color="#'.$color.'"><a name="'.$id.'"><b>'. |
$newstuff.='<font color="#'.$color.'"><a name="LC_'.$id.'"></a><b>'. |
$sender.'</b> ('.$mhour.':'.$mmin.':'.$msec.'): '. |
$sender.'</b> ('.$mhour.':'.$mmin.':'.$msec.'): '. |
$contrib."</font><br>"; |
$contrib."</font><br />"; |
$bottomid=$id; |
$bottomid='LC_'.$id; |
} else { |
} else { |
$_=~/^(\w+)/; |
$entry=~/^(\w+)/; |
if ($1 eq $ENV{'form.lastid'}) { $include=1; } |
if ($1 eq $env{'form.lastid'}) { $include=1; } |
} |
} |
} |
} |
my $participant_output=join('<br />',sort @participants); |
my $participant_output=join('<br />',sort @participants); |
|
my $refresh_cmd = "/adm/chatfetch?lastid=$lastid"; |
|
if (defined($group)) { |
|
$refresh_cmd .= "&group=$group"; |
|
} |
|
my $headarg; |
|
my ($blocked,$blocktext) = &blockstatus(); |
|
if ($blocked) { |
|
$newstuff = $blocktext; |
|
$headarg = {'only_body' => 1,}; |
|
} else { |
|
$headarg = {'redirect' => [5,$refresh_cmd,1], |
|
'only_body' => 1,}; |
|
} |
|
my $start_page = &Apache::loncommon::start_page('Chat',undef,$headarg); |
|
my $end_page = &Apache::loncommon::end_page(); |
$r->print(<<ENDDOCUMENT); |
$r->print(<<ENDDOCUMENT); |
<html> |
$start_page |
<head> |
<script type="text/javascript"> |
<title>The LearningOnline Network with CAPA</title> |
parent.chatout.document.writeln('$header$newstuff'); |
<meta HTTP-EQUIV="Refresh" CONTENT="5; url=/adm/chatfetch?lastid=$lastid"> |
|
</head> |
|
<body bgcolor="#FFFFFF"> |
|
<script> |
|
parent.chatout.document.writeln('$newstuff'); |
|
parent.chatout.scroll(0,10000000); |
parent.chatout.scroll(0,10000000); |
</script> |
</script> |
|
$grouptitle |
$participant_output |
$participant_output |
</body> |
$end_page |
</html> |
|
ENDDOCUMENT |
ENDDOCUMENT |
return OK; |
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; |
|
} |
|
|
|
sub blockstatus { |
|
my ($blocked,$output); |
|
my %setters; |
|
my ($startblock,$endblock) = &Apache::loncommon::blockcheck(\%setters,'chat'); |
|
if ($startblock && $endblock) { |
|
$blocked = 1; |
|
my $endblocktime = &Apache::lonlocal::locallocaltime($endblock); |
|
$output .= &mt('Chat will be unavailable to you until [_1] because communication is blocked in one or more of your courses: <br/><br />',$endblocktime); |
|
foreach my $course (keys(%setters)) { |
|
my %courseinfo=&Apache::lonnet::coursedescription($course); |
|
for (my $i=0; $i<@{$setters{$course}{staff}}; $i++) { |
|
my ($uname,$udom) = @{$setters{$course}{staff}[$i]}; |
|
my $fullname = &Apache::loncommon::plainname($uname,$udom); |
|
my ($openblock,$closeblock) = @{$setters{$course}{times}[$i]}; |
|
$openblock = &Apache::lonlocal::locallocaltime($openblock); |
|
$closeblock= &Apache::lonlocal::locallocaltime($closeblock); |
|
$output .= &mt('Block for [_1] starts: [_2], ends [_3], set by: [_4]<br />',$courseinfo{'description'},$openblock,$closeblock,$fullname); |
|
} |
|
} |
|
} |
|
return ($blocked,$output); |
|
} |
|
|
1; |
1; |
__END__ |
__END__ |