Return to lonchatfetch.pm CVS log

Up to [LON-CAPA] / loncom / interface

- pcl is the priv for chat (not pch); was reversed in lonchatfetch.pm from the
  beginning (rev 1.12).

    1: # The LearningOnline Network
    2: # Chat Fetching
    3: #
    4: # $Id: lonchatfetch.pm,v 1.38 2010/11/18 23:18:39 raeburn 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: use Apache::longroup;
   37: use Apache::lonlocal;
   38: use lib '/home/httpd/lib/perl/';
   39: use LONCAPA;
   40:  
   41: 
   42: sub handler {
   43:     my $r = shift;
   44: 
   45:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
   46: 					    ['lastid','group']);
   47:     my ($group,$grouptitle);
   48:     my $cnum=$env{'course.'.$env{'request.course.id'}.'.num'};
   49:     my $cdom=$env{'course.'.$env{'request.course.id'}.'.domain'};
   50:     if (defined($env{'form.group'})) {
   51:         $group = $env{'form.group'};
   52:         if ((! &Apache::lonnet::allowed('pgc',$env{'request.course.id'}.'/'.
   53: 				       $group)) &&
   54:            (! &Apache::lonnet::allowed('vcg',$env{'request.course.id'}.
   55:          ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
   56:             return HTTP_NOT_ACCEPTABLE;
   57:         }
   58:         my %curr_groups = &Apache::longroup::coursegroups($cdom,$cnum,$group);
   59:         if (%curr_groups) {
   60:             my %group_info = 
   61: 		&Apache::longroup::get_group_settings($curr_groups{$group});
   62:             $grouptitle = 
   63: 		'<b>'.&unescape($group_info{description}).
   64: 		'</b><br />';
   65:         }
   66:     } elsif (! &Apache::lonnet::allowed('plc',$env{'request.course.id'}.
   67:              ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:''))
   68:         ) {
   69:         return HTTP_NOT_ACCEPTABLE;
   70:     }
   71: 
   72:     &Apache::loncommon::content_type($r,'text/html');
   73:     $r->send_http_header;
   74:     return OK if $r->header_only;
   75: 
   76: # ------------------------------------------------------------ retrieve entries
   77: 
   78:     my $chome=$env{'course.'.$env{'request.course.id'}.'.home'};
   79: 
   80:     my @entries=split(/\:/,
   81:        &Apache::lonnet::reply(
   82:         "chatretr:$cdom:$cnum:$env{'user.domain'}:$env{'user.name'}:$group",
   83:         $chome));
   84: # Figure out what the last valid entry-id is
   85:     my ($lastid,$thentime,$idnum);
   86:     foreach my $entry (@entries) {
   87: 	$entry =~/^(\w+)/;
   88:         if ($1 ne 'active_participant') {
   89: 	    $lastid=$1;
   90:             ($thentime,$idnum)=split(/\_/,$lastid);
   91: 	}
   92:     }
   93: # ----------------------------------------------------------- Can see identity?
   94:     my $seeid = &get_seeid_status();
   95: # -------------------------------------------------------- see which ones apply
   96:     my $include=0;
   97:     my $header;
   98:     my $newstuff='';
   99:     my $bottomid='';
  100:     unless ($env{'form.lastid'}) { 
  101: 	$include=1; 
  102: 	$header = 
  103: 	    &Apache::loncommon::start_page(undef,undef,
  104: 					   {'only_body' => 1,
  105: 					    'bgcolor'   => '#FFFFFF',
  106: 					    'js_ready'  => 1,});
  107:     }
  108:     my @participants=();
  109:     foreach my $entry (@entries) {
  110: 	my ($id,$msg,$udom)=split(/\:/,&unescape($entry));
  111:  	if ($id eq 'active_participant') {
  112:            chomp($udom);
  113: 	   my $participant= &Apache::loncommon::nickname($msg,$udom);
  114: 	   unless ($participant=~/\w/) { $participant=$msg.':'.$udom; }
  115: 	   $participants[$#participants+1]=$participant;
  116: 	} elsif ($include) {
  117: 	    chomp($msg);
  118: 	    my ($msgtime,$msgnum)=split(/\_/,$id);
  119: 	    my ($sdom,$snum,$anon,$contrib)=split(/\:/,
  120: 					     &unescape($msg));
  121: 	    $contrib=&unescape($contrib);
  122: 	    &Apache::lonfeedback::newline_to_br(\$contrib);
  123: 	    ($contrib,my $errors)=&Apache::lontexconvert::msgtexconverted($contrib);
  124:             if ($errors) {
  125:                 $contrib.=' <span class="LC_error">'
  126:                          .&mt('(Message not fully displayed due to incorrect embedded TeX.)')
  127:                          .'</span>';
  128:             }
  129: 	    if ($errors && $snum eq $env{'user.name'} &&
  130: 		$sdom eq $env{'user.domain'} ) {
  131:                 $contrib.='<br /><span class="LC_error">'
  132:                          .&mt('TeX error message: [_1]',$errors)
  133:                          .'</span>';
  134: 	    }
  135: 	    $contrib=~s/\n/ /g;
  136: 	    $contrib=~s/\'/\&\#39\;/g;
  137: 	    my $sender='';
  138: 	    if ($seeid) {
  139: 		$sender=&Apache::loncommon::plainname($snum,$sdom);
  140: 		my $nick=&Apache::loncommon::nickname($snum,$sdom);
  141: 		if (($nick) && ($nick ne $sender)) {
  142: 		    $sender.=' '.$nick;
  143: 		}
  144: 		unless ($sender) { $sender=$snum.':'.$sdom; }
  145: 		if ($anon) { $sender.=' [Anon]' };
  146: 	    } elsif (!$anon) {
  147: 		$sender=&Apache::loncommon::nickname($snum,$sdom);
  148: 		unless ($sender) { $sender=$snum.':'.$sdom; }
  149: 	    } else {
  150: 		$sender=&Apache::loncommon::screenname($snum,$sdom);
  151: 		unless ($sender) { $sender=&mt("Anonymous"); }
  152: 	    }
  153: 	    $sender=~s/\'/\&\#39\;/g;
  154: 	    my $color=$sender;
  155: 	    $color=~tr/a-j/0-9/;
  156: 	    $color=~tr/A-J/0-9/;
  157: 	    $color=~tr/k-t/0-9/;
  158: 	    $color=~tr/K-T/0-9/;
  159: 	    $color=~tr/u-z/0-5/;
  160: 	    $color=~tr/U-Z/0-5/;
  161: 	    $color=~s/\D//g;
  162: 	    $color=substr($color,0,6);
  163: 	    my $timestamp=localtime($msgtime);
  164: 	    my ($mhour,$mmin,$msec)=($timestamp=~/(\d\d)\:(\d\d)\:(\d\d)/);
  165: 	    $newstuff.='<span style="color:#'.$color.'"><a name="LC_'.$id.'"></a><b>'.
  166: 		$sender.'</b> ('.$mhour.':'.$mmin.':'.$msec.'): '.
  167: 		$contrib."</span><br />";
  168: 	    $bottomid='LC_'.$id;
  169: 	} else {
  170: 	    $entry=~/^(\w+)/;
  171: 	    if ($1 eq $env{'form.lastid'}) { $include=1; }
  172: 	}
  173:     }
  174:     my $participant_output=join('<br />',sort @participants);
  175:     my $refresh_cmd = "/adm/chatfetch?lastid=$lastid";
  176:     if (defined($group)) {
  177:         $refresh_cmd .= "&amp;group=$group";
  178:     }
  179:     my $headarg;
  180:     my ($blocked,$blocktext) = blockstatus();
  181:     if ($blocked) {
  182:         $newstuff = $blocktext;
  183:         $headarg =  {'only_body' => 1,};
  184: 
  185: 	$r->print(<<ENDSCRIPT);
  186:           <script type="text/javascript">
  187:             parent.location.href="/adm/blockingstatus/?activity=chat"
  188:           </script>
  189: ENDSCRIPT
  190:     } else {
  191:         $headarg = {'redirect'  => [5,$refresh_cmd,1],
  192:                                     'only_body' => 1,};
  193:     }
  194:     my $start_page = &Apache::loncommon::start_page('Chat Room',undef,$headarg); 
  195:     my $end_page = &Apache::loncommon::end_page();
  196:     $r->print(<<ENDDOCUMENT);
  197: $start_page
  198: <script type="text/javascript">
  199: parent.chatout.document.writeln('$header$newstuff');
  200: parent.chatout.scroll(0,10000000);
  201: </script>
  202: $grouptitle
  203: $participant_output
  204: $end_page
  205: ENDDOCUMENT
  206:     return OK;
  207: }
  208: 
  209: sub get_seeid_status {
  210:     my $crs='/'.$env{'request.course.id'};
  211:     my $seeid;
  212:     if (exists($env{'form.group'})) {
  213:         $seeid = &Apache::lonnet::allowed('rci',$crs.'/'.$env{'form.group'});
  214:     } else {
  215:         if ($env{'request.course.sec'}) {
  216:             $crs.='_'.$env{'request.course.sec'};
  217:         }
  218:         $crs=~s/\_/\//g;
  219:         $seeid=&Apache::lonnet::allowed('rin',$crs);
  220:     }
  221:     return $seeid;
  222: }
  223: 
  224: sub blockstatus {
  225:     my ($blocked,$output);
  226:     my %setters;
  227:     my ($startblock,$endblock) = &Apache::loncommon::blockcheck(\%setters,'chat');
  228:     if ($startblock && $endblock) {
  229:         $blocked = 1;
  230:         my $endblocktime = &Apache::lonlocal::locallocaltime($endblock);
  231:         $output .= &mt('Chat Room will be unavailable to you until [_1] because communication is blocked in one or more of your courses:',$endblocktime).'<br /><br />';
  232:         foreach my $course (keys(%setters)) {
  233:             my %courseinfo=&Apache::lonnet::coursedescription($course);
  234:             for (my $i=0; $i<@{$setters{$course}{staff}}; $i++) {
  235:                 my ($uname,$udom) = @{$setters{$course}{staff}[$i]};
  236:                 my $fullname = &Apache::loncommon::plainname($uname,$udom);
  237:                 my ($openblock,$closeblock) = @{$setters{$course}{times}[$i]};
  238:                 $openblock = &Apache::lonlocal::locallocaltime($openblock);
  239:                 $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
  240:                 $output .= &mt('Block for [_1] starts: [_2], ends [_3], set by: [_4]<br />',$courseinfo{'description'},$openblock,$closeblock,$fullname);
  241:             }
  242:         }
  243:     }
  244:     return ($blocked,$output);
  245: }
  246: 
  247: 1;
  248: __END__