--- loncom/interface/lonmsg.pm 2005/07/08 10:39:49 1.152 +++ loncom/interface/lonmsg.pm 2022/01/18 17:33:13 1.248 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.152 2005/07/08 10:39:49 www Exp $ +# $Id: lonmsg.pm,v 1.248 2022/01/18 17:33:13 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -26,7 +26,6 @@ # http://www.lon-capa.org/ # - package Apache::lonmsg; =pod @@ -37,132 +36,271 @@ Apache::lonmsg: supports internal messag =head1 SYNOPSIS -lonmsg provides routines for sending messages, receiving messages, and -a handler to allow users to read, send, and delete messages. +lonmsg provides routines for sending messages. -=head1 OVERVIEW +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. -=head2 Messaging Overview +The routines used to package messages and unpackage messages are not +only used by lonmsg when creating/extracting messages for LON-CAPA's +internal messaging system, but also by lonnotify.pm which is available +for use by Domain Coordinators to broadcast standard e-mail to specified +users in their domain. The XML packaging used in the two cases is very +similar. The differences are the use of $uname and +$udom in stored internal messages, compared +with $email in stored +Domain Coordinator e-mail for the storage of information about +recipients of the message/e-mail. -XLON-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: A message the recipient B -acknowlegde receipt of before they are allowed to continue using the -system, preventing a user from claiming they never got a message - -=item * B: 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: 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: 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. +=head1 SUBROUTINES -=back +=over -Users can ask LON-CAPA to forward messages to conventional e-mail -addresses on their B screen, but generally, LON-CAPA messages -are much more useful than traditional email can be made to be, even -with HTML support. +=pod -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. +=item packagemsg() + +Package + +=item get_course_context() + +=item unpackagemsg() + +Unpack message into a hash + +=item buildmsgid() + +Get info out of msgid + +=item unpackmsgid() + +=item sendemail() + +=item sendnotification() + +Send notification emails + +=item newmail() + +Check for email + +=item author_res_msg() + +Automated message to the author of a resource + +=item * B: Sends message $message to the owner + of the resource with the URI $filename. + +=item retrieve_author_res_msg() + +Retrieve author resource messages + +=item del_url_author_res_msg() + +Delete all author messages related to one URL + +=item clear_author_res_msg() + +Clear out all author messages in URL path + +=item all_url_author_res_msg() + +Return hash with URLs for which there is a resource message + +=item store_instructor_comment() + +Add a comment to the User Notes screen + +=item user_crit_msg_raw() + +Critical message to a user + +=item user_crit_msg() + +New routine that respects "forward" and calls old routine + +=item * B: + Sends a critical message $message to the $user at $domain. If $sendback + is true, a receipt will be sent to the current user when $user receives + 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 + + +=item user_crit_received() + +Critical message received + +=item user_normal_msg_raw() + +Normal communication + +=item user_normal_msg() + +New routine that respects "forward" and calls old routine -=head1 FUNCTIONS +=item * B: + Sends a message to the $user at $domain, with subject $subject and message $message. -=over 4 + 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 + +=item store_sent_mail() + +=item store_recipients() + +=item foldersuffix() + +=item get_user_folders() + +User-defined folders + +=item secapply() + +=item B: + +Arguments + $feedurl - /res/ url of resource (only need if $author is true) + $author,$question,$course,$policy - all true/false parameters + if true will attempt to find the addresses of user that should receive + 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. + 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 + +=back =cut use strict; use Apache::lonnet; -use vars qw($msgcount); +use Apache::loncommon; 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::loncommunicate; +use HTML::Entities; +use Encode; +use LONCAPA qw(:DEFAULT :match); + +{ + my $uniq; + sub get_uniq { + $uniq++; + return $uniq; + } +} -# Querystring component with sorting type -my $sqs; -my $startdis; -my $interdis; -# ===================================================================== Package sub packagemsg { - my ($subject,$message,$citation,$baseurl,$attachmenturl, - $recuser,$recdomain)=@_; + my ($subject,$message,$citation,$baseurl,$attachmenturl,$recuser,$recdomain, + $msgid,$type,$crsmsgid,$symb,$error,$recipid,$senthide,$origmsgid)=@_; $message =&HTML::Entities::encode($message,'<>&"'); $citation=&HTML::Entities::encode($citation,'<>&"'); $subject =&HTML::Entities::encode($subject,'<>&"'); #remove machine specification - $baseurl =~ s|^http://[^/]+/|/|; + $baseurl =~ s|^https?://[^/]+/|/|; $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); #remove machine specification - $attachmenturl =~ s|^http://[^/]+/|/|; + $attachmenturl =~ s|^https?://[^/]+/|/|; $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); - + if ($senthide) { + foreach my $item ($subject,$message) { + if ($item ne '') { + $item = 'Not shown due to IP block'; + } + } + if ($attachmenturl ne '') { + $attachmenturl = ''; + } + if ($citation ne '') { + $citation = ''; + } + if ($msgid ne '') { + $msgid = ''; + } + } + my $course_context = &get_course_context(); my $now=time; - $msgcount++; - my $partsubj=$subject; - $partsubj=&Apache::lonnet::escape($partsubj); - my $msgid=&Apache::lonnet::escape( - $now.':'.$partsubj.':'.$env{'user.name'}.':'. - $env{'user.domain'}.':'.$msgcount.':'. - $env{'request.course.id'}.':'.$$); - my $result=''.$env{'user.name'}.''. + my $ip = &Apache::lonnet::get_requestor_ip(); + my $msgcount = &get_uniq(); + unless(defined($msgid)) { + $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, + $msgcount,$course_context,$symb,$error,$$); + } + my $result = ''.$env{'user.name'}.''. ''.$env{'user.domain'}.''. ''.$subject.''. - ''. - ''.$ENV{'SERVER_NAME'}.''. + ''; + if (defined($crsmsgid)) { + $result.= ''.$course_context.''. + ''.$env{'request.course.sec'}.''. + ''.$msgid.''. + ''.$crsmsgid.''. + ''.$message.''; + return ($msgid,$result); + } + $result .= ''.$ENV{'SERVER_NAME'}.''. ''.$ENV{'HTTP_HOST'}.''. - ''.$ENV{'REMOTE_ADDR'}.''. + ''.$ip.''. ''.$env{'browser.type'}.''. ''.$env{'browser.os'}.''. ''.$env{'browser.version'}.''. ''.$env{'browser.mathml'}.''. ''.$ENV{'HTTP_USER_AGENT'}.''. - ''.$env{'request.course.id'}.''. + ''.$course_context.''. ''.$env{'request.course.sec'}.''. ''.$env{'request.role'}.''. ''.$env{'request.filename'}.''. - ''.$msgid.''. - ''.$recuser.''. - ''.$recdomain.''. - ''.$message.''; + ''.$msgid.''; + if (defined($env{'form.group'})) { + $result .= ''.$env{'form.group'}.''; + } + if (ref($recuser) eq 'ARRAY') { + for (my $i=0; $i<@{$recuser}; $i++) { + 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 .= ''. + $email.''; + } else { + $result .= ''.$$recuser[$i].''. + ''.$$recdomain[$i].''; + } + } + } else { + $result .= ''.$recuser.''. + ''.$recdomain.''; + } + $result .= ''.$message.''; if (defined($citation)) { $result.=''.$citation.''; } @@ -172,13 +310,69 @@ sub packagemsg { if (defined($attachmenturl)) { $result.= ''.$attachmenturl.''; } - return $msgid,$result; + if (defined($symb)) { + $result.= ''.$symb.''; + if ($course_context ne '') { + if ($course_context eq $env{'request.course.id'}) { + my $resource_title = &Apache::lonnet::gettitle($symb); + if (defined($resource_title)) { + $result .= ''.$resource_title.''; + } + } + } + } + if (defined($recipid)) { + $result.= ''.$recipid.''; + } + if ($env{'form.can_reply'} eq 'N') { + $result .= '1'; + } + if ($env{'form.reply_to_addr'}) { + my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); + if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { + if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { + $result .= ''.$env{'form.reply_to_addr'}.''; + } + } + } + if ($senthide) { + $result .= '$origmsgid'; + } + return ($msgid,$result); +} + +sub get_course_context { + my $course_context; + my $msgkey; + if (defined($env{'form.replyid'})) { + $msgkey = $env{'form.replyid'}; + } elsif (defined($env{'form.forwid'})) { + $msgkey = $env{'form.forwid'} + } elsif (defined($env{'form.multiforwid'})) { + $msgkey = $env{'form.multiforwid'}; + } + if ($msgkey ne '') { + my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= + split(/\:/,&unescape($msgkey)); + $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; + } + } + if ($course_context eq '') { + $course_context = $env{'request.course.id'}; + } + return $course_context; } -# ================================================== Unpack message into a hash sub unpackagemsg { - my ($message,$notoken)=@_; + my ($message,$notoken,$noattachmentlink)=@_; my %content=(); my $parser=HTML::TokeParser->new(\$message); my $token; @@ -186,10 +380,19 @@ sub unpackagemsg { if ($token->[0] eq 'S') { my $entry=$token->[1]; 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 ($content{'attachmenturl'}) { + if (!exists($content{'recuser'})) { $content{'recuser'} = []; } + if (($content{'attachmenturl'}) && (!$noattachmentlink)) { my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); if ($notoken) { $content{'message'}.='

