|
version 1.28, 2002/02/16 19:59:10
|
version 1.192, 2006/12/27 18:00:00
|
|
Line 25
|
Line 25
|
| # |
# |
| # http://www.lon-capa.org/ |
# http://www.lon-capa.org/ |
| # |
# |
| # |
|
| # (Routines to control the menu |
|
| # |
|
| # (TeX Conversion Module |
|
| # |
|
| # 05/29/00,05/30 Gerd Kortemeyer) |
|
| # |
|
| # 10/05 Gerd Kortemeyer) |
|
| # |
|
| # 10/19,10/20,10/30, |
|
| # 02/06/01 Gerd Kortemeyer |
|
| # 07/27 Guy Albertelli |
|
| # 07/27,07/28,07/30,08/03,08/06,08/08,08/09,08/10,8/13,8/15, |
|
| # 10/1,11/5 Gerd Kortemeyer |
|
| # YEAR=2002 |
|
| # 1/1 Gerd Kortemeyer |
|
| # |
|
| package Apache::lonmsg; |
package Apache::lonmsg; |
| |
|
| use strict; |
use strict; |
| use Apache::lonnet(); |
use Apache::lonnet; |
| use vars qw($msgcount); |
use HTML::TokeParser(); |
| use HTML::TokeParser; |
use Apache::lonlocal; |
| use Apache::Constants qw(:common); |
use Mail::Send; |
| |
use LONCAPA qw(:DEFAULT :match); |
| |
|
| |
{ |
| |
my $uniq; |
| |
sub get_uniq { |
| |
$uniq++; |
| |
return $uniq; |
| |
} |
| |
} |
| |
|
| # ===================================================================== Package |
# ===================================================================== Package |
| |
|
| sub packagemsg { |
sub packagemsg { |
| my ($subject,$message,$citation)=@_; |
my ($subject,$message,$citation,$baseurl,$attachmenturl, |
| $message=~s/\</\<\;/g; |
$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_; |
| $message=~s/\>/\>\;/g; |
$message =&HTML::Entities::encode($message,'<>&"'); |
| $citation=~s/\</\<\;/g; |
$citation=&HTML::Entities::encode($citation,'<>&"'); |
| $citation=~s/\>/\>\;/g; |
$subject =&HTML::Entities::encode($subject,'<>&"'); |
| $subject=~s/\</\<\;/g; |
#remove machine specification |
| $subject=~s/\>/\>\;/g; |
$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 $now=time; |
| $msgcount++; |
my $msgcount = &get_uniq(); |
| my $partsubj=$subject; |
unless(defined($msgid)) { |
| $partsubj=&Apache::lonnet::escape($partsubj); |
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, |
| my $msgid=&Apache::lonnet::escape( |
$msgcount,$course_context,$symb,$error,$$); |
| $now.':'.$partsubj.':'.$ENV{'user.name'}.':'. |
} |
| $ENV{'user.domain'}.':'.$msgcount.':'.$$); |
my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. |
| return $msgid, |
'<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. |
| '<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>'; |
| '<citation>'.$citation.'</citation>'; |
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 |
# ================================================== Unpack message into a hash |
| |
|
| sub unpackagemsg { |
sub unpackagemsg { |
| my $message=shift; |
my ($message,$notoken)=@_; |
| my %content=(); |
my %content=(); |
| my $parser=HTML::TokeParser->new(\$message); |
my $parser=HTML::TokeParser->new(\$message); |
| my $token; |
my $token; |
|
Line 99 sub unpackagemsg {
|
Line 159 sub unpackagemsg {
|
| if ($token->[0] eq 'S') { |
if ($token->[0] eq 'S') { |
| my $entry=$token->[1]; |
my $entry=$token->[1]; |
| my $value=$parser->get_text('/'.$entry); |
my $value=$parser->get_text('/'.$entry); |
| $content{$entry}=$value; |
if (($entry eq 'recuser') || ($entry eq 'recdomain')) { |
| |
push(@{$content{$entry}},$value); |
| |
} elsif ($entry eq 'recipient') { |
| |
my $username = $token->[2]{'username'}; |
| |
$username = &HTML::Entities::decode($username,'<>&"'); |
| |
$content{$entry}{$username} = $value; |
| |
} else { |
| |
$content{$entry}=$value; |
| |
} |
| |
} |
| |
} |
| |
if (!exists($content{'recuser'})) { $content{'recuser'} = []; } |
| |
if ($content{'attachmenturl'}) { |
| |
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; |
|
Line 107 sub unpackagemsg {
|
Line 188 sub unpackagemsg {
|
| |
|
| # ======================================================= Get info out of msgid |
# ======================================================= Get info out of msgid |
| |
|
| |
sub buildmsgid { |
| |
my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; |
| |
$subject=&escape($subject); |
| |
$symb = &escape($symb); |
| |
return(&escape($now.':'.$subject.':'.$uname.':'. |
| |
$udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error)); |
| |
} |
| |
|
| sub unpackmsgid { |
sub unpackmsgid { |
| my $msgid=&Apache::lonnet::unescape(shift); |
my ($msgid,$folder,$skipstatus,$status_cache)=@_; |
| my ($sendtime,$shortsubj,$fromname,$fromdomain)=split(/\:/, |
$msgid=&unescape($msgid); |
| &Apache::lonnet::unescape($msgid)); |
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, |
| my %status=&Apache::lonnet::get('email_status',[$msgid]); |
$processid,$symb,$error) = split(/\:/,&unescape($msgid)); |
| if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } |
$shortsubj = &unescape($shortsubj); |
| unless ($status{$msgid}) { $status{$msgid}='new'; } |
$shortsubj = &HTML::Entities::decode($shortsubj); |
| return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid}); |
$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'; } |
unless ($message) { return 'empty'; } |
|
Line 127 sub author_res_msg {
|
Line 303 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'; |
| } |
} |
| |
|
| |
# =========================================== 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 { |
sub user_crit_msg_raw { |
| my ($user,$domain,$subject,$message,$sendback)=@_; |
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; |
| # Check if allowed missing |
# Check if allowed missing |
| my $status=''; |
my ($status,$packed_message); |
| my $msgid='undefined'; |
my $msgid='undefined'; |
| unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
| |
my $text=$message; |
| my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| ($msgid,$message)=&packagemsg($subject,$message); |
($msgid,$packed_message)=&packagemsg($subject,$message); |
| if ($sendback) { $message.='<sendback>true</sendback>'; } |
if ($sendback) { $packed_message.='<sendback>true</sendback>'; } |
| $status=&Apache::lonnet::critical( |
$status=&Apache::lonnet::critical( |
| 'put:'.$domain.':'.$user.':critical:'. |
'put:'.$domain.':'.$user.':critical:'. |
| &Apache::lonnet::escape($msgid).'='. |
&escape($msgid).'='. |
| &Apache::lonnet::escape($message),$homeserver); |
&escape($packed_message),$homeserver); |
| |
if (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 { |
} 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); |
| |
} |
| |
if ($toperm && $userenv{'permanentemail'}) { |
| |
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, |
| |
$text); |
| |
} |
| |
# Log this |
| &Apache::lonnet::logthis( |
&Apache::lonnet::logthis( |
| '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)); |
.$status)); |
| return $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 { |
| |
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); |
| |
} |
| |
|
| # =================================================== Critical message received |
# =================================================== Critical message received |
| |
|
| sub user_crit_received { |
sub user_crit_received { |
| my $msgid=shift; |
my $msgid=shift; |
| my %message=&Apache::lonnet::get('critical',[$msgid]); |
my %message=&Apache::lonnet::get('critical',[$msgid]); |
| my %contents=&unpackagemsg($message{$msgid}); |
my %contents=&unpackagemsg($message{$msgid},1); |
| my $status='rec: '.($contents{'sendback'}? |
my $status='rec: '.($contents{'sendback'}? |
| &user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, |
&user_normal_msg($contents{'sendername'},$contents{'senderdomain'}, |
| 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}, |
&mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'}, |
| 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}. |
&mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}. |
| ' acknowledged receipt of message "'. |
' acknowledged receipt of message'."\n".' "'. |
| $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n" |
$contents{'subject'}.'"'."\n".&mt('dated').' '. |
| .'Message ID: '.$contents{'msgid'}):'no msg req'); |
$contents{'time'}.".\n" |
| |
):'no msg req'); |
| $status.=' trans: '. |
$status.=' trans: '. |
| &Apache::lonnet::put( |
&Apache::lonnet::put( |
| 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); |
'nohist_email',{$contents{'msgid'} => $message{$msgid}}); |
| $status.=' del: '. |
$status.=' del: '. |
| &Apache::lonnet::del('critical',[$contents{'msgid'}]); |
&Apache::lonnet::del('critical',[$contents{'msgid'}]); |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, |
| $ENV{'user.home'},'Received critical message '. |
$env{'user.home'},'Received critical message '. |
| $contents{'msgid'}. |
$contents{'msgid'}. |
| ', '.$status); |
', '.$status); |
| return $status; |
return $status; |
|
Line 193 sub user_crit_received {
|
Line 506 sub user_crit_received {
|
| |
|
| # ======================================================== Normal communication |
# ======================================================== Normal communication |
| |
|
| sub user_normal_msg { |
sub user_normal_msg_raw { |
| my ($user,$domain,$subject,$message,$citation)=@_; |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| |
$toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, |
| |
$error)=@_; |
| # Check if allowed missing |
# Check if allowed missing |
| my $status=''; |
my ($status,$packed_message); |
| my $msgid='undefined'; |
my $msgid='undefined'; |
| |
my $text=$message; |
| unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
unless (($message)&&($user)&&($domain)) { $status='empty'; }; |
| my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
my $homeserver=&Apache::lonnet::homeserver($user,$domain); |
| if ($homeserver ne 'no_host') { |
if ($homeserver ne 'no_host') { |
| ($msgid,$message)=&packagemsg($subject,$message,$citation); |
($msgid,$packed_message)= |
| |
&packagemsg($subject,$message,$citation,$baseurl, |
| |
$attachmenturl,$user,$domain,$currid, |
| |
undef,$crsmsgid,$symb,$error); |
| |
|
| |
# Store in user folder |
| $status=&Apache::lonnet::critical( |
$status=&Apache::lonnet::critical( |
| 'put:'.$domain.':'.$user.':nohist_email:'. |
'put:'.$domain.':'.$user.':nohist_email:'. |
| &Apache::lonnet::escape($msgid).'='. |
&escape($msgid).'='. |
| &Apache::lonnet::escape($message),$homeserver); |
&escape($packed_message),$homeserver); |
| |
# Save new message received time |
| |
&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 { |
} else { |
| $status='no_host'; |
$status='no_host'; |
| } |
} |
| &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'}, |
if (defined($newid)) { |
| $ENV{'user.home'}, |
$$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); |
'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); |
| return $status; |
return $status; |
| } |
} |
| |
|
| # =============================================================== Status Change |
# New routine that respects "forward" and calls old routine |
| |
|
| sub statuschange { |
=pod |
| my ($msgid,$newstatus)=@_; |
|
| my %status=&Apache::lonnet::get('email_status',[$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',{$msgid => $newstatus}); |
|
| } |
|
| if (($newstatus eq 'deleted') || ($newstatus eq 'new')) { |
|
| &Apache::lonnet::put('email_status',{$msgid => $newstatus}); |
|
| } |
|
| } |
|
| |
|
| # ======================================================= Display a course list |
=item * B<user_normal_msg($user, $domain, $subject, $message, $citation, |
| |
$baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>: |
| sub discourse { |
Sends a message to the $user at $domain, with subject $subject and message $message. |
| my $r=shift; |
|
| my %courselist=&Apache::lonnet::dump( |
|
| 'classlist', |
|
| $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, |
|
| $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); |
|
| my $now=time; |
|
| $r->print(<<ENDDISHEADER); |
|
| <input type=hidden name=sendmode value=group> |
|
| <script> |
|
| function checkall() { |
|
| for (i=0; i<document.forms.compemail.elements.length; i++) { |
|
| if |
|
| (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) { |
|
| document.forms.compemail.elements[i].checked=true; |
|
| } |
|
| } |
|
| } |
|
| |
|
| function checksec() { |
=cut |
| for (i=0; i<document.forms.compemail.elements.length; i++) { |
|
| if |
|
| (document.forms.compemail.elements[i].name.indexOf |
|
| ('send_to_&&&'+document.forms.compemail.chksec.value)==0) { |
|
| document.forms.compemail.elements[i].checked=true; |
|
| } |
|
| } |
|
| } |
|
| |
|
| function uncheckall() { |
sub user_normal_msg { |
| for (i=0; i<document.forms.compemail.elements.length; i++) { |
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, |
| if |
$toperm,$sentmessage,$symb,$restitle,$error)=@_; |
| (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) { |
my $status=''; |
| document.forms.compemail.elements[i].checked=false; |
my %userenv = &Apache::lonnet::get('environment',['msgforward'], |
| } |
$domain,$user); |
| } |
my $msgforward=$userenv{'msgforward'}; |
| } |
if ($msgforward) { |
| </script> |
foreach (split(/\,/,$msgforward)) { |
| <input type=button onClick="checkall()" value="Check for All"> |
my ($forwuser,$forwdomain)=split(/\:/,$_); |
| <input type=button onClick="checksec()" value="Check for Section/Group"> |
$status.= |
| <input type=text size=5 name=chksec> |
&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, |
| <input type=button onClick="uncheckall()" value="Check for None"> |
$citation,$baseurl,$attachmenturl,$toperm, |
| <p> |
undef,undef,$sentmessage,undef,$symb,$restitle,$error).' '; |
| ENDDISHEADER |
|
| foreach (sort keys %courselist) { |
|
| my ($end,$start)=split(/\:/,$courselist{$_}); |
|
| my $active=1; |
|
| if (($end) && ($now>$end)) { $active=0; } |
|
| if ($active) { |
|
| my ($sname,$sdom)=split(/\:/,$_); |
|
| my %reply=&Apache::lonnet::get('environment', |
|
| ['firstname','middlename','lastname','generation'], |
|
| $sdom,$sname); |
|
| my $section=&Apache::lonnet::usection |
|
| ($sdom,$sname,$ENV{'request.course.id'}); |
|
| $r->print( |
|
| '<br><input type=checkbox name="send_to_&&&'.$section.'&&&_'.$_.'"> '. |
|
| $reply{'firstname'}.' '. |
|
| $reply{'middlename'}.' '. |
|
| $reply{'lastname'}.' '. |
|
| $reply{'generation'}. |
|
| ' ('.$_.') '.$section); |
|
| } |
|
| } |
|
| } |
|
| |
|
| # ==================================================== Display Critical Message |
|
| |
|
| sub discrit { |
|
| my $r=shift; |
|
| $r->print('<h1><font color=red>Critical Messages</font></h1>'. |
|
| '<form action=/adm/email method=post>'. |
|
| '<input type=hidden name=confirm value=true>'); |
|
| my %what=&Apache::lonnet::dump('critical'); |
|
| foreach (sort keys %what) { |
|
| my %content=&unpackagemsg($what{$_}); |
|
| $content{'message'}=~s/\n/\<br\>/g; |
|
| $r->print('<hr>From: <b>'.$content{'sendername'}.'@'. |
|
| $content{'senderdomain'}.'</b> ('.$content{'time'}. |
|
| ')<br><blockquote>'.$content{'message'}.'</blockquote>'. |
|
| '<input type=submit name="rec_'.$_.'" value="Confirm Receipt">'. |
|
| '<input type=submit name="reprec_'.$_.'" value="Confirm Receipt and Reply">'); |
|
| } |
|
| $r->print( |
|
| '<input type=hidden name="displayedcrit" value="true"></form>'); |
|
| } |
|
| |
|
| # =============================================================== Compose reply |
|
| |
|
| sub comprep { |
|
| my ($r,$msgid)=@_; |
|
| my %message=&Apache::lonnet::get('nohist_email',[$msgid]); |
|
| my %content=&unpackagemsg($message{$msgid}); |
|
| my $quotemsg='> '.$content{'message'}; |
|
| $quotemsg=~s/\r/\n/g; |
|
| $quotemsg=~s/\f/\n/g; |
|
| $quotemsg=~s/\n+/\n\> /g; |
|
| my $subject='Re: '.$content{'subject'}; |
|
| my $dispcrit=''; |
|
| if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
|
| $dispcrit= |
|
| '<input type=checkbox name=critmsg> Send as critical message<br>'. |
|
| '<input type=checkbox name=sendbck> Send as critical message'. |
|
| ' and return receipt<p>'; |
|
| } |
|
| $r->print(<<"ENDREPLY"); |
|
| <form action="/adm/email" method=post> |
|
| <input type=hidden name=sendreply value="$msgid"> |
|
| Subject: <input type=text size=50 name=subject value="$subject"><p> |
|
| <textarea name=message cols=64 rows=10 wrap=hard> |
|
| $quotemsg |
|
| </textarea><p> |
|
| $dispcrit |
|
| <input type=submit value="Send Reply"> |
|
| </form> |
|
| ENDREPLY |
|
| } |
|
| |
|
| # ======================================================== Display all messages |
|
| |
|
| sub disall { |
|
| my $r=shift; |
|
| $r->print( |
|
| '<h1>Display All Messages</h1><form method=post action="/adm/email">'. |
|
| '<table border=2><tr><th colspan=2> </th><th>Date</th>'. |
|
| '<th>Username</th><th>Domain</th><th>Subject</th><th>Status</th></tr>'); |
|
| foreach (sort split(/\&/,&Apache::lonnet::reply('keys:'. |
|
| $ENV{'user.domain'}.':'. |
|
| $ENV{'user.name'}.':nohist_email', |
|
| $ENV{'user.home'}))) { |
|
| my ($sendtime,$shortsubj,$fromname,$fromdomain,$status)= |
|
| &Apache::lonmsg::unpackmsgid($_); |
|
| unless ($status eq 'deleted') { |
|
| if ($status eq 'new') { |
|
| $r->print('<tr bgcolor="#FFBB77">'); |
|
| } elsif ($status eq 'read') { |
|
| $r->print('<tr bgcolor="#BBBB77">'); |
|
| } elsif ($status eq 'replied') { |
|
| $r->print('<tr bgcolor="#AAAA88">'); |
|
| } else { |
|
| $r->print('<tr bgcolor="#99BBBB">'); |
|
| } |
} |
| $r->print('<td><a href="/adm/email?display='.$_. |
} else { |
| '">Open</a></td><td><a href="/adm/email?markdel='.$_. |
$status=&user_normal_msg_raw($user,$domain,$subject,$message, |
| '">Delete</a><input type=checkbox name="delmark_'.$_.'"></td>'. |
$citation,$baseurl,$attachmenturl,$toperm, |
| '<td>'.localtime($sendtime).'</td><td>'. |
undef,undef,$sentmessage,undef,$symb,$restitle,$error); |
| $fromname.'</td><td>'.$fromdomain.'</td><td>'. |
|
| &Apache::lonnet::unescape($shortsubj).'</td><td>'. |
|
| $status.'</td></tr>'); |
|
| } |
|
| } |
|
| $r->print('</table><p>'. |
|
| '<input type=submit name="markeddel" value="Delete Checked">'. |
|
| '</form></body></html>'); |
|
| } |
|
| |
|
| # ============================================================== Compose output |
|
| |
|
| sub compout { |
|
| my ($r,$forwarding,$broadcast)=@_; |
|
| my $dispcrit=''; |
|
| my $dissub=''; |
|
| my $dismsg=''; |
|
| my $func='Send New'; |
|
| if (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'})) { |
|
| $dispcrit= |
|
| '<input type=checkbox name=critmsg> Send as critical message<br>'. |
|
| '<input type=checkbox name=sendbck> Send as critical message'. |
|
| ' and return receipt<p>'; |
|
| } |
|
| if ($forwarding) { |
|
| $dispcrit.='<input type=hidden name=forwid value="'. |
|
| $forwarding.'">'; |
|
| $func='Forward'; |
|
| my %message=&Apache::lonnet::get('nohist_email',[$forwarding]); |
|
| my %content=&unpackagemsg($message{$forwarding}); |
|
| |
|
| $dissub='Forwarding: '.$content{'subject'}; |
|
| $dismsg='Forwarded message from '. |
|
| $content{'sendername'}.' at '.$content{'senderdomain'}; |
|
| } |
|
| my $defdom=$ENV{'user.domain'}; |
|
| $r->print( |
|
| '<form action="/adm/email" name="compemail" method=post'. |
|
| ' enctype="multipart/form-data">'. |
|
| '<input type=hidden name=sendmail value=on><table>'); |
|
| unless (($broadcast eq 'group') || ($broadcast eq 'upload')) { |
|
| $r->print(<<"ENDREC"); |
|
| <table> |
|
| <tr><td>Username:</td><td><input type=text size=12 name=recuname></td></tr> |
|
| <tr><td>Domain:</td> |
|
| <td><input type=text size=12 name=recdomain value="$defdom"></td></tr> |
|
| ENDREC |
|
| } |
|
| unless ($broadcast eq 'upload') { |
|
| $r->print(<<"ENDCOMP"); |
|
| <tr><td>Additional Recipients<br><tt>username\@domain,username\@domain, ... |
|
| </tt></td><td> |
|
| <input type=text size=50 name=additionalrec></td></tr> |
|
| <tr><td>Subject:</td><td><input type=text size=50 name=subject value="$dissub"> |
|
| </td></tr></table> |
|
| <textarea name=message cols=60 rows=10 wrap=hard>$dismsg |
|
| </textarea><p> |
|
| $dispcrit |
|
| <input type=submit value="$func Mail"> |
|
| ENDCOMP |
|
| } |
|
| if ($broadcast eq 'upload') { |
|
| $r->print(<<ENDUPLOAD); |
|
| <input type=hidden name=sendmode value=upload> |
|
| <h3>Generate messages from a file</h3> |
|
| Subject: <input type=text size=50 name=subject> |
|
| <pre> |
|
| username1\@domain1: text |
|
| username2\@domain2: text |
|
| username1\@domain1: text |
|
| </pre> |
|
| The messages will be assembled from all lines with the respective |
|
| <tt>username\@domain</tt>, and appended to the general message text.<p> |
|
| <input type=file name=upfile size=20><p> |
|
| General message text:<p> |
|
| <textarea name=message cols=60 rows=10 wrap=hard>$dismsg |
|
| </textarea><p> |
|
| $dispcrit |
|
| <input type=submit value="Upload and send"> |
|
| ENDUPLOAD |
|
| } |
|
| if ($broadcast eq 'group') { |
|
| &discourse; |
|
| } |
|
| $r->print('</form>'); |
|
| } |
|
| |
|
| # ===================================================================== Handler |
|
| |
|
| sub handler { |
|
| my $r=shift; |
|
| |
|
| # ----------------------------------------------------------- Set document type |
|
| |
|
| $r->content_type('text/html'); |
|
| $r->send_http_header; |
|
| |
|
| return OK if $r->header_only; |
|
| |
|
| # --------------------------- Get query string for limited number of parameters |
|
| |
|
| foreach (split(/&/,$ENV{'QUERY_STRING'})) { |
|
| my ($name, $value) = split(/=/,$_); |
|
| $value =~ tr/+/ /; |
|
| $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; |
|
| if (($name eq 'display') || ($name eq 'replyto') || |
|
| ($name eq 'forward') || ($name eq 'markread') || |
|
| ($name eq 'markdel') || ($name eq 'markunread') || |
|
| ($name eq 'sendreply') || ($name eq 'compose') || |
|
| ($name eq 'sendmail') || ($name eq 'critical')) { |
|
| unless ($ENV{'form.'.$name}) { |
|
| $ENV{'form.'.$name}=$value; |
|
| } |
|
| } |
|
| } |
} |
| |
return $status; |
| # --------------------------------------------------------------- Render Output |
|
| |
|
| $r->print('<html><head><title>EMail and Messaging</title></head>'); |
|
| $r->print( |
|
| '<body bgcolor="#FFFFFF"><img align=right src=/adm/lonIcons/lonlogos.gif>'); |
|
| $r->print('<h1>EMail</h1>'); |
|
| if ($ENV{'form.display'}) { |
|
| my $msgid=$ENV{'form.display'}; |
|
| &statuschange($msgid,'read'); |
|
| my %message=&Apache::lonnet::get('nohist_email',[$msgid]); |
|
| my %content=&unpackagemsg($message{$msgid}); |
|
| $r->print('<b>Subject:</b> '.$content{'subject'}. |
|
| '<br><b>From:</b> '.$content{'sendername'}.' at '. |
|
| $content{'senderdomain'}. |
|
| '<br><b>Time:</b> '.$content{'time'}.'<p>'. |
|
| '<table border=2><tr bgcolor="#FFFFAA"><td>Functions:</td>'. |
|
| '<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Reply</b></a></td>'. |
|
| '<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Forward</b></a></td>'. |
|
| '<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid). |
|
| '"><b>Mark Unread</b></a></td>'. |
|
| '<td><a href="/adm/email"><b>Display all Messages</b></a></td>'. |
|
| '</tr></table><p><pre>'. |
|
| $content{'message'}.'</pre><hr>'.$content{'citation'}); |
|
| } elsif ($ENV{'form.replyto'}) { |
|
| &comprep($r,$ENV{'form.replyto'}); |
|
| } elsif ($ENV{'form.sendreply'}) { |
|
| my $msgid=$ENV{'form.sendreply'}; |
|
| my %message=&Apache::lonnet::get('nohist_email',[$msgid]); |
|
| my %content=&unpackagemsg($message{$msgid}); |
|
| &statuschange($msgid,'replied'); |
|
| if ((($ENV{'form.critmsg'}) || ($ENV{'form.sendbck'})) && |
|
| (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) { |
|
| $r->print('Sending critical: '. |
|
| &user_crit_msg($content{'sendername'}, |
|
| $content{'senderdomain'}, |
|
| $ENV{'form.subject'}, |
|
| $ENV{'form.message'}, |
|
| $ENV{'form.sendbck'})); |
|
| } else { |
|
| $r->print('Sending: '.&user_normal_msg($content{'sendername'}, |
|
| $content{'senderdomain'}, |
|
| $ENV{'form.subject'}, |
|
| $ENV{'form.message'})); |
|
| } |
|
| if ($ENV{'form.displayedcrit'}) { |
|
| &discrit($r); |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| } elsif ($ENV{'form.confirm'}) { |
|
| foreach (keys %ENV) { |
|
| if ($_=~/^form\.rec\_(.*)$/) { |
|
| $r->print('<b>Confirming Receipt:</b> '. |
|
| &user_crit_received($1).'<br>'); |
|
| } |
|
| if ($_=~/^form\.reprec\_(.*)$/) { |
|
| my $msgid=$1; |
|
| $r->print('<b>Confirming Receipt:</b> '. |
|
| &user_crit_received($msgid).'<br>'); |
|
| &comprep($r,$msgid); |
|
| } |
|
| } |
|
| &discrit($r); |
|
| } elsif ($ENV{'form.critical'}) { |
|
| &discrit($r); |
|
| } elsif ($ENV{'form.forward'}) { |
|
| &compout($r,$ENV{'form.forward'}); |
|
| } elsif ($ENV{'form.markread'}) { |
|
| } elsif ($ENV{'form.markdel'}) { |
|
| &statuschange($ENV{'form.markdel'},'deleted'); |
|
| &disall($r); |
|
| } elsif ($ENV{'form.markeddel'}) { |
|
| my $total=0; |
|
| foreach (keys %ENV) { |
|
| if ($_=~/^form\.delmark_(.*)$/) { |
|
| &statuschange(&Apache::lonnet::unescape($1),'deleted'); |
|
| $total++; |
|
| } |
|
| } |
|
| $r->print('Deleted '.$total.' message(s)<p>'); |
|
| &disall($r); |
|
| } elsif ($ENV{'form.markunread'}) { |
|
| &statuschange($ENV{'form.markunread'},'new'); |
|
| &disall($r); |
|
| } elsif ($ENV{'form.compose'}) { |
|
| &compout($r,'',$ENV{'form.compose'}); |
|
| } elsif ($ENV{'form.sendmail'}) { |
|
| my %content=(); |
|
| undef %content; |
|
| if ($ENV{'form.forwid'}) { |
|
| my $msgid=$ENV{'form.forwid'}; |
|
| my %message=&Apache::lonnet::get('nohist_email',[$msgid]); |
|
| %content=&unpackagemsg($message{$msgid}); |
|
| &statuschange($msgid,'forwarded'); |
|
| $ENV{'form.message'}.="\n\n-- Forwarded message --\n\n". |
|
| $content{'message'}; |
|
| } |
|
| 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=$ENV{'form.message'}; |
|
| if ($toaddr{$_}) { $msgtxt.='<hr>'.$toaddr{$_}; } |
|
| if ((($ENV{'form.critmsg'}) || ($ENV{'form.sendbck'})) && |
|
| (&Apache::lonnet::allowed('srm',$ENV{'request.course.id'}))) { |
|
| $r->print('Sending critical: '. |
|
| &user_crit_msg($recuname,$recdomain, |
|
| $ENV{'form.subject'}, |
|
| $msgtxt, |
|
| $ENV{'form.sendbck'})); |
|
| } else { |
|
| $r->print('Sending: '.&user_normal_msg($recuname,$recdomain, |
|
| $ENV{'form.subject'}, |
|
| $msgtxt, |
|
| $content{'citation'})); |
|
| } |
|
| $r->print('<br>'); |
|
| } |
|
| if ($ENV{'form.displayedcrit'}) { |
|
| &discrit($r); |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| } else { |
|
| &disall($r); |
|
| } |
|
| $r->print('</body></html>'); |
|
| return OK; |
|
| |
|
| } |
} |
| # ================================================= Main program, reset counter |
|
| |
|
| BEGIN { |
sub store_sent_mail { |
| $msgcount=0; |
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; |
| } |
} |
| |
|
| 1; |
# =============================================================== Folder suffix |
| __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; |
| |
} |
| |
|
| |
# ========================================================= 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