--- loncom/interface/lonmsg.pm 2002/10/11 20:09:36 1.41
+++ loncom/interface/lonmsg.pm 2015/07/21 21:26:32 1.243
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines for messaging
#
-# $Id: lonmsg.pm,v 1.41 2002/10/11 20:09:36 www Exp $
+# $Id: lonmsg.pm,v 1.243 2015/07/21 21:26:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -25,75 +25,334 @@
#
# 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,3/18 Gerd Kortemeyer
-#
+
package Apache::lonmsg;
+=pod
+
+=head1 NAME
+
+Apache::lonmsg: supports internal messaging
+
+=head1 SYNOPSIS
+
+lonmsg provides routines for sending messages.
+
+Right now, this document will cover just how to send a message, since
+it is likely you will not need to programmatically read messages,
+since lonmsg already implements that functionality.
+
+The routines used to package messages and unpackage messages are not
+only used by lonmsg when creating/extracting messages for LON-CAPA's
+internal messaging system, but also by lonnotify.pm which is available
+for use by Domain Coordinators to broadcast standard e-mail to specified
+users in their domain. The XML packaging used in the two cases is very
+similar. The differences are the use of $uname and
+$udom in stored internal messages, compared
+with $email in stored
+Domain Coordinator e-mail for the storage of information about
+recipients of the message/e-mail.
+
+=head1 SUBROUTINES
+
+=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
+
use strict;
-use Apache::lonnet();
-use vars qw($msgcount);
-use HTML::TokeParser;
-use Apache::Constants qw(:common);
+use Apache::lonnet;
use Apache::loncommon;
-use Apache::lontexconvert;
+use HTML::TokeParser();
+use Apache::lonlocal;
+use HTML::Entities;
+use Encode;
+use LONCAPA qw(:DEFAULT :match);
+
+{
+ my $uniq;
+ sub get_uniq {
+ $uniq++;
+ return $uniq;
+ }
+}
+
-# ===================================================================== Package
sub packagemsg {
- my ($subject,$message,$citation)=@_;
- $message=~s/\\<\;/g;
- $message=~s/\>/\>\;/g;
- $citation=~s/\\<\;/g;
- $citation=~s/\>/\>\;/g;
- $subject=~s/\\<\;/g;
- $subject=~s/\>/\>\;/g;
+ my ($subject,$message,$citation,$baseurl,$attachmenturl,
+ $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error,$recipid)=@_;
+ $message =&HTML::Entities::encode($message,'<>&"');
+ $citation=&HTML::Entities::encode($citation,'<>&"');
+ $subject =&HTML::Entities::encode($subject,'<>&"');
+ #remove machine specification
+ $baseurl =~ s|^https?://[^/]+/|/|;
+ $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
+ #remove machine specification
+ $attachmenturl =~ s|^https?://[^/]+/|/|;
+ $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
+ my $course_context = &get_course_context();
my $now=time;
- $msgcount++;
- my $partsubj=$subject;
- $partsubj=&Apache::lonnet::escape($partsubj);
- my $msgid=&Apache::lonnet::escape(
- $now.':'.$partsubj.':'.$ENV{'user.name'}.':'.
- $ENV{'user.domain'}.':'.$msgcount.':'.$$);
- return $msgid,
- ''.$ENV{'user.name'}.''.
- ''.$ENV{'user.domain'}.''.
+ my $msgcount = &get_uniq();
+ unless(defined($msgid)) {
+ $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
+ $msgcount,$course_context,$symb,$error,$$);
+ }
+ my $result = ''.$env{'user.name'}.''.
+ ''.$env{'user.domain'}.''.
''.$subject.''.
- ''.
- ''.$ENV{'SERVER_NAME'}.''.
+ '';
+ if (defined($crsmsgid)) {
+ $result.= ''.$course_context.''.
+ ''.$env{'request.course.sec'}.''.
+ ''.$msgid.''.
+ ''.$crsmsgid.''.
+ ''.$message.'';
+ return ($msgid,$result);
+ }
+ $result .= ''.$ENV{'SERVER_NAME'}.''.
''.$ENV{'HTTP_HOST'}.''.
''.$ENV{'REMOTE_ADDR'}.''.
- ''.$ENV{'browser.type'}.''.
- ''.$ENV{'browser.os'}.''.
- ''.$ENV{'browser.version'}.''.
- ''.$ENV{'browser.mathml'}.''.
+ ''.$env{'browser.type'}.''.
+ ''.$env{'browser.os'}.''.
+ ''.$env{'browser.version'}.''.
+ ''.$env{'browser.mathml'}.''.
''.$ENV{'HTTP_USER_AGENT'}.''.
- ''.$ENV{'request.course.id'}.''.
- ''.$ENV{'request.role'}.''.
- ''.$ENV{'request.filename'}.''.
- ''.$msgid.''.
- ''.$message.''.
- ''.$citation.'';
+ ''.$course_context.''.
+ ''.$env{'request.course.sec'}.''.
+ ''.$env{'request.role'}.''.
+ ''.$env{'request.filename'}.''.
+ ''.$msgid.'';
+ if (defined($env{'form.group'})) {
+ $result .= ''.$env{'form.group'}.'';
+ }
+ 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 .= ''.
+ $email.'';
+ } else {
+ $result .= ''.$$recuser[$i].''.
+ ''.$$recdomain[$i].'';
+ }
+ }
+ } else {
+ $result .= ''.$recuser.''.
+ ''.$recdomain.'';
+ }
+ $result .= ''.$message.'';
+ if (defined($citation)) {
+ $result.=''.$citation.'';
+ }
+ if (defined($baseurl)) {
+ $result.= ''.$baseurl.'';
+ }
+ if (defined($attachmenturl)) {
+ $result.= ''.$attachmenturl.'';
+ }
+ if (defined($symb)) {
+ $result.= ''.$symb.'';
+ if ($course_context ne '') {
+ if ($course_context eq $env{'request.course.id'}) {
+ my $resource_title = &Apache::lonnet::gettitle($symb);
+ if (defined($resource_title)) {
+ $result .= ''.$resource_title.'';
+ }
+ }
+ }
+ }
+ if (defined($recipid)) {
+ $result.= ''.$recipid.'';
+ }
+ if ($env{'form.can_reply'} eq 'N') {
+ $result .= '1';
+ }
+ 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') {
+ $result .= ''.$env{'form.reply_to_addr'}.'';
+ }
+ }
+ }
+ return ($msgid,$result);
+}
+
+sub get_course_context {
+ my $course_context;
+ my $msgkey;
+ if (defined($env{'form.replyid'})) {
+ $msgkey = $env{'form.replyid'};
+ } elsif (defined($env{'form.forwid'})) {
+ $msgkey = $env{'form.forwid'}
+ } elsif (defined($env{'form.multiforwid'})) {
+ $msgkey = $env{'form.multiforwid'};
+ }
+ if ($msgkey ne '') {
+ my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
+ split(/\:/,&unescape($msgkey));
+ $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;
+ }
+ }
+ if ($course_context eq '') {
+ $course_context = $env{'request.course.id'};
+ }
+ return $course_context;
}
-# ================================================== Unpack message into a hash
sub unpackagemsg {
- my $message=shift;
+ my ($message,$notoken,$noattachmentlink)=@_;
my %content=();
my $parser=HTML::TokeParser->new(\$message);
my $token;
@@ -101,36 +360,253 @@ sub unpackagemsg {
if ($token->[0] eq 'S') {
my $entry=$token->[1];
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'}) && (!$noattachmentlink)) {
+ my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
+ if ($notoken) {
+ $content{'message'}.='