'.&mt('Attachment').': '.$fname.''; @@ -204,86 +407,232 @@ sub unpackagemsg { return %content; } -# ======================================================= 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 { - my ($msgid,$folder)=@_; - $msgid=&Apache::lonnet::unescape($msgid); - my $suffix=&foldersuffix($folder); - my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/, - &Apache::lonnet::unescape($msgid)); - my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); - if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } - unless ($status{$msgid}) { $status{$msgid}='new'; } - return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid); + my ($msgid,$folder,$skipstatus,$status_cache,$onlycid)=@_; + $msgid=&unescape($msgid); + my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, + $processid,$symb,$error) = split(/\:/,&unescape($msgid)); + if (!defined($processid)) { $fromcid = ''; } + if (($onlycid) && ($onlycid ne $fromcid)) { + return ($sendtime,'',$fromname,$fromdomain,'',$fromcid,'',$error); + } + $shortsubj = &unescape($shortsubj); + $shortsubj = &HTML::Entities::decode($shortsubj); + $symb = &unescape($symb); + 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 { - my ($to,$subject,$body)=@_; + my ($to,$subject,$body,$to_uname,$to_udom,$user_lh,$attachmenturl)=@_; + my $senderaddress=''; + my $replytoaddress=''; + my $msgsent; + if ($env{'form.can_reply'} eq 'N') { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my $hostname = &Apache::lonnet::hostname($lonhost); + $replytoaddress = 'do-not-reply@'.$hostname; + } else { + my %senderemails; + my $have_sender; + if ($env{'form.reply_to_addr'}) { + my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); + if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { + if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { + %senderemails = + &Apache::loncommon::getemails($replytoname,$replytodom); + $have_sender = 1; + } + } + } + if (!$have_sender) { + %senderemails=&Apache::loncommon::getemails(); + } + foreach my $type ('permanentemail','critnotification','notification') { + if ($senderemails{$type}) { + ($senderaddress) = split(/,/,$senderemails{$type}); + last if ($senderaddress); + } + } + } $body= - "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n". - "*** ".&mt('Please do not reply to this address.')."\n\n".$body; - my $msg = new Mail::Send; - $msg->to($to); - $msg->subject('[LON-CAPA] '.$subject); - if (my $fh = $msg->open()) { - print $fh $body; - $fh->close; + "*** ".&mt_user($user_lh,'This is an automatic e-mail generated by the LON-CAPA system.')."\n". + "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ". + &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body; + + $attachmenturl = &Apache::lonnet::filelocation("",$attachmenturl); + my $filesize = (stat($attachmenturl))[7]; + if ($filesize > 1048576) { + # Don't send if it exceeds 1 MB. + print '

' + .&mt('Email not sent. Attachment exceeds permitted length.') + .'

