loncom/interface/lonchatfetch.pm - view

File: [LON-CAPA] / loncom / interface / lonchatfetch.pm
Revision 1.14: download - view: text, annotated - select for diffs
Sun Jun 27 17:36:57 2004 UTC (20 years, 10 months ago) by www
Branches: MAIN
CVS tags: version_1_3_X, version_1_3_3, version_1_3_2, version_1_3_1, version_1_3_0, version_1_2_X, version_1_2_99_1, version_1_2_99_0, version_1_2_1, version_1_2_0, version_1_1_99_5, version_1_1_99_4, version_1_1_99_3, version_1_1_99_2, version_1_1_99_1, HEAD

Bug #3086: show username in CHAT for nameless folks

# The LearningOnline Network # Chat Fetching # # $Id: lonchatfetch.pm,v 1.14 2004/06/27 17:36:57 www Exp $ # # 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::lonchatfetch; use strict; use Apache::Constants qw(:common :http); use Apache::lontexconvert; use Apache::loncommon; use Apache::lonnet; sub handler { my $r = shift; if (! &Apache::lonnet::allowed('pch',$ENV{'request.course.id'}. ($ENV{'request.course.sec'}?'/'.$ENV{'request.course.sec'}:'')) ) { return HTTP_NOT_ACCEPTABLE; } my $loaderror=&Apache::lonnet::overloaderror($r); if ($loaderror) { return $loaderror; } $loaderror= &Apache::lonnet::overloaderror($r, $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); if ($loaderror) { return $loaderror; } $r->content_type('text/html'); $r->send_http_header; return OK if $r->header_only; # ------------------------------------------------------------ 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)); # Figure out what the last valid entry-id is my ($lastid,$thentime,$idnum); foreach (@entries) { $_=~/^(\w+)/; if ($1 ne 'active_participant') { $lastid=$1; ($thentime,$idnum)=split(/\_/,$lastid); } } # ----------------------------------------------------------- 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); # -------------------------------------------------------- see which ones apply &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid']); my $include=0; my $newstuff=''; my $bottomid=''; unless ($ENV{'form.lastid'}) { $include=1; $newstuff='<html><body bgcolor="#FFFFFF">'; } my @participants=(); foreach (@entries) { my ($id,$msg,$udom)=split(/\:/,&Apache::lonnet::unescape($_)); if ($id eq 'active_participant') { chomp($udom); my $participant= &Apache::loncommon::nickname($msg,$udom); unless ($participant=~/\w/) { $participant=$msg.'@'.$udom; } $participants[$#participants+1]=$participant; } elsif ($include) { chomp($msg); my ($msgtime,$msgnum)=split(/\_/,$id); my ($sdom,$snum,$anon,$contrib)=split(/\:/, &Apache::lonnet::unescape($msg)); $contrib=&Apache::lonnet::unescape($contrib); $contrib=~s/\n/\<br \/\>/g; ($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); if ($errors) { $contrib.="[Message not fully displayed due to incorrect embedded TeX]"; } if ($errors && $snum eq $ENV{'user.name'} && $sdom eq $ENV{'user.domain'} ) { $contrib.="<br />[TeX error message: $errors]"; } $contrib=~s/\n/ /g; $contrib=~s/\'/\&\#39\;/g; my $sender=''; if ($seeid) { $sender=&Apache::loncommon::plainname($snum,$sdom); my $nick=&Apache::loncommon::nickname($snum,$sdom); if (($nick) && ($nick ne $sender)) { $sender.=' '.$nick; } unless ($sender) { $sender=$snum.'@'.$sdom; } if ($anon) { $sender.=' [Anon]' }; } elsif (!$anon) { $sender=&Apache::loncommon::nickname($snum,$sdom); unless ($sender) { $sender=$snum.'@'.$sdom; } } else { $sender=&Apache::loncommon::screenname($snum,$sdom); unless ($sender) { $sender="Anonymous"; } } $sender=~s/\'/\&\#39\;/g; my $color=$sender; $color=~tr/a-j/0-9/; $color=~tr/A-J/0-9/; $color=~tr/k-t/0-9/; $color=~tr/K-T/0-9/; $color=~tr/u-z/0-5/; $color=~tr/U-Z/0-5/; $color=~s/\D//g; $color=substr($color,0,6); my $timestamp=localtime($msgtime); my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); $newstuff.='<font color="#'.$color.'"><a name="'.$id.'"><b>'. $sender.'</b> ('.$mhour.':'.$mmin.':'.$msec.'): '. $contrib."</font><br>"; $bottomid=$id; } else { $_=~/^(\w+)/; if ($1 eq $ENV{'form.lastid'}) { $include=1; } } } my $participant_output=join('<br />',sort @participants); $r->print(<<ENDDOCUMENT); <html> <head> <title>The LearningOnline Network with CAPA</title> <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); </script> $participant_output </body> </html> ENDDOCUMENT return OK; } 1; __END__