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

Diff for /loncom/interface/lonmsg.pm between versions 1.160 and 1.173

version 1.160, 2005/11/29 22:55:10 version 1.173, 2006/01/23 23:15:51
Line 97  Right now, this document will cover just Line 97  Right now, this document will cover just
 it is likely you will not need to programmatically read messages,  it is likely you will not need to programmatically read messages,
 since lonmsg already implements that functionality.  since lonmsg already implements that functionality.
   
   The routines used to package messages and unpackage messages are not
   only used by lonmsg when creating/extracting messages for LON-CAPA's
   internal messaging system, but also by lonnotify.pm which is available
   for use by Domain Coordinators to broadcast standard e-mail to specified
   users in their domain.  The XML packaging used in the two cases is very
   similar.  The differences are the use of <recuser>$uname</recuser> and 
   <recdomain>$udom</recdomain> in stored internal messages, compared 
   with <recipient username="$uname:$udom">$email</recipient> in stored
   Domain Coordinator e-mail for the storage of information about 
   recipients of the message/e-mail.
   
 =head1 FUNCTIONS  =head1 FUNCTIONS
   
 =over 4  =over 4
Line 126  my $interdis; Line 137  my $interdis;
   
 sub packagemsg {  sub packagemsg {
     my ($subject,$message,$citation,$baseurl,$attachmenturl,      my ($subject,$message,$citation,$baseurl,$attachmenturl,
  $recuser,$recdomain,$msgid)=@_;   $recuser,$recdomain,$msgid,$type)=@_;
     $message =&HTML::Entities::encode($message,'<>&"');      $message =&HTML::Entities::encode($message,'<>&"');
     $citation=&HTML::Entities::encode($citation,'<>&"');      $citation=&HTML::Entities::encode($citation,'<>&"');
     $subject =&HTML::Entities::encode($subject,'<>&"');      $subject =&HTML::Entities::encode($subject,'<>&"');
Line 178  sub packagemsg { Line 189  sub packagemsg {
            '<msgid>'.$msgid.'</msgid>';             '<msgid>'.$msgid.'</msgid>';
     if (ref($recuser) eq 'ARRAY') {      if (ref($recuser) eq 'ARRAY') {
         for (my $i=0; $i<@{$recuser}; $i++) {          for (my $i=0; $i<@{$recuser}; $i++) {
             $result .= '<recuser>'.$$recuser[$i].'</recuser>'.              if ($type eq 'dcmail') {
                        '<recdomain>'.$$recdomain[$i].'</recdomain>';                  my ($username,$email) = split(/:/,$$recuser[$i]);
                   $username = &Apache::lonnet::unescape($username);
                   $email = &Apache::lonnet::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 {      } else {
         $result .= '<recuser>'.$recuser.'</recuser>'.          $result .= '<recuser>'.$recuser.'</recuser>'.
Line 211  sub unpackagemsg { Line 232  sub unpackagemsg {
            my $value=$parser->get_text('/'.$entry);             my $value=$parser->get_text('/'.$entry);
            if (($entry eq 'recuser') || ($entry eq 'recdomain')) {             if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
                push(@{$content{$entry}},$value);                 push(@{$content{$entry}},$value);
              } elsif ($entry eq 'recipient') {
                  my $username = $token->[2]{'username'};
                  $username = &HTML::Entities::decode($username,'<>&"');
                  $content{$entry}{$username} = $value;
            } else {             } else {
                $content{$entry}=$value;                 $content{$entry}=$value;
            }             }
        }         }
     }      }
       if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
     if ($content{'attachmenturl'}) {      if ($content{'attachmenturl'}) {
        my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);         my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
        if ($notoken) {         if ($notoken) {
Line 241  sub buildmsgid { Line 267  sub buildmsgid {
 }  }
   
 sub unpackmsgid {  sub unpackmsgid {
     my ($msgid,$folder)=@_;      my ($msgid,$folder,$skipstatus,$status_cache)=@_;
     $msgid=&Apache::lonnet::unescape($msgid);      $msgid=&Apache::lonnet::unescape($msgid);
     my $suffix=&foldersuffix($folder);      my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/,                       $processid)=split(/\:/,&Apache::lonnet::unescape($msgid));
                           &Apache::lonnet::unescape($msgid));      if (!defined($processid)) { $fromcid = ''; }
     my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);      my %status=();
     if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }      unless ($skipstatus) {
     unless ($status{$msgid}) { $status{$msgid}='new'; }   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);      return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid);
 }  }
   
Line 504  sub user_normal_msg_raw { Line 538  sub user_normal_msg_raw {
     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,      my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
  $toperm,$currid,$newid,$sentmessage)=@_;   $toperm,$currid,$newid,$sentmessage)=@_;
 # Check if allowed missing  # Check if allowed missing
     my $status='';      my ($status,$packed_message);
     my $msgid='undefined';      my $msgid='undefined';
     my $text=$message;      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') {
        ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl,         ($msgid,$packed_message)=
                    &packagemsg($subject,$message,$citation,$baseurl,
                                        $attachmenturl,$user,$domain,$currid);
          (undef, my $packed_message_no_citation)=
                            &packagemsg($subject,$message,undef     ,$baseurl,
                                      $attachmenturl,$user,$domain,$currid);                                       $attachmenturl,$user,$domain,$currid);
 # 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).'='.             &Apache::lonnet::escape($msgid).'='.
            &Apache::lonnet::escape($message),$homeserver);             &Apache::lonnet::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 524  sub user_normal_msg_raw { Line 562  sub user_normal_msg_raw {
        unless (($env{'request.course.id'}) &&          unless (($env{'request.course.id'}) && 
                (($env{'form.sendmode'} eq 'group')  ||                  (($env{'form.sendmode'} eq 'group')  || 
                (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&                 (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
                (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))) {                 (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
            $status .= &store_sent_mail($msgid,$message);   || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
       '/'.$env{'request.course.sec'})))) {
              $status .= &store_sent_mail($msgid,$packed_message_no_citation);
        }         }
     } else {      } else {
        $status='no_host';         $status='no_host';
Line 534  sub user_normal_msg_raw { Line 574  sub user_normal_msg_raw {
         $$newid = $msgid;          $$newid = $msgid;
     }      }
     if (defined($sentmessage)) {      if (defined($sentmessage)) {
         $$sentmessage = $message;          $$sentmessage = $packed_message;
     }      }
   
 # Notifications  # Notifications
Line 573  sub user_normal_msg { Line 613  sub user_normal_msg {
                                        $domain,$user);                                         $domain,$user);
     my $msgforward=$userenv{'msgforward'};      my $msgforward=$userenv{'msgforward'};
     if ($msgforward) {      if ($msgforward) {
        foreach (split(/\,/,$msgforward)) {          foreach (split(/\,/,$msgforward)) {
  my ($forwuser,$forwdomain)=split(/\:/,$_);      my ($forwuser,$forwdomain)=split(/\:/,$_);
          $status.=      $status.=
   &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,          &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
  $citation,$baseurl,$attachmenturl,$toperm,undef,undef,$sentmessage).' ';       $citation,$baseurl,$attachmenturl,$toperm,
        }       undef,undef,$sentmessage).' ';
           }
     } else {       } else { 
  $status=&user_normal_msg_raw($user,$domain,$subject,$message,   $status=&user_normal_msg_raw($user,$domain,$subject,$message,
     $citation,$baseurl,$attachmenturl,$toperm,undef,undef,$sentmessage);       $citation,$baseurl,$attachmenturl,$toperm,
        undef,undef,$sentmessage);
     }      }
     return $status;      return $status;
 }  }
   
 sub store_sent_mail {  sub store_sent_mail {
     my ($msgid,$message) = @_;      my ($msgid,$message) = @_;
         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).'='.                 &Apache::lonnet::escape($msgid).'='.
                    &Apache::lonnet::escape($message),$env{'user.home'});                 &Apache::lonnet::escape($message),$env{'user.home'});
     return $status;      return $status;
 }  }
   