'; + } else { + # Otherwise build and send the email + $subject = '[LON-CAPA] '.$subject; + &Apache::loncommon::mime_email($senderaddress,$replytoaddress,$to, + $subject,$body,'','',$attachmenturl,'',''); + $msgsent = 1; } + return $msgsent; } # ==================================================== Send notification emails sub sendnotification { - my ($to,$touname,$toudom,$subj,$crit,$text)=@_; + my ($to,$touname,$toudom,$subj,$crit,$text,$msgid,$attachmenturl)=@_; my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; unless ($sender=~/\w/) { - $sender=$env{'user.name'}.'@'.$env{'user.domain'}; + $sender=$env{'user.name'}.':'.$env{'user.domain'}; } my $critical=($crit?' critical':''); + my $numsent = 0; + $text=~s/\<\;/\/gs; - $text=~s/\<\/*[^\>]+\>//gs; - my $url='http://'. - $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}. - '/adm/email?username='.$touname.'&domain='.$toudom; - my $body=(<]+\>//gs; + $text = &HTML::Entities::decode($text); + $text = &Encode::encode('utf8',$text); + return $text; +} -to access the full message. -ENDMSG - &sendemail($to,'New'.$critical.' message from '.$sender,$body); +sub mynewmail{ + &newmail(); + return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'}; } -# ============================================================= Check for email + sub newmail { if ((time-$env{'user.mailcheck.time'})>300) { my %what=&Apache::lonnet::get('email_status',['recnewemail']); - &Apache::lonnet::appenv('user.mailcheck.time'=>time); + &Apache::lonnet::appenv({'user.mailcheck.time'=>time}); + &Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}}); if ($what{'recnewemail'}>0) { return 1; } } return 0; } -# =============================== Automated message to the author of a resource -=pod - -=item * B: Sends message $message to the owner - of the resource with the URI $filename. - -=cut sub author_res_msg { my ($filename,$message)=@_; @@ -293,27 +642,29 @@ sub author_res_msg { my $homeserver=&Apache::lonnet::homeserver($author,$domain); if ($homeserver ne 'no_host') { my $id=unpack("%32C*",$message); + $message .= "

This error occurred on machine ". + $Apache::lonnet::perlvar{'lonHostID'}."

"; my $msgid; ($msgid,$message)=&packagemsg($filename,$message); return &Apache::lonnet::reply('put:'.$domain.':'.$author. ':nohist_res_msgs:'. - &Apache::lonnet::escape($filename.'_'.$id).'='. - &Apache::lonnet::escape($message),$homeserver); + &escape($filename.'_'.$id).'='. + &escape($message),$homeserver); } return 'no_host'; } -# =========================================== Retrieve author resource messages + sub retrieve_author_res_msg { my $url=shift; $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 $msgs=''; - foreach (keys %errormsgs) { - if ($_=~/^\Q$url\E\_\d+$/) { - my %content=&unpackagemsg($errormsgs{$_}); + foreach my $msg (keys(%errormsgs)) { + if ($msg =~ /^\Q$url\E\_\d+$/) { + my %content=&unpackagemsg($errormsgs{$msg}); $msgs.='

'. $content{'time'}.': '.$content{'message'}. '

