--- loncom/interface/lonmsg.pm 2006/04/08 06:53:37 1.180 +++ loncom/interface/lonmsg.pm 2006/12/27 20:42:12 1.193 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.180 2006/04/08 06:53:37 albertel Exp $ +# $Id: lonmsg.pm,v 1.193 2006/12/27 20:42:12 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -33,6 +33,7 @@ use Apache::lonnet; use HTML::TokeParser(); use Apache::lonlocal; use Mail::Send; +use LONCAPA qw(:DEFAULT :match); { my $uniq; @@ -46,7 +47,7 @@ use Mail::Send; sub packagemsg { my ($subject,$message,$citation,$baseurl,$attachmenturl, - $recuser,$recdomain,$msgid,$type,$crsmsgid)=@_; + $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_; $message =&HTML::Entities::encode($message,'<>&"'); $citation=&HTML::Entities::encode($citation,'<>&"'); $subject =&HTML::Entities::encode($subject,'<>&"'); @@ -59,13 +60,13 @@ sub packagemsg { my $course_context; if (defined($env{'form.replyid'})) { my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= - split(/\:/,&Apache::lonnet::unescape($env{'form.replyid'})); + 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(/\:/,&Apache::lonnet::unescape($2)); + split(/\:/,&unescape($2)); $course_context = $origcid; last; } @@ -77,7 +78,7 @@ sub packagemsg { my $msgcount = &get_uniq(); unless(defined($msgid)) { $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, - $msgcount,$course_context,$$); + $msgcount,$course_context,$symb,$error,$$); } my $result = ''.$env{'user.name'}.''. ''.$env{'user.domain'}.''. @@ -108,8 +109,8 @@ sub packagemsg { for (my $i=0; $i<@{$recuser}; $i++) { if ($type eq 'dcmail') { my ($username,$email) = split(/:/,$$recuser[$i]); - $username = &Apache::lonnet::unescape($username); - $email = &Apache::lonnet::unescape($email); + $username = &unescape($username); + $email = &unescape($email); $username = &HTML::Entities::encode($username,'<>&"'); $email = &HTML::Entities::encode($email,'<>&"'); $result .= ''. @@ -133,7 +134,18 @@ sub packagemsg { if (defined($attachmenturl)) { $result.= ''.$attachmenturl.''; } - return $msgid,$result; + if (defined($symb)) { + $result.= ''.$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.''; + } + } + } + } + return ($msgid,$result); } # ================================================== Unpack message into a hash @@ -177,17 +189,21 @@ sub unpackagemsg { # ======================================================= Get info out of msgid sub buildmsgid { - my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_; - $subject=&Apache::lonnet::escape($subject); - return(&Apache::lonnet::escape($now.':'.$subject.':'.$uname.':'. - $udom.':'.$msgcount.':'.$course_context.':'.$pid)); + 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=&Apache::lonnet::unescape($msgid); + $msgid=&unescape($msgid); my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, - $processid)=split(/\:/,&Apache::lonnet::unescape($msgid)); + $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) { @@ -200,18 +216,27 @@ sub unpackmsgid { if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } unless ($status{$msgid}) { $status{$msgid}='new'; } } - return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid); + 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". - "*** ".&mt('Please do not reply to this address.')."\n\n".$body; + "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ". + &mt('A reply will not be received by the recipient!'))."\n\n".$body; my $msg = new Mail::Send; $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; @@ -278,12 +303,14 @@ sub author_res_msg { my $homeserver=&Apache::lonnet::homeserver($author,$domain); if ($homeserver ne 'no_host') { my $id=unpack("%32C*",$message); + $message .= "

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