Line 828  sub sortedmessages { Line 870  sub sortedmessages {
     my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix);      my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix);
     #unpack the varibles and repack into temp for sorting      #unpack the varibles and repack into temp for sorting
     my @temp;      my @temp;
       my %descriptions;
       my %status_cache = 
    &Apache::lonnet::get('email_status'.&foldersuffix($folder),\@messages);
     foreach (@messages) {      foreach (@messages) {
  my $msgid=&Apache::lonnet::escape($_);   my $msgid=&Apache::lonnet::escape($_);
  my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)=   my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)=
     &Apache::lonmsg::unpackmsgid($msgid,$folder);      &Apache::lonmsg::unpackmsgid($msgid,$folder,undef,
         my $description = &get_course_desc($fromcid);   \%status_cache);
           my $description = &get_course_desc($fromcid,\%descriptions);
  my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status,   my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status,
      $msgid,$description);       $msgid,$description);
         # Check whether message was sent during blocking period.          # Check whether message was sent during blocking period.
Line 886  sub sortedmessages { Line 932  sub sortedmessages {
 }  }
   
 sub get_course_desc {  sub get_course_desc {
     my ($fromcid) = @_;      my ($fromcid,$descriptions) = @_;
     my $description;       my $description;
     if (defined($env{'course.'.$fromcid.'.description'})) {      if (!$fromcid) {
        $description = $env{'course.'.$fromcid.'.description'};          return $description;
     } else {      } else {
        my %courseinfo=&Apache::lonnet::coursedescription($fromcid);          if (defined($$descriptions{$fromcid})) {
         $description = $courseinfo{'description'};              $description = $$descriptions{$fromcid};
           } else {
               if (defined($env{'course.'.$fromcid.'.description'})) {
                   $description = $env{'course.'.$fromcid.'.description'};
               } else {
                   my %courseinfo=&Apache::lonnet::coursedescription($fromcid);                $description = $courseinfo{'description'};
                   $description = $courseinfo{'description'};
               }
               $$descriptions{$fromcid} = $description;
           }
           return $description;
     }      }
     return $description;  
 }  }
   
 # ======================================================== Display new messages  # ======================================================== Display new messages
