--- loncom/interface/lonmsg.pm 2005/11/29 22:55:10 1.160
+++ loncom/interface/lonmsg.pm 2006/01/30 07:32:20 1.174
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines for messaging
#
-# $Id: lonmsg.pm,v 1.160 2005/11/29 22:55:10 raeburn Exp $
+# $Id: lonmsg.pm,v 1.174 2006/01/30 07:32:20 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -97,6 +97,17 @@ Right now, this document will cover just
it is likely you will not need to programmatically read messages,
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 $uname and
+$udom in stored internal messages, compared
+with $email in stored
+Domain Coordinator e-mail for the storage of information about
+recipients of the message/e-mail.
+
=head1 FUNCTIONS
=over 4
@@ -126,7 +137,7 @@ my $interdis;
sub packagemsg {
my ($subject,$message,$citation,$baseurl,$attachmenturl,
- $recuser,$recdomain,$msgid)=@_;
+ $recuser,$recdomain,$msgid,$type,$crsmsgid)=@_;
$message =&HTML::Entities::encode($message,'<>&"');
$citation=&HTML::Entities::encode($citation,'<>&"');
$subject =&HTML::Entities::encode($subject,'<>&"');
@@ -159,11 +170,19 @@ sub packagemsg {
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
$msgcount,$course_context,$$);
}
- my $result=''.$env{'user.name'}.''.
+ my $result = ''.$env{'user.name'}.''.
''.$env{'user.domain'}.''.
''.$subject.''.
- ''.
- ''.$ENV{'SERVER_NAME'}.''.
+ '';
+ if (defined($crsmsgid)) {
+ $result.= ''.$course_context.''.
+ ''.$env{'request.course.sec'}.''.
+ ''.$msgid.''.
+ ''.$crsmsgid.''.
+ ''.$message.'';
+ return ($msgid,$result);
+ }
+ $result .= ''.$ENV{'SERVER_NAME'}.''.
''.$ENV{'HTTP_HOST'}.''.
''.$ENV{'REMOTE_ADDR'}.''.
''.$env{'browser.type'}.''.
@@ -178,8 +197,18 @@ sub packagemsg {
''.$msgid.'';
if (ref($recuser) eq 'ARRAY') {
for (my $i=0; $i<@{$recuser}; $i++) {
- $result .= ''.$$recuser[$i].''.
- ''.$$recdomain[$i].'';
+ if ($type eq 'dcmail') {
+ 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 .= ''.
+ $email.'';
+ } else {
+ $result .= ''.$$recuser[$i].''.
+ ''.$$recdomain[$i].'';
+ }
}
} else {
$result .= ''.$recuser.''.
@@ -211,11 +240,16 @@ sub unpackagemsg {
my $value=$parser->get_text('/'.$entry);
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) {
@@ -241,14 +275,22 @@ sub buildmsgid {
}
sub unpackmsgid {
- my ($msgid,$folder)=@_;
+ my ($msgid,$folder,$skipstatus,$status_cache)=@_;
$msgid=&Apache::lonnet::unescape($msgid);
- my $suffix=&foldersuffix($folder);
- my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/,
- &Apache::lonnet::unescape($msgid));
- my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
- if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
- unless ($status{$msgid}) { $status{$msgid}='new'; }
+ my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
+ $processid)=split(/\:/,&Apache::lonnet::unescape($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);
}
@@ -502,21 +544,24 @@ sub user_crit_received {
sub user_normal_msg_raw {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
- $toperm,$currid,$newid,$sentmessage)=@_;
+ $toperm,$currid,$newid,$sentmessage,$crsmsgid)=@_;
# Check if allowed missing
- my $status='';
+ my ($status,$packed_message);
my $msgid='undefined';
my $text=$message;
unless (($message)&&($user)&&($domain)) { $status='empty'; };
my $homeserver=&Apache::lonnet::homeserver($user,$domain);
if ($homeserver ne 'no_host') {
- ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl,
- $attachmenturl,$user,$domain,$currid);
+ ($msgid,$packed_message)=
+ &packagemsg($subject,$message,$citation,$baseurl,
+ $attachmenturl,$user,$domain,$currid,
+ undef,$crsmsgid);
+
# Store in user folder
$status=&Apache::lonnet::critical(
'put:'.$domain.':'.$user.':nohist_email:'.
&Apache::lonnet::escape($msgid).'='.
- &Apache::lonnet::escape($message),$homeserver);
+ &Apache::lonnet::escape($packed_message),$homeserver);
# Save new message received time
&Apache::lonnet::put
('email_status',{'recnewemail'=>time},$domain,$user);
@@ -524,8 +569,15 @@ sub user_normal_msg_raw {
unless (($env{'request.course.id'}) &&
(($env{'form.sendmode'} eq 'group') ||
(($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
- (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))) {
- $status .= &store_sent_mail($msgid,$message);
+ (&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);
+
+ $status .= &store_sent_mail($msgid,$packed_message_no_citation);
}
} else {
$status='no_host';
@@ -534,7 +586,7 @@ sub user_normal_msg_raw {
$$newid = $msgid;
}
if (defined($sentmessage)) {
- $$sentmessage = $message;
+ $$sentmessage = $packed_message;
}
# Notifications
@@ -573,26 +625,28 @@ sub user_normal_msg {
$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).' ';
- }
+ foreach (split(/\,/,$msgforward)) {
+ my ($forwuser,$forwdomain)=split(/\:/,$_);
+ $status.=
+ &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
+ $citation,$baseurl,$attachmenturl,$toperm,
+ undef,undef,$sentmessage).' ';
+ }
} else {
$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;
}
sub store_sent_mail {
my ($msgid,$message) = @_;
- my $status =' '.&Apache::lonnet::critical(
- 'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
- ':nohist_email_sent:'.
- &Apache::lonnet::escape($msgid).'='.
- &Apache::lonnet::escape($message),$env{'user.home'});
+ my $status =' '.&Apache::lonnet::critical(
+ 'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
+ ':nohist_email_sent:'.
+ &Apache::lonnet::escape($msgid).'='.
+ &Apache::lonnet::escape($message),$env{'user.home'});
return $status;
}
@@ -828,11 +882,15 @@ sub sortedmessages {
my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix);
#unpack the varibles and repack into temp for sorting
my @temp;
+ my %descriptions;
+ my %status_cache =
+ &Apache::lonnet::get('email_status'.&foldersuffix($folder),\@messages);
foreach (@messages) {
my $msgid=&Apache::lonnet::escape($_);
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)=
- &Apache::lonmsg::unpackmsgid($msgid,$folder);
- my $description = &get_course_desc($fromcid);
+ &Apache::lonmsg::unpackmsgid($msgid,$folder,undef,
+ \%status_cache);
+ my $description = &get_course_desc($fromcid,\%descriptions);
my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status,
$msgid,$description);
# Check whether message was sent during blocking period.
@@ -886,15 +944,24 @@ sub sortedmessages {
}
sub get_course_desc {
- my ($fromcid) = @_;
- my $description;
- if (defined($env{'course.'.$fromcid.'.description'})) {
- $description = $env{'course.'.$fromcid.'.description'};
+ my ($fromcid,$descriptions) = @_;
+ my $description;
+ if (!$fromcid) {
+ return $description;
} else {
- my %courseinfo=&Apache::lonnet::coursedescription($fromcid);
- $description = $courseinfo{'description'};
+ if (defined($$descriptions{$fromcid})) {
+ $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
@@ -911,10 +978,7 @@ sub disnew {
'op' => 'Open',
'do' => 'Domain'
);
- my @msgids = sort split(/\&/,&Apache::lonnet::reply
- ('keys:'.$env{'user.domain'}.':'.
- $env{'user.name'}.':nohist_email',
- $env{'user.home'}));
+ my @msgids = sort(&Apache::lonnet::getkeys('nohist_email'));
my @newmsgs;
my %setters = ();
my $startblock = 0;
@@ -923,11 +987,15 @@ sub disnew {
my $numblocked = 0;
# Check for blocking of display because of scheduled online exams.
&blockcheck(\%setters,\$startblock,\$endblock);
+ my %status_cache =
+ &Apache::lonnet::get('email_status',\@msgids);
+ my %descriptions;
foreach (@msgids) {
+ my $msgid=&Apache::lonnet::escape($_);
my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
- &Apache::lonmsg::unpackmsgid($_);
+ &Apache::lonmsg::unpackmsgid($msgid,undef,undef,\%status_cache);
if (defined($sendtime) && $sendtime!~/error/) {
- my $description = &get_course_desc($fromcid);
+ my $description = &get_course_desc($fromcid,\%descriptions);
my $numsendtime = $sendtime;
$sendtime = &Apache::lonlocal::locallocaltime($sendtime);
if ($status eq 'new') {
@@ -936,7 +1004,7 @@ sub disnew {
$numblocked ++;
} else {
push @newmsgs, {
- msgid => $_,
+ msgid => $msgid,
sendtime => $sendtime,
shortsub => &Apache::lonnet::unescape($shortsubj),
from => $fromname,
@@ -1180,7 +1248,9 @@ sub compout {
'ca' => 'Cancel',
'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");
$dispcrit=
'
' . $crithelp .
@@ -1189,8 +1259,8 @@ sub compout {
&mt('and return receipt') . '' . $crithelp .
'
'.
-''; }
+''; }
my %message;
my %content;
my $defdom=$env{'user.domain'};
@@ -1306,7 +1376,7 @@ $dispcrit
ENDUPLOAD
}
if ($broadcast eq 'group') {
- &discourse;
+ &discourse($r);
}
$r->print(''.
&Apache::lonfeedback::generate_preview_button('compemail','message').
@@ -1319,7 +1389,9 @@ sub retrieve_instructor_comments {
my ($user,$domain)=@_;
my $target=$env{'form.grade_target'};
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;
}
my %records=&Apache::lonnet::dump('nohist_email',
@@ -1344,7 +1416,10 @@ sub disfacetoface {
my ($r,$user,$domain)=@_;
my $target=$env{'form.grade_target'};
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;
}
my %records=&Apache::lonnet::dump('nohist_email',
@@ -1361,17 +1436,29 @@ sub disfacetoface {
} elsif ($content{'subject'}=~/^Broadcast/) {
$result .=''.&mt('Broadcast Message').'
';
if ($content{'subject'}=~/^Broadcast\./) {
- %content=&unpackagemsg($content{'message'});
- $content{'message'}=
+ if (defined($content{'coursemsgid'})) {
+ my $crsmsgid = &Apache::lonnet::escape($content{'coursemsgid'});
+ my $broadcast_message = &general_message($crsmsgid);
+ $content{'message'} = ''.&mt('Subject').': '.$content{'message'}.'
'.$broadcast_message;
+ } else {
+ %content=&unpackagemsg($content{'message'});
+ $content{'message'} =
''.&mt('Subject').': '.$content{'subject'}.'
'.
$content{'message'};
+ }
}
} else {
$result.=''.&mt('Critical Message').'
';
- %content=&unpackagemsg($content{'message'});
- $content{'message'}=
+ if (defined($content{'coursemsgid'})) {
+ my $crsmsgid=&Apache::lonnet::escape($content{'coursemsgid'});
+ my $critical_message = &general_message($crsmsgid);
+ $content{'message'} = ''.&mt('Subject').': '.$content{'message'}.'
'.$critical_message;
+ } else {
+ %content=&unpackagemsg($content{'message'});
+ $content{'message'}=
''.&mt('Subject').': '.$content{'subject'}.'
'.
$content{'message'};
+ }
}
$result.=&mt('By').': '.
&Apache::loncommon::aboutmewrapper(
@@ -1394,11 +1481,26 @@ $content{'sendername'}.'@'.
}
}
+sub general_message {
+ my ($crsmsgid) = @_;
+ my %general_content;
+ if ($crsmsgid) {
+ my %course_content = &Apache::lonnet::get('nohist_email',[$crsmsgid],
+ $env{'course.'.$env{'request.course.id'}.'.domain'},
+ $env{'course.'.$env{'request.course.id'}.'.num'});
+ %general_content = &unpackagemsg($course_content{$crsmsgid});
+ }
+ return $general_content{'message'};
+}
+
# ---------------------------------------------------------------- Face to face
sub facetoface {
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;
}
&printheader($r,
@@ -1473,7 +1575,12 @@ ENDBFORM
sub examblock {
my ($r,$action) = @_;
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(
'comb' => 'Communication Blocking',
'cbds' => 'Communication blocking during scheduled exams',
@@ -1964,9 +2071,10 @@ sub displayresource {
$content{'sendername'},
$content{'senderdomain'},
$content{'courseid'});
- } else {
+ } elsif ($env{'user.adv'}) {
return $content{'citation'};
}
+ return '';
}
# ================================================================== The Header
@@ -2088,8 +2196,12 @@ sub sendoffmail {
my $savemsg;
my $msgtype;
my %sentmessage;
+ my $msgsubj=&Apache::lonfeedback::clear_out_html($env{'form.subject'});
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);
$msgtype = 'critical';
} else {
@@ -2102,17 +2214,16 @@ sub sendoffmail {
if ($toaddr{$_}) { $msgtxt.='
'.$toaddr{$_}; }
my $thismsg;
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.': ');
- $thismsg=&user_crit_msg($recuname,$recdomain,
- &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
- $msgtxt,
- $env{'form.sendbck'},$env{'form.permanent'},\$sentmessage{$_});
+ $thismsg=&user_crit_msg($recuname,$recdomain,$msgsubj,$msgtxt,
+ $env{'form.sendbck'},$env{'form.permanent'},
+ \$sentmessage{$_});
} else {
$r->print(&mt('Sending').' '.$recuname.'@'.$recdomain.': ');
- $thismsg=&user_normal_msg($recuname,$recdomain,
- &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
- $msgtxt,
+ $thismsg=&user_normal_msg($recuname,$recdomain,$msgsubj,$msgtxt,
$content{'citation'},undef,undef,$env{'form.permanent'},\$sentmessage{$_});
}
if (($env{'request.course.id'}) && (($msgtype eq 'critical') ||
@@ -2148,7 +2259,7 @@ sub sendoffmail {
my $record_sent;
my @recusers = ();
my @recudoms = ();
- my ($stamp,$msgsubj,$msgname,$msgdom,$msgcount,$context,$pid) =
+ my ($stamp,$crssubj,$msgname,$msgdom,$msgcount,$context,$pid) =
split(/\:/,&Apache::lonnet::unescape($specialmsgid));
foreach my $recipient (sort(keys(%toaddr))) {
if ($specialmsg_status{$recipient} eq 'ok') {
@@ -2156,8 +2267,8 @@ sub sendoffmail {
my $usermsgid = &buildmsgid($stamp,$usersubj,$msgname,
$msgdom,$msgcount,$context,$pid);
&user_normal_msg_raw($cnum,$cdom,$subj_prefix.
- ' ['.$recipient.']',$sentmessage{$recipient},
- undef,undef,undef,undef,$usermsgid);
+ ' ['.$recipient.']',$msgsubj,undef,
+ undef,undef,undef,$usermsgid,undef,undef,$specialmsgid);
my ($uname,$udom) = split/:/,$recipient;
push(@recusers,$uname);
push(@recudoms,$udom);
@@ -2166,14 +2277,12 @@ sub sendoffmail {
if (@recusers) {
my $specialmessage;
my $sentsubj = $subj_prefix.' ('.$numspecial.' sent) '.
- &Apache::lonfeedback::clear_out_html($env{'form.subject'});
+ $msgsubj;
$sentsubj = &HTML::Entities::encode($sentsubj,'<>&"');
my $sentmsgid = &buildmsgid($stamp,$sentsubj,$msgname,
$msgdom,$msgcount,$context,$pid);
- ($specialmsgid,$specialmessage) =
- &packagemsg(&Apache::lonfeedback::clear_out_html(
- $env{'form.subject'}),$savemsg,undef,undef,undef,
- \@recusers,\@recudoms,$sentmsgid);
+ ($specialmsgid,$specialmessage) = &packagemsg($msgsubj,$savemsg,
+ undef,undef,undef,\@recusers,\@recudoms,$sentmsgid);
$record_sent = &store_sent_mail($specialmsgid,$specialmessage);
}
} else {