File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.157: download - view: text, annotated - select for diffs
Mon Nov 28 18:32:39 2005 UTC (18 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Bug 4333. Include course context in display of folder contents in COM. Can sort by course (description, NOT courseID).  Currently implemented for all folders. Could be restricted to just INBOX, as per bug request.

    1: # The LearningOnline Network with CAPA
    2: # Routines for messaging
    3: #
    4: # $Id: lonmsg.pm,v 1.157 2005/11/28 18:32: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: 
   30: package Apache::lonmsg;
   31: 
   32: =pod
   33: 
   34: =head1 NAME
   35: 
   36: Apache::lonmsg: supports internal messaging
   37: 
   38: =head1 SYNOPSIS
   39: 
   40: lonmsg provides routines for sending messages, receiving messages, and
   41: a handler to allow users to read, send, and delete messages.
   42: 
   43: =head1 OVERVIEW
   44: 
   45: =head2 Messaging Overview
   46: 
   47: X<messages>LON-CAPA provides an internal messaging system similar to
   48: email, but customized for LON-CAPA's usage. LON-CAPA implements its
   49: own messaging system, rather then building on top of email, because of
   50: the features LON-CAPA messages can offer that conventional e-mail can
   51: not:
   52: 
   53: =over 4
   54: 
   55: =item * B<Critical messages>: A message the recipient B<must>
   56: acknowlegde receipt of before they are allowed to continue using the
   57: system, preventing a user from claiming they never got a message
   58: 
   59: =item * B<Receipts>: LON-CAPA can reliably send reciepts informing the
   60: sender that it has been read; again, useful for preventing students
   61: from claiming they did not see a message. (While conventional e-mail
   62: has some reciept support, it's sporadic, e-mail client-specific, and
   63: generally the receiver can opt to not send one, making it useless in
   64: this case.)
   65: 
   66: =item * B<Context>: LON-CAPA knows about the sender, such as where
   67: they are in a course. When a student mails an instructor asking for
   68: help on the problem, the instructor receives not just the student's
   69: question, but all submissions the student has made up to that point,
   70: the user's rendering of the problem, and the complete view the student
   71: saw of the resource, including discussion up to that point. Finally,
   72: the instructor is reading all of this inside of LON-CAPA, not their
   73: email program, so they have full access to LON-CAPA's grading
   74: interface, or other features they may wish to use in response to the
   75: student's query.
   76: 
   77: =item * B<Blocking>: LON-CAPA can block display of e-mails that are 
   78: sent to a student during an online exam. A course coordinator or
   79: instructor can set an open and close date/time for scheduled online
   80: exams in a course. If a user uses the LON-CAPA internal messaging 
   81: system to display e-mails during the scheduled blocking event,  
   82: display of all e-mail sent during the blocking period will be 
   83: suppressed, and a message of explanation, including details of the 
   84: currently active blocking periods will be displayed instead. A user 
   85: who has a course coordinator or instructor role in a course will be
   86: unaffected by any blocking periods for the course, unless the user
   87: also has a student role in the course, AND has selected the student role.
   88: 
   89: =back
   90: 
   91: Users can ask LON-CAPA to forward messages to conventional e-mail
   92: addresses on their B<PREF> screen, but generally, LON-CAPA messages
   93: are much more useful than traditional email can be made to be, even
   94: with HTML support.
   95: 
   96: Right now, this document will cover just how to send a message, since
   97: it is likely you will not need to programmatically read messages,
   98: since lonmsg already implements that functionality.
   99: 
  100: =head1 FUNCTIONS
  101: 
  102: =over 4
  103: 
  104: =cut
  105: 
  106: use strict;
  107: use Apache::lonnet;
  108: use vars qw($msgcount);
  109: use HTML::TokeParser();
  110: use Apache::Constants qw(:common);
  111: use Apache::loncommon();
  112: use Apache::lontexconvert();
  113: use HTML::Entities();
  114: use Mail::Send;
  115: use Apache::lonlocal;
  116: use Apache::loncommunicate;
  117: use Apache::lonfeedback;
  118: use Apache::lonrss();
  119: 
  120: # Querystring component with sorting type
  121: my $sqs;
  122: my $startdis;
  123: my $interdis;
  124: 
  125: # ===================================================================== Package
  126: 
  127: sub packagemsg {
  128:     my ($subject,$message,$citation,$baseurl,$attachmenturl,
  129: 	$recuser,$recdomain,$msgid)=@_;
  130:     $message =&HTML::Entities::encode($message,'<>&"');
  131:     $citation=&HTML::Entities::encode($citation,'<>&"');
  132:     $subject =&HTML::Entities::encode($subject,'<>&"');
  133:     #remove machine specification
  134:     $baseurl =~ s|^http://[^/]+/|/|;
  135:     $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
  136:     #remove machine specification
  137:     $attachmenturl =~ s|^http://[^/]+/|/|;
  138:     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
  139: 
  140:     my $now=time;
  141:     $msgcount++;
  142:     my $partsubj=$subject;
  143:     $partsubj=&Apache::lonnet::escape($partsubj);
  144:     unless(defined($msgid)) {
  145:         $msgid=&Apache::lonnet::escape(
  146:            $now.':'.$partsubj.':'.$env{'user.name'}.':'.
  147:            $env{'user.domain'}.':'.$msgcount.':'.
  148:            $env{'request.course.id'}.':'.$$);
  149:     }
  150:     my $result='<sendername>'.$env{'user.name'}.'</sendername>'.
  151:            '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
  152:            '<subject>'.$subject.'</subject>'.
  153: 	   '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'.
  154: 	   '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
  155:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
  156: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
  157: 	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
  158: 	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
  159: 	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
  160:            '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
  161: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
  162: 	   '<courseid>'.$env{'request.course.id'}.'</courseid>'.
  163: 	   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
  164: 	   '<role>'.$env{'request.role'}.'</role>'.
  165: 	   '<resource>'.$env{'request.filename'}.'</resource>'.
  166:            '<msgid>'.$msgid.'</msgid>';
  167:     if (ref($recuser) eq 'ARRAY') {
  168:         for (my $i=0; $i<@{$recuser}; $i++) {
  169:             $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
  170:                        '<recdomain>'.$$recdomain[$i].'</recdomain>';
  171:         }
  172:     } else {
  173:         $result .= '<recuser>'.$recuser.'</recuser>'.
  174:                    '<recdomain>'.$recdomain.'</recdomain>';
  175:     }
  176:     $result .= '<message>'.$message.'</message>';
  177:     if (defined($citation)) {
  178: 	$result.='<citation>'.$citation.'</citation>';
  179:     }
  180:     if (defined($baseurl)) {
  181: 	$result.= '<baseurl>'.$baseurl.'</baseurl>';
  182:     }
  183:     if (defined($attachmenturl)) {
  184: 	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
  185:     }
  186:     return $msgid,$result;
  187: }
  188: 
  189: # ================================================== Unpack message into a hash
  190: 
  191: sub unpackagemsg {
  192:     my ($message,$notoken)=@_;
  193:     my %content=();
  194:     my $parser=HTML::TokeParser->new(\$message);
  195:     my $token;
  196:     while ($token=$parser->get_token) {
  197:        if ($token->[0] eq 'S') {
  198: 	   my $entry=$token->[1];
  199:            my $value=$parser->get_text('/'.$entry);
  200:            if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
  201:                push(@{$content{$entry}},$value);
  202:            } else {
  203:                $content{$entry}=$value;
  204:            }
  205:        }
  206:     }
  207:     if ($content{'attachmenturl'}) {
  208:        my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
  209:        if ($notoken) {
  210: 	   $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
  211:        } else {
  212: 	   &Apache::lonnet::allowuploaded('/adm/msg',
  213: 					  $content{'attachmenturl'});
  214: 	   $content{'message'}.='<p>'.&mt('Attachment').
  215: 	       ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
  216: 	       $fname.'</tt></a>';
  217:        }
  218:     }
  219:     return %content;
  220: }
  221: 
  222: # ======================================================= Get info out of msgid
  223: 
  224: sub unpackmsgid {
  225:     my ($msgid,$folder)=@_;
  226:     $msgid=&Apache::lonnet::unescape($msgid);
  227:     my $suffix=&foldersuffix($folder);
  228:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/,
  229:                           &Apache::lonnet::unescape($msgid));
  230:     my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
  231:     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
  232:     unless ($status{$msgid}) { $status{$msgid}='new'; }
  233:     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid);
  234: }
  235: 
  236: 
  237: sub sendemail {
  238:     my ($to,$subject,$body)=@_;
  239:     $body=
  240:     "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
  241:     "*** ".&mt('Please do not reply to this address.')."\n\n".$body;
  242:     my $msg = new Mail::Send;
  243:     $msg->to($to);
  244:     $msg->subject('[LON-CAPA] '.$subject);
  245:     if (my $fh = $msg->open()) {
  246: 	print $fh $body;
  247: 	$fh->close;
  248:     }
  249: }
  250: 
  251: # ==================================================== Send notification emails
  252: 
  253: sub sendnotification {
  254:     my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
  255:     my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
  256:     unless ($sender=~/\w/) { 
  257: 	$sender=$env{'user.name'}.'@'.$env{'user.domain'};
  258:     }
  259:     my $critical=($crit?' critical':'');
  260:     $text=~s/\&lt\;/\</gs;
  261:     $text=~s/\&gt\;/\>/gs;
  262:     $text=~s/\<\/*[^\>]+\>//gs;
  263:     my $url='http://'.
  264:       $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
  265:       '/adm/email?username='.$touname.'&domain='.$toudom;
  266:     my $body=(<<ENDMSG);
  267: You received a$critical message from $sender in LON-CAPA. The subject is
  268: 
  269:  $subj
  270: 
  271: === Excerpt ============================================================
  272: $text
  273: ========================================================================
  274: 
  275: Use
  276: 
  277:  $url
  278: 
  279: to access the full message.
  280: ENDMSG
  281:     &sendemail($to,'New'.$critical.' message from '.$sender,$body);
  282: }
  283: # ============================================================= Check for email
  284: 
  285: sub newmail {
  286:     if ((time-$env{'user.mailcheck.time'})>300) {
  287:         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
  288:         &Apache::lonnet::appenv('user.mailcheck.time'=>time);
  289:         if ($what{'recnewemail'}>0) { return 1; }
  290:     }
  291:     return 0;
  292: }
  293: 
  294: # =============================== Automated message to the author of a resource
  295: 
  296: =pod
  297: 
  298: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
  299:     of the resource with the URI $filename.
  300: 
  301: =cut
  302: 
  303: sub author_res_msg {
  304:     my ($filename,$message)=@_;
  305:     unless ($message) { return 'empty'; }
  306:     $filename=&Apache::lonnet::declutter($filename);
  307:     my ($domain,$author,@dummy)=split(/\//,$filename);
  308:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
  309:     if ($homeserver ne 'no_host') {
  310:        my $id=unpack("%32C*",$message);
  311:        my $msgid;
  312:        ($msgid,$message)=&packagemsg($filename,$message);
  313:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
  314:          ':nohist_res_msgs:'.
  315:           &Apache::lonnet::escape($filename.'_'.$id).'='.
  316:           &Apache::lonnet::escape($message),$homeserver);
  317:     }
  318:     return 'no_host';
  319: }
  320: 
  321: # =========================================== Retrieve author resource messages
  322: 
  323: sub retrieve_author_res_msg {
  324:     my $url=shift;
  325:     $url=&Apache::lonnet::declutter($url);
  326:     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
  327:     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
  328:     my $msgs='';
  329:     foreach (keys %errormsgs) {
  330: 	if ($_=~/^\Q$url\E\_\d+$/) {
  331: 	    my %content=&unpackagemsg($errormsgs{$_});
  332: 	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
  333: 		$content{'time'}.'</b>: '.$content{'message'}.
  334: 		'<br /></p>';
  335: 	}
  336:     } 
  337:     return $msgs;     
  338: }
  339: 
  340: 
  341: # =============================== Delete all author messages related to one URL
  342: 
  343: sub del_url_author_res_msg {
  344:     my $url=shift;
  345:     $url=&Apache::lonnet::declutter($url);
  346:     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
  347:     my @delmsgs=();
  348:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  349: 	if ($_=~/^\Q$url\E\_\d+$/) {
  350: 	    push (@delmsgs,$_);
  351: 	}
  352:     }
  353:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
  354: }
  355: # =================================== Clear out all author messages in URL path
  356: 
  357: sub clear_author_res_msg {
  358:     my $url=shift;
  359:     $url=&Apache::lonnet::declutter($url);
  360:     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
  361:     my @delmsgs=();
  362:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  363: 	if ($_=~/^\Q$url\E/) {
  364: 	    push (@delmsgs,$_);
  365: 	}
  366:     }
  367:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
  368: }
  369: # ================= Return hash with URLs for which there is a resource message
  370: 
  371: sub all_url_author_res_msg {
  372:     my ($author,$domain)=@_;
  373:     my %returnhash=();
  374:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  375: 	$_=~/^(.+)\_\d+/;
  376: 	$returnhash{$1}=1;
  377:     }
  378:     return %returnhash;
  379: }
  380: 
  381: # ================================================== Critical message to a user
  382: 
  383: sub user_crit_msg_raw {
  384:     my ($user,$domain,$subject,$message,$sendback,$toperm)=@_;
  385: # Check if allowed missing
  386:     my $status='';
  387:     my $msgid='undefined';
  388:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  389:     my $text=$message;
  390:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  391:     if ($homeserver ne 'no_host') {
  392:        ($msgid,$message)=&packagemsg($subject,$message);
  393:        if ($sendback) { $message.='<sendback>true</sendback>'; }
  394:        $status=&Apache::lonnet::critical(
  395:            'put:'.$domain.':'.$user.':critical:'.
  396:            &Apache::lonnet::escape($msgid).'='.
  397:            &Apache::lonnet::escape($message),$homeserver);
  398:        if ($env{'request.course.id'}) {
  399:           &user_normal_msg_raw(
  400:             $env{'course.'.$env{'request.course.id'}.'.num'},
  401:             $env{'course.'.$env{'request.course.id'}.'.domain'},
  402:             'Critical ['.$user.':'.$domain.']',
  403: 	    $message);
  404:        }
  405:     } else {
  406:        $status='no_host';
  407:     }
  408: # Notifications
  409:     my %userenv = &Apache::lonnet::get('environment',['critnotification',
  410:                                                       'permanentemail'],
  411:                                        $domain,$user);
  412:     if ($userenv{'critnotification'}) {
  413:       &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
  414: 			$text);
  415:     }
  416:     if ($toperm && $userenv{'permanentemail'}) {
  417:       &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
  418: 			$text);
  419:     }
  420: # Log this
  421:     &Apache::lonnet::logthis(
  422:       'Sending critical email '.$msgid.
  423:       ', log status: '.
  424:       &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  425:                          $env{'user.home'},
  426:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
  427:       .$status));
  428:     return $status;
  429: }
  430: 
  431: # New routine that respects "forward" and calls old routine
  432: 
  433: =pod
  434: 
  435: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
  436:     a critical message $message to the $user at $domain. If $sendback is true,
  437:     a reciept will be sent to the current user when $user recieves the message.
  438: 
  439: =cut
  440: 
  441: sub user_crit_msg {
  442:     my ($user,$domain,$subject,$message,$sendback,$toperm)=@_;
  443:     my $status='';
  444:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  445:                                        $domain,$user);
  446:     my $msgforward=$userenv{'msgforward'};
  447:     if ($msgforward) {
  448:        foreach (split(/\,/,$msgforward)) {
  449: 	 my ($forwuser,$forwdomain)=split(/\:/,$_);
  450:          $status.=
  451: 	   &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
  452:                 $sendback,$toperm).' ';
  453:        }
  454:     } else { 
  455: 	$status=&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,$toperm);
  456:     }
  457:     return $status;
  458: }
  459: 
  460: # =================================================== Critical message received
  461: 
  462: sub user_crit_received {
  463:     my $msgid=shift;
  464:     my %message=&Apache::lonnet::get('critical',[$msgid]);
  465:     my %contents=&unpackagemsg($message{$msgid},1);
  466:     my $status='rec: '.($contents{'sendback'}?
  467:      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
  468:                      &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
  469:                      &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
  470:                      ' acknowledged receipt of message'."\n".'   "'.
  471:                      $contents{'subject'}.'"'."\n".&mt('dated').' '.
  472:                      $contents{'time'}.".\n"
  473:                      ):'no msg req');
  474:     $status.=' trans: '.
  475:      &Apache::lonnet::put(
  476:      'nohist_email',{$contents{'msgid'} => $message{$msgid}});
  477:     $status.=' del: '.
  478:      &Apache::lonnet::del('critical',[$contents{'msgid'}]);
  479:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  480:                          $env{'user.home'},'Received critical message '.
  481:                          $contents{'msgid'}.
  482:                          ', '.$status);
  483:     return $status;
  484: }
  485: 
  486: # ======================================================== Normal communication
  487: 
  488: sub user_normal_msg_raw {
  489:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
  490: 	$toperm,$newid)=@_;
  491: # Check if allowed missing
  492:     my $status='';
  493:     my $msgid='undefined';
  494:     my $text=$message;
  495:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  496:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  497:     if ($homeserver ne 'no_host') {
  498:        ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl,
  499:                                      $attachmenturl,$user,$domain);
  500: # Store in user folder
  501:        $status=&Apache::lonnet::critical(
  502:            'put:'.$domain.':'.$user.':nohist_email:'.
  503:            &Apache::lonnet::escape($msgid).'='.
  504:            &Apache::lonnet::escape($message),$homeserver);
  505: # Save new message received time
  506:        &Apache::lonnet::put
  507:                          ('email_status',{'recnewemail'=>time},$domain,$user);
  508: # Into sent-mail folder unless a broadcast message
  509:        unless (($env{'request.course.id'}) && ($env{'form.sendmode'} eq 'group')) {
  510:            $status .= &store_sent_mail($msgid,$message);
  511:        }
  512:     } else {
  513:        $status='no_host';
  514:     }
  515:     if (defined($newid)) {
  516:         $$newid = $msgid;
  517:     }
  518: # Notifications
  519:     my %userenv = &Apache::lonnet::get('environment',['notification',
  520:                                                       'permanentemail'],
  521:                                        $domain,$user);
  522:     if ($userenv{'notification'}) {
  523: 	&sendnotification($userenv{'notification'},$user,$domain,$subject,0,
  524: 			  $text);
  525:     }
  526:     if ($toperm && $userenv{'permanentemail'}) {
  527:       &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
  528: 			$text);
  529:     }
  530:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
  531:                          $env{'user.home'},
  532:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
  533:     return $status;
  534: }
  535: 
  536: # New routine that respects "forward" and calls old routine
  537: 
  538: =pod
  539: 
  540: =item * B<user_normal_msg($user, $domain, $subject, $message,
  541:     $citation, $baseurl, $attachmenturl)>: Sends a message to the
  542:     $user at $domain, with subject $subject and message $message.
  543: 
  544: =cut
  545: 
  546: sub user_normal_msg {
  547:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
  548: 	$toperm)=@_;
  549:     my $status='';
  550:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  551:                                        $domain,$user);
  552:     my $msgforward=$userenv{'msgforward'};
  553:     if ($msgforward) {
  554:        foreach (split(/\,/,$msgforward)) {
  555: 	 my ($forwuser,$forwdomain)=split(/\:/,$_);
  556:          $status.=
  557: 	  &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
  558: 			       $citation,$baseurl,$attachmenturl,$toperm).' ';
  559:        }
  560:     } else { 
  561: 	$status=&user_normal_msg_raw($user,$domain,$subject,$message,
  562: 				     $citation,$baseurl,$attachmenturl,$toperm);
  563:     }
  564:     return $status;
  565: }
  566: 
  567: sub store_sent_mail {
  568:     my ($msgid,$message) = @_;
  569:         my $status =' '.&Apache::lonnet::critical(
  570:                    'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
  571:                                               ':nohist_email_sent:'.
  572:                    &Apache::lonnet::escape($msgid).'='.
  573:                    &Apache::lonnet::escape($message),$env{'user.home'});
  574:     return $status;
  575: }
  576: 
  577: # ============================================================ List all folders
  578: 
  579: sub folderlist {
  580:     my $folder=shift;
  581:     my @allfolders=&Apache::lonnet::getkeys('email_folders');
  582:     if ($allfolders[0]=~/^error:/) { @allfolders=(); }
  583:     return '<form method="post" action="/adm/email">'.
  584: 	&mt('Folder').': '.
  585: 	&Apache::loncommon::select_form($folder,'folder',
  586: 			     ('' => &mt('INBOX'),'trash' => &mt('TRASH'),
  587: 			      'new' => &mt('New Messages Only'),
  588:                               'critical' => &mt('Critical'),
  589: 			      'sent' => &mt('Sent Messages'),
  590: 			      map { $_ => $_ } @allfolders)).
  591: 			      ' '.&mt('Show').
  592: 			      '<select name="interdis">'.
  593: 			      join("\n",map { '<option value="'.$_.'"'.
  594: 	 ($_==$interdis?' selected="selected"':'').'>'.$_.'</option>' }
  595: 				   (10,20,50,100,200)).'</select>'.	
  596:    '<input type="submit" value="'.&mt('View Folder').'" /><br />'.
  597:     '<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />'.
  598: 			      ($folder=~/^(new|critical)/?'</form>':'');
  599: }
  600: 
  601: sub scrollbuttons {
  602:     my ($start,$maxdis,$first,$finish,$total)=@_;
  603:     unless ($total>0) { return ''; }
  604:     $start++; $maxdis++;$first++;$finish++;
  605:     return
  606:    &mt('Page').': '. 
  607:    '<input type="submit" name="firstview" value="'.&mt('First').'" />'.
  608:    '<input type="submit" name="prevview" value="'.&mt('Previous').'" />'.
  609:    '<input type="text" size="5" name="startdis" value="'.$start.'" onChange="this.form.submit()" /> of '.$maxdis.
  610:    '<input type="submit" name="nextview" value="'.&mt('Next').'" />'.
  611:    '<input type="submit" name="lastview" value="'.&mt('Last').'" /><br />'.
  612:    &mt('Showing messages [_1] through [_2] of [_3]',$first,$finish,$total).'</form>';
  613: }
  614: 
  615: # =============================================================== Folder suffix
  616: 
  617: sub foldersuffix {
  618:     my $folder=shift;
  619:     unless ($folder) { return ''; }
  620:     return '_'.&Apache::lonnet::escape($folder);
  621: }
  622: 
  623: # =============================================================== Status Change
  624: 
  625: sub statuschange {
  626:     my ($msgid,$newstatus,$folder)=@_;
  627:     my $suffix=&foldersuffix($folder);
  628:     my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
  629:     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
  630:     unless ($status{$msgid}) { $status{$msgid}='new'; }
  631:     unless (($status{$msgid} eq 'replied') || 
  632:             ($status{$msgid} eq 'forwarded')) {
  633: 	&Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus});
  634:     }
  635:     if (($newstatus eq 'deleted') || ($newstatus eq 'new')) {
  636: 	&Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus});
  637:     }
  638:     if ($newstatus eq 'deleted') {
  639:        &movemsg(&Apache::lonnet::unescape($msgid),$folder,'trash');
  640:    }
  641: }
  642: 
  643: # ============================================================= Make new folder
  644: 
  645: sub makefolder {
  646:     my ($newfolder)=@_;
  647:     if (($newfolder eq 'sent')
  648:      || ($newfolder eq 'critical')
  649:      || ($newfolder eq 'trash')
  650:      || ($newfolder eq 'new')) { return; }
  651:     &Apache::lonnet::put('email_folders',{$newfolder => time});
  652: }
  653: 
  654: # ======================================================== Move between folders
  655: 
  656: sub movemsg {
  657:     my ($msgid,$srcfolder,$trgfolder)=@_;
  658:     if ($srcfolder eq 'new') { $srcfolder=''; }
  659:     my $srcsuffix=&foldersuffix($srcfolder);
  660:     my $trgsuffix=&foldersuffix($trgfolder);
  661: 
  662: # Copy message
  663:     my %message=&Apache::lonnet::get('nohist_email'.$srcsuffix,[$msgid]);
  664:     &Apache::lonnet::put('nohist_email'.$trgsuffix,{$msgid => $message{$msgid}});
  665: 
  666: # Copy status
  667:     unless ($trgfolder eq 'trash') {
  668: 	my %status=&Apache::lonnet::get('email_status'.$srcsuffix,[$msgid]);
  669: 	&Apache::lonnet::put('email_status'.$trgsuffix,{$msgid => $status{$msgid}});
  670:     }
  671: # Delete orginals
  672:     &Apache::lonnet::del('nohist_email'.$srcsuffix,[$msgid]);
  673:     &Apache::lonnet::del('email_status'.$srcsuffix,[$msgid]);
  674: }
  675: 
  676: # ======================================================= Display a course list
  677: 
  678: sub discourse {
  679:     my $r=shift;
  680:     my $classlist = &Apache::loncoursedata::get_classlist();
  681:     my $now=time;
  682:     my %lt=&Apache::lonlocal::texthash('cfa' => 'Check All',
  683:             'cfs' => 'Check Section/Group',
  684:             'cfn' => 'Uncheck All');
  685:     $r->print(<<ENDDISHEADER);
  686: <input type="hidden" name="sendmode" value="group" />
  687: <script>
  688:     function checkall() {
  689: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  690:             if 
  691:           (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
  692: 	      document.forms.compemail.elements[i].checked=true;
  693:             }
  694:         }
  695:     }
  696: 
  697:     function checksec() {
  698: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  699:             if 
  700:           (document.forms.compemail.elements[i].name.indexOf
  701:            ('send_to_&&&'+document.forms.compemail.chksec.value)==0) {
  702: 	      document.forms.compemail.elements[i].checked=true;
  703:             }
  704:         }
  705:     }
  706: 
  707:     function uncheckall() {
  708: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  709:             if 
  710:           (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
  711: 	      document.forms.compemail.elements[i].checked=false;
  712:             }
  713:         }
  714:     }
  715: </script>
  716: <input type="button" onClick="checkall()" value="$lt{'cfa'}" />&nbsp;
  717: <input type="button" onClick="checksec()" value="$lt{'cfs'}" />
  718: <input type="text" size="5" name="chksec" />&nbsp;
  719: <input type="button" onClick="uncheckall()" value="$lt{'cfn'}" />
  720: <p>
  721: ENDDISHEADER
  722:     my %coursepersonnel=&Apache::lonnet::get_course_adv_roles();
  723:     $r->print('<table>');
  724:     foreach my $role (sort keys %coursepersonnel) {
  725:         foreach (split(/\,/,$coursepersonnel{$role})) {
  726:             my ($puname,$pudom)=split(/\:/,$_);
  727:             $r->print('<tr><td><label>'.
  728:                       '<input type="checkbox" name="send_to_&&&&&&_'.
  729:                       $puname.':'.$pudom.'" /> '.
  730:                       &Apache::loncommon::plainname($puname,$pudom).
  731:                       '</label></td>'.
  732:                       '<td>('.$_.'),</td><td><i>'.$role.'</i></td></tr>');
  733:         }
  734:     }
  735:     $r->print('</table><table>');
  736:     my $sort = sub {
  737: 	my $aname=lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]);
  738: 	if (!$aname) { $aname=$a; }
  739: 	my $bname=lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]);
  740: 	if (!$bname) { $bname=$b; }
  741: 	return $aname cmp $bname;
  742:     };
  743:     foreach my $student (sort $sort (keys(%{$classlist}))) {
  744: 	my $info=$classlist->{$student};
  745:         my ($sname,$sdom,$status,$fullname,$section) =
  746:             (@{$info}[&Apache::loncoursedata::CL_SNAME(),
  747:                       &Apache::loncoursedata::CL_SDOM(),
  748:                       &Apache::loncoursedata::CL_STATUS(),
  749:                       &Apache::loncoursedata::CL_FULLNAME(),
  750:                       &Apache::loncoursedata::CL_SECTION()]);
  751:         next if ($status ne 'Active');
  752: 	next if ($env{'request.course.sec'} &&
  753: 		 $section ne $env{'request.course.sec'});
  754:         my $key = 'send_to_&&&'.$section.'&&&_'.$student;
  755:         if (! defined($fullname) || $fullname eq '') { $fullname = $sname; }
  756:         $r->print('<tr><td><label>'.
  757:                   qq{<input type="checkbox" name="$key" />}.('&nbsp;'x2).
  758:                   $fullname.'</label></td><td>'.$sname.'@'.$sdom.'</td><td>'.$section.
  759:                   '</td></tr>');
  760:     }
  761:     $r->print('</table>');
  762: }
  763: 
  764: # ==================================================== Display Critical Message
  765: 
  766: sub discrit {
  767:     my $r=shift;
  768:     my $header = '<h1><font color=red>'.&mt('Critical Messages').'</font></h1>'.
  769:         '<form action="/adm/email" method="POST">'.
  770:         '<input type="hidden" name="confirm" value="true" />';
  771:     my %what=&Apache::lonnet::dump('critical');
  772:     my $result = '';
  773:     foreach (sort keys %what) {
  774:         my %content=&unpackagemsg($what{$_});
  775:         next if ($content{'senderdomain'} eq '');
  776:         $result.='<hr />'.&mt('From').': <b>'.
  777: &Apache::loncommon::aboutmewrapper(
  778:  &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
  779: $content{'sendername'}.'@'.
  780:             $content{'senderdomain'}.') '.$content{'time'}.
  781:             '<br />'.&mt('Subject').': '.$content{'subject'}.
  782:             '<br /><pre>'.
  783:               &Apache::lontexconvert::msgtexconverted($content{'message'}).
  784:             '</pre><small>'.
  785: &mt('You have to confirm that you received this message. After confirmation, this message will be moved to your regular inbox').
  786:             '</small><br />'.
  787:             '<input type="submit" name="rec_'.$_.'" value="'.&mt('Confirm Receipt').'" />'.
  788:             '<input type="submit" name="reprec_'.$_.'" '.
  789:                   'value="'.&mt('Confirm Receipt and Reply').'" />';
  790:     }
  791:     # Check to see if there were any messages.
  792:     if ($result eq '') {
  793:         $result = "<h2>".&mt('You have no critical messages.')."</h2>".
  794: 	    '<a href="/adm/roles">'.&mt('Select a course').'</a><br />'.
  795:             '<a href="/adm/email">'.&mt('Communicate').'</a>';
  796:     } else {
  797:         $r->print($header);
  798:     }
  799:     $r->print($result);
  800:     $r->print('<input type="hidden" name="displayedcrit" value="true" /></form>');
  801: }
  802: 
  803: sub sortedmessages {
  804:     my ($blocked,$startblock,$endblock,$numblocked,$folder) = @_;
  805:     my $suffix=&foldersuffix($folder);
  806:     my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix);
  807:     #unpack the varibles and repack into temp for sorting
  808:     my @temp;
  809:     foreach (@messages) {
  810: 	my $msgid=&Apache::lonnet::escape($_);
  811: 	my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)=
  812: 	    &Apache::lonmsg::unpackmsgid($msgid,$folder);
  813:         my $description = &get_course_desc($fromcid);
  814: 	my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status,
  815: 		     $msgid,$description);
  816:         # Check whether message was sent during blocking period.
  817:         if ($sendtime >= $startblock && ($sendtime <= $endblock && $endblock > 0) ) {
  818:             my $escid = &Apache::lonnet::unescape($msgid);
  819:             $$blocked{$escid} = 'ON';
  820:             $$numblocked ++;
  821:         } else { 
  822:             push @temp ,\@temp1;
  823:         }
  824:     }
  825:     #default sort
  826:     @temp = sort  {$a->[0] <=> $b->[0]} @temp;    
  827:     if ($env{'form.sortedby'} eq "date"){
  828:         @temp = sort  {$a->[0] <=> $b->[0]} @temp;    
  829:     }
  830:     if ($env{'form.sortedby'} eq "revdate"){
  831:     	@temp = sort  {$b->[0] <=> $a->[0]} @temp; 
  832:     }
  833:     if ($env{'form.sortedby'} eq "user"){
  834: 	@temp = sort  {lc($a->[2]) cmp lc($b->[2])} @temp;
  835:     }
  836:     if ($env{'form.sortedby'} eq "revuser"){
  837: 	@temp = sort  {lc($b->[2]) cmp lc($a->[2])} @temp;
  838:     }
  839:     if ($env{'form.sortedby'} eq "domain"){
  840:         @temp = sort  {$a->[3] cmp $b->[3]} @temp;
  841:     }
  842:     if ($env{'form.sortedby'} eq "revdomain"){
  843:         @temp = sort  {$b->[3] cmp $a->[3]} @temp;
  844:     }
  845:     if ($env{'form.sortedby'} eq "subject"){
  846:         @temp = sort  {lc($a->[1]) cmp lc($b->[1])} @temp;
  847:     }
  848:     if ($env{'form.sortedby'} eq "revsubject"){
  849:         @temp = sort  {lc($b->[1]) cmp lc($a->[1])} @temp;
  850:     }
  851:     if ($env{'form.sortedby'} eq "course"){
  852:         @temp = sort  {lc($a->[6]) cmp lc($b->[6])} @temp;
  853:     }
  854:     if ($env{'form.sortedby'} eq "revcourse"){
  855:         @temp = sort  {lc($b->[6]) cmp lc($a->[6])} @temp;
  856:     }
  857:     if ($env{'form.sortedby'} eq "status"){
  858:         @temp = sort  {$a->[4] cmp $b->[4]} @temp;
  859:     }
  860:     if ($env{'form.sortedby'} eq "revstatus"){
  861:         @temp = sort  {$b->[4] cmp $a->[4]} @temp;
  862:     }
  863:     return @temp;
  864: }
  865: 
  866: sub get_course_desc {
  867:     my ($fromcid) = @_;
  868:     my $description; 
  869:     if (defined($env{'course.'.$fromcid.'.description'})) {
  870:        $description = $env{'course.'.$fromcid.'.description'};
  871:     } else {
  872:        my %courseinfo=&Apache::lonnet::coursedescription($fromcid);
  873:         $description = $courseinfo{'description'};
  874:     }
  875:     return $description;
  876: }
  877: 
  878: # ======================================================== Display new messages
  879: 
  880: 
  881: sub disnew {
  882:     my $r=shift;
  883:     my %lt=&Apache::lonlocal::texthash(
  884: 				       'nm' => 'New Messages',
  885: 				       'su' => 'Subject',
  886:                                        'co' => 'Course',
  887: 				       'da' => 'Date',
  888: 				       'us' => 'Username',
  889: 				       'op' => 'Open',
  890: 				       'do' => 'Domain'
  891: 				       );
  892:     my @msgids = sort split(/\&/,&Apache::lonnet::reply
  893:                             ('keys:'.$env{'user.domain'}.':'.
  894:                              $env{'user.name'}.':nohist_email',
  895:                              $env{'user.home'}));
  896:     my @newmsgs;
  897:     my %setters = ();
  898:     my $startblock = 0;
  899:     my $endblock = 0;
  900:     my %blocked = ();
  901:     my $numblocked = 0;
  902:     # Check for blocking of display because of scheduled online exams.
  903:     &blockcheck(\%setters,\$startblock,\$endblock);
  904:     foreach (@msgids) {
  905:         my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
  906: 	    &Apache::lonmsg::unpackmsgid($_);
  907:         if (defined($sendtime) && $sendtime!~/error/) {
  908:             my $description = &get_course_desc($fromcid);
  909:             my $numsendtime = $sendtime;
  910:             $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
  911:             if ($status eq 'new') {
  912:                 if ($numsendtime >= $startblock && ($numsendtime <= $endblock && $endblock > 0) ) {
  913:                     $blocked{$_} = 'ON';
  914:                     $numblocked ++;
  915:                 } else {
  916:                     push @newmsgs, { 
  917:                         msgid    => $_,
  918:                         sendtime => $sendtime,
  919:                         shortsub => &Apache::lonnet::unescape($shortsubj),
  920:                         from     => $fromname,
  921:                         fromdom  => $fromdom,
  922:                         course   => $description 
  923:                         }
  924:                 }
  925:             }
  926:         }
  927:     }
  928:     if ($#newmsgs >= 0) {
  929:         $r->print(<<TABLEHEAD);
  930: <h2>$lt{'nm'}</h2>
  931: <table border=2><tr><th>&nbsp</th>
  932: <th>$lt{'da'}</th><th>$lt{'us'}</th><th>$lt{'do'}</th><th>$lt{'su'}</th><th>$lt{'co'}</th></tr>
  933: TABLEHEAD
  934:         foreach my $msg (@newmsgs) {
  935:             $r->print(<<"ENDLINK");
  936: <tr class="new" bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor='#DD9955'" 
  937: onMouseOut="javascript:style.backgroundColor='#FFBB77'">
  938: <td><a href="/adm/email?dismode=new&display=$msg->{'msgid'}">$lt{'op'}</a></td>
  939: ENDLINK
  940:             foreach ('sendtime','from','fromdom','shortsub','course') {
  941:                 $r->print("<td>$msg->{$_}</td>");
  942:             }
  943:             $r->print("</td></tr>");
  944:         }
  945:         $r->print('</table>'.&Apache::loncommon::endbodytag().'</html>');
  946:     } elsif ($numblocked == 0) {
  947:         $r->print("<h3>".&mt('You have no unread messages')."</h3>");
  948:     }
  949:     if ($numblocked > 0) {
  950:         my $beginblock = &Apache::lonlocal::locallocaltime($startblock);
  951:         my $finishblock = &Apache::lonlocal::locallocaltime($endblock);
  952:         if ($numblocked == 1) {
  953:             $r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread message').".</h3>");
  954:             $r->print(&mt('This message is not viewable because').' ');
  955:         } else {
  956:             $r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread messages').".</h3>");
  957:             $r->print(&mt('These').' '.$numblocked.' '.&mt('messages are not viewable because '));
  958:         }
  959:         $r->print(
  960: &mt('display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams').'.');
  961:         &build_block_table($r,$startblock,$endblock,\%setters);
  962:     }
  963: }
  964: 
  965: 
  966: # ======================================================== Display all messages
  967: 
  968: sub disall {
  969:     my ($r,$folder)=@_;
  970:     $r->print(&folderlist($folder));
  971:     if ($folder eq 'new') {
  972: 	&disnew($r);
  973:     } elsif ($folder eq 'critical') {
  974: 	&discrit($r);
  975:     } else {
  976: 	&disfolder($r,$folder);
  977:     }
  978: }
  979: 
  980: # ============================================================ Display a folder
  981: 
  982: sub disfolder {
  983:     my ($r,$folder)=@_;
  984:     my %blocked = ();
  985:     my %setters = ();
  986:     my $startblock;
  987:     my $endblock;
  988:     my $numblocked = 0;
  989:     &blockcheck(\%setters,\$startblock,\$endblock);
  990:     $r->print(<<ENDDISHEADER);
  991: <script>
  992:     function checkall() {
  993: 	for (i=0; i<document.forms.disall.elements.length; i++) {
  994:             if 
  995:           (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
  996: 	      document.forms.disall.elements[i].checked=true;
  997:             }
  998:         }
  999:     }
 1000: 
 1001:     function uncheckall() {
 1002: 	for (i=0; i<document.forms.disall.elements.length; i++) {
 1003:             if 
 1004:           (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
 1005: 	      document.forms.disall.elements[i].checked=false;
 1006:             }
 1007:         }
 1008:     }
 1009: </script>
 1010: ENDDISHEADER
 1011:     my $fsqs='&folder='.$folder;
 1012:     my @temp=sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
 1013:     my $totalnumber=$#temp+1;
 1014:     unless ($totalnumber>0) {
 1015: 	$r->print('<h2>'.&mt('Empty Folder').'</h2>');
 1016: 	return;
 1017:     }
 1018:     unless ($interdis) {
 1019: 	$interdis=20;
 1020:     }
 1021:     my $number=int($totalnumber/$interdis);
 1022:     if (($startdis<0) || ($startdis>$number)) { $startdis=$number; }
 1023:     my $firstdis=$interdis*$startdis;
 1024:     if ($firstdis>$#temp) { $firstdis=$#temp-$interdis+1; }
 1025:     my $lastdis=$firstdis+$interdis-1;
 1026:     if ($lastdis>$#temp) { $lastdis=$#temp; }
 1027:     $r->print(&scrollbuttons($startdis,$number,$firstdis,$lastdis,$totalnumber));
 1028:     $r->print('<form method="post" name="disall" action="/adm/email">'.
 1029: 	      '<table border=2><tr><th colspan="3">&nbsp</th><th>');
 1030:     if ($env{'form.sortedby'} eq "revdate") {
 1031: 	$r->print('<a href = "?sortedby=date'.$fsqs.'">'.&mt('Date').'</a></th>');
 1032:     } else {
 1033: 	$r->print('<a href = "?sortedby=revdate'.$fsqs.'">'.&mt('Date').'</a></th>');
 1034:     }
 1035:     $r->print('<th>');
 1036:     if ($env{'form.sortedby'} eq "revuser") {
 1037: 	$r->print('<a href = "?sortedby=user'.$fsqs.'">'.&mt('Username').'</a>');
 1038:     } else {
 1039: 	$r->print('<a href = "?sortedby=revuser'.$fsqs.'">'.&mt('Username').'</a>');
 1040:     }
 1041:     $r->print('</th><th>');
 1042:     if ($env{'form.sortedby'} eq "revdomain") {
 1043: 	$r->print('<a href = "?sortedby=domain'.$fsqs.'">'.&mt('Domain').'</a>');
 1044:     } else {
 1045: 	$r->print('<a href = "?sortedby=revdomain'.$fsqs.'">'.&mt('Domain').'</a>');
 1046:     }
 1047:     $r->print('</th><th>');
 1048:     if ($env{'form.sortedby'} eq "revsubject") {
 1049: 	$r->print('<a href = "?sortedby=subject'.$fsqs.'">'.&mt('Subject').'</a>');
 1050:     } else {
 1051:     	$r->print('<a href = "?sortedby=revsubject'.$fsqs.'">'.&mt('Subject').'</a>');
 1052:     }
 1053:     $r->print('</th><th>');
 1054:     if ($env{'form.sortedby'} eq "revcourse") {
 1055:         $r->print('<a href = "?sortedby=course'.$fsqs.'">'.&mt('Course').'</a>');
 1056:     } else {
 1057:         $r->print('<a href = "?sortedby=revcourse'.$fsqs.'">'.&mt('Course').'</a>');
 1058:     }
 1059:     $r->print('</th><th>');
 1060:     if ($env{'form.sortedby'} eq "revstatus") {
 1061: 	$r->print('<a href = "?sortedby=status'.$fsqs.'">'.&mt('Status').'</a></th>');
 1062:     } else {
 1063:      	$r->print('<a href = "?sortedby=revstatus'.$fsqs.'">'.&mt('Status').'</a></th>');
 1064:     }
 1065:     $r->print("</tr>\n");
 1066:     for (my $n=$firstdis;$n<=$lastdis;$n++) {
 1067: 	my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$origID,$description)= @{$temp[$n]};
 1068: 	if (($status ne 'deleted') && defined($sendtime) && $sendtime!~/error/) {
 1069: 	    if ($status eq 'new') {
 1070: 		$r->print('<tr bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor=\'#DD9955\'"  onMouseOut="javascript:style.backgroundColor=\'#FFBB77\'">');
 1071: 	    } elsif ($status eq 'read') {
 1072: 		$r->print('<tr bgcolor="#BBBB77" onMouseOver="javascript:style.backgroundColor=\'#999944\'"  onMouseOut="javascript:style.backgroundColor=\'#BBBB77\'">');
 1073: 	    } elsif ($status eq 'replied') {
 1074: 		$r->print('<tr bgcolor="#AAAA88" onMouseOver="javascript:style.backgroundColor=\'#888855\'"  onMouseOut="javascript:style.backgroundColor=\'#AAAA88\'">'); 
 1075: 	    } else {
 1076: 		$r->print('<tr bgcolor="#99BBBB" onMouseOver="javascript:style.backgroundColor=\'#669999\'"  onMouseOut="javascript:style.backgroundColor=\'#99BBBB\'">');
 1077: 	    }
 1078: 	    $r->print('<td><input type="checkbox" name="delmark_'.$origID.'" /></td><td><a href="/adm/email?display='.$origID.$sqs. 
 1079: 		      '">'.&mt('Open').'</a></td><td>'.
 1080: 		      ($folder ne 'trash'?'<a href="/adm/email?markdel='.$origID.$sqs.
 1081: 		      '">'.&mt('Delete'):'&nbsp').'</a></td>'.
 1082: 		      '<td>'.&Apache::lonlocal::locallocaltime($sendtime).'</td><td>'.
 1083: 		      $fromname.'</td><td>'.$fromdomain.'</td><td>'.
 1084: 		      &Apache::lonnet::unescape($shortsubj).'</td><td>'.
 1085:                       $description.'</td><td>'.$status.'</td></tr>'."\n");
 1086: 	} elsif ($status eq 'deleted') {
 1087: # purge
 1088: 	    &movemsg(&Apache::lonnet::unescape($origID),$folder,'trash');
 1089: 	}
 1090:     }   
 1091:     $r->print("</table>\n<p>".
 1092:   '<a href="javascript:checkall()">'.&mt('Check All').'</a>&nbsp;'.
 1093:   '<a href="javascript:uncheckall()">'.&mt('Uncheck All').'</a></p>'.
 1094:   '<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />');
 1095:     if ($folder ne 'trash') {
 1096: 	$r->print(
 1097: 	      '<p><input type="submit" name="markeddel" value="'.&mt('Delete Checked').'" /></p>');
 1098:     }
 1099:     $r->print('<p><input type="submit" name="markedmove" value="'.&mt('Move Checked to Folder').'" />');
 1100:     my @allfolders=&Apache::lonnet::getkeys('email_folders');
 1101:     if ($allfolders[0]=~/^error:/) { @allfolders=(); }
 1102:     $r->print(
 1103: 	&Apache::loncommon::select_form('','movetofolder',
 1104: 			     ( map { $_ => $_ } @allfolders))
 1105: 	      );
 1106:     my $postedstartdis=$startdis+1;
 1107:     $r->print('<input type="hidden" name="folder" value="'.$folder.'" /><input type="hidden" name="startdis" value="'.$postedstartdis.'" /><input type="hidden" name="interdis" value="'.$env{'form.interdis'}.'" /></form>');
 1108:     if ($numblocked > 0) {
 1109:         my $beginblock = &Apache::lonlocal::locallocaltime($startblock);
 1110:         my $finishblock = &Apache::lonlocal::locallocaltime($endblock);
 1111:         $r->print('<br /><br />'.
 1112:                   $numblocked.' '.&mt('message(s) is/are not viewable because display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams.'));
 1113:         &build_block_table($r,$startblock,$endblock,\%setters);
 1114:     }
 1115: }
 1116: 
 1117: # ============================================================== Compose output
 1118: 
 1119: sub compout {
 1120:     my ($r,$forwarding,$replying,$broadcast,$replycrit,$folder,$dismode)=@_;
 1121:     my $suffix=&foldersuffix($folder);
 1122: 
 1123:     if ($broadcast eq 'individual') {
 1124: 	&printheader($r,'/adm/email?compose=individual',
 1125: 	     'Send a Message');
 1126:     } elsif ($broadcast) {
 1127: 	&printheader($r,'/adm/email?compose=group',
 1128: 	     'Broadcast Message');
 1129:     } elsif ($forwarding) {
 1130: 	&Apache::lonhtmlcommon::add_breadcrumb
 1131:         ({href=>"/adm/email?display=".&Apache::lonnet::escape($forwarding),
 1132:           text=>"Display Message"});
 1133: 	&printheader($r,'/adm/email?forward='.&Apache::lonnet::escape($forwarding),
 1134: 	     'Forwarding a Message');
 1135:     } elsif ($replying) {
 1136: 	&Apache::lonhtmlcommon::add_breadcrumb
 1137:         ({href=>"/adm/email?display=".&Apache::lonnet::escape($replying),
 1138:           text=>"Display Message"});
 1139: 	&printheader($r,'/adm/email?replyto='.&Apache::lonnet::escape($replying),
 1140: 	     'Replying to a Message');
 1141:     } elsif ($replycrit) {
 1142: 	$r->print('<h3>'.&mt('Replying to a Critical Message').'</h3>');
 1143: 	$replying=$replycrit;
 1144:     } else {
 1145: 	&printheader($r,'/adm/email?compose=upload',
 1146: 	     'Distribute from Uploaded File');
 1147:     }
 1148: 
 1149:     my $dispcrit='';
 1150:     my $dissub='';
 1151:     my $dismsg='';
 1152:     my $disbase='';
 1153:     my $func=&mt('Send New');
 1154:     my %lt=&Apache::lonlocal::texthash('us' => 'Username',
 1155: 				       'do' => 'Domain',
 1156: 				       'ad' => 'Additional Recipients',
 1157: 				       'sb' => 'Subject',
 1158: 				       'ca' => 'Cancel',
 1159: 				       'ma' => 'Mail');
 1160: 
 1161:     if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
 1162: 	 my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
 1163:          $dispcrit=
 1164:  '<p><label><input type="checkbox" name="critmsg" /> '.&mt('Send as critical message').'</label> ' . $crithelp . 
 1165:  '</p><p>'.
 1166:  '<label><input type="checkbox" name="sendbck" /> '.&mt('Send as critical message').'  ' .
 1167:  &mt('and return receipt') . '</label>' . $crithelp . 
 1168:  '</p><p><label><input type="checkbox" name="permanent" /> '.
 1169: &mt('Send copy to permanent email address (if known)').'</label></p>'.
 1170: '<p><label><input type="checkbox" name="rsspost" /> '.
 1171: 		  &mt('Include in course RSS newsfeed').'</label></p>';      }
 1172:     my %message;
 1173:     my %content;
 1174:     my $defdom=$env{'user.domain'};
 1175:     if ($forwarding) {
 1176: 	%message=&Apache::lonnet::get('nohist_email'.$suffix,[$forwarding]);
 1177: 	%content=&unpackagemsg($message{$forwarding},$folder);
 1178: 	$dispcrit.='<input type="hidden" name="forwid" value="'.
 1179: 	    $forwarding.'" />';
 1180: 	$func=&mt('Forward');
 1181: 	
 1182: 	$dissub=&mt('Forwarding').': '.$content{'subject'};
 1183: 	$dismsg=&mt('Forwarded message from').' '.
 1184: 	    $content{'sendername'}.' '.&mt('at').' '.$content{'senderdomain'};
 1185: 	if ($content{'baseurl'}) {
 1186: 	    $disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />';
 1187: 	}
 1188:     }
 1189:     if ($replying) {
 1190: 	%message=&Apache::lonnet::get('nohist_email'.$suffix,[$replying]);
 1191: 	%content=&unpackagemsg($message{$replying},$folder);
 1192: 	$dispcrit.='<input type="hidden" name="replyid" value="'.
 1193: 	    $replying.'" />';
 1194: 	$func=&mt('Send Reply to');
 1195: 	
 1196: 	$dissub=&mt('Reply').': '.$content{'subject'};       
 1197: 	$dismsg='> '.$content{'message'};
 1198: 	$dismsg=~s/\r/\n/g;
 1199: 	$dismsg=~s/\f/\n/g;
 1200: 	$dismsg=~s/\n+/\n\> /g;
 1201: 	if ($content{'baseurl'}) {
 1202: 	    $disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />';
 1203: 	    if ($env{'user.adv'}) {
 1204: 		$disbase.='<label><input type="checkbox" name="storebasecomment" />'.&mt('Store message for re-use').
 1205: 		    '</label> <a href="/adm/email?showcommentbaseurl='.
 1206: 		    &Apache::lonnet::escape($content{'baseurl'}).'" target="comments">'.
 1207: 		    &mt('Show re-usable messages').'</a><br />';
 1208: 	    }
 1209: 	}
 1210:     }
 1211:     my $citation=&displayresource(%content);
 1212:     if ($env{'form.recdom'}) { $defdom=$env{'form.recdom'}; }
 1213:       $r->print(
 1214:                 '<form action="/adm/email"  name="compemail" method="post"'.
 1215:                 ' enctype="multipart/form-data">'."\n".
 1216:                 '<input type="hidden" name="sendmail" value="on" />'."\n".
 1217:                 '<table>');
 1218:     unless (($broadcast eq 'group') || ($broadcast eq 'upload')) {
 1219: 	if ($replying) {
 1220: 	    $r->print('<tr><td colspan="2">'.&mt('Replying to').' '.
 1221: 		      &Apache::loncommon::aboutmewrapper(
 1222: 							 &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('.
 1223: 		      $content{'sendername'}.'@'.
 1224: 		      $content{'senderdomain'}.')'.
 1225: 		      '<input type="hidden" name="recuname" value="'.$content{'sendername'}.'" />'.
 1226: 		      '<input type="hidden" name="recdomain" value="'.$content{'senderdomain'}.'" />'.
 1227: 		      '</td></tr>');
 1228: 	} else {
 1229: 	    my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
 1230: 	    my $selectlink=&Apache::loncommon::selectstudent_link
 1231: 	    ('compemail','recuname','recdomain');
 1232: 	    $r->print(<<"ENDREC");
 1233: <tr><td>$lt{'us'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recname'}" /></td><td rowspan="2">$selectlink</td></tr>
 1234: <tr><td>$lt{'do'}:</td>
 1235: <td>$domform</td></tr>
 1236: ENDREC
 1237:         }
 1238:     }
 1239:     my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
 1240:     if ($broadcast ne 'upload') {
 1241:        $r->print(<<"ENDCOMP");
 1242: <tr><td>$lt{'ad'}<br /><tt>username\@domain,username\@domain, ...
 1243: </tt></td><td>
 1244: <input type="text" size="50" name="additionalrec" /></td></tr>
 1245: <tr><td>$lt{'sb'}:</td><td><input type="text" size="50" name="subject" value="$dissub" />
 1246: </td></tr></table>
 1247: $latexHelp
 1248: <textarea name="message" id="message" cols="80" rows="15" wrap="hard">$dismsg
 1249: </textarea></p><br />
 1250: $dispcrit
 1251: $disbase
 1252: <input type="hidden" name="folder" value="$folder" />
 1253: <input type="hidden" name="dismode" value="$dismode" />
 1254: <input type="submit" name="send" value="$func $lt{'ma'}" />
 1255: <input type="submit" name="cancel" value="$lt{'ca'}" /><hr />
 1256: $citation
 1257: ENDCOMP
 1258:     } else { # $broadcast is 'upload'
 1259: 	$r->print(<<ENDUPLOAD);
 1260: <input type="hidden" name="sendmode" value="upload" />
 1261: <input type="hidden" name="send" value="on" />
 1262: <h3>Generate messages from a file</h3>
 1263: <p>
 1264: Subject: <input type="text" size="50" name="subject" />
 1265: </p>
 1266: <p>General message text<br />
 1267: <textarea name="message" id="message" cols="60" rows="10" wrap="hard">$dismsg
 1268: </textarea></p>
 1269: <p>
 1270: The file format for the uploaded portion of the message is:
 1271: <pre>
 1272: username1\@domain1: text
 1273: username2\@domain2: text
 1274: username3\@domain1: text
 1275: </pre>
 1276: </p>
 1277: <p>
 1278: The messages will be assembled from all lines with the respective 
 1279: <tt>username\@domain</tt>, and appended to the general message text.</p>
 1280: <p>
 1281: <input type="file" name="upfile" size="40" /></p><p>
 1282: $dispcrit
 1283: <input type="submit" value="Upload and Send" /></p>
 1284: ENDUPLOAD
 1285:     }
 1286:     if ($broadcast eq 'group') {
 1287:        &discourse;
 1288:     }
 1289:     $r->print('</form>'.
 1290: 	      &Apache::lonfeedback::generate_preview_button('compemail','message').
 1291: 	      &Apache::lonhtmlcommon::htmlareaselectactive('message'));
 1292: }
 1293: 
 1294: # ---------------------------------------------------- Display all face to face
 1295: 
 1296: sub retrieve_instructor_comments {
 1297:     my ($user,$domain)=@_;
 1298:     my $target=$env{'form.grade_target'};
 1299:     if (! $env{'request.course.id'}) { return; }
 1300:     if (! &Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
 1301: 	return;
 1302:     }
 1303:     my %records=&Apache::lonnet::dump('nohist_email',
 1304: 			 $env{'course.'.$env{'request.course.id'}.'.domain'},
 1305: 			 $env{'course.'.$env{'request.course.id'}.'.num'},
 1306:                          '%255b'.$user.'%253a'.$domain.'%255d');
 1307:     my $result='';
 1308:     foreach (sort(keys(%records))) {
 1309:         my %content=&unpackagemsg($records{$_});
 1310:         next if ($content{'senderdomain'} eq '');
 1311:         next if ($content{'subject'} !~ /^Record/);
 1312: 	# &Apache::lonfeedback::newline_to_br(\$content{'message'});
 1313: 	$result.='Recorded by '.
 1314:             $content{'sendername'}.'@'.$content{'senderdomain'}."\n";
 1315:         $result.=
 1316:             &Apache::lontexconvert::msgtexconverted($content{'message'})."\n";
 1317:      }
 1318:     return $result;
 1319: }
 1320: 
 1321: sub disfacetoface {
 1322:     my ($r,$user,$domain)=@_;
 1323:     my $target=$env{'form.grade_target'};
 1324:     unless ($env{'request.course.id'}) { return; }
 1325:     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
 1326: 	return;
 1327:     }
 1328:     my %records=&Apache::lonnet::dump('nohist_email',
 1329: 			 $env{'course.'.$env{'request.course.id'}.'.domain'},
 1330: 			 $env{'course.'.$env{'request.course.id'}.'.num'},
 1331:                          '%255b'.$user.'%253a'.$domain.'%255d');
 1332:     my $result='';
 1333:     foreach (sort keys %records) {
 1334:         my %content=&unpackagemsg($records{$_});
 1335:         next if ($content{'senderdomain'} eq '');
 1336: 	&Apache::lonfeedback::newline_to_br(\$content{'message'});
 1337:         if ($content{'subject'}=~/^Record/) {
 1338: 	    $result.='<h3>'.&mt('Record').'</h3>';
 1339:         } elsif ($content{'subject'}=~/^Broadcast/) {
 1340:             $result .='<h3>'.&mt('Broadcast Message').'</h3>';
 1341:         } else {
 1342:             $result.='<h3>'.&mt('Critical Message').'</h3>';
 1343:             %content=&unpackagemsg($content{'message'});
 1344:             $content{'message'}=
 1345:                 '<b>'.&mt('Subject').': '.$content{'subject'}.'</b><br />'.
 1346: 		$content{'message'};
 1347:         }
 1348:         $result.=&mt('By').': <b>'.
 1349: &Apache::loncommon::aboutmewrapper(
 1350:  &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
 1351: $content{'sendername'}.'@'.
 1352:             $content{'senderdomain'}.') '.$content{'time'}.
 1353:             '<br /><pre>'.
 1354:               &Apache::lontexconvert::msgtexconverted($content{'message'}).
 1355: 	      '</pre>';
 1356:      }
 1357:     # Check to see if there were any messages.
 1358:     if ($result eq '') {
 1359: 	if ($target ne 'tex') { 
 1360: 	    $r->print("<p><b>".&mt("No notes, face-to-face discussion records, critical messages, or broadcast messages in this course.")."</b></p>");
 1361: 	} else {
 1362: 	    $r->print('\textbf{'.&mt("No notes, face-to-face discussion records, critical messages or broadcast messages in this course.").'}\\\\');
 1363: 	}
 1364:     } else {
 1365:        $r->print($result);
 1366:     }
 1367: }
 1368: 
 1369: # ---------------------------------------------------------------- Face to face
 1370: 
 1371: sub facetoface {
 1372:     my ($r,$stage)=@_;
 1373:     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
 1374: 	return;
 1375:     }
 1376:     &printheader($r,
 1377: 		 '/adm/email?recordftf=query',
 1378: 		 "User Notes, Face-to-Face, Critical Messages, Broadcast Messages");
 1379: # from query string
 1380: 
 1381:     if ($env{'form.recname'}) { $env{'form.recuname'}=$env{'form.recname'}; }
 1382:     if ($env{'form.recdom'}) { $env{'form.recdomain'}=$env{'form.recdom'}; }
 1383: 
 1384:     my $defdom=$env{'user.domain'};
 1385: # already filled in
 1386:     if ($env{'form.recdomain'}) { $defdom=$env{'form.recdomain'}; }
 1387: # generate output
 1388:     my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
 1389:     my $stdbrws = &Apache::loncommon::selectstudent_link
 1390: 	('stdselect','recuname','recdomain');
 1391:     my %lt=&Apache::lonlocal::texthash('user' => 'Username',
 1392: 				       'dom' => 'Domain',
 1393: 				       'head' => 'User Notes, Records of Face-To-Face Discussions, Critical Messages, and Broadcast Messages in Course',
 1394: 				       'subm' => 'Retrieve discussion and message records',
 1395: 				       'newr' => 'New Record (record is visible to course faculty and staff)',
 1396: 				       'post' => 'Post this Record');
 1397:     $r->print(<<"ENDTREC");
 1398: <h3>$lt{'head'}</h3>
 1399: <form method="post" action="/adm/email" name="stdselect">
 1400: <input type="hidden" name="recordftf" value="retrieve" />
 1401: <table>
 1402: <tr><td>$lt{'user'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recuname'}" /></td>
 1403: <td rowspan="2">
 1404: $stdbrws
 1405: <input type="submit" value="$lt{'subm'}" /></td>
 1406: </tr>
 1407: <tr><td>$lt{'dom'}:</td>
 1408: <td>$domform</td></tr>
 1409: </table>
 1410: </form>
 1411: ENDTREC
 1412:     if (($stage ne 'query') &&
 1413:         ($env{'form.recdomain'}) && ($env{'form.recuname'})) {
 1414:         chomp($env{'form.newrecord'});
 1415:         if ($env{'form.newrecord'}) {
 1416:            &user_normal_msg_raw(
 1417:             $env{'course.'.$env{'request.course.id'}.'.num'},
 1418:             $env{'course.'.$env{'request.course.id'}.'.domain'},
 1419:             &mt('Record').
 1420: 	     ' ['.$env{'form.recuname'}.':'.$env{'form.recdomain'}.']',
 1421: 	    $env{'form.newrecord'});
 1422:         }
 1423:         $r->print('<h3>'.&Apache::loncommon::plainname($env{'form.recuname'},
 1424: 				     $env{'form.recdomain'}).'</h3>');
 1425:         &disfacetoface($r,$env{'form.recuname'},$env{'form.recdomain'});
 1426: 	$r->print(<<ENDRHEAD);
 1427: <form method="post" action="/adm/email">
 1428: <input name="recdomain" value="$env{'form.recdomain'}" type="hidden" />
 1429: <input name="recuname" value="$env{'form.recuname'}" type="hidden" />
 1430: ENDRHEAD
 1431:         $r->print(<<ENDBFORM);
 1432: <hr />$lt{'newr'}<br />
 1433: <textarea name="newrecord" cols="80" rows="10" wrap="hard"></textarea>
 1434: <br />
 1435: <input type="hidden" name="recordftf" value="post" />
 1436: <input type="submit" value="$lt{'post'}" />
 1437: </form>
 1438: ENDBFORM
 1439:     }
 1440: }
 1441: 
 1442: # ----------------------------------------------------------- Blocking during exams
 1443: 
 1444: sub examblock {
 1445:     my ($r,$action) = @_;
 1446:     unless ($env{'request.course.id'}) { return;}
 1447:     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { $r->print('Not allowed'); }
 1448:     my %lt=&Apache::lonlocal::texthash(
 1449:             'comb' => 'Communication Blocking',
 1450:             'cbds' => 'Communication blocking during scheduled exams',
 1451:             'desc' => 'You can use communication blocking to prevent students enrolled in this course from displaying LON-CAPA messages sent by other students during an online exam. As blocking of communication could potentially interrupt legitimate communication between students who are also both enrolled in a different LON-CAPA course, please be careful that you select the correct start and end times for your scheduled exam when setting or modifying these parameters.',
 1452:              'mecb' => 'Modify existing communication blocking periods',
 1453:              'ncbc' => 'No communication blocks currently stored'
 1454:     );
 1455: 
 1456:     my %ltext = &Apache::lonlocal::texthash(
 1457:             'dura' => 'Duration',
 1458:             'setb' => 'Set by',
 1459:             'even' => 'Event',
 1460:             'actn' => 'Action',
 1461:             'star' => 'Start',
 1462:             'endd' => 'End'
 1463:     );
 1464: 
 1465:     &printheader($r,'/adm/email?block=display',$lt{'comb'});
 1466:     $r->print('<h3>'.$lt{'cbds'}.'</h3>');
 1467: 
 1468:     if ($action eq 'store') {
 1469:         &blockstore($r);
 1470:     }
 1471: 
 1472:     $r->print($lt{'desc'}.'<br /><br />
 1473:                <form name="blockform" method="post" action="/adm/email?block=store">
 1474:              ');
 1475: 
 1476:     $r->print('<h4>'.$lt{'mecb'}.'</h4>');
 1477:     my %records = ();
 1478:     my $blockcount = 0;
 1479:     my $parmcount = 0;
 1480:     &get_blockdates(\%records,\$blockcount);
 1481:     if ($blockcount > 0) {
 1482:         $parmcount = &display_blocker_status($r,\%records,\%ltext);
 1483:     } else {
 1484:         $r->print($lt{'ncbc'}.'<br /><br />');
 1485:     }
 1486:     &display_addblocker_table($r,$parmcount,\%ltext);
 1487:     my $endbody=&Apache::loncommon::endbodytag();
 1488:     $r->print(<<"END");
 1489: <br />
 1490: <input type="hidden" name="blocktotal" value="$blockcount" />
 1491: <input type ="submit" value="Save Changes" />
 1492: </form>
 1493: $endbody
 1494: </html>
 1495: END
 1496:     return;
 1497: }
 1498: 
 1499: sub blockstore {
 1500:     my $r = shift;
 1501:     my %lt=&Apache::lonlocal::texthash(
 1502:             'tfcm' => 'The following changes were made',
 1503:             'cbps' => 'communication blocking period(s)',
 1504:             'werm' => 'was/were removed',
 1505:             'wemo' => 'was/were modified',
 1506:             'wead' => 'was/were added',
 1507:             'ncwm' => 'No changes were made.' 
 1508:     );
 1509:     my %adds = ();
 1510:     my %removals = ();
 1511:     my %cancels = ();
 1512:     my $modtotal = 0;
 1513:     my $canceltotal = 0;
 1514:     my $addtotal = 0;
 1515:     my %blocking = ();
 1516:     $r->print('<h3>'.$lt{'head'}.'</h3>');
 1517:     foreach (keys %env) {
 1518:         if ($_ =~ m/^form\.modify_(\w+)$/) {
 1519:             $adds{$1} = $1;
 1520:             $removals{$1} = $1;
 1521:             $modtotal ++;
 1522:         } elsif ($_ =~ m/^form\.cancel_(\d+)$/) {
 1523:             $cancels{$1} = $1;
 1524:             unless ( defined($removals{$1}) ) {
 1525:                 $removals{$1} = $1;
 1526:                 $canceltotal ++;
 1527:             }
 1528:         } elsif ($_ =~ m/^form\.add_(\d+)$/) {
 1529:             $adds{$1} = $1;
 1530:             $addtotal ++;
 1531:         }
 1532:     }
 1533: 
 1534:     foreach (keys %removals) {
 1535:         my $hashkey = $env{'form.key_'.$_};
 1536:         &Apache::lonnet::del('comm_block',["$hashkey"],
 1537:                          $env{'course.'.$env{'request.course.id'}.'.domain'},
 1538:                          $env{'course.'.$env{'request.course.id'}.'.num'}
 1539:                          );
 1540:     }
 1541:     foreach (keys %adds) {
 1542:         unless ( defined($cancels{$_}) ) {
 1543:             my ($newstart,$newend) = &get_dates_from_form($_);
 1544:             my $newkey = $newstart.'____'.$newend;
 1545:             $blocking{$newkey} = $env{'user.name'}.'@'.$env{'user.domain'}.':'.$env{'form.title_'.$_};
 1546:         }
 1547:     }
 1548:     if ($addtotal + $modtotal > 0) {
 1549:         &Apache::lonnet::put('comm_block',\%blocking,
 1550:                      $env{'course.'.$env{'request.course.id'}.'.domain'},
 1551:                      $env{'course.'.$env{'request.course.id'}.'.num'}
 1552:                      );
 1553:     }
 1554:     my $chgestotal = $canceltotal + $modtotal + $addtotal;
 1555:     if ($chgestotal > 0) {
 1556:         $r->print($lt{'tfcm'}.'<ul>');
 1557:         if ($canceltotal > 0) {
 1558:             $r->print('<li>'.$canceltotal.' '.$lt{'cbps'},' '.$lt{'werm'}.'</li>');
 1559:         }
 1560:         if ($modtotal > 0) {
 1561:             $r->print('<li>'.$modtotal.' '.$lt{'cbps'},' '.$lt{'wemo'}.'</li>');
 1562:         }
 1563:         if ($addtotal > 0) {
 1564:             $r->print('<li>'.$addtotal.' '.$lt{'cbps'},' '.$lt{'wead'}.'</li>');
 1565:         }
 1566:         $r->print('</ul>');
 1567:     } else {
 1568:         $r->print($lt{'ncwm'});
 1569:     }
 1570:     $r->print('<br />');
 1571:     return;
 1572: }
 1573: 
 1574: sub get_dates_from_form {
 1575:     my $item = shift;
 1576:     my $startdate = &Apache::lonhtmlcommon::get_date_from_form('startdate_'.$item);
 1577:     my $enddate   = &Apache::lonhtmlcommon::get_date_from_form('enddate_'.$item);
 1578:     return ($startdate,$enddate);
 1579: }
 1580: 
 1581: sub get_blockdates {
 1582:     my ($records,$blockcount) = @_;
 1583:     $$blockcount = 0;
 1584:     %{$records} = &Apache::lonnet::dump('comm_block',
 1585:                          $env{'course.'.$env{'request.course.id'}.'.domain'},
 1586:                          $env{'course.'.$env{'request.course.id'}.'.num'}
 1587:                          );
 1588:     $$blockcount = keys %{$records};
 1589:                                                                                                              
 1590:     foreach (keys %{$records}) {
 1591:         if ($_ eq 'error: 2 tie(GDBM) Failed while attempting dump') {
 1592:             $$blockcount = 0;
 1593:             last;
 1594:         }
 1595:     }
 1596: }
 1597: 
 1598: sub display_blocker_status {
 1599:     my ($r,$records,$ltext) = @_;
 1600:     my $parmcount = 0;
 1601:     my @bgcols = ("#eeeeee","#dddddd");
 1602:     my $function = &Apache::loncommon::get_users_function();
 1603:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
 1604:                                                     $env{'user.domain'});
 1605:     my %lt = &Apache::lonlocal::texthash(
 1606:         'modi' => 'Modify',
 1607:         'canc' => 'Cancel',
 1608:     );
 1609:     $r->print(<<"END");
 1610: <table border="0" cellpadding="0" cellspacing="0">
 1611:  <tr>
 1612:   <td width="100%" bgcolor="#000000">
 1613:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
 1614:     <tr>
 1615:      <td width="100%" bgcolor="#000000">
 1616:       <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
 1617:        <tr bgcolor="$color">
 1618:         <td><b>$$ltext{'dura'}</b></td>
 1619:         <td><b>$$ltext{'setb'}</b></td>
 1620:         <td><b>$$ltext{'even'}</b></td>
 1621:         <td><b>$$ltext{'actn'}?</b></td>
 1622:        </tr>
 1623: END
 1624:     foreach (sort keys %{$records}) {
 1625:         my $iter = $parmcount%2;
 1626:         my $onchange = 'onFocus="javascript:window.document.forms['.
 1627:                        "'blockform'].elements['modify_".$parmcount."'].".
 1628:                        'checked=true;"';
 1629:         my ($start,$end) = split/____/,$_;
 1630:         my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange);
 1631:         my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange);
 1632:         my ($setter,$title) = split/:/,$$records{$_};
 1633:         my ($setuname,$setudom) = split/@/,$setter;
 1634:         my $settername = &Apache::loncommon::plainname($setuname,$setudom);
 1635:         $r->print(<<"END");
 1636:        <tr bgcolor="$bgcols[$iter]">
 1637:         <td>$$ltext{'star'}:&nbsp;$startform<br/>$$ltext{'endd'}:&nbsp;&nbsp;$endform</td>
 1638:         <td>$settername</td>
 1639:         <td><input type="text" name="title_$parmcount" size="15" value="$title" /><input type="hidden" name="key_$parmcount" value="$_" /></td>
 1640:         <td><label>$lt{'modi'}?&nbsp;<input type="checkbox" name="modify_$parmcount" /></label><br /><label>$lt{'canc'}?&nbsp;&nbsp;<input type="checkbox" name="cancel_$parmcount" /></label>
 1641:        </tr>
 1642: END
 1643:         $parmcount ++;
 1644:     }
 1645:     $r->print(<<"END");
 1646:       </table>
 1647:      </td>
 1648:     </tr>
 1649:    </table>
 1650:   </td>
 1651:  </tr>
 1652: </table>
 1653: <br />
 1654: <br />
 1655: END
 1656:     return $parmcount;
 1657: }
 1658: 
 1659: sub display_addblocker_table {
 1660:     my ($r,$parmcount,$ltext) = @_;
 1661:     my $start = time;
 1662:     my $end = $start + (60 * 60 * 2); #Default is an exam of 2 hours duration.
 1663:     my $onchange = 'onFocus="javascript:window.document.forms['.
 1664:                    "'blockform'].elements['add_".$parmcount."'].".
 1665:                    'checked=true;"';
 1666:     my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange);
 1667:     my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange);
 1668:     my $function = &Apache::loncommon::get_users_function();
 1669:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
 1670:                                                     $env{'user.domain'});
 1671:     my %lt = &Apache::lonlocal::texthash(
 1672:         'addb' => 'Add block',
 1673:         'exam' => 'e.g., Exam 1',
 1674:         'addn' => 'Add new communication blocking periods'
 1675:     );
 1676:     $r->print(<<"END");
 1677: <h4>$lt{'addn'}</h4> 
 1678: <table border="0" cellpadding="0" cellspacing="0">
 1679:  <tr>
 1680:   <td width="100%" bgcolor="#000000">
 1681:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
 1682:     <tr>
 1683:      <td width="100%" bgcolor="#000000">
 1684:       <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
 1685:        <tr bgcolor="#CCCCFF">
 1686:         <td><b>$$ltext{'dura'}</b></td>
 1687:         <td><b>$$ltext{'even'} $lt{'exam'}</b></td>
 1688:         <td><b>$$ltext{'actn'}?</b></td>
 1689:        </tr>
 1690:        <tr bgcolor="#eeeeee">
 1691:         <td>$$ltext{'star'}:&nbsp;$startform<br />$$ltext{'endd'}:&nbsp;&nbsp;$endform</td>
 1692:         <td><input type="text" name="title_$parmcount" size="15" value="" /></td>
 1693:         <td><label>$lt{'addb'}?&nbsp;<input type="checkbox" name="add_$parmcount" value="1" /></label></td>
 1694:        </tr>
 1695:       </table>
 1696:      </td>
 1697:     </tr>
 1698:    </table>
 1699:   </td>
 1700:  </tr>
 1701: </table>
 1702: END
 1703:     return;
 1704: }
 1705: 
 1706: sub blockcheck {
 1707:     my ($setters,$startblock,$endblock) = @_;
 1708:     # Retrieve active student roles and active course coordinator/instructor roles
 1709:     my @livecses = ();
 1710:     my @staffcses = ();
 1711:     $$startblock = 0;
 1712:     $$endblock = 0;
 1713:     foreach (keys %env) {
 1714:         if ($_ =~ m-^user\.role\.(st|cc|in)\./(.+)$-) {
 1715:             my $role = $1;
 1716:             my $cse = $2;
 1717:             $cse =~ s|/|_|;
 1718:             if ($env{$_} =~ m/^(\d*)\.(\d*)$/) {
 1719:                 unless (($2 > 0 && $2 < time) || ($1 > time)) {
 1720:                     if ($role eq 'st') {
 1721:                         push @livecses, $cse;
 1722:                     } else {
 1723:                         unless (grep/^$cse$/,@staffcses) {
 1724:                             push @staffcses, $cse;
 1725:                         }
 1726:                     }
 1727:                 }
 1728:             }
 1729:         } elsif ($_ =~ m-user\.role\.cr/(\w+)/(\w+)/([^/]+)\./(.+)$- ) { 
 1730:             my $rolepriv = $env{'user.role..rolesdef_'.$3};
 1731:         }
 1732:     }
 1733:     # Retrieve blocking times and identity of blocker for active courses for students.
 1734:     if (@livecses > 0) {
 1735:         foreach my $cse (@livecses) {
 1736:             my ($cdom,$crs) = split/_/,$cse;
 1737:             if ( (grep/^$cse$/,@staffcses) && ($env{'request.role'} !~ m-^st\./$cdom/$crs$-) ) {
 1738:                 next;
 1739:             } else {
 1740:                 %{$$setters{$cse}} = ();
 1741:                 @{$$setters{$cse}{'staff'}} = ();
 1742:                 @{$$setters{$cse}{'times'}} = ();
 1743:                 my %records = &Apache::lonnet::dump('comm_block',$cdom,$crs);
 1744:                 foreach (keys %records) {
 1745:                     if ($_ =~ m/^(\d+)____(\d+)$/) {
 1746:                         if ($1 <= time && $2 >= time) {
 1747:                             my ($staff,$title) = split/:/,$records{$_};
 1748:                             push @{$$setters{$cse}{'staff'}}, $staff;
 1749:                             push @{$$setters{$cse}{'times'}}, $_;
 1750:                             if ( ($$startblock == 0) || ($$startblock > $1) ) {
 1751:                                 $$startblock = $1;
 1752:                             }
 1753:                             if ( ($$endblock == 0) || ($$endblock < $2) ) {
 1754:                                 $$endblock = $2;
 1755:                             }
 1756:                         }
 1757:                     }
 1758:                 }
 1759:             }
 1760:         }
 1761:     }
 1762: }
 1763: 
 1764: sub build_block_table {
 1765:     my ($r,$startblock,$endblock,$setters) = @_;
 1766:     my $function = &Apache::loncommon::get_users_function();
 1767:     my $color = &Apache::loncommon::designparm($function.'.tabbg',
 1768:                                                     $env{'user.domain'});
 1769:     my %lt = &Apache::lonlocal::texthash(
 1770:         'cacb' => 'Currently active communication blocks',
 1771:         'cour' => 'Course',
 1772:         'dura' => 'Duration',
 1773:         'blse' => 'Block set by'
 1774:     ); 
 1775:     $r->print(<<"END");
 1776: <br /<br />$lt{'cacb'}:<br /><br />
 1777: <table border="0" cellpadding="0" cellspacing="0">
 1778:  <tr>
 1779:   <td width="100%" bgcolor="#000000">
 1780:    <table width="100%" border="0" cellpadding="1" cellspacing="0">
 1781:     <tr>
 1782:      <td width="100%" bgcolor="#000000">
 1783:       <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
 1784:        <tr bgcolor="$color">
 1785:         <td><b>$lt{'cour'}</b></td>
 1786:         <td><b>$lt{'dura'}</b></td>
 1787:         <td><b>$lt{'blse'}</b></td>
 1788:        </tr>
 1789: END
 1790:     foreach (keys %{$setters}) {
 1791:         my %courseinfo=&Apache::lonnet::coursedescription($_);
 1792:         for (my $i=0; $i<@{$$setters{$_}{staff}}; $i++) {
 1793:             my ($uname,$udom) = split/\@/,$$setters{$_}{staff}[$i];
 1794:             my $fullname = &Apache::loncommon::plainname($uname,$udom);
 1795:             my ($openblock,$closeblock) = split/____/,$$setters{$_}{times}[$i];
 1796:             $openblock = &Apache::lonlocal::locallocaltime($openblock);
 1797:             $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
 1798:             $r->print('<tr><td>'.$courseinfo{'description'}.'</td>'.
 1799:                       '<td>'.$openblock.' to '.$closeblock.'</td>'.
 1800:                       '<td>'.$fullname.' ('.$uname.'@'.$udom.
 1801:                       ')</td></tr>');
 1802:         }
 1803:     }
 1804:     $r->print('</table></td></tr></table></td></tr></table>');
 1805: }
 1806: 
 1807: # ----------------------------------------------------------- Display a message
 1808: 
 1809: sub displaymessage {
 1810:     my ($r,$msgid,$folder)=@_;
 1811:     my $suffix=&foldersuffix($folder);
 1812:     my %blocked = ();
 1813:     my %setters = ();
 1814:     my $startblock = 0;
 1815:     my $endblock = 0;
 1816:     my $numblocked = 0;
 1817: # info to generate "next" and "previous" buttons and check if message is blocked
 1818:     &blockcheck(\%setters,\$startblock,\$endblock);
 1819:     my @messages=&sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
 1820:     if ( $blocked{$msgid} eq 'ON' ) {
 1821:         &printheader($r,'/adm/email',&mt('Display a Message'));
 1822:         $r->print(&mt('You attempted to display a message that is currently blocked because you are enrolled in one or more courses for which there is an ongoing online exam.'));
 1823:         &build_block_table($r,$startblock,$endblock,\%setters);
 1824:         return;
 1825:     }
 1826:     &statuschange($msgid,'read',$folder);
 1827:     my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
 1828:     my %content=&unpackagemsg($message{$msgid});
 1829: 
 1830:     my $counter=0;
 1831:     $r->print('<pre>');
 1832:     my $escmsgid=&Apache::lonnet::escape($msgid);
 1833:     foreach (@messages) {
 1834: 	if ($_->[5] eq $escmsgid){
 1835: 	    last;
 1836: 	}
 1837: 	$counter++;
 1838:     }
 1839:     $r->print('</pre>');
 1840:     my $number_of_messages = scalar(@messages); #subtract 1 for last index
 1841: # start output
 1842:     &printheader($r,'/adm/email?display='.&Apache::lonnet::escape($msgid),'Display a Message','',$content{'baseurl'});
 1843:     my %courseinfo=&Apache::lonnet::coursedescription($content{'courseid'});
 1844: # Functions
 1845:     $r->print('<table border="2" width="100%"><tr bgcolor="#FFFFAA"><td>'.&mt('Functions').':</td>'.
 1846: 	      '<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid).$sqs.
 1847: 	      '"><b>'.&mt('Reply').'</b></a></td>'.
 1848: 	      '<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid).$sqs.
 1849: 	      '"><b>'.&mt('Forward').'</b></a></td>'.
 1850: 	      '<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid).$sqs.
 1851: 	      '"><b>'.&mt('Mark Unread').'</b></a></td>'.
 1852: 	      '<td><a href="/adm/email?markdel='.&Apache::lonnet::escape($msgid).$sqs.
 1853: 	      '"><b>'.&mt('Delete').'</b></a></td>'.
 1854: 	      '<td><a href="/adm/email?'.$sqs.
 1855: 	      ($env{'form.dismode'} eq 'new'?'&folder=new':'').
 1856: 	      '"><b>'.&mt('Back to Folder Display').'</b></a></td>');
 1857:     if ($counter > 0){
 1858: 	$r->print('<td><a href="/adm/email?display='.$messages[$counter-1]->[5].$sqs.
 1859: 		  '"><b>'.&mt('Previous').'</b></a></td>');
 1860:     }
 1861:     if ($counter < $number_of_messages - 1){
 1862: 	$r->print('<td><a href="/adm/email?display='.$messages[$counter+1]->[5].$sqs.
 1863: 		  '"><b>'.&mt('Next').'</b></a></td>');
 1864:     }
 1865:     $r->print('</tr></table>');
 1866:     if ($env{'user.adv'}) {
 1867: 	$r->print('<table border="2" width="100%"><tr bgcolor="#FFAAAA"><td>'.&mt('Currently available actions (will open extra window)').':</td>');
 1868: 	my $symb=&Apache::lonnet::symbread($content{'baseurl'});      
 1869: 	if (&Apache::lonnet::allowed('vgr',$env{'request.course.id'})) {
 1870: 		$r->print('<td><b>'.&Apache::loncommon::track_student_link(&mt('View recent activity'),$content{'sendername'},$content{'senderdomain'},'check').'</b></td>');
 1871: 	    }
 1872: 	if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) && $symb) {
 1873: 	    $r->print('<td><b>'.&Apache::loncommon::pprmlink(&mt('Set/Change parameters'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>');
 1874: 	}
 1875: 	if (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}) && $symb) {
 1876: 	    $r->print('<td><b>'.&Apache::loncommon::pgrdlink(&mt('Set/Change grades'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>');
 1877: 	}
 1878: 	$r->print('</tr></table>');
 1879:     }
 1880:     my $tolist;
 1881:     my @recipients = ();
 1882:     for (my $i=0; $i<@{$content{'recuser'}}; $i++) {
 1883:         $recipients[$i] =  &Apache::loncommon::aboutmewrapper(
 1884:            &Apache::loncommon::plainname($content{'recuser'}[$i],
 1885:                                       $content{'recdomain'}[$i]),
 1886:               $content{'recuser'}[$i],$content{'recdomain'}[$i]).
 1887:        ' ('.$content{'recuser'}[$i].' at '.$content{'recdomain'}[$i].') ';
 1888:     }
 1889:     $tolist = join(', ',@recipients);
 1890:     $r->print('<br /><b>'.&mt('Subject').':</b> '.$content{'subject'}.
 1891: 	      ($folder ne 'sent'?'<br /><b>'.&mt('From').':</b> '.
 1892: 	      &Apache::loncommon::aboutmewrapper(
 1893: 						 &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),
 1894: 						 $content{'sendername'},$content{'senderdomain'}).' ('.
 1895: 	      $content{'sendername'}.' at '.
 1896: 	      $content{'senderdomain'}.') ':'<br /><b>'.&mt('To').':</b> '.
 1897:               $tolist).
 1898: 	      ($content{'courseid'}?'<br /><b>'.&mt('Course').':</b> '.$courseinfo{'description'}.
 1899: 	       ($content{'coursesec'}?' ('.&mt('Group/Section').': '.$content{'coursesec'}.')':''):'').
 1900: 	      '<br /><b>'.&mt('Time').':</b> '.$content{'time'}.
 1901: 	      ($content{'baseurl'}?'<br /><b>'.&mt('Refers to').':</b> <a href="'.$content{'baseurl'}.'">'.
 1902: 	       $content{'baseurl'}.' ('.&Apache::lonnet::gettitle($content{'baseurl'}).')</a>':'').
 1903: 	      '<p><pre>'.
 1904: 	      &Apache::lontexconvert::msgtexconverted($content{'message'},1).
 1905: 	      '</pre><hr />'.&displayresource(%content).'</p>');
 1906:     return;   
 1907: }
 1908: 
 1909: # =========================================================== Show the citation
 1910: 
 1911: sub displayresource {
 1912:     my %content=@_;
 1913: #
 1914: # If the recipient is in the same course that the message was sent from and
 1915: # has sufficient privileges, show "all details," else show citation
 1916: #
 1917:     if (($env{'request.course.id'} eq $content{'courseid'})
 1918:      && (&Apache::lonnet::allowed('vgr',$content{'courseid'}))) {
 1919: 	my $symb=&Apache::lonnet::symbread($content{'baseurl'});
 1920: # Could not get a symb, give up
 1921: 	unless ($symb) { return $content{'citation'}; }
 1922: # Have a symb, can render
 1923: 	return '<h2>'.&mt('Current attempts of student (if applicable)').'</h2>'.
 1924: 	    &Apache::loncommon::get_previous_attempt($symb,
 1925: 						     $content{'sendername'},
 1926: 						     $content{'senderdomain'},
 1927: 						     $content{'courseid'}).
 1928: 	    '<hr /><h2>'.&mt('Current screen output (if applicable)').'</h2>'.
 1929: 	    &Apache::loncommon::get_student_view($symb,
 1930: 						 $content{'sendername'},
 1931: 						 $content{'senderdomain'},
 1932: 						 $content{'courseid'}).
 1933: 	    '<h2>'.&mt('Correct Answer(s) (if applicable)').'</h2>'.
 1934: 	    &Apache::loncommon::get_student_answers($symb,
 1935: 						    $content{'sendername'},
 1936: 						    $content{'senderdomain'},
 1937: 						    $content{'courseid'});
 1938:     } else {
 1939: 	return $content{'citation'};
 1940:     }
 1941: }
 1942: 
 1943: # ================================================================== The Header
 1944: 
 1945: sub header {
 1946:     my ($r,$title,$baseurl)=@_;
 1947:     $r->print(&Apache::lonxml::xmlbegin().
 1948: 	      '<head>'.&Apache::lonxml::fontsettings().
 1949: 	      '<title>Communication and Messages</title>'.
 1950: 	      &Apache::lonhtmlcommon::htmlareaheaders());
 1951:     if ($baseurl) {
 1952: 	$r->print("<base href=\"http://$ENV{'SERVER_NAME'}/$baseurl\" />");
 1953:     }
 1954:     $r->print(&Apache::loncommon::studentbrowser_javascript().'</head>'.
 1955: 	      &Apache::loncommon::bodytag('Communication and Messages'));
 1956:         $r->print(&Apache::lonhtmlcommon::breadcrumbs
 1957:                   (undef,($title?$title:'Communication and Messages')));
 1958: 
 1959: }
 1960: 
 1961: # ---------------------------------------------------------------- Print header
 1962: 
 1963: sub printheader {
 1964:     my ($r,$url,$desc,$title,$baseurl)=@_;
 1965:     &Apache::lonhtmlcommon::add_breadcrumb
 1966: 	({href=>$url,
 1967: 	  text=>$desc});
 1968:     &header($r,$title,$baseurl);
 1969: }
 1970: 
 1971: # ------------------------------------------------------------ Store the comment
 1972: 
 1973: sub storecomment {
 1974:     my ($r)=@_;
 1975:     my $msgtxt=&Apache::lonfeedback::clear_out_html($env{'form.message'});
 1976:     my $cleanmsgtxt='';
 1977:     foreach (split(/[\n\r]/,$msgtxt)) {
 1978: 	unless ($_=~/^\s*(\>|\&gt\;)/) {
 1979: 	    $cleanmsgtxt.=$_."\n";
 1980: 	}
 1981:     }
 1982:     my $key=&Apache::lonnet::escape($env{'form.baseurl'}).'___'.time;
 1983:     &Apache::lonnet::put('nohist_stored_comments',{ $key => $cleanmsgtxt });
 1984: }
 1985: 
 1986: sub storedcommentlisting {
 1987:     my ($r)=@_;
 1988:     my %msgs=&Apache::lonnet::dump('nohist_stored_comments',undef,undef,
 1989:        '^'.&Apache::lonnet::escape(&Apache::lonnet::escape($env{'form.showcommentbaseurl'})));
 1990:     $r->print(&Apache::lonxml::xmlbegin().'<head>'.
 1991: 	      &Apache::lonxml::fontsettings().'</head><body>');
 1992:     if ((keys %msgs)[0]=~/^error\:/) {
 1993: 	$r->print(&mt('No stored comments yet.'));
 1994:     } else {
 1995: 	my $found=0;
 1996: 	foreach (sort keys %msgs) {
 1997: 	    $r->print("\n".$msgs{$_}."<hr />");
 1998: 	    $found=1;
 1999: 	}
 2000: 	unless ($found) {
 2001: 	    $r->print(&mt('No stored comments yet for this resource.'));
 2002: 	}
 2003:     }
 2004: }
 2005: 
 2006: # ---------------------------------------------------------------- Send an email
 2007: 
 2008: sub sendoffmail {
 2009:     my ($r,$folder)=@_;
 2010:     my $suffix=&foldersuffix($folder);
 2011:     my $sendstatus='';
 2012:     my %broadcast_status;
 2013:     my $numbroadcast = 0;
 2014:     if ($env{'form.send'}) {
 2015: 	&printheader($r,'','Messages being sent.');
 2016: 	$r->rflush();
 2017: 	my %content=();
 2018: 	undef %content;
 2019: 	if ($env{'form.forwid'}) {
 2020: 	    my $msgid=$env{'form.forwid'};
 2021: 	    my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
 2022: 	    %content=&unpackagemsg($message{$msgid},1);
 2023: 	    &statuschange($msgid,'forwarded',$folder);
 2024: 	    $env{'form.message'}.="\n\n-- Forwarded message --\n\n".
 2025: 		$content{'message'};
 2026: 	}
 2027: 	if ($env{'form.replyid'}) {
 2028: 	    my $msgid=$env{'form.replyid'};
 2029: 	    my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
 2030: 	    %content=&unpackagemsg($message{$msgid},1);
 2031: 	    &statuschange($msgid,'replied',$folder);
 2032: 	}
 2033: 	my %toaddr=();
 2034: 	undef %toaddr;
 2035: 	if ($env{'form.sendmode'} eq 'group') {
 2036: 	    foreach (keys %env) {
 2037: 		if ($_=~/^form\.send\_to\_\&\&\&[^\&]*\&\&\&\_(.+)$/) {
 2038: 		    $toaddr{$1}='';
 2039: 		}
 2040: 	    }
 2041: 	} elsif ($env{'form.sendmode'} eq 'upload') {
 2042: 	    foreach (split(/[\n\r\f]+/,$env{'form.upfile'})) {
 2043: 		my ($rec,$txt)=split(/\s*\:\s*/,$_);
 2044: 		if ($txt) {
 2045: 		    $rec=~s/\@/\:/;
 2046: 		    $toaddr{$rec}.=$txt."\n";
 2047: 		}
 2048: 	    }
 2049: 	} else {
 2050: 	    $toaddr{$env{'form.recuname'}.':'.$env{'form.recdomain'}}='';
 2051: 	}
 2052: 	if ($env{'form.additionalrec'}) {
 2053: 	    foreach (split(/\,/,$env{'form.additionalrec'})) {
 2054: 		my ($auname,$audom)=split(/\@/,$_);
 2055: 		$toaddr{$auname.':'.$audom}='';
 2056: 	    }
 2057: 	}
 2058: 
 2059:         my $basicmsg;
 2060:         my $msgtype;
 2061:         if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
 2062:             (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) {
 2063:             $basicmsg=&Apache::lonfeedback::clear_out_html($env{'form.message'},1);
 2064:             $msgtype = '(critical)';
 2065:         } else {
 2066:             $basicmsg=&Apache::lonfeedback::clear_out_html($env{'form.message'});
 2067:         }
 2068: 	
 2069: 	foreach (keys %toaddr) {
 2070: 	    my ($recuname,$recdomain)=split(/\:/,$_);
 2071:             my $msgtxt = $basicmsg;
 2072: 	    if ($toaddr{$_}) { $msgtxt.='<hr />'.$toaddr{$_}; }
 2073: 	    my $thismsg;
 2074: 	    if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) && 
 2075: 		(&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) {
 2076: 		$r->print(&mt('Sending critical message').' '.$recuname.'@'.$recdomain.': ');
 2077: 		$thismsg=&user_crit_msg($recuname,$recdomain,
 2078: 					&Apache::lonfeedback::clear_out_html($env{'form.subject'}),
 2079: 					$msgtxt,
 2080: 					$env{'form.sendbck'},$env{'form.permanent'});
 2081: 	    } else {
 2082: 		$r->print(&mt('Sending').' '.$recuname.'@'.$recdomain.': ');
 2083: 		$thismsg=&user_normal_msg($recuname,$recdomain,
 2084: 					  &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
 2085: 					  $msgtxt,
 2086: 					  $content{'citation'},undef,undef,$env{'form.permanent'});
 2087:             }
 2088: 	    if (($env{'request.course.id'}) && 
 2089:                                          ($env{'form.sendmode'} eq 'group')) {
 2090: 	        $broadcast_status{$recuname.':'.$recdomain}  = $thismsg;
 2091:                 if ($thismsg eq 'ok') {
 2092:                     $numbroadcast ++;
 2093:                 }
 2094: 	    }
 2095: 	    $r->print($thismsg.'<br />');
 2096: 	    $sendstatus.=' '.$thismsg;
 2097: 	}
 2098:         if (($env{'request.course.id'}) && ($env{'form.sendmode'} eq 'group')) {
 2099:             my $subj_prefix;
 2100:             if ($msgtype eq 'critical') {
 2101:                 $subj_prefix = 'Critical broadcast';
 2102:             } else {
 2103:                 $subj_prefix = 'Broadcast';
 2104:             }
 2105:             my ($broadmsgid,$broadresult);
 2106:             if ($numbroadcast) {
 2107:                 $broadresult = &user_normal_msg_raw(
 2108:                     $env{'course.'.$env{'request.course.id'}.'.num'},
 2109:                     $env{'course.'.$env{'request.course.id'}.'.domain'},                $subj_prefix.' to: '.$env{'course.'.$env{'request.course.id'}.'.description'}.
 2110:                     ' ('.$numbroadcast.' sent)',$basicmsg,undef,undef,undef,
 2111:                     undef,\$broadmsgid);
 2112:             }
 2113:             if ($broadresult eq 'ok') {
 2114:                 my $record_sent;
 2115:                 my @recusers = ();
 2116:                 my @recudoms = ();
 2117:                 foreach my $recipient (sort(keys(%toaddr))) {
 2118:                     if ($broadcast_status{$recipient} eq 'ok') {
 2119:                         my ($uname,$udom) = split/:/,$recipient;
 2120:                         push(@recusers,$uname);
 2121:                         push(@recudoms,$udom);
 2122:                     }
 2123:                 }
 2124:                 if (@recusers) {
 2125:                     my $broadmessage;
 2126:                     ($broadmsgid,$broadmessage)=&packagemsg(&Apache::lonfeedback::clear_out_html($env{'form.subject'}),$basicmsg,undef,undef,undef,\@recusers,\@recudoms,$broadmsgid);
 2127:                     $record_sent = &store_sent_mail($broadmsgid,$broadmessage);
 2128:                 }
 2129:             } else {
 2130:                 &Apache::lonnet::logthis('Failed to create record of broadcast in '.$env{'course.'.$env{'request.course.id'}.'.num'}.' at '.$env{'course.'.$env{'request.course.id'}.'.domain'}.' - no msgid generated');
 2131:             }
 2132:         }
 2133:     } else {
 2134: 	&printheader($r,'','No messages sent.'); 
 2135:     }
 2136:     if ($sendstatus=~/^(\s*(?:ok|con_delayed)\s*)*$/) {
 2137: 	$r->print('<br /><font color="green">'.&mt('Completed.').'</font>');
 2138: 	if ($env{'form.displayedcrit'}) {
 2139: 	    &discrit($r);
 2140: 	} else {
 2141: 	    &Apache::loncommunicate::menu($r);
 2142: 	}
 2143:     } else {
 2144: 	$r->print(
 2145: 		  '<h2><font color="red">'.&mt('Could not deliver message').'</font></h2>'.
 2146: 		  &mt('Please use the browser "Back" button and correct the recipient addresses')
 2147: 		  );
 2148:     }
 2149: }
 2150: 
 2151: # ===================================================================== Handler
 2152: 
 2153: sub handler {
 2154:     my $r=shift;
 2155: 
 2156: # ----------------------------------------------------------- Set document type
 2157:     
 2158:     &Apache::loncommon::content_type($r,'text/html');
 2159:     $r->send_http_header;
 2160:     
 2161:     return OK if $r->header_only;
 2162:     
 2163: # --------------------------- Get query string for limited number of parameters
 2164:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
 2165:         ['display','replyto','forward','markread','markdel','markunread',
 2166:          'sendreply','compose','sendmail','critical','recname','recdom',
 2167:          'recordftf','sortedby','block','folder','startdis','interdis',
 2168: 	 'showcommentbaseurl','dismode']);
 2169:     $sqs='&sortedby='.$env{'form.sortedby'};
 2170: 
 2171: # ------------------------------------------------------ They checked for email
 2172:     unless ($env{'form.block'}) {
 2173:         &Apache::lonnet::put('email_status',{'recnewemail'=>0});
 2174:     }
 2175: 
 2176: # ----------------------------------------------------------------- Breadcrumbs
 2177: 
 2178:     &Apache::lonhtmlcommon::clear_breadcrumbs();
 2179:     &Apache::lonhtmlcommon::add_breadcrumb
 2180:         ({href=>"/adm/communicate",
 2181:           text=>"Communication/Messages",
 2182:           faq=>12,bug=>'Communication Tools',});
 2183: 
 2184: # ------------------------------------------------------------------ Get Folder
 2185: 
 2186:     my $folder=$env{'form.folder'};
 2187:     unless ($folder) { 
 2188: 	$folder=''; 
 2189:     } else {
 2190: 	$sqs.='&folder='.&Apache::lonnet::escape($folder);
 2191:     }
 2192: # ------------------------------------------------------------ Get Display Mode
 2193: 
 2194:     my $dismode=$env{'form.dismode'};
 2195:     unless ($dismode) { 
 2196: 	$dismode=''; 
 2197:     } else {
 2198: 	$sqs.='&dismode='.&Apache::lonnet::escape($dismode);
 2199:     }
 2200: 
 2201: # --------------------------------------------------------------------- Display
 2202: 
 2203:     $startdis=$env{'form.startdis'};
 2204:     $startdis--;
 2205:     unless ($startdis) { $startdis=0; }
 2206: 
 2207:     $interdis=$env{'form.interdis'};
 2208:     unless ($interdis) { $interdis=20; }
 2209:     $sqs.='&interdis='.$interdis;
 2210: 
 2211:     if ($env{'form.firstview'}) {
 2212: 	$startdis=0;
 2213:     }
 2214:     if ($env{'form.lastview'}) {
 2215: 	$startdis=-1;
 2216:     }
 2217:     if ($env{'form.prevview'}) {
 2218: 	$startdis--;
 2219:     }
 2220:     if ($env{'form.nextview'}) {
 2221: 	$startdis++;
 2222:     }
 2223:     my $postedstartdis=$startdis+1;
 2224:     $sqs.='&startdis='.$postedstartdis;
 2225: 
 2226: # --------------------------------------------------------------- Render Output
 2227: 
 2228:     if ($env{'form.display'}) {
 2229: 	&displaymessage($r,$env{'form.display'},$folder);
 2230:     } elsif ($env{'form.replyto'}) {
 2231: 	&compout($r,'',$env{'form.replyto'},undef,undef,$folder,$dismode);
 2232:     } elsif ($env{'form.confirm'}) {
 2233: 	&printheader($r,'','Confirmed Receipt');
 2234: 	foreach (keys %env) {
 2235: 	    if ($_=~/^form\.rec\_(.*)$/) {
 2236: 		$r->print('<b>'.&mt('Confirming Receipt').':</b> '.
 2237: 			  &user_crit_received($1).'<br>');
 2238: 	    }
 2239: 	    if ($_=~/^form\.reprec\_(.*)$/) {
 2240: 		my $msgid=$1;
 2241: 		$r->print('<b>'.&mt('Confirming Receipt').':</b> '.
 2242: 			  &user_crit_received($msgid).'<br>');
 2243: 		&compout($r,'','','',$msgid);
 2244: 	    }
 2245: 	}
 2246: 	&discrit($r);
 2247:     } elsif ($env{'form.critical'}) {
 2248: 	&printheader($r,'','Displaying Critical Messages');
 2249: 	&discrit($r);
 2250:     } elsif ($env{'form.forward'}) {
 2251: 	&compout($r,$env{'form.forward'},undef,undef,undef,$folder);
 2252:     } elsif ($env{'form.markdel'}) {
 2253: 	&printheader($r,'','Deleted Message');
 2254: 	&statuschange($env{'form.markdel'},'deleted',$folder);
 2255: 	&Apache::loncommunicate::menu($r);
 2256: 	&disall($r,($folder?$folder:$dismode));
 2257:     } elsif ($env{'form.markedmove'}) {
 2258: 	my $total=0;
 2259: 	foreach (keys %env) {
 2260: 	    if ($_=~/^form\.delmark_(.*)$/) {
 2261: 		&movemsg(&Apache::lonnet::unescape($1),$folder,
 2262: 			 $env{'form.movetofolder'});
 2263: 		$total++;
 2264: 	    }
 2265: 	}
 2266: 	&printheader($r,'','Moved Messages');
 2267: 	$r->print('Moved '.$total.' message(s)<p>');
 2268: 	&Apache::loncommunicate::menu($r);
 2269: 	&disall($r,($folder?$folder:$dismode));
 2270:     } elsif ($env{'form.markeddel'}) {
 2271: 	my $total=0;
 2272: 	foreach (keys %env) {
 2273: 	    if ($_=~/^form\.delmark_(.*)$/) {
 2274: 		&statuschange(&Apache::lonnet::unescape($1),'deleted',$folder);
 2275: 		$total++;
 2276: 	    }
 2277: 	}
 2278: 	&printheader($r,'','Deleted Messages');
 2279: 	$r->print('Deleted '.$total.' message(s)<p>');
 2280: 	&Apache::loncommunicate::menu($r);
 2281: 	&disall($r,($folder?$folder:$dismode));
 2282:     } elsif ($env{'form.markunread'}) {
 2283: 	&printheader($r,'','Marked Message as Unread');
 2284: 	&statuschange($env{'form.markunread'},'new');
 2285: 	&Apache::loncommunicate::menu($r);
 2286: 	&disall($r,($folder?$folder:$dismode));
 2287:     } elsif ($env{'form.compose'}) {
 2288: 	&compout($r,'','',$env{'form.compose'});
 2289:     } elsif ($env{'form.recordftf'}) {
 2290: 	&facetoface($r,$env{'form.recordftf'});
 2291:     } elsif ($env{'form.block'}) {
 2292:         &examblock($r,$env{'form.block'});
 2293:     } elsif ($env{'form.sendmail'}) {
 2294: 	&sendoffmail($r,$folder);
 2295: 	if ($env{'form.storebasecomment'}) {
 2296: 	    &storecomment($r);
 2297: 	}
 2298: 	if (($env{'form.rsspost'}) && ($env{'request.course.id'})) {
 2299: 	    &Apache::lonrss::addentry($env{'course.'.$env{'request.course.id'}.'.num'},
 2300: 				      $env{'course.'.$env{'request.course.id'}.'.domain'},
 2301: 				      'Course_Announcements',
 2302: 				      $env{'form.subject'},
 2303: 				      $env{'form.message'},'/adm/communicate','public');
 2304: 	}
 2305: 	&disall($r,($folder?$folder:$dismode));
 2306:     } elsif ($env{'form.newfolder'}) {
 2307: 	&printheader($r,'','New Folder');
 2308: 	&makefolder($env{'form.newfolder'});
 2309: 	&Apache::loncommunicate::menu($r);
 2310: 	&disall($r,$env{'form.newfolder'});
 2311:     } elsif ($env{'form.showcommentbaseurl'}) {
 2312: 	&storedcommentlisting($r);
 2313:     } else {
 2314: 	&printheader($r,'','Display All Messages');
 2315: 	&Apache::loncommunicate::menu($r); 
 2316: 	&disall($r,($folder?$folder:$dismode));
 2317:     }
 2318:     $r->print(&Apache::loncommon::endbodytag().'</html>');
 2319:     return OK;
 2320: }
 2321: # ================================================= Main program, reset counter
 2322: 
 2323: BEGIN {
 2324:     $msgcount=0;
 2325: }
 2326: 
 2327: =pod
 2328: 
 2329: =back
 2330: 
 2331: =cut
 2332: 
 2333: 1; 
 2334: 
 2335: __END__
 2336: 
 2337: 
 2338: 
 2339: 
 2340: 
 2341: 
 2342: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>