File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.52: download - view: text, annotated - select for diffs
Mon Mar 31 16:34:08 2003 UTC (21 years, 3 months ago) by www
Branches: MAIN
CVS tags: HEAD
Attachments displayed in normal messages.

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

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