Line 911  sub disnew { Line 966  sub disnew {
        'op' => 'Open',         'op' => 'Open',
        'do' => 'Domain'         'do' => 'Domain'
        );         );
     my @msgids = sort split(/\&/,&Apache::lonnet::reply      my @msgids = sort(&Apache::lonnet::getkeys('nohist_email'));
                             ('keys:'.$env{'user.domain'}.':'.  
                              $env{'user.name'}.':nohist_email',  
                              $env{'user.home'}));  
     my @newmsgs;      my @newmsgs;
     my %setters = ();      my %setters = ();
     my $startblock = 0;      my $startblock = 0;
Line 923  sub disnew { Line 975  sub disnew {
     my $numblocked = 0;      my $numblocked = 0;
     # Check for blocking of display because of scheduled online exams.      # Check for blocking of display because of scheduled online exams.
     &blockcheck(\%setters,\$startblock,\$endblock);      &blockcheck(\%setters,\$startblock,\$endblock);
       my %status_cache = 
    &Apache::lonnet::get('email_status',\@msgids);
       my %descriptions;
     foreach (@msgids) {      foreach (@msgids) {
    my $msgid=&Apache::lonnet::escape($_);
         my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=          my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
     &Apache::lonmsg::unpackmsgid($_);      &Apache::lonmsg::unpackmsgid($msgid,undef,undef,\%status_cache);
         if (defined($sendtime) && $sendtime!~/error/) {          if (defined($sendtime) && $sendtime!~/error/) {
             my $description = &get_course_desc($fromcid);              my $description = &get_course_desc($fromcid,\%descriptions);
             my $numsendtime = $sendtime;              my $numsendtime = $sendtime;
             $sendtime = &Apache::lonlocal::locallocaltime($sendtime);              $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
             if ($status eq 'new') {              if ($status eq 'new') {
Line 936  sub disnew { Line 992  sub disnew {
                     $numblocked ++;                      $numblocked ++;
                 } else {                  } else {
                     push @newmsgs, {                       push @newmsgs, { 
                         msgid    => $_,                          msgid    => $msgid,
                         sendtime => $sendtime,                          sendtime => $sendtime,
                         shortsub => &Apache::lonnet::unescape($shortsubj),                          shortsub => &Apache::lonnet::unescape($shortsubj),
                         from     => $fromname,                          from     => $fromname,
Line 1180  sub compout { Line 1236  sub compout {
        'ca' => 'Cancel',         'ca' => 'Cancel',
        'ma' => 'Mail');         'ma' => 'Mail');
   
     if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {      if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
       '/'.$env{'request.course.sec'})) {
  my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");   my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
          $dispcrit=           $dispcrit=
  '<p><label><input type="checkbox" name="critmsg" /> '.&mt('Send as critical message').'</label> ' . $crithelp .    '<p><label><input type="checkbox" name="critmsg" /> '.&mt('Send as critical message').'</label> ' . $crithelp . 
Line 1189  sub compout { Line 1247  sub compout {
  &mt('and return receipt') . '</label>' . $crithelp .    &mt('and return receipt') . '</label>' . $crithelp . 
  '</p><p><label><input type="checkbox" name="permanent" /> '.   '</p><p><label><input type="checkbox" name="permanent" /> '.
 &mt('Send copy to permanent email address (if known)').'</label></p>'.  &mt('Send copy to permanent email address (if known)').'</label></p>'.
 '<p><label><input type="checkbox" name="rsspost" /> '.  '<!-- <p><label><input type="checkbox" name="rsspost" /> '.
   &mt('Include in course RSS newsfeed').'</label></p>';      }    &mt('Include in course RSS newsfeed').'</label></p>-->';      }
     my %message;      my %message;
     my %content;      my %content;
     my $defdom=$env{'user.domain'};      my $defdom=$env{'user.domain'};
Line 1306  $dispcrit Line 1364  $dispcrit
 ENDUPLOAD  ENDUPLOAD
     }      }
     if ($broadcast eq 'group') {      if ($broadcast eq 'group') {
        &discourse;         &discourse($r);
     }      }
     $r->print('</form>'.      $r->print('</form>'.
       &Apache::lonfeedback::generate_preview_button('compemail','message').        &Apache::lonfeedback::generate_preview_button('compemail','message').
Line 1319  sub retrieve_instructor_comments { Line 1377  sub retrieve_instructor_comments {
     my ($user,$domain)=@_;      my ($user,$domain)=@_;
     my $target=$env{'form.grade_target'};      my $target=$env{'form.grade_target'};
     if (! $env{'request.course.id'}) { return; }      if (! $env{'request.course.id'}) { return; }
     if (! &Apache::lonnet::allowed('srm',$env{'request.course.id'})) {      if (! &Apache::lonnet::allowed('srm',$env{'request.course.id'})
    && ! &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
         '/'.$env{'request.course.sec'})) {
  return;   return;
     }      }
     my %records=&Apache::lonnet::dump('nohist_email',      my %records=&Apache::lonnet::dump('nohist_email',
Line 1344  sub disfacetoface { Line 1404  sub disfacetoface {
     my ($r,$user,$domain)=@_;      my ($r,$user,$domain)=@_;
     my $target=$env{'form.grade_target'};      my $target=$env{'form.grade_target'};
     unless ($env{'request.course.id'}) { return; }      unless ($env{'request.course.id'}) { return; }
     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {      if  (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    && ! &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
          '/'.$env{'request.course.sec'})) {
    $r->print('Not allowed');
  return;   return;
     }      }
     my %records=&Apache::lonnet::dump('nohist_email',      my %records=&Apache::lonnet::dump('nohist_email',
Line 1398  $content{'sendername'}.'@'. Line 1461  $content{'sendername'}.'@'.
   
 sub facetoface {  sub facetoface {
     my ($r,$stage)=@_;      my ($r,$stage)=@_;
     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {      if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    && ! &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
         '/'.$env{'request.course.sec'})) {
    $r->print('Not allowed');
  return;   return;
     }      }
     &printheader($r,      &printheader($r,
Line 1473  ENDBFORM Line 1539  ENDBFORM
 sub examblock {  sub examblock {
     my ($r,$action) = @_;      my ($r,$action) = @_;
     unless ($env{'request.course.id'}) { return;}      unless ($env{'request.course.id'}) { return;}
     unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { $r->print('Not allowed'); }      if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
    && ! &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
         '/'.$env{'request.course.sec'})) {
    $r->print('Not allowed');
    return;
       }
     my %lt=&Apache::lonlocal::texthash(      my %lt=&Apache::lonlocal::texthash(
             'comb' => 'Communication Blocking',              'comb' => 'Communication Blocking',
             'cbds' => 'Communication blocking during scheduled exams',              'cbds' => 'Communication blocking during scheduled exams',
Line 1964  sub displayresource { Line 2035  sub displayresource {
     $content{'sendername'},      $content{'sendername'},
     $content{'senderdomain'},      $content{'senderdomain'},
     $content{'courseid'});      $content{'courseid'});
     } else {      } elsif ($env{'user.adv'}) {
  return $content{'citation'};   return $content{'citation'};
     }      }
       return '';
 }  }
   
 # ================================================================== The Header  # ================================================================== The Header
Line 2089  sub sendoffmail { Line 2161  sub sendoffmail {
         my $msgtype;          my $msgtype;
         my %sentmessage;          my %sentmessage;
         if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&          if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
             (&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'})
        )) {
             $savemsg=&Apache::lonfeedback::clear_out_html($env{'form.message'},1);              $savemsg=&Apache::lonfeedback::clear_out_html($env{'form.message'},1);
             $msgtype = 'critical';              $msgtype = 'critical';
         } else {          } else {
Line 2102  sub sendoffmail { Line 2177  sub sendoffmail {
     if ($toaddr{$_}) { $msgtxt.='<hr />'.$toaddr{$_}; }      if ($toaddr{$_}) { $msgtxt.='<hr />'.$toaddr{$_}; }
     my $thismsg;      my $thismsg;
     if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&       if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) && 
  (&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'}))) {
  $r->print(&mt('Sending critical message').' '.$recuname.'@'.$recdomain.': ');   $r->print(&mt('Sending critical message').' '.$recuname.'@'.$recdomain.': ');
  $thismsg=&user_crit_msg($recuname,$recdomain,   $thismsg=&user_crit_msg($recuname,$recdomain,
  &Apache::lonfeedback::clear_out_html($env{'form.subject'}),   &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
Removed from v.1.160  
changed lines
  Added in v.1.173

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