File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.49: download - view: text, annotated - select for diffs
Tue Feb 18 15:47:40 2003 UTC (21 years, 4 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
-Fixes BUG#1255, sets the base url of email messages that contain forwars of a problems view, thus relative links will work.

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

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