# The LearningOnline Network # Chat Fetching # # $Id: lonchatfetch.pm,v 1.32 2006/11/29 19:45:55 raeburn 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; use Apache::longroup; use Apache::lonlocal; use lib '/home/httpd/lib/perl/'; use LONCAPA; sub handler { my $r = shift; &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)) && (! &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 = ''.&unescape($group_info{description}). '
'; } } elsif (! &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; } &Apache::loncommon::content_type($r,'text/html'); $r->send_http_header; return OK if $r->header_only; # ------------------------------------------------------------ retrieve entries my $chome=$env{'course.'.$env{'request.course.id'}.'.home'}; my @entries=split(/\:/, &Apache::lonnet::reply( "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 my $entry (@entries) { $entry =~/^(\w+)/; if ($1 ne 'active_participant') { $lastid=$1; ($thentime,$idnum)=split(/\_/,$lastid); } } # ----------------------------------------------------------- Can see identity? my $seeid = &get_seeid_status(); # -------------------------------------------------------- see which ones apply my $include=0; my $header; my $newstuff=''; my $bottomid=''; unless ($env{'form.lastid'}) { $include=1; $header = &Apache::loncommon::start_page(undef,undef, {'only_body' => 1, 'bgcolor' => '#FFFFFF', 'js_ready' => 1,}); } my @participants=(); foreach my $entry (@entries) { my ($id,$msg,$udom)=split(/\:/,&unescape($entry)); 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(/\:/, &unescape($msg)); $contrib=&unescape($contrib); &Apache::lonfeedback::newline_to_br(\$contrib); ($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib); if ($errors) { $contrib.=&mt('[Message not fully displayed due to incorrect embedded TeX]'); } if ($errors && $snum eq $env{'user.name'} && $sdom eq $env{'user.domain'} ) { $contrib.='
'.&mt('[TeX error message: [_1]',$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=&mt("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.=''. $sender.' ('.$mhour.':'.$mmin.':'.$msec.'): '. $contrib."
"; $bottomid='LC_'.$id; } else { $entry=~/^(\w+)/; if ($1 eq $env{'form.lastid'}) { $include=1; } } } my $participant_output=join('
',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(< parent.chatout.document.writeln('$header$newstuff'); parent.chatout.scroll(0,10000000); $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; } 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:

',$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]
',$courseinfo{'description'},$openblock,$closeblock,$fullname); } } } return ($blocked,$output); } 1; __END__