version 1.155, 2005/11/18 13:35:30
|
version 1.198, 2007/03/02 23:17:59
|
Line 26
|
Line 26
|
# http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
# |
# |
|
|
|
|
package Apache::lonmsg; |
package Apache::lonmsg; |
|
|
=pod |
|
|
|
=head1 NAME |
|
|
|
Apache::lonmsg: supports internal messaging |
|
|
|
=head1 SYNOPSIS |
|
|
|
lonmsg provides routines for sending messages, receiving messages, and |
|
a handler to allow users to read, send, and delete messages. |
|
|
|
=head1 OVERVIEW |
|
|
|
=head2 Messaging Overview |
|
|
|
X<messages>LON-CAPA provides an internal messaging system similar to |
|
email, but customized for LON-CAPA's usage. LON-CAPA implements its |
|
own messaging system, rather then building on top of email, because of |
|
the features LON-CAPA messages can offer that conventional e-mail can |
|
not: |
|
|
|
=over 4 |
|
|
|
=item * B<Critical messages>: A message the recipient B<must> |
|
acknowlegde receipt of before they are allowed to continue using the |
|
system, preventing a user from claiming they never got a message |
|
|
|
=item * B<Receipts>: LON-CAPA can reliably send reciepts informing the |
|
sender that it has been read; again, useful for preventing students |
|
from claiming they did not see a message. (While conventional e-mail |
|
has some reciept support, it's sporadic, e-mail client-specific, and |
|
generally the receiver can opt to not send one, making it useless in |
|
this case.) |
|
|
|
=item * B<Context>: LON-CAPA knows about the sender, such as where |
|
they are in a course. When a student mails an instructor asking for |
|
help on the problem, the instructor receives not just the student's |
|
question, but all submissions the student has made up to that point, |
|
the user's rendering of the problem, and the complete view the student |
|
saw of the resource, including discussion up to that point. Finally, |
|
the instructor is reading all of this inside of LON-CAPA, not their |
|
email program, so they have full access to LON-CAPA's grading |
|
interface, or other features they may wish to use in response to the |
|
student's query. |
|
|
|
=item * B<Blocking>: LON-CAPA can block display of e-mails that are |
|
sent to a student during an online exam. A course coordinator or |
|
instructor can set an open and close date/time for scheduled online |
|
exams in a course. If a user uses the LON-CAPA internal messaging |
|
system to display e-mails during the scheduled blocking event, |
|
display of all e-mail sent during the blocking period will be |
|
suppressed, and a message of explanation, including details of the |
|
currently active blocking periods will be displayed instead. A user |
|
who has a course coordinator or instructor role in a course will be |
|
unaffected by any blocking periods for the course, unless the user |
|
also has a student role in the course, AND has selected the student role. |
|
|
|
=back |
|
|
|
Users can ask LON-CAPA to forward messages to conventional e-mail |
|
addresses on their B<PREF> screen, but generally, LON-CAPA messages |
|
are much more useful than traditional email can be made to be, even |
|
with HTML support. |
|
|
|
Right now, this document will cover just how to send a message, since |
|
it is likely you will not need to programmatically read messages, |
|
since lonmsg already implements that functionality. |
|
|
|
=head1 FUNCTIONS |
|
|
|
=over 4 |
|
|
|
=cut |
|
|
|
use strict; |
use strict; |
use Apache::lonnet; |
use Apache::lonnet; |
use vars qw($msgcount); |
|
use HTML::TokeParser(); |
use HTML::TokeParser(); |
use Apache::Constants qw(:common); |
|
use Apache::loncommon(); |
|
use Apache::lontexconvert(); |
|
use HTML::Entities(); |
|
use Mail::Send; |
|
use Apache::lonlocal; |
use Apache::lonlocal; |
use Apache::loncommunicate; |
use Mail::Send; |
use Apache::lonfeedback; |
use LONCAPA qw(:DEFAULT :match); |
use Apache::lonrss(); |
|
|
{ |
# Querystring component with sorting type |
my $uniq; |
my $sqs; |
sub get_uniq { |
my $startdis; |
$uniq++; |
my $interdis; |
return $uniq; |
|
} |
|
} |
|
|
# ===================================================================== Package |
# ===================================================================== Package |
|
|
sub packagemsg { |
sub packagemsg { |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
$recuser,$recdomain)=@_; |
$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_; |
$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 136 sub packagemsg {
|
Line 57 sub packagemsg {
|
#remove machine specification |
#remove machine specification |
$attachmenturl =~ s|^http://[^/]+/|/|; |
$attachmenturl =~ s|^http://[^/]+/|/|; |
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); |
$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'}, |
my $msgid=&Apache::lonnet::escape( |
$msgcount,$course_context,$symb,$error,$$); |
$now.':'.$partsubj.':'.$env{'user.name'}.':'. |
} |
$env{'user.domain'}.':'.$msgcount.':'. |
my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. |
$env{'request.course.id'}.':'.$$); |
|
my $result='<sendername>'.$env{'user.name'}.'</sendername>'. |
|
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
'<subject>'.$subject.'</subject>'. |
'<subject>'.$subject.'</subject>'. |
'<time>'.&Apache::lonlocal::locallocaltime($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>'. |
Line 157 sub packagemsg {
|
Line 100 sub packagemsg {
|
'<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>'. |
'<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. |
'<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. |
'<role>'.$env{'request.role'}.'</role>'. |
'<role>'.$env{'request.role'}.'</role>'. |
'<resource>'.$env{'request.filename'}.'</resource>'. |
'<resource>'.$env{'request.filename'}.'</resource>'. |
'<msgid>'.$msgid.'</msgid>'. |
'<msgid>'.$msgid.'</msgid>'; |
'<recuser>'.$recuser.'</recuser>'. |
if (ref($recuser) eq 'ARRAY') { |
'<recdomain>'.$recdomain.'</recdomain>'. |
for (my $i=0; $i<@{$recuser}; $i++) { |
'<message>'.$message.'</message>'; |
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)) { |
if (defined($citation)) { |
$result.='<citation>'.$citation.'</citation>'; |
$result.='<citation>'.$citation.'</citation>'; |
} |
} |
Line 174 sub packagemsg {
|
Line 134 sub packagemsg {
|
if (defined($attachmenturl)) { |
if (defined($attachmenturl)) { |
$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; |
$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; |
} |
} |
return $msgid,$result; |
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 |
Line 188 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'}) { |
if ($content{'attachmenturl'}) { |
my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); |
my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); |
if ($notoken) { |
if ($notoken) { |
Line 208 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); |
|
$symb = &escape($symb); |
|
return(&escape($now.':'.$subject.':'.$uname.':'. |
|
$udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error)); |
|
} |
|
|
sub unpackmsgid { |
sub unpackmsgid { |
my ($msgid,$folder)=@_; |
my ($msgid,$folder,$skipstatus,$status_cache)=@_; |
$msgid=&Apache::lonnet::unescape($msgid); |
$msgid=&unescape($msgid); |
my $suffix=&foldersuffix($folder); |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/, |
$processid,$symb,$error) = split(/\:/,&unescape($msgid)); |
&Apache::lonnet::unescape($msgid)); |
$shortsubj = &unescape($shortsubj); |
my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); |
$shortsubj = &HTML::Entities::decode($shortsubj); |
if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
$symb = &unescape($symb); |
unless ($status{$msgid}) { $status{$msgid}='new'; } |
if (!defined($processid)) { $fromcid = ''; } |
return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$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 { |
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 238 sub sendemail {
|
Line 246 sub sendemail {
|
# ==================================================== Send notification emails |
# ==================================================== Send notification emails |
|
|
sub sendnotification { |
sub sendnotification { |
my ($to,$touname,$toudom,$subj,$crit,$text)=@_; |
my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; |
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; |
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; |
unless ($sender=~/\w/) { |
unless ($sender=~/\w/) { |
$sender=$env{'user.name'}.'@'.$env{'user.domain'}; |
$sender=$env{'user.name'}.'@'.$env{'user.domain'}; |
Line 248 sub sendnotification {
|
Line 256 sub sendnotification {
|
$text=~s/\>\;/\>/gs; |
$text=~s/\>\;/\>/gs; |
$text=~s/\<\/*[^\>]+\>//gs; |
$text=~s/\<\/*[^\>]+\>//gs; |
my $url='http://'. |
my $url='http://'. |
$Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}. |
&Apache::lonnet::hostname(&Apache::lonnet::homeserver($touname,$toudom)). |
'/adm/email?username='.$touname.'&domain='.$toudom; |
'/adm/email?username='.$touname.'&domain='.$toudom; |
my $body=(<<ENDMSG); |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, |
You received a$critical message from $sender in LON-CAPA. The subject is |
$symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); |
|
my $coursetext; |
|
if ($fromcid ne '') { |
|
$coursetext = "\n".&mt('Course').': '; |
|
if ($env{'course.'.$fromcid.'.description'} ne '') { |
|
$coursetext .= $env{'course.'.$fromcid.'.description'}; |
|
} else { |
|
my %coursehash = &Apache::lonnet::coursedescription($fromcid,); |
|
if ($coursehash{'description'} ne '') { |
|
$coursetext .= $coursehash{'description'}; |
|
} |
|
} |
|
$coursetext .= "\n\n"; |
|
} |
|
my $body = $coursetext. |
|
&mt('You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '.&mt('The subject is |
|
|
$subj |
[_1] |
|
|
=== Excerpt ============================================================ |
',$subj)."\n". |
|
'=== '.&mt('Excerpt')." ============================================================ |
$text |
$text |
======================================================================== |
======================================================================== |
|
|
Use |
".&mt('Use |
|
|
$url |
[_1] |
|
|
to access the full message. |
to access the full message.',$url); |
ENDMSG |
|
&sendemail($to,'New'.$critical.' message from '.$sender,$body); |
&sendemail($to,'New'.$critical.' message from '.$sender,$body); |
} |
} |
# ============================================================= Check for email |
# ============================================================= Check for email |
Line 295 sub author_res_msg {
|
Line 318 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'; |
} |
} |
Line 310 sub author_res_msg {
|
Line 335 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 330 sub retrieve_author_res_msg {
|
Line 355 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 344 sub del_url_author_res_msg {
|
Line 369 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 365 sub all_url_author_res_msg {
|
Line 390 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)=@_; |
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 ($env{'request.course.id'}) { |
if (defined($sentmessage)) { |
&user_normal_msg_raw( |
$$sentmessage = $packed_message; |
$env{'course.'.$env{'request.course.id'}.'.num'}, |
} |
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
if ($env{'request.course.id'} eq '') { |
'Critical ['.$user.':'.$domain.']', |
(undef,my $packed_message_no_citation) = |
$message); |
&packagemsg($subject,$message,undef,undef,undef,$user,$domain, |
} |
$msgid); |
|
if ($status eq 'ok' || $status eq 'con_delayed') { |
|
&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,$msgid); |
} |
} |
if ($toperm && $userenv{'permanentemail'}) { |
if ($toperm && $userenv{'permanentemail'}) { |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
$text); |
$text,$msgid); |
} |
} |
# Log this |
# Log this |
&Apache::lonnet::logthis( |
&Apache::lonnet::logthis( |
Line 423 sub user_crit_msg_raw {
|
Line 463 sub user_crit_msg_raw {
|
a critical message $message to the $user at $domain. If $sendback is true, |
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. |
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 |
=cut |
|
|
sub user_crit_msg { |
sub user_crit_msg { |
my ($user,$domain,$subject,$message,$sendback,$toperm)=@_; |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
my $status=''; |
my @status; |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
$domain,$user); |
$domain,$user); |
my $msgforward=$userenv{'msgforward'}; |
my $msgforward=$userenv{'msgforward'}; |
if ($msgforward) { |
if ($msgforward) { |
foreach (split(/\,/,$msgforward)) { |
foreach my $addr (split(/\,/,$msgforward)) { |
my ($forwuser,$forwdomain)=split(/\:/,$_); |
my ($forwuser,$forwdomain)=split(/\:/,$addr); |
$status.= |
push(@status, |
&user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, |
&user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, |
$sendback,$toperm).' '; |
$sendback,$toperm,$sentmessage)); |
} |
} |
} else { |
} else { |
$status=&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,$toperm); |
push(@status, |
|
&user_crit_msg_raw($user,$domain,$subject,$message,$sendback, |
|
$toperm,$sentmessage)); |
} |
} |
return $status; |
if (wantarray) { |
|
return @status; |
|
} |
|
return join(' ',@status); |
} |
} |
|
|
# =================================================== Critical message received |
# =================================================== Critical message received |
Line 474 sub user_crit_received {
|
Line 527 sub user_crit_received {
|
|
|
sub user_normal_msg_raw { |
sub user_normal_msg_raw { |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
$toperm)=@_; |
$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; |
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)= |
$attachmenturl,$user,$domain); |
&packagemsg($subject,$message,$citation,$baseurl, |
|
$attachmenturl,$user,$domain,$currid, |
|
undef,$crsmsgid,$symb,$error); |
|
|
# 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($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); |
# Into sent-mail folder |
# Into sent-mail folder unless a broadcast message or critical message |
$status.=' '.&Apache::lonnet::critical( |
unless (($env{'request.course.id'}) && |
'put:'.$env{'user.domain'}.':'.$env{'user.name'}. |
(($env{'form.sendmode'} eq 'group') || |
':nohist_email_sent:'. |
(($env{'form.critmsg'}) || ($env{'form.sendbck'})) && |
&Apache::lonnet::escape($msgid).'='. |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
&Apache::lonnet::escape($message),$env{'user.home'}); |
|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
} else { |
'/'.$env{'request.course.sec'})))) { |
$status='no_host'; |
(undef,my $packed_message_no_citation) = |
} |
&packagemsg($subject,$message,undef,$baseurl,$attachmenturl, |
|
$user,$domain,$currid,undef,$crsmsgid,$symb,$error); |
|
if ($status eq 'ok' || $status eq 'con_delayed') { |
|
&store_sent_mail($msgid,$packed_message_no_citation); |
|
} |
|
} |
|
if (defined($newid)) { |
|
$$newid = $msgid; |
|
} |
|
if (defined($sentmessage)) { |
|
$$sentmessage = $packed_message; |
|
} |
# Notifications |
# Notifications |
my %userenv = &Apache::lonnet::get('environment',['notification', |
my %userenv = &Apache::lonnet::get('environment',['notification', |
'permanentemail'], |
'permanentemail'], |
$domain,$user); |
$domain,$user); |
if ($userenv{'notification'}) { |
if ($userenv{'notification'}) { |
&sendnotification($userenv{'notification'},$user,$domain,$subject,0, |
&sendnotification($userenv{'notification'},$user,$domain,$subject,0, |
$text); |
$text,$msgid); |
} |
} |
if ($toperm && $userenv{'permanentemail'}) { |
if ($toperm && $userenv{'permanentemail'}) { |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, |
$text); |
$text,$msgid); |
} |
} |
&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 '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
|
} else { |
|
$status='no_host'; |
|
} |
return $status; |
return $status; |
} |
} |
|
|
Line 523 sub user_normal_msg_raw {
|
Line 594 sub user_normal_msg_raw {
|
|
|
=pod |
=pod |
|
|
=item * B<user_normal_msg($user, $domain, $subject, $message, |
=item * B<user_normal_msg($user, $domain, $subject, $message, $citation, |
$citation, $baseurl, $attachmenturl)>: Sends a message to the |
$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>: |
$user at $domain, with subject $subject and message $message. |
Sends a message to the $user at $domain, with subject $subject and message $message. |
|
|
=cut |
=cut |
|
|
sub user_normal_msg { |
sub user_normal_msg { |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
$toperm)=@_; |
$toperm,$sentmessage,$symb,$restitle,$error)=@_; |
my $status=''; |
my $status=''; |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
$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).' '; |
$citation,$baseurl,$attachmenturl,$toperm, |
} |
undef,undef,$sentmessage,undef,$symb,$restitle,$error).' '; |
} else { |
} |
|
} else { |
$status=&user_normal_msg_raw($user,$domain,$subject,$message, |
$status=&user_normal_msg_raw($user,$domain,$subject,$message, |
$citation,$baseurl,$attachmenturl,$toperm); |
$citation,$baseurl,$attachmenturl,$toperm, |
|
undef,undef,$sentmessage,undef,$symb,$restitle,$error); |
} |
} |
return $status; |
return $status; |
} |
} |
|
|
|
sub store_sent_mail { |
# ============================================================ List all folders |
my ($msgid,$message) = @_; |
|
my $status =' '.&Apache::lonnet::critical( |
sub folderlist { |
'put:'.$env{'user.domain'}.':'.$env{'user.name'}. |
my $folder=shift; |
':nohist_email_sent:'. |
my @allfolders=&Apache::lonnet::getkeys('email_folders'); |
&escape($msgid).'='. |
if ($allfolders[0]=~/^error:/) { @allfolders=(); } |
&escape($message),$env{'user.home'}); |
return '<form method="post" action="/adm/email">'. |
return $status; |
&mt('Folder').': '. |
|
&Apache::loncommon::select_form($folder,'folder', |
|
('' => &mt('INBOX'),'trash' => &mt('TRASH'), |
|
'new' => &mt('New Messages Only'), |
|
'critical' => &mt('Critical'), |
|
'sent' => &mt('Sent Messages'), |
|
map { $_ => $_ } @allfolders)). |
|
' '.&mt('Show'). |
|
'<select name="interdis">'. |
|
join("\n",map { '<option value="'.$_.'"'. |
|
($_==$interdis?' selected="selected"':'').'>'.$_.'</option>' } |
|
(10,20,50,100,200)).'</select>'. |
|
'<input type="submit" value="'.&mt('View Folder').'" /><br />'. |
|
'<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />'. |
|
($folder=~/^(new|critical)/?'</form>':''); |
|
} |
|
|
|
sub scrollbuttons { |
|
my ($start,$maxdis,$first,$finish,$total)=@_; |
|
unless ($total>0) { return ''; } |
|
$start++; $maxdis++;$first++;$finish++; |
|
return |
|
&mt('Page').': '. |
|
'<input type="submit" name="firstview" value="'.&mt('First').'" />'. |
|
'<input type="submit" name="prevview" value="'.&mt('Previous').'" />'. |
|
'<input type="text" size="5" name="startdis" value="'.$start.'" onChange="this.form.submit()" /> of '.$maxdis. |
|
'<input type="submit" name="nextview" value="'.&mt('Next').'" />'. |
|
'<input type="submit" name="lastview" value="'.&mt('Last').'" /><br />'. |
|
&mt('Showing messages [_1] through [_2] of [_3]',$first,$finish,$total).'</form>'; |
|
} |
} |
|
|
# =============================================================== Folder suffix |
# =============================================================== Folder suffix |
Line 594 sub scrollbuttons {
|
Line 638 sub scrollbuttons {
|
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') { |
# =============================================================== Status Change |
$suffix = '_'.&escape($folderhash{$folder}{'id'}); |
|
} else { |
sub statuschange { |
$suffix = '_'.&escape($folder); |
my ($msgid,$newstatus,$folder)=@_; |
} |
my $suffix=&foldersuffix($folder); |
return $suffix; |
my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); |
} |
if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
|
unless ($status{$msgid}) { $status{$msgid}='new'; } |
# ========================================================= User-defined folders |
unless (($status{$msgid} eq 'replied') || |
|
($status{$msgid} eq 'forwarded')) { |
sub get_user_folders { |
&Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus}); |
my ($folder) = @_; |
} |
my %userfolders = |
if (($newstatus eq 'deleted') || ($newstatus eq 'new')) { |
&Apache::lonnet::dump('email_folders',undef,undef,$folder); |
&Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus}); |
my $lock = "\0".'lock_counter'; # locks db while counter incremented |
} |
my $counter = "\0".'idcount'; # used in suffix for email db files |
if ($newstatus eq 'deleted') { |
if (defined($userfolders{$lock})) { |
&movemsg(&Apache::lonnet::unescape($msgid),$folder,'trash'); |
delete($userfolders{$lock}); |
} |
} |
} |
if (defined($userfolders{$counter})) { |
|
delete($userfolders{$counter}); |
# ============================================================= Make new folder |
} |
|
return %userfolders; |
sub makefolder { |
} |
my ($newfolder)=@_; |
|
if (($newfolder eq 'sent') |
sub secapply { |
|| ($newfolder eq 'critical') |
my $rec=shift; |
|| ($newfolder eq 'trash') |
my $defaultflag=shift; |
|| ($newfolder eq 'new')) { return; } |
$rec=~s/\s+//g; |
&Apache::lonnet::put('email_folders',{$newfolder => time}); |
$rec=~s/\@/\:/g; |
} |
my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/); |
|
if ($sections_or_groups) { |
# ======================================================== Move between folders |
foreach my $item (split(/\;/,$sections_or_groups)) { |
|
if (($item eq $env{'request.course.sec'}) || |
sub movemsg { |
($defaultflag && ($item eq '*'))) { |
my ($msgid,$srcfolder,$trgfolder)=@_; |
return $adr; |
if ($srcfolder eq 'new') { $srcfolder=''; } |
} elsif ($env{'request.course.groups'}) { |
my $srcsuffix=&foldersuffix($srcfolder); |
my @usersgroups = split(/:/,$env{'request.course.groups'}); |
my $trgsuffix=&foldersuffix($trgfolder); |
if (grep(/^\Q$item\E$/,@usersgroups)) { |
|
return $adr; |
# Copy message |
|
my %message=&Apache::lonnet::get('nohist_email'.$srcsuffix,[$msgid]); |
|
&Apache::lonnet::put('nohist_email'.$trgsuffix,{$msgid => $message{$msgid}}); |
|
|
|
# Copy status |
|
unless ($trgfolder eq 'trash') { |
|
my %status=&Apache::lonnet::get('email_status'.$srcsuffix,[$msgid]); |
|
&Apache::lonnet::put('email_status'.$trgsuffix,{$msgid => $status{$msgid}}); |
|
} |
|
# Delete orginals |
|
&Apache::lonnet::del('nohist_email'.$srcsuffix,[$msgid]); |
|
&Apache::lonnet::del('email_status'.$srcsuffix,[$msgid]); |
|
} |
|
|
|
# ======================================================= Display a course list |
|
|
|
sub discourse { |
|
my $r=shift; |
|
my $classlist = &Apache::loncoursedata::get_classlist(); |
|
my $now=time; |
|
my %lt=&Apache::lonlocal::texthash('cfa' => 'Check All', |
|
'cfs' => 'Check Section/Group', |
|
'cfn' => 'Uncheck All'); |
|
$r->print(<<ENDDISHEADER); |
|
<input type="hidden" name="sendmode" value="group" /> |
|
<script> |
|
function checkall() { |
|
for (i=0; i<document.forms.compemail.elements.length; i++) { |
|
if |
|
(document.forms.compemail.elements[i].name.indexOf('send_to_')==0) { |
|
document.forms.compemail.elements[i].checked=true; |
|
} |
|
} |
|
} |
|
|
|
function checksec() { |
|
for (i=0; i<document.forms.compemail.elements.length; i++) { |
|
if |
|
(document.forms.compemail.elements[i].name.indexOf |
|
('send_to_&&&'+document.forms.compemail.chksec.value)==0) { |
|
document.forms.compemail.elements[i].checked=true; |
|
} |
|
} |
|
} |
|
|
|
function uncheckall() { |
|
for (i=0; i<document.forms.compemail.elements.length; i++) { |
|
if |
|
(document.forms.compemail.elements[i].name.indexOf('send_to_')==0) { |
|
document.forms.compemail.elements[i].checked=false; |
|
} |
|
} |
|
} |
|
</script> |
|
<input type="button" onClick="checkall()" value="$lt{'cfa'}" /> |
|
<input type="button" onClick="checksec()" value="$lt{'cfs'}" /> |
|
<input type="text" size="5" name="chksec" /> |
|
<input type="button" onClick="uncheckall()" value="$lt{'cfn'}" /> |
|
<p> |
|
ENDDISHEADER |
|
my %coursepersonnel=&Apache::lonnet::get_course_adv_roles(); |
|
$r->print('<table>'); |
|
foreach my $role (sort keys %coursepersonnel) { |
|
foreach (split(/\,/,$coursepersonnel{$role})) { |
|
my ($puname,$pudom)=split(/\:/,$_); |
|
$r->print('<tr><td><label>'. |
|
'<input type="checkbox" name="send_to_&&&&&&_'. |
|
$puname.':'.$pudom.'" /> '. |
|
&Apache::loncommon::plainname($puname,$pudom). |
|
'</label></td>'. |
|
'<td>('.$_.'),</td><td><i>'.$role.'</i></td></tr>'); |
|
} |
|
} |
|
$r->print('</table><table>'); |
|
my $sort = sub { |
|
my $aname=lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]); |
|
if (!$aname) { $aname=$a; } |
|
my $bname=lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]); |
|
if (!$bname) { $bname=$b; } |
|
return $aname cmp $bname; |
|
}; |
|
foreach my $student (sort $sort (keys(%{$classlist}))) { |
|
my $info=$classlist->{$student}; |
|
my ($sname,$sdom,$status,$fullname,$section) = |
|
(@{$info}[&Apache::loncoursedata::CL_SNAME(), |
|
&Apache::loncoursedata::CL_SDOM(), |
|
&Apache::loncoursedata::CL_STATUS(), |
|
&Apache::loncoursedata::CL_FULLNAME(), |
|
&Apache::loncoursedata::CL_SECTION()]); |
|
next if ($status ne 'Active'); |
|
next if ($env{'request.course.sec'} && |
|
$section ne $env{'request.course.sec'}); |
|
my $key = 'send_to_&&&'.$section.'&&&_'.$student; |
|
if (! defined($fullname) || $fullname eq '') { $fullname = $sname; } |
|
$r->print('<tr><td><label>'. |
|
qq{<input type="checkbox" name="$key" />}.(' 'x2). |
|
$fullname.'</label></td><td>'.$sname.'@'.$sdom.'</td><td>'.$section. |
|
'</td></tr>'); |
|
} |
|
$r->print('</table>'); |
|
} |
|
|
|
# ==================================================== Display Critical Message |
|
|
|
sub discrit { |
|
my $r=shift; |
|
my $header = '<h1><font color=red>'.&mt('Critical Messages').'</font></h1>'. |
|
'<form action="/adm/email" method="POST">'. |
|
'<input type="hidden" name="confirm" value="true" />'; |
|
my %what=&Apache::lonnet::dump('critical'); |
|
my $result = ''; |
|
foreach (sort keys %what) { |
|
my %content=&unpackagemsg($what{$_}); |
|
next if ($content{'senderdomain'} eq ''); |
|
$result.='<hr />'.&mt('From').': <b>'. |
|
&Apache::loncommon::aboutmewrapper( |
|
&Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('. |
|
$content{'sendername'}.'@'. |
|
$content{'senderdomain'}.') '.$content{'time'}. |
|
'<br />'.&mt('Subject').': '.$content{'subject'}. |
|
'<br /><pre>'. |
|
&Apache::lontexconvert::msgtexconverted($content{'message'}). |
|
'</pre><small>'. |
|
&mt('You have to confirm that you received this message. After confirmation, this message will be moved to your regular inbox'). |
|
'</small><br />'. |
|
'<input type="submit" name="rec_'.$_.'" value="'.&mt('Confirm Receipt').'" />'. |
|
'<input type="submit" name="reprec_'.$_.'" '. |
|
'value="'.&mt('Confirm Receipt and Reply').'" />'; |
|
} |
|
# Check to see if there were any messages. |
|
if ($result eq '') { |
|
$result = "<h2>".&mt('You have no critical messages.')."</h2>". |
|
'<a href="/adm/roles">'.&mt('Select a course').'</a><br />'. |
|
'<a href="/adm/email">'.&mt('Communicate').'</a>'; |
|
} else { |
|
$r->print($header); |
|
} |
|
$r->print($result); |
|
$r->print('<input type="hidden" name="displayedcrit" value="true" /></form>'); |
|
} |
|
|
|
sub sortedmessages { |
|
my ($blocked,$startblock,$endblock,$numblocked,$folder) = @_; |
|
my $suffix=&foldersuffix($folder); |
|
my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix); |
|
#unpack the varibles and repack into temp for sorting |
|
my @temp; |
|
foreach (@messages) { |
|
my $msgid=&Apache::lonnet::escape($_); |
|
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)= |
|
&Apache::lonmsg::unpackmsgid($msgid,$folder); |
|
my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status, |
|
$msgid); |
|
# Check whether message was sent during blocking period. |
|
if ($sendtime >= $startblock && ($sendtime <= $endblock && $endblock > 0) ) { |
|
my $escid = &Apache::lonnet::unescape($msgid); |
|
$$blocked{$escid} = 'ON'; |
|
$$numblocked ++; |
|
} else { |
|
push @temp ,\@temp1; |
|
} |
|
} |
|
#default sort |
|
@temp = sort {$a->[0] <=> $b->[0]} @temp; |
|
if ($env{'form.sortedby'} eq "date"){ |
|
@temp = sort {$a->[0] <=> $b->[0]} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "revdate"){ |
|
@temp = sort {$b->[0] <=> $a->[0]} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "user"){ |
|
@temp = sort {lc($a->[2]) cmp lc($b->[2])} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "revuser"){ |
|
@temp = sort {lc($b->[2]) cmp lc($a->[2])} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "domain"){ |
|
@temp = sort {$a->[3] cmp $b->[3]} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "revdomain"){ |
|
@temp = sort {$b->[3] cmp $a->[3]} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "subject"){ |
|
@temp = sort {lc($a->[1]) cmp lc($b->[1])} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "revsubject"){ |
|
@temp = sort {lc($b->[1]) cmp lc($a->[1])} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "status"){ |
|
@temp = sort {$a->[4] cmp $b->[4]} @temp; |
|
} |
|
if ($env{'form.sortedby'} eq "revstatus"){ |
|
@temp = sort {$b->[4] cmp $a->[4]} @temp; |
|
} |
|
return @temp; |
|
} |
|
|
|
# ======================================================== Display new messages |
|
|
|
|
|
sub disnew { |
|
my $r=shift; |
|
my %lt=&Apache::lonlocal::texthash( |
|
'nm' => 'New Messages', |
|
'su' => 'Subject', |
|
'da' => 'Date', |
|
'us' => 'Username', |
|
'op' => 'Open', |
|
'do' => 'Domain' |
|
); |
|
my @msgids = sort split(/\&/,&Apache::lonnet::reply |
|
('keys:'.$env{'user.domain'}.':'. |
|
$env{'user.name'}.':nohist_email', |
|
$env{'user.home'})); |
|
my @newmsgs; |
|
my %setters = (); |
|
my $startblock = 0; |
|
my $endblock = 0; |
|
my %blocked = (); |
|
my $numblocked = 0; |
|
# Check for blocking of display because of scheduled online exams. |
|
&blockcheck(\%setters,\$startblock,\$endblock); |
|
foreach (@msgids) { |
|
my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)= |
|
&Apache::lonmsg::unpackmsgid($_); |
|
if (defined($sendtime) && $sendtime!~/error/) { |
|
my $numsendtime = $sendtime; |
|
$sendtime = &Apache::lonlocal::locallocaltime($sendtime); |
|
if ($status eq 'new') { |
|
if ($numsendtime >= $startblock && ($numsendtime <= $endblock && $endblock > 0) ) { |
|
$blocked{$_} = 'ON'; |
|
$numblocked ++; |
|
} else { |
|
push @newmsgs, { |
|
msgid => $_, |
|
sendtime => $sendtime, |
|
shortsub => &Apache::lonnet::unescape($shortsubj), |
|
from => $fromname, |
|
fromdom => $fromdom |
|
} |
|
} |
|
} |
|
} |
|
} |
|
if ($#newmsgs >= 0) { |
|
$r->print(<<TABLEHEAD); |
|
<h2>$lt{'nm'}</h2> |
|
<table border=2><tr><th> </th> |
|
<th>$lt{'da'}</th><th>$lt{'us'}</th><th>$lt{'do'}</th><th>$lt{'su'}</th></tr> |
|
TABLEHEAD |
|
foreach my $msg (@newmsgs) { |
|
$r->print(<<"ENDLINK"); |
|
<tr class="new" bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor='#DD9955'" |
|
onMouseOut="javascript:style.backgroundColor='#FFBB77'"> |
|
<td><a href="/adm/email?dismode=new&display=$msg->{'msgid'}">$lt{'op'}</a></td> |
|
ENDLINK |
|
foreach ('sendtime','from','fromdom','shortsub') { |
|
$r->print("<td>$msg->{$_}</td>"); |
|
} |
|
$r->print("</td></tr>"); |
|
} |
|
$r->print('</table>'.&Apache::loncommon::endbodytag().'</html>'); |
|
} elsif ($numblocked == 0) { |
|
$r->print("<h3>".&mt('You have no unread messages')."</h3>"); |
|
} |
|
if ($numblocked > 0) { |
|
my $beginblock = &Apache::lonlocal::locallocaltime($startblock); |
|
my $finishblock = &Apache::lonlocal::locallocaltime($endblock); |
|
if ($numblocked == 1) { |
|
$r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread message').".</h3>"); |
|
$r->print(&mt('This message is not viewable because').' '); |
|
} else { |
|
$r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread messages').".</h3>"); |
|
$r->print(&mt('These').' '.$numblocked.' '.&mt('messages are not viewable because ')); |
|
} |
|
$r->print( |
|
&mt('display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams').'.'); |
|
&build_block_table($r,$startblock,$endblock,\%setters); |
|
} |
|
} |
|
|
|
|
|
# ======================================================== Display all messages |
|
|
|
sub disall { |
|
my ($r,$folder)=@_; |
|
$r->print(&folderlist($folder)); |
|
if ($folder eq 'new') { |
|
&disnew($r); |
|
} elsif ($folder eq 'critical') { |
|
&discrit($r); |
|
} else { |
|
&disfolder($r,$folder); |
|
} |
|
} |
|
|
|
# ============================================================ Display a folder |
|
|
|
sub disfolder { |
|
my ($r,$folder)=@_; |
|
my %blocked = (); |
|
my %setters = (); |
|
my $startblock; |
|
my $endblock; |
|
my $numblocked = 0; |
|
&blockcheck(\%setters,\$startblock,\$endblock); |
|
$r->print(<<ENDDISHEADER); |
|
<script> |
|
function checkall() { |
|
for (i=0; i<document.forms.disall.elements.length; i++) { |
|
if |
|
(document.forms.disall.elements[i].name.indexOf('delmark_')==0) { |
|
document.forms.disall.elements[i].checked=true; |
|
} |
|
} |
|
} |
|
|
|
function uncheckall() { |
|
for (i=0; i<document.forms.disall.elements.length; i++) { |
|
if |
|
(document.forms.disall.elements[i].name.indexOf('delmark_')==0) { |
|
document.forms.disall.elements[i].checked=false; |
|
} |
|
} |
|
} |
|
</script> |
|
ENDDISHEADER |
|
my $fsqs='&folder='.$folder; |
|
my @temp=sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder); |
|
my $totalnumber=$#temp+1; |
|
unless ($totalnumber>0) { |
|
$r->print('<h2>'.&mt('Empty Folder').'</h2>'); |
|
return; |
|
} |
|
unless ($interdis) { |
|
$interdis=20; |
|
} |
|
my $number=int($totalnumber/$interdis); |
|
if (($startdis<0) || ($startdis>$number)) { $startdis=$number; } |
|
my $firstdis=$interdis*$startdis; |
|
if ($firstdis>$#temp) { $firstdis=$#temp-$interdis+1; } |
|
my $lastdis=$firstdis+$interdis-1; |
|
if ($lastdis>$#temp) { $lastdis=$#temp; } |
|
$r->print(&scrollbuttons($startdis,$number,$firstdis,$lastdis,$totalnumber)); |
|
$r->print('<form method="post" name="disall" action="/adm/email">'. |
|
'<table border=2><tr><th colspan="3"> </th><th>'); |
|
if ($env{'form.sortedby'} eq "revdate") { |
|
$r->print('<a href = "?sortedby=date'.$fsqs.'">'.&mt('Date').'</a></th>'); |
|
} else { |
|
$r->print('<a href = "?sortedby=revdate'.$fsqs.'">'.&mt('Date').'</a></th>'); |
|
} |
|
$r->print('<th>'); |
|
if ($env{'form.sortedby'} eq "revuser") { |
|
$r->print('<a href = "?sortedby=user'.$fsqs.'">'.&mt('Username').'</a>'); |
|
} else { |
|
$r->print('<a href = "?sortedby=revuser'.$fsqs.'">'.&mt('Username').'</a>'); |
|
} |
|
$r->print('</th><th>'); |
|
if ($env{'form.sortedby'} eq "revdomain") { |
|
$r->print('<a href = "?sortedby=domain'.$fsqs.'">'.&mt('Domain').'</a>'); |
|
} else { |
|
$r->print('<a href = "?sortedby=revdomain'.$fsqs.'">'.&mt('Domain').'</a>'); |
|
} |
|
$r->print('</th><th>'); |
|
if ($env{'form.sortedby'} eq "revsubject") { |
|
$r->print('<a href = "?sortedby=subject'.$fsqs.'">'.&mt('Subject').'</a>'); |
|
} else { |
|
$r->print('<a href = "?sortedby=revsubject'.$fsqs.'">'.&mt('Subject').'</a>'); |
|
} |
|
$r->print('</th><th>'); |
|
if ($env{'form.sortedby'} eq "revstatus") { |
|
$r->print('<a href = "?sortedby=status'.$fsqs.'">'.&mt('Status').'</a></th>'); |
|
} else { |
|
$r->print('<a href = "?sortedby=revstatus'.$fsqs.'">'.&mt('Status').'</a></th>'); |
|
} |
|
$r->print("</tr>\n"); |
|
for (my $n=$firstdis;$n<=$lastdis;$n++) { |
|
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$origID)= @{$temp[$n]}; |
|
if (($status ne 'deleted') && defined($sendtime) && $sendtime!~/error/) { |
|
if ($status eq 'new') { |
|
$r->print('<tr bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor=\'#DD9955\'" onMouseOut="javascript:style.backgroundColor=\'#FFBB77\'">'); |
|
} elsif ($status eq 'read') { |
|
$r->print('<tr bgcolor="#BBBB77" onMouseOver="javascript:style.backgroundColor=\'#999944\'" onMouseOut="javascript:style.backgroundColor=\'#BBBB77\'">'); |
|
} elsif ($status eq 'replied') { |
|
$r->print('<tr bgcolor="#AAAA88" onMouseOver="javascript:style.backgroundColor=\'#888855\'" onMouseOut="javascript:style.backgroundColor=\'#AAAA88\'">'); |
|
} else { |
|
$r->print('<tr bgcolor="#99BBBB" onMouseOver="javascript:style.backgroundColor=\'#669999\'" onMouseOut="javascript:style.backgroundColor=\'#99BBBB\'">'); |
|
} |
|
$r->print('<td><input type="checkbox" name="delmark_'.$origID.'" /></td><td><a href="/adm/email?display='.$origID.$sqs. |
|
'">'.&mt('Open').'</a></td><td>'. |
|
($folder ne 'trash'?'<a href="/adm/email?markdel='.$origID.$sqs. |
|
'">'.&mt('Delete'):' ').'</a></td>'. |
|
'<td>'.&Apache::lonlocal::locallocaltime($sendtime).'</td><td>'. |
|
$fromname.'</td><td>'.$fromdomain.'</td><td>'. |
|
&Apache::lonnet::unescape($shortsubj).'</td><td>'. |
|
$status."</td></tr>\n"); |
|
} elsif ($status eq 'deleted') { |
|
# purge |
|
&movemsg(&Apache::lonnet::unescape($origID),$folder,'trash'); |
|
} |
|
} |
|
$r->print("</table>\n<p>". |
|
'<a href="javascript:checkall()">'.&mt('Check All').'</a> '. |
|
'<a href="javascript:uncheckall()">'.&mt('Uncheck All').'</a></p>'. |
|
'<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />'); |
|
if ($folder ne 'trash') { |
|
$r->print( |
|
'<p><input type="submit" name="markeddel" value="'.&mt('Delete Checked').'" /></p>'); |
|
} |
|
$r->print('<p><input type="submit" name="markedmove" value="'.&mt('Move Checked to Folder').'" />'); |
|
my @allfolders=&Apache::lonnet::getkeys('email_folders'); |
|
if ($allfolders[0]=~/^error:/) { @allfolders=(); } |
|
$r->print( |
|
&Apache::loncommon::select_form('','movetofolder', |
|
( map { $_ => $_ } @allfolders)) |
|
); |
|
my $postedstartdis=$startdis+1; |
|
$r->print('<input type="hidden" name="folder" value="'.$folder.'" /><input type="hidden" name="startdis" value="'.$postedstartdis.'" /><input type="hidden" name="interdis" value="'.$env{'form.interdis'}.'" /></form>'); |
|
if ($numblocked > 0) { |
|
my $beginblock = &Apache::lonlocal::locallocaltime($startblock); |
|
my $finishblock = &Apache::lonlocal::locallocaltime($endblock); |
|
$r->print('<br /><br />'. |
|
$numblocked.' '.&mt('message(s) is/are not viewable because display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams.')); |
|
&build_block_table($r,$startblock,$endblock,\%setters); |
|
} |
|
} |
|
|
|
# ============================================================== Compose output |
|
|
|
sub compout { |
|
my ($r,$forwarding,$replying,$broadcast,$replycrit,$folder,$dismode)=@_; |
|
my $suffix=&foldersuffix($folder); |
|
|
|
if ($broadcast eq 'individual') { |
|
&printheader($r,'/adm/email?compose=individual', |
|
'Send a Message'); |
|
} elsif ($broadcast) { |
|
&printheader($r,'/adm/email?compose=group', |
|
'Broadcast Message'); |
|
} elsif ($forwarding) { |
|
&Apache::lonhtmlcommon::add_breadcrumb |
|
({href=>"/adm/email?display=".&Apache::lonnet::escape($forwarding), |
|
text=>"Display Message"}); |
|
&printheader($r,'/adm/email?forward='.&Apache::lonnet::escape($forwarding), |
|
'Forwarding a Message'); |
|
} elsif ($replying) { |
|
&Apache::lonhtmlcommon::add_breadcrumb |
|
({href=>"/adm/email?display=".&Apache::lonnet::escape($replying), |
|
text=>"Display Message"}); |
|
&printheader($r,'/adm/email?replyto='.&Apache::lonnet::escape($replying), |
|
'Replying to a Message'); |
|
} elsif ($replycrit) { |
|
$r->print('<h3>'.&mt('Replying to a Critical Message').'</h3>'); |
|
$replying=$replycrit; |
|
} else { |
|
&printheader($r,'/adm/email?compose=upload', |
|
'Distribute from Uploaded File'); |
|
} |
|
|
|
my $dispcrit=''; |
|
my $dissub=''; |
|
my $dismsg=''; |
|
my $disbase=''; |
|
my $func=&mt('Send New'); |
|
my %lt=&Apache::lonlocal::texthash('us' => 'Username', |
|
'do' => 'Domain', |
|
'ad' => 'Additional Recipients', |
|
'sb' => 'Subject', |
|
'ca' => 'Cancel', |
|
'ma' => 'Mail'); |
|
|
|
if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { |
|
my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message"); |
|
$dispcrit= |
|
'<p><label><input type="checkbox" name="critmsg" /> '.&mt('Send as critical message').'</label> ' . $crithelp . |
|
'</p><p>'. |
|
'<label><input type="checkbox" name="sendbck" /> '.&mt('Send as critical message').' ' . |
|
&mt('and return receipt') . '</label>' . $crithelp . |
|
'</p><p><label><input type="checkbox" name="permanent" /> '. |
|
&mt('Send copy to permanent email address (if known)').'</label></p>'. |
|
'<p><label><input type="checkbox" name="rsspost" /> '. |
|
&mt('Include in course RSS newsfeed').'</label></p>'; } |
|
my %message; |
|
my %content; |
|
my $defdom=$env{'user.domain'}; |
|
if ($forwarding) { |
|
%message=&Apache::lonnet::get('nohist_email'.$suffix,[$forwarding]); |
|
%content=&unpackagemsg($message{$forwarding},$folder); |
|
$dispcrit.='<input type="hidden" name="forwid" value="'. |
|
$forwarding.'" />'; |
|
$func=&mt('Forward'); |
|
|
|
$dissub=&mt('Forwarding').': '.$content{'subject'}; |
|
$dismsg=&mt('Forwarded message from').' '. |
|
$content{'sendername'}.' '.&mt('at').' '.$content{'senderdomain'}; |
|
if ($content{'baseurl'}) { |
|
$disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />'; |
|
} |
|
} |
|
if ($replying) { |
|
%message=&Apache::lonnet::get('nohist_email'.$suffix,[$replying]); |
|
%content=&unpackagemsg($message{$replying},$folder); |
|
$dispcrit.='<input type="hidden" name="replyid" value="'. |
|
$replying.'" />'; |
|
$func=&mt('Send Reply to'); |
|
|
|
$dissub=&mt('Reply').': '.$content{'subject'}; |
|
$dismsg='> '.$content{'message'}; |
|
$dismsg=~s/\r/\n/g; |
|
$dismsg=~s/\f/\n/g; |
|
$dismsg=~s/\n+/\n\> /g; |
|
if ($content{'baseurl'}) { |
|
$disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />'; |
|
if ($env{'user.adv'}) { |
|
$disbase.='<label><input type="checkbox" name="storebasecomment" />'.&mt('Store message for re-use'). |
|
'</label> <a href="/adm/email?showcommentbaseurl='. |
|
&Apache::lonnet::escape($content{'baseurl'}).'" target="comments">'. |
|
&mt('Show re-usable messages').'</a><br />'; |
|
} |
|
} |
|
} |
|
my $citation=&displayresource(%content); |
|
if ($env{'form.recdom'}) { $defdom=$env{'form.recdom'}; } |
|
$r->print( |
|
'<form action="/adm/email" name="compemail" method="post"'. |
|
' enctype="multipart/form-data">'."\n". |
|
'<input type="hidden" name="sendmail" value="on" />'."\n". |
|
'<table>'); |
|
unless (($broadcast eq 'group') || ($broadcast eq 'upload')) { |
|
if ($replying) { |
|
$r->print('<tr><td colspan="2">'.&mt('Replying to').' '. |
|
&Apache::loncommon::aboutmewrapper( |
|
&Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('. |
|
$content{'sendername'}.'@'. |
|
$content{'senderdomain'}.')'. |
|
'<input type="hidden" name="recuname" value="'.$content{'sendername'}.'" />'. |
|
'<input type="hidden" name="recdomain" value="'.$content{'senderdomain'}.'" />'. |
|
'</td></tr>'); |
|
} else { |
|
my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain'); |
|
my $selectlink=&Apache::loncommon::selectstudent_link |
|
('compemail','recuname','recdomain'); |
|
$r->print(<<"ENDREC"); |
|
<tr><td>$lt{'us'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recname'}" /></td><td rowspan="2">$selectlink</td></tr> |
|
<tr><td>$lt{'do'}:</td> |
|
<td>$domform</td></tr> |
|
ENDREC |
|
} |
|
} |
|
my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); |
|
if ($broadcast ne 'upload') { |
|
$r->print(<<"ENDCOMP"); |
|
<tr><td>$lt{'ad'}<br /><tt>username\@domain,username\@domain, ... |
|
</tt></td><td> |
|
<input type="text" size="50" name="additionalrec" /></td></tr> |
|
<tr><td>$lt{'sb'}:</td><td><input type="text" size="50" name="subject" value="$dissub" /> |
|
</td></tr></table> |
|
$latexHelp |
|
<textarea name="message" id="message" cols="80" rows="15" wrap="hard">$dismsg |
|
</textarea></p><br /> |
|
$dispcrit |
|
$disbase |
|
<input type="hidden" name="folder" value="$folder" /> |
|
<input type="hidden" name="dismode" value="$dismode" /> |
|
<input type="submit" name="send" value="$func $lt{'ma'}" /> |
|
<input type="submit" name="cancel" value="$lt{'ca'}" /><hr /> |
|
$citation |
|
ENDCOMP |
|
} else { # $broadcast is 'upload' |
|
$r->print(<<ENDUPLOAD); |
|
<input type="hidden" name="sendmode" value="upload" /> |
|
<input type="hidden" name="send" value="on" /> |
|
<h3>Generate messages from a file</h3> |
|
<p> |
|
Subject: <input type="text" size="50" name="subject" /> |
|
</p> |
|
<p>General message text<br /> |
|
<textarea name="message" id="message" cols="60" rows="10" wrap="hard">$dismsg |
|
</textarea></p> |
|
<p> |
|
The file format for the uploaded portion of the message is: |
|
<pre> |
|
username1\@domain1: text |
|
username2\@domain2: text |
|
username3\@domain1: text |
|
</pre> |
|
</p> |
|
<p> |
|
The messages will be assembled from all lines with the respective |
|
<tt>username\@domain</tt>, and appended to the general message text.</p> |
|
<p> |
|
<input type="file" name="upfile" size="40" /></p><p> |
|
$dispcrit |
|
<input type="submit" value="Upload and Send" /></p> |
|
ENDUPLOAD |
|
} |
|
if ($broadcast eq 'group') { |
|
&discourse; |
|
} |
|
$r->print('</form>'. |
|
&Apache::lonfeedback::generate_preview_button('compemail','message'). |
|
&Apache::lonhtmlcommon::htmlareaselectactive('message')); |
|
} |
|
|
|
# ---------------------------------------------------- Display all face to face |
|
|
|
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'})) { |
|
return; |
|
} |
|
my %records=&Apache::lonnet::dump('nohist_email', |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'}, |
|
'%255b'.$user.'%253a'.$domain.'%255d'); |
|
my $result=''; |
|
foreach (sort(keys(%records))) { |
|
my %content=&unpackagemsg($records{$_}); |
|
next if ($content{'senderdomain'} eq ''); |
|
next if ($content{'subject'} !~ /^Record/); |
|
# &Apache::lonfeedback::newline_to_br(\$content{'message'}); |
|
$result.='Recorded by '. |
|
$content{'sendername'}.'@'.$content{'senderdomain'}."\n"; |
|
$result.= |
|
&Apache::lontexconvert::msgtexconverted($content{'message'})."\n"; |
|
} |
|
return $result; |
|
} |
|
|
|
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'})) { |
|
return; |
|
} |
|
my %records=&Apache::lonnet::dump('nohist_email', |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'}, |
|
'%255b'.$user.'%253a'.$domain.'%255d'); |
|
my $result=''; |
|
foreach (sort keys %records) { |
|
my %content=&unpackagemsg($records{$_}); |
|
next if ($content{'senderdomain'} eq ''); |
|
&Apache::lonfeedback::newline_to_br(\$content{'message'}); |
|
if ($content{'subject'}=~/^Record/) { |
|
$result.='<h3>'.&mt('Record').'</h3>'; |
|
} elsif ($content{'subject'}=~/^Broadcast/) { |
|
$result .='<h3>'.&mt('Broadcast Message').'</h3>'; |
|
} else { |
|
$result.='<h3>'.&mt('Critical Message').'</h3>'; |
|
%content=&unpackagemsg($content{'message'}); |
|
$content{'message'}= |
|
'<b>'.&mt('Subject').': '.$content{'subject'}.'</b><br />'. |
|
$content{'message'}; |
|
} |
|
$result.=&mt('By').': <b>'. |
|
&Apache::loncommon::aboutmewrapper( |
|
&Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('. |
|
$content{'sendername'}.'@'. |
|
$content{'senderdomain'}.') '.$content{'time'}. |
|
'<br /><pre>'. |
|
&Apache::lontexconvert::msgtexconverted($content{'message'}). |
|
'</pre>'; |
|
} |
|
# Check to see if there were any messages. |
|
if ($result eq '') { |
|
if ($target ne 'tex') { |
|
$r->print("<p><b>".&mt("No notes, face-to-face discussion records, critical messages, or broadcast messages in this course.")."</b></p>"); |
|
} else { |
|
$r->print('\textbf{'.&mt("No notes, face-to-face discussion records, critical messages or broadcast messages in this course.").'}\\\\'); |
|
} |
|
} else { |
|
$r->print($result); |
|
} |
|
} |
|
|
|
# ---------------------------------------------------------------- Face to face |
|
|
|
sub facetoface { |
|
my ($r,$stage)=@_; |
|
unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { |
|
return; |
|
} |
|
&printheader($r, |
|
'/adm/email?recordftf=query', |
|
"User Notes, Face-to-Face, Critical Messages, Broadcast Messages"); |
|
# from query string |
|
|
|
if ($env{'form.recname'}) { $env{'form.recuname'}=$env{'form.recname'}; } |
|
if ($env{'form.recdom'}) { $env{'form.recdomain'}=$env{'form.recdom'}; } |
|
|
|
my $defdom=$env{'user.domain'}; |
|
# already filled in |
|
if ($env{'form.recdomain'}) { $defdom=$env{'form.recdomain'}; } |
|
# generate output |
|
my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain'); |
|
my $stdbrws = &Apache::loncommon::selectstudent_link |
|
('stdselect','recuname','recdomain'); |
|
my %lt=&Apache::lonlocal::texthash('user' => 'Username', |
|
'dom' => 'Domain', |
|
'head' => 'User Notes, Records of Face-To-Face Discussions, Critical Messages, and Broadcast Messages in Course', |
|
'subm' => 'Retrieve discussion and message records', |
|
'newr' => 'New Record (record is visible to course faculty and staff)', |
|
'post' => 'Post this Record'); |
|
$r->print(<<"ENDTREC"); |
|
<h3>$lt{'head'}</h3> |
|
<form method="post" action="/adm/email" name="stdselect"> |
|
<input type="hidden" name="recordftf" value="retrieve" /> |
|
<table> |
|
<tr><td>$lt{'user'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recuname'}" /></td> |
|
<td rowspan="2"> |
|
$stdbrws |
|
<input type="submit" value="$lt{'subm'}" /></td> |
|
</tr> |
|
<tr><td>$lt{'dom'}:</td> |
|
<td>$domform</td></tr> |
|
</table> |
|
</form> |
|
ENDTREC |
|
if (($stage ne 'query') && |
|
($env{'form.recdomain'}) && ($env{'form.recuname'})) { |
|
chomp($env{'form.newrecord'}); |
|
if ($env{'form.newrecord'}) { |
|
&user_normal_msg_raw( |
|
$env{'course.'.$env{'request.course.id'}.'.num'}, |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
&mt('Record'). |
|
' ['.$env{'form.recuname'}.':'.$env{'form.recdomain'}.']', |
|
$env{'form.newrecord'}); |
|
} |
|
$r->print('<h3>'.&Apache::loncommon::plainname($env{'form.recuname'}, |
|
$env{'form.recdomain'}).'</h3>'); |
|
&disfacetoface($r,$env{'form.recuname'},$env{'form.recdomain'}); |
|
$r->print(<<ENDRHEAD); |
|
<form method="post" action="/adm/email"> |
|
<input name="recdomain" value="$env{'form.recdomain'}" type="hidden" /> |
|
<input name="recuname" value="$env{'form.recuname'}" type="hidden" /> |
|
ENDRHEAD |
|
$r->print(<<ENDBFORM); |
|
<hr />$lt{'newr'}<br /> |
|
<textarea name="newrecord" cols="80" rows="10" wrap="hard"></textarea> |
|
<br /> |
|
<input type="hidden" name="recordftf" value="post" /> |
|
<input type="submit" value="$lt{'post'}" /> |
|
</form> |
|
ENDBFORM |
|
} |
|
} |
|
|
|
# ----------------------------------------------------------- Blocking during exams |
|
|
|
sub examblock { |
|
my ($r,$action) = @_; |
|
unless ($env{'request.course.id'}) { return;} |
|
unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { $r->print('Not allowed'); } |
|
my %lt=&Apache::lonlocal::texthash( |
|
'comb' => 'Communication Blocking', |
|
'cbds' => 'Communication blocking during scheduled exams', |
|
'desc' => 'You can use communication blocking to prevent students enrolled in this course from displaying LON-CAPA messages sent by other students during an online exam. As blocking of communication could potentially interrupt legitimate communication between students who are also both enrolled in a different LON-CAPA course, please be careful that you select the correct start and end times for your scheduled exam when setting or modifying these parameters.', |
|
'mecb' => 'Modify existing communication blocking periods', |
|
'ncbc' => 'No communication blocks currently stored' |
|
); |
|
|
|
my %ltext = &Apache::lonlocal::texthash( |
|
'dura' => 'Duration', |
|
'setb' => 'Set by', |
|
'even' => 'Event', |
|
'actn' => 'Action', |
|
'star' => 'Start', |
|
'endd' => 'End' |
|
); |
|
|
|
&printheader($r,'/adm/email?block=display',$lt{'comb'}); |
|
$r->print('<h3>'.$lt{'cbds'}.'</h3>'); |
|
|
|
if ($action eq 'store') { |
|
&blockstore($r); |
|
} |
|
|
|
$r->print($lt{'desc'}.'<br /><br /> |
|
<form name="blockform" method="post" action="/adm/email?block=store"> |
|
'); |
|
|
|
$r->print('<h4>'.$lt{'mecb'}.'</h4>'); |
|
my %records = (); |
|
my $blockcount = 0; |
|
my $parmcount = 0; |
|
&get_blockdates(\%records,\$blockcount); |
|
if ($blockcount > 0) { |
|
$parmcount = &display_blocker_status($r,\%records,\%ltext); |
|
} else { |
|
$r->print($lt{'ncbc'}.'<br /><br />'); |
|
} |
|
&display_addblocker_table($r,$parmcount,\%ltext); |
|
my $endbody=&Apache::loncommon::endbodytag(); |
|
$r->print(<<"END"); |
|
<br /> |
|
<input type="hidden" name="blocktotal" value="$blockcount" /> |
|
<input type ="submit" value="Save Changes" /> |
|
</form> |
|
$endbody |
|
</html> |
|
END |
|
return; |
|
} |
|
|
|
sub blockstore { |
|
my $r = shift; |
|
my %lt=&Apache::lonlocal::texthash( |
|
'tfcm' => 'The following changes were made', |
|
'cbps' => 'communication blocking period(s)', |
|
'werm' => 'was/were removed', |
|
'wemo' => 'was/were modified', |
|
'wead' => 'was/were added', |
|
'ncwm' => 'No changes were made.' |
|
); |
|
my %adds = (); |
|
my %removals = (); |
|
my %cancels = (); |
|
my $modtotal = 0; |
|
my $canceltotal = 0; |
|
my $addtotal = 0; |
|
my %blocking = (); |
|
$r->print('<h3>'.$lt{'head'}.'</h3>'); |
|
foreach (keys %env) { |
|
if ($_ =~ m/^form\.modify_(\w+)$/) { |
|
$adds{$1} = $1; |
|
$removals{$1} = $1; |
|
$modtotal ++; |
|
} elsif ($_ =~ m/^form\.cancel_(\d+)$/) { |
|
$cancels{$1} = $1; |
|
unless ( defined($removals{$1}) ) { |
|
$removals{$1} = $1; |
|
$canceltotal ++; |
|
} |
|
} elsif ($_ =~ m/^form\.add_(\d+)$/) { |
|
$adds{$1} = $1; |
|
$addtotal ++; |
|
} |
|
} |
|
|
|
foreach (keys %removals) { |
|
my $hashkey = $env{'form.key_'.$_}; |
|
&Apache::lonnet::del('comm_block',["$hashkey"], |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'} |
|
); |
|
} |
|
foreach (keys %adds) { |
|
unless ( defined($cancels{$_}) ) { |
|
my ($newstart,$newend) = &get_dates_from_form($_); |
|
my $newkey = $newstart.'____'.$newend; |
|
$blocking{$newkey} = $env{'user.name'}.'@'.$env{'user.domain'}.':'.$env{'form.title_'.$_}; |
|
} |
|
} |
|
if ($addtotal + $modtotal > 0) { |
|
&Apache::lonnet::put('comm_block',\%blocking, |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'} |
|
); |
|
} |
|
my $chgestotal = $canceltotal + $modtotal + $addtotal; |
|
if ($chgestotal > 0) { |
|
$r->print($lt{'tfcm'}.'<ul>'); |
|
if ($canceltotal > 0) { |
|
$r->print('<li>'.$canceltotal.' '.$lt{'cbps'},' '.$lt{'werm'}.'</li>'); |
|
} |
|
if ($modtotal > 0) { |
|
$r->print('<li>'.$modtotal.' '.$lt{'cbps'},' '.$lt{'wemo'}.'</li>'); |
|
} |
|
if ($addtotal > 0) { |
|
$r->print('<li>'.$addtotal.' '.$lt{'cbps'},' '.$lt{'wead'}.'</li>'); |
|
} |
|
$r->print('</ul>'); |
|
} else { |
|
$r->print($lt{'ncwm'}); |
|
} |
|
$r->print('<br />'); |
|
return; |
|
} |
|
|
|
sub get_dates_from_form { |
|
my $item = shift; |
|
my $startdate = &Apache::lonhtmlcommon::get_date_from_form('startdate_'.$item); |
|
my $enddate = &Apache::lonhtmlcommon::get_date_from_form('enddate_'.$item); |
|
return ($startdate,$enddate); |
|
} |
|
|
|
sub get_blockdates { |
|
my ($records,$blockcount) = @_; |
|
$$blockcount = 0; |
|
%{$records} = &Apache::lonnet::dump('comm_block', |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
$env{'course.'.$env{'request.course.id'}.'.num'} |
|
); |
|
$$blockcount = keys %{$records}; |
|
|
|
foreach (keys %{$records}) { |
|
if ($_ eq 'error: 2 tie(GDBM) Failed while attempting dump') { |
|
$$blockcount = 0; |
|
last; |
|
} |
|
} |
|
} |
|
|
|
sub display_blocker_status { |
|
my ($r,$records,$ltext) = @_; |
|
my $parmcount = 0; |
|
my @bgcols = ("#eeeeee","#dddddd"); |
|
my $function = &Apache::loncommon::get_users_function(); |
|
my $color = &Apache::loncommon::designparm($function.'.tabbg', |
|
$env{'user.domain'}); |
|
my %lt = &Apache::lonlocal::texthash( |
|
'modi' => 'Modify', |
|
'canc' => 'Cancel', |
|
); |
|
$r->print(<<"END"); |
|
<table border="0" cellpadding="0" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table width="100%" border="0" cellpadding="1" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF"> |
|
<tr bgcolor="$color"> |
|
<td><b>$$ltext{'dura'}</b></td> |
|
<td><b>$$ltext{'setb'}</b></td> |
|
<td><b>$$ltext{'even'}</b></td> |
|
<td><b>$$ltext{'actn'}?</b></td> |
|
</tr> |
|
END |
|
foreach (sort keys %{$records}) { |
|
my $iter = $parmcount%2; |
|
my $onchange = 'onFocus="javascript:window.document.forms['. |
|
"'blockform'].elements['modify_".$parmcount."'].". |
|
'checked=true;"'; |
|
my ($start,$end) = split/____/,$_; |
|
my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange); |
|
my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange); |
|
my ($setter,$title) = split/:/,$$records{$_}; |
|
my ($setuname,$setudom) = split/@/,$setter; |
|
my $settername = &Apache::loncommon::plainname($setuname,$setudom); |
|
$r->print(<<"END"); |
|
<tr bgcolor="$bgcols[$iter]"> |
|
<td>$$ltext{'star'}: $startform<br/>$$ltext{'endd'}: $endform</td> |
|
<td>$settername</td> |
|
<td><input type="text" name="title_$parmcount" size="15" value="$title" /><input type="hidden" name="key_$parmcount" value="$_" /></td> |
|
<td><label>$lt{'modi'}? <input type="checkbox" name="modify_$parmcount" /></label><br /><label>$lt{'canc'}? <input type="checkbox" name="cancel_$parmcount" /></label> |
|
</tr> |
|
END |
|
$parmcount ++; |
|
} |
|
$r->print(<<"END"); |
|
</table> |
|
</td> |
|
</tr> |
|
</table> |
|
</td> |
|
</tr> |
|
</table> |
|
<br /> |
|
<br /> |
|
END |
|
return $parmcount; |
|
} |
|
|
|
sub display_addblocker_table { |
|
my ($r,$parmcount,$ltext) = @_; |
|
my $start = time; |
|
my $end = $start + (60 * 60 * 2); #Default is an exam of 2 hours duration. |
|
my $onchange = 'onFocus="javascript:window.document.forms['. |
|
"'blockform'].elements['add_".$parmcount."'].". |
|
'checked=true;"'; |
|
my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange); |
|
my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange); |
|
my $function = &Apache::loncommon::get_users_function(); |
|
my $color = &Apache::loncommon::designparm($function.'.tabbg', |
|
$env{'user.domain'}); |
|
my %lt = &Apache::lonlocal::texthash( |
|
'addb' => 'Add block', |
|
'exam' => 'e.g., Exam 1', |
|
'addn' => 'Add new communication blocking periods' |
|
); |
|
$r->print(<<"END"); |
|
<h4>$lt{'addn'}</h4> |
|
<table border="0" cellpadding="0" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table width="100%" border="0" cellpadding="1" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF"> |
|
<tr bgcolor="#CCCCFF"> |
|
<td><b>$$ltext{'dura'}</b></td> |
|
<td><b>$$ltext{'even'} $lt{'exam'}</b></td> |
|
<td><b>$$ltext{'actn'}?</b></td> |
|
</tr> |
|
<tr bgcolor="#eeeeee"> |
|
<td>$$ltext{'star'}: $startform<br />$$ltext{'endd'}: $endform</td> |
|
<td><input type="text" name="title_$parmcount" size="15" value="" /></td> |
|
<td><label>$lt{'addb'}? <input type="checkbox" name="add_$parmcount" value="1" /></label></td> |
|
</tr> |
|
</table> |
|
</td> |
|
</tr> |
|
</table> |
|
</td> |
|
</tr> |
|
</table> |
|
END |
|
return; |
|
} |
|
|
|
sub blockcheck { |
|
my ($setters,$startblock,$endblock) = @_; |
|
# Retrieve active student roles and active course coordinator/instructor roles |
|
my @livecses = (); |
|
my @staffcses = (); |
|
$$startblock = 0; |
|
$$endblock = 0; |
|
foreach (keys %env) { |
|
if ($_ =~ m-^user\.role\.(st|cc|in)\./(.+)$-) { |
|
my $role = $1; |
|
my $cse = $2; |
|
$cse =~ s|/|_|; |
|
if ($env{$_} =~ m/^(\d*)\.(\d*)$/) { |
|
unless (($2 > 0 && $2 < time) || ($1 > time)) { |
|
if ($role eq 'st') { |
|
push @livecses, $cse; |
|
} else { |
|
unless (grep/^$cse$/,@staffcses) { |
|
push @staffcses, $cse; |
|
} |
|
} |
|
} |
} |
} |
} |
} elsif ($_ =~ m-user\.role\.cr/(\w+)/(\w+)/([^/]+)\./(.+)$- ) { |
|
my $rolepriv = $env{'user.role..rolesdef_'.$3}; |
|
} |
|
} |
|
# Retrieve blocking times and identity of blocker for active courses for students. |
|
if (@livecses > 0) { |
|
foreach my $cse (@livecses) { |
|
my ($cdom,$crs) = split/_/,$cse; |
|
if ( (grep/^$cse$/,@staffcses) && ($env{'request.role'} !~ m-^st\./$cdom/$crs$-) ) { |
|
next; |
|
} else { |
|
%{$$setters{$cse}} = (); |
|
@{$$setters{$cse}{'staff'}} = (); |
|
@{$$setters{$cse}{'times'}} = (); |
|
my %records = &Apache::lonnet::dump('comm_block',$cdom,$crs); |
|
foreach (keys %records) { |
|
if ($_ =~ m/^(\d+)____(\d+)$/) { |
|
if ($1 <= time && $2 >= time) { |
|
my ($staff,$title) = split/:/,$records{$_}; |
|
push @{$$setters{$cse}{'staff'}}, $staff; |
|
push @{$$setters{$cse}{'times'}}, $_; |
|
if ( ($$startblock == 0) || ($$startblock > $1) ) { |
|
$$startblock = $1; |
|
} |
|
if ( ($$endblock == 0) || ($$endblock < $2) ) { |
|
$$endblock = $2; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
|
|
sub build_block_table { |
|
my ($r,$startblock,$endblock,$setters) = @_; |
|
my $function = &Apache::loncommon::get_users_function(); |
|
my $color = &Apache::loncommon::designparm($function.'.tabbg', |
|
$env{'user.domain'}); |
|
my %lt = &Apache::lonlocal::texthash( |
|
'cacb' => 'Currently active communication blocks', |
|
'cour' => 'Course', |
|
'dura' => 'Duration', |
|
'blse' => 'Block set by' |
|
); |
|
$r->print(<<"END"); |
|
<br /<br />$lt{'cacb'}:<br /><br /> |
|
<table border="0" cellpadding="0" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table width="100%" border="0" cellpadding="1" cellspacing="0"> |
|
<tr> |
|
<td width="100%" bgcolor="#000000"> |
|
<table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF"> |
|
<tr bgcolor="$color"> |
|
<td><b>$lt{'cour'}</b></td> |
|
<td><b>$lt{'dura'}</b></td> |
|
<td><b>$lt{'blse'}</b></td> |
|
</tr> |
|
END |
|
foreach (keys %{$setters}) { |
|
my %courseinfo=&Apache::lonnet::coursedescription($_); |
|
for (my $i=0; $i<@{$$setters{$_}{staff}}; $i++) { |
|
my ($uname,$udom) = split/\@/,$$setters{$_}{staff}[$i]; |
|
my $fullname = &Apache::loncommon::plainname($uname,$udom); |
|
my ($openblock,$closeblock) = split/____/,$$setters{$_}{times}[$i]; |
|
$openblock = &Apache::lonlocal::locallocaltime($openblock); |
|
$closeblock= &Apache::lonlocal::locallocaltime($closeblock); |
|
$r->print('<tr><td>'.$courseinfo{'description'}.'</td>'. |
|
'<td>'.$openblock.' to '.$closeblock.'</td>'. |
|
'<td>'.$fullname.' ('.$uname.'@'.$udom. |
|
')</td></tr>'); |
|
} |
} |
} |
|
$r->print('</table></td></tr></table></td></tr></table>'); |
|
} |
|
|
|
# ----------------------------------------------------------- Display a message |
|
|
|
sub displaymessage { |
|
my ($r,$msgid,$folder)=@_; |
|
my $suffix=&foldersuffix($folder); |
|
my %blocked = (); |
|
my %setters = (); |
|
my $startblock = 0; |
|
my $endblock = 0; |
|
my $numblocked = 0; |
|
# info to generate "next" and "previous" buttons and check if message is blocked |
|
&blockcheck(\%setters,\$startblock,\$endblock); |
|
my @messages=&sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder); |
|
if ( $blocked{$msgid} eq 'ON' ) { |
|
&printheader($r,'/adm/email',&mt('Display a Message')); |
|
$r->print(&mt('You attempted to display a message that is currently blocked because you are enrolled in one or more courses for which there is an ongoing online exam.')); |
|
&build_block_table($r,$startblock,$endblock,\%setters); |
|
return; |
|
} |
|
&statuschange($msgid,'read',$folder); |
|
my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]); |
|
my %content=&unpackagemsg($message{$msgid}); |
|
|
|
my $counter=0; |
|
$r->print('<pre>'); |
|
my $escmsgid=&Apache::lonnet::escape($msgid); |
|
foreach (@messages) { |
|
if ($_->[5] eq $escmsgid){ |
|
last; |
|
} |
|
$counter++; |
|
} |
|
$r->print('</pre>'); |
|
my $number_of_messages = scalar(@messages); #subtract 1 for last index |
|
# start output |
|
&printheader($r,'/adm/email?display='.&Apache::lonnet::escape($msgid),'Display a Message','',$content{'baseurl'}); |
|
my %courseinfo=&Apache::lonnet::coursedescription($content{'courseid'}); |
|
# Functions |
|
$r->print('<table border="2" width="100%"><tr bgcolor="#FFFFAA"><td>'.&mt('Functions').':</td>'. |
|
'<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid).$sqs. |
|
'"><b>'.&mt('Reply').'</b></a></td>'. |
|
'<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid).$sqs. |
|
'"><b>'.&mt('Forward').'</b></a></td>'. |
|
'<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid).$sqs. |
|
'"><b>'.&mt('Mark Unread').'</b></a></td>'. |
|
'<td><a href="/adm/email?markdel='.&Apache::lonnet::escape($msgid).$sqs. |
|
'"><b>'.&mt('Delete').'</b></a></td>'. |
|
'<td><a href="/adm/email?'.$sqs. |
|
($env{'form.dismode'} eq 'new'?'&folder=new':''). |
|
'"><b>'.&mt('Back to Folder Display').'</b></a></td>'); |
|
if ($counter > 0){ |
|
$r->print('<td><a href="/adm/email?display='.$messages[$counter-1]->[5].$sqs. |
|
'"><b>'.&mt('Previous').'</b></a></td>'); |
|
} |
|
if ($counter < $number_of_messages - 1){ |
|
$r->print('<td><a href="/adm/email?display='.$messages[$counter+1]->[5].$sqs. |
|
'"><b>'.&mt('Next').'</b></a></td>'); |
|
} |
|
$r->print('</tr></table>'); |
|
if ($env{'user.adv'}) { |
|
$r->print('<table border="2" width="100%"><tr bgcolor="#FFAAAA"><td>'.&mt('Currently available actions (will open extra window)').':</td>'); |
|
my $symb=&Apache::lonnet::symbread($content{'baseurl'}); |
|
if (&Apache::lonnet::allowed('vgr',$env{'request.course.id'})) { |
|
$r->print('<td><b>'.&Apache::loncommon::track_student_link(&mt('View recent activity'),$content{'sendername'},$content{'senderdomain'},'check').'</b></td>'); |
|
} |
|
if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) && $symb) { |
|
$r->print('<td><b>'.&Apache::loncommon::pprmlink(&mt('Set/Change parameters'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>'); |
|
} |
|
if (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}) && $symb) { |
|
$r->print('<td><b>'.&Apache::loncommon::pgrdlink(&mt('Set/Change grades'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>'); |
|
} |
|
$r->print('</tr></table>'); |
|
} |
|
$r->print('<br /><b>'.&mt('Subject').':</b> '.$content{'subject'}. |
|
($folder ne 'sent'?'<br /><b>'.&mt('From').':</b> '. |
|
&Apache::loncommon::aboutmewrapper( |
|
&Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}), |
|
$content{'sendername'},$content{'senderdomain'}).' ('. |
|
$content{'sendername'}.' at '. |
|
$content{'senderdomain'}.') ':'<br /><b>'.&mt('To').':</b> '. |
|
&Apache::loncommon::aboutmewrapper( |
|
&Apache::loncommon::plainname($content{'recuser'},$content{'recdomain'}), |
|
$content{'recuser'},$content{'recdomain'}).' ('. |
|
$content{'recuser'}.' at '. |
|
$content{'recdomain'}.') '). |
|
($content{'courseid'}?'<br /><b>'.&mt('Course').':</b> '.$courseinfo{'description'}. |
|
($content{'coursesec'}?' ('.&mt('Group/Section').': '.$content{'coursesec'}.')':''):''). |
|
'<br /><b>'.&mt('Time').':</b> '.$content{'time'}. |
|
($content{'baseurl'}?'<br /><b>'.&mt('Refers to').':</b> <a href="'.$content{'baseurl'}.'">'. |
|
$content{'baseurl'}.' ('.&Apache::lonnet::gettitle($content{'baseurl'}).')</a>':''). |
|
'<p><pre>'. |
|
&Apache::lontexconvert::msgtexconverted($content{'message'},1). |
|
'</pre><hr />'.&displayresource(%content).'</p>'); |
|
return; |
|
} |
|
|
|
# =========================================================== Show the citation |
|
|
|
sub displayresource { |
|
my %content=@_; |
|
# |
|
# If the recipient is in the same course that the message was sent from and |
|
# has sufficient privileges, show "all details," else show citation |
|
# |
|
if (($env{'request.course.id'} eq $content{'courseid'}) |
|
&& (&Apache::lonnet::allowed('vgr',$content{'courseid'}))) { |
|
my $symb=&Apache::lonnet::symbread($content{'baseurl'}); |
|
# Could not get a symb, give up |
|
unless ($symb) { return $content{'citation'}; } |
|
# Have a symb, can render |
|
return '<h2>'.&mt('Current attempts of student (if applicable)').'</h2>'. |
|
&Apache::loncommon::get_previous_attempt($symb, |
|
$content{'sendername'}, |
|
$content{'senderdomain'}, |
|
$content{'courseid'}). |
|
'<hr /><h2>'.&mt('Current screen output (if applicable)').'</h2>'. |
|
&Apache::loncommon::get_student_view($symb, |
|
$content{'sendername'}, |
|
$content{'senderdomain'}, |
|
$content{'courseid'}). |
|
'<h2>'.&mt('Correct Answer(s) (if applicable)').'</h2>'. |
|
&Apache::loncommon::get_student_answers($symb, |
|
$content{'sendername'}, |
|
$content{'senderdomain'}, |
|
$content{'courseid'}); |
|
} else { |
} else { |
return $content{'citation'}; |
return $rec; |
} |
} |
|
return ''; |
} |
} |
|
|
# ================================================================== The Header |
=pod |
|
|
sub header { |
|
my ($r,$title,$baseurl)=@_; |
|
$r->print(&Apache::lonxml::xmlbegin(). |
|
'<head>'.&Apache::lonxml::fontsettings(). |
|
'<title>Communication and Messages</title>'. |
|
&Apache::lonhtmlcommon::htmlareaheaders()); |
|
if ($baseurl) { |
|
$r->print("<base href=\"http://$ENV{'SERVER_NAME'}/$baseurl\" />"); |
|
} |
|
$r->print(&Apache::loncommon::studentbrowser_javascript().'</head>'. |
|
&Apache::loncommon::bodytag('Communication and Messages')); |
|
$r->print(&Apache::lonhtmlcommon::breadcrumbs |
|
(undef,($title?$title:'Communication and Messages'))); |
|
|
|
} |
=over 4 |
|
|
# ---------------------------------------------------------------- Print header |
|
|
|
sub printheader { |
|
my ($r,$url,$desc,$title,$baseurl)=@_; |
|
&Apache::lonhtmlcommon::add_breadcrumb |
|
({href=>$url, |
|
text=>$desc}); |
|
&header($r,$title,$baseurl); |
|
} |
|
|
|
# ------------------------------------------------------------ Store the comment |
|
|
|
sub storecomment { |
|
my ($r)=@_; |
|
my $msgtxt=&Apache::lonfeedback::clear_out_html($env{'form.message'}); |
|
my $cleanmsgtxt=''; |
|
foreach (split(/[\n\r]/,$msgtxt)) { |
|
unless ($_=~/^\s*(\>|\>\;)/) { |
|
$cleanmsgtxt.=$_."\n"; |
|
} |
|
} |
|
my $key=&Apache::lonnet::escape($env{'form.baseurl'}).'___'.time; |
|
&Apache::lonnet::put('nohist_stored_comments',{ $key => $cleanmsgtxt }); |
|
} |
|
|
|
sub storedcommentlisting { |
|
my ($r)=@_; |
|
my %msgs=&Apache::lonnet::dump('nohist_stored_comments',undef,undef, |
|
'^'.&Apache::lonnet::escape(&Apache::lonnet::escape($env{'form.showcommentbaseurl'}))); |
|
$r->print(&Apache::lonxml::xmlbegin().'<head>'. |
|
&Apache::lonxml::fontsettings().'</head><body>'); |
|
if ((keys %msgs)[0]=~/^error\:/) { |
|
$r->print(&mt('No stored comments yet.')); |
|
} else { |
|
my $found=0; |
|
foreach (sort keys %msgs) { |
|
$r->print("\n".$msgs{$_}."<hr />"); |
|
$found=1; |
|
} |
|
unless ($found) { |
|
$r->print(&mt('No stored comments yet for this resource.')); |
|
} |
|
} |
|
} |
|
|
|
# ---------------------------------------------------------------- Send an email |
|
|
|
sub sendoffmail { |
=item * |
my ($r,$folder)=@_; |
|
my $suffix=&foldersuffix($folder); |
|
my $sendstatus=''; |
|
if ($env{'form.send'}) { |
|
&printheader($r,'','Messages being sent.'); |
|
$r->rflush(); |
|
my %content=(); |
|
undef %content; |
|
if ($env{'form.forwid'}) { |
|
my $msgid=$env{'form.forwid'}; |
|
my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]); |
|
%content=&unpackagemsg($message{$msgid},1); |
|
&statuschange($msgid,'forwarded',$folder); |
|
$env{'form.message'}.="\n\n-- Forwarded message --\n\n". |
|
$content{'message'}; |
|
} |
|
if ($env{'form.replyid'}) { |
|
my $msgid=$env{'form.replyid'}; |
|
my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]); |
|
%content=&unpackagemsg($message{$msgid},1); |
|
&statuschange($msgid,'replied',$folder); |
|
} |
|
my %toaddr=(); |
|
undef %toaddr; |
|
if ($env{'form.sendmode'} eq 'group') { |
|
foreach (keys %env) { |
|
if ($_=~/^form\.send\_to\_\&\&\&[^\&]*\&\&\&\_(.+)$/) { |
|
$toaddr{$1}=''; |
|
} |
|
} |
|
} elsif ($env{'form.sendmode'} eq 'upload') { |
|
foreach (split(/[\n\r\f]+/,$env{'form.upfile'})) { |
|
my ($rec,$txt)=split(/\s*\:\s*/,$_); |
|
if ($txt) { |
|
$rec=~s/\@/\:/; |
|
$toaddr{$rec}.=$txt."\n"; |
|
} |
|
} |
|
} else { |
|
$toaddr{$env{'form.recuname'}.':'.$env{'form.recdomain'}}=''; |
|
} |
|
if ($env{'form.additionalrec'}) { |
|
foreach (split(/\,/,$env{'form.additionalrec'})) { |
|
my ($auname,$audom)=split(/\@/,$_); |
|
$toaddr{$auname.':'.$audom}=''; |
|
} |
|
} |
|
|
|
foreach (keys %toaddr) { |
|
my ($recuname,$recdomain)=split(/\:/,$_); |
|
my $msgtxt; |
|
if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) && |
|
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) { |
|
$msgtxt=&Apache::lonfeedback::clear_out_html($env{'form.message'},1); |
|
} else { |
|
$msgtxt=&Apache::lonfeedback::clear_out_html($env{'form.message'}); |
|
} |
|
if ($toaddr{$_}) { $msgtxt.='<hr />'.$toaddr{$_}; } |
|
my $thismsg; |
|
if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) && |
|
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) { |
|
$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'}); |
|
} else { |
|
$r->print(&mt('Sending').' '.$recuname.'@'.$recdomain.': '); |
|
$thismsg=&user_normal_msg($recuname,$recdomain, |
|
&Apache::lonfeedback::clear_out_html($env{'form.subject'}), |
|
$msgtxt, |
|
$content{'citation'},undef,undef,$env{'form.permanent'}); |
|
if (($env{'request.course.id'}) && ($env{'form.sendmode'} eq 'group')) { |
|
&user_normal_msg_raw( |
|
$env{'course.'.$env{'request.course.id'}.'.num'}, |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
'Broadcast ['.$recuname.':'.$recdomain.']', |
|
$msgtxt); |
|
} |
|
} |
|
$r->print($thismsg.'<br />'); |
|
$sendstatus.=' '.$thismsg; |
|
} |
|
} else { |
|
&printheader($r,'','No messages sent.'); |
|
} |
|
if ($sendstatus=~/^(\s*(?:ok|con_delayed)\s*)*$/) { |
|
$r->print('<br /><font color="green">'.&mt('Completed.').'</font>'); |
|
if ($env{'form.displayedcrit'}) { |
|
&discrit($r); |
|
} else { |
|
&Apache::loncommunicate::menu($r); |
|
} |
|
} else { |
|
$r->print( |
|
'<h2><font color="red">'.&mt('Could not deliver message').'</font></h2>'. |
|
&mt('Please use the browser "Back" button and correct the recipient addresses') |
|
); |
|
} |
|
} |
|
|
|
# ===================================================================== Handler |
decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag); |
|
|
sub handler { |
|
my $r=shift; |
|
|
|
# ----------------------------------------------------------- Set document type |
|
|
|
&Apache::loncommon::content_type($r,'text/html'); |
|
$r->send_http_header; |
|
|
|
return OK if $r->header_only; |
|
|
|
# --------------------------- Get query string for limited number of parameters |
|
&Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}, |
|
['display','replyto','forward','markread','markdel','markunread', |
|
'sendreply','compose','sendmail','critical','recname','recdom', |
|
'recordftf','sortedby','block','folder','startdis','interdis', |
|
'showcommentbaseurl','dismode']); |
|
$sqs='&sortedby='.$env{'form.sortedby'}; |
|
|
|
# ------------------------------------------------------ They checked for email |
|
unless ($env{'form.block'}) { |
|
&Apache::lonnet::put('email_status',{'recnewemail'=>0}); |
|
} |
|
|
|
# ----------------------------------------------------------------- Breadcrumbs |
|
|
|
&Apache::lonhtmlcommon::clear_breadcrumbs(); |
|
&Apache::lonhtmlcommon::add_breadcrumb |
|
({href=>"/adm/communicate", |
|
text=>"Communication/Messages", |
|
faq=>12,bug=>'Communication Tools',}); |
|
|
|
# ------------------------------------------------------------------ Get Folder |
|
|
|
my $folder=$env{'form.folder'}; |
|
unless ($folder) { |
|
$folder=''; |
|
} else { |
|
$sqs.='&folder='.&Apache::lonnet::escape($folder); |
|
} |
|
# ------------------------------------------------------------ Get Display Mode |
|
|
|
my $dismode=$env{'form.dismode'}; |
Arguments |
unless ($dismode) { |
$feedurl - /res/ url of resource (only need if $author is true) |
$dismode=''; |
$author,$question,$course,$policy - all true/false parameters |
} else { |
if true will attempt to find the addresses of user that should receive |
$sqs.='&dismode='.&Apache::lonnet::escape($dismode); |
this type of feedback (author - feedback to author of resource $feedurl, |
} |
$question 'Resource Content Questions', $course 'Course Content Question', |
|
$policy 'Course Policy') |
|
(Additionally it also checks $env for whether the corresponding form.<name> |
|
element exists, for ease of use in a html response context) |
|
|
|
$defaultflag - (internal should be left blank) if true gather addresses |
|
that aren't for a section even if I have a section |
|
(used for reccursion internally, first we look for |
|
addresses for our specific section then we recurse |
|
and look for non section addresses) |
|
|
|
Returns |
|
$typestyle - string of html text, describing what addresses were found |
|
%to - a hash, which keys are addresses of users to send messages to |
|
the keys will look like name:domain |
|
|
# --------------------------------------------------------------------- Display |
=cut |
|
|
$startdis=$env{'form.startdis'}; |
sub decide_receiver { |
$startdis--; |
my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; |
unless ($startdis) { $startdis=0; } |
&Apache::lonenc::check_decrypt(\$feedurl); |
|
my $typestyle=''; |
$interdis=$env{'form.interdis'}; |
my %to=(); |
unless ($interdis) { $interdis=20; } |
if ($env{'form.discuss'} eq 'author' ||$author) { |
$sqs.='&interdis='.$interdis; |
$typestyle.='Submitting as Author Feedback<br />'; |
|
$feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/}; |
if ($env{'form.firstview'}) { |
$to{$2.':'.$1}=1; |
$startdis=0; |
} |
} |
my $cid = $env{'request.course.id'}; |
if ($env{'form.lastview'}) { |
if ($env{'form.discuss'} eq 'question' ||$question) { |
$startdis=-1; |
$typestyle.=&mt('Submitting as Question').'<br />'; |
} |
foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) { |
if ($env{'form.prevview'}) { |
my $rec=&secapply($item,$defaultflag); |
$startdis--; |
if ($rec) { $to{$rec}=1; } |
} |
} |
if ($env{'form.nextview'}) { |
} |
$startdis++; |
if ($env{'form.discuss'} eq 'course' ||$course) { |
} |
$typestyle.=&mt('Submitting as Comment').'<br />'; |
my $postedstartdis=$startdis+1; |
foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) { |
$sqs.='&startdis='.$postedstartdis; |
my $rec=&secapply($item,$defaultflag); |
|
if ($rec) { $to{$rec}=1; } |
# --------------------------------------------------------------- Render Output |
} |
|
} |
if ($env{'form.display'}) { |
if ($env{'form.discuss'} eq 'policy' ||$policy) { |
&displaymessage($r,$env{'form.display'},$folder); |
$typestyle.=&mt('Submitting as Policy Feedback').'<br />'; |
} elsif ($env{'form.replyto'}) { |
foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) { |
&compout($r,'',$env{'form.replyto'},undef,undef,$folder,$dismode); |
my $rec=&secapply($item,$defaultflag); |
} elsif ($env{'form.confirm'}) { |
if ($rec) { $to{$rec}=1; } |
&printheader($r,'','Confirmed Receipt'); |
} |
foreach (keys %env) { |
} |
if ($_=~/^form\.rec\_(.*)$/) { |
if ((scalar(%to) eq '0') && (!$defaultflag)) { |
$r->print('<b>'.&mt('Confirming Receipt').':</b> '. |
($typestyle,%to)= |
&user_crit_received($1).'<br>'); |
&decide_receiver($feedurl,$author,$question,$course,$policy,1); |
} |
|
if ($_=~/^form\.reprec\_(.*)$/) { |
|
my $msgid=$1; |
|
$r->print('<b>'.&mt('Confirming Receipt').':</b> '. |
|
&user_crit_received($msgid).'<br>'); |
|
&compout($r,'','','',$msgid); |
|
} |
|
} |
|
&discrit($r); |
|
} elsif ($env{'form.critical'}) { |
|
&printheader($r,'','Displaying Critical Messages'); |
|
&discrit($r); |
|
} elsif ($env{'form.forward'}) { |
|
&compout($r,$env{'form.forward'},undef,undef,undef,$folder); |
|
} elsif ($env{'form.markdel'}) { |
|
&printheader($r,'','Deleted Message'); |
|
&statuschange($env{'form.markdel'},'deleted',$folder); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,($folder?$folder:$dismode)); |
|
} elsif ($env{'form.markedmove'}) { |
|
my $total=0; |
|
foreach (keys %env) { |
|
if ($_=~/^form\.delmark_(.*)$/) { |
|
&movemsg(&Apache::lonnet::unescape($1),$folder, |
|
$env{'form.movetofolder'}); |
|
$total++; |
|
} |
|
} |
|
&printheader($r,'','Moved Messages'); |
|
$r->print('Moved '.$total.' message(s)<p>'); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,($folder?$folder:$dismode)); |
|
} elsif ($env{'form.markeddel'}) { |
|
my $total=0; |
|
foreach (keys %env) { |
|
if ($_=~/^form\.delmark_(.*)$/) { |
|
&statuschange(&Apache::lonnet::unescape($1),'deleted',$folder); |
|
$total++; |
|
} |
|
} |
|
&printheader($r,'','Deleted Messages'); |
|
$r->print('Deleted '.$total.' message(s)<p>'); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,($folder?$folder:$dismode)); |
|
} elsif ($env{'form.markunread'}) { |
|
&printheader($r,'','Marked Message as Unread'); |
|
&statuschange($env{'form.markunread'},'new'); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,($folder?$folder:$dismode)); |
|
} elsif ($env{'form.compose'}) { |
|
&compout($r,'','',$env{'form.compose'}); |
|
} elsif ($env{'form.recordftf'}) { |
|
&facetoface($r,$env{'form.recordftf'}); |
|
} elsif ($env{'form.block'}) { |
|
&examblock($r,$env{'form.block'}); |
|
} elsif ($env{'form.sendmail'}) { |
|
&sendoffmail($r,$folder); |
|
if ($env{'form.storebasecomment'}) { |
|
&storecomment($r); |
|
} |
|
if (($env{'form.rsspost'}) && ($env{'request.course.id'})) { |
|
&Apache::lonrss::addentry($env{'course.'.$env{'request.course.id'}.'.num'}, |
|
$env{'course.'.$env{'request.course.id'}.'.domain'}, |
|
'Course_Announcements', |
|
$env{'form.subject'}, |
|
$env{'form.message'},'/adm/communicate','public'); |
|
} |
|
&disall($r,($folder?$folder:$dismode)); |
|
} elsif ($env{'form.newfolder'}) { |
|
&printheader($r,'','New Folder'); |
|
&makefolder($env{'form.newfolder'}); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,$env{'form.newfolder'}); |
|
} elsif ($env{'form.showcommentbaseurl'}) { |
|
&storedcommentlisting($r); |
|
} else { |
|
&printheader($r,'','Display All Messages'); |
|
&Apache::loncommunicate::menu($r); |
|
&disall($r,($folder?$folder:$dismode)); |
|
} |
} |
$r->print(&Apache::loncommon::endbodytag().'</html>'); |
return ($typestyle,%to); |
return OK; |
|
} |
} |
# ================================================= Main program, reset counter |
|
|
|
BEGIN { |
|
$msgcount=0; |
|
} |
|
|
|
=pod |
|
|
|
=back |
|
|
|
=cut |
|
|
|
1; |
|
|
|
|
1; |
__END__ |
__END__ |
|
|
|
|
|
|
|
|
|
|
|
|
|
|