--- loncom/interface/lonmsg.pm 2006/12/13 01:45:15 1.190
+++ loncom/interface/lonmsg.pm 2007/02/23 00:39:31 1.197
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Routines for messaging
#
-# $Id: lonmsg.pm,v 1.190 2006/12/13 01:45:15 raeburn Exp $
+# $Id: lonmsg.pm,v 1.197 2007/02/23 00:39:31 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -47,7 +47,7 @@ use LONCAPA qw(:DEFAULT :match);
sub packagemsg {
my ($subject,$message,$citation,$baseurl,$attachmenturl,
- $recuser,$recdomain,$msgid,$type,$crsmsgid)=@_;
+ $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
$message =&HTML::Entities::encode($message,'<>&"');
$citation=&HTML::Entities::encode($citation,'<>&"');
$subject =&HTML::Entities::encode($subject,'<>&"');
@@ -78,7 +78,7 @@ sub packagemsg {
my $msgcount = &get_uniq();
unless(defined($msgid)) {
$msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
- $msgcount,$course_context,$$);
+ $msgcount,$course_context,$symb,$error,$$);
}
my $result = ''.$env{'user.name'}.''.
''.$env{'user.domain'}.''.
@@ -134,7 +134,18 @@ sub packagemsg {
if (defined($attachmenturl)) {
$result.= ''.$attachmenturl.'';
}
- return $msgid,$result;
+ if (defined($symb)) {
+ $result.= ''.$symb.'';
+ if (defined($course_context)) {
+ if ($course_context eq $env{'request.course.id'}) {
+ my $resource_title = &Apache::lonnet::gettitle($symb);
+ if (defined($resource_title)) {
+ $result .= ''.$resource_title.'';
+ }
+ }
+ }
+ }
+ return ($msgid,$result);
}
# ================================================== Unpack message into a hash
@@ -178,19 +189,21 @@ sub unpackagemsg {
# ======================================================= Get info out of msgid
sub buildmsgid {
- my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_;
+ my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
$subject=&escape($subject);
+ $symb = &escape($symb);
return(&escape($now.':'.$subject.':'.$uname.':'.
- $udom.':'.$msgcount.':'.$course_context.':'.$pid));
+ $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
}
sub unpackmsgid {
my ($msgid,$folder,$skipstatus,$status_cache)=@_;
$msgid=&unescape($msgid);
my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
- $processid)=split(/\:/,&unescape($msgid));
+ $processid,$symb,$error) = split(/\:/,&unescape($msgid));
$shortsubj = &unescape($shortsubj);
$shortsubj = &HTML::Entities::decode($shortsubj);
+ $symb = &unescape($symb);
if (!defined($processid)) { $fromcid = ''; }
my %status=();
unless ($skipstatus) {
@@ -203,7 +216,7 @@ sub unpackmsgid {
if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
unless ($status{$msgid}) { $status{$msgid}='new'; }
}
- return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid);
+ return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
}
@@ -233,7 +246,7 @@ sub sendemail {
# ==================================================== Send notification emails
sub sendnotification {
- my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
+ my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_;
my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
unless ($sender=~/\w/) {
$sender=$env{'user.name'}.'@'.$env{'user.domain'};
@@ -245,21 +258,36 @@ sub sendnotification {
my $url='http://'.
$Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
'/adm/email?username='.$touname.'&domain='.$toudom;
- my $body=(<: Sends a message to the
- $user at $domain, with subject $subject and message $message.
+=item * B:
+ Sends a message to the $user at $domain, with subject $subject and message $message.
=cut
sub user_normal_msg {
my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
- $toperm,$sentmessage)=@_;
+ $toperm,$sentmessage,$symb,$restitle,$error)=@_;
my $status='';
my %userenv = &Apache::lonnet::get('environment',['msgforward'],
$domain,$user);
@@ -579,12 +613,12 @@ sub user_normal_msg {
$status.=
&user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
$citation,$baseurl,$attachmenturl,$toperm,
- undef,undef,$sentmessage).' ';
+ undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
}
- } else {
+ } else {
$status=&user_normal_msg_raw($user,$domain,$subject,$message,
$citation,$baseurl,$attachmenturl,$toperm,
- undef,undef,$sentmessage);
+ undef,undef,$sentmessage,undef,$symb,$restitle,$error);
}
return $status;
}
@@ -631,6 +665,100 @@ sub get_user_folders {
return %userfolders;
}
+sub secapply {
+ my $rec=shift;
+ my $defaultflag=shift;
+ $rec=~s/\s+//g;
+ $rec=~s/\@/\:/g;
+ my ($adr,$sections_or_groups)=($rec=~/^([^\(]+)\(([^\)]+)\)/);
+ if ($sections_or_groups) {
+ foreach my $item (split(/\;/,$sections_or_groups)) {
+ if (($item eq $env{'request.course.sec'}) ||
+ ($defaultflag && ($item eq '*'))) {
+ return $adr;
+ } elsif ($env{'request.course.groups'}) {
+ my @usersgroups = split(/:/,$env{'request.course.groups'});
+ if (grep(/^\Q$item\E$/,@usersgroups)) {
+ return $adr;
+ }
+ }
+ }
+ } else {
+ return $rec;
+ }
+ return '';
+}
+
+=pod
+
+=over 4
+
+=item *
+
+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.
+ 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);
+ my $typestyle='';
+ my %to=();
+ if ($env{'form.discuss'} eq 'author' ||$author) {
+ $typestyle.='Submitting as Author Feedback
';
+ $feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/};
+ $to{$2.':'.$1}=1;
+ }
+ my $cid = $env{'request.course.id'};
+ if ($env{'form.discuss'} eq 'question' ||$question) {
+ $typestyle.=&mt('Submitting as Question').'
';
+ foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) {
+ my $rec=&secapply($item,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ($env{'form.discuss'} eq 'course' ||$course) {
+ $typestyle.=&mt('Submitting as Comment').'
';
+ foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) {
+ my $rec=&secapply($item,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ($env{'form.discuss'} eq 'policy' ||$policy) {
+ $typestyle.=&mt('Submitting as Policy Feedback').'
';
+ foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) {
+ my $rec=&secapply($item,$defaultflag);
+ if ($rec) { $to{$rec}=1; }
+ }
+ }
+ if ((scalar(%to) eq '0') && (!$defaultflag)) {
+ ($typestyle,%to)=
+ &decide_receiver($feedurl,$author,$question,$course,$policy,1);
+ }
+ return ($typestyle,%to);
+}
+
1;
__END__