loncom/interface/lonchatfetch.pm - view

File: [LON-CAPA] / loncom / interface / lonchatfetch.pm
Revision 1.17: download - view: text, annotated - select for diffs
Thu Apr 7 06:56:22 2005 UTC (19 years, 2 months ago) by albertel
Branches: MAIN
CVS tags: version_1_99_1_tmcc, version_1_99_0_tmcc, HEAD

- ENV -> env

1: # The LearningOnline Network 2: # Chat Fetching 3: # 4: # $Id: lonchatfetch.pm,v 1.17 2005/04/07 06:56:22 albertel Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonchatfetch; 30: 31: use strict; 32: use Apache::Constants qw(:common :http); 33: use Apache::lontexconvert; 34: use Apache::loncommon; 35: use Apache::lonnet; 36: 37: sub handler { 38: my $r = shift; 39: 40: if (! &Apache::lonnet::allowed('pch',$env{'request.course.id'}. 41: ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')) 42: ) { 43: return HTTP_NOT_ACCEPTABLE; 44: } 45: 46: my $loaderror=&Apache::lonnet::overloaderror($r); 47: if ($loaderror) { return $loaderror; } 48: $loaderror= 49: &Apache::lonnet::overloaderror($r, 50: $env{'course.'.$env{'request.course.id'}.'.home'}); 51: if ($loaderror) { return $loaderror; } 52: 53: &Apache::loncommon::content_type($r,'text/html'); 54: $r->send_http_header; 55: return OK if $r->header_only; 56: 57: # ------------------------------------------------------------ retrieve entries 58: 59: my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'}; 60: my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'}; 61: my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; 62: 63: my @entries=split(/\:/, 64: &Apache::lonnet::reply( 65: "chatretr:$cdom:$cnum:$env{'user.domain'}:$env{'user.name'}",$chome)); 66: # Figure out what the last valid entry-id is 67: my ($lastid,$thentime,$idnum); 68: foreach (@entries) { 69: $_=~/^(\w+)/; 70: if ($1 ne 'active_participant') { 71: $lastid=$1; 72: ($thentime,$idnum)=split(/\_/,$lastid); 73: } 74: } 75: # ----------------------------------------------------------- Can see identity? 76: my $crs='/'.$env{'request.course.id'}; 77: if ($env{'request.course.sec'}) { 78: $crs.='_'.$env{'request.course.sec'}; 79: } 80: $crs=~s/\_/\//g; 81: my $seeid=&Apache::lonnet::allowed('rin',$crs); 82: # -------------------------------------------------------- see which ones apply 83: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['lastid']); 84: my $include=0; 85: my $newstuff=''; 86: my $bottomid=''; 87: unless ($env{'form.lastid'}) { 88: $include=1; 89: my $html=&Apache::lonxml::xmlbegin(); 90: $newstuff=$html.'<head></head><body bgcolor="#FFFFFF">'; 91: } 92: my @participants=(); 93: foreach (@entries) { 94: my ($id,$msg,$udom)=split(/\:/,&Apache::lonnet::unescape($_)); 95: if ($id eq 'active_participant') { 96: chomp($udom); 97: my $participant= &Apache::loncommon::nickname($msg,$udom); 98: unless ($participant=~/\w/) { $participant=$msg.'@'.$udom; } 99: $participants[$#participants+1]=$participant; 100: } elsif ($include) { 101: chomp($msg); 102: my ($msgtime,$msgnum)=split(/\_/,$id); 103: my ($sdom,$snum,$anon,$contrib)=split(/\:/, 104: &Apache::lonnet::unescape($msg)); 105: $contrib=&Apache::lonnet::unescape($contrib); 106: $contrib=~s/\n/\<br \/\>/g; 107: ($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); 108: if ($errors) { $contrib.="[Message not fully displayed due to incorrect embedded TeX]"; } 109: if ($errors && $snum eq $env{'user.name'} && 110: $sdom eq $env{'user.domain'} ) { 111: $contrib.="<br />[TeX error message: $errors]"; 112: } 113: $contrib=~s/\n/ /g; 114: $contrib=~s/\'/\&\#39\;/g; 115: my $sender=''; 116: if ($seeid) { 117: $sender=&Apache::loncommon::plainname($snum,$sdom); 118: my $nick=&Apache::loncommon::nickname($snum,$sdom); 119: if (($nick) && ($nick ne $sender)) { 120: $sender.=' '.$nick; 121: } 122: unless ($sender) { $sender=$snum.'@'.$sdom; } 123: if ($anon) { $sender.=' [Anon]' }; 124: } elsif (!$anon) { 125: $sender=&Apache::loncommon::nickname($snum,$sdom); 126: unless ($sender) { $sender=$snum.'@'.$sdom; } 127: } else { 128: $sender=&Apache::loncommon::screenname($snum,$sdom); 129: unless ($sender) { $sender="Anonymous"; } 130: } 131: $sender=~s/\'/\&\#39\;/g; 132: my $color=$sender; 133: $color=~tr/a-j/0-9/; 134: $color=~tr/A-J/0-9/; 135: $color=~tr/k-t/0-9/; 136: $color=~tr/K-T/0-9/; 137: $color=~tr/u-z/0-5/; 138: $color=~tr/U-Z/0-5/; 139: $color=~s/\D//g; 140: $color=substr($color,0,6); 141: my $timestamp=localtime($msgtime); 142: my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/); 143: $newstuff.='<font color="#'.$color.'"><a name="'.$id.'"><b>'. 144: $sender.'</b> ('.$mhour.':'.$mmin.':'.$msec.'): '. 145: $contrib."</font><br>"; 146: $bottomid=$id; 147: } else { 148: $_=~/^(\w+)/; 149: if ($1 eq $env{'form.lastid'}) { $include=1; } 150: } 151: } 152: my $participant_output=join('<br />',sort @participants); 153: my $html=&Apache::lonxml::xmlbegin(); 154: $r->print(<<ENDDOCUMENT); 155: $html 156: <head> 157: <title>The LearningOnline Network with CAPA</title> 158: <meta HTTP-EQUIV="Refresh" CONTENT="5; url=/adm/chatfetch?lastid=$lastid"> 159: </head> 160: <body bgcolor="#FFFFFF"> 161: <script> 162: parent.chatout.document.writeln('$newstuff'); 163: parent.chatout.scroll(0,10000000); 164: </script> 165: $participant_output 166: </body> 167: </html> 168: ENDDOCUMENT 169: return OK; 170: } 171: 172: 1; 173: __END__