'; @@ -323,139 +674,189 @@ sub retrieve_author_res_msg { } -# =============================== Delete all author messages related to one URL + + sub del_url_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); - my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//); + my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - if ($_=~/^\Q$url\E\_\d+$/) { - push (@delmsgs,$_); + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + if ($msg =~ /^\Q$url\E\_\d+$/) { + push (@delmsgs,$msg); } } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# =================================== Clear out all author messages in URL path + sub clear_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); - my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//); + my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - if ($_=~/^\Q$url\E/) { - push (@delmsgs,$_); + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + if ($msg =~ /^\Q$url\E/) { + push (@delmsgs,$msg); } } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# ================= Return hash with URLs for which there is a resource message + + sub all_url_author_res_msg { my ($author,$domain)=@_; my %returnhash=(); - foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { - $_=~/^(.+)\_\d+/; + foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { + $msg =~ /^(.+)\_\d+/; $returnhash{$1}=1; } return %returnhash; } -# ================================================== Critical message to a user + +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); + if ($result eq 'ok' || $result eq 'con_delayed') { + + } + return $result; +} + sub user_crit_msg_raw { - my ($user,$domain,$subject,$message,$sendback,$toperm)=@_; + my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; # Check if allowed missing - my $status=''; + my ($status,$packed_message); my $msgid='undefined'; unless (($message)&&($user)&&($domain)) { $status='empty'; }; my $text=$message; my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { - ($msgid,$message)=&packagemsg($subject,$message); - if ($sendback) { $message.='true'; } - $status=&Apache::lonnet::critical( - 'put:'.$domain.':'.$user.':critical:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$homeserver); - if ($env{'request.course.id'}) { - &user_normal_msg_raw( - $env{'course.'.$env{'request.course.id'}.'.num'}, - $env{'course.'.$env{'request.course.id'}.'.domain'}, - 'Critical ['.$user.':'.$domain.']', - $message); - } + ($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef, + $attachmenturl,undef,undef,undef,undef,undef, + undef,undef,$recipid); + if ($sendback) { $packed_message.='true'; } + $status=&Apache::lonnet::cput('critical', {$msgid => $packed_message}, + $domain,$user); + if (defined($sentmessage)) { + $$sentmessage = $packed_message; + } + if (!$nosentstore) { + my ($sentmsgid,$packed_message_no_citation) = + &packagemsg($subject,$message,undef,undef,$attachmenturl,$user, + $domain,$msgid,undef,undef,undef,undef,undef,$senthide,$msgid); + if ($status eq 'ok' || $status eq 'con_delayed') { + if ($senthide && $sentmsgid) { + &store_sent_mail($sentmsgid,$packed_message_no_citation); + } else { + &store_sent_mail($msgid,$packed_message_no_citation); + } + } + } } else { $status='no_host'; } + # Notifications - my %userenv = &Apache::lonnet::get('environment',['critnotification', - 'permanentemail'], - $domain,$user); - if ($userenv{'critnotification'}) { - &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, - $text); - } - if ($toperm && $userenv{'permanentemail'}) { - &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, - $text); + my %userenv = &Apache::loncommon::getemails($user,$domain); + my $critnotify = $userenv{'critnotification'}; + my $permemail = $userenv{'permanentemail'}; + my $numcrit = 0; + my $numperm = 0; + my $permlogmsgstatus; + if ($critnotify) { + $numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid,$attachmenturl); + } + if ($toperm && $permemail) { + if ($critnotify && $numcrit) { + if (grep(/^\Q$permemail\E/,split(/,/,$critnotify))) { + $numperm = 1; + } + } + unless ($numperm) { + $numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid,$attachmenturl); + } + } + if ($toperm) { + $permlogmsgstatus = '. Perm. email log status '. + &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, + "Perm. e-mail count $numperm for $user at $domain"); + if (ref($permresults) eq 'HASH') { + $permresults->{"$user:$domain"} = $numperm; + } } # Log this &Apache::lonnet::logthis( - 'Sending critical email '.$msgid. + 'Sending critical '.$msgid. ', log status: '. &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, $env{'user.home'}, - 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' - .$status)); + 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status ' + .$status).$permlogmsgstatus); return $status; } -# New routine that respects "forward" and calls old routine - -=pod -=item * B: Sends - 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. - -=cut sub user_crit_msg { - my ($user,$domain,$subject,$message,$sendback,$toperm)=@_; - my $status=''; + my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, + $nosentstore,$recipid,$attachmenturl,$permresults,$senthide)=@_; + my @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); my $msgforward=$userenv{'msgforward'}; if ($msgforward) { - foreach (split(/\,/,$msgforward)) { - my ($forwuser,$forwdomain)=split(/\:/,$_); - $status.= - &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, - $sendback,$toperm).' '; + foreach my $addr (split(/\,/,$msgforward)) { + my ($forwuser,$forwdomain)=split(/\:/,$addr); + push(@status, + &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, + $sendback,$toperm,$sentmessage,$nosentstore, + $recipid,$attachmenturl,$permresults,$senthide)); } } 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,$nosentstore,$recipid, + $attachmenturl,$permresults,$senthide)); } - return $status; + if (wantarray) { + return @status; + } + return join(' ',@status); } -# =================================================== Critical message received sub user_crit_received { my $msgid=shift; my %message=&Apache::lonnet::get('critical',[$msgid]); my %contents=&unpackagemsg($message{$msgid},1); + my $destname = $contents{'sendername'}; + my $destdom = $contents{'senderdomain'}; + if ($contents{'replytoaddr'}) { + my ($repname,$repdom) = split(/:/,$contents{'replytoaddr'}); + if (&Apache::lonnet::homeserver($repname,$repdom) ne 'no_host') { + $destname = $repname; + $destdom = $repdom; + } + } my $status='rec: '.($contents{'sendback'}? - &user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, - &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'}, - &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}. - ' acknowledged receipt of message'."\n".' "'. - $contents{'subject'}.'"'."\n".&mt('dated').' '. - $contents{'time'}.".\n" - ):'no msg req'); + &user_normal_msg($destname,$destdom,&mt('Receipt').': '.$env{'user.name'}. + ' '.&mt('at').' '.$env{'user.domain'}.', '. + $contents{'subject'},&mt('User').' '.$env{'user.name'}. + ' '.&mt('at').' '.$env{'user.domain'}. + ' acknowledged receipt of message'."\n".' "'. + $contents{'subject'}.'"'."\n".&mt('dated').' '. + $contents{'time'}.".\n" + ):'no msg req'); $status.=' trans: '. &Apache::lonnet::put( 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); @@ -468,1766 +869,274 @@ sub user_crit_received { return $status; } -# ======================================================== Normal communication + + sub user_normal_msg_raw { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, - $toperm)=@_; + $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, + $error,$nosentstore,$recipid,$permresults,$senthide)=@_; # Check if allowed missing - my $status=''; + my ($status,$packed_message); my $msgid='undefined'; my $text=$message; unless (($message)&&($user)&&($domain)) { $status='empty'; }; my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { - ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl, - $attachmenturl,$user,$domain); + ($msgid,$packed_message)= + &packagemsg($subject,$message,$citation,$baseurl, + $attachmenturl,$user,$domain,$currid, + undef,$crsmsgid,$symb,$error,$recipid); + # Store in user folder - $status=&Apache::lonnet::critical( - 'put:'.$domain.':'.$user.':nohist_email:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$homeserver); + $status= + &Apache::lonnet::cput('nohist_email',{$msgid => $packed_message}, + $domain,$user); # Save new message received time &Apache::lonnet::put ('email_status',{'recnewemail'=>time},$domain,$user); -# Into sent-mail folder - $status.=' '.&Apache::lonnet::critical( - 'put:'.$env{'user.domain'}.':'.$env{'user.name'}. - ':nohist_email_sent:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$env{'user.home'}); - } else { - $status='no_host'; - } +# Into sent-mail folder if sent mail storage required + if (!$nosentstore) { + my ($sentmsgid,$packed_message_no_citation) = + &packagemsg($subject,$message,undef,$baseurl,$attachmenturl, + $user,$domain,$currid,undef,$crsmsgid,$symb,$error, + undef,$senthide,$msgid); + if ($status eq 'ok' || $status eq 'con_delayed') { + if ($senthide && $sentmsgid) { + &store_sent_mail($sentmsgid,$packed_message_no_citation); + } else { + &store_sent_mail($msgid,$packed_message_no_citation); + } + } + } + if (ref($newid) eq 'SCALAR') { + $$newid = $msgid; + } + if (ref($sentmessage) eq 'SCALAR') { + $$sentmessage = $packed_message; + } # Notifications - my %userenv = &Apache::lonnet::get('environment',['notification', - 'permanentemail'], - $domain,$user); - if ($userenv{'notification'}) { - &sendnotification($userenv{'notification'},$user,$domain,$subject,0, - $text); - } - if ($toperm && $userenv{'permanentemail'}) { - &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, - $text); - } - &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, - $env{'user.home'}, - 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); + my %userenv = &Apache::loncommon::getemails($user,$domain); + my $notify = $userenv{'notification'}; + my $permemail = $userenv{'permanentemail'}; + my $numnotify = 0; + my $numperm = 0; + my $permlogmsgstatus; + if ($notify) { + $numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid,$attachmenturl); + } + if ($toperm && $permemail) { + if ($notify && $numnotify) { + if (grep(/^\Q$permemail\E/,split(/,/,$notify))) { + $numperm = 1; + } + } + unless ($numperm) { + $numperm = &sendnotification($permemail,$user,$domain,$subject,0, + $text,$msgid,$attachmenturl); + } + } + if ($toperm) { + $permlogmsgstatus = '. Perm. email log status '. + &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'}, + "Perm. e-mail count $numperm for $user at $domain"); + if (ref($permresults) eq 'HASH') { + $permresults->{"$user:$domain"} = $numperm; + } + } + &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, + $env{'user.home'}, + 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status '.$status. + $permlogmsgstatus); + } else { + $status='no_host'; + } return $status; } -# New routine that respects "forward" and calls old routine - -=pod - -=item * B: Sends a message to the - $user at $domain, with subject $subject and message $message. - -=cut - sub user_normal_msg { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, - $toperm)=@_; - my $status=''; + $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid, + $permresults,$senthide)=@_; + my @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); my $msgforward=$userenv{'msgforward'}; if ($msgforward) { - foreach (split(/\,/,$msgforward)) { - my ($forwuser,$forwdomain)=split(/\:/,$_); - $status.= - &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, - $citation,$baseurl,$attachmenturl,$toperm).' '; - } - } else { - $status=&user_normal_msg_raw($user,$domain,$subject,$message, - $citation,$baseurl,$attachmenturl,$toperm); - } - return $status; -} - - -# ============================================================ List all folders - -sub folderlist { - my $folder=shift; - my @allfolders=&Apache::lonnet::getkeys('email_folders'); - if ($allfolders[0]=~/^error:/) { @allfolders=(); } - return '
'. - &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'). - ''. - '
'. - ''. - ($folder=~/^(new|critical)/?'
':''); -} - -sub scrollbuttons { - my ($start,$maxdis,$first,$finish,$total)=@_; - unless ($total>0) { return ''; } - $start++; $maxdis++;$first++;$finish++; - return - &mt('Page').': '. - ''. - ''. - ' of '.$maxdis. - ''. - '
'. - &mt('Showing messages [_1] through [_2] of [_3]',$first,$finish,$total).''; -} - -# =============================================================== Folder suffix - -sub foldersuffix { - my $folder=shift; - unless ($folder) { return ''; } - return '_'.&Apache::lonnet::escape($folder); -} - -# =============================================================== Status Change - -sub statuschange { - my ($msgid,$newstatus,$folder)=@_; - my $suffix=&foldersuffix($folder); - my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); - if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } - unless ($status{$msgid}) { $status{$msgid}='new'; } - unless (($status{$msgid} eq 'replied') || - ($status{$msgid} eq 'forwarded')) { - &Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus}); - } - if (($newstatus eq 'deleted') || ($newstatus eq 'new')) { - &Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus}); - } - if ($newstatus eq 'deleted') { - &movemsg(&Apache::lonnet::unescape($msgid),$folder,'trash'); - } -} - -# ============================================================= Make new folder - -sub makefolder { - my ($newfolder)=@_; - if (($newfolder eq 'sent') - || ($newfolder eq 'critical') - || ($newfolder eq 'trash') - || ($newfolder eq 'new')) { return; } - &Apache::lonnet::put('email_folders',{$newfolder => time}); -} - -# ======================================================== Move between folders - -sub movemsg { - my ($msgid,$srcfolder,$trgfolder)=@_; - if ($srcfolder eq 'new') { $srcfolder=''; } - my $srcsuffix=&foldersuffix($srcfolder); - my $trgsuffix=&foldersuffix($trgfolder); - -# 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 - my %coursepersonnel=&Apache::lonnet::get_course_adv_roles(); - $r->print(''); - foreach my $role (sort keys %coursepersonnel) { - foreach (split(/\,/,$coursepersonnel{$role})) { - my ($puname,$pudom)=split(/\:/,$_); - $r->print(''. - ''); - } - } - $r->print('
('.$_.'),'.$role.'
'); - 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(''); - } - $r->print('
'.$sname.'@'.$sdom.''.$section. - '
'); -} - -# ==================================================== Display Critical Message - -sub discrit { - my $r=shift; - my $header = '

