--- loncom/interface/lonmsg.pm 2001/08/03 14:54:52 1.13
+++ loncom/interface/lonmsg.pm 2006/03/16 22:12:17 1.178
@@ -1,71 +1,236 @@
# The LearningOnline Network with CAPA
-#
# Routines for messaging
#
-# (Routines to control the menu
+# $Id: lonmsg.pm,v 1.178 2006/03/16 22:12:17 albertel Exp $
+#
+# Copyright Michigan State University Board of Trustees
+#
+# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
-# (TeX Conversion Module
+# LON-CAPA is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 2 of the License, or
+# (at your option) any later version.
#
-# 05/29/00,05/30 Gerd Kortemeyer)
+# LON-CAPA is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
#
-# 10/05 Gerd Kortemeyer)
+# You should have received a copy of the GNU General Public License
+# along with LON-CAPA; if not, write to the Free Software
+# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
-# 10/19,10/20,10/30,
-# 02/06/01 Gerd Kortemeyer
-# 07/27 Guy Albertelli
-# 07/27,07/28,07/30,08/03 Gerd Kortemeyer
+# /home/httpd/html/adm/gpl.txt
+#
+# http://www.lon-capa.org/
+#
+
package Apache::lonmsg;
+=pod
+
+=head1 NAME
+
+Apache::lonmsg: supports internal messaging
+
+=head1 SYNOPSIS
+
+lonmsg provides routines for sending messages, receiving messages, and
+a handler to allow users to read, send, and delete messages.
+
+=head1 OVERVIEW
+
+=head2 Messaging Overview
+
+XLON-CAPA provides an internal messaging system similar to
+email, but customized for LON-CAPA's usage. LON-CAPA implements its
+own messaging system, rather then building on top of email, because of
+the features LON-CAPA messages can offer that conventional e-mail can
+not:
+
+=over 4
+
+=item * B: A message the recipient B
+acknowlegde receipt of before they are allowed to continue using the
+system, preventing a user from claiming they never got a message
+
+=item * B: LON-CAPA can reliably send reciepts informing the
+sender that it has been read; again, useful for preventing students
+from claiming they did not see a message. (While conventional e-mail
+has some reciept support, it's sporadic, e-mail client-specific, and
+generally the receiver can opt to not send one, making it useless in
+this case.)
+
+=item * B: LON-CAPA knows about the sender, such as where
+they are in a course. When a student mails an instructor asking for
+help on the problem, the instructor receives not just the student's
+question, but all submissions the student has made up to that point,
+the user's rendering of the problem, and the complete view the student
+saw of the resource, including discussion up to that point. Finally,
+the instructor is reading all of this inside of LON-CAPA, not their
+email program, so they have full access to LON-CAPA's grading
+interface, or other features they may wish to use in response to the
+student's query.
+
+=item * B: LON-CAPA can block display of e-mails that are
+sent to a student during an online exam. A course coordinator or
+instructor can set an open and close date/time for scheduled online
+exams in a course. If a user uses the LON-CAPA internal messaging
+system to display e-mails during the scheduled blocking event,
+display of all e-mail sent during the blocking period will be
+suppressed, and a message of explanation, including details of the
+currently active blocking periods will be displayed instead. A user
+who has a course coordinator or instructor role in a course will be
+unaffected by any blocking periods for the course, unless the user
+also has a student role in the course, AND has selected the student role.
+
+=back
+
+Users can ask LON-CAPA to forward messages to conventional e-mail
+addresses on their B screen, but generally, LON-CAPA messages
+are much more useful than traditional email can be made to be, even
+with HTML support.
+
+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 FUNCTIONS
+
+=over 4
+
+=cut
+
use strict;
-use Apache::lonnet();
+use Apache::lonnet;
use vars qw($msgcount);
-use HTML::TokeParser;
+use HTML::TokeParser();
use Apache::Constants qw(:common);
+use Apache::loncommon();
+use Apache::lontexconvert();
+use HTML::Entities();
+use Mail::Send;
+use Apache::lonlocal;
+use Apache::loncommunicate;
+use Apache::lonfeedback;
+use Apache::lonrss();
+
+# Querystring component with sorting type
+my $sqs;
+my $startdis;
+my $interdis;
# ===================================================================== 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)=@_;
+ $message =&HTML::Entities::encode($message,'<>&"');
+ $citation=&HTML::Entities::encode($citation,'<>&"');
+ $subject =&HTML::Entities::encode($subject,'<>&"');
+ #remove machine specification
+ $baseurl =~ s|^http://[^/]+/|/|;
+ $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
+ #remove machine specification
+ $attachmenturl =~ s|^http://[^/]+/|/|;
+ $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
+ my $course_context;
+ if (defined($env{'form.replyid'})) {
+ my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
+ split(/\:/,&Apache::lonnet::unescape($env{'form.replyid'}));
+ $course_context = $origcid;
+ }
+ foreach my $key (keys(%env)) {
+ if ($key=~/^form\.(rep)?rec\_(.*)$/) {
+ my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
+ split(/\:/,&Apache::lonnet::unescape($2));
+ $course_context = $origcid;
+ last;
+ }
+ }
+ unless(defined($course_context)) {
+ $course_context = $env{'request.course.id'};
+ }
my $now=time;
$msgcount++;
- my $partsubj=$subject;
- $partsubj=&Apache::lonnet::escape($partsubj);
- $partsubj=substr($partsubj,0,50);
- my $msgid=&Apache::lonnet::escape(
- $now.':'.$partsubj.':'.$ENV{'user.name'}.':'.
- $ENV{'user.domain'}.':'.$msgcount.':'.$$);
- return $msgid,
- ''.$ENV{'user.name'}.''.
- ''.$ENV{'user.domain'}.''.
+ unless(defined($msgid)) {
+ $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
+ $msgcount,$course_context,$$);
+ }
+ 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 (ref($recuser) eq 'ARRAY') {
+ for (my $i=0; $i<@{$recuser}; $i++) {
+ if ($type eq 'dcmail') {
+ my ($username,$email) = split(/:/,$$recuser[$i]);
+ $username = &Apache::lonnet::unescape($username);
+ $email = &Apache::lonnet::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.'';
+ }
+ return $msgid,$result;
}
# ================================================== Unpack message into a hash
sub unpackagemsg {
- my $message=shift;
+ my ($message,$notoken)=@_;
my %content=();
my $parser=HTML::TokeParser->new(\$message);
my $token;
@@ -73,7 +238,28 @@ 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'}) {
+ my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
+ if ($notoken) {
+ $content{'message'}.='
");
+ $r->print(&mt('These').' '.$numblocked.' '.&mt('messages are not viewable because '));
+ }
+ $r->print(
+&mt('display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams').'.');
+ &build_block_table($r,$startblock,$endblock,\%setters);
+ }
+}
+
+
+# ======================================================== Display all messages
+
+sub disall {
+ my ($r,$folder)=@_;
+ $r->print(&folderlist($folder));
+ if ($folder eq 'new') {
+ &disnew($r);
+ } elsif ($folder eq 'critical') {
+ &discrit($r);
+ } else {
+ &disfolder($r,$folder);
+ }
+}
+
+# ============================================================ Display a folder
+
+sub disfolder {
+ my ($r,$folder)=@_;
+ my %blocked = ();
+ my %setters = ();
+ my $startblock;
+ my $endblock;
+ my $numblocked = 0;
+ &blockcheck(\%setters,\$startblock,\$endblock);
+ $r->print(<
+ function checkall() {
+ for (i=0; i
+ENDDISHEADER
+ my $fsqs='&folder='.$folder;
+ my @temp=sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
+ my $totalnumber=$#temp+1;
+ unless ($totalnumber>0) {
+ $r->print('
'.&mt('Empty Folder').'
');
+ return;
+ }
+ unless ($interdis) {
+ $interdis=20;
+ }
+ my $number=int($totalnumber/$interdis);
+ if (($startdis<0) || ($startdis>$number)) { $startdis=$number; }
+ my $firstdis=$interdis*$startdis;
+ if ($firstdis>$#temp) { $firstdis=$#temp-$interdis+1; }
+ my $lastdis=$firstdis+$interdis-1;
+ if ($lastdis>$#temp) { $lastdis=$#temp; }
+ $r->print(&scrollbuttons($startdis,$number,$firstdis,$lastdis,$totalnumber));
+ $r->print('');
+ if ($numblocked > 0) {
+ my $beginblock = &Apache::lonlocal::locallocaltime($startblock);
+ my $finishblock = &Apache::lonlocal::locallocaltime($endblock);
+ $r->print('
'.
+ $numblocked.' '.&mt('message(s) is/are not viewable because display of LON-CAPA messages sent to you by other students between').' '.$beginblock.' '.&mt('and').' '.$finishblock.' '.&mt('is currently being blocked because of online exams.'));
+ &build_block_table($r,$startblock,$endblock,\%setters);
+ }
+}
+
+# ============================================================== Compose output
+
+sub compout {
+ my ($r,$forwarding,$replying,$broadcast,$replycrit,$folder,$dismode)=@_;
+ my $suffix=&foldersuffix($folder);
+
+ if ($broadcast eq 'individual') {
+ &printheader($r,'/adm/email?compose=individual',
+ 'Send a Message');
+ } elsif ($broadcast) {
+ &printheader($r,'/adm/email?compose=group',
+ 'Broadcast Message');
+ } elsif ($forwarding) {
+ &Apache::lonhtmlcommon::add_breadcrumb
+ ({href=>"/adm/email?display=".&Apache::lonnet::escape($forwarding),
+ text=>"Display Message"});
+ &printheader($r,'/adm/email?forward='.&Apache::lonnet::escape($forwarding),
+ 'Forwarding a Message');
+ } elsif ($replying) {
+ &Apache::lonhtmlcommon::add_breadcrumb
+ ({href=>"/adm/email?display=".&Apache::lonnet::escape($replying),
+ text=>"Display Message"});
+ &printheader($r,'/adm/email?replyto='.&Apache::lonnet::escape($replying),
+ 'Replying to a Message');
+ } elsif ($replycrit) {
+ $r->print('
'.&mt('Replying to a Critical Message').'
');
+ $replying=$replycrit;
+ } else {
+ &printheader($r,'/adm/email?compose=upload',
+ 'Distribute from Uploaded File');
+ }
+
+ my $dispcrit='';
+ my $dissub='';
+ my $dismsg='';
+ my $disbase='';
+ my $func=&mt('Send New');
+ my %lt=&Apache::lonlocal::texthash('us' => 'Username',
+ 'do' => 'Domain',
+ 'ad' => 'Additional Recipients',
+ 'sb' => 'Subject',
+ 'ca' => 'Cancel',
+ 'ma' => 'Mail');
+
+ if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})) {
+ my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
$dispcrit=
- ' Send as critical message
');
+ &disfacetoface($r,$env{'form.recuname'},$env{'form.recdomain'});
+ $r->print(<
+
+
+ENDRHEAD
+ $r->print(<$lt{'newr'}
+
+
+
+
+
+ENDBFORM
+ }
+}
+
+# ----------------------------------------------------------- Blocking during exams
+
+sub examblock {
+ my ($r,$action) = @_;
+ unless ($env{'request.course.id'}) { return;}
+ if (!&Apache::lonnet::allowed('srm',$env{'request.course.id'})
+ && ! &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
+ '/'.$env{'request.course.sec'})) {
+ $r->print('Not allowed');
+ return;
+ }
+ my %lt=&Apache::lonlocal::texthash(
+ 'comb' => 'Communication Blocking',
+ 'cbds' => 'Communication blocking during scheduled exams',
+ 'desc' => 'You can use communication blocking to prevent students enrolled in this course from displaying LON-CAPA messages sent by other students during an online exam. As blocking of communication could potentially interrupt legitimate communication between students who are also both enrolled in a different LON-CAPA course, please be careful that you select the correct start and end times for your scheduled exam when setting or modifying these parameters.',
+ 'mecb' => 'Modify existing communication blocking periods',
+ 'ncbc' => 'No communication blocks currently stored'
+ );
+
+ my %ltext = &Apache::lonlocal::texthash(
+ 'dura' => 'Duration',
+ 'setb' => 'Set by',
+ 'even' => 'Event',
+ 'actn' => 'Action',
+ 'star' => 'Start',
+ 'endd' => 'End'
+ );
+
+ &printheader($r,'/adm/email?block=display',$lt{'comb'});
+ $r->print('
+END
+ return;
+}
+
+sub blockcheck {
+ my ($setters,$startblock,$endblock) = @_;
+ # Retrieve active student roles and active course coordinator/instructor roles
+ my @livecses = ();
+ my @staffcses = ();
+ $$startblock = 0;
+ $$endblock = 0;
+ foreach (keys %env) {
+ if ($_ =~ m-^user\.role\.(st|cc|in)\./(.+)$-) {
+ my $role = $1;
+ my $cse = $2;
+ $cse =~ s|/|_|;
+ if ($env{$_} =~ m/^(\d*)\.(\d*)$/) {
+ unless (($2 > 0 && $2 < time) || ($1 > time)) {
+ if ($role eq 'st') {
+ push @livecses, $cse;
+ } else {
+ unless (grep/^$cse$/,@staffcses) {
+ push @staffcses, $cse;
+ }
+ }
+ }
+ }
+ } elsif ($_ =~ m-user\.role\.cr/(\w+)/(\w+)/([^/]+)\./(.+)$- ) {
+ my $rolepriv = $env{'user.role..rolesdef_'.$3};
+ }
+ }
+ # Retrieve blocking times and identity of blocker for active courses for students.
+ if (@livecses > 0) {
+ foreach my $cse (@livecses) {
+ my ($cdom,$crs) = split/_/,$cse;
+ if ( (grep/^$cse$/,@staffcses) && ($env{'request.role'} !~ m-^st\./$cdom/$crs$-) ) {
+ next;
+ } else {
+ %{$$setters{$cse}} = ();
+ @{$$setters{$cse}{'staff'}} = ();
+ @{$$setters{$cse}{'times'}} = ();
+ my %records = &Apache::lonnet::dump('comm_block',$cdom,$crs);
+ foreach (keys %records) {
+ if ($_ =~ m/^(\d+)____(\d+)$/) {
+ if ($1 <= time && $2 >= time) {
+ my ($staff,$title) = split/:/,$records{$_};
+ push @{$$setters{$cse}{'staff'}}, $staff;
+ push @{$$setters{$cse}{'times'}}, $_;
+ if ( ($$startblock == 0) || ($$startblock > $1) ) {
+ $$startblock = $1;
+ }
+ if ( ($$endblock == 0) || ($$endblock < $2) ) {
+ $$endblock = $2;
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+}
+
+sub build_block_table {
+ my ($r,$startblock,$endblock,$setters) = @_;
+ my $function = &Apache::loncommon::get_users_function();
+ my $color = &Apache::loncommon::designparm($function.'.tabbg',
+ $env{'user.domain'});
+ my %lt = &Apache::lonlocal::texthash(
+ 'cacb' => 'Currently active communication blocks',
+ 'cour' => 'Course',
+ 'dura' => 'Duration',
+ 'blse' => 'Block set by'
+ );
+ $r->print(<<"END");
+ $lt{'cacb'}:
+
+
+
+
+
+
+
+
+
$lt{'cour'}
+
$lt{'dura'}
+
$lt{'blse'}
+
+END
+ foreach (keys %{$setters}) {
+ my %courseinfo=&Apache::lonnet::coursedescription($_);
+ for (my $i=0; $i<@{$$setters{$_}{staff}}; $i++) {
+ my ($uname,$udom) = split/\@/,$$setters{$_}{staff}[$i];
+ my $fullname = &Apache::loncommon::plainname($uname,$udom);
+ my ($openblock,$closeblock) = split/____/,$$setters{$_}{times}[$i];
+ $openblock = &Apache::lonlocal::locallocaltime($openblock);
+ $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
+ $r->print('
'.$courseinfo{'description'}.'
'.
+ '
'.$openblock.' to '.$closeblock.'
'.
+ '
'.$fullname.' ('.$uname.'@'.$udom.
+ ')
');
+ }
+ }
+ $r->print('
');
+}
+
+# ----------------------------------------------------------- Display a message
+
+sub displaymessage {
+ my ($r,$msgid,$folder)=@_;
+ my $suffix=&foldersuffix($folder);
+ my %blocked = ();
+ my %setters = ();
+ my $startblock = 0;
+ my $endblock = 0;
+ my $numblocked = 0;
+# info to generate "next" and "previous" buttons and check if message is blocked
+ &blockcheck(\%setters,\$startblock,\$endblock);
+ my @messages=&sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
+ if ( $blocked{$msgid} eq 'ON' ) {
+ &printheader($r,'/adm/email',&mt('Display a Message'));
+ $r->print(&mt('You attempted to display a message that is currently blocked because you are enrolled in one or more courses for which there is an ongoing online exam.'));
+ &build_block_table($r,$startblock,$endblock,\%setters);
+ return;
+ }
+ &statuschange($msgid,'read',$folder);
+ my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
+ my %content=&unpackagemsg($message{$msgid});
+
+ my $counter=0;
+ $r->print('
');
+ my $number_of_messages = scalar(@messages); #subtract 1 for last index
+# start output
+ &printheader($r,'/adm/email?display='.&Apache::lonnet::escape($msgid),'Display a Message','',$content{'baseurl'});
+ my %courseinfo=&Apache::lonnet::coursedescription($content{'courseid'});
+# Functions
+ $r->print('
'.&displayresource(%content).'');
+ return;
+}
+
+# =========================================================== Show the citation
+
+sub displayresource {
+ my %content=@_;
+#
+# If the recipient is in the same course that the message was sent from and
+# has sufficient privileges, show "all details," else show citation
+#
+ if (($env{'request.course.id'} eq $content{'courseid'})
+ && (&Apache::lonnet::allowed('vgr',$content{'courseid'}))) {
+ my $symb=&Apache::lonnet::symbread($content{'baseurl'});
+# Could not get a symb, give up
+ unless ($symb) { return $content{'citation'}; }
+# Have a symb, can render
+ return '
'.&mt('Current attempts of student (if applicable)').'