File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.57: download - view: text, annotated - select for diffs
Sat Jul 5 10:07:11 2003 UTC (20 years, 11 months ago) by www
Branches: MAIN
CVS tags: version_1_0_3, version_1_0_2, version_1_0_1, version_1_0_0, version_0_99_5, version_0_99_4, HEAD
Have very limited connectivity, need to do big commit while online.
Will call this JULYone in Bugzilla. Fixes several small bugs.

    1: # The LearningOnline Network with CAPA
    2: # Routines for messaging
    3: #
    4: # $Id: lonmsg.pm,v 1.57 2003/07/05 10:07:11 www 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: # (Routines to control the menu
   30: #
   31: # (TeX Conversion Module
   32: #
   33: # 05/29/00,05/30 Gerd Kortemeyer)
   34: #
   35: # 10/05 Gerd Kortemeyer)
   36: #
   37: # 10/19,10/20,10/30,
   38: # 02/06/01 Gerd Kortemeyer
   39: # 07/27 Guy Albertelli
   40: # 07/27,07/28,07/30,08/03,08/06,08/08,08/09,08/10,8/13,8/15,
   41: # 10/1,11/5 Gerd Kortemeyer
   42: # YEAR=2002
   43: # 1/1,3/18 Gerd Kortemeyer
   44: #
   45: package Apache::lonmsg;
   46: 
   47: use strict;
   48: use Apache::lonnet();
   49: use vars qw($msgcount);
   50: use HTML::TokeParser();
   51: use Apache::Constants qw(:common);
   52: use Apache::loncommon();
   53: use Apache::lontexconvert();
   54: use HTML::Entities();
   55: use Mail::Send;
   56: 
   57: # ===================================================================== Package
   58: 
   59: sub packagemsg {
   60:     my ($subject,$message,$citation,$baseurl,$attachmenturl)=@_;
   61:     $message =&HTML::Entities::encode($message);
   62:     $citation=&HTML::Entities::encode($citation);
   63:     $subject =&HTML::Entities::encode($subject);
   64:     #remove machine specification
   65:     $baseurl =~ s|^http://[^/]+/|/|;
   66:     $baseurl =&HTML::Entities::encode($baseurl);
   67:     #remove machine specification
   68:     $attachmenturl =~ s|^http://[^/]+/|/|;
   69:     $attachmenturl =&HTML::Entities::encode($attachmenturl);
   70: 
   71:     my $now=time;
   72:     $msgcount++;
   73:     my $partsubj=$subject;
   74:     $partsubj=&Apache::lonnet::escape($partsubj);
   75:     my $msgid=&Apache::lonnet::escape(
   76:            $now.':'.$partsubj.':'.$ENV{'user.name'}.':'.
   77:            $ENV{'user.domain'}.':'.$msgcount.':'.$$);
   78:     my $result='<sendername>'.$ENV{'user.name'}.'</sendername>'.
   79:            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
   80:            '<subject>'.$subject.'</subject>'.
   81: 	   '<time>'.localtime($now).'</time>'.
   82: 	   '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
   83:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
   84: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
   85: 	   '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
   86: 	   '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
   87: 	   '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
   88:            '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
   89: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
   90: 	   '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
   91: 	   '<role>'.$ENV{'request.role'}.'</role>'.
   92: 	   '<resource>'.$ENV{'request.filename'}.'</resource>'.
   93:            '<msgid>'.$msgid.'</msgid>'.
   94: 	   '<message>'.$message.'</message>';
   95:     if (defined($citation)) {
   96: 	$result.='<citation>'.$citation.'</citation>';
   97:     }
   98:     if (defined($baseurl)) {
   99: 	$result.= '<baseurl>'.$baseurl.'</baseurl>';
  100:     }
  101:     if (defined($attachmenturl)) {
  102: 	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
  103:     }
  104:     return $msgid,$result;
  105: }
  106: 
  107: # ================================================== Unpack message into a hash
  108: 
  109: sub unpackagemsg {
  110:     my ($message,$notoken)=@_;
  111:     my %content=();
  112:     my $parser=HTML::TokeParser->new(\$message);
  113:     my $token;
  114:     while ($token=$parser->get_token) {
  115:        if ($token->[0] eq 'S') {
  116: 	   my $entry=$token->[1];
  117:            my $value=$parser->get_text('/'.$entry);
  118:            $content{$entry}=$value;
  119:        }
  120:     }
  121:     if ($content{'attachmenturl'}) {
  122:        my ($fname,$ft)=($content{'attachmenturl'}=~/\/(\w+)\.(\w+)$/);
  123:        if ($notoken) {
  124: 	   $content{'message'}.='<p>Attachment: <tt>'.$fname.'.'.$ft.'</tt>';
  125:        } else {
  126: 	   $content{'message'}.='<p>Attachment: <a href="'.
  127: 	       &Apache::lonnet::tokenwrapper($content{'attachmenturl'}).
  128: 	       '"><tt>'.$fname.'.'.$ft.'</tt></a>';
  129:        }
  130:     }
  131:     return %content;
  132: }
  133: 
  134: # ======================================================= Get info out of msgid
  135: 
  136: sub unpackmsgid {
  137:     my $msgid=&Apache::lonnet::unescape(shift);
  138:     my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/,
  139:                           &Apache::lonnet::unescape($msgid));
  140:     my %status=&Apache::lonnet::get('email_status',[$msgid]);
  141:     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
  142:     unless ($status{$msgid}) { $status{$msgid}='new'; }
  143:     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid});
  144: } 
  145: 
  146: 
  147: sub sendemail {
  148:     my ($to,$subject,$body)=@_;
  149:     $body=
  150:     "*** This is an automatic message generated by the LON-CAPA system.\n".
  151:     "*** Please do not reply to this address.\n\n".$body;
  152:     my $msg = new Mail::Send;
  153:     $msg->to($to);
  154:     $msg->subject('[LON-CAPA] '.$subject);
  155:     my $fh = $msg->open('smtp',Server => 'localhost');
  156:     print $fh $body;
  157:     $fh->close;
  158: }
  159: 
  160: # ==================================================== Send notification emails
  161: 
  162: sub sendnotification {
  163:     my ($to,$touname,$toudom,$subj,$crit)=@_;
  164:     my $sender=$ENV{'environment.firstname'}.' '.$ENV{'environment.lastname'};
  165:     my $critical=($crit?' critical':'');
  166:     my $url='http://'.
  167:       $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
  168:       '/adm/email?username='.$touname.'&domain='.$toudom;
  169:     my $body=(<<ENDMSG);
  170: You received a$critical message from $sender in LON-CAPA. The subject is
  171: 
  172:  $subj
  173: 
  174: Use
  175: 
  176:  $url
  177: 
  178: to access this message.
  179: ENDMSG
  180:     &sendemail($to,'New'.$critical.' message from '.$sender,$body);
  181: }
  182: # ============================================================= Check for email
  183: 
  184: sub newmail {
  185:     if ((time-$ENV{'user.mailcheck.time'})>300) {
  186:         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
  187:         &Apache::lonnet::appenv('user.mailcheck.time'=>time);
  188:         if ($what{'recnewemail'}>0) { return 1; }
  189:     }
  190:     return 0;
  191: }
  192: 
  193: # =============================== Automated message to the author of a resource
  194: 
  195: sub author_res_msg {
  196:     my ($filename,$message)=@_;
  197:     unless ($message) { return 'empty'; }
  198:     $filename=&Apache::lonnet::declutter($filename);
  199:     my ($domain,$author,@dummy)=split(/\//,$filename);
  200:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
  201:     if ($homeserver ne 'no_host') {
  202:        my $id=unpack("%32C*",$message);
  203:        my $msgid;
  204:        ($msgid,$message)=&packagemsg($filename,$message);
  205:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
  206:          ':nohist_res_msgs:'.
  207:           &Apache::lonnet::escape($filename.'_'.$id).'='.
  208:           &Apache::lonnet::escape($message),$homeserver);
  209:     }
  210:     return 'no_host';
  211: }
  212: 
  213: # ================================================== Critical message to a user
  214: 
  215: sub user_crit_msg_raw {
  216:     my ($user,$domain,$subject,$message,$sendback)=@_;
  217: # Check if allowed missing
  218:     my $status='';
  219:     my $msgid='undefined';
  220:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  221:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  222:     if ($homeserver ne 'no_host') {
  223:        ($msgid,$message)=&packagemsg($subject,$message);
  224:        if ($sendback) { $message.='<sendback>true</sendback>'; }
  225:        $status=&Apache::lonnet::critical(
  226:            'put:'.$domain.':'.$user.':critical:'.
  227:            &Apache::lonnet::escape($msgid).'='.
  228:            &Apache::lonnet::escape($message),$homeserver);
  229:        if ($ENV{'request.course.id'}) {
  230:           &user_normal_msg_raw(
  231:             $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
  232:             $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  233:             'Critical ['.$user.':'.$domain.']',
  234: 	    $message);
  235:        }
  236:     } else {
  237:        $status='no_host';
  238:     }
  239: # Notifications
  240:     my %userenv = &Apache::lonnet::get('environment',['critnotification'],
  241:                                        $domain,$user);
  242:     if ($userenv{'critnotification'}) {
  243:       &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1);
  244:     }
  245: # Log this
  246:     &Apache::lonnet::logthis(
  247:       'Sending critical email '.$msgid.
  248:       ', log status: '.
  249:       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  250:                          $ENV{'user.home'},
  251:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
  252:       .$status));
  253:     return $status;
  254: }
  255: 
  256: # New routine that respects "forward" and calls old routine
  257: 
  258: sub user_crit_msg {
  259:     my ($user,$domain,$subject,$message,$sendback)=@_;
  260:     my $status='';
  261:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  262:                                        $domain,$user);
  263:     my $msgforward=$userenv{'msgforward'};
  264:     if ($msgforward) {
  265:        foreach (split(/\,/,$msgforward)) {
  266: 	 my ($forwuser,$forwdomain)=split(/\:/,$_);
  267:          $status.=
  268: 	   &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
  269:                 $sendback).' ';
  270:        }
  271:     } else { 
  272: 	$status=&user_crit_msg_raw($user,$domain,$subject,$message,$sendback);
  273:     }
  274:     return $status;
  275: }
  276: 
  277: # =================================================== Critical message received
  278: 
  279: sub user_crit_received {
  280:     my $msgid=shift;
  281:     my %message=&Apache::lonnet::get('critical',[$msgid]);
  282:     my %contents=&unpackagemsg($message{$msgid},1);
  283:     my $status='rec: '.($contents{'sendback'}?
  284:      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
  285:                      'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
  286:                      'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
  287:                      ' acknowledged receipt of message'."\n".'   "'.
  288:                      $contents{'subject'}.'"'."\n".'dated '.
  289:                      $contents{'time'}.".\n"
  290:                      ):'no msg req');
  291:     $status.=' trans: '.
  292:      &Apache::lonnet::put(
  293:      'nohist_email',{$contents{'msgid'} => $message{$msgid}});
  294:     $status.=' del: '.
  295:      &Apache::lonnet::del('critical',[$contents{'msgid'}]);
  296:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  297:                          $ENV{'user.home'},'Received critical message '.
  298:                          $contents{'msgid'}.
  299:                          ', '.$status);
  300:     return $status;
  301: }
  302: 
  303: # ======================================================== Normal communication
  304: 
  305: sub user_normal_msg_raw {
  306:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl)=@_;
  307: # Check if allowed missing
  308:     my $status='';
  309:     my $msgid='undefined';
  310:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
  311:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
  312:     if ($homeserver ne 'no_host') {
  313:        ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl,
  314:                                      $attachmenturl);
  315:        $status=&Apache::lonnet::critical(
  316:            'put:'.$domain.':'.$user.':nohist_email:'.
  317:            &Apache::lonnet::escape($msgid).'='.
  318:            &Apache::lonnet::escape($message),$homeserver);
  319:        &Apache::lonnet::put
  320:                          ('email_status',{'recnewemail'=>time},$domain,$user);
  321:     } else {
  322:        $status='no_host';
  323:     }
  324: # Notifications
  325:     my %userenv = &Apache::lonnet::get('environment',['notification'],
  326:                                        $domain,$user);
  327:     if ($userenv{'notification'}) {
  328: 	&sendnotification($userenv{'notification'},$user,$domain,$subject,0);
  329:     }
  330:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
  331:                          $ENV{'user.home'},
  332:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
  333:     return $status;
  334: }
  335: 
  336: # New routine that respects "forward" and calls old routine
  337: 
  338: sub user_normal_msg {
  339:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl)=@_;
  340:     my $status='';
  341:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
  342:                                        $domain,$user);
  343:     my $msgforward=$userenv{'msgforward'};
  344:     if ($msgforward) {
  345:        foreach (split(/\,/,$msgforward)) {
  346: 	 my ($forwuser,$forwdomain)=split(/\:/,$_);
  347:          $status.=
  348: 	  &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
  349: 			       $citation,$baseurl,$attachmenturl).' ';
  350:        }
  351:     } else { 
  352: 	$status=&user_normal_msg_raw($user,$domain,$subject,$message,
  353: 				     $citation,$baseurl,$attachmenturl);
  354:     }
  355:     return $status;
  356: }
  357: 
  358: 
  359: # =============================================================== Status Change
  360: 
  361: sub statuschange {
  362:     my ($msgid,$newstatus)=@_;
  363:     my %status=&Apache::lonnet::get('email_status',[$msgid]);
  364:     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
  365:     unless ($status{$msgid}) { $status{$msgid}='new'; }
  366:     unless (($status{$msgid} eq 'replied') || 
  367:             ($status{$msgid} eq 'forwarded')) {
  368: 	&Apache::lonnet::put('email_status',{$msgid => $newstatus});
  369:     }
  370:     if (($newstatus eq 'deleted') || ($newstatus eq 'new')) {
  371: 	&Apache::lonnet::put('email_status',{$msgid => $newstatus});
  372:     }
  373: }
  374: 
  375: # ======================================================= Display a course list
  376: 
  377: sub discourse {
  378:     my $r=shift;
  379:     my %courselist=&Apache::lonnet::dump(
  380:                    'classlist',
  381: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  382: 		   $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  383:     my $now=time;
  384:     $r->print(<<ENDDISHEADER);
  385: <input type=hidden name=sendmode value=group>
  386: <script>
  387:     function checkall() {
  388: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  389:             if 
  390:           (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
  391: 	      document.forms.compemail.elements[i].checked=true;
  392:             }
  393:         }
  394:     }
  395: 
  396:     function checksec() {
  397: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  398:             if 
  399:           (document.forms.compemail.elements[i].name.indexOf
  400:            ('send_to_&&&'+document.forms.compemail.chksec.value)==0) {
  401: 	      document.forms.compemail.elements[i].checked=true;
  402:             }
  403:         }
  404:     }
  405: 
  406:     function uncheckall() {
  407: 	for (i=0; i<document.forms.compemail.elements.length; i++) {
  408:             if 
  409:           (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
  410: 	      document.forms.compemail.elements[i].checked=false;
  411:             }
  412:         }
  413:     }
  414: </script>
  415: <input type=button onClick="checkall()" value="Check for All">&nbsp;
  416: <input type=button onClick="checksec()" value="Check for Section/Group">
  417: <input type=text size=5 name=chksec>&nbsp;
  418: <input type=button onClick="uncheckall()" value="Check for None">
  419: <p>
  420: ENDDISHEADER
  421:     foreach (sort keys %courselist) {
  422:         my ($end,$start)=split(/\:/,$courselist{$_});
  423:         my $active=1;
  424:         if (($end) && ($now>$end)) { $active=0; }
  425:         if ($active) {
  426:            my ($sname,$sdom)=split(/\:/,$_);
  427:            my %reply=&Apache::lonnet::get('environment',
  428:               ['firstname','middlename','lastname','generation'],
  429:               $sdom,$sname);
  430:            my $section=&Apache::lonnet::usection
  431: 	       ($sdom,$sname,$ENV{'request.course.id'});
  432:            $r->print(
  433:         '<br><input type=checkbox name="send_to_&&&'.$section.'&&&_'.$_.'"> '.
  434: 		      $reply{'firstname'}.' '. 
  435:                       $reply{'middlename'}.' '.
  436:                       $reply{'lastname'}.' '.
  437:                       $reply{'generation'}.
  438:                       ' ('.$_.') '.$section);
  439:         } 
  440:     }
  441: }
  442: 
  443: # ==================================================== Display Critical Message
  444: 
  445: sub discrit {
  446:     my $r=shift;
  447:     my $header = '<h1><font color=red>Critical Messages</font></h1>'.
  448:         '<form action=/adm/email method=post>'.
  449:         '<input type=hidden name=confirm value=true>';
  450:     my %what=&Apache::lonnet::dump('critical');
  451:     my $result = '';
  452:     foreach (sort keys %what) {
  453:         my %content=&unpackagemsg($what{$_});
  454:         next if ($content{'senderdomain'} eq '');
  455:         $content{'message'}=~s/\n/\<br\>/g;
  456:         $result.='<hr>From: <b>'.
  457: &Apache::loncommon::aboutmewrapper(
  458:  &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
  459: $content{'sendername'}.'@'.
  460:             $content{'senderdomain'}.') '.$content{'time'}.
  461:             '<br>Subject: '.$content{'subject'}.
  462:             '<br><blockquote>'.
  463:               &Apache::lontexconvert::msgtexconverted($content{'message'}).
  464:             '</blockquote>'.
  465:             '<input type=submit name="rec_'.$_.'" value="Confirm Receipt">'.
  466:             '<input type=submit name="reprec_'.$_.'" '.
  467:                   'value="Confirm Receipt and Reply">';
  468:     }
  469:     # Check to see if there were any messages.
  470:     if ($result eq '') {
  471:         $result = "<h2>You have no critical messages.</h2>";
  472:     } else {
  473:         $r->print($header);
  474:     }
  475:     $r->print($result);
  476:     $r->print('<input type=hidden name="displayedcrit" value="true"></form>');
  477: }
  478: 
  479: # =============================================================== Compose reply
  480: 
  481: sub comprep {
  482:     my ($r,$msgid)=@_;
  483:       my %message=&Apache::lonnet::get('nohist_email',[$msgid]);
  484:       my %content=&unpackagemsg($message{$msgid},1);
  485:       my $quotemsg='> '.$content{'message'};
  486:       $quotemsg=~s/\r/\n/g;
  487:       $quotemsg=~s/\f/\n/g;
  488:       $quotemsg=~s/\n+/\n\> /g;
  489:       my $torepl=&Apache::loncommon::aboutmewrapper(
  490:  &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('.
  491: $content{'sendername'}.'@'.
  492:             $content{'senderdomain'}.')';
  493:       my $subject='Re: '.$content{'subject'};
  494:       my $dispcrit='';
  495:       if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
  496: 	 my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
  497:          $dispcrit=
  498:  '<input type=checkbox name=critmsg> Send as critical message ' . $crithelp . 
  499:  '<br>'.
  500:  '<input type=checkbox name=sendbck> Send as critical message ' .
  501:  ' and return receipt' . $crithelp . '<p>';
  502:       }
  503:       $r->print(<<"ENDREPLY");
  504: <form action="/adm/email" method=post>
  505: <input type=hidden name=sendreply value="$msgid">
  506: To: $torepl<br />
  507: Subject: <input type=text size=50 name=subject value="$subject"><p>
  508: <textarea name=message cols=84 rows=10 wrap=hard>
  509: $quotemsg
  510: </textarea><p>
  511: $dispcrit
  512: <input type=submit value="Send Reply">
  513: </form>
  514: ENDREPLY
  515: }
  516: 
  517: # ======================================================== Display all messages
  518: 
  519: sub disall {
  520:     my $r=shift;
  521:      $r->print(<<ENDDISHEADER);
  522: <script>
  523:     function checkall() {
  524: 	for (i=0; i<document.forms.disall.elements.length; i++) {
  525:             if 
  526:           (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
  527: 	      document.forms.disall.elements[i].checked=true;
  528:             }
  529:         }
  530:     }
  531: 
  532:     function uncheckall() {
  533: 	for (i=0; i<document.forms.disall.elements.length; i++) {
  534:             if 
  535:           (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
  536: 	      document.forms.disall.elements[i].checked=false;
  537:             }
  538:         }
  539:     }
  540: </script>
  541: ENDDISHEADER
  542:    $r->print(
  543:  '<h1>Display All Messages</h1><form method=post name=disall '.
  544:  'action="/adm/email">'.
  545:      '<table border=2><tr><th colspan=2>&nbsp</th><th>Date</th>'.
  546:      '<th>Username</th><th>Domain</th><th>Subject</th><th>Status</th></tr>');
  547:     foreach (sort split(/\&/,&Apache::lonnet::reply('keys:'.
  548: 					$ENV{'user.domain'}.':'.
  549:                                         $ENV{'user.name'}.':nohist_email',
  550:                                         $ENV{'user.home'}))) {
  551:         my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)=
  552: 	    &Apache::lonmsg::unpackmsgid($_);
  553: 	if (($status ne 'deleted') && defined($sendtime) && $sendtime!~/error/) {
  554: 	    if ($status eq 'new') {
  555: 		$r->print('<tr bgcolor="#FFBB77">');
  556: 	    } elsif ($status eq 'read') {
  557: 		$r->print('<tr bgcolor="#BBBB77">');
  558: 	    } elsif ($status eq 'replied') {
  559: 		$r->print('<tr bgcolor="#AAAA88">');
  560: 	    } else {
  561: 		$r->print('<tr bgcolor="#99BBBB">');
  562: 	    }
  563: 	    $r->print('<td><a href="/adm/email?display='.$_.
  564: 		      '">Open</a></td><td><a href="/adm/email?markdel='.$_.
  565: 		      '">Delete</a><input type=checkbox name="delmark_'.$_.'"></td>'.
  566: 		      '<td>'.localtime($sendtime).'</td><td>'.
  567: 		      $fromname.'</td><td>'.$fromdomain.'</td><td>'.
  568: 		      &Apache::lonnet::unescape($shortsubj).'</td><td>'.
  569:                       $status.'</td></tr>');
  570: 	}
  571:     }
  572:     $r->print('</table><p>'.
  573:               '<a href="javascript:checkall()">Check All</a>&nbsp;'.
  574:               '<a href="javascript:uncheckall()">Uncheck All</a><p>'.
  575:               '<input type=submit name="markeddel" value="Delete Checked">'.
  576:               '</form></body></html>');
  577: }
  578: 
  579: # ============================================================== Compose output
  580: 
  581: sub compout {
  582:     my ($r,$forwarding,$broadcast)=@_;
  583:       my $dispcrit='';
  584:     my $dissub='';
  585:     my $dismsg='';
  586:     my $func='Send New';
  587:       if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
  588: 	 my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
  589:          $dispcrit=
  590:  '<input type=checkbox name=critmsg> Send as critical message ' . $crithelp . 
  591:  '<br>'.
  592:  '<input type=checkbox name=sendbck> Send as critical message ' .
  593:  ' and return receipt' . $crithelp . '<p>';
  594:       }
  595:     if ($forwarding) {
  596:        $dispcrit.='<input type=hidden name=forwid value="'.
  597: 	   $forwarding.'">';
  598:        $func='Forward';
  599:       my %message=&Apache::lonnet::get('nohist_email',[$forwarding]);
  600:       my %content=&unpackagemsg($message{$forwarding});
  601: 
  602:        $dissub='Forwarding: '.$content{'subject'};
  603:        $dismsg='Forwarded message from '.
  604: 	   $content{'sendername'}.' at '.$content{'senderdomain'};
  605:     }
  606:     my $defdom=$ENV{'user.domain'};
  607:     if ($ENV{'form.recdom'}) { $defdom=$ENV{'form.recdom'}; }
  608:       $r->print(
  609:                 '<form action="/adm/email"  name="compemail" method="post"'.
  610:                 ' enctype="multipart/form-data">'."\n".
  611:                 '<input type="hidden" name="sendmail" value="on">'."\n".
  612:                 '<table>');
  613:     unless (($broadcast eq 'group') || ($broadcast eq 'upload')) {
  614:         my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
  615:         my $selectlink=&Apache::loncommon::selectstudent_link
  616: 	    ('compemail','recuname','recdomain');
  617:        $r->print(<<"ENDREC");
  618: <table>
  619: <tr><td>Username:</td><td><input type=text size=12 name=recuname value="$ENV{'form.recname'}"></td><td rowspan="2">$selectlink</td></tr>
  620: <tr><td>Domain:</td>
  621: <td>$domform</td></tr>
  622: ENDREC
  623:     }
  624:     my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
  625:     if ($broadcast ne 'upload') {
  626:        $r->print(<<"ENDCOMP");
  627: <tr><td>Additional Recipients<br><tt>username\@domain,username\@domain, ...
  628: </tt></td><td>
  629: <input type=text size=50 name=additionalrec></td></tr>
  630: <tr><td>Subject:</td><td><input type=text size=50 name=subject value="$dissub">
  631: </td></tr></table>
  632: $latexHelp
  633: <textarea name=message cols=80 rows=10 wrap=hard>$dismsg
  634: </textarea><p>
  635: $dispcrit
  636: <input type=submit value="$func Mail">
  637: ENDCOMP
  638:     } else { # $broadcast is 'upload'
  639: 	$r->print(<<ENDUPLOAD);
  640: <input type=hidden name=sendmode value=upload>
  641: <h3>Generate messages from a file</h3>
  642: <p>
  643: Subject: <input type=text size=50 name=subject>
  644: </p>
  645: <p>General message text<br />
  646: <textarea name=message cols=60 rows=10 wrap=hard>$dismsg
  647: </textarea></p>
  648: <p>
  649: The file format for the uploaded portion of the message is:
  650: <pre>
  651: username1\@domain1: text
  652: username2\@domain2: text
  653: username3\@domain1: text
  654: </pre>
  655: </p>
  656: <p>
  657: The messages will be assembled from all lines with the respective 
  658: <tt>username\@domain</tt>, and appended to the general message text.</p>
  659: <p>
  660: <input type=file name=upfile size=20><p>
  661: $dispcrit
  662: <input type=submit value="Upload and send">
  663: ENDUPLOAD
  664:     }
  665:     if ($broadcast eq 'group') {
  666:        &discourse;
  667:     }
  668:     $r->print('</form>');
  669: }
  670: 
  671: # ---------------------------------------------------- Display all face to face
  672: 
  673: sub disfacetoface {
  674:     my ($r,$user,$domain)=@_;
  675:     unless ($ENV{'request.course.id'}) { return; }
  676:     unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
  677: 	return;
  678:     }
  679:     my %records=&Apache::lonnet::dump('nohist_email',
  680: 			 $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  681: 			 $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
  682:                          '%255b'.$user.'%253a'.$domain.'%255d');
  683:     my $result='';
  684:     foreach (sort keys %records) {
  685:         my %content=&unpackagemsg($records{$_});
  686:         next if ($content{'senderdomain'} eq '');
  687:         $content{'message'}=~s/\n/\<br\>/g;
  688:         if ($content{'subject'}=~/^Record/) {
  689: 	    $result.='<h3>Record</h3>';
  690:         } else {
  691:             $result.='<h3>Sent Message</h3>';
  692:             %content=&unpackagemsg($content{'message'});
  693:             $content{'message'}=
  694:                 '<b>Subject: '.$content{'subject'}.'</b><br />'.
  695: 		$content{'message'};
  696:         }
  697:         $result.='By: <b>'.
  698: &Apache::loncommon::aboutmewrapper(
  699:  &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
  700: $content{'sendername'}.'@'.
  701:             $content{'senderdomain'}.') '.$content{'time'}.
  702:             '<br><blockquote>'.
  703:               &Apache::lontexconvert::msgtexconverted($content{'message'}).
  704: 	      '</blockquote>';
  705:      }
  706:     # Check to see if there were any messages.
  707:     if ($result eq '') {
  708:         $r->print("<p><b>No notes, face-to-face discussion records, or critical messages in this course.</b></p>");
  709:     } else {
  710:        $r->print($result);
  711:     }
  712: }
  713: 
  714: # ---------------------------------------------------------------- Face to face
  715: 
  716: sub facetoface {
  717:     my ($r,$stage)=@_;
  718:     unless (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) {
  719: 	return;
  720:     }
  721: # from query string
  722:     if ($ENV{'form.recname'}) { $ENV{'form.recuname'}=$ENV{'form.recname'}; }
  723:     if ($ENV{'form.recdom'}) { $ENV{'form.recdomain'}=$ENV{'form.recdom'}; }
  724: 
  725:     my $defdom=$ENV{'user.domain'};
  726: # already filled in
  727:     if ($ENV{'form.recdomain'}) { $defdom=$ENV{'form.recdomain'}; }
  728: # generate output
  729:     my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
  730:     my $stdbrws = &Apache::loncommon::selectstudent_link
  731: 	('stdselect','recuname','recdomain');
  732:     $r->print(<<"ENDTREC");
  733: <h3>User Notes, Records of Face-To-Face Discussions, and Critical Messages in Course</h3>
  734: <form method="post" action="/adm/email" name="stdselect">
  735: <input type="hidden" name="recordftf" value="retrieve" />
  736: <table>
  737: <tr><td>Username:</td><td><input type=text size=12 name=recuname value="$ENV{'form.recuname'}"></td>
  738: <td rowspan="2">
  739: $stdbrws
  740: <input type="submit" value="Retrieve discussion and message records"></td>
  741: </tr>
  742: <tr><td>Domain:</td>
  743: <td>$domform</td></tr>
  744: </table>
  745: </form>
  746: ENDTREC
  747:     if (($stage ne 'query') &&
  748:         ($ENV{'form.recdomain'}) && ($ENV{'form.recuname'})) {
  749:         chomp($ENV{'form.newrecord'});
  750:         if ($ENV{'form.newrecord'}) {
  751:            &user_normal_msg_raw(
  752:             $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
  753:             $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  754:             'Record ['.$ENV{'form.recuname'}.':'.$ENV{'form.recdomain'}.']',
  755: 	    $ENV{'form.newrecord'});
  756:         }
  757:         $r->print('<h3>'.&Apache::loncommon::plainname($ENV{'form.recuname'},
  758: 				     $ENV{'form.recdomain'}).'</h3>');
  759:         &disfacetoface($r,$ENV{'form.recuname'},$ENV{'form.recdomain'});
  760: 	$r->print(<<ENDRHEAD);
  761: <form method="post" action="/adm/email">
  762: <input name="recdomain" value="$ENV{'form.recdomain'}" type="hidden" />
  763: <input name="recuname" value="$ENV{'form.recuname'}" type="hidden" />
  764: ENDRHEAD
  765:         $r->print(<<ENDBFORM);
  766: <hr />New Record (record is visible to course faculty and staff)<br />
  767: <textarea name="newrecord" cols="80" rows="10" wrap="hard"></textarea>
  768: <br />
  769: <input type="hidden" name="recordftf" value="post" />
  770: <input type="submit" value="Post this record" />
  771: </form>
  772: ENDBFORM
  773:     }
  774: }
  775: 
  776: # ===================================================================== Handler
  777: 
  778: sub handler {
  779:     my $r=shift;
  780: 
  781: # ----------------------------------------------------------- Set document type
  782: 
  783:   $r->content_type('text/html');
  784:   $r->send_http_header;
  785: 
  786:   return OK if $r->header_only;
  787: 
  788: # --------------------------- Get query string for limited number of parameters
  789:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
  790:         ['display','replyto','forward','markread','markdel','markunread',
  791:          'sendreply','compose','sendmail','critical','recname','recdom',
  792:          'recordftf']);
  793: 
  794: # ------------------------------------------------------ They checked for email
  795:   &Apache::lonnet::put('email_status',{'recnewemail'=>0});
  796: # --------------------------------------------------------------- Render Output
  797:   if (!$ENV{'form.display'}) {
  798:       $r->print('<html><head><title>EMail and Messaging</title>'.
  799: 		&Apache::loncommon::studentbrowser_javascript().'</head>'.
  800: 		&Apache::loncommon::bodytag('EMail and Messages'));
  801:   }
  802:   if ($ENV{'form.display'}) {
  803:       my $msgid=$ENV{'form.display'};
  804:       &statuschange($msgid,'read');
  805:       my %message=&Apache::lonnet::get('nohist_email',[$msgid]);
  806:       my %content=&unpackagemsg($message{$msgid});
  807:       $r->print('<html><head><title>EMail and Messaging</title>');
  808:       if (defined($content{'baseurl'})) {
  809: 	  $r->print("<base href=\"http://$ENV{'SERVER_NAME'}/$content{'baseurl'}\" />");
  810:       }
  811:       $r->print(&Apache::loncommon::studentbrowser_javascript().
  812: 		'</head>'.
  813: 		&Apache::loncommon::bodytag('EMail and Messages'));
  814:       $r->print('<b>Subject:</b> '.$content{'subject'}.
  815:              '<br><b>From:</b> '.
  816: &Apache::loncommon::aboutmewrapper(
  817: &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),
  818: $content{'sendername'},$content{'senderdomain'}).' ('.
  819:                                  $content{'sendername'}.' at '.
  820:                                  $content{'senderdomain'}.') '.
  821:              '<br><b>Time:</b> '.$content{'time'}.'<p>'.
  822:              '<table border=2><tr bgcolor="#FFFFAA"><td>Functions:</td>'.
  823:            '<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid).
  824:              '"><b>Reply</b></a></td>'.
  825:            '<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid).
  826:              '"><b>Forward</b></a></td>'.
  827:         '<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid).
  828:              '"><b>Mark Unread</b></a></td>'.
  829:         '<td><a href="/adm/email?markdel='.&Apache::lonnet::escape($msgid).
  830:              '"><b>Delete</b></a></td>'.
  831:         '<td><a href="/adm/email"><b>Display all Messages</b></a></td>'.
  832:              '</tr></table><p><pre>'.
  833:              &Apache::lontexconvert::msgtexconverted($content{'message'}).
  834:              '</pre><hr>'.$content{'citation'});
  835:   } elsif ($ENV{'form.replyto'}) {
  836:       &comprep($r,$ENV{'form.replyto'});
  837:   } elsif ($ENV{'form.sendreply'}) {
  838:       my $msgid=$ENV{'form.sendreply'};
  839:       my %message=&Apache::lonnet::get('nohist_email',[$msgid]);
  840:       my %content=&unpackagemsg($message{$msgid},1);
  841:       &statuschange($msgid,'replied');
  842:       if ((($ENV{'form.critmsg'}) || ($ENV{'form.sendbck'})) && 
  843:           (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) {
  844:          $r->print('Sending critical: '.
  845:                 &user_crit_msg($content{'sendername'},
  846:                                  $content{'senderdomain'},
  847:                                  &Apache::lonfeedback::clear_out_html($ENV{'form.subject'}),
  848:                                  &Apache::lonfeedback::clear_out_html($ENV{'form.message'}),
  849:                                  $ENV{'form.sendbck'}));
  850:       } else {
  851:          $r->print('Sending: '.&user_normal_msg($content{'sendername'},
  852:                                  $content{'senderdomain'},
  853:                                  &Apache::lonfeedback::clear_out_html($ENV{'form.subject'}),
  854:                                  &Apache::lonfeedback::clear_out_html($ENV{'form.message'})));
  855:       }
  856:       if ($ENV{'form.displayedcrit'}) {
  857:           &discrit($r);
  858:       } else {
  859: 	  &disall($r);
  860:       }
  861:   } elsif ($ENV{'form.confirm'}) {
  862:       foreach (keys %ENV) {
  863:           if ($_=~/^form\.rec\_(.*)$/) {
  864: 	      $r->print('<b>Confirming Receipt:</b> '.
  865:                         &user_crit_received($1).'<br>');
  866:           }
  867:           if ($_=~/^form\.reprec\_(.*)$/) {
  868:               my $msgid=$1;
  869: 	      $r->print('<b>Confirming Receipt:</b> '.
  870:                         &user_crit_received($msgid).'<br>');
  871:               &comprep($r,$msgid);
  872:           }
  873:       }
  874:       &discrit($r);
  875:   } elsif ($ENV{'form.critical'}) {
  876:       &discrit($r);
  877:   } elsif ($ENV{'form.forward'}) {
  878:       &compout($r,$ENV{'form.forward'});
  879:   } elsif ($ENV{'form.markread'}) {
  880:   } elsif ($ENV{'form.markdel'}) {
  881:       &statuschange($ENV{'form.markdel'},'deleted');
  882:       &disall($r);
  883:   } elsif ($ENV{'form.markeddel'}) {
  884:       my $total=0;
  885:       foreach (keys %ENV) {
  886:           if ($_=~/^form\.delmark_(.*)$/) {
  887: 	      &statuschange(&Apache::lonnet::unescape($1),'deleted');
  888:               $total++;
  889:           }
  890:       }
  891:       $r->print('Deleted '.$total.' message(s)<p>');
  892:       &disall($r);
  893:   } elsif ($ENV{'form.markunread'}) {
  894:       &statuschange($ENV{'form.markunread'},'new');
  895:       &disall($r);
  896:   } elsif ($ENV{'form.compose'}) {
  897:       &compout($r,'',$ENV{'form.compose'});
  898:   } elsif ($ENV{'form.recordftf'}) {
  899:       &facetoface($r,$ENV{'form.recordftf'});
  900:   } elsif ($ENV{'form.sendmail'}) {
  901:       my %content=();
  902:       undef %content;
  903:       if ($ENV{'form.forwid'}) {
  904:         my $msgid=$ENV{'form.forwid'};
  905:         my %message=&Apache::lonnet::get('nohist_email',[$msgid]);
  906:         %content=&unpackagemsg($message{$msgid},1);
  907:         &statuschange($msgid,'forwarded');
  908:         $ENV{'form.message'}.="\n\n-- Forwarded message --\n\n".
  909: 	                       $content{'message'};
  910:       }
  911:       my %toaddr=();
  912:       undef %toaddr;
  913:       if ($ENV{'form.sendmode'} eq 'group') {
  914:           foreach (keys %ENV) {
  915: 	      if ($_=~/^form\.send\_to\_\&\&\&[^\&]*\&\&\&\_(.+)$/) {
  916: 		  $toaddr{$1}='';
  917:               }
  918:           }
  919:       } elsif ($ENV{'form.sendmode'} eq 'upload') {
  920:           foreach (split(/[\n\r\f]+/,$ENV{'form.upfile'})) {
  921:               my ($rec,$txt)=split(/\s*\:\s*/,$_);
  922:               if ($txt) {
  923: 		  $rec=~s/\@/\:/;
  924:                   $toaddr{$rec}.=$txt."\n";
  925:               }
  926:           }
  927:       } else {
  928: 	  $toaddr{$ENV{'form.recuname'}.':'.$ENV{'form.recdomain'}}='';
  929:       }
  930:       if ($ENV{'form.additionalrec'}) {
  931: 	  foreach (split(/\,/,$ENV{'form.additionalrec'})) {
  932:               my ($auname,$audom)=split(/\@/,$_);
  933:               $toaddr{$auname.':'.$audom}='';
  934:           }
  935:       }
  936:     foreach (keys %toaddr) {
  937:       my ($recuname,$recdomain)=split(/\:/,$_);
  938:       my $msgtxt=&Apache::lonfeedback::clear_out_html($ENV{'form.message'});
  939:       if ($toaddr{$_}) { $msgtxt.='<hr>'.$toaddr{$_}; }    
  940:       if ((($ENV{'form.critmsg'}) || ($ENV{'form.sendbck'})) && 
  941:           (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) {
  942:          $r->print('Sending critical: '.
  943:                 &user_crit_msg($recuname,$recdomain,
  944:                &Apache::lonfeedback::clear_out_html($ENV{'form.subject'}),
  945:                                  $msgtxt,
  946:                                  $ENV{'form.sendbck'}));
  947:       } else {
  948:          $r->print('Sending: '.&user_normal_msg($recuname,$recdomain,
  949:               &Apache::lonfeedback::clear_out_html($ENV{'form.subject'}),
  950:                                  $msgtxt,
  951:                                  $content{'citation'}));
  952:       }
  953:       $r->print('<br>');
  954:     }
  955:       if ($ENV{'form.displayedcrit'}) {
  956:           &discrit($r);
  957:       } else {
  958: 	  &disall($r);
  959:       }
  960:   } else {
  961:       &disall($r);
  962:   }
  963:   $r->print('</body></html>');
  964:   return OK;
  965: 
  966: }
  967: # ================================================= Main program, reset counter
  968: 
  969: BEGIN {
  970:     $msgcount=0;
  971: }
  972: 
  973: 1;
  974: __END__
  975: 
  976: 
  977: 
  978: 
  979: 
  980: 
  981: 

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