"; my $msgid; ($msgid,$message)=&packagemsg($filename,$message); return &Apache::lonnet::reply('put:'.$domain.':'.$author. ':nohist_res_msgs:'. - &Apache::lonnet::escape($filename.'_'.$id).'='. - &Apache::lonnet::escape($message),$homeserver); + &escape($filename.'_'.$id).'='. + &escape($message),$homeserver); } return 'no_host'; } @@ -293,7 +320,7 @@ sub author_res_msg { sub retrieve_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); - my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//); + my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author); my $msgs=''; foreach (keys %errormsgs) { @@ -313,7 +340,7 @@ sub retrieve_author_res_msg { sub del_url_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); - my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//); + my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { if ($_=~/^\Q$url\E\_\d+$/) { @@ -327,7 +354,7 @@ sub del_url_author_res_msg { sub clear_author_res_msg { my $url=shift; $url=&Apache::lonnet::declutter($url); - my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//); + my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); my @delmsgs=(); foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { if ($_=~/^\Q$url\E/) { @@ -348,33 +375,52 @@ sub all_url_author_res_msg { 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 sub user_crit_msg_raw { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_; # Check if allowed missing - my $status=''; + my ($status,$packed_message); my $msgid='undefined'; unless (($message)&&($user)&&($domain)) { $status='empty'; }; my $text=$message; my $homeserver=&Apache::lonnet::homeserver($user,$domain); if ($homeserver ne 'no_host') { - ($msgid,$message)=&packagemsg($subject,$message); - if ($sendback) { $message.='true'; } + ($msgid,$packed_message)=&packagemsg($subject,$message); + if ($sendback) { $packed_message.='true'; } $status=&Apache::lonnet::critical( 'put:'.$domain.':'.$user.':critical:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$homeserver); + &escape($msgid).'='. + &escape($packed_message),$homeserver); if (defined($sentmessage)) { - $$sentmessage = $message; + $$sentmessage = $packed_message; + } + if ($env{'request.course.id'} eq '') { + (undef,my $packed_message_no_citation) = + &packagemsg($subject,$message,undef,undef,undef,$user,$domain, + $msgid); + if ($status eq 'ok' || $status eq 'con_delayed') { + &store_sent_mail($msgid,$packed_message_no_citation); + } } } else { $status='no_host'; } + # Notifications - my %userenv = &Apache::lonnet::get('environment',['critnotification', - 'permanentemail'], - $domain,$user); + my %userenv = &Apache::loncommon::getemails($user,$domain); if ($userenv{'critnotification'}) { &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, $text); @@ -402,25 +448,38 @@ sub user_crit_msg_raw { 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 @status; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); my $msgforward=$userenv{'msgforward'}; if ($msgforward) { - foreach (split(/\,/,$msgforward)) { - my ($forwuser,$forwdomain)=split(/\:/,$_); - $status.= - &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, - $sendback,$toperm,$sentmessage).' '; + foreach my $addr (split(/\,/,$msgforward)) { + my ($forwuser,$forwdomain)=split(/\:/,$addr); + push(@status, + &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, + $sendback,$toperm,$sentmessage)); } } else { - $status=&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage); + push(@status, + &user_crit_msg_raw($user,$domain,$subject,$message,$sendback, + $toperm,$sentmessage)); } - return $status; + if (wantarray) { + return @status; + } + return join(' ',@status); } # =================================================== Critical message received @@ -453,7 +512,8 @@ sub user_crit_received { sub user_normal_msg_raw { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, - $toperm,$currid,$newid,$sentmessage,$crsmsgid)=@_; + $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, + $error)=@_; # Check if allowed missing my ($status,$packed_message); my $msgid='undefined'; @@ -464,13 +524,13 @@ sub user_normal_msg_raw { ($msgid,$packed_message)= &packagemsg($subject,$message,$citation,$baseurl, $attachmenturl,$user,$domain,$currid, - undef,$crsmsgid); + undef,$crsmsgid,$symb,$error); # Store in user folder $status=&Apache::lonnet::critical( 'put:'.$domain.':'.$user.':nohist_email:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($packed_message),$homeserver); + &escape($msgid).'='. + &escape($packed_message),$homeserver); # Save new message received time &Apache::lonnet::put ('email_status',{'recnewemail'=>time},$domain,$user); @@ -481,12 +541,12 @@ sub user_normal_msg_raw { (&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); - - $status .= &store_sent_mail($msgid,$packed_message_no_citation); + (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); + } } } else { $status='no_host'; @@ -520,15 +580,15 @@ sub user_normal_msg_raw { =pod -=item * B: Sends a message to the - $user at $domain, with subject $subject and message $message. +=item * B: + Sends a message to the $user at $domain, with subject $subject and message $message. =cut sub user_normal_msg { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, - $toperm,$sentmessage)=@_; + $toperm,$sentmessage,$symb,$restitle,$error)=@_; my $status=''; my %userenv = &Apache::lonnet::get('environment',['msgforward'], $domain,$user); @@ -539,12 +599,12 @@ sub user_normal_msg { $status.= &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, $citation,$baseurl,$attachmenturl,$toperm, - undef,undef,$sentmessage).' '; + undef,undef,$sentmessage,undef,$symb,$restitle,$error).' '; } - } else { + } else { $status=&user_normal_msg_raw($user,$domain,$subject,$message, $citation,$baseurl,$attachmenturl,$toperm, - undef,undef,$sentmessage); + undef,undef,$sentmessage,undef,$symb,$restitle,$error); } return $status; } @@ -554,8 +614,8 @@ sub store_sent_mail { my $status =' '.&Apache::lonnet::critical( 'put:'.$env{'user.domain'}.':'.$env{'user.name'}. ':nohist_email_sent:'. - &Apache::lonnet::escape($msgid).'='. - &Apache::lonnet::escape($message),$env{'user.home'}); + &escape($msgid).'='. + &escape($message),$env{'user.home'}); return $status; } @@ -564,7 +624,31 @@ sub store_sent_mail { sub foldersuffix { my $folder=shift; unless ($folder) { return ''; } - return '_'.&Apache::lonnet::escape($folder); + 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;