[BACK]Return to lonmsg.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmsg.pm between versions 1.7 and 1.191

version 1.7, 2001/02/06 18:17:34 version 1.191, 2006/12/24 22:13:19
Line 1 Line 1
 # The LearningOnline Network with CAPA  # The LearningOnline Network with CAPA
 #  
 # Routines for messaging  # Routines for messaging
 #  #
 # (Routines to control the menu  # $Id$
   #
   # Copyright Michigan State University Board of Trustees
   #
   # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   #
   # LON-CAPA is free software; you can redistribute it and/or modify
   # it under the terms of the GNU General Public License as published by
   # the Free Software Foundation; either version 2 of the License, or
   # (at your option) any later version.
 #  #
 # (TeX Conversion Module  # LON-CAPA is distributed in the hope that it will be useful,
   # but WITHOUT ANY WARRANTY; without even the implied warranty of
   # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   # GNU General Public License for more details.
 #  #
 # 05/29/00,05/30 Gerd Kortemeyer)  # You should have received a copy of the GNU General Public License
   # along with LON-CAPA; if not, write to the Free Software
   # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 #  #
 # 10/05 Gerd Kortemeyer)  # /home/httpd/html/adm/gpl.txt
   #
   # http://www.lon-capa.org/
 #  #
 # 10/19,10/20,10/30,  
 # 02/06/01 Gerd Kortemeyer  
   
 package Apache::lonmsg;  package Apache::lonmsg;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet;
 use vars qw($msgcount);  use HTML::TokeParser();
 use HTML::TokeParser;  use Apache::lonlocal;
 use Apache::Constants qw(:common);  use Mail::Send;
   use LONCAPA qw(:DEFAULT :match);
   
   {
       my $uniq;
       sub get_uniq {
    $uniq++;
    return $uniq;
       }
   }
   
 # ===================================================================== Package  # ===================================================================== Package
   
 sub packagemsg {  sub packagemsg {
     my ($subject,$message,$citation)=@_;      my ($subject,$message,$citation,$baseurl,$attachmenturl,
     $message=~s/\</\&lt\;/g;   $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
     $message=~s/\>/\&gt\;/g;      $message =&HTML::Entities::encode($message,'<>&"');
     $citation=~s/\</\&lt\;/g;      $citation=&HTML::Entities::encode($citation,'<>&"');
     $citation=~s/\>/\&gt\;/g;      $subject =&HTML::Entities::encode($subject,'<>&"');
     $subject=~s/\</\&lt\;/g;      #remove machine specification
     $subject=~s/\>/\&gt\;/g;      $baseurl =~ s|^http://[^/]+/|/|;
       $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
       #remove machine specification
       $attachmenturl =~ s|^http://[^/]+/|/|;
       $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
       my $course_context;
       if (defined($env{'form.replyid'})) {
           my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
                      split(/\:/,&unescape($env{'form.replyid'}));
           $course_context = $origcid;
       }
       foreach my $key (keys(%env)) {
           if ($key=~/^form\.(rep)?rec\_(.*)$/) {
               my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
                                       split(/\:/,&unescape($2));
               $course_context = $origcid;
               last;
           }
       }
       unless(defined($course_context)) {
           $course_context = $env{'request.course.id'};
       }
     my $now=time;      my $now=time;
     $msgcount++;      my $msgcount = &get_uniq();
     my $partsubj=$subject;      unless(defined($msgid)) {
     $partsubj=&Apache::lonnet::escape($partsubj);          $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
     $partsubj=substr($partsubj,0,50);                             $msgcount,$course_context,$symb,$error,$$);
     my $msgid=&Apache::lonnet::escape(      }
            $now.':'.$partsubj.':'.$ENV{'user.name'}.':'.      my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
            $ENV{'user.domain'}.':'.$msgcount.':'.$$);             '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
     return $msgid,  
            '<sendername>'.$ENV{'user.name'}.'</sendername>'.  
            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.  
            '<subject>'.$subject.'</subject>'.             '<subject>'.$subject.'</subject>'.
    '<time>'.localtime($now).'</time>'.             '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>';
    '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.      if (defined($crsmsgid)) {
           $result.= '<courseid>'.$course_context.'</courseid>'.
                     '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                     '<msgid>'.$msgid.'</msgid>'.
                     '<coursemsgid>'.$crsmsgid.'</coursemsgid>'.
                     '<message>'.$message.'</message>';
           return ($msgid,$result);
       }
       $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.             '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
    '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.     '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
    '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.     '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
    '<browseros>'.$ENV{'browser.os'}.'</browseros>'.     '<browseros>'.$env{'browser.os'}.'</browseros>'.
    '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.     '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
            '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.             '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
    '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.     '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
    '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.     '<courseid>'.$course_context.'</courseid>'.
    '<role>'.$ENV{'request.role'}.'</role>'.     '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
    '<resource>'.$ENV{'request.filename'}.'</resource>'.     '<role>'.$env{'request.role'}.'</role>'.
            '<msgid>'.$msgid.'</msgid>'.     '<resource>'.$env{'request.filename'}.'</resource>'.
    '<message>'.$message.'</message>'.             '<msgid>'.$msgid.'</msgid>';
    '<citation>'.$citation.'</citation>';      if (ref($recuser) eq 'ARRAY') {
           for (my $i=0; $i<@{$recuser}; $i++) {
               if ($type eq 'dcmail') {
                   my ($username,$email) = split(/:/,$$recuser[$i]);
                   $username = &unescape($username);
                   $email = &unescape($email);
                   $username = &HTML::Entities::encode($username,'<>&"');
                   $email = &HTML::Entities::encode($email,'<>&"');
                   $result .= '<recipient username="'.$username.'">'.
                                               $email.'</recipient>';
               } else {
                   $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
                              '<recdomain>'.$$recdomain[$i].'</recdomain>';
               }
           }
       } else {
           $result .= '<recuser>'.$recuser.'</recuser>'.
                      '<recdomain>'.$recdomain.'</recdomain>';
       }
       $result .= '<message>'.$message.'</message>';
       if (defined($citation)) {
    $result.='<citation>'.$citation.'</citation>';
       }
       if (defined($baseurl)) {
    $result.= '<baseurl>'.$baseurl.'</baseurl>';
       }
       if (defined($attachmenturl)) {
    $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
       }
       if (defined($symb)) {
           $result.= '<symb>'.$symb.'</symb>';
           if (defined($course_context)) {
               if ($course_context eq $env{'request.course.id'}) {
                   my $resource_title = &Apache::lonnet::gettitle($symb);
                   if (defined($resource_title)) {
                       $result .= '<resource_title>'.$resource_title.'</resource_title>';
                   }
               }
           }
       }
       return ($msgid,$result);
 }  }
   
 # ================================================== Unpack message into a hash  # ================================================== Unpack message into a hash
   
 sub unpackagemsg {  sub unpackagemsg {
     my $message=shift;      my ($message,$notoken)=@_;
     my %content=();      my %content=();
     my $parser=HTML::TokeParser->new(\$message);      my $parser=HTML::TokeParser->new(\$message);
     my $token;      my $token;
Line 71  sub unpackagemsg { Line 159  sub unpackagemsg {
        if ($token->[0] eq 'S') {         if ($token->[0] eq 'S') {
    my $entry=$token->[1];     my $entry=$token->[1];
            my $value=$parser->get_text('/'.$entry);             my $value=$parser->get_text('/'.$entry);
            $content{$entry}=$value;             if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
                  push(@{$content{$entry}},$value);
              } elsif ($entry eq 'recipient') {
                  my $username = $token->[2]{'username'};
                  $username = &HTML::Entities::decode($username,'<>&"');
                  $content{$entry}{$username} = $value;
              } else {
                  $content{$entry}=$value;
              }
          }
       }
       if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
       if ($content{'attachmenturl'}) {
          my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
          if ($notoken) {
      $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
          } else {
      &Apache::lonnet::allowuploaded('/adm/msg',
     $content{'attachmenturl'});
      $content{'message'}.='<p>'.&mt('Attachment').
          ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
          $fname.'</tt></a>';
        }         }
     }      }
     return %content;      return %content;
Line 79  sub unpackagemsg { Line 188  sub unpackagemsg {
   
 # ======================================================= Get info out of msgid  # ======================================================= Get info out of msgid
   
   sub buildmsgid {
       my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
       $subject=&escape($subject);
       return(&escape($now.':'.$subject.':'.$uname.':'.
              $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
   }
   
 sub unpackmsgid {  sub unpackmsgid {
     my $msgid=&Apache::lonnet::unescape(shift);      my ($msgid,$folder,$skipstatus,$status_cache)=@_;
     my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/,      $msgid=&unescape($msgid);
                           &Apache::lonnet::unescape($msgid));      my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
     my %status=&Apache::lonnet::get('email_status',$msgid);          $processid,$symb,$error) = split(/\:/,&unescape($msgid));
     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }      $shortsubj = &unescape($shortsubj);
     unless ($status{$msgid}) { $status{$msgid}='new'; }      $shortsubj = &HTML::Entities::decode($shortsubj);
     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid});      if (!defined($processid)) { $fromcid = ''; }
 }       my %status=();
       unless ($skipstatus) {
    if (ref($status_cache)) {
       $status{$msgid} = $status_cache->{$msgid};
    } else {
       my $suffix=&foldersuffix($folder);
       %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
    }
    if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
           unless ($status{$msgid}) { $status{$msgid}='new'; }
       }
       return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
   }
   
   
   sub sendemail {
       my ($to,$subject,$body)=@_;
       my %senderemails=&Apache::loncommon::getemails();
       my $senderaddress='';
       foreach my $type ('notification','permanentemail','critnotification') {
    if ($senderemails{$type}) {
       $senderaddress=$senderemails{$type};
    }
       }
       $body=
       "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
       "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ".
       &mt('A reply will not be received by the recipient!'))."\n\n".$body;
       my $msg = new Mail::Send;
       $msg->to($to);
       $msg->subject('[LON-CAPA] '.$subject);
       if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
       if (my $fh = $msg->open()) {
    print $fh $body;
    $fh->close;
       }
   }
   
   # ==================================================== Send notification emails
   
   sub sendnotification {
       my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
       my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
       unless ($sender=~/\w/) { 
    $sender=$env{'user.name'}.'@'.$env{'user.domain'};
       }
       my $critical=($crit?' critical':'');
       $text=~s/\&lt\;/\</gs;
       $text=~s/\&gt\;/\>/gs;
       $text=~s/\<\/*[^\>]+\>//gs;
       my $url='http://'.
         $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
         '/adm/email?username='.$touname.'&domain='.$toudom;
       my $body=(<<ENDMSG);
   You received a$critical message from $sender in LON-CAPA. The subject is
   
    $subj
   
   === Excerpt ============================================================
   $text
   ========================================================================
   
   Use
   
    $url
   
   to access the full message.
   ENDMSG
       &sendemail($to,'New'.$critical.' message from '.$sender,$body);
   }
   # ============================================================= Check for email
   
   sub newmail {
       if ((time-$env{'user.mailcheck.time'})>300) {
           my %what=&Apache::lonnet::get('email_status',['recnewemail']);
           &Apache::lonnet::appenv('user.mailcheck.time'=>time);
           if ($what{'recnewemail'}>0) { return 1; }
       }
       return 0;
   }
   
 # =============================== Automated message to the author of a resource  # =============================== Automated message to the author of a resource
   
   =pod
   
   =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
       of the resource with the URI $filename.
   
   =cut
   
 sub author_res_msg {  sub author_res_msg {
     my ($filename,$message)=@_;      my ($filename,$message)=@_;
     unless ($message) { return 'empty'; }      unless ($message) { return 'empty'; }
Line 99  sub author_res_msg { Line 301  sub author_res_msg {
     my $homeserver=&Apache::lonnet::homeserver($author,$domain);      my $homeserver=&Apache::lonnet::homeserver($author,$domain);
     if ($homeserver ne 'no_host') {      if ($homeserver ne 'no_host') {
        my $id=unpack("%32C*",$message);         my $id=unpack("%32C*",$message);
          $message .= " <p>This error occurred on machine ".
      $Apache::lonnet::perlvar{'lonHostID'}."</p>";
        my $msgid;         my $msgid;
        ($msgid,$message)=&packagemsg($filename,$message);         ($msgid,$message)=&packagemsg($filename,$message);
        return &Apache::lonnet::reply('put:'.$domain.':'.$author.         return &Apache::lonnet::reply('put:'.$domain.':'.$author.
          ':nohist_res_msgs:'.           ':nohist_res_msgs:'.
           &Apache::lonnet::escape($filename.'_'.$id).'='.            &escape($filename.'_'.$id).'='.
           &Apache::lonnet::escape($message),$homeserver);            &escape($message),$homeserver);
     }      }
     return 'no_host';      return 'no_host';
 }  }
   
   # =========================================== Retrieve author resource messages
   
   sub retrieve_author_res_msg {
       my $url=shift;
       $url=&Apache::lonnet::declutter($url);
       my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
       my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
       my $msgs='';
       foreach (keys %errormsgs) {
    if ($_=~/^\Q$url\E\_\d+$/) {
       my %content=&unpackagemsg($errormsgs{$_});
       $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
    $content{'time'}.'</b>: '.$content{'message'}.
    '<br /></p>';
    }
       } 
       return $msgs;     
   }
   
   
   # =============================== Delete all author messages related to one URL
   
   sub del_url_author_res_msg {
       my $url=shift;
       $url=&Apache::lonnet::declutter($url);
       my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
       my @delmsgs=();
       foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
    if ($_=~/^\Q$url\E\_\d+$/) {
       push (@delmsgs,$_);
    }
       }
       return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
   }
   # =================================== Clear out all author messages in URL path
   
   sub clear_author_res_msg {
       my $url=shift;
       $url=&Apache::lonnet::declutter($url);
       my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
       my @delmsgs=();
       foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
    if ($_=~/^\Q$url\E/) {
       push (@delmsgs,$_);
    }
       }
       return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
   }
   # ================= Return hash with URLs for which there is a resource message
   
   sub all_url_author_res_msg {
       my ($author,$domain)=@_;
       my %returnhash=();
       foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
    $_=~/^(.+)\_\d+/;
    $returnhash{$1}=1;
       }
       return %returnhash;
   }
   
   # ====================================== Add a comment to the User Notes screen
   
   sub store_instructor_comment {
       my ($msg,$uname,$udom) = @_;
       my $cid  = $env{'request.course.id'};
       my $cnum = $env{'course.'.$cid.'.num'};
       my $cdom = $env{'course.'.$cid.'.domain'};
       my $subject= &mt('Record').' ['.$uname.':'.$udom.']';
       my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg);
       return $result;
   }
   
 # ================================================== Critical message to a user  # ================================================== Critical message to a user
   
 sub user_crit_msg {  sub user_crit_msg_raw {
     my ($user,$domain,$subject,$message)=@_;      my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
 # Check if allowed missing  # Check if allowed missing
     my $status='';      my ($status,$packed_message);
     my $msgid='undefined';      my $msgid='undefined';
     unless (($message)&&($user)&&($domain)) { $status='empty'; };      unless (($message)&&($user)&&($domain)) { $status='empty'; };
       my $text=$message;
     my $homeserver=&Apache::lonnet::homeserver($user,$domain);      my $homeserver=&Apache::lonnet::homeserver($user,$domain);
     if ($homeserver ne 'no_host') {      if ($homeserver ne 'no_host') {
        my $msgid;         ($msgid,$packed_message)=&packagemsg($subject,$message);
        ($msgid,$message)=&packagemsg($subject,$message);         if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
        $status=&Apache::lonnet::critical(         $status=&Apache::lonnet::critical(
            'put:'.$domain.':'.$user.':critical:'.             'put:'.$domain.':'.$user.':critical:'.
            &Apache::lonnet::escape($msgid).'='.             &escape($msgid).'='.
            &Apache::lonnet::escape($message),$homeserver);             &escape($packed_message),$homeserver);
           if (defined($sentmessage)) {
               $$sentmessage = $packed_message;
           }
           (undef,my $packed_message_no_citation) =
               &packagemsg($subject,$message,undef,undef,undef,$user,$domain,
                           $msgid);
           $status .= &store_sent_mail($msgid,$packed_message_no_citation);
     } else {      } else {
        $status='no_host';         $status='no_host';
     }      }
   
   # Notifications
       my %userenv = &Apache::loncommon::getemails($user,$domain);
       if ($userenv{'critnotification'}) {
         &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
    $text);
       }
       if ($toperm && $userenv{'permanentemail'}) {
         &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
    $text);
       }
   # Log this
     &Apache::lonnet::logthis(      &Apache::lonnet::logthis(
       'Sending critical email '.$msgid.        'Sending critical email '.$msgid.
       ', log status: '.        ', log status: '.
       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},        &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                          $ENV{'user.home'},                           $env{'user.home'},
       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '        'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
       .$status));        .$status));
     return $status;      return $status;
 }  }
   
   # New routine that respects "forward" and calls old routine
   
   =pod
   
   =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
       a critical message $message to the $user at $domain. If $sendback is true,
       a reciept will be sent to the current user when $user recieves the message.
   
       Additionally it will check if the user has a Forwarding address
       set, and send the message to that address instead
   
       returns 
         - in array context a list of results for each message that was sent
         - in scalar context a space seperated list of results for each 
              message sent
   
   =cut
   
   sub user_crit_msg {
       my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
       my @status;
       my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                                          $domain,$user);
       my $msgforward=$userenv{'msgforward'};
       if ($msgforward) {
          foreach my $addr (split(/\,/,$msgforward)) {
    my ($forwuser,$forwdomain)=split(/\:/,$addr);
            push(@status,
         &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
    $sendback,$toperm,$sentmessage));
          }
       } else { 
    push(@status,
        &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
    $toperm,$sentmessage));
       }
       if (wantarray) {
    return @status;
       }
       return join(' ',@status);
   }
   
 # =================================================== Critical message received  # =================================================== Critical message received
   
 sub user_crit_received {  sub user_crit_received {
     my $message=shift;      my $msgid=shift;
     my %contents=&unpackagemsg($message);      my %message=&Apache::lonnet::get('critical',[$msgid]);
     my $status='rec: '.      my %contents=&unpackagemsg($message{$msgid},1);
       my $status='rec: '.($contents{'sendback'}?
      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},       &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
                      'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},                       &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
                      'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.                       &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
                      ' acknowledged receipt of message "'.                       ' acknowledged receipt of message'."\n".'   "'.
                      $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"                       $contents{'subject'}.'"'."\n".&mt('dated').' '.
                      .'Message ID: '.$contents{'msgid'});                       $contents{'time'}.".\n"
                        ):'no msg req');
     $status.=' trans: '.      $status.=' trans: '.
      &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);       &Apache::lonnet::put(
        'nohist_email',{$contents{'msgid'} => $message{$msgid}});
     $status.=' del: '.      $status.=' del: '.
      &Apache::lonnet::del('critical',$contents{'msgid'});       &Apache::lonnet::del('critical',[$contents{'msgid'}]);
     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},      &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                          $ENV{'user.home'},'Received critical message '.                           $env{'user.home'},'Received critical message '.
                          $contents{'msgid'}.                           $contents{'msgid'}.
                          ', '.$status);                           ', '.$status);
       return $status;
 }  }
   
 # ======================================================== Normal communication  # ======================================================== Normal communication
   
 sub user_normal_msg {  sub user_normal_msg_raw {
     my ($user,$domain,$subject,$message,$citation)=@_;      my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
           $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
           $error)=@_;
 # Check if allowed missing  # Check if allowed missing
     my $status='';      my ($status,$packed_message);
     my $msgid='undefined';      my $msgid='undefined';
       my $text=$message;
     unless (($message)&&($user)&&($domain)) { $status='empty'; };      unless (($message)&&($user)&&($domain)) { $status='empty'; };
     my $homeserver=&Apache::lonnet::homeserver($user,$domain);      my $homeserver=&Apache::lonnet::homeserver($user,$domain);
     if ($homeserver ne 'no_host') {      if ($homeserver ne 'no_host') {
        my $msgid;         ($msgid,$packed_message)=
        ($msgid,$message)=&packagemsg($subject,$message,$citation);                   &packagemsg($subject,$message,$citation,$baseurl,
                                        $attachmenturl,$user,$domain,$currid,
                                        undef,$crsmsgid,$symb,$error);
   
   # Store in user folder
        $status=&Apache::lonnet::critical(         $status=&Apache::lonnet::critical(
            'put:'.$domain.':'.$user.':nohist_email:'.             'put:'.$domain.':'.$user.':nohist_email:'.
            &Apache::lonnet::escape($msgid).'='.             &escape($msgid).'='.
            &Apache::lonnet::escape($message),$homeserver);             &escape($packed_message),$homeserver);
   # Save new message received time
          &Apache::lonnet::put
                            ('email_status',{'recnewemail'=>time},$domain,$user);
   # Into sent-mail folder unless a broadcast message or critical message
          unless (($env{'request.course.id'}) && 
                  (($env{'form.sendmode'} eq 'group')  || 
                  (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
                  (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
       '/'.$env{'request.course.sec'})))) {
              (undef,my $packed_message_no_citation) =
                  &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
                              $user,$domain,$currid,undef,$crsmsgid,$symb,$error);
              $status .= &store_sent_mail($msgid,$packed_message_no_citation);
          }
     } else {      } else {
        $status='no_host';         $status='no_host';
     }      }
     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},      if (defined($newid)) {
                          $ENV{'user.home'},          $$newid = $msgid;
       }
       if (defined($sentmessage)) {
           $$sentmessage = $packed_message;
       }
   
   # Notifications
       my %userenv = &Apache::lonnet::get('environment',['notification',
                                                         'permanentemail'],
                                          $domain,$user);
       if ($userenv{'notification'}) {
    &sendnotification($userenv{'notification'},$user,$domain,$subject,0,
     $text);
       }
       if ($toperm && $userenv{'permanentemail'}) {
    &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
     $text);
       }
       &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                            $env{'user.home'},
       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);        'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
     return $status;      return $status;
 }  }
   
 # =============================================================== Status Change  # New routine that respects "forward" and calls old routine
   
 sub statuschange {  =pod
     my ($msgid,$newstatus)=@_;  
     my %status=&Apache::lonnet::get('email_status',$msgid);  
     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }  
     unless ($status{$msgid}) { $status{$msgid}='new'; }  
     unless (($status{$msgid} eq 'replied') ||   
             ($status{$msgid} eq 'forwarded')) {  
  &Apache::lonnet::put('email_status',($msgid => $newstatus));  
     }  
 }  
 # ===================================================================== Handler  
   
 sub handler {  
     my $r=shift;  
   
 # ----------------------------------------------------------- Set document type  
   
   $r->content_type('text/html');  
   $r->send_http_header;  
   
   return OK if $r->header_only;  
   
 # --------------------------- Get query string for limited number of parameters  
   
     map {  
        my ($name, $value) = split(/=/,$_);  
        $value =~ tr/+/ /;  
        $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;  
        if (($name eq 'display') || ($name eq 'replyto') ||   
            ($name eq 'forward') || ($name eq 'mark') ||  
            ($name eq 'sendreply')) {  
            unless ($ENV{'form.'.$name}) {  
               $ENV{'form.'.$name}=$value;  
    }  
        }  
     } (split(/&/,$ENV{'QUERY_STRING'}));  
   
 # --------------------------------------------------------------- Render Output  =item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
            $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>:
   $r->print('<html><head><title>EMail and Messaging</title></head>');   Sends a message to the  $user at $domain, with subject $subject and message $message.
   $r->print(  
    '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>');  
   $r->print('<h1>EMail</h1>');  
   if ($ENV{'form.display'}) {  
       my $msgid=$ENV{'form.display'};  
       &statuschange($msgid,'read');  
       my %message=&Apache::lonnet::get('nohist_email',$msgid);  
       my %content=&unpackagemsg($message{$msgid});  
       $r->print('<b>Subject:</b> '.$content{'subject'}.  
              '<br><b>From:</b> '.$content{'sendername'}.' at '.  
                                  $content{'senderdomain'}.  
              '<br><b>Time:</b> '.$content{'time'}.'<hr>Functions: '.  
              '<a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid).  
              '"><b>Reply</b></a><hr><pre>'.  
              $content{'message'}.'</pre><hr>'.$content{'citation'});  
   } elsif ($ENV{'form.replyto'}) {  
       my $msgid=$ENV{'form.replyto'};  
       my %message=&Apache::lonnet::get('nohist_email',$msgid);  
       my %content=&unpackagemsg($message{$msgid});  
       my $quotemsg='> '.$content{'message'};  
       $quotemsg=~s/\r/\n/g;  
       $quotemsg=~s/\f/\n/g;  
       $quotemsg=~s/\n+/\n\> /g;  
       my $subject='Re: '.$content{'subject'};  
       $r->print(<<"ENDREPLY");  
 <form action="/adm/email" method=post>  
 <input type=hidden name=sendreply value="$msgid">  
 Subject: <input type=text size=50 name=subject value="$subject"><p>  
 <textarea name=message cols=60 rows=10>  
 $quotemsg  
 </textarea><p>  
 <input type=submit value="Send Reply">  
 </form>  
 ENDREPLY  
   } elsif ($ENV{'form.sendreply'}) {  
       my $msgid=$ENV{'form.sendreply'};  
       my %message=&Apache::lonnet::get('nohist_email',$msgid);  
       my %content=&unpackagemsg($message{$msgid});  
       &statuschange($msgid,'replied');  
       $r->print('Sending: '.&user_normal_msg($content{'sendername'},  
                                  $content{'senderdomain'},  
                                  $ENV{'form.subject'},  
                                  $ENV{'form.message'}));  
   } elsif ($ENV{'form.forward'}) {  
   } elsif ($ENV{'form.mark'}) {  
   } else {  
     $r->print('<table border=2><tr><th>&nbsp</th><th>Date</th>'.  
      '<th>Username</th><th>Domain</th><th>Subject</th><th>Status</th></tr>');  
     map {  
         my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)=  
     &Apache::lonmsg::unpackmsgid($_);  
         if ($status eq 'new') {  
     $r->print('<tr bgcolor="#FFBB77">');  
         } elsif ($status eq 'read') {  
     $r->print('<tr bgcolor="#BBBB77">');  
         } elsif ($status eq 'replied') {  
     $r->print('<tr bgcolor="#AAAA88">');  
  } else {  
     $r->print('<tr bgcolor="#99BBBB">');  
         }  
         $r->print('<td><a href="/adm/email?display='.$_.  
                   '">Open</a></td><td>'.localtime($sendtime).'</td><td>'.  
                   $fromname.'</td><td>'.$fromdomain.'</td><td>'.  
       &Apache::lonnet::unescape($shortsubj).'</td><td>'.  
                       $status.'</td></tr>');  
     } sort split(/\&/,&Apache::lonnet::reply('keys:'.  
  $ENV{'user.domain'}.':'.  
                                         $ENV{'user.name'}.':nohist_email',  
                                         $ENV{'user.home'}));  
     $r->print('</table></body></html>');  
   
   }  
   $r->print('</body></html>');  
   return OK;  
   
 }  =cut
 # ================================================= Main program, reset counter  
   
 sub BEGIN {  sub user_normal_msg {
     $msgcount=0;      my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
    $toperm,$sentmessage,$symb,$restitle,$error)=@_;
       my $status='';
       my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                                          $domain,$user);
       my $msgforward=$userenv{'msgforward'};
       if ($msgforward) {
           foreach (split(/\,/,$msgforward)) {
       my ($forwuser,$forwdomain)=split(/\:/,$_);
       $status.=
           &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
        $citation,$baseurl,$attachmenturl,$toperm,
        undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
           }
       } else {
    $status=&user_normal_msg_raw($user,$domain,$subject,$message,
        $citation,$baseurl,$attachmenturl,$toperm,
        undef,undef,$sentmessage,undef,$symb,$restitle,$error);
       }
       return $status;
 }  }
   
 1;  sub store_sent_mail {
 __END__      my ($msgid,$message) = @_;
       my $status =' '.&Apache::lonnet::critical(
                  'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
                                             ':nohist_email_sent:'.
                  &escape($msgid).'='.
                  &escape($message),$env{'user.home'});
       return $status;
   }
   
   # =============================================================== Folder suffix
   
   sub foldersuffix {
       my $folder=shift;
       unless ($folder) { return ''; }
       my $suffix;
       my %folderhash = &get_user_folders($folder);
       if (ref($folderhash{$folder}) eq 'HASH') {
           $suffix = '_'.&escape($folderhash{$folder}{'id'});
       } else {
           $suffix = '_'.&escape($folder);
       }
       return $suffix;
   }
   
   # ========================================================= User-defined folders 
   
   sub get_user_folders {
       my ($folder) = @_;
       my %userfolders = 
             &Apache::lonnet::dump('email_folders',undef,undef,$folder);
       my $lock = "\0".'lock_counter'; # locks db while counter incremented
       my $counter = "\0".'idcount';   # used in suffix for email db files
       if (defined($userfolders{$lock})) {
           delete($userfolders{$lock});
       }
       if (defined($userfolders{$counter})) {
           delete($userfolders{$counter});
       }
       return %userfolders;
   }
   
   1;
   __END__
   
Removed from v.1.7  
changed lines
  Added in v.1.191

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