'.&mt('Critical Messages').'

'. - '
'. - ''; - my %what=&Apache::lonnet::dump('critical'); - my $result = ''; - foreach (sort keys %what) { - my %content=&unpackagemsg($what{$_}); - next if ($content{'senderdomain'} eq ''); - $result.='
'.&mt('From').': '. -&Apache::loncommon::aboutmewrapper( - &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('. -$content{'sendername'}.'@'. - $content{'senderdomain'}.') '.$content{'time'}. - '
'.&mt('Subject').': '.$content{'subject'}. - '
'.
-              &Apache::lontexconvert::msgtexconverted($content{'message'}).
-            '
'. -&mt('You have to confirm that you received this message. After confirmation, this message will be moved to your regular inbox'). - '
'. - ''. - ''; - } - # Check to see if there were any messages. - if ($result eq '') { - $result = "

".&mt('You have no critical messages.')."

". - ''.&mt('Select a course').'
'. - ''.&mt('Communicate').''; } else { - $r->print($header); - } - $r->print($result); - $r->print('
'); -} - -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(<$lt{'nm'} - - -TABLEHEAD - foreach my $msg (@newmsgs) { - $r->print(<<"ENDLINK"); - - -ENDLINK - foreach ('sendtime','from','fromdom','shortsub') { - $r->print(""); - } - $r->print(""); - } - $r->print('
 $lt{'da'}$lt{'us'}$lt{'do'}$lt{'su'}
$lt{'op'}$msg->{$_}
'.&Apache::loncommon::endbodytag().''); - } elsif ($numblocked == 0) { - $r->print("

".&mt('You have no unread messages')."

"); - } - if ($numblocked > 0) { - my $beginblock = &Apache::lonlocal::locallocaltime($startblock); - my $finishblock = &Apache::lonlocal::locallocaltime($endblock); - if ($numblocked == 1) { - $r->print("

".&mt('You have').' '.$numblocked.' '.&mt('blocked unread message').".

"); - $r->print(&mt('This message is not viewable because').' '); - } else { - $r->print("

".&mt('You have').' '.$numblocked.' '.&mt('blocked unread messages').".

"); - $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); + push(@status,&user_normal_msg_raw($user,$domain,$subject,$message, + $citation,$baseurl,$attachmenturl,$toperm, + undef,undef,$sentmessage,undef,$symb, + $restitle,$error,$nosentstore,$recipid, + $permresults,$senthide)); + } + if (wantarray) { + return @status; + } + return join(' ',@status); +} + +sub process_sent_mail { + my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount, + $context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl, + $symb,$error,$senderuname,$senderdom,$recipid) = @_; + my $sentsubj; + if ($numsent > 1) { + $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj; } 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(< - function checkall() { - for (i=0; i -ENDDISHEADER - my $fsqs='&folder='.$folder; - my @temp=sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder); - my $totalnumber=$#temp+1; - unless ($totalnumber>0) { - $r->print('

'.&mt('Empty Folder').'

