--- loncom/interface/lonmsg.pm	2009/01/04 16:21:10	1.214.2.4
+++ loncom/interface/lonmsg.pm	2014/12/11 01:53:22	1.237
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Routines for messaging
 #
-# $Id: lonmsg.pm,v 1.214.2.4 2009/01/04 16:21:10 raeburn Exp $
+# $Id: lonmsg.pm,v 1.237 2014/12/11 01:53:22 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -53,9 +53,148 @@ with <recipient username="$uname:$udom">
 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<author_res_msg($filename, $message)>: Sends message $message to the owner
+    of the resource with the URI $filename.
+
+=item retrieve_author_res_msg()
+
+Retrieve author resource messages
+
+=item del_url_author_res_msg()
+
+Delete all author messages related to one URL
+
+=item clear_author_res_msg()
+
+Clear out all author messages in URL path
+
+=item all_url_author_res_msg()
+
+Return hash with URLs for which there is a resource message
+
+=item store_instructor_comment()
+
+Add a comment to the User Notes screen
+
+=item user_crit_msg_raw()
+
+Critical message to a user
+
+=item user_crit_msg()
+
+New routine that respects "forward" and calls old routine
+
+=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: 
+    Sends a critical message $message to the $user at $domain.  If $sendback
+    is true,  a receipt will be sent to the current user when $user receives 
+    the message.
+
+    Additionally it will check if the user has a Forwarding address
+    set, and send the message to that address instead
+
+    returns 
+      - in array context a list of results for each message that was sent
+      - in scalar context a space seperated list of results for each 
+           message sent
+
+
+=item user_crit_received()
+
+Critical message received
+
+=item user_normal_msg_raw()
+
+Normal communication
+
+=item user_normal_msg()
+
+New routine that respects "forward" and calls old routine
+
+=item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
+       $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle,
+       $error,$nosentstore,$recipid)>:
+ Sends a message to the  $user at $domain, with subject $subject and message $message.
+
+    Additionally it will check if the user has a Forwarding address
+    set, and send the message to that address instead
+
+    returns
+      - in array context a list of results for each message that was sent
+      - in scalar context a space seperated list of results for each
+           message sent
+
+=item store_sent_mail()
+
+=item store_recipients()
+
+=item foldersuffix()
+
+=item get_user_folders()
+
+User-defined folders 
+
+=item secapply()
+
+=item B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>:
+
+Arguments
+  $feedurl - /res/ url of resource (only need if $author is true)
+  $author,$question,$course,$policy - all true/false parameters
+    if true will attempt to find the addresses of user that should receive
+    this type of feedback (author - feedback to author of resource $feedurl,
+    $question 'Resource Content Questions', $course 'Course Content Question',
+    $policy 'Course Policy')
+    (Additionally it also checks $env for whether the corresponding form.<name>
+    element exists, for ease of use in a html response context)
+   
+  $defaultflag - (internal should be left blank) if true gather addresses 
+                 that aren't for a section even if I have a section
+                 (used for reccursion internally, first we look for
+                 addresses for our specific section then we recurse
+                 and look for non section addresses)
+
+Returns
+  $typestyle - string of html text, describing what addresses were found
+  %to - a hash, which keys are addresses of users to send messages to
+        the keys will look like   name:domain
+
+=back
 
 =cut
 
@@ -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) = @_;
@@ -306,25 +445,27 @@ sub sendemail {
             %senderemails=&Apache::loncommon::getemails();
         }
         foreach my $type ('permanentemail','critnotification','notification') {
-	    if ($senderemails{$type}) {
+            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,'This is an automatic e-mail generated by the LON-CAPA system.')."\n".
+    "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this e-mail'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ".
     &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body;
+    
     my $msg = new Mail::Send;
     $msg->to($to);
     $msg->subject('[LON-CAPA] '.$subject);
-    if ($replytoaddress) { 
+    if ($replytoaddress) {
         $msg->add('Reply-to',$replytoaddress);
     }
     if ($senderaddress) {
-        $msg->add('From',$senderaddress); 
+        $msg->add('From',$senderaddress);
     }
+    $msg->add('Content-type','text/plain; charset=UTF-8');
     if (my $fh = $msg->open()) {
 	print $fh $body;
 	$fh->close;
@@ -347,11 +488,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 '') {
@@ -384,7 +526,10 @@ sub sendnotification {
 
 to access the full message.',$url);
     my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname);
-    my $subject = &mt_user($user_lh,"'New' $critical message from ").$sender;
+    my $subject = &mt_user($user_lh,"'New'$critical message from [_1]",$sender);
+    unless ($subj eq '') {
+        $subject = $subj;
+    }
  
     my ($blocked,$blocktext);
     if (!$crit) {
@@ -400,13 +545,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;
             }
@@ -416,31 +564,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.lastnewmessagetime'} > $env{'user.mailcheck.lastvisit'};
+}
+
 
 sub newmail {
     if ((time-$env{'user.mailcheck.time'})>300) {
         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
         &Apache::lonnet::appenv({'user.mailcheck.time'=>time});
+		&Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}});
         if ($what{'recnewemail'}>0) { return 1; }
     }
     return 0;
 }
 
-# =============================== 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 {
     my ($filename,$message)=@_;
@@ -462,7 +617,7 @@ sub author_res_msg {
     return 'no_host';
 }
 
-# =========================================== Retrieve author resource messages
+
 
 sub retrieve_author_res_msg {
     my $url=shift;
@@ -470,7 +625,7 @@ sub retrieve_author_res_msg {
     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
     my $msgs='';
-    foreach (keys %errormsgs) {
+    foreach (keys(%errormsgs)) {
 	if ($_=~/^\Q$url\E\_\d+$/) {
 	    my %content=&unpackagemsg($errormsgs{$_});
 	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
@@ -482,7 +637,8 @@ sub retrieve_author_res_msg {
 }
 
 
-# =============================== Delete all author messages related to one URL
+
+
 
 sub del_url_author_res_msg {
     my $url=shift;
@@ -496,7 +652,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;
@@ -510,7 +666,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)=@_;
@@ -522,7 +679,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) = @_;
@@ -537,7 +693,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,
@@ -591,24 +746,7 @@ sub user_crit_msg_raw {
     return $status;
 }
 
-# New routine that respects "forward" and calls old routine
-
-=pod
-
-=item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: 
-    Sends a critical message $message to the $user at $domain.  If $sendback
-    is true,  a receipt will be sent to the current user when $user receives 
-    the message.
-
-    Additionally it will check if the user has a Forwarding address
-    set, and send the message to that address instead
-
-    returns 
-      - in array context a list of results for each message that was sent
-      - in scalar context a space seperated list of results for each 
-           message sent
 
-=cut
 
 sub user_crit_msg {
     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
@@ -637,7 +775,6 @@ sub user_crit_msg {
     return join(' ',@status);
 }
 
-# =================================================== Critical message received
 
 sub user_crit_received {
     my $msgid=shift;
@@ -673,7 +810,8 @@ sub user_crit_received {
     return $status;
 }
 
-# ======================================================== Normal communication
+
+
 
 sub user_normal_msg_raw {
     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
@@ -734,25 +872,6 @@ sub user_normal_msg_raw {
     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,$nosentstore,$recipid)>:
- Sends a message to the  $user at $domain, with subject $subject and message $message.
-
-    Additionally it will check if the user has a Forwarding address
-    set, and send the message to that address instead
-
-    returns
-      - in array context a list of results for each message that was sent
-      - in scalar context a space seperated list of results for each
-           message sent
-
-=cut
-
 sub user_normal_msg {
     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
 	$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_;
@@ -782,7 +901,9 @@ sub user_normal_msg {
 }
 
 sub process_sent_mail {
-    my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,$context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,$symb,$error,$senderuname,$senderdom,$recipid) = @_;
+    my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,
+        $context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,
+        $symb,$error,$senderuname,$senderdom,$recipid) = @_;
     my $sentsubj;
     if ($numsent > 1) {
         $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj;
@@ -836,7 +957,6 @@ sub store_recipients {
     }
 }
 
-# =============================================================== Folder suffix
 
 sub foldersuffix {
     my $folder=shift;
@@ -851,7 +971,6 @@ sub foldersuffix {
     return $suffix;
 }
 
-# ========================================================= User-defined folders 
 
 sub get_user_folders {
     my ($folder) = @_;
@@ -872,7 +991,9 @@ sub secapply {
     my $rec=shift;
     my $defaultflag=shift;
     $rec=~s/\s+//g;
-    $rec=~s/\@/\:/g;
+    unless ($rec =~ /\:/) {
+        $rec=~s/\@/\:/g;
+    }
     my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
     if ($sections_or_groups) {
 	foreach my $item (split(/\;/,$sections_or_groups)) {
@@ -892,33 +1013,6 @@ sub secapply {
     return '';
 }
 
-=pod 
-
-=item * B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>:
-
-Arguments
-  $feedurl - /res/ url of resource (only need if $author is true)
-  $author,$question,$course,$policy - all true/false parameters
-    if true will attempt to find the addresses of user that should receive
-    this type of feedback (author - feedback to author of resource $feedurl,
-    $question 'Resource Content Questions', $course 'Course Content Question',
-    $policy 'Course Policy')
-    (Additionally it also checks $env for whether the corresponding form.<name>
-    element exists, for ease of use in a html response context)
-   
-  $defaultflag - (internal should be left blank) if true gather addresses 
-                 that aren't for a section even if I have a section
-                 (used for reccursion internally, first we look for
-                 addresses for our specific section then we recurse
-                 and look for non section addresses)
-
-Returns
-  $typestyle - string of html text, describing what addresses were found
-  %to - a hash, which keys are addresses of users to send messages to
-        the keys will look like   name:domain
-
-=cut
-
 sub decide_receiver {
     my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
     &Apache::lonenc::check_decrypt(\$feedurl);
@@ -958,34 +1052,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::loncommon::getlangs($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__