--- loncom/interface/lonmsg.pm 2008/12/21 04:21:53 1.214.2.2 +++ loncom/interface/lonmsg.pm 2010/05/29 22:39:52 1.226 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # Routines for messaging # -# $Id: lonmsg.pm,v 1.214.2.2 2008/12/21 04:21:53 raeburn Exp $ +# $Id: lonmsg.pm,v 1.226 2010/05/29 22:39:52 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -53,9 +53,148 @@ with Domain Coordinator e-mail for the storage of information about recipients of the message/e-mail. -=head1 FUNCTIONS +=head1 SUBROUTINES -=over 4 +=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: Sends message $message to the owner + of the resource with the URI $filename. + +=item retrieve_author_res_msg() + +Retrieve author resource messages + +=item del_url_author_res_msg() + +Delete all author messages related to one URL + +=item clear_author_res_msg() + +Clear out all author messages in URL path + +=item all_url_author_res_msg() + +Return hash with URLs for which there is a resource message + +=item store_instructor_comment() + +Add a comment to the User Notes screen + +=item user_crit_msg_raw() + +Critical message to a user + +=item user_crit_msg() + +New routine that respects "forward" and calls old routine + +=item * B: + Sends a critical message $message to the $user at $domain. If $sendback + is true, a receipt will be sent to the current user when $user receives + the message. + + Additionally it will check if the user has a Forwarding address + set, and send the message to that address instead + + returns + - in array context a list of results for each message that was sent + - in scalar context a space seperated list of results for each + message sent + + +=item user_crit_received() + +Critical message received + +=item user_normal_msg_raw() + +Normal communication + +=item user_normal_msg() + +New routine that respects "forward" and calls old routine + +=item * B: + 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: + +Arguments + $feedurl - /res/ url of resource (only need if $author is true) + $author,$question,$course,$policy - all true/false parameters + if true will attempt to find the addresses of user that should receive + this type of feedback (author - feedback to author of resource $feedurl, + $question 'Resource Content Questions', $course 'Course Content Question', + $policy 'Course Policy') + (Additionally it also checks $env for whether the corresponding form. + element exists, for ease of use in a html response context) + + $defaultflag - (internal should be left blank) if true gather addresses + that aren't for a section even if I have a section + (used for reccursion internally, first we look for + addresses for our specific section then we recurse + and look for non section addresses) + +Returns + $typestyle - string of html text, describing what addresses were found + %to - a hash, which keys are addresses of users to send messages to + the keys will look like name:domain + +=back =cut @@ -64,6 +203,8 @@ use Apache::lonnet; use HTML::TokeParser(); use Apache::lonlocal; use Mail::Send; +use HTML::Entities; +use Encode; use LONCAPA qw(:DEFAULT :match); { @@ -74,7 +215,7 @@ use LONCAPA qw(:DEFAULT :match); } } -# ===================================================================== Package + sub packagemsg { my ($subject,$message,$citation,$baseurl,$attachmenturl, @@ -83,10 +224,10 @@ sub packagemsg { $citation=&HTML::Entities::encode($citation,'<>&"'); $subject =&HTML::Entities::encode($subject,'<>&"'); #remove machine specification - $baseurl =~ s|^https?\://[^/]+/|/|; + $baseurl =~ s|^https?://[^/]+/|/|; $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); #remove machine specification - $attachmenturl =~ s|^https\://[^/]+/|/|; + $attachmenturl =~ s|^https?://[^/]+/|/|; $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); my $course_context = &get_course_context(); my $now=time; @@ -209,7 +350,6 @@ sub get_course_context { return $course_context; } -# ================================================== Unpack message into a hash sub unpackagemsg { my ($message,$notoken,$noattachmentlink)=@_; @@ -247,7 +387,6 @@ sub unpackagemsg { return %content; } -# ======================================================= Get info out of msgid sub buildmsgid { my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; @@ -283,21 +422,49 @@ sub unpackmsgid { sub sendemail { my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; - my %senderemails=&Apache::loncommon::getemails(); my $senderaddress=''; - foreach my $type ('notification','permanentemail','critnotification') { - if ($senderemails{$type}) { - $senderaddress=$senderemails{$type}; - } + 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 message generated by the LON-CAPA system.')."\n". - "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this message'):&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; + "*** ".&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 ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); } + if ($replytoaddress) { + $msg->add('Reply-to',$replytoaddress); + } + if ($senderaddress) { + $msg->add('From',$senderaddress); + } if (my $fh = $msg->open()) { print $fh $body; $fh->close; @@ -320,11 +487,12 @@ sub sendnotification { 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; + '/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 = &user_lang($touname,$toudom,$fromcid); + 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 '') { @@ -373,13 +541,16 @@ to access the full message.',$url); } 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 = $text; + my $sendtext; if (!grep/^\Q$addr\E/,@htmlexcerpt) { - $sendtext =~ s/\<\/*[^\>]+\>//gs; + $sendtext = &htmlfree; + } else { + $sendtext = $text; } $body = $bodybegin.$bodysubj.$sendtext.$bodyend; } @@ -389,31 +560,38 @@ to access the full message.',$url); if ($blocked) { $body = $bodybegin."\n".$blocktext."\n".$bodyend; } else { - $text =~ s/\<\/*[^\>]+\>//gs; - $body = $bodybegin.$bodysubj.$text.$bodyend; + my $htmlfree = &make_htmlfree($text); + $body = $bodybegin.$bodysubj.$htmlfree.$bodyend; } &sendemail($to,$subject,$body,$touname,$toudom,$user_lh); } } -# ============================================================= Check for email + +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.lastnewmassagetime'} > $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.lastnewmassagetime'=> $what{'recnewemail'}}); if ($what{'recnewemail'}>0) { return 1; } } return 0; } -# =============================== Automated message to the author of a resource - -=pod - -=item * B: Sends message $message to the owner - of the resource with the URI $filename. -=cut sub author_res_msg { my ($filename,$message)=@_; @@ -435,7 +613,7 @@ sub author_res_msg { return 'no_host'; } -# =========================================== Retrieve author resource messages + sub retrieve_author_res_msg { my $url=shift; @@ -455,7 +633,8 @@ sub retrieve_author_res_msg { } -# =============================== Delete all author messages related to one URL + + sub del_url_author_res_msg { my $url=shift; @@ -469,7 +648,7 @@ sub del_url_author_res_msg { } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# =================================== Clear out all author messages in URL path + sub clear_author_res_msg { my $url=shift; @@ -483,7 +662,8 @@ sub clear_author_res_msg { } return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); } -# ================= Return hash with URLs for which there is a resource message + + sub all_url_author_res_msg { my ($author,$domain)=@_; @@ -495,7 +675,6 @@ sub all_url_author_res_msg { return %returnhash; } -# ====================================== Add a comment to the User Notes screen sub store_instructor_comment { my ($msg,$uname,$udom) = @_; @@ -510,7 +689,6 @@ sub store_instructor_comment { return $result; } -# ================================================== Critical message to a user sub user_crit_msg_raw { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, @@ -564,24 +742,7 @@ sub user_crit_msg_raw { return $status; } -# New routine that respects "forward" and calls old routine - -=pod -=item * B: - Sends a critical message $message to the $user at $domain. If $sendback - is true, a 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 - -=cut sub user_crit_msg { my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, @@ -610,7 +771,6 @@ sub user_crit_msg { return join(' ',@status); } -# =================================================== Critical message received sub user_crit_received { my $msgid=shift; @@ -646,7 +806,8 @@ sub user_crit_received { return $status; } -# ======================================================== Normal communication + + sub user_normal_msg_raw { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, @@ -707,25 +868,6 @@ sub user_normal_msg_raw { return $status; } -# New routine that respects "forward" and calls old routine - -=pod - -=item * B: - Sends a message to the $user at $domain, with subject $subject and message $message. - - 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_normal_msg { my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; @@ -809,7 +951,6 @@ sub store_recipients { } } -# =============================================================== Folder suffix sub foldersuffix { my $folder=shift; @@ -824,7 +965,6 @@ sub foldersuffix { return $suffix; } -# ========================================================= User-defined folders sub get_user_folders { my ($folder) = @_; @@ -865,33 +1005,6 @@ sub secapply { return ''; } -=pod - -=item * B: - -Arguments - $feedurl - /res/ url of resource (only need if $author is true) - $author,$question,$course,$policy - all true/false parameters - if true will attempt to find the addresses of user that should receive - this type of feedback (author - feedback to author of resource $feedurl, - $question 'Resource Content Questions', $course 'Course Content Question', - $policy 'Course Policy') - (Additionally it also checks $env for whether the corresponding form. - element exists, for ease of use in a html response context) - - $defaultflag - (internal should be left blank) if true gather addresses - that aren't for a section even if I have a section - (used for reccursion internally, first we look for - addresses for our specific section then we recurse - and look for non section addresses) - -Returns - $typestyle - string of html text, describing what addresses were found - %to - a hash, which keys are addresses of users to send messages to - the keys will look like name:domain - -=cut - sub decide_receiver { my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; &Apache::lonenc::check_decrypt(\$feedurl); @@ -931,34 +1044,6 @@ sub decide_receiver { return ($typestyle,%to); } -sub user_lang { - my ($touname,$toudom,$fromcid) = @_; - my @userlangs; - if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) { - @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/, - $env{'course.'.$fromcid.'.languages'})); - } else { - my %langhash = &Apache::lonnet::get('environment',['languages'],$toudom,$touname); - if ($langhash{'languages'} ne '') { - @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'}); - } else { - my %domdefs = &Apache::lonnet::get_domain_defaults($toudom); - if ($domdefs{'lang_def'} ne '') { - @userlangs = ($domdefs{'lang_def'}); - } - } - } - my @languages=&Apache::lonlocal::get_genlanguages(@userlangs); - my $user_lh = Apache::localize->get_handle(@languages); - return $user_lh; -} - -=pod - -=back - -=cut - 1; __END__