|
version 1.3, 2000/10/20 14:40:26
|
version 1.231, 2011/02/13 17:44:51
|
|
Line 1
|
Line 1
|
| # The LearningOnline Network with CAPA |
# The LearningOnline Network with CAPA |
| # |
|
| # Routines for messaging |
# Routines for messaging |
| # |
# |
| # (Routines to control the menu |
# $Id$ |
| |
# |
| |
# Copyright Michigan State University Board of Trustees |
| |
# |
| |
# This file is part of the LearningOnline Network with CAPA (LON-CAPA). |
| |
# |
| |
# LON-CAPA is free software; you can redistribute it and/or modify |
| |
# it under the terms of the GNU General Public License as published by |
| |
# the Free Software Foundation; either version 2 of the License, or |
| |
# (at your option) any later version. |
| # |
# |
| # (TeX Conversion Module |
# LON-CAPA is distributed in the hope that it will be useful, |
| |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
| |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| |
# GNU General Public License for more details. |
| # |
# |
| # 05/29/00,05/30 Gerd Kortemeyer) |
# You should have received a copy of the GNU General Public License |
| |
# along with LON-CAPA; if not, write to the Free Software |
| |
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
| # |
# |
| # 10/05 Gerd Kortemeyer) |
# /home/httpd/html/adm/gpl.txt |
| |
# |
| |
# http://www.lon-capa.org/ |
| # |
# |
| # 10/19,10/20 Gerd Kortemeyer |
|
| |
|
| package Apache::lonmsg; |
package Apache::lonmsg; |
| |
|
| |
=pod |
| |
|
| |
=head1 NAME |
| |
|
| |
Apache::lonmsg: supports internal messaging |
| |
|
| |
=head1 SYNOPSIS |
| |
|
| |
lonmsg provides routines for sending messages. |
| |
|
| |
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. |
| |
|
| |
The routines used to package messages and unpackage messages are not |
| |
only used by lonmsg when creating/extracting messages for LON-CAPA's |
| |
internal messaging system, but also by lonnotify.pm which is available |
| |
for use by Domain Coordinators to broadcast standard e-mail to specified |
| |
users in their domain. The XML packaging used in the two cases is very |
| |
similar. The differences are the use of <recuser>$uname</recuser> and |
| |
<recdomain>$udom</recdomain> in stored internal messages, compared |
| |
with <recipient username="$uname:$udom">$email</recipient> in stored |
| |
Domain Coordinator e-mail for the storage of information about |
| |
recipients of the message/e-mail. |
| |
|
| |
=head1 SUBROUTINES |
| |
|
| |
=over |
| |
|
| |
=pod |
| |
|
| |
=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<author_res_msg($filename, $message)>: 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<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: |
| |
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 |
| |
|
| |
=item * B<user_normal_msg($user, $domain, $subject, $message, $citation, |
| |
$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, |
| |
$error,$nosentstore,$recipid)>: |
| |
Sends a message to the $user at $domain, with subject $subject and message $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 store_sent_mail() |
| |
|
| |
=item store_recipients() |
| |
|
| |
=item foldersuffix() |
| |
|
| |
=item get_user_folders() |
| |
|
| |
User-defined folders |
| |
|
| |
=item secapply() |
| |
|
| |
=item B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>: |
| |
|
| |
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.<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 |
| |
|
| |
=back |
| |
|
| |
=cut |
| |
|
| use strict; |
use strict; |
| use Apache::lonnet(); |
use Apache::lonnet; |
| use vars qw($msgcount); |
use HTML::TokeParser(); |
| use HTML::TokeParser; |
use Apache::lonlocal; |
| |
use Mail::Send; |
| |
use HTML::Entities; |
| |
use Encode; |
| |
use LONCAPA qw(:DEFAULT :match); |
| |
|
| |
{ |
| |
my $uniq; |
| |
sub get_uniq { |
| |
$uniq++; |
| |
return $uniq; |
| |
} |
| |
} |
| |
|
| |
|
| # ===================================================================== Package |
|
| |
|
| sub packagemsg { |
sub packagemsg { |
| my ($subject,$message)=@_; |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
| $message=~s/\</\<\;/g; |
$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error,$recipid)=@_; |
| $message=~s/\>/\>\;/g; |
$message =&HTML::Entities::encode($message,'<>&"'); |
| $subject=~s/\</\<\;/g; |
$citation=&HTML::Entities::encode($citation,'<>&"'); |
| $subject=~s/\>/\>\;/g; |
$subject =&HTML::Entities::encode($subject,'<>&"'); |
| |
#remove machine specification |
| |
$baseurl =~ s|^https?://[^/]+/|/|; |
| |
$baseurl =&HTML::Entities::encode($baseurl,'<>&"'); |
| |
#remove machine specification |
| |
$attachmenturl =~ s|^https?://[^/]+/|/|; |
| |
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); |
| |
my $course_context = &get_course_context(); |
| my $now=time; |
my $now=time; |
| $msgcount++; |
my $msgcount = &get_uniq(); |
| my $msgid=$now.'_'.$ENV{'user.name'}.'_'. |
unless(defined($msgid)) { |
| $ENV{'user.domain'}.'_'.$msgcount.'_'.$$; |
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, |
| return $msgid, |
$msgcount,$course_context,$symb,$error,$$); |
| '<sendername>'.$ENV{'user.name'}.'</sendername>'. |
} |
| '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'. |
my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. |
| |
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
| '<subject>'.$subject.'</subject>'. |
'<subject>'.$subject.'</subject>'. |
| '<time>'.localtime($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>'. |
| '<browseros>'.$ENV{'browser.os'}.'</browseros>'. |
'<browseros>'.$env{'browser.os'}.'</browseros>'. |
| '<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>'. |
| '<role>'.$ENV{'request.role'}.'</role>'. |
'<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. |
| '<resource>'.$ENV{'request.filename'}.'</resource>'. |
'<role>'.$env{'request.role'}.'</role>'. |
| '<msgid>'.$msgid.'</msgid>'. |
'<resource>'.$env{'request.filename'}.'</resource>'. |
| '<message>'.$message.'</message>'; |
'<msgid>'.$msgid.'</msgid>'; |
| |
if (defined($env{'form.group'})) { |
| |
$result .= '<group>'.$env{'form.group'}.'</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 .= '<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)) { |
| |
$result.='<citation>'.$citation.'</citation>'; |
| |
} |
| |
if (defined($baseurl)) { |
| |
$result.= '<baseurl>'.$baseurl.'</baseurl>'; |
| |
} |
| |
if (defined($attachmenturl)) { |
| |
$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; |
| |
} |
| |
if (defined($symb)) { |
| |
$result.= '<symb>'.$symb.'</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>'.$resource_title.'</resource_title>'; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
if (defined($recipid)) { |
| |
$result.= '<recipid>'.$recipid.'</recipid>'; |
| |
} |
| |
if ($env{'form.can_reply'} eq 'N') { |
| |
$result .= '<noreplies>1</noreplies>'; |
| |
} |
| |
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 .= '<replytoaddr>'.$env{'form.reply_to_addr'}.'</replytoaddr>'; |
| |
} |
| |
} |
| |
} |
| |
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 { |
sub unpackagemsg { |
| my $message=shift; |
my ($message,$notoken,$noattachmentlink)=@_; |
| my %content=(); |
my %content=(); |
| my $parser=HTML::TokeParser->new(\$message); |
my $parser=HTML::TokeParser->new(\$message); |
| my $token; |
my $token; |
|
Line 62 sub unpackagemsg {
|
Line 360 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'}) && (!$noattachmentlink)) { |
| |
my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); |
| |
if ($notoken) { |
| |
$content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>'; |
| |
} else { |
| |
&Apache::lonnet::allowuploaded('/adm/msg', |
| |
$content{'attachmenturl'}); |
| |
$content{'message'}.='<p>'.&mt('Attachment'). |
| |
': <a href="'.$content{'attachmenturl'}.'"><tt>'. |
| |
$fname.'</tt></a>'; |
| } |
} |
| } |
} |
| return %content; |
return %content; |
| } |
} |
| |
|
| # =============================== Automated message to the author of a resource |
|
| |
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,$skipstatus,$status_cache)=@_; |
| |
$msgid=&unescape($msgid); |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, |
| |
$processid,$symb,$error) = split(/\:/,&unescape($msgid)); |
| |
$shortsubj = &unescape($shortsubj); |
| |
$shortsubj = &HTML::Entities::decode($shortsubj); |
| |
$symb = &unescape($symb); |
| |
if (!defined($processid)) { $fromcid = ''; } |
| |
my %status=(); |
| |
unless ($skipstatus) { |
| |
if (ref($status_cache)) { |
| |
$status{$msgid} = $status_cache->{$msgid}; |
| |
} else { |
| |
my $suffix=&foldersuffix($folder); |
| |
%status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); |
| |
} |
| |
if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
| |
unless ($status{$msgid}) { $status{$msgid}='new'; } |
| |
} |
| |
return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error); |
| |
} |
| |
|
| |
|
| |
sub sendemail { |
| |
my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; |
| |
my $senderaddress=''; |
| |
my $replytoaddress=''; |
| |
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_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; |
| |
|
| |
my $msg = new Mail::Send; |
| |
$msg->to($to); |
| |
$msg->subject('[LON-CAPA] '.$subject); |
| |
if ($replytoaddress) { |
| |
$msg->add('Reply-to',$replytoaddress); |
| |
} |
| |
if ($senderaddress) { |
| |
$msg->add('From',$senderaddress); |
| |
} |
| |
$msg->add('Content-type','text/plain; charset=UTF-8'); |
| |
if (my $fh = $msg->open()) { |
| |
print $fh $body; |
| |
$fh->close; |
| |
} |
| |
} |
| |
|
| |
# ==================================================== Send notification emails |
| |
|
| |
sub sendnotification { |
| |
my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; |
| |
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; |
| |
unless ($sender=~/\w/) { |
| |
$sender=$env{'user.name'}.':'.$env{'user.domain'}; |
| |
} |
| |
my $critical=($crit?' critical':''); |
| |
|
| |
$text=~s/\<\;/\</gs; |
| |
$text=~s/\>\;/\>/gs; |
| |
my $homeserver = &Apache::lonnet::homeserver($touname,$toudom); |
| |
my $protocol = $Apache::lonnet::protocol{$homeserver}; |
| |
$protocol = 'http' if ($protocol ne 'https'); |
| |
my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver). |
| |
'/adm/email?username='.$touname.'&domain='.$toudom. |
| |
'&display='.&escape($msgid); |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, |
| |
$symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); |
| |
my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); |
| |
my $user_lh = &Apache::loncommon::user_lang($touname,$toudom,$fromcid); |
| |
if ($fromcid ne '') { |
| |
$coursetext = "\n".&mt_user($user_lh,'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 @recipients = split(/,/,$to); |
| |
$bodybegin = $coursetext. |
| |
&mt_user($user_lh, |
| |
'You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '; |
| |
$bodysubj = &mt_user($user_lh,'The subject is |
| |
|
| |
[_1] |
| |
|
| |
',$subj)."\n". |
| |
'=== '.&mt_user($user_lh,'Excerpt')." ============================================================ |
| |
"; |
| |
$bodyend = " |
| |
======================================================================== |
| |
|
| |
".&mt_user($user_lh,'Use |
| |
|
| |
[_1] |
| |
|
| |
to access the full message.',$url); |
| |
my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname); |
| |
my $subject = &mt_user($user_lh,"'New' $critical message from ").$sender; |
| |
|
| |
my ($blocked,$blocktext); |
| |
if (!$crit) { |
| |
my %setters; |
| |
my ($startblock,$endblock) = |
| |
&Apache::loncommon::blockcheck(\%setters,'com',$touname,$toudom); |
| |
if ($startblock && $endblock) { |
| |
$blocked = 1; |
| |
my $showstart = &Apache::lonlocal::locallocaltime($startblock); |
| |
my $showend = &Apache::lonlocal::locallocaltime($endblock); |
| |
$blocktext = &mt_user($user_lh,'LON-CAPA messages sent to you between [_1] and [_2] will be inaccessible until the end of this time period, because you are a student in a course with an active communications block.',$showstart,$showend); |
| |
} |
| |
} |
| |
if ($userenv{'notifywithhtml'} ne '') { |
| |
my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'}); |
| |
my $htmlfree = &make_htmlfree($text); |
| |
foreach my $addr (@recipients) { |
| |
if ($blocked) { |
| |
$body = $bodybegin."\n".$blocktext."\n".$bodyend; |
| |
} else { |
| |
my $sendtext; |
| |
if (!grep/^\Q$addr\E/,@htmlexcerpt) { |
| |
$sendtext = $htmlfree; |
| |
} else { |
| |
$sendtext = $text; |
| |
} |
| |
$body = $bodybegin.$bodysubj.$sendtext.$bodyend; |
| |
} |
| |
&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh); |
| |
} |
| |
} else { |
| |
if ($blocked) { |
| |
$body = $bodybegin."\n".$blocktext."\n".$bodyend; |
| |
} else { |
| |
my $htmlfree = &make_htmlfree($text); |
| |
$body = $bodybegin.$bodysubj.$htmlfree.$bodyend; |
| |
} |
| |
&sendemail($to,$subject,$body,$touname,$toudom,$user_lh); |
| |
} |
| |
} |
| |
|
| |
sub make_htmlfree { |
| |
my ($text) = @_; |
| |
$text =~ s/\<\/*[^\>]+\>//gs; |
| |
$text = &HTML::Entities::decode($text); |
| |
$text = &Encode::encode('utf8',$text); |
| |
return $text; |
| |
} |
| |
|
| |
sub mynewmail{ |
| |
&newmail(); |
| |
return $env{'user.mailcheck.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'}; |
| |
} |
| |
|
| |
|
| |
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.lastnewmessagetime'=> $what{'recnewemail'}}); |
| |
if ($what{'recnewemail'}>0) { return 1; } |
| |
} |
| |
return 0; |
| |
} |
| |
|
| |
|
| |
|
| sub author_res_msg { |
sub author_res_msg { |
| my ($filename,$message)=@_; |
my ($filename,$message)=@_; |
|
Line 78 sub author_res_msg {
|
Line 602 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'; |
| } |
} |
| |
|
| # ================================================== Critical message to a user |
|
| |
|
| sub user_crit_msg { |
|
| my ($user,$domain,$subject,$message)=@_; |
sub retrieve_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
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{$_}); |
| |
$msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'. |
| |
$content{'time'}.'</b>: '.$content{'message'}. |
| |
'<br /></p>'; |
| |
} |
| |
} |
| |
return $msgs; |
| |
} |
| |
|
| |
|
| |
|
| |
|
| |
|
| |
sub del_url_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
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,$_); |
| |
} |
| |
} |
| |
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); |
| |
} |
| |
|
| |
|
| |
sub clear_author_res_msg { |
| |
my $url=shift; |
| |
$url=&Apache::lonnet::declutter($url); |
| |
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,$_); |
| |
} |
| |
} |
| |
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); |
| |
} |
| |
|
| |
|
| |
|
| |
sub all_url_author_res_msg { |
| |
my ($author,$domain)=@_; |
| |
my %returnhash=(); |
| |
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { |
| |
$_=~/^(.+)\_\d+/; |
| |
$returnhash{$1}=1; |
| |
} |
| |
return %returnhash; |
| |
} |
| |
|
| |
|
| |
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,$sentmessage, |
| |
$nosentstore,$recipid,$attachmenturl)=@_; |
| # 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 $homeserver=&Apache::lonnet::homeserver($user,$domain); |
my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| my $msgid; |
($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef, |
| ($msgid,$message)=&packagemsg($subject,$message); |
$attachmenturl,undef,undef,undef,undef,undef, |
| $status=&Apache::lonnet::cput('critical',$msgid => $message); |
undef,undef,$recipid); |
| |
if ($sendback) { $packed_message.='<sendback>true</sendback>'; } |
| |
$status=&Apache::lonnet::cput('critical', {$msgid => $packed_message}, |
| |
$domain,$user); |
| |
if (defined($sentmessage)) { |
| |
$$sentmessage = $packed_message; |
| |
} |
| |
if (!$nosentstore) { |
| |
(undef,my $packed_message_no_citation) = |
| |
&packagemsg($subject,$message,undef,undef,$attachmenturl,$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 |
| |
my %userenv = &Apache::loncommon::getemails($user,$domain); |
| |
if ($userenv{'critnotification'}) { |
| |
&sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, |
| |
$text,$msgid); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
| |
$text,$msgid); |
| |
} |
| |
# Log this |
| &Apache::lonnet::logthis( |
&Apache::lonnet::logthis( |
| '<font color=yellow>INFO: Sending critical email '.$msgid. |
'Sending critical email '.$msgid. |
| ', log status: '. |
', log status: '. |
| &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 critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' |
'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' |
| .$status).'</font>'); |
.$status)); |
| return $status; |
return $status; |
| } |
} |
| |
|
| # =================================================== Critical message received |
|
| |
|
| sub user_crit_received { |
|
| my $message=shift; |
|
| |
|
| |
sub user_crit_msg { |
| |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, |
| |
$nosentstore,$recipid,$attachmenturl)=@_; |
| |
my @status; |
| |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
| |
$domain,$user); |
| |
my $msgforward=$userenv{'msgforward'}; |
| |
if ($msgforward) { |
| |
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)); |
| |
} |
| |
} else { |
| |
push(@status, |
| |
&user_crit_msg_raw($user,$domain,$subject,$message,$sendback, |
| |
$toperm,$sentmessage,$nosentstore,$recipid, |
| |
$attachmenturl)); |
| |
} |
| |
if (wantarray) { |
| |
return @status; |
| |
} |
| |
return join(' ',@status); |
| } |
} |
| |
|
| # ======================================================== Normal communication |
|
| |
|
| sub user_normal_msg { |
sub user_crit_received { |
| my ($user,$domain,$subject,$message)=@_; |
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($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}}); |
| |
$status.=' del: '. |
| |
&Apache::lonnet::del('critical',[$contents{'msgid'}]); |
| |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| |
$env{'user.home'},'Received critical message '. |
| |
$contents{'msgid'}. |
| |
', '.$status); |
| |
return $status; |
| |
} |
| |
|
| |
|
| |
|
| |
|
| |
sub user_normal_msg_raw { |
| |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, |
| |
$error,$nosentstore,$recipid)=@_; |
| # Check if allowed missing |
# Check if allowed missing |
| my $status=''; |
my ($status,$packed_message); |
| my $msgid='undefined'; |
my $msgid='undefined'; |
| |
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') { |
| my $msgid; |
($msgid,$packed_message)= |
| ($msgid,$message)=&packagemsg($subject,$message); |
&packagemsg($subject,$message,$citation,$baseurl, |
| $status=&Apache::lonnet::cput('nohist_email',$msgid => $message); |
$attachmenturl,$user,$domain,$currid, |
| } else { |
undef,$crsmsgid,$symb,$error,$recipid); |
| |
|
| |
# Store in user folder |
| |
$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 if sent mail storage required |
| |
if (!$nosentstore) { |
| |
(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 (ref($newid) eq 'SCALAR') { |
| |
$$newid = $msgid; |
| |
} |
| |
if (ref($sentmessage) eq 'SCALAR') { |
| |
$$sentmessage = $packed_message; |
| |
} |
| |
# Notifications |
| |
my %userenv = &Apache::loncommon::getemails($user,$domain); |
| |
if ($userenv{'notification'}) { |
| |
&sendnotification($userenv{'notification'},$user,$domain,$subject,0, |
| |
$text,$msgid); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
if ((!$userenv{'notification'}) || ($userenv{'notification'} ne $userenv{'permanentemail'})) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, |
| |
$text,$msgid); |
| |
} |
| |
} |
| |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| |
$env{'user.home'}, |
| |
'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
| |
} else { |
| $status='no_host'; |
$status='no_host'; |
| |
} |
| |
return $status; |
| |
} |
| |
|
| |
sub user_normal_msg { |
| |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; |
| |
my @status; |
| |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
| |
$domain,$user); |
| |
my $msgforward=$userenv{'msgforward'}; |
| |
if ($msgforward) { |
| |
foreach (split(/\,/,$msgforward)) { |
| |
my ($forwuser,$forwdomain)=split(/\:/,$_); |
| |
push(@status, |
| |
&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, |
| |
$citation,$baseurl,$attachmenturl,$toperm, |
| |
undef,undef,$sentmessage,undef,$symb, |
| |
$restitle,$error,$nosentstore,$recipid)); |
| |
} |
| |
} else { |
| |
push(@status,&user_normal_msg_raw($user,$domain,$subject,$message, |
| |
$citation,$baseurl,$attachmenturl,$toperm, |
| |
undef,undef,$sentmessage,undef,$symb, |
| |
$restitle,$error,$nosentstore,$recipid)); |
| |
} |
| |
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 { |
| |
if ($subj_prefix) { |
| |
$sentsubj = $subj_prefix.' '; |
| |
} |
| |
$sentsubj .= $msgsubj; |
| } |
} |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
$sentsubj = &HTML::Entities::encode($sentsubj,'<>&"'); |
| $ENV{'user.home'}, |
my $sentmsgid = |
| 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
&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; |
return $status; |
| } |
} |
| |
|
| # ================================================= Main program, reset counter |
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 BEGIN { |
sub store_recipients { |
| $msgcount=0; |
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 { |
| |
return (undef,$status); |
| |
} |
| } |
} |
| |
|
| 1; |
|
| __END__ |
|
| |
|
| |
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 { |
| |
$suffix = '_'.&escape($folder); |
| |
} |
| |
return $suffix; |
| |
} |
| |
|
| |
|
| |
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; |
| |
} |
| |
} |
| |
} |
| |
} else { |
| |
return $rec; |
| |
} |
| |
return ''; |
| |
} |
| |
|
| |
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<br />'; |
| |
$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').'<br />'; |
| |
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').'<br />'; |
| |
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').'<br />'; |
| |
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); |
| |
} |
| |
return ($typestyle,%to); |
| |
} |
| |
|
| |
1; |
| |
__END__ |
| |
|
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmsg.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface