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

Diff for /loncom/interface/lonmsg.pm between versions 1.161 and 1.172

version 1.161, 2005/12/05 22:16:52 version 1.172, 2006/01/10 15:29:13
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 524  sub user_normal_msg_raw { Line 558  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'})
    || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
       '/'.$env{'request.course.sec'})))) {
            $status .= &store_sent_mail($msgid,$message);             $status .= &store_sent_mail($msgid,$message);
        }         }
     } else {      } else {
Line 573  sub user_normal_msg { Line 609  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 866  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 928  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 962  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 971  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 988  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 1232  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 1306  $dispcrit Line 1360  $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 1373  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 1400  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 1457  $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 1535  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 2089  sub sendoffmail { Line 2156  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 2172  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.161  
changed lines
  Added in v.1.172

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