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 and 1.239.2.2

version 1.214, 2008/11/04 04:18:22	version 1.239.2.2, 2021/01/04 03:44:12
Line 53 with <recipient username="$uname:$udom">	Line 53 with <recipient username="$uname:$udom">
Domain Coordinator e-mail for the storage of information about	Domain Coordinator e-mail for the storage of information about
recipients of the message/e-mail.	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, $permresults)>:
	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,$permresults)>:
	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	=cut

Line 64 use Apache::lonnet;	Line 203 use Apache::lonnet;
use HTML::TokeParser();	use HTML::TokeParser();
use Apache::lonlocal;	use Apache::lonlocal;
use Mail::Send;	use Mail::Send;
	use HTML::Entities;
	use Encode;
use LONCAPA qw(:DEFAULT :match);	use LONCAPA qw(:DEFAULT :match);

{	{
Line 74 use LONCAPA qw(:DEFAULT :match);	Line 215 use LONCAPA qw(:DEFAULT :match);
}	}
}	}

# ===================================================================== Package

sub packagemsg {	sub packagemsg {
my ($subject,$message,$citation,$baseurl,$attachmenturl,	my ($subject,$message,$citation,$baseurl,$attachmenturl,
Line 83 sub packagemsg {	Line 224 sub packagemsg {
$citation=&HTML::Entities::encode($citation,'<>&"');	$citation=&HTML::Entities::encode($citation,'<>&"');
$subject =&HTML::Entities::encode($subject,'<>&"');	$subject =&HTML::Entities::encode($subject,'<>&"');
#remove machine specification	#remove machine specification
$baseurl =~ s\|^http://[^/]+/\|/\|;	$baseurl =~ s\|^https?://[^/]+/\|/\|;
$baseurl =&HTML::Entities::encode($baseurl,'<>&"');	$baseurl =&HTML::Entities::encode($baseurl,'<>&"');
#remove machine specification	#remove machine specification
$attachmenturl =~ s\|^http://[^/]+/\|/\|;	$attachmenturl =~ s\|^https?://[^/]+/\|/\|;
$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');	$attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
my $course_context = &get_course_context();	my $course_context = &get_course_context();
my $now=time;	my $now=time;
	my $ip = &Apache::lonnet::get_requestor_ip();
my $msgcount = &get_uniq();	my $msgcount = &get_uniq();
unless(defined($msgid)) {	unless(defined($msgid)) {
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},	$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
Line 109 sub packagemsg {	Line 251 sub packagemsg {
}	}
$result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.	$result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
'<host>'.$ENV{'HTTP_HOST'}.'</host>'.	'<host>'.$ENV{'HTTP_HOST'}.'</host>'.
'<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.	'<client>'.$ip.'</client>'.
'<browsertype>'.$env{'browser.type'}.'</browsertype>'.	'<browsertype>'.$env{'browser.type'}.'</browsertype>'.
'<browseros>'.$env{'browser.os'}.'</browseros>'.	'<browseros>'.$env{'browser.os'}.'</browseros>'.
'<browserversion>'.$env{'browser.version'}.'</browserversion>'.	'<browserversion>'.$env{'browser.version'}.'</browserversion>'.
Line 209 sub get_course_context {	Line 351 sub get_course_context {
return $course_context;	return $course_context;
}	}

# ================================================== Unpack message into a hash

sub unpackagemsg {	sub unpackagemsg {
my ($message,$notoken,$noattachmentlink)=@_;	my ($message,$notoken,$noattachmentlink)=@_;
Line 247 sub unpackagemsg {	Line 388 sub unpackagemsg {
return %content;	return %content;
}	}

# ======================================================= Get info out of msgid

sub buildmsgid {	sub buildmsgid {
my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;	my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
Line 258 sub buildmsgid {	Line 398 sub buildmsgid {
}	}

sub unpackmsgid {	sub unpackmsgid {
my ($msgid,$folder,$skipstatus,$status_cache)=@_;	my ($msgid,$folder,$skipstatus,$status_cache,$onlycid)=@_;
$msgid=&unescape($msgid);	$msgid=&unescape($msgid);
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,	my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
$processid,$symb,$error) = split(/\:/,&unescape($msgid));	$processid,$symb,$error) = split(/\:/,&unescape($msgid));
	if (!defined($processid)) { $fromcid = ''; }
	if (($onlycid) && ($onlycid ne $fromcid)) {
	return ($sendtime,'',$fromname,$fromdomain,'',$fromcid,'',$error);
	}
$shortsubj = &unescape($shortsubj);	$shortsubj = &unescape($shortsubj);
$shortsubj = &HTML::Entities::decode($shortsubj);	$shortsubj = &HTML::Entities::decode($shortsubj);
$symb = &unescape($symb);	$symb = &unescape($symb);
Line 283 sub unpackmsgid {	Line 427 sub unpackmsgid {

sub sendemail {	sub sendemail {
my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_;	my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_;
my %senderemails=&Apache::loncommon::getemails();
my $senderaddress='';	my $senderaddress='';
foreach my $type ('notification','permanentemail','critnotification') {	my $replytoaddress='';
if ($senderemails{$type}) {	my $msgsent;
$senderaddress=$senderemails{$type};	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=	$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;	my $msg = new Mail::Send;
$msg->to($to);	$msg->to($to);
$msg->subject('[LON-CAPA] '.$subject);	$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()) {	if (my $fh = $msg->open()) {
print $fh $body;	print $fh $body;
$fh->close;	$fh->close;
	$msgsent = 1;
}	}
	return $msgsent;
}	}

# ==================================================== Send notification emails	# ==================================================== Send notification emails
Line 313 sub sendnotification {	Line 489 sub sendnotification {
$sender=$env{'user.name'}.':'.$env{'user.domain'};	$sender=$env{'user.name'}.':'.$env{'user.domain'};
}	}
my $critical=($crit?' critical':'');	my $critical=($crit?' critical':'');
	my $numsent = 0;

$text=~s/\&lt\;/\</gs;	$text=~s/\&lt\;/\</gs;
$text=~s/\&gt\;/\>/gs;	$text=~s/\&gt\;/\>/gs;
my $url='http://'.	my $homeserver = &Apache::lonnet::homeserver($touname,$toudom);
&Apache::lonnet::hostname(&Apache::lonnet::homeserver($touname,$toudom)).	my $protocol = $Apache::lonnet::protocol{$homeserver};
'/adm/email?username='.$touname.'&domain='.$toudom;	$protocol = 'http' if ($protocol ne 'https');
	my $url = $protocol.'://'.&Apache::lonnet::hostname($homeserver).
	'/adm/email?username='.$touname.'&domain='.$toudom.
	'&display='.&escape($msgid);
my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,	my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,
$symb,$error) = &Apache::lonmsg::unpackmsgid($msgid);	$symb,$error) = &Apache::lonmsg::unpackmsgid($msgid);
my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend);	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 '') {	if ($fromcid ne '') {
$coursetext = "\n".&mt_user($user_lh,'Course').': ';	$coursetext = "\n".&mt_user($user_lh,'Course').': ';
if ($env{'course.'.$fromcid.'.description'} ne '') {	if ($env{'course.'.$fromcid.'.description'} ne '') {
Line 355 sub sendnotification {	Line 535 sub sendnotification {

to access the full message.',$url);	to access the full message.',$url);
my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname);	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);	my ($blocked,$blocktext);
if (!$crit) {	if (!$crit) {
Line 371 to access the full message.',$url);	Line 554 to access the full message.',$url);
}	}
if ($userenv{'notifywithhtml'} ne '') {	if ($userenv{'notifywithhtml'} ne '') {
my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'});	my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'});
	my $htmlfree = &make_htmlfree($text);
foreach my $addr (@recipients) {	foreach my $addr (@recipients) {
if ($blocked) {	if ($blocked) {
$body = $bodybegin."\n".$blocktext."\n".$bodyend;	$body = $bodybegin."\n".$blocktext."\n".$bodyend;
} else {	} else {
my $sendtext = $text;	my $sendtext;
if (!grep/^\Q$addr\E/,@htmlexcerpt) {	if (!grep/^\Q$addr\E/,@htmlexcerpt) {
$sendtext =~ s/\<\/*[^\>]+\>//gs;	$sendtext = $htmlfree;
	} else {
	$sendtext = $text;
}	}
$body = $bodybegin.$bodysubj.$sendtext.$bodyend;	$body = $bodybegin.$bodysubj.$sendtext.$bodyend;
}	}
&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh);	if (&sendemail($addr,$subject,$body,$touname,$toudom,$user_lh)) {
	$numsent ++;
	}
}	}
} else {	} else {
if ($blocked) {	if ($blocked) {
$body = $bodybegin."\n".$blocktext."\n".$bodyend;	$body = $bodybegin."\n".$blocktext."\n".$bodyend;
} else {	} else {
$text =~ s/\<\/*[^\>]+\>//gs;	my $htmlfree = &make_htmlfree($text);
$body = $bodybegin.$bodysubj.$text.$bodyend;	$body = $bodybegin.$bodysubj.$htmlfree.$bodyend;
	}
	if (&sendemail($to,$subject,$body,$touname,$toudom,$user_lh)) {
	$numsent ++;
}	}
&sendemail($to,$subject,$body,$touname,$toudom,$user_lh);
}	}
	return $numsent;
}	}
# ============================================================= 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 {	sub newmail {
if ((time-$env{'user.mailcheck.time'})>300) {	if ((time-$env{'user.mailcheck.time'})>300) {
my %what=&Apache::lonnet::get('email_status',['recnewemail']);	my %what=&Apache::lonnet::get('email_status',['recnewemail']);
&Apache::lonnet::appenv({'user.mailcheck.time'=>time});	&Apache::lonnet::appenv({'user.mailcheck.time'=>time});
	&Apache::lonnet::appenv({'user.mailcheck.lastnewmessagetime'=> $what{'recnewemail'}});
if ($what{'recnewemail'}>0) { return 1; }	if ($what{'recnewemail'}>0) { return 1; }
}	}
return 0;	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 {	sub author_res_msg {
my ($filename,$message)=@_;	my ($filename,$message)=@_;
Line 433 sub author_res_msg {	Line 631 sub author_res_msg {
return 'no_host';	return 'no_host';
}	}

# =========================================== Retrieve author resource messages

sub retrieve_author_res_msg {	sub retrieve_author_res_msg {
my $url=shift;	my $url=shift;
Line 441 sub retrieve_author_res_msg {	Line 639 sub retrieve_author_res_msg {
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);	my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);	my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
my $msgs='';	my $msgs='';
foreach (keys %errormsgs) {	foreach my $msg (keys(%errormsgs)) {
if ($_=~/^\Q$url\E\_\d+$/) {	if ($msg =~ /^\Q$url\E\_\d+$/) {
my %content=&unpackagemsg($errormsgs{$_});	my %content=&unpackagemsg($errormsgs{$msg});
$msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.	$msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
$content{'time'}.'</b>: '.$content{'message'}.	$content{'time'}.'</b>: '.$content{'message'}.
'<br /></p>';	'<br /></p>';
Line 453 sub retrieve_author_res_msg {	Line 651 sub retrieve_author_res_msg {
}	}


# =============================== Delete all author messages related to one URL


sub del_url_author_res_msg {	sub del_url_author_res_msg {
my $url=shift;	my $url=shift;
$url=&Apache::lonnet::declutter($url);	$url=&Apache::lonnet::declutter($url);
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);	my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
my @delmsgs=();	my @delmsgs=();
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {	foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
if ($_=~/^\Q$url\E\_\d+$/) {	if ($msg =~ /^\Q$url\E\_\d+$/) {
push (@delmsgs,$_);	push (@delmsgs,$msg);
}	}
}	}
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);	return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
}	}
# =================================== Clear out all author messages in URL path

sub clear_author_res_msg {	sub clear_author_res_msg {
my $url=shift;	my $url=shift;
$url=&Apache::lonnet::declutter($url);	$url=&Apache::lonnet::declutter($url);
my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);	my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
my @delmsgs=();	my @delmsgs=();
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {	foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
if ($_=~/^\Q$url\E/) {	if ($msg =~ /^\Q$url\E/) {
push (@delmsgs,$_);	push (@delmsgs,$msg);
}	}
}	}
return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);	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 {	sub all_url_author_res_msg {
my ($author,$domain)=@_;	my ($author,$domain)=@_;
my %returnhash=();	my %returnhash=();
foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {	foreach my $msg (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
$_=~/^(.+)\_\d+/;	$msg =~ /^(.+)\_\d+/;
$returnhash{$1}=1;	$returnhash{$1}=1;
}	}
return %returnhash;	return %returnhash;
}	}

# ====================================== Add a comment to the User Notes screen

sub store_instructor_comment {	sub store_instructor_comment {
my ($msg,$uname,$udom) = @_;	my ($msg,$uname,$udom) = @_;
Line 508 sub store_instructor_comment {	Line 707 sub store_instructor_comment {
return $result;	return $result;
}	}

# ================================================== Critical message to a user

sub user_crit_msg_raw {	sub user_crit_msg_raw {
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,	my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
$nosentstore,$recipid,$attachmenturl)=@_;	$nosentstore,$recipid,$attachmenturl,$permresults)=@_;
# Check if allowed missing	# Check if allowed missing
my ($status,$packed_message);	my ($status,$packed_message);
my $msgid='undefined';	my $msgid='undefined';
Line 543 sub user_crit_msg_raw {	Line 741 sub user_crit_msg_raw {

# Notifications	# Notifications
my %userenv = &Apache::loncommon::getemails($user,$domain);	my %userenv = &Apache::loncommon::getemails($user,$domain);
if ($userenv{'critnotification'}) {	my $critnotify = $userenv{'critnotification'};
&sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,	my $permemail = $userenv{'permanentemail'};
$text,$msgid);	my $numcrit = 0;
}	my $numperm = 0;
if ($toperm && $userenv{'permanentemail'}) {	my $permlogmsgstatus;
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,	if ($critnotify) {
$text,$msgid);	$numcrit = &sendnotification($critnotify,$user,$domain,$subject,1,$text,$msgid);
	}
	if ($toperm && $permemail) {
	if ($critnotify && $numcrit) {
	if (grep(/^\Q$permemail\E/,split(/,/,$critnotify))) {
	$numperm = 1;
	}
	}
	unless ($numperm) {
	$numperm = &sendnotification($permemail,$user,$domain,$subject,1,$text,$msgid);
	}
	}
	if ($toperm) {
	$permlogmsgstatus = '. Perm. email log status '.
	&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
	"Perm. e-mail count $numperm for $user at $domain");
	if (ref($permresults) eq 'HASH') {
	$permresults->{"$user:$domain"} = $numperm;
	}
}	}
# Log this	# Log this
&Apache::lonnet::logthis(	&Apache::lonnet::logthis(
'Sending critical email '.$msgid.	'Sending critical '.$msgid.
', log status: '.	', log status: '.
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},	&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
$env{'user.home'},	$env{'user.home'},
'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '	'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status '
.$status));	.$status).$permlogmsgstatus);
return $status;	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 {	sub user_crit_msg {
my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,	my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage,
$nosentstore,$recipid,$attachmenturl)=@_;	$nosentstore,$recipid,$attachmenturl,$permresults)=@_;
my @status;	my @status;
my %userenv = &Apache::lonnet::get('environment',['msgforward'],	my %userenv = &Apache::lonnet::get('environment',['msgforward'],
$domain,$user);	$domain,$user);
Line 594 sub user_crit_msg {	Line 793 sub user_crit_msg {
push(@status,	push(@status,
&user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,	&user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
$sendback,$toperm,$sentmessage,$nosentstore,	$sendback,$toperm,$sentmessage,$nosentstore,
$recipid,$attachmenturl));	$recipid,$attachmenturl,$permresults));
}	}
} else {	} else {
push(@status,	push(@status,
&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,	&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
$toperm,$sentmessage,$nosentstore,$recipid,	$toperm,$sentmessage,$nosentstore,$recipid,
$attachmenturl));	$attachmenturl,$permresults));
}	}
if (wantarray) {	if (wantarray) {
return @status;	return @status;
Line 608 sub user_crit_msg {	Line 807 sub user_crit_msg {
return join(' ',@status);	return join(' ',@status);
}	}

# =================================================== Critical message received

sub user_crit_received {	sub user_crit_received {
my $msgid=shift;	my $msgid=shift;
Line 644 sub user_crit_received {	Line 842 sub user_crit_received {
return $status;	return $status;
}	}

# ======================================================== Normal communication


sub user_normal_msg_raw {	sub user_normal_msg_raw {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,	my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
$toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,	$toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
$error,$nosentstore,$recipid)=@_;	$error,$nosentstore,$recipid,$permresults)=@_;
# Check if allowed missing	# Check if allowed missing
my ($status,$packed_message);	my ($status,$packed_message);
my $msgid='undefined';	my $msgid='undefined';
Line 686 sub user_normal_msg_raw {	Line 885 sub user_normal_msg_raw {
}	}
# Notifications	# Notifications
my %userenv = &Apache::loncommon::getemails($user,$domain);	my %userenv = &Apache::loncommon::getemails($user,$domain);
if ($userenv{'notification'}) {	my $notify = $userenv{'notification'};
&sendnotification($userenv{'notification'},$user,$domain,$subject,0,	my $permemail = $userenv{'permanentemail'};
$text,$msgid);	my $numnotify = 0;
	my $numperm = 0;
	my $permlogmsgstatus;
	if ($notify) {
	$numnotify = &sendnotification($notify,$user,$domain,$subject,0,$text,$msgid);
}	}
if ($toperm && $userenv{'permanentemail'}) {	if ($toperm && $permemail) {
if ((!$userenv{'notification'}) \|\| ($userenv{'notification'} ne $userenv{'permanentemail'})) {	if ($notify && $numnotify) {
&sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,	if (grep(/^\Q$permemail\E/,split(/,/,$notify))) {
$text,$msgid);	$numperm = 1;
	}
	}
	unless ($numperm) {
	$numperm = &sendnotification($permemail,$user,$domain,$subject,0,
	$text,$msgid);
	}
	}
	if ($toperm) {
	$permlogmsgstatus = '. Perm. email log status '.
	&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
	"Perm. e-mail count $numperm for $user at $domain");
	if (ref($permresults) eq 'HASH') {
	$permresults->{"$user:$domain"} = $numperm;
}	}
}	}
&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},	&Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
$env{'user.home'},	$env{'user.home'},
'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);	'Sending '.$msgid.' to '.$user.' at '.$domain.' with status '.$status.
	$permlogmsgstatus);
} else {	} else {
$status='no_host';	$status='no_host';
}	}
return $status;	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 {	sub user_normal_msg {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,	my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_;	$toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid,
	$permresults)=@_;
my @status;	my @status;
my %userenv = &Apache::lonnet::get('environment',['msgforward'],	my %userenv = &Apache::lonnet::get('environment',['msgforward'],
$domain,$user);	$domain,$user);
my $msgforward=$userenv{'msgforward'};	my $msgforward=$userenv{'msgforward'};
if ($msgforward) {	if ($msgforward) {
foreach (split(/\,/,$msgforward)) {	foreach my $fwd (split(/\,/,$msgforward)) {
my ($forwuser,$forwdomain)=split(/\:/,$_);	my ($forwuser,$forwdomain)=split(/\:/,$fwd);
push(@status,	push(@status,
&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,	&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
$citation,$baseurl,$attachmenturl,$toperm,	$citation,$baseurl,$attachmenturl,$toperm,
undef,undef,$sentmessage,undef,$symb,	undef,undef,$sentmessage,undef,$symb,
$restitle,$error,$nosentstore,$recipid));	$restitle,$error,$nosentstore,$recipid,$permresults));
}	}
} else {	} else {
push(@status,&user_normal_msg_raw($user,$domain,$subject,$message,	push(@status,&user_normal_msg_raw($user,$domain,$subject,$message,
$citation,$baseurl,$attachmenturl,$toperm,	$citation,$baseurl,$attachmenturl,$toperm,
undef,undef,$sentmessage,undef,$symb,	undef,undef,$sentmessage,undef,$symb,
$restitle,$error,$nosentstore,$recipid));	$restitle,$error,$nosentstore,$recipid,$permresults));
}	}
if (wantarray) {	if (wantarray) {
return @status;	return @status;
Line 753 sub user_normal_msg {	Line 952 sub user_normal_msg {
}	}

sub process_sent_mail {	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;	my $sentsubj;
if ($numsent > 1) {	if ($numsent > 1) {
$sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj;	$sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj;
Line 807 sub store_recipients {	Line 1008 sub store_recipients {
}	}
}	}

# =============================================================== Folder suffix

sub foldersuffix {	sub foldersuffix {
my $folder=shift;	my $folder=shift;
Line 822 sub foldersuffix {	Line 1022 sub foldersuffix {
return $suffix;	return $suffix;
}	}

# ========================================================= User-defined folders

sub get_user_folders {	sub get_user_folders {
my ($folder) = @_;	my ($folder) = @_;
Line 843 sub secapply {	Line 1042 sub secapply {
my $rec=shift;	my $rec=shift;
my $defaultflag=shift;	my $defaultflag=shift;
$rec=~s/\s+//g;	$rec=~s/\s+//g;
$rec=~s/\@/\:/g;	unless ($rec =~ /\:/) {
	$rec=~s/\@/\:/g;
	}
my ($adr,$sections_or_groups)=($rec=~/^([^$]+)\(([^$]+)\)/);	my ($adr,$sections_or_groups)=($rec=~/^([^$]+)\(([^$]+)\)/);
if ($sections_or_groups) {	if ($sections_or_groups) {
foreach my $item (split(/\;/,$sections_or_groups)) {	foreach my $item (split(/\;/,$sections_or_groups)) {
Line 863 sub secapply {	Line 1064 sub secapply {
return '';	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 {	sub decide_receiver {
my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;	my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_;
&Apache::lonenc::check_decrypt(\$feedurl);	&Apache::lonenc::check_decrypt(\$feedurl);
Line 929 sub decide_receiver {	Line 1103 sub decide_receiver {
return ($typestyle,%to);	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::loncommon::get_genlanguages(@userlangs);
my $user_lh = Apache::localize->get_handle(@languages);
return $user_lh;
}

=pod

=back

=cut

1;	1;
__END__	__END__

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

Removed from v.1.214
changed lines
	Added in v.1.239.2.2