Diff for /loncom/interface/lonmsg.pm between versions 1.183 and 1.190

version 1.183, 2006/04/25 19:45:50 version 1.190, 2006/12/13 01:45:15
Line 33  use Apache::lonnet; Line 33  use Apache::lonnet;
 use HTML::TokeParser();  use HTML::TokeParser();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Mail::Send;  use Mail::Send;
   use LONCAPA qw(:DEFAULT :match);
   
 {  {
     my $uniq;      my $uniq;
Line 59  sub packagemsg { Line 60  sub packagemsg {
     my $course_context;      my $course_context;
     if (defined($env{'form.replyid'})) {      if (defined($env{'form.replyid'})) {
         my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=          my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
                    split(/\:/,&Apache::lonnet::unescape($env{'form.replyid'}));                     split(/\:/,&unescape($env{'form.replyid'}));
         $course_context = $origcid;          $course_context = $origcid;
     }      }
     foreach my $key (keys(%env)) {      foreach my $key (keys(%env)) {
         if ($key=~/^form\.(rep)?rec\_(.*)$/) {          if ($key=~/^form\.(rep)?rec\_(.*)$/) {
             my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =              my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
                                     split(/\:/,&Apache::lonnet::unescape($2));                                      split(/\:/,&unescape($2));
             $course_context = $origcid;              $course_context = $origcid;
             last;              last;
         }          }
Line 108  sub packagemsg { Line 109  sub packagemsg {
         for (my $i=0; $i<@{$recuser}; $i++) {          for (my $i=0; $i<@{$recuser}; $i++) {
             if ($type eq 'dcmail') {              if ($type eq 'dcmail') {
                 my ($username,$email) = split(/:/,$$recuser[$i]);                  my ($username,$email) = split(/:/,$$recuser[$i]);
                 $username = &Apache::lonnet::unescape($username);                  $username = &unescape($username);
                 $email = &Apache::lonnet::unescape($email);                  $email = &unescape($email);
                 $username = &HTML::Entities::encode($username,'<>&"');                  $username = &HTML::Entities::encode($username,'<>&"');
                 $email = &HTML::Entities::encode($email,'<>&"');                  $email = &HTML::Entities::encode($email,'<>&"');
                 $result .= '<recipient username="'.$username.'">'.                  $result .= '<recipient username="'.$username.'">'.
Line 178  sub unpackagemsg { Line 179  sub unpackagemsg {
   
 sub buildmsgid {  sub buildmsgid {
     my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_;      my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_;
     $subject=&Apache::lonnet::escape($subject);      $subject=&escape($subject);
     return(&Apache::lonnet::escape($now.':'.$subject.':'.$uname.':'.      return(&escape($now.':'.$subject.':'.$uname.':'.
            $udom.':'.$msgcount.':'.$course_context.':'.$pid));             $udom.':'.$msgcount.':'.$course_context.':'.$pid));
 }  }
   
 sub unpackmsgid {  sub unpackmsgid {
     my ($msgid,$folder,$skipstatus,$status_cache)=@_;      my ($msgid,$folder,$skipstatus,$status_cache)=@_;
     $msgid=&Apache::lonnet::unescape($msgid);      $msgid=&unescape($msgid);
     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,      my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
                      $processid)=split(/\:/,&Apache::lonnet::unescape($msgid));                       $processid)=split(/\:/,&unescape($msgid));
     $shortsubj = &Apache::lonnet::unescape($shortsubj);      $shortsubj = &unescape($shortsubj);
     $shortsubj = &HTML::Entities::decode($shortsubj);      $shortsubj = &HTML::Entities::decode($shortsubj);
     if (!defined($processid)) { $fromcid = ''; }      if (!defined($processid)) { $fromcid = ''; }
     my %status=();      my %status=();
Line 208  sub unpackmsgid { Line 209  sub unpackmsgid {
   
 sub sendemail {  sub sendemail {
     my ($to,$subject,$body)=@_;      my ($to,$subject,$body)=@_;
       my %senderemails=&Apache::loncommon::getemails();
       my $senderaddress='';
       foreach my $type ('notification','permanentemail','critnotification') {
    if ($senderemails{$type}) {
       $senderaddress=$senderemails{$type};
    }
       }
     $body=      $body=
     "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".      "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
     "*** ".&mt('Please do not reply to this address.')."\n\n".$body;      "*** ".($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;      my $msg = new Mail::Send;
     $msg->to($to);      $msg->to($to);
     $msg->subject('[LON-CAPA] '.$subject);      $msg->subject('[LON-CAPA] '.$subject);
       if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
     if (my $fh = $msg->open()) {      if (my $fh = $msg->open()) {
  print $fh $body;   print $fh $body;
  $fh->close;   $fh->close;
Line 286  sub author_res_msg { Line 296  sub author_res_msg {
        ($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';
 }  }
Line 297  sub author_res_msg { Line 307  sub author_res_msg {
 sub retrieve_author_res_msg {  sub retrieve_author_res_msg {
     my $url=shift;      my $url=shift;
     $url=&Apache::lonnet::declutter($url);      $url=&Apache::lonnet::declutter($url);
     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);      my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);      my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
     my $msgs='';      my $msgs='';
     foreach (keys %errormsgs) {      foreach (keys %errormsgs) {
Line 317  sub retrieve_author_res_msg { Line 327  sub retrieve_author_res_msg {
 sub del_url_author_res_msg {  sub del_url_author_res_msg {
     my $url=shift;      my $url=shift;
     $url=&Apache::lonnet::declutter($url);      $url=&Apache::lonnet::declutter($url);
     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);      my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
     my @delmsgs=();      my @delmsgs=();
     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {      foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  if ($_=~/^\Q$url\E\_\d+$/) {   if ($_=~/^\Q$url\E\_\d+$/) {
Line 331  sub del_url_author_res_msg { Line 341  sub del_url_author_res_msg {
 sub clear_author_res_msg {  sub clear_author_res_msg {
     my $url=shift;      my $url=shift;
     $url=&Apache::lonnet::declutter($url);      $url=&Apache::lonnet::declutter($url);
     my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);      my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
     my @delmsgs=();      my @delmsgs=();
     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {      foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
  if ($_=~/^\Q$url\E/) {   if ($_=~/^\Q$url\E/) {
Line 352  sub all_url_author_res_msg { Line 362  sub all_url_author_res_msg {
     return %returnhash;      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_raw {  sub user_crit_msg_raw {
     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;      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 $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') {
        ($msgid,$message)=&packagemsg($subject,$message);         ($msgid,$packed_message)=&packagemsg($subject,$message);
        if ($sendback) { $message.='<sendback>true</sendback>'; }         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)) {          if (defined($sentmessage)) {
             $$sentmessage = $message;              $$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  # Notifications
     my %userenv = &Apache::lonnet::get('environment',['critnotification',      my %userenv = &Apache::loncommon::getemails($user,$domain);
                                                       'permanentemail'],  
                                        $domain,$user);  
     if ($userenv{'critnotification'}) {      if ($userenv{'critnotification'}) {
       &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,        &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
  $text);   $text);
Line 486  sub user_normal_msg_raw { Line 511  sub user_normal_msg_raw {
 # Store in user folder  # 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($packed_message),$homeserver);             &escape($packed_message),$homeserver);
 # Save new message received time  # Save new message received time
        &Apache::lonnet::put         &Apache::lonnet::put
                          ('email_status',{'recnewemail'=>time},$domain,$user);                           ('email_status',{'recnewemail'=>time},$domain,$user);
Line 498  sub user_normal_msg_raw { Line 523  sub user_normal_msg_raw {
                (&Apache::lonnet::allowed('srm',$env{'request.course.id'})                 (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
  || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.   || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
     '/'.$env{'request.course.sec'})))) {      '/'.$env{'request.course.sec'})))) {
            (undef, my $packed_message_no_citation)=             (undef,my $packed_message_no_citation) =
                              &packagemsg($subject,$message,undef     ,$baseurl,                 &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
                                           $attachmenturl,$user,$domain,$currid,                             $user,$domain,$currid,undef,$crsmsgid);
                                                               undef,$crsmsgid);  
   
            $status .= &store_sent_mail($msgid,$packed_message_no_citation);             $status .= &store_sent_mail($msgid,$packed_message_no_citation);
        }         }
     } else {      } else {
Line 571  sub store_sent_mail { Line 594  sub store_sent_mail {
     my $status =' '.&Apache::lonnet::critical(      my $status =' '.&Apache::lonnet::critical(
                'put:'.$env{'user.domain'}.':'.$env{'user.name'}.                 'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
                                           ':nohist_email_sent:'.                                            ':nohist_email_sent:'.
                &Apache::lonnet::escape($msgid).'='.                 &escape($msgid).'='.
                &Apache::lonnet::escape($message),$env{'user.home'});                 &escape($message),$env{'user.home'});
     return $status;      return $status;
 }  }
   
Line 581  sub store_sent_mail { Line 604  sub store_sent_mail {
 sub foldersuffix {  sub foldersuffix {
     my $folder=shift;      my $folder=shift;
     unless ($folder) { return ''; }      unless ($folder) { return ''; }
     return '_'.&Apache::lonnet::escape($folder);      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;  1;

Removed from v.1.183  
changed lines
  Added in v.1.190


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