'); - 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('
'. - ''); - } else { - $r->print(''.&mt('Date').''); - } - $r->print(''); - } else { - $r->print(''.&mt('Status').''); - } - $r->print("\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(''); - } elsif ($status eq 'read') { - $r->print(''); - } elsif ($status eq 'replied') { - $r->print(''); - } else { - $r->print(''); - } - $r->print(''. - '\n"); - } elsif ($status eq 'deleted') { -# purge - &movemsg(&Apache::lonnet::unescape($origID),$folder,'trash'); - } - } - $r->print("
 '); - if ($env{'form.sortedby'} eq "revdate") { - $r->print(''.&mt('Date').''); - if ($env{'form.sortedby'} eq "revuser") { - $r->print(''.&mt('Username').''); - } else { - $r->print(''.&mt('Username').''); - } - $r->print(''); - if ($env{'form.sortedby'} eq "revdomain") { - $r->print(''.&mt('Domain').''); - } else { - $r->print(''.&mt('Domain').''); - } - $r->print(''); - if ($env{'form.sortedby'} eq "revsubject") { - $r->print(''.&mt('Subject').''); - } else { - $r->print(''.&mt('Subject').''); - } - $r->print(''); - if ($env{'form.sortedby'} eq "revstatus") { - $r->print(''.&mt('Status').'
'.&mt('Open').''. - ($folder ne 'trash'?''.&mt('Delete'):' ').''.&Apache::lonlocal::locallocaltime($sendtime).''. - $fromname.''.$fromdomain.''. - &Apache::lonnet::unescape($shortsubj).''. - $status."
\n

". - ''.&mt('Check All').' '. - ''.&mt('Uncheck All').'

'. - ''); - if ($folder ne 'trash') { - $r->print( - '

'); - } - $r->print('

'); - 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('

'); - if ($numblocked > 0) { - my $beginblock = &Apache::lonlocal::locallocaltime($startblock); - my $finishblock = &Apache::lonlocal::locallocaltime($endblock); - $r->print('

'. - $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); - } + $sentsubj = &HTML::Entities::encode($sentsubj,'<>&"'); + my $sentmsgid = + &buildmsgid($stamp,$sentsubj,$msgname,$msgdom,$msgcount,$context,$pid); + (undef,my $sentmessage) = + &packagemsg($msgsubj,$savemsg,undef,$baseurl,$attachmenturl,$recusers, + $recudoms,$sentmsgid,undef,undef,$symb,$error,$recipid); + my $status = &store_sent_mail($sentmsgid,$sentmessage,$senderuname, + $senderdom); + return $status; } -# ============================================================== 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('

'.&mt('Replying to a Critical Message').'

'); - $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= - '

' . $crithelp . - '

'. - '' . $crithelp . - '

'; - } - 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.=''; - $func=&mt('Forward'); - - $dissub=&mt('Forwarding').': '.$content{'subject'}; - $dismsg=&mt('Forwarded message from').' '. - $content{'sendername'}.' '.&mt('at').' '.$content{'senderdomain'}; - if ($content{'baseurl'}) { - $disbase=''; - } - } - if ($replying) { - %message=&Apache::lonnet::get('nohist_email'.$suffix,[$replying]); - %content=&unpackagemsg($message{$replying},$folder); - $dispcrit.=''; - $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=''; - if ($env{'user.adv'}) { - $disbase.=' '. - &mt('Show re-usable messages').'
'; - } - } - } - my $citation=&displayresource(%content); - if ($env{'form.recdom'}) { $defdom=$env{'form.recdom'}; } - $r->print( - '
'."\n". - ''."\n". - ''); - unless (($broadcast eq 'group') || ($broadcast eq 'upload')) { - if ($replying) { - $r->print(''); - } else { - my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain'); - my $selectlink=&Apache::loncommon::selectstudent_link - ('compemail','recuname','recdomain'); - $r->print(<<"ENDREC"); - - - -ENDREC - } - } - my $latexHelp = Apache::loncommon::helpLatexCheatsheet(); - if ($broadcast ne 'upload') { - $r->print(<<"ENDCOMP"); - -
'.&mt('Replying to').' '. - &Apache::loncommon::aboutmewrapper( - &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('. - $content{'sendername'}.'@'. - $content{'senderdomain'}.')'. - ''. - ''. - '
$lt{'us'}:$selectlink
$lt{'do'}:$domform
$lt{'ad'}
username\@domain,username\@domain, ... -		 -
$lt{'sb'}: -
-$latexHelp -


-$dispcrit -$disbase - - - -
-$citation -ENDCOMP - } else { # $broadcast is 'upload' - $r->print(< - -

Generate messages from a file

-

-Subject: -

-

General message text
-

-

-The file format for the uploaded portion of the message is: -

-username1\@domain1: text
-username2\@domain2: text
-username3\@domain1: text
-
-

-

-The messages will be assembled from all lines with the respective -username\@domain, and appended to the general message text.

-

-

-$dispcrit -

-ENDUPLOAD - } - if ($broadcast eq 'group') { - &discourse; - } - $r->print(''. - &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 store_sent_mail { + my ($msgid,$message,$senderuname,$senderdom) = @_; + if ($senderuname eq '') { + $senderuname = $env{'user.name'}; + } + if ($senderdom eq '') { + $senderdom = $env{'user.domain'}; + } + my $status =' '.&Apache::lonnet::cput('nohist_email_sent', + {$msgid => $message}, + $senderdom,$senderuname); + return $status; } -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.='

'.&mt('Record').'

'; - } elsif ($content{'subject'}=~/^Broadcast/) { - $result .='

'.&mt('Broadcast Message').'

'; - } else { - $result.='

'.&mt('Critical Message').'

'; - %content=&unpackagemsg($content{'message'}); - $content{'message'}= - ''.&mt('Subject').': '.$content{'subject'}.'
'. - $content{'message'}; - } - $result.=&mt('By').': '. -&Apache::loncommon::aboutmewrapper( - &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('. -$content{'sendername'}.'@'. - $content{'senderdomain'}.') '.$content{'time'}. - '
'.
-              &Apache::lontexconvert::msgtexconverted($content{'message'}).
-	      '
'; - } - # Check to see if there were any messages. - if ($result eq '') { - if ($target ne 'tex') { - $r->print("

".&mt("No notes, face-to-face discussion records, critical messages, or broadcast messages in this course.")."

"); - } else { - $r->print('\textbf{'.&mt("No notes, face-to-face discussion records, critical messages or broadcast messages in this course.").'}\\\\'); - } +sub store_recipients { + my ($subject,$sendername,$senderdom,$reciphash) = @_; + my $context = &get_course_context(); + my $now = time(); + my $msgcount = &get_uniq(); + my $recipid = + &buildmsgid($now,$subject,$sendername,$senderdom,$msgcount,$context,$$); + my %recipinfo = ( + $recipid => $reciphash, + ); + my $status = &Apache::lonnet::put('nohist_emailrecip',\%recipinfo, + $senderdom,$sendername); + if ($status eq 'ok') { + return ($recipid,$status); } else { - $r->print($result); + return (undef,$status); } } -# ---------------------------------------------------------------- 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"); -

$lt{'head'}

-
- - - - - - - -
$lt{'user'}: -$stdbrws -
$lt{'dom'}:$domform
-
-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('

'.&Apache::loncommon::plainname($env{'form.recuname'}, - $env{'form.recdomain'}).'

'); - &disfacetoface($r,$env{'form.recuname'},$env{'form.recdomain'}); - $r->print(< - - -ENDRHEAD - $r->print(<$lt{'newr'}
- -
- - - -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('

'.$lt{'cbds'}.'

'); - - if ($action eq 'store') { - &blockstore($r); - } - - $r->print($lt{'desc'}.'

-
- '); - - $r->print('

'.$lt{'mecb'}.'

'); - 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'}.'

'); - } - &display_addblocker_table($r,$parmcount,\%ltext); - my $endbody=&Apache::loncommon::endbodytag(); - $r->print(<<"END"); -
- - -
-$endbody - -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('

'.$lt{'head'}.'

'); - 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'}.'
    '); - if ($canceltotal > 0) { - $r->print('
  • '.$canceltotal.' '.$lt{'cbps'},' '.$lt{'werm'}.'
    • '); - } - if ($modtotal > 0) { - $r->print('
  • '.$modtotal.' '.$lt{'cbps'},' '.$lt{'wemo'}.'
    • '); - } - if ($addtotal > 0) { - $r->print('
  • '.$addtotal.' '.$lt{'cbps'},' '.$lt{'wead'}.'
    • '); - } - $r->print('
'); +sub foldersuffix { + my $folder=shift; + unless ($folder) { return ''; } + my $suffix; + my %folderhash = &get_user_folders($folder); + if (ref($folderhash{$folder}) eq 'HASH') { + $suffix = '_'.&escape($folderhash{$folder}{'id'}); } else { - $r->print($lt{'ncwm'}); + $suffix = '_'.&escape($folder); } - $r->print('
'); - return; + return $suffix; } -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"); - - - - -
- - - - -
- - - - - - - -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"); - - - - - -END - $parmcount ++; - } - $r->print(<<"END"); -
$$ltext{'dura'}$$ltext{'setb'}$$ltext{'even'}$$ltext{'actn'}?
$$ltext{'star'}: $startform
$$ltext{'endd'}:  $endform		$settername
-
-
-
-
-
-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"); -

$lt{'addn'}

- - - - -
- - - - -
- - - - - - - - - - - -
$$ltext{'dura'}$$ltext{'even'} $lt{'exam'}$$ltext{'actn'}?
$$ltext{'star'}: $startform
$$ltext{'endd'}:  $endform
-
-
-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; - } - } +sub get_user_folders { + my ($folder) = @_; + my %userfolders = + &Apache::lonnet::dump('email_folders',undef,undef,$folder); + my $lock = "\0".'lock_counter'; # locks db while counter incremented + my $counter = "\0".'idcount'; # used in suffix for email db files + if (defined($userfolders{$lock})) { + delete($userfolders{$lock}); + } + if (defined($userfolders{$counter})) { + delete($userfolders{$counter}); + } + return %userfolders; +} + +sub secapply { + my $rec=shift; + my $defaultflag=shift; + $rec=~s/\s+//g; + unless ($rec =~ /\:/) { + $rec=~s/\@/\:/g; + } + my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/); + if ($sections_or_groups) { + foreach my $item (split(/\;/,$sections_or_groups)) { + if (($item eq $env{'request.course.sec'}) || + ($defaultflag && ($item eq '*'))) { + return $adr; + } elsif ($env{'request.course.groups'}) { + my @usersgroups = split(/:/,$env{'request.course.groups'}); + if (grep(/^\Q$item\E$/,@usersgroups)) { + return $adr; } - } - } 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"); -
$lt{'cacb'}:

- - -
- - -
- - - - - - -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(''. - ''. - ''); - } - } - $r->print('
$lt{'cour'}$lt{'dura'}$lt{'blse'}
'.$courseinfo{'description'}.''.$openblock.' to '.$closeblock.''.$fullname.' ('.$uname.'@'.$udom. - ')
'); -} - -# ----------------------------------------------------------- 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('
');
-    my $escmsgid=&Apache::lonnet::escape($msgid);
-    foreach (@messages) {
-	if ($_->[5] eq $escmsgid){
-	    last;
-	}
-	$counter++;
-    }
-    $r->print('
'); - 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(''. - ''. - ''. - ''. - ''. - ''); - if ($counter > 0){ - $r->print(''); - } - if ($counter < $number_of_messages - 1){ - $r->print(''); - } - $r->print('
'.&mt('Functions').':'.&mt('Reply').''.&mt('Forward').''.&mt('Mark Unread').''.&mt('Delete').''.&mt('Back to Folder Display').''.&mt('Previous').''.&mt('Next').'
'); - if ($env{'user.adv'}) { - $r->print(''); - my $symb=&Apache::lonnet::symbread($content{'baseurl'}); - if (&Apache::lonnet::allowed('vgr',$env{'request.course.id'})) { - $r->print(''); - } - if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) && $symb) { - $r->print(''); - } - if (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}) && $symb) { - $r->print(''); - } - $r->print('
'.&mt('Currently available actions (will open extra window)').':'.&Apache::loncommon::track_student_link(&mt('View recent activity'),$content{'sendername'},$content{'senderdomain'},'check').''.&Apache::loncommon::pprmlink(&mt('Set/Change parameters'),$content{'sendername'},$content{'senderdomain'},$symb,'check').''.&Apache::loncommon::pgrdlink(&mt('Set/Change grades'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'
'); - } - $r->print('
'.&mt('Subject').': '.$content{'subject'}. - ($folder ne 'sent'?'
'.&mt('From').': '. - &Apache::loncommon::aboutmewrapper( - &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}), - $content{'sendername'},$content{'senderdomain'}).' ('. - $content{'sendername'}.' at '. - $content{'senderdomain'}.') ':'
'.&mt('To').': '. - &Apache::loncommon::aboutmewrapper( - &Apache::loncommon::plainname($content{'recuser'},$content{'recdomain'}), - $content{'recuser'},$content{'recdomain'}).' ('. - $content{'recuser'}.' at '. - $content{'recdomain'}.') '). - ($content{'courseid'}?'
'.&mt('Course').': '.$courseinfo{'description'}. - ($content{'coursesec'}?' ('.&mt('Group/Section').': '.$content{'coursesec'}.')':''):''). - '
'.&mt('Time').': '.$content{'time'}. - ($content{'baseurl'}?'
'.&mt('Refers to').': '. - $content{'baseurl'}.' ('.&Apache::lonnet::gettitle($content{'baseurl'}).')':''). - '

'.
-	      &Apache::lontexconvert::msgtexconverted($content{'message'},1).
-	      '
'.&displayresource(%content).'

'); - 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 '

'.&mt('Current attempts of student (if applicable)').'

'. - &Apache::loncommon::get_previous_attempt($symb, - $content{'sendername'}, - $content{'senderdomain'}, - $content{'courseid'}). - '

'.&mt('Current screen output (if applicable)').'

'. - &Apache::loncommon::get_student_view($symb, - $content{'sendername'}, - $content{'senderdomain'}, - $content{'courseid'}). - '

'.&mt('Correct Answer(s) (if applicable)').'

'. - &Apache::loncommon::get_student_answers($symb, - $content{'sendername'}, - $content{'senderdomain'}, - $content{'courseid'}); - } else { - return $content{'citation'}; - } -} - -# ================================================================== The Header - -sub header { - my ($r,$title,$baseurl)=@_; - $r->print(&Apache::lonxml::xmlbegin(). - ''.&Apache::lonxml::fontsettings(). - 'Communication and Messages'. - &Apache::lonhtmlcommon::htmlareaheaders()); - if ($baseurl) { - $r->print(""); - } - $r->print(&Apache::loncommon::studentbrowser_javascript().''. - &Apache::loncommon::bodytag('Communication and Messages')); - $r->print(&Apache::lonhtmlcommon::breadcrumbs - (undef,($title?$title:'Communication and Messages'))); - -} - -# ---------------------------------------------------------------- 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().''. - &Apache::lonxml::fontsettings().''); - if ((keys %msgs)[0]=~/^error\:/) { - $r->print(&mt('No stored comments yet.')); - } else { - my $found=0; - foreach (sort keys %msgs) { - $r->print("\n".$msgs{$_}."
"); - $found=1; - } - unless ($found) { - $r->print(&mt('No stored comments yet for this resource.')); - } - } -} - -# ---------------------------------------------------------------- Send an email - -sub sendoffmail { - 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.='
'.$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.'
'); - $sendstatus.=' '.$thismsg; - } } else { - &printheader($r,'','No messages sent.'); - } - if ($sendstatus=~/^(\s*(?:ok|con_delayed)\s*)*$/) { - $r->print('
'.&mt('Completed.').''); - if ($env{'form.displayedcrit'}) { - &discrit($r); - } else { - &Apache::loncommunicate::menu($r); - } - } else { - $r->print( - '

'.&mt('Could not deliver message').'

'. - &mt('Please use the browser "Back" button and correct the recipient addresses') - ); + return $rec; } + return ''; } -# ===================================================================== Handler - -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); +sub decide_receiver { + my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; + &Apache::lonenc::check_decrypt(\$feedurl); + my $typestyle=''; + my %to=(); + if ($env{'form.discuss'} eq 'author' ||$author) { + $typestyle.='Submitting as Author Feedback
'; + $feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/}; + $to{$2.':'.$1}=1; + } + my $cid = $env{'request.course.id'}; + if ($env{'form.discuss'} eq 'question' ||$question) { + $typestyle.=&mt('Submitting as Question').'
'; + foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) { + my $rec=&secapply($item,$defaultflag); + if ($rec) { $to{$rec}=1; } + } + } + if ($env{'form.discuss'} eq 'course' ||$course) { + $typestyle.=&mt('Submitting as Comment').'
'; + foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) { + my $rec=&secapply($item,$defaultflag); + if ($rec) { $to{$rec}=1; } + } + } + if ($env{'form.discuss'} eq 'policy' ||$policy) { + $typestyle.=&mt('Submitting as Policy Feedback').'
'; + foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) { + my $rec=&secapply($item,$defaultflag); + if ($rec) { $to{$rec}=1; } + } + } + if ((scalar(%to) eq '0') && (!$defaultflag)) { + ($typestyle,%to)= + &decide_receiver($feedurl,$author,$question,$course,$policy,1); } -# ------------------------------------------------------------ Get Display Mode - - my $dismode=$env{'form.dismode'}; - unless ($dismode) { - $dismode=''; - } else { - $sqs.='&dismode='.&Apache::lonnet::escape($dismode); - } - -# --------------------------------------------------------------------- Display - - $startdis=$env{'form.startdis'}; - $startdis--; - unless ($startdis) { $startdis=0; } - - $interdis=$env{'form.interdis'}; - unless ($interdis) { $interdis=20; } - $sqs.='&interdis='.$interdis; - - if ($env{'form.firstview'}) { - $startdis=0; - } - if ($env{'form.lastview'}) { - $startdis=-1; - } - if ($env{'form.prevview'}) { - $startdis--; - } - if ($env{'form.nextview'}) { - $startdis++; - } - my $postedstartdis=$startdis+1; - $sqs.='&startdis='.$postedstartdis; - -# --------------------------------------------------------------- Render Output - - if ($env{'form.display'}) { - &displaymessage($r,$env{'form.display'},$folder); - } elsif ($env{'form.replyto'}) { - &compout($r,'',$env{'form.replyto'},undef,undef,$folder,$dismode); - } elsif ($env{'form.confirm'}) { - &printheader($r,'','Confirmed Receipt'); - foreach (keys %env) { - if ($_=~/^form\.rec\_(.*)$/) { - $r->print(''.&mt('Confirming Receipt').': '. - &user_crit_received($1).'
'); - } - if ($_=~/^form\.reprec\_(.*)$/) { - my $msgid=$1; - $r->print(''.&mt('Confirming Receipt').': '. - &user_crit_received($msgid).'
'); - &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)

'); - &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)

'); - &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); - } - &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().''); - return OK; + return ($typestyle,%to); } -# ================================================= Main program, reset counter - -BEGIN { - $msgcount=0; -} - -=pod - -=back - -=cut - -1; +1; __END__ - - - - - -