|
version 1.1, 2000/10/19 14:20:17
|
version 1.192, 2006/12/27 18:00:00
|
|
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 Gerd Kortemeyer |
|
| |
|
| package Apache::lonmsg; |
package Apache::lonmsg; |
| |
|
| use strict; |
use strict; |
| use Apache::lonnet(); |
use Apache::lonnet; |
| |
use HTML::TokeParser(); |
| |
use Apache::lonlocal; |
| |
use Mail::Send; |
| |
use LONCAPA qw(:DEFAULT :match); |
| |
|
| |
{ |
| |
my $uniq; |
| |
sub get_uniq { |
| |
$uniq++; |
| |
return $uniq; |
| |
} |
| |
} |
| |
|
| # ===================================================================== Package |
# ===================================================================== Package |
| |
|
| sub package { |
sub packagemsg { |
| var ($subject,$message)=@_; |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
| $message=~s/\</\<\;/g; |
$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_; |
| $message=~s/\>/\>\;/g; |
$message =&HTML::Entities::encode($message,'<>&"'); |
| $subject=~s/\</\<\;/g; |
$citation=&HTML::Entities::encode($citation,'<>&"'); |
| $subject=~s/\>/\>\;/g; |
$subject =&HTML::Entities::encode($subject,'<>&"'); |
| return '<sendername>'.$ENV{'user.name'}.'</sendername>'. |
#remove machine specification |
| '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'. |
$baseurl =~ s|^http://[^/]+/|/|; |
| |
$baseurl =&HTML::Entities::encode($baseurl,'<>&"'); |
| |
#remove machine specification |
| |
$attachmenturl =~ s|^http://[^/]+/|/|; |
| |
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); |
| |
my $course_context; |
| |
if (defined($env{'form.replyid'})) { |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= |
| |
split(/\:/,&unescape($env{'form.replyid'})); |
| |
$course_context = $origcid; |
| |
} |
| |
foreach my $key (keys(%env)) { |
| |
if ($key=~/^form\.(rep)?rec\_(.*)$/) { |
| |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) = |
| |
split(/\:/,&unescape($2)); |
| |
$course_context = $origcid; |
| |
last; |
| |
} |
| |
} |
| |
unless(defined($course_context)) { |
| |
$course_context = $env{'request.course.id'}; |
| |
} |
| |
my $now=time; |
| |
my $msgcount = &get_uniq(); |
| |
unless(defined($msgid)) { |
| |
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, |
| |
$msgcount,$course_context,$symb,$error,$$); |
| |
} |
| |
my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. |
| |
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
| '<subject>'.$subject.'</subject>'. |
'<subject>'.$subject.'</subject>'. |
| '<time>'.localtime().'</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>'. |
| '<message>'.$message.'</message>'; |
'<resource>'.$env{'request.filename'}.'</resource>'. |
| |
'<msgid>'.$msgid.'</msgid>'; |
| |
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 (defined($course_context)) { |
| |
if ($course_context eq $env{'request.course.id'}) { |
| |
my $resource_title = &Apache::lonnet::gettitle($symb); |
| |
if (defined($resource_title)) { |
| |
$result .= '<resource_title>'.$resource_title.'</resource_title>'; |
| |
} |
| |
} |
| |
} |
| |
} |
| |
return ($msgid,$result); |
| |
} |
| |
|
| |
# ================================================== Unpack message into a hash |
| |
|
| |
sub unpackagemsg { |
| |
my ($message,$notoken)=@_; |
| |
my %content=(); |
| |
my $parser=HTML::TokeParser->new(\$message); |
| |
my $token; |
| |
while ($token=$parser->get_token) { |
| |
if ($token->[0] eq 'S') { |
| |
my $entry=$token->[1]; |
| |
my $value=$parser->get_text('/'.$entry); |
| |
if (($entry eq 'recuser') || ($entry eq 'recdomain')) { |
| |
push(@{$content{$entry}},$value); |
| |
} elsif ($entry eq 'recipient') { |
| |
my $username = $token->[2]{'username'}; |
| |
$username = &HTML::Entities::decode($username,'<>&"'); |
| |
$content{$entry}{$username} = $value; |
| |
} else { |
| |
$content{$entry}=$value; |
| |
} |
| |
} |
| |
} |
| |
if (!exists($content{'recuser'})) { $content{'recuser'} = []; } |
| |
if ($content{'attachmenturl'}) { |
| |
my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); |
| |
if ($notoken) { |
| |
$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; |
| |
} |
| |
|
| |
# ======================================================= 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,$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)=@_; |
| |
my %senderemails=&Apache::loncommon::getemails(); |
| |
my $senderaddress=''; |
| |
foreach my $type ('notification','permanentemail','critnotification') { |
| |
if ($senderemails{$type}) { |
| |
$senderaddress=$senderemails{$type}; |
| |
} |
| |
} |
| |
$body= |
| |
"*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n". |
| |
"*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ". |
| |
&mt('A reply will not be received by the recipient!'))."\n\n".$body; |
| |
my $msg = new Mail::Send; |
| |
$msg->to($to); |
| |
$msg->subject('[LON-CAPA] '.$subject); |
| |
if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); } |
| |
if (my $fh = $msg->open()) { |
| |
print $fh $body; |
| |
$fh->close; |
| |
} |
| |
} |
| |
|
| |
# ==================================================== Send notification emails |
| |
|
| |
sub sendnotification { |
| |
my ($to,$touname,$toudom,$subj,$crit,$text)=@_; |
| |
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; |
| |
$text=~s/\<\/*[^\>]+\>//gs; |
| |
my $url='http://'. |
| |
$Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}. |
| |
'/adm/email?username='.$touname.'&domain='.$toudom; |
| |
my $body=(<<ENDMSG); |
| |
You received a$critical message from $sender in LON-CAPA. The subject is |
| |
|
| |
$subj |
| |
|
| |
=== Excerpt ============================================================ |
| |
$text |
| |
======================================================================== |
| |
|
| |
Use |
| |
|
| |
$url |
| |
|
| |
to access the full message. |
| |
ENDMSG |
| |
&sendemail($to,'New'.$critical.' message from '.$sender,$body); |
| |
} |
| |
# ============================================================= 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); |
| |
if ($what{'recnewemail'}>0) { return 1; } |
| |
} |
| |
return 0; |
| } |
} |
| |
|
| # =============================== Automated message to the author of a resource |
# =============================== Automated message to the author of a resource |
| |
|
| |
=pod |
| |
|
| |
=item * B<author_res_msg($filename, $message)>: Sends message $message to the owner |
| |
of the resource with the URI $filename. |
| |
|
| |
=cut |
| |
|
| sub author_res_msg { |
sub author_res_msg { |
| my ($filename,$message)=@_; |
my ($filename,$message)=@_; |
| |
unless ($message) { return 'empty'; } |
| $filename=&Apache::lonnet::declutter($filename); |
$filename=&Apache::lonnet::declutter($filename); |
| my ($domain,$author,@dummy)=split(/\//,$filename); |
my ($domain,$author,@dummy)=split(/\//,$filename); |
| 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); |
| &Apache::lonnet::put('res_msgs',$filename.'_'.$id => package($message)); |
$message .= " <p>This error occurred on machine ". |
| |
$Apache::lonnet::perlvar{'lonHostID'}."</p>"; |
| |
my $msgid; |
| |
($msgid,$message)=&packagemsg($filename,$message); |
| |
return &Apache::lonnet::reply('put:'.$domain.':'.$author. |
| |
':nohist_res_msgs:'. |
| |
&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=~/^($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; |
| |
} |
| |
|
| |
|
| |
# =============================== 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=~/^($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); |
| |
} |
| |
# =================================== 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=~/^($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); |
| |
} |
| |
# ================= 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+/; |
| |
$returnhash{$1}=1; |
| |
} |
| |
return %returnhash; |
| |
} |
| |
|
| |
# ====================================== Add a comment to the User Notes screen |
| |
|
| |
sub store_instructor_comment { |
| |
my ($msg,$uname,$udom) = @_; |
| |
my $cid = $env{'request.course.id'}; |
| |
my $cnum = $env{'course.'.$cid.'.num'}; |
| |
my $cdom = $env{'course.'.$cid.'.domain'}; |
| |
my $subject= &mt('Record').' ['.$uname.':'.$udom.']'; |
| |
my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg); |
| |
return $result; |
| } |
} |
| |
|
| # ================================================== Critical message to a user |
# ================================================== Critical message to a user |
| |
|
| |
sub user_crit_msg_raw { |
| |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
| |
# Check if allowed missing |
| |
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,$packed_message)=&packagemsg($subject,$message); |
| |
if ($sendback) { $packed_message.='<sendback>true</sendback>'; } |
| |
$status=&Apache::lonnet::critical( |
| |
'put:'.$domain.':'.$user.':critical:'. |
| |
&escape($msgid).'='. |
| |
&escape($packed_message),$homeserver); |
| |
if (defined($sentmessage)) { |
| |
$$sentmessage = $packed_message; |
| |
} |
| |
(undef,my $packed_message_no_citation) = |
| |
&packagemsg($subject,$message,undef,undef,undef,$user,$domain, |
| |
$msgid); |
| |
$status .= &store_sent_mail($msgid,$packed_message_no_citation); |
| |
} else { |
| |
$status='no_host'; |
| |
} |
| |
|
| |
# Notifications |
| |
my %userenv = &Apache::loncommon::getemails($user,$domain); |
| |
if ($userenv{'critnotification'}) { |
| |
&sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, |
| |
$text); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
| |
$text); |
| |
} |
| |
# Log this |
| |
&Apache::lonnet::logthis( |
| |
'Sending critical email '.$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)); |
| |
return $status; |
| |
} |
| |
|
| |
# New routine that respects "forward" and calls old routine |
| |
|
| |
=pod |
| |
|
| |
=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: 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. |
| |
|
| |
Additionally it will check if the user has a Forwarding address |
| |
set, and send the message to that address instead |
| |
|
| |
returns |
| |
- in array context a list of results for each message that was sent |
| |
- in scalar context a space seperated list of results for each |
| |
message sent |
| |
|
| |
=cut |
| |
|
| sub user_crit_msg { |
sub user_crit_msg { |
| my ($user,$domain,$subject,$message)=@_; |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
| |
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)); |
| |
} |
| |
} else { |
| |
push(@status, |
| |
&user_crit_msg_raw($user,$domain,$subject,$message,$sendback, |
| |
$toperm,$sentmessage)); |
| |
} |
| |
if (wantarray) { |
| |
return @status; |
| |
} |
| |
return join(' ',@status); |
| } |
} |
| |
|
| 1; |
# =================================================== Critical message received |
| __END__ |
|
| |
|
| |
sub user_crit_received { |
| |
my $msgid=shift; |
| |
my %message=&Apache::lonnet::get('critical',[$msgid]); |
| |
my %contents=&unpackagemsg($message{$msgid},1); |
| |
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'); |
| |
$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; |
| |
} |
| |
|
| |
# ======================================================== Normal communication |
| |
|
| |
sub user_normal_msg_raw { |
| |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, |
| |
$error)=@_; |
| |
# Check if allowed missing |
| |
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,$packed_message)= |
| |
&packagemsg($subject,$message,$citation,$baseurl, |
| |
$attachmenturl,$user,$domain,$currid, |
| |
undef,$crsmsgid,$symb,$error); |
| |
|
| |
# Store in user folder |
| |
$status=&Apache::lonnet::critical( |
| |
'put:'.$domain.':'.$user.':nohist_email:'. |
| |
&escape($msgid).'='. |
| |
&escape($packed_message),$homeserver); |
| |
# Save new message received time |
| |
&Apache::lonnet::put |
| |
('email_status',{'recnewemail'=>time},$domain,$user); |
| |
# Into sent-mail folder unless a broadcast message or critical message |
| |
unless (($env{'request.course.id'}) && |
| |
(($env{'form.sendmode'} eq 'group') || |
| |
(($env{'form.critmsg'}) || ($env{'form.sendbck'})) && |
| |
(&Apache::lonnet::allowed('srm',$env{'request.course.id'}) |
| |
|| &Apache::lonnet::allowed('srm',$env{'request.course.id'}. |
| |
'/'.$env{'request.course.sec'})))) { |
| |
(undef,my $packed_message_no_citation) = |
| |
&packagemsg($subject,$message,undef,$baseurl,$attachmenturl, |
| |
$user,$domain,$currid,undef,$crsmsgid,$symb,$error); |
| |
$status .= &store_sent_mail($msgid,$packed_message_no_citation); |
| |
} |
| |
} else { |
| |
$status='no_host'; |
| |
} |
| |
if (defined($newid)) { |
| |
$$newid = $msgid; |
| |
} |
| |
if (defined($sentmessage)) { |
| |
$$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); |
| |
return $status; |
| |
} |
| |
|
| |
# New routine that respects "forward" and calls old routine |
| |
|
| |
=pod |
| |
|
| |
=item * B<user_normal_msg($user, $domain, $subject, $message, $citation, |
| |
$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>: |
| |
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,$sentmessage,$symb,$restitle,$error)=@_; |
| |
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, |
| |
undef,undef,$sentmessage,undef,$symb,$restitle,$error).' '; |
| |
} |
| |
} else { |
| |
$status=&user_normal_msg_raw($user,$domain,$subject,$message, |
| |
$citation,$baseurl,$attachmenturl,$toperm, |
| |
undef,undef,$sentmessage,undef,$symb,$restitle,$error); |
| |
} |
| |
return $status; |
| |
} |
| |
|
| |
sub store_sent_mail { |
| |
my ($msgid,$message) = @_; |
| |
my $status =' '.&Apache::lonnet::critical( |
| |
'put:'.$env{'user.domain'}.':'.$env{'user.name'}. |
| |
':nohist_email_sent:'. |
| |
&escape($msgid).'='. |
| |
&escape($message),$env{'user.home'}); |
| |
return $status; |
| |
} |
| |
|
| |
# =============================================================== Folder suffix |
| |
|
| |
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; |
| |
} |
| |
|
| |
# ========================================================= User-defined folders |
| |
|
| |
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; |
| |
} |
| |
|
| |
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