loncom/interface/lonmsg.pm - diff

Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmsg.pm between versions 1.214.2.2 and 1.231

-version 1.214.2.2, 2008/12/21 04:21:53
+version 1.231, 2011/02/13 17:44:51
  Line 53  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
- Line 64  use Apache::lonnet;
+ Line 203  use Apache::lonnet;
  use HTML::TokeParser();
  use Apache::lonlocal;
  use Mail::Send;
+ use HTML::Entities;
+ use Encode;
  use LONCAPA qw(:DEFAULT :match);
  {
- Line 74  use LONCAPA qw(:DEFAULT :match);
+ Line 215  use LONCAPA qw(:DEFAULT :match);
      }
  }
- # ===================================================================== Package
  sub packagemsg {
      my ($subject,$message,$citation,$baseurl,$attachmenturl,
- Line 83  sub packagemsg {
+ Line 224  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;
- Line 209  sub get_course_context {
+ Line 350  sub get_course_context {
      return $course_context;
  }
- # ================================================== Unpack message into a hash
  sub unpackagemsg {
      my ($message,$notoken,$noattachmentlink)=@_;
- Line 247  sub unpackagemsg {
+ Line 387  sub unpackagemsg {
      return %content;
  }
- # ======================================================= Get info out of msgid
  sub buildmsgid {
      my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
- Line 283  sub unpackmsgid {
+ Line 422  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') {
+     my $replytoaddress='';
- 	if ($senderemails{$type}) {
+     if ($env{'form.can_reply'} eq 'N') {
- 	    $senderaddress=$senderemails{$type};
+         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".
+     "*** ".&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 message'):&mt_user($user_lh,'Please do not reply to this address.')."\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;
+     &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);
+     }
+     $msg->add('Content-type','text/plain; charset=UTF-8');
      if (my $fh = $msg->open()) {
  	print $fh $body;
  	$fh->close;
- Line 320  sub sendnotification {
+ Line 488  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 '') {
- Line 373  to access the full message.',$url);
+ Line 542  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;
              }
- Line 389  to access the full message.',$url);
+ Line 561  to access the full message.',$url);
          if ($blocked) {
              $body = $bodybegin."\n".$blocktext."\n".$bodyend;
          } else {
-             $text =~ s/\<\/*[^\>]+\>//gs;
+             my $htmlfree = &make_htmlfree($text);
-             $body = $bodybegin.$bodysubj.$text.$bodyend;
+             $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)=@_;
- Line 435  sub author_res_msg {
+ Line 614  sub author_res_msg {
      return 'no_host';
  }
- # =========================================== Retrieve author resource messages
  sub retrieve_author_res_msg {
      my $url=shift;
- Line 455  sub retrieve_author_res_msg {
+ Line 634  sub retrieve_author_res_msg {
  }
- # =============================== Delete all author messages related to one URL
  sub del_url_author_res_msg {
      my $url=shift;
- Line 469  sub del_url_author_res_msg {
+ Line 649  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;
- Line 483  sub clear_author_res_msg {
+ Line 663  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)=@_;
- Line 495  sub all_url_author_res_msg {
+ Line 676  sub all_url_author_res_msg {
      return %returnhash;
  }
- # ====================================== Add a comment to the User Notes screen
  sub store_instructor_comment {
      my ($msg,$uname,$udom) = @_;
- Line 510  sub store_instructor_comment {
+ Line 690  sub store_instructor_comment {
      return $result;
  }
- # ================================================== Critical message to a user
  sub user_crit_msg_raw {
      my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
- Line 564  sub user_crit_msg_raw {
+ Line 743  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,
- Line 610  sub user_crit_msg {
+ Line 772  sub user_crit_msg {
      return join(' ',@status);
  }
- # =================================================== Critical message received
  sub user_crit_received {
      my $msgid=shift;
- Line 646  sub user_crit_received {
+ Line 807  sub user_crit_received {
      return $status;
  }
- # ======================================================== Normal communication
  sub user_normal_msg_raw {
      my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
- Line 707  sub user_normal_msg_raw {
+ Line 869  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)=@_;
- Line 809  sub store_recipients {
+ Line 952  sub store_recipients {
      }
  }
- # =============================================================== Folder suffix
  sub foldersuffix {
      my $folder=shift;
- Line 824  sub foldersuffix {
+ Line 966  sub foldersuffix {
      return $suffix;
  }
- # ========================================================= User-defined folders
  sub get_user_folders {
      my ($folder) = @_;
- Line 845  sub secapply {
+ Line 986  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)) {
- Line 865  sub secapply {
+ Line 1008  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);
- Line 931  sub decide_receiver {
+ Line 1047  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
 ;
  __END__

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.214.2.2
changed lines
	Added in v.1.231