File:
[LON-CAPA] /
loncom /
interface /
lonmsg.pm
Revision
1.159:
download - view:
text,
annotated -
select for diffs
Tue Nov 29 22:41:30 2005 UTC (18 years, 7 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
Bug 3999. Critical and Broadcast messages now handled similarly. For each recipient a copy of the message is stored in the nohist_email db for the course, with subject Critical. [$user:$domain] or Broadcast. [$user:$domain] to allow for straightfoward construction of the Record page for each user in a course. A separate copy (with a different subjeca)t is stored in the nohist_email_sent db file, to alllow a more meaningful isubject in the sent mail folder display. The timestamp, courseID, and process ID parts of the msgIDs are common to the messages in the two db files. Also double escaping of message content is no$w used for both Critical and Broadcast so User records will display subject and message in both cases. Legacy broadcast messages still supported through use of Broadcast. as identifier of new style (compared with Broadcast for old style.
1: # The LearningOnline Network with CAPA
2: # Routines for messaging
3: #
4: # $Id: lonmsg.pm,v 1.159 2005/11/29 22:41:30 raeburn Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28:
29:
30: package Apache::lonmsg;
31:
32: =pod
33:
34: =head1 NAME
35:
36: Apache::lonmsg: supports internal messaging
37:
38: =head1 SYNOPSIS
39:
40: lonmsg provides routines for sending messages, receiving messages, and
41: a handler to allow users to read, send, and delete messages.
42:
43: =head1 OVERVIEW
44:
45: =head2 Messaging Overview
46:
47: X<messages>LON-CAPA provides an internal messaging system similar to
48: email, but customized for LON-CAPA's usage. LON-CAPA implements its
49: own messaging system, rather then building on top of email, because of
50: the features LON-CAPA messages can offer that conventional e-mail can
51: not:
52:
53: =over 4
54:
55: =item * B<Critical messages>: A message the recipient B<must>
56: acknowlegde receipt of before they are allowed to continue using the
57: system, preventing a user from claiming they never got a message
58:
59: =item * B<Receipts>: LON-CAPA can reliably send reciepts informing the
60: sender that it has been read; again, useful for preventing students
61: from claiming they did not see a message. (While conventional e-mail
62: has some reciept support, it's sporadic, e-mail client-specific, and
63: generally the receiver can opt to not send one, making it useless in
64: this case.)
65:
66: =item * B<Context>: LON-CAPA knows about the sender, such as where
67: they are in a course. When a student mails an instructor asking for
68: help on the problem, the instructor receives not just the student's
69: question, but all submissions the student has made up to that point,
70: the user's rendering of the problem, and the complete view the student
71: saw of the resource, including discussion up to that point. Finally,
72: the instructor is reading all of this inside of LON-CAPA, not their
73: email program, so they have full access to LON-CAPA's grading
74: interface, or other features they may wish to use in response to the
75: student's query.
76:
77: =item * B<Blocking>: LON-CAPA can block display of e-mails that are
78: sent to a student during an online exam. A course coordinator or
79: instructor can set an open and close date/time for scheduled online
80: exams in a course. If a user uses the LON-CAPA internal messaging
81: system to display e-mails during the scheduled blocking event,
82: display of all e-mail sent during the blocking period will be
83: suppressed, and a message of explanation, including details of the
84: currently active blocking periods will be displayed instead. A user
85: who has a course coordinator or instructor role in a course will be
86: unaffected by any blocking periods for the course, unless the user
87: also has a student role in the course, AND has selected the student role.
88:
89: =back
90:
91: Users can ask LON-CAPA to forward messages to conventional e-mail
92: addresses on their B<PREF> screen, but generally, LON-CAPA messages
93: are much more useful than traditional email can be made to be, even
94: with HTML support.
95:
96: Right now, this document will cover just how to send a message, since
97: it is likely you will not need to programmatically read messages,
98: since lonmsg already implements that functionality.
99:
100: =head1 FUNCTIONS
101:
102: =over 4
103:
104: =cut
105:
106: use strict;
107: use Apache::lonnet;
108: use vars qw($msgcount);
109: use HTML::TokeParser();
110: use Apache::Constants qw(:common);
111: use Apache::loncommon();
112: use Apache::lontexconvert();
113: use HTML::Entities();
114: use Mail::Send;
115: use Apache::lonlocal;
116: use Apache::loncommunicate;
117: use Apache::lonfeedback;
118: use Apache::lonrss();
119:
120: # Querystring component with sorting type
121: my $sqs;
122: my $startdis;
123: my $interdis;
124:
125: # ===================================================================== Package
126:
127: sub packagemsg {
128: my ($subject,$message,$citation,$baseurl,$attachmenturl,
129: $recuser,$recdomain,$msgid)=@_;
130: $message =&HTML::Entities::encode($message,'<>&"');
131: $citation=&HTML::Entities::encode($citation,'<>&"');
132: $subject =&HTML::Entities::encode($subject,'<>&"');
133: #remove machine specification
134: $baseurl =~ s|^http://[^/]+/|/|;
135: $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
136: #remove machine specification
137: $attachmenturl =~ s|^http://[^/]+/|/|;
138: $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
139: my $course_context;
140: if (defined($env{'form.replyid'})) {
141: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
142: split(/\:/,&Apache::lonnet::unescape($env{'form.replyid'}));
143: $course_context = $origcid;
144: }
145: unless(defined($course_context)) {
146: $course_context = $env{'request.course.id'};
147: }
148: my $now=time;
149: $msgcount++;
150: unless(defined($msgid)) {
151: $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
152: $msgcount,$course_context,$$);
153: }
154: my $result='<sendername>'.$env{'user.name'}.'</sendername>'.
155: '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
156: '<subject>'.$subject.'</subject>'.
157: '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'.
158: '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
159: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
160: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
161: '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
162: '<browseros>'.$env{'browser.os'}.'</browseros>'.
163: '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
164: '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
165: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
166: '<courseid>'.$course_context.'</courseid>'.
167: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
168: '<role>'.$env{'request.role'}.'</role>'.
169: '<resource>'.$env{'request.filename'}.'</resource>'.
170: '<msgid>'.$msgid.'</msgid>';
171: if (ref($recuser) eq 'ARRAY') {
172: for (my $i=0; $i<@{$recuser}; $i++) {
173: $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
174: '<recdomain>'.$$recdomain[$i].'</recdomain>';
175: }
176: } else {
177: $result .= '<recuser>'.$recuser.'</recuser>'.
178: '<recdomain>'.$recdomain.'</recdomain>';
179: }
180: $result .= '<message>'.$message.'</message>';
181: if (defined($citation)) {
182: $result.='<citation>'.$citation.'</citation>';
183: }
184: if (defined($baseurl)) {
185: $result.= '<baseurl>'.$baseurl.'</baseurl>';
186: }
187: if (defined($attachmenturl)) {
188: $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
189: }
190: return $msgid,$result;
191: }
192:
193: # ================================================== Unpack message into a hash
194:
195: sub unpackagemsg {
196: my ($message,$notoken)=@_;
197: my %content=();
198: my $parser=HTML::TokeParser->new(\$message);
199: my $token;
200: while ($token=$parser->get_token) {
201: if ($token->[0] eq 'S') {
202: my $entry=$token->[1];
203: my $value=$parser->get_text('/'.$entry);
204: if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
205: push(@{$content{$entry}},$value);
206: } else {
207: $content{$entry}=$value;
208: }
209: }
210: }
211: if ($content{'attachmenturl'}) {
212: my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
213: if ($notoken) {
214: $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
215: } else {
216: &Apache::lonnet::allowuploaded('/adm/msg',
217: $content{'attachmenturl'});
218: $content{'message'}.='<p>'.&mt('Attachment').
219: ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
220: $fname.'</tt></a>';
221: }
222: }
223: return %content;
224: }
225:
226: # ======================================================= Get info out of msgid
227:
228: sub buildmsgid {
229: my ($now,$subject,$uname,$udom,$msgcount,$course_context,$pid) = @_;
230: $subject=&Apache::lonnet::escape($subject);
231: return(&Apache::lonnet::escape($now.':'.$subject.':'.$uname.':'.
232: $udom.':'.$msgcount.':'.$course_context.':'.$pid));
233: }
234:
235: sub unpackmsgid {
236: my ($msgid,$folder)=@_;
237: $msgid=&Apache::lonnet::unescape($msgid);
238: my $suffix=&foldersuffix($folder);
239: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid)=split(/\:/,
240: &Apache::lonnet::unescape($msgid));
241: my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
242: if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
243: unless ($status{$msgid}) { $status{$msgid}='new'; }
244: return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid);
245: }
246:
247:
248: sub sendemail {
249: my ($to,$subject,$body)=@_;
250: $body=
251: "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
252: "*** ".&mt('Please do not reply to this address.')."\n\n".$body;
253: my $msg = new Mail::Send;
254: $msg->to($to);
255: $msg->subject('[LON-CAPA] '.$subject);
256: if (my $fh = $msg->open()) {
257: print $fh $body;
258: $fh->close;
259: }
260: }
261:
262: # ==================================================== Send notification emails
263:
264: sub sendnotification {
265: my ($to,$touname,$toudom,$subj,$crit,$text)=@_;
266: my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
267: unless ($sender=~/\w/) {
268: $sender=$env{'user.name'}.'@'.$env{'user.domain'};
269: }
270: my $critical=($crit?' critical':'');
271: $text=~s/\<\;/\</gs;
272: $text=~s/\>\;/\>/gs;
273: $text=~s/\<\/*[^\>]+\>//gs;
274: my $url='http://'.
275: $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
276: '/adm/email?username='.$touname.'&domain='.$toudom;
277: my $body=(<<ENDMSG);
278: You received a$critical message from $sender in LON-CAPA. The subject is
279:
280: $subj
281:
282: === Excerpt ============================================================
283: $text
284: ========================================================================
285:
286: Use
287:
288: $url
289:
290: to access the full message.
291: ENDMSG
292: &sendemail($to,'New'.$critical.' message from '.$sender,$body);
293: }
294: # ============================================================= Check for email
295:
296: sub newmail {
297: if ((time-$env{'user.mailcheck.time'})>300) {
298: my %what=&Apache::lonnet::get('email_status',['recnewemail']);
299: &Apache::lonnet::appenv('user.mailcheck.time'=>time);
300: if ($what{'recnewemail'}>0) { return 1; }
301: }
302: return 0;
303: }
304:
305: # =============================== Automated message to the author of a resource
306:
307: =pod
308:
309: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
310: of the resource with the URI $filename.
311:
312: =cut
313:
314: sub author_res_msg {
315: my ($filename,$message)=@_;
316: unless ($message) { return 'empty'; }
317: $filename=&Apache::lonnet::declutter($filename);
318: my ($domain,$author,@dummy)=split(/\//,$filename);
319: my $homeserver=&Apache::lonnet::homeserver($author,$domain);
320: if ($homeserver ne 'no_host') {
321: my $id=unpack("%32C*",$message);
322: my $msgid;
323: ($msgid,$message)=&packagemsg($filename,$message);
324: return &Apache::lonnet::reply('put:'.$domain.':'.$author.
325: ':nohist_res_msgs:'.
326: &Apache::lonnet::escape($filename.'_'.$id).'='.
327: &Apache::lonnet::escape($message),$homeserver);
328: }
329: return 'no_host';
330: }
331:
332: # =========================================== Retrieve author resource messages
333:
334: sub retrieve_author_res_msg {
335: my $url=shift;
336: $url=&Apache::lonnet::declutter($url);
337: my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
338: my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
339: my $msgs='';
340: foreach (keys %errormsgs) {
341: if ($_=~/^\Q$url\E\_\d+$/) {
342: my %content=&unpackagemsg($errormsgs{$_});
343: $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
344: $content{'time'}.'</b>: '.$content{'message'}.
345: '<br /></p>';
346: }
347: }
348: return $msgs;
349: }
350:
351:
352: # =============================== Delete all author messages related to one URL
353:
354: sub del_url_author_res_msg {
355: my $url=shift;
356: $url=&Apache::lonnet::declutter($url);
357: my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
358: my @delmsgs=();
359: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
360: if ($_=~/^\Q$url\E\_\d+$/) {
361: push (@delmsgs,$_);
362: }
363: }
364: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
365: }
366: # =================================== Clear out all author messages in URL path
367:
368: sub clear_author_res_msg {
369: my $url=shift;
370: $url=&Apache::lonnet::declutter($url);
371: my ($domain,$author)=($url=~/^(\w+)\/(\w+)\//);
372: my @delmsgs=();
373: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
374: if ($_=~/^\Q$url\E/) {
375: push (@delmsgs,$_);
376: }
377: }
378: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
379: }
380: # ================= Return hash with URLs for which there is a resource message
381:
382: sub all_url_author_res_msg {
383: my ($author,$domain)=@_;
384: my %returnhash=();
385: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
386: $_=~/^(.+)\_\d+/;
387: $returnhash{$1}=1;
388: }
389: return %returnhash;
390: }
391:
392: # ================================================== Critical message to a user
393:
394: sub user_crit_msg_raw {
395: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
396: # Check if allowed missing
397: my $status='';
398: my $msgid='undefined';
399: unless (($message)&&($user)&&($domain)) { $status='empty'; };
400: my $text=$message;
401: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
402: if ($homeserver ne 'no_host') {
403: ($msgid,$message)=&packagemsg($subject,$message);
404: if ($sendback) { $message.='<sendback>true</sendback>'; }
405: $status=&Apache::lonnet::critical(
406: 'put:'.$domain.':'.$user.':critical:'.
407: &Apache::lonnet::escape($msgid).'='.
408: &Apache::lonnet::escape($message),$homeserver);
409: if (defined($sentmessage)) {
410: $$sentmessage = $message;
411: }
412: } else {
413: $status='no_host';
414: }
415: # Notifications
416: my %userenv = &Apache::lonnet::get('environment',['critnotification',
417: 'permanentemail'],
418: $domain,$user);
419: if ($userenv{'critnotification'}) {
420: &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
421: $text);
422: }
423: if ($toperm && $userenv{'permanentemail'}) {
424: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
425: $text);
426: }
427: # Log this
428: &Apache::lonnet::logthis(
429: 'Sending critical email '.$msgid.
430: ', log status: '.
431: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
432: $env{'user.home'},
433: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
434: .$status));
435: return $status;
436: }
437:
438: # New routine that respects "forward" and calls old routine
439:
440: =pod
441:
442: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
443: a critical message $message to the $user at $domain. If $sendback is true,
444: a reciept will be sent to the current user when $user recieves the message.
445:
446: =cut
447:
448: sub user_crit_msg {
449: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
450: my $status='';
451: my %userenv = &Apache::lonnet::get('environment',['msgforward'],
452: $domain,$user);
453: my $msgforward=$userenv{'msgforward'};
454: if ($msgforward) {
455: foreach (split(/\,/,$msgforward)) {
456: my ($forwuser,$forwdomain)=split(/\:/,$_);
457: $status.=
458: &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
459: $sendback,$toperm,$sentmessage).' ';
460: }
461: } else {
462: $status=&user_crit_msg_raw($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage);
463: }
464: return $status;
465: }
466:
467: # =================================================== Critical message received
468:
469: sub user_crit_received {
470: my $msgid=shift;
471: my %message=&Apache::lonnet::get('critical',[$msgid]);
472: my %contents=&unpackagemsg($message{$msgid},1);
473: my $status='rec: '.($contents{'sendback'}?
474: &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
475: &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
476: &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
477: ' acknowledged receipt of message'."\n".' "'.
478: $contents{'subject'}.'"'."\n".&mt('dated').' '.
479: $contents{'time'}.".\n"
480: ):'no msg req');
481: $status.=' trans: '.
482: &Apache::lonnet::put(
483: 'nohist_email',{$contents{'msgid'} => $message{$msgid}});
484: $status.=' del: '.
485: &Apache::lonnet::del('critical',[$contents{'msgid'}]);
486: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
487: $env{'user.home'},'Received critical message '.
488: $contents{'msgid'}.
489: ', '.$status);
490: return $status;
491: }
492:
493: # ======================================================== Normal communication
494:
495: sub user_normal_msg_raw {
496: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
497: $toperm,$currid,$newid,$sentmessage)=@_;
498: # Check if allowed missing
499: my $status='';
500: my $msgid='undefined';
501: my $text=$message;
502: unless (($message)&&($user)&&($domain)) { $status='empty'; };
503: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
504: if ($homeserver ne 'no_host') {
505: ($msgid,$message)=&packagemsg($subject,$message,$citation,$baseurl,
506: $attachmenturl,$user,$domain,$currid);
507: # Store in user folder
508: $status=&Apache::lonnet::critical(
509: 'put:'.$domain.':'.$user.':nohist_email:'.
510: &Apache::lonnet::escape($msgid).'='.
511: &Apache::lonnet::escape($message),$homeserver);
512: # Save new message received time
513: &Apache::lonnet::put
514: ('email_status',{'recnewemail'=>time},$domain,$user);
515: # Into sent-mail folder unless a broadcast message or critical message
516: unless (($env{'request.course.id'}) &&
517: (($env{'form.sendmode'} eq 'group') ||
518: (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
519: (&Apache::lonnet::allowed('srm',$env{'request.course.id'})))) {
520: $status .= &store_sent_mail($msgid,$message);
521: }
522: } else {
523: $status='no_host';
524: }
525: if (defined($newid)) {
526: $$newid = $msgid;
527: }
528: if (defined($sentmessage)) {
529: $$sentmessage = $message;
530: }
531:
532: # Notifications
533: my %userenv = &Apache::lonnet::get('environment',['notification',
534: 'permanentemail'],
535: $domain,$user);
536: if ($userenv{'notification'}) {
537: &sendnotification($userenv{'notification'},$user,$domain,$subject,0,
538: $text);
539: }
540: if ($toperm && $userenv{'permanentemail'}) {
541: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
542: $text);
543: }
544: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
545: $env{'user.home'},
546: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
547: return $status;
548: }
549:
550: # New routine that respects "forward" and calls old routine
551:
552: =pod
553:
554: =item * B<user_normal_msg($user, $domain, $subject, $message,
555: $citation, $baseurl, $attachmenturl)>: Sends a message to the
556: $user at $domain, with subject $subject and message $message.
557:
558: =cut
559:
560: sub user_normal_msg {
561: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
562: $toperm,$sentmessage)=@_;
563: my $status='';
564: my %userenv = &Apache::lonnet::get('environment',['msgforward'],
565: $domain,$user);
566: my $msgforward=$userenv{'msgforward'};
567: if ($msgforward) {
568: foreach (split(/\,/,$msgforward)) {
569: my ($forwuser,$forwdomain)=split(/\:/,$_);
570: $status.=
571: &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
572: $citation,$baseurl,$attachmenturl,$toperm,undef,undef,$sentmessage).' ';
573: }
574: } else {
575: $status=&user_normal_msg_raw($user,$domain,$subject,$message,
576: $citation,$baseurl,$attachmenturl,$toperm,undef,undef,$sentmessage);
577: }
578: return $status;
579: }
580:
581: sub store_sent_mail {
582: my ($msgid,$message) = @_;
583: my $status =' '.&Apache::lonnet::critical(
584: 'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
585: ':nohist_email_sent:'.
586: &Apache::lonnet::escape($msgid).'='.
587: &Apache::lonnet::escape($message),$env{'user.home'});
588: return $status;
589: }
590:
591: # ============================================================ List all folders
592:
593: sub folderlist {
594: my $folder=shift;
595: my @allfolders=&Apache::lonnet::getkeys('email_folders');
596: if ($allfolders[0]=~/^error:/) { @allfolders=(); }
597: return '<form method="post" action="/adm/email">'.
598: &mt('Folder').': '.
599: &Apache::loncommon::select_form($folder,'folder',
600: ('' => &mt('INBOX'),'trash' => &mt('TRASH'),
601: 'new' => &mt('New Messages Only'),
602: 'critical' => &mt('Critical'),
603: 'sent' => &mt('Sent Messages'),
604: map { $_ => $_ } @allfolders)).
605: ' '.&mt('Show').
606: '<select name="interdis">'.
607: join("\n",map { '<option value="'.$_.'"'.
608: ($_==$interdis?' selected="selected"':'').'>'.$_.'</option>' }
609: (10,20,50,100,200)).'</select>'.
610: '<input type="submit" value="'.&mt('View Folder').'" /><br />'.
611: '<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />'.
612: ($folder=~/^(new|critical)/?'</form>':'');
613: }
614:
615: sub scrollbuttons {
616: my ($start,$maxdis,$first,$finish,$total)=@_;
617: unless ($total>0) { return ''; }
618: $start++; $maxdis++;$first++;$finish++;
619: return
620: &mt('Page').': '.
621: '<input type="submit" name="firstview" value="'.&mt('First').'" />'.
622: '<input type="submit" name="prevview" value="'.&mt('Previous').'" />'.
623: '<input type="text" size="5" name="startdis" value="'.$start.'" onChange="this.form.submit()" /> of '.$maxdis.
624: '<input type="submit" name="nextview" value="'.&mt('Next').'" />'.
625: '<input type="submit" name="lastview" value="'.&mt('Last').'" /><br />'.
626: &mt('Showing messages [_1] through [_2] of [_3]',$first,$finish,$total).'</form>';
627: }
628:
629: # =============================================================== Folder suffix
630:
631: sub foldersuffix {
632: my $folder=shift;
633: unless ($folder) { return ''; }
634: return '_'.&Apache::lonnet::escape($folder);
635: }
636:
637: # =============================================================== Status Change
638:
639: sub statuschange {
640: my ($msgid,$newstatus,$folder)=@_;
641: my $suffix=&foldersuffix($folder);
642: my %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
643: if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
644: unless ($status{$msgid}) { $status{$msgid}='new'; }
645: unless (($status{$msgid} eq 'replied') ||
646: ($status{$msgid} eq 'forwarded')) {
647: &Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus});
648: }
649: if (($newstatus eq 'deleted') || ($newstatus eq 'new')) {
650: &Apache::lonnet::put('email_status'.$suffix,{$msgid => $newstatus});
651: }
652: if ($newstatus eq 'deleted') {
653: &movemsg(&Apache::lonnet::unescape($msgid),$folder,'trash');
654: }
655: }
656:
657: # ============================================================= Make new folder
658:
659: sub makefolder {
660: my ($newfolder)=@_;
661: if (($newfolder eq 'sent')
662: || ($newfolder eq 'critical')
663: || ($newfolder eq 'trash')
664: || ($newfolder eq 'new')) { return; }
665: &Apache::lonnet::put('email_folders',{$newfolder => time});
666: }
667:
668: # ======================================================== Move between folders
669:
670: sub movemsg {
671: my ($msgid,$srcfolder,$trgfolder)=@_;
672: if ($srcfolder eq 'new') { $srcfolder=''; }
673: my $srcsuffix=&foldersuffix($srcfolder);
674: my $trgsuffix=&foldersuffix($trgfolder);
675:
676: # Copy message
677: my %message=&Apache::lonnet::get('nohist_email'.$srcsuffix,[$msgid]);
678: &Apache::lonnet::put('nohist_email'.$trgsuffix,{$msgid => $message{$msgid}});
679:
680: # Copy status
681: unless ($trgfolder eq 'trash') {
682: my %status=&Apache::lonnet::get('email_status'.$srcsuffix,[$msgid]);
683: &Apache::lonnet::put('email_status'.$trgsuffix,{$msgid => $status{$msgid}});
684: }
685: # Delete orginals
686: &Apache::lonnet::del('nohist_email'.$srcsuffix,[$msgid]);
687: &Apache::lonnet::del('email_status'.$srcsuffix,[$msgid]);
688: }
689:
690: # ======================================================= Display a course list
691:
692: sub discourse {
693: my $r=shift;
694: my $classlist = &Apache::loncoursedata::get_classlist();
695: my $now=time;
696: my %lt=&Apache::lonlocal::texthash('cfa' => 'Check All',
697: 'cfs' => 'Check Section/Group',
698: 'cfn' => 'Uncheck All');
699: $r->print(<<ENDDISHEADER);
700: <input type="hidden" name="sendmode" value="group" />
701: <script>
702: function checkall() {
703: for (i=0; i<document.forms.compemail.elements.length; i++) {
704: if
705: (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
706: document.forms.compemail.elements[i].checked=true;
707: }
708: }
709: }
710:
711: function checksec() {
712: for (i=0; i<document.forms.compemail.elements.length; i++) {
713: if
714: (document.forms.compemail.elements[i].name.indexOf
715: ('send_to_&&&'+document.forms.compemail.chksec.value)==0) {
716: document.forms.compemail.elements[i].checked=true;
717: }
718: }
719: }
720:
721: function uncheckall() {
722: for (i=0; i<document.forms.compemail.elements.length; i++) {
723: if
724: (document.forms.compemail.elements[i].name.indexOf('send_to_')==0) {
725: document.forms.compemail.elements[i].checked=false;
726: }
727: }
728: }
729: </script>
730: <input type="button" onClick="checkall()" value="$lt{'cfa'}" />
731: <input type="button" onClick="checksec()" value="$lt{'cfs'}" />
732: <input type="text" size="5" name="chksec" />
733: <input type="button" onClick="uncheckall()" value="$lt{'cfn'}" />
734: <p>
735: ENDDISHEADER
736: my %coursepersonnel=&Apache::lonnet::get_course_adv_roles();
737: $r->print('<table>');
738: foreach my $role (sort keys %coursepersonnel) {
739: foreach (split(/\,/,$coursepersonnel{$role})) {
740: my ($puname,$pudom)=split(/\:/,$_);
741: $r->print('<tr><td><label>'.
742: '<input type="checkbox" name="send_to_&&&&&&_'.
743: $puname.':'.$pudom.'" /> '.
744: &Apache::loncommon::plainname($puname,$pudom).
745: '</label></td>'.
746: '<td>('.$_.'),</td><td><i>'.$role.'</i></td></tr>');
747: }
748: }
749: $r->print('</table><table>');
750: my $sort = sub {
751: my $aname=lc($classlist->{$a}[&Apache::loncoursedata::CL_FULLNAME()]);
752: if (!$aname) { $aname=$a; }
753: my $bname=lc($classlist->{$b}[&Apache::loncoursedata::CL_FULLNAME()]);
754: if (!$bname) { $bname=$b; }
755: return $aname cmp $bname;
756: };
757: foreach my $student (sort $sort (keys(%{$classlist}))) {
758: my $info=$classlist->{$student};
759: my ($sname,$sdom,$status,$fullname,$section) =
760: (@{$info}[&Apache::loncoursedata::CL_SNAME(),
761: &Apache::loncoursedata::CL_SDOM(),
762: &Apache::loncoursedata::CL_STATUS(),
763: &Apache::loncoursedata::CL_FULLNAME(),
764: &Apache::loncoursedata::CL_SECTION()]);
765: next if ($status ne 'Active');
766: next if ($env{'request.course.sec'} &&
767: $section ne $env{'request.course.sec'});
768: my $key = 'send_to_&&&'.$section.'&&&_'.$student;
769: if (! defined($fullname) || $fullname eq '') { $fullname = $sname; }
770: $r->print('<tr><td><label>'.
771: qq{<input type="checkbox" name="$key" />}.(' 'x2).
772: $fullname.'</label></td><td>'.$sname.'@'.$sdom.'</td><td>'.$section.
773: '</td></tr>');
774: }
775: $r->print('</table>');
776: }
777:
778: # ==================================================== Display Critical Message
779:
780: sub discrit {
781: my $r=shift;
782: my $header = '<h1><font color=red>'.&mt('Critical Messages').'</font></h1>'.
783: '<form action="/adm/email" method="POST">'.
784: '<input type="hidden" name="confirm" value="true" />';
785: my %what=&Apache::lonnet::dump('critical');
786: my $result = '';
787: foreach (sort keys %what) {
788: my %content=&unpackagemsg($what{$_});
789: next if ($content{'senderdomain'} eq '');
790: $result.='<hr />'.&mt('From').': <b>'.
791: &Apache::loncommon::aboutmewrapper(
792: &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
793: $content{'sendername'}.'@'.
794: $content{'senderdomain'}.') '.$content{'time'}.
795: '<br />'.&mt('Subject').': '.$content{'subject'}.
796: '<br /><pre>'.
797: &Apache::lontexconvert::msgtexconverted($content{'message'}).
798: '</pre><small>'.
799: &mt('You have to confirm that you received this message. After confirmation, this message will be moved to your regular inbox').
800: '</small><br />'.
801: '<input type="submit" name="rec_'.$_.'" value="'.&mt('Confirm Receipt').'" />'.
802: '<input type="submit" name="reprec_'.$_.'" '.
803: 'value="'.&mt('Confirm Receipt and Reply').'" />';
804: }
805: # Check to see if there were any messages.
806: if ($result eq '') {
807: $result = "<h2>".&mt('You have no critical messages.')."</h2>".
808: '<a href="/adm/roles">'.&mt('Select a course').'</a><br />'.
809: '<a href="/adm/email">'.&mt('Communicate').'</a>';
810: } else {
811: $r->print($header);
812: }
813: $r->print($result);
814: $r->print('<input type="hidden" name="displayedcrit" value="true" /></form>');
815: }
816:
817: sub sortedmessages {
818: my ($blocked,$startblock,$endblock,$numblocked,$folder) = @_;
819: my $suffix=&foldersuffix($folder);
820: my @messages = &Apache::lonnet::getkeys('nohist_email'.$suffix);
821: #unpack the varibles and repack into temp for sorting
822: my @temp;
823: foreach (@messages) {
824: my $msgid=&Apache::lonnet::escape($_);
825: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid)=
826: &Apache::lonmsg::unpackmsgid($msgid,$folder);
827: my $description = &get_course_desc($fromcid);
828: my @temp1 = ($sendtime,$shortsubj,$fromname,$fromdomain,$status,
829: $msgid,$description);
830: # Check whether message was sent during blocking period.
831: if ($sendtime >= $startblock && ($sendtime <= $endblock && $endblock > 0) ) {
832: my $escid = &Apache::lonnet::unescape($msgid);
833: $$blocked{$escid} = 'ON';
834: $$numblocked ++;
835: } else {
836: push @temp ,\@temp1;
837: }
838: }
839: #default sort
840: @temp = sort {$a->[0] <=> $b->[0]} @temp;
841: if ($env{'form.sortedby'} eq "date"){
842: @temp = sort {$a->[0] <=> $b->[0]} @temp;
843: }
844: if ($env{'form.sortedby'} eq "revdate"){
845: @temp = sort {$b->[0] <=> $a->[0]} @temp;
846: }
847: if ($env{'form.sortedby'} eq "user"){
848: @temp = sort {lc($a->[2]) cmp lc($b->[2])} @temp;
849: }
850: if ($env{'form.sortedby'} eq "revuser"){
851: @temp = sort {lc($b->[2]) cmp lc($a->[2])} @temp;
852: }
853: if ($env{'form.sortedby'} eq "domain"){
854: @temp = sort {$a->[3] cmp $b->[3]} @temp;
855: }
856: if ($env{'form.sortedby'} eq "revdomain"){
857: @temp = sort {$b->[3] cmp $a->[3]} @temp;
858: }
859: if ($env{'form.sortedby'} eq "subject"){
860: @temp = sort {lc($a->[1]) cmp lc($b->[1])} @temp;
861: }
862: if ($env{'form.sortedby'} eq "revsubject"){
863: @temp = sort {lc($b->[1]) cmp lc($a->[1])} @temp;
864: }
865: if ($env{'form.sortedby'} eq "course"){
866: @temp = sort {lc($a->[6]) cmp lc($b->[6])} @temp;
867: }
868: if ($env{'form.sortedby'} eq "revcourse"){
869: @temp = sort {lc($b->[6]) cmp lc($a->[6])} @temp;
870: }
871: if ($env{'form.sortedby'} eq "status"){
872: @temp = sort {$a->[4] cmp $b->[4]} @temp;
873: }
874: if ($env{'form.sortedby'} eq "revstatus"){
875: @temp = sort {$b->[4] cmp $a->[4]} @temp;
876: }
877: return @temp;
878: }
879:
880: sub get_course_desc {
881: my ($fromcid) = @_;
882: my $description;
883: if (defined($env{'course.'.$fromcid.'.description'})) {
884: $description = $env{'course.'.$fromcid.'.description'};
885: } else {
886: my %courseinfo=&Apache::lonnet::coursedescription($fromcid);
887: $description = $courseinfo{'description'};
888: }
889: return $description;
890: }
891:
892: # ======================================================== Display new messages
893:
894:
895: sub disnew {
896: my $r=shift;
897: my %lt=&Apache::lonlocal::texthash(
898: 'nm' => 'New Messages',
899: 'su' => 'Subject',
900: 'co' => 'Course',
901: 'da' => 'Date',
902: 'us' => 'Username',
903: 'op' => 'Open',
904: 'do' => 'Domain'
905: );
906: my @msgids = sort split(/\&/,&Apache::lonnet::reply
907: ('keys:'.$env{'user.domain'}.':'.
908: $env{'user.name'}.':nohist_email',
909: $env{'user.home'}));
910: my @newmsgs;
911: my %setters = ();
912: my $startblock = 0;
913: my $endblock = 0;
914: my %blocked = ();
915: my $numblocked = 0;
916: # Check for blocking of display because of scheduled online exams.
917: &blockcheck(\%setters,\$startblock,\$endblock);
918: foreach (@msgids) {
919: my ($sendtime,$shortsubj,$fromname,$fromdom,$status,$fromcid)=
920: &Apache::lonmsg::unpackmsgid($_);
921: if (defined($sendtime) && $sendtime!~/error/) {
922: my $description = &get_course_desc($fromcid);
923: my $numsendtime = $sendtime;
924: $sendtime = &Apache::lonlocal::locallocaltime($sendtime);
925: if ($status eq 'new') {
926: if ($numsendtime >= $startblock && ($numsendtime <= $endblock && $endblock > 0) ) {
927: $blocked{$_} = 'ON';
928: $numblocked ++;
929: } else {
930: push @newmsgs, {
931: msgid => $_,
932: sendtime => $sendtime,
933: shortsub => &Apache::lonnet::unescape($shortsubj),
934: from => $fromname,
935: fromdom => $fromdom,
936: course => $description
937: }
938: }
939: }
940: }
941: }
942: if ($#newmsgs >= 0) {
943: $r->print(<<TABLEHEAD);
944: <h2>$lt{'nm'}</h2>
945: <table border=2><tr><th> </th>
946: <th>$lt{'da'}</th><th>$lt{'us'}</th><th>$lt{'do'}</th><th>$lt{'su'}</th><th>$lt{'co'}</th></tr>
947: TABLEHEAD
948: foreach my $msg (@newmsgs) {
949: $r->print(<<"ENDLINK");
950: <tr class="new" bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor='#DD9955'"
951: onMouseOut="javascript:style.backgroundColor='#FFBB77'">
952: <td><a href="/adm/email?dismode=new&display=$msg->{'msgid'}">$lt{'op'}</a></td>
953: ENDLINK
954: foreach ('sendtime','from','fromdom','shortsub','course') {
955: $r->print("<td>$msg->{$_}</td>");
956: }
957: $r->print("</td></tr>");
958: }
959: $r->print('</table>'.&Apache::loncommon::endbodytag().'</html>');
960: } elsif ($numblocked == 0) {
961: $r->print("<h3>".&mt('You have no unread messages')."</h3>");
962: }
963: if ($numblocked > 0) {
964: my $beginblock = &Apache::lonlocal::locallocaltime($startblock);
965: my $finishblock = &Apache::lonlocal::locallocaltime($endblock);
966: if ($numblocked == 1) {
967: $r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread message').".</h3>");
968: $r->print(&mt('This message is not viewable because').' ');
969: } else {
970: $r->print("<h3>".&mt('You have').' '.$numblocked.' '.&mt('blocked unread messages').".</h3>");
971: $r->print(&mt('These').' '.$numblocked.' '.&mt('messages are not viewable because '));
972: }
973: $r->print(
974: &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').'.');
975: &build_block_table($r,$startblock,$endblock,\%setters);
976: }
977: }
978:
979:
980: # ======================================================== Display all messages
981:
982: sub disall {
983: my ($r,$folder)=@_;
984: $r->print(&folderlist($folder));
985: if ($folder eq 'new') {
986: &disnew($r);
987: } elsif ($folder eq 'critical') {
988: &discrit($r);
989: } else {
990: &disfolder($r,$folder);
991: }
992: }
993:
994: # ============================================================ Display a folder
995:
996: sub disfolder {
997: my ($r,$folder)=@_;
998: my %blocked = ();
999: my %setters = ();
1000: my $startblock;
1001: my $endblock;
1002: my $numblocked = 0;
1003: &blockcheck(\%setters,\$startblock,\$endblock);
1004: $r->print(<<ENDDISHEADER);
1005: <script>
1006: function checkall() {
1007: for (i=0; i<document.forms.disall.elements.length; i++) {
1008: if
1009: (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
1010: document.forms.disall.elements[i].checked=true;
1011: }
1012: }
1013: }
1014:
1015: function uncheckall() {
1016: for (i=0; i<document.forms.disall.elements.length; i++) {
1017: if
1018: (document.forms.disall.elements[i].name.indexOf('delmark_')==0) {
1019: document.forms.disall.elements[i].checked=false;
1020: }
1021: }
1022: }
1023: </script>
1024: ENDDISHEADER
1025: my $fsqs='&folder='.$folder;
1026: my @temp=sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
1027: my $totalnumber=$#temp+1;
1028: unless ($totalnumber>0) {
1029: $r->print('<h2>'.&mt('Empty Folder').'</h2>');
1030: return;
1031: }
1032: unless ($interdis) {
1033: $interdis=20;
1034: }
1035: my $number=int($totalnumber/$interdis);
1036: if (($startdis<0) || ($startdis>$number)) { $startdis=$number; }
1037: my $firstdis=$interdis*$startdis;
1038: if ($firstdis>$#temp) { $firstdis=$#temp-$interdis+1; }
1039: my $lastdis=$firstdis+$interdis-1;
1040: if ($lastdis>$#temp) { $lastdis=$#temp; }
1041: $r->print(&scrollbuttons($startdis,$number,$firstdis,$lastdis,$totalnumber));
1042: $r->print('<form method="post" name="disall" action="/adm/email">'.
1043: '<table border=2><tr><th colspan="3"> </th><th>');
1044: if ($env{'form.sortedby'} eq "revdate") {
1045: $r->print('<a href = "?sortedby=date'.$fsqs.'">'.&mt('Date').'</a></th>');
1046: } else {
1047: $r->print('<a href = "?sortedby=revdate'.$fsqs.'">'.&mt('Date').'</a></th>');
1048: }
1049: $r->print('<th>');
1050: if ($env{'form.sortedby'} eq "revuser") {
1051: $r->print('<a href = "?sortedby=user'.$fsqs.'">'.&mt('Username').'</a>');
1052: } else {
1053: $r->print('<a href = "?sortedby=revuser'.$fsqs.'">'.&mt('Username').'</a>');
1054: }
1055: $r->print('</th><th>');
1056: if ($env{'form.sortedby'} eq "revdomain") {
1057: $r->print('<a href = "?sortedby=domain'.$fsqs.'">'.&mt('Domain').'</a>');
1058: } else {
1059: $r->print('<a href = "?sortedby=revdomain'.$fsqs.'">'.&mt('Domain').'</a>');
1060: }
1061: $r->print('</th><th>');
1062: if ($env{'form.sortedby'} eq "revsubject") {
1063: $r->print('<a href = "?sortedby=subject'.$fsqs.'">'.&mt('Subject').'</a>');
1064: } else {
1065: $r->print('<a href = "?sortedby=revsubject'.$fsqs.'">'.&mt('Subject').'</a>');
1066: }
1067: $r->print('</th><th>');
1068: if ($env{'form.sortedby'} eq "revcourse") {
1069: $r->print('<a href = "?sortedby=course'.$fsqs.'">'.&mt('Course').'</a>');
1070: } else {
1071: $r->print('<a href = "?sortedby=revcourse'.$fsqs.'">'.&mt('Course').'</a>');
1072: }
1073: $r->print('</th><th>');
1074: if ($env{'form.sortedby'} eq "revstatus") {
1075: $r->print('<a href = "?sortedby=status'.$fsqs.'">'.&mt('Status').'</a></th>');
1076: } else {
1077: $r->print('<a href = "?sortedby=revstatus'.$fsqs.'">'.&mt('Status').'</a></th>');
1078: }
1079: $r->print("</tr>\n");
1080: for (my $n=$firstdis;$n<=$lastdis;$n++) {
1081: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$origID,$description)= @{$temp[$n]};
1082: if (($status ne 'deleted') && defined($sendtime) && $sendtime!~/error/) {
1083: if ($status eq 'new') {
1084: $r->print('<tr bgcolor="#FFBB77" onMouseOver="javascript:style.backgroundColor=\'#DD9955\'" onMouseOut="javascript:style.backgroundColor=\'#FFBB77\'">');
1085: } elsif ($status eq 'read') {
1086: $r->print('<tr bgcolor="#BBBB77" onMouseOver="javascript:style.backgroundColor=\'#999944\'" onMouseOut="javascript:style.backgroundColor=\'#BBBB77\'">');
1087: } elsif ($status eq 'replied') {
1088: $r->print('<tr bgcolor="#AAAA88" onMouseOver="javascript:style.backgroundColor=\'#888855\'" onMouseOut="javascript:style.backgroundColor=\'#AAAA88\'">');
1089: } else {
1090: $r->print('<tr bgcolor="#99BBBB" onMouseOver="javascript:style.backgroundColor=\'#669999\'" onMouseOut="javascript:style.backgroundColor=\'#99BBBB\'">');
1091: }
1092: $r->print('<td><input type="checkbox" name="delmark_'.$origID.'" /></td><td><a href="/adm/email?display='.$origID.$sqs.
1093: '">'.&mt('Open').'</a></td><td>'.
1094: ($folder ne 'trash'?'<a href="/adm/email?markdel='.$origID.$sqs.
1095: '">'.&mt('Delete'):' ').'</a></td>'.
1096: '<td>'.&Apache::lonlocal::locallocaltime($sendtime).'</td><td>'.
1097: $fromname.'</td><td>'.$fromdomain.'</td><td>'.
1098: &Apache::lonnet::unescape($shortsubj).'</td><td>'.
1099: $description.'</td><td>'.$status.'</td></tr>'."\n");
1100: } elsif ($status eq 'deleted') {
1101: # purge
1102: &movemsg(&Apache::lonnet::unescape($origID),$folder,'trash');
1103: }
1104: }
1105: $r->print("</table>\n<p>".
1106: '<a href="javascript:checkall()">'.&mt('Check All').'</a> '.
1107: '<a href="javascript:uncheckall()">'.&mt('Uncheck All').'</a></p>'.
1108: '<input type="hidden" name="sortedby" value="'.$env{'form.sortedby'}.'" />');
1109: if ($folder ne 'trash') {
1110: $r->print(
1111: '<p><input type="submit" name="markeddel" value="'.&mt('Delete Checked').'" /></p>');
1112: }
1113: $r->print('<p><input type="submit" name="markedmove" value="'.&mt('Move Checked to Folder').'" />');
1114: my @allfolders=&Apache::lonnet::getkeys('email_folders');
1115: if ($allfolders[0]=~/^error:/) { @allfolders=(); }
1116: $r->print(
1117: &Apache::loncommon::select_form('','movetofolder',
1118: ( map { $_ => $_ } @allfolders))
1119: );
1120: my $postedstartdis=$startdis+1;
1121: $r->print('<input type="hidden" name="folder" value="'.$folder.'" /><input type="hidden" name="startdis" value="'.$postedstartdis.'" /><input type="hidden" name="interdis" value="'.$env{'form.interdis'}.'" /></form>');
1122: if ($numblocked > 0) {
1123: my $beginblock = &Apache::lonlocal::locallocaltime($startblock);
1124: my $finishblock = &Apache::lonlocal::locallocaltime($endblock);
1125: $r->print('<br /><br />'.
1126: $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.'));
1127: &build_block_table($r,$startblock,$endblock,\%setters);
1128: }
1129: }
1130:
1131: # ============================================================== Compose output
1132:
1133: sub compout {
1134: my ($r,$forwarding,$replying,$broadcast,$replycrit,$folder,$dismode)=@_;
1135: my $suffix=&foldersuffix($folder);
1136:
1137: if ($broadcast eq 'individual') {
1138: &printheader($r,'/adm/email?compose=individual',
1139: 'Send a Message');
1140: } elsif ($broadcast) {
1141: &printheader($r,'/adm/email?compose=group',
1142: 'Broadcast Message');
1143: } elsif ($forwarding) {
1144: &Apache::lonhtmlcommon::add_breadcrumb
1145: ({href=>"/adm/email?display=".&Apache::lonnet::escape($forwarding),
1146: text=>"Display Message"});
1147: &printheader($r,'/adm/email?forward='.&Apache::lonnet::escape($forwarding),
1148: 'Forwarding a Message');
1149: } elsif ($replying) {
1150: &Apache::lonhtmlcommon::add_breadcrumb
1151: ({href=>"/adm/email?display=".&Apache::lonnet::escape($replying),
1152: text=>"Display Message"});
1153: &printheader($r,'/adm/email?replyto='.&Apache::lonnet::escape($replying),
1154: 'Replying to a Message');
1155: } elsif ($replycrit) {
1156: $r->print('<h3>'.&mt('Replying to a Critical Message').'</h3>');
1157: $replying=$replycrit;
1158: } else {
1159: &printheader($r,'/adm/email?compose=upload',
1160: 'Distribute from Uploaded File');
1161: }
1162:
1163: my $dispcrit='';
1164: my $dissub='';
1165: my $dismsg='';
1166: my $disbase='';
1167: my $func=&mt('Send New');
1168: my %lt=&Apache::lonlocal::texthash('us' => 'Username',
1169: 'do' => 'Domain',
1170: 'ad' => 'Additional Recipients',
1171: 'sb' => 'Subject',
1172: 'ca' => 'Cancel',
1173: 'ma' => 'Mail');
1174:
1175: if (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
1176: my $crithelp = Apache::loncommon::help_open_topic("Course_Critical_Message");
1177: $dispcrit=
1178: '<p><label><input type="checkbox" name="critmsg" /> '.&mt('Send as critical message').'</label> ' . $crithelp .
1179: '</p><p>'.
1180: '<label><input type="checkbox" name="sendbck" /> '.&mt('Send as critical message').' ' .
1181: &mt('and return receipt') . '</label>' . $crithelp .
1182: '</p><p><label><input type="checkbox" name="permanent" /> '.
1183: &mt('Send copy to permanent email address (if known)').'</label></p>'.
1184: '<p><label><input type="checkbox" name="rsspost" /> '.
1185: &mt('Include in course RSS newsfeed').'</label></p>'; }
1186: my %message;
1187: my %content;
1188: my $defdom=$env{'user.domain'};
1189: if ($forwarding) {
1190: %message=&Apache::lonnet::get('nohist_email'.$suffix,[$forwarding]);
1191: %content=&unpackagemsg($message{$forwarding},$folder);
1192: $dispcrit.='<input type="hidden" name="forwid" value="'.
1193: $forwarding.'" />';
1194: $func=&mt('Forward');
1195:
1196: $dissub=&mt('Forwarding').': '.$content{'subject'};
1197: $dismsg=&mt('Forwarded message from').' '.
1198: $content{'sendername'}.' '.&mt('at').' '.$content{'senderdomain'};
1199: if ($content{'baseurl'}) {
1200: $disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />';
1201: }
1202: }
1203: if ($replying) {
1204: %message=&Apache::lonnet::get('nohist_email'.$suffix,[$replying]);
1205: %content=&unpackagemsg($message{$replying},$folder);
1206: $dispcrit.='<input type="hidden" name="replyid" value="'.
1207: $replying.'" />';
1208: $func=&mt('Send Reply to');
1209:
1210: $dissub=&mt('Reply').': '.$content{'subject'};
1211: $dismsg='> '.$content{'message'};
1212: $dismsg=~s/\r/\n/g;
1213: $dismsg=~s/\f/\n/g;
1214: $dismsg=~s/\n+/\n\> /g;
1215: if ($content{'baseurl'}) {
1216: $disbase='<input type="hidden" name="baseurl" value="'.&Apache::lonnet::escape($content{'baseurl'}).'" />';
1217: if ($env{'user.adv'}) {
1218: $disbase.='<label><input type="checkbox" name="storebasecomment" />'.&mt('Store message for re-use').
1219: '</label> <a href="/adm/email?showcommentbaseurl='.
1220: &Apache::lonnet::escape($content{'baseurl'}).'" target="comments">'.
1221: &mt('Show re-usable messages').'</a><br />';
1222: }
1223: }
1224: }
1225: my $citation=&displayresource(%content);
1226: if ($env{'form.recdom'}) { $defdom=$env{'form.recdom'}; }
1227: $r->print(
1228: '<form action="/adm/email" name="compemail" method="post"'.
1229: ' enctype="multipart/form-data">'."\n".
1230: '<input type="hidden" name="sendmail" value="on" />'."\n".
1231: '<table>');
1232: unless (($broadcast eq 'group') || ($broadcast eq 'upload')) {
1233: if ($replying) {
1234: $r->print('<tr><td colspan="2">'.&mt('Replying to').' '.
1235: &Apache::loncommon::aboutmewrapper(
1236: &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).' ('.
1237: $content{'sendername'}.'@'.
1238: $content{'senderdomain'}.')'.
1239: '<input type="hidden" name="recuname" value="'.$content{'sendername'}.'" />'.
1240: '<input type="hidden" name="recdomain" value="'.$content{'senderdomain'}.'" />'.
1241: '</td></tr>');
1242: } else {
1243: my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
1244: my $selectlink=&Apache::loncommon::selectstudent_link
1245: ('compemail','recuname','recdomain');
1246: $r->print(<<"ENDREC");
1247: <tr><td>$lt{'us'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recname'}" /></td><td rowspan="2">$selectlink</td></tr>
1248: <tr><td>$lt{'do'}:</td>
1249: <td>$domform</td></tr>
1250: ENDREC
1251: }
1252: }
1253: my $latexHelp = Apache::loncommon::helpLatexCheatsheet();
1254: if ($broadcast ne 'upload') {
1255: $r->print(<<"ENDCOMP");
1256: <tr><td>$lt{'ad'}<br /><tt>username\@domain,username\@domain, ...
1257: </tt></td><td>
1258: <input type="text" size="50" name="additionalrec" /></td></tr>
1259: <tr><td>$lt{'sb'}:</td><td><input type="text" size="50" name="subject" value="$dissub" />
1260: </td></tr></table>
1261: $latexHelp
1262: <textarea name="message" id="message" cols="80" rows="15" wrap="hard">$dismsg
1263: </textarea></p><br />
1264: $dispcrit
1265: $disbase
1266: <input type="hidden" name="folder" value="$folder" />
1267: <input type="hidden" name="dismode" value="$dismode" />
1268: <input type="submit" name="send" value="$func $lt{'ma'}" />
1269: <input type="submit" name="cancel" value="$lt{'ca'}" /><hr />
1270: $citation
1271: ENDCOMP
1272: } else { # $broadcast is 'upload'
1273: $r->print(<<ENDUPLOAD);
1274: <input type="hidden" name="sendmode" value="upload" />
1275: <input type="hidden" name="send" value="on" />
1276: <h3>Generate messages from a file</h3>
1277: <p>
1278: Subject: <input type="text" size="50" name="subject" />
1279: </p>
1280: <p>General message text<br />
1281: <textarea name="message" id="message" cols="60" rows="10" wrap="hard">$dismsg
1282: </textarea></p>
1283: <p>
1284: The file format for the uploaded portion of the message is:
1285: <pre>
1286: username1\@domain1: text
1287: username2\@domain2: text
1288: username3\@domain1: text
1289: </pre>
1290: </p>
1291: <p>
1292: The messages will be assembled from all lines with the respective
1293: <tt>username\@domain</tt>, and appended to the general message text.</p>
1294: <p>
1295: <input type="file" name="upfile" size="40" /></p><p>
1296: $dispcrit
1297: <input type="submit" value="Upload and Send" /></p>
1298: ENDUPLOAD
1299: }
1300: if ($broadcast eq 'group') {
1301: &discourse;
1302: }
1303: $r->print('</form>'.
1304: &Apache::lonfeedback::generate_preview_button('compemail','message').
1305: &Apache::lonhtmlcommon::htmlareaselectactive('message'));
1306: }
1307:
1308: # ---------------------------------------------------- Display all face to face
1309:
1310: sub retrieve_instructor_comments {
1311: my ($user,$domain)=@_;
1312: my $target=$env{'form.grade_target'};
1313: if (! $env{'request.course.id'}) { return; }
1314: if (! &Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
1315: return;
1316: }
1317: my %records=&Apache::lonnet::dump('nohist_email',
1318: $env{'course.'.$env{'request.course.id'}.'.domain'},
1319: $env{'course.'.$env{'request.course.id'}.'.num'},
1320: '%255b'.$user.'%253a'.$domain.'%255d');
1321: my $result='';
1322: foreach (sort(keys(%records))) {
1323: my %content=&unpackagemsg($records{$_});
1324: next if ($content{'senderdomain'} eq '');
1325: next if ($content{'subject'} !~ /^Record/);
1326: # &Apache::lonfeedback::newline_to_br(\$content{'message'});
1327: $result.='Recorded by '.
1328: $content{'sendername'}.'@'.$content{'senderdomain'}."\n";
1329: $result.=
1330: &Apache::lontexconvert::msgtexconverted($content{'message'})."\n";
1331: }
1332: return $result;
1333: }
1334:
1335: sub disfacetoface {
1336: my ($r,$user,$domain)=@_;
1337: my $target=$env{'form.grade_target'};
1338: unless ($env{'request.course.id'}) { return; }
1339: unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
1340: return;
1341: }
1342: my %records=&Apache::lonnet::dump('nohist_email',
1343: $env{'course.'.$env{'request.course.id'}.'.domain'},
1344: $env{'course.'.$env{'request.course.id'}.'.num'},
1345: '%255b'.$user.'%253a'.$domain.'%255d');
1346: my $result='';
1347: foreach (sort keys %records) {
1348: my %content=&unpackagemsg($records{$_});
1349: next if ($content{'senderdomain'} eq '');
1350: &Apache::lonfeedback::newline_to_br(\$content{'message'});
1351: if ($content{'subject'}=~/^Record/) {
1352: $result.='<h3>'.&mt('Record').'</h3>';
1353: } elsif ($content{'subject'}=~/^Broadcast/) {
1354: $result .='<h3>'.&mt('Broadcast Message').'</h3>';
1355: if ($content{'subject'}=~/^Broadcast\./) {
1356: %content=&unpackagemsg($content{'message'});
1357: $content{'message'}=
1358: '<b>'.&mt('Subject').': '.$content{'subject'}.'</b><br />'.
1359: $content{'message'};
1360: }
1361: } else {
1362: $result.='<h3>'.&mt('Critical Message').'</h3>';
1363: %content=&unpackagemsg($content{'message'});
1364: $content{'message'}=
1365: '<b>'.&mt('Subject').': '.$content{'subject'}.'</b><br />'.
1366: $content{'message'};
1367: }
1368: $result.=&mt('By').': <b>'.
1369: &Apache::loncommon::aboutmewrapper(
1370: &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),$content{'sendername'},$content{'senderdomain'}).'</b> ('.
1371: $content{'sendername'}.'@'.
1372: $content{'senderdomain'}.') '.$content{'time'}.
1373: '<br /><pre>'.
1374: &Apache::lontexconvert::msgtexconverted($content{'message'}).
1375: '</pre>';
1376: }
1377: # Check to see if there were any messages.
1378: if ($result eq '') {
1379: if ($target ne 'tex') {
1380: $r->print("<p><b>".&mt("No notes, face-to-face discussion records, critical messages, or broadcast messages in this course.")."</b></p>");
1381: } else {
1382: $r->print('\textbf{'.&mt("No notes, face-to-face discussion records, critical messages or broadcast messages in this course.").'}\\\\');
1383: }
1384: } else {
1385: $r->print($result);
1386: }
1387: }
1388:
1389: # ---------------------------------------------------------------- Face to face
1390:
1391: sub facetoface {
1392: my ($r,$stage)=@_;
1393: unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) {
1394: return;
1395: }
1396: &printheader($r,
1397: '/adm/email?recordftf=query',
1398: "User Notes, Face-to-Face, Critical Messages, Broadcast Messages");
1399: # from query string
1400:
1401: if ($env{'form.recname'}) { $env{'form.recuname'}=$env{'form.recname'}; }
1402: if ($env{'form.recdom'}) { $env{'form.recdomain'}=$env{'form.recdom'}; }
1403:
1404: my $defdom=$env{'user.domain'};
1405: # already filled in
1406: if ($env{'form.recdomain'}) { $defdom=$env{'form.recdomain'}; }
1407: # generate output
1408: my $domform = &Apache::loncommon::select_dom_form($defdom,'recdomain');
1409: my $stdbrws = &Apache::loncommon::selectstudent_link
1410: ('stdselect','recuname','recdomain');
1411: my %lt=&Apache::lonlocal::texthash('user' => 'Username',
1412: 'dom' => 'Domain',
1413: 'head' => 'User Notes, Records of Face-To-Face Discussions, Critical Messages, and Broadcast Messages in Course',
1414: 'subm' => 'Retrieve discussion and message records',
1415: 'newr' => 'New Record (record is visible to course faculty and staff)',
1416: 'post' => 'Post this Record');
1417: $r->print(<<"ENDTREC");
1418: <h3>$lt{'head'}</h3>
1419: <form method="post" action="/adm/email" name="stdselect">
1420: <input type="hidden" name="recordftf" value="retrieve" />
1421: <table>
1422: <tr><td>$lt{'user'}:</td><td><input type="text" size="12" name="recuname" value="$env{'form.recuname'}" /></td>
1423: <td rowspan="2">
1424: $stdbrws
1425: <input type="submit" value="$lt{'subm'}" /></td>
1426: </tr>
1427: <tr><td>$lt{'dom'}:</td>
1428: <td>$domform</td></tr>
1429: </table>
1430: </form>
1431: ENDTREC
1432: if (($stage ne 'query') &&
1433: ($env{'form.recdomain'}) && ($env{'form.recuname'})) {
1434: chomp($env{'form.newrecord'});
1435: if ($env{'form.newrecord'}) {
1436: my $recordtxt = $env{'form.newrecord'};
1437: &user_normal_msg_raw(
1438: $env{'course.'.$env{'request.course.id'}.'.num'},
1439: $env{'course.'.$env{'request.course.id'}.'.domain'},
1440: &mt('Record').
1441: ' ['.$env{'form.recuname'}.':'.$env{'form.recdomain'}.']',
1442: $recordtxt);
1443: }
1444: $r->print('<h3>'.&Apache::loncommon::plainname($env{'form.recuname'},
1445: $env{'form.recdomain'}).'</h3>');
1446: &disfacetoface($r,$env{'form.recuname'},$env{'form.recdomain'});
1447: $r->print(<<ENDRHEAD);
1448: <form method="post" action="/adm/email">
1449: <input name="recdomain" value="$env{'form.recdomain'}" type="hidden" />
1450: <input name="recuname" value="$env{'form.recuname'}" type="hidden" />
1451: ENDRHEAD
1452: $r->print(<<ENDBFORM);
1453: <hr />$lt{'newr'}<br />
1454: <textarea name="newrecord" cols="80" rows="10" wrap="hard"></textarea>
1455: <br />
1456: <input type="hidden" name="recordftf" value="post" />
1457: <input type="submit" value="$lt{'post'}" />
1458: </form>
1459: ENDBFORM
1460: }
1461: }
1462:
1463: # ----------------------------------------------------------- Blocking during exams
1464:
1465: sub examblock {
1466: my ($r,$action) = @_;
1467: unless ($env{'request.course.id'}) { return;}
1468: unless (&Apache::lonnet::allowed('srm',$env{'request.course.id'})) { $r->print('Not allowed'); }
1469: my %lt=&Apache::lonlocal::texthash(
1470: 'comb' => 'Communication Blocking',
1471: 'cbds' => 'Communication blocking during scheduled exams',
1472: '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.',
1473: 'mecb' => 'Modify existing communication blocking periods',
1474: 'ncbc' => 'No communication blocks currently stored'
1475: );
1476:
1477: my %ltext = &Apache::lonlocal::texthash(
1478: 'dura' => 'Duration',
1479: 'setb' => 'Set by',
1480: 'even' => 'Event',
1481: 'actn' => 'Action',
1482: 'star' => 'Start',
1483: 'endd' => 'End'
1484: );
1485:
1486: &printheader($r,'/adm/email?block=display',$lt{'comb'});
1487: $r->print('<h3>'.$lt{'cbds'}.'</h3>');
1488:
1489: if ($action eq 'store') {
1490: &blockstore($r);
1491: }
1492:
1493: $r->print($lt{'desc'}.'<br /><br />
1494: <form name="blockform" method="post" action="/adm/email?block=store">
1495: ');
1496:
1497: $r->print('<h4>'.$lt{'mecb'}.'</h4>');
1498: my %records = ();
1499: my $blockcount = 0;
1500: my $parmcount = 0;
1501: &get_blockdates(\%records,\$blockcount);
1502: if ($blockcount > 0) {
1503: $parmcount = &display_blocker_status($r,\%records,\%ltext);
1504: } else {
1505: $r->print($lt{'ncbc'}.'<br /><br />');
1506: }
1507: &display_addblocker_table($r,$parmcount,\%ltext);
1508: my $endbody=&Apache::loncommon::endbodytag();
1509: $r->print(<<"END");
1510: <br />
1511: <input type="hidden" name="blocktotal" value="$blockcount" />
1512: <input type ="submit" value="Save Changes" />
1513: </form>
1514: $endbody
1515: </html>
1516: END
1517: return;
1518: }
1519:
1520: sub blockstore {
1521: my $r = shift;
1522: my %lt=&Apache::lonlocal::texthash(
1523: 'tfcm' => 'The following changes were made',
1524: 'cbps' => 'communication blocking period(s)',
1525: 'werm' => 'was/were removed',
1526: 'wemo' => 'was/were modified',
1527: 'wead' => 'was/were added',
1528: 'ncwm' => 'No changes were made.'
1529: );
1530: my %adds = ();
1531: my %removals = ();
1532: my %cancels = ();
1533: my $modtotal = 0;
1534: my $canceltotal = 0;
1535: my $addtotal = 0;
1536: my %blocking = ();
1537: $r->print('<h3>'.$lt{'head'}.'</h3>');
1538: foreach (keys %env) {
1539: if ($_ =~ m/^form\.modify_(\w+)$/) {
1540: $adds{$1} = $1;
1541: $removals{$1} = $1;
1542: $modtotal ++;
1543: } elsif ($_ =~ m/^form\.cancel_(\d+)$/) {
1544: $cancels{$1} = $1;
1545: unless ( defined($removals{$1}) ) {
1546: $removals{$1} = $1;
1547: $canceltotal ++;
1548: }
1549: } elsif ($_ =~ m/^form\.add_(\d+)$/) {
1550: $adds{$1} = $1;
1551: $addtotal ++;
1552: }
1553: }
1554:
1555: foreach (keys %removals) {
1556: my $hashkey = $env{'form.key_'.$_};
1557: &Apache::lonnet::del('comm_block',["$hashkey"],
1558: $env{'course.'.$env{'request.course.id'}.'.domain'},
1559: $env{'course.'.$env{'request.course.id'}.'.num'}
1560: );
1561: }
1562: foreach (keys %adds) {
1563: unless ( defined($cancels{$_}) ) {
1564: my ($newstart,$newend) = &get_dates_from_form($_);
1565: my $newkey = $newstart.'____'.$newend;
1566: $blocking{$newkey} = $env{'user.name'}.'@'.$env{'user.domain'}.':'.$env{'form.title_'.$_};
1567: }
1568: }
1569: if ($addtotal + $modtotal > 0) {
1570: &Apache::lonnet::put('comm_block',\%blocking,
1571: $env{'course.'.$env{'request.course.id'}.'.domain'},
1572: $env{'course.'.$env{'request.course.id'}.'.num'}
1573: );
1574: }
1575: my $chgestotal = $canceltotal + $modtotal + $addtotal;
1576: if ($chgestotal > 0) {
1577: $r->print($lt{'tfcm'}.'<ul>');
1578: if ($canceltotal > 0) {
1579: $r->print('<li>'.$canceltotal.' '.$lt{'cbps'},' '.$lt{'werm'}.'</li>');
1580: }
1581: if ($modtotal > 0) {
1582: $r->print('<li>'.$modtotal.' '.$lt{'cbps'},' '.$lt{'wemo'}.'</li>');
1583: }
1584: if ($addtotal > 0) {
1585: $r->print('<li>'.$addtotal.' '.$lt{'cbps'},' '.$lt{'wead'}.'</li>');
1586: }
1587: $r->print('</ul>');
1588: } else {
1589: $r->print($lt{'ncwm'});
1590: }
1591: $r->print('<br />');
1592: return;
1593: }
1594:
1595: sub get_dates_from_form {
1596: my $item = shift;
1597: my $startdate = &Apache::lonhtmlcommon::get_date_from_form('startdate_'.$item);
1598: my $enddate = &Apache::lonhtmlcommon::get_date_from_form('enddate_'.$item);
1599: return ($startdate,$enddate);
1600: }
1601:
1602: sub get_blockdates {
1603: my ($records,$blockcount) = @_;
1604: $$blockcount = 0;
1605: %{$records} = &Apache::lonnet::dump('comm_block',
1606: $env{'course.'.$env{'request.course.id'}.'.domain'},
1607: $env{'course.'.$env{'request.course.id'}.'.num'}
1608: );
1609: $$blockcount = keys %{$records};
1610:
1611: foreach (keys %{$records}) {
1612: if ($_ eq 'error: 2 tie(GDBM) Failed while attempting dump') {
1613: $$blockcount = 0;
1614: last;
1615: }
1616: }
1617: }
1618:
1619: sub display_blocker_status {
1620: my ($r,$records,$ltext) = @_;
1621: my $parmcount = 0;
1622: my @bgcols = ("#eeeeee","#dddddd");
1623: my $function = &Apache::loncommon::get_users_function();
1624: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1625: $env{'user.domain'});
1626: my %lt = &Apache::lonlocal::texthash(
1627: 'modi' => 'Modify',
1628: 'canc' => 'Cancel',
1629: );
1630: $r->print(<<"END");
1631: <table border="0" cellpadding="0" cellspacing="0">
1632: <tr>
1633: <td width="100%" bgcolor="#000000">
1634: <table width="100%" border="0" cellpadding="1" cellspacing="0">
1635: <tr>
1636: <td width="100%" bgcolor="#000000">
1637: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
1638: <tr bgcolor="$color">
1639: <td><b>$$ltext{'dura'}</b></td>
1640: <td><b>$$ltext{'setb'}</b></td>
1641: <td><b>$$ltext{'even'}</b></td>
1642: <td><b>$$ltext{'actn'}?</b></td>
1643: </tr>
1644: END
1645: foreach (sort keys %{$records}) {
1646: my $iter = $parmcount%2;
1647: my $onchange = 'onFocus="javascript:window.document.forms['.
1648: "'blockform'].elements['modify_".$parmcount."'].".
1649: 'checked=true;"';
1650: my ($start,$end) = split/____/,$_;
1651: my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange);
1652: my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange);
1653: my ($setter,$title) = split/:/,$$records{$_};
1654: my ($setuname,$setudom) = split/@/,$setter;
1655: my $settername = &Apache::loncommon::plainname($setuname,$setudom);
1656: $r->print(<<"END");
1657: <tr bgcolor="$bgcols[$iter]">
1658: <td>$$ltext{'star'}: $startform<br/>$$ltext{'endd'}: $endform</td>
1659: <td>$settername</td>
1660: <td><input type="text" name="title_$parmcount" size="15" value="$title" /><input type="hidden" name="key_$parmcount" value="$_" /></td>
1661: <td><label>$lt{'modi'}? <input type="checkbox" name="modify_$parmcount" /></label><br /><label>$lt{'canc'}? <input type="checkbox" name="cancel_$parmcount" /></label>
1662: </tr>
1663: END
1664: $parmcount ++;
1665: }
1666: $r->print(<<"END");
1667: </table>
1668: </td>
1669: </tr>
1670: </table>
1671: </td>
1672: </tr>
1673: </table>
1674: <br />
1675: <br />
1676: END
1677: return $parmcount;
1678: }
1679:
1680: sub display_addblocker_table {
1681: my ($r,$parmcount,$ltext) = @_;
1682: my $start = time;
1683: my $end = $start + (60 * 60 * 2); #Default is an exam of 2 hours duration.
1684: my $onchange = 'onFocus="javascript:window.document.forms['.
1685: "'blockform'].elements['add_".$parmcount."'].".
1686: 'checked=true;"';
1687: my $startform = &Apache::lonhtmlcommon::date_setter('blockform','startdate_'.$parmcount,$start,$onchange);
1688: my $endform = &Apache::lonhtmlcommon::date_setter('blockform','enddate_'.$parmcount,$end,$onchange);
1689: my $function = &Apache::loncommon::get_users_function();
1690: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1691: $env{'user.domain'});
1692: my %lt = &Apache::lonlocal::texthash(
1693: 'addb' => 'Add block',
1694: 'exam' => 'e.g., Exam 1',
1695: 'addn' => 'Add new communication blocking periods'
1696: );
1697: $r->print(<<"END");
1698: <h4>$lt{'addn'}</h4>
1699: <table border="0" cellpadding="0" cellspacing="0">
1700: <tr>
1701: <td width="100%" bgcolor="#000000">
1702: <table width="100%" border="0" cellpadding="1" cellspacing="0">
1703: <tr>
1704: <td width="100%" bgcolor="#000000">
1705: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
1706: <tr bgcolor="#CCCCFF">
1707: <td><b>$$ltext{'dura'}</b></td>
1708: <td><b>$$ltext{'even'} $lt{'exam'}</b></td>
1709: <td><b>$$ltext{'actn'}?</b></td>
1710: </tr>
1711: <tr bgcolor="#eeeeee">
1712: <td>$$ltext{'star'}: $startform<br />$$ltext{'endd'}: $endform</td>
1713: <td><input type="text" name="title_$parmcount" size="15" value="" /></td>
1714: <td><label>$lt{'addb'}? <input type="checkbox" name="add_$parmcount" value="1" /></label></td>
1715: </tr>
1716: </table>
1717: </td>
1718: </tr>
1719: </table>
1720: </td>
1721: </tr>
1722: </table>
1723: END
1724: return;
1725: }
1726:
1727: sub blockcheck {
1728: my ($setters,$startblock,$endblock) = @_;
1729: # Retrieve active student roles and active course coordinator/instructor roles
1730: my @livecses = ();
1731: my @staffcses = ();
1732: $$startblock = 0;
1733: $$endblock = 0;
1734: foreach (keys %env) {
1735: if ($_ =~ m-^user\.role\.(st|cc|in)\./(.+)$-) {
1736: my $role = $1;
1737: my $cse = $2;
1738: $cse =~ s|/|_|;
1739: if ($env{$_} =~ m/^(\d*)\.(\d*)$/) {
1740: unless (($2 > 0 && $2 < time) || ($1 > time)) {
1741: if ($role eq 'st') {
1742: push @livecses, $cse;
1743: } else {
1744: unless (grep/^$cse$/,@staffcses) {
1745: push @staffcses, $cse;
1746: }
1747: }
1748: }
1749: }
1750: } elsif ($_ =~ m-user\.role\.cr/(\w+)/(\w+)/([^/]+)\./(.+)$- ) {
1751: my $rolepriv = $env{'user.role..rolesdef_'.$3};
1752: }
1753: }
1754: # Retrieve blocking times and identity of blocker for active courses for students.
1755: if (@livecses > 0) {
1756: foreach my $cse (@livecses) {
1757: my ($cdom,$crs) = split/_/,$cse;
1758: if ( (grep/^$cse$/,@staffcses) && ($env{'request.role'} !~ m-^st\./$cdom/$crs$-) ) {
1759: next;
1760: } else {
1761: %{$$setters{$cse}} = ();
1762: @{$$setters{$cse}{'staff'}} = ();
1763: @{$$setters{$cse}{'times'}} = ();
1764: my %records = &Apache::lonnet::dump('comm_block',$cdom,$crs);
1765: foreach (keys %records) {
1766: if ($_ =~ m/^(\d+)____(\d+)$/) {
1767: if ($1 <= time && $2 >= time) {
1768: my ($staff,$title) = split/:/,$records{$_};
1769: push @{$$setters{$cse}{'staff'}}, $staff;
1770: push @{$$setters{$cse}{'times'}}, $_;
1771: if ( ($$startblock == 0) || ($$startblock > $1) ) {
1772: $$startblock = $1;
1773: }
1774: if ( ($$endblock == 0) || ($$endblock < $2) ) {
1775: $$endblock = $2;
1776: }
1777: }
1778: }
1779: }
1780: }
1781: }
1782: }
1783: }
1784:
1785: sub build_block_table {
1786: my ($r,$startblock,$endblock,$setters) = @_;
1787: my $function = &Apache::loncommon::get_users_function();
1788: my $color = &Apache::loncommon::designparm($function.'.tabbg',
1789: $env{'user.domain'});
1790: my %lt = &Apache::lonlocal::texthash(
1791: 'cacb' => 'Currently active communication blocks',
1792: 'cour' => 'Course',
1793: 'dura' => 'Duration',
1794: 'blse' => 'Block set by'
1795: );
1796: $r->print(<<"END");
1797: <br /<br />$lt{'cacb'}:<br /><br />
1798: <table border="0" cellpadding="0" cellspacing="0">
1799: <tr>
1800: <td width="100%" bgcolor="#000000">
1801: <table width="100%" border="0" cellpadding="1" cellspacing="0">
1802: <tr>
1803: <td width="100%" bgcolor="#000000">
1804: <table border="0" cellpadding="3" cellspacing="3" bgcolor="#FFFFFF">
1805: <tr bgcolor="$color">
1806: <td><b>$lt{'cour'}</b></td>
1807: <td><b>$lt{'dura'}</b></td>
1808: <td><b>$lt{'blse'}</b></td>
1809: </tr>
1810: END
1811: foreach (keys %{$setters}) {
1812: my %courseinfo=&Apache::lonnet::coursedescription($_);
1813: for (my $i=0; $i<@{$$setters{$_}{staff}}; $i++) {
1814: my ($uname,$udom) = split/\@/,$$setters{$_}{staff}[$i];
1815: my $fullname = &Apache::loncommon::plainname($uname,$udom);
1816: my ($openblock,$closeblock) = split/____/,$$setters{$_}{times}[$i];
1817: $openblock = &Apache::lonlocal::locallocaltime($openblock);
1818: $closeblock= &Apache::lonlocal::locallocaltime($closeblock);
1819: $r->print('<tr><td>'.$courseinfo{'description'}.'</td>'.
1820: '<td>'.$openblock.' to '.$closeblock.'</td>'.
1821: '<td>'.$fullname.' ('.$uname.'@'.$udom.
1822: ')</td></tr>');
1823: }
1824: }
1825: $r->print('</table></td></tr></table></td></tr></table>');
1826: }
1827:
1828: # ----------------------------------------------------------- Display a message
1829:
1830: sub displaymessage {
1831: my ($r,$msgid,$folder)=@_;
1832: my $suffix=&foldersuffix($folder);
1833: my %blocked = ();
1834: my %setters = ();
1835: my $startblock = 0;
1836: my $endblock = 0;
1837: my $numblocked = 0;
1838: # info to generate "next" and "previous" buttons and check if message is blocked
1839: &blockcheck(\%setters,\$startblock,\$endblock);
1840: my @messages=&sortedmessages(\%blocked,$startblock,$endblock,\$numblocked,$folder);
1841: if ( $blocked{$msgid} eq 'ON' ) {
1842: &printheader($r,'/adm/email',&mt('Display a Message'));
1843: $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.'));
1844: &build_block_table($r,$startblock,$endblock,\%setters);
1845: return;
1846: }
1847: &statuschange($msgid,'read',$folder);
1848: my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
1849: my %content=&unpackagemsg($message{$msgid});
1850:
1851: my $counter=0;
1852: $r->print('<pre>');
1853: my $escmsgid=&Apache::lonnet::escape($msgid);
1854: foreach (@messages) {
1855: if ($_->[5] eq $escmsgid){
1856: last;
1857: }
1858: $counter++;
1859: }
1860: $r->print('</pre>');
1861: my $number_of_messages = scalar(@messages); #subtract 1 for last index
1862: # start output
1863: &printheader($r,'/adm/email?display='.&Apache::lonnet::escape($msgid),'Display a Message','',$content{'baseurl'});
1864: my %courseinfo=&Apache::lonnet::coursedescription($content{'courseid'});
1865: # Functions
1866: $r->print('<table border="2" width="100%"><tr bgcolor="#FFFFAA"><td>'.&mt('Functions').':</td>'.
1867: '<td><a href="/adm/email?replyto='.&Apache::lonnet::escape($msgid).$sqs.
1868: '"><b>'.&mt('Reply').'</b></a></td>'.
1869: '<td><a href="/adm/email?forward='.&Apache::lonnet::escape($msgid).$sqs.
1870: '"><b>'.&mt('Forward').'</b></a></td>'.
1871: '<td><a href="/adm/email?markunread='.&Apache::lonnet::escape($msgid).$sqs.
1872: '"><b>'.&mt('Mark Unread').'</b></a></td>'.
1873: '<td><a href="/adm/email?markdel='.&Apache::lonnet::escape($msgid).$sqs.
1874: '"><b>'.&mt('Delete').'</b></a></td>'.
1875: '<td><a href="/adm/email?'.$sqs.
1876: ($env{'form.dismode'} eq 'new'?'&folder=new':'').
1877: '"><b>'.&mt('Back to Folder Display').'</b></a></td>');
1878: if ($counter > 0){
1879: $r->print('<td><a href="/adm/email?display='.$messages[$counter-1]->[5].$sqs.
1880: '"><b>'.&mt('Previous').'</b></a></td>');
1881: }
1882: if ($counter < $number_of_messages - 1){
1883: $r->print('<td><a href="/adm/email?display='.$messages[$counter+1]->[5].$sqs.
1884: '"><b>'.&mt('Next').'</b></a></td>');
1885: }
1886: $r->print('</tr></table>');
1887: if ($env{'user.adv'}) {
1888: $r->print('<table border="2" width="100%"><tr bgcolor="#FFAAAA"><td>'.&mt('Currently available actions (will open extra window)').':</td>');
1889: my $symb=&Apache::lonnet::symbread($content{'baseurl'});
1890: if (&Apache::lonnet::allowed('vgr',$env{'request.course.id'})) {
1891: $r->print('<td><b>'.&Apache::loncommon::track_student_link(&mt('View recent activity'),$content{'sendername'},$content{'senderdomain'},'check').'</b></td>');
1892: }
1893: if (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) && $symb) {
1894: $r->print('<td><b>'.&Apache::loncommon::pprmlink(&mt('Set/Change parameters'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>');
1895: }
1896: if (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}) && $symb) {
1897: $r->print('<td><b>'.&Apache::loncommon::pgrdlink(&mt('Set/Change grades'),$content{'sendername'},$content{'senderdomain'},$symb,'check').'</b></td>');
1898: }
1899: $r->print('</tr></table>');
1900: }
1901: my $tolist;
1902: my @recipients = ();
1903: for (my $i=0; $i<@{$content{'recuser'}}; $i++) {
1904: $recipients[$i] = &Apache::loncommon::aboutmewrapper(
1905: &Apache::loncommon::plainname($content{'recuser'}[$i],
1906: $content{'recdomain'}[$i]),
1907: $content{'recuser'}[$i],$content{'recdomain'}[$i]).
1908: ' ('.$content{'recuser'}[$i].' at '.$content{'recdomain'}[$i].') ';
1909: }
1910: $tolist = join(', ',@recipients);
1911: $r->print('<br /><b>'.&mt('Subject').':</b> '.$content{'subject'}.
1912: ($folder ne 'sent'?'<br /><b>'.&mt('From').':</b> '.
1913: &Apache::loncommon::aboutmewrapper(
1914: &Apache::loncommon::plainname($content{'sendername'},$content{'senderdomain'}),
1915: $content{'sendername'},$content{'senderdomain'}).' ('.
1916: $content{'sendername'}.' at '.
1917: $content{'senderdomain'}.') ':'<br /><b>'.&mt('To').':</b> '.
1918: $tolist).
1919: ($content{'courseid'}?'<br /><b>'.&mt('Course').':</b> '.$courseinfo{'description'}.
1920: ($content{'coursesec'}?' ('.&mt('Group/Section').': '.$content{'coursesec'}.')':''):'').
1921: '<br /><b>'.&mt('Time').':</b> '.$content{'time'}.
1922: ($content{'baseurl'}?'<br /><b>'.&mt('Refers to').':</b> <a href="'.$content{'baseurl'}.'">'.
1923: $content{'baseurl'}.' ('.&Apache::lonnet::gettitle($content{'baseurl'}).')</a>':'').
1924: '<p><pre>'.
1925: &Apache::lontexconvert::msgtexconverted($content{'message'},1).
1926: '</pre><hr />'.&displayresource(%content).'</p>');
1927: return;
1928: }
1929:
1930: # =========================================================== Show the citation
1931:
1932: sub displayresource {
1933: my %content=@_;
1934: #
1935: # If the recipient is in the same course that the message was sent from and
1936: # has sufficient privileges, show "all details," else show citation
1937: #
1938: if (($env{'request.course.id'} eq $content{'courseid'})
1939: && (&Apache::lonnet::allowed('vgr',$content{'courseid'}))) {
1940: my $symb=&Apache::lonnet::symbread($content{'baseurl'});
1941: # Could not get a symb, give up
1942: unless ($symb) { return $content{'citation'}; }
1943: # Have a symb, can render
1944: return '<h2>'.&mt('Current attempts of student (if applicable)').'</h2>'.
1945: &Apache::loncommon::get_previous_attempt($symb,
1946: $content{'sendername'},
1947: $content{'senderdomain'},
1948: $content{'courseid'}).
1949: '<hr /><h2>'.&mt('Current screen output (if applicable)').'</h2>'.
1950: &Apache::loncommon::get_student_view($symb,
1951: $content{'sendername'},
1952: $content{'senderdomain'},
1953: $content{'courseid'}).
1954: '<h2>'.&mt('Correct Answer(s) (if applicable)').'</h2>'.
1955: &Apache::loncommon::get_student_answers($symb,
1956: $content{'sendername'},
1957: $content{'senderdomain'},
1958: $content{'courseid'});
1959: } else {
1960: return $content{'citation'};
1961: }
1962: }
1963:
1964: # ================================================================== The Header
1965:
1966: sub header {
1967: my ($r,$title,$baseurl)=@_;
1968: $r->print(&Apache::lonxml::xmlbegin().
1969: '<head>'.&Apache::lonxml::fontsettings().
1970: '<title>Communication and Messages</title>'.
1971: &Apache::lonhtmlcommon::htmlareaheaders());
1972: if ($baseurl) {
1973: $r->print("<base href=\"http://$ENV{'SERVER_NAME'}/$baseurl\" />");
1974: }
1975: $r->print(&Apache::loncommon::studentbrowser_javascript().'</head>'.
1976: &Apache::loncommon::bodytag('Communication and Messages'));
1977: $r->print(&Apache::lonhtmlcommon::breadcrumbs
1978: (undef,($title?$title:'Communication and Messages')));
1979:
1980: }
1981:
1982: # ---------------------------------------------------------------- Print header
1983:
1984: sub printheader {
1985: my ($r,$url,$desc,$title,$baseurl)=@_;
1986: &Apache::lonhtmlcommon::add_breadcrumb
1987: ({href=>$url,
1988: text=>$desc});
1989: &header($r,$title,$baseurl);
1990: }
1991:
1992: # ------------------------------------------------------------ Store the comment
1993:
1994: sub storecomment {
1995: my ($r)=@_;
1996: my $msgtxt=&Apache::lonfeedback::clear_out_html($env{'form.message'});
1997: my $cleanmsgtxt='';
1998: foreach (split(/[\n\r]/,$msgtxt)) {
1999: unless ($_=~/^\s*(\>|\>\;)/) {
2000: $cleanmsgtxt.=$_."\n";
2001: }
2002: }
2003: my $key=&Apache::lonnet::escape($env{'form.baseurl'}).'___'.time;
2004: &Apache::lonnet::put('nohist_stored_comments',{ $key => $cleanmsgtxt });
2005: }
2006:
2007: sub storedcommentlisting {
2008: my ($r)=@_;
2009: my %msgs=&Apache::lonnet::dump('nohist_stored_comments',undef,undef,
2010: '^'.&Apache::lonnet::escape(&Apache::lonnet::escape($env{'form.showcommentbaseurl'})));
2011: $r->print(&Apache::lonxml::xmlbegin().'<head>'.
2012: &Apache::lonxml::fontsettings().'</head><body>');
2013: if ((keys %msgs)[0]=~/^error\:/) {
2014: $r->print(&mt('No stored comments yet.'));
2015: } else {
2016: my $found=0;
2017: foreach (sort keys %msgs) {
2018: $r->print("\n".$msgs{$_}."<hr />");
2019: $found=1;
2020: }
2021: unless ($found) {
2022: $r->print(&mt('No stored comments yet for this resource.'));
2023: }
2024: }
2025: }
2026:
2027: # ---------------------------------------------------------------- Send an email
2028:
2029: sub sendoffmail {
2030: my ($r,$folder)=@_;
2031: my $suffix=&foldersuffix($folder);
2032: my $sendstatus='';
2033: my %specialmsg_status;
2034: my $numspecial = 0;
2035: if ($env{'form.send'}) {
2036: &printheader($r,'','Messages being sent.');
2037: $r->rflush();
2038: my %content=();
2039: undef %content;
2040: if ($env{'form.forwid'}) {
2041: my $msgid=$env{'form.forwid'};
2042: my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
2043: %content=&unpackagemsg($message{$msgid},1);
2044: &statuschange($msgid,'forwarded',$folder);
2045: $env{'form.message'}.="\n\n-- Forwarded message --\n\n".
2046: $content{'message'};
2047: }
2048: if ($env{'form.replyid'}) {
2049: my $msgid=$env{'form.replyid'};
2050: my %message=&Apache::lonnet::get('nohist_email'.$suffix,[$msgid]);
2051: %content=&unpackagemsg($message{$msgid},1);
2052: &statuschange($msgid,'replied',$folder);
2053: }
2054: my %toaddr=();
2055: undef %toaddr;
2056: if ($env{'form.sendmode'} eq 'group') {
2057: foreach (keys %env) {
2058: if ($_=~/^form\.send\_to\_\&\&\&[^\&]*\&\&\&\_(.+)$/) {
2059: $toaddr{$1}='';
2060: }
2061: }
2062: } elsif ($env{'form.sendmode'} eq 'upload') {
2063: foreach (split(/[\n\r\f]+/,$env{'form.upfile'})) {
2064: my ($rec,$txt)=split(/\s*\:\s*/,$_);
2065: if ($txt) {
2066: $rec=~s/\@/\:/;
2067: $toaddr{$rec}.=$txt."\n";
2068: }
2069: }
2070: } else {
2071: $toaddr{$env{'form.recuname'}.':'.$env{'form.recdomain'}}='';
2072: }
2073: if ($env{'form.additionalrec'}) {
2074: foreach (split(/\,/,$env{'form.additionalrec'})) {
2075: my ($auname,$audom)=split(/\@/,$_);
2076: $toaddr{$auname.':'.$audom}='';
2077: }
2078: }
2079:
2080: my $savemsg;
2081: my $msgtype;
2082: my %sentmessage;
2083: if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
2084: (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) {
2085: $savemsg=&Apache::lonfeedback::clear_out_html($env{'form.message'},1);
2086: $msgtype = 'critical';
2087: } else {
2088: $savemsg=&Apache::lonfeedback::clear_out_html($env{'form.message'});
2089: }
2090:
2091: foreach (keys %toaddr) {
2092: my ($recuname,$recdomain)=split(/\:/,$_);
2093: my $msgtxt = $savemsg;
2094: if ($toaddr{$_}) { $msgtxt.='<hr />'.$toaddr{$_}; }
2095: my $thismsg;
2096: if ((($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
2097: (&Apache::lonnet::allowed('srm',$env{'request.course.id'}))) {
2098: $r->print(&mt('Sending critical message').' '.$recuname.'@'.$recdomain.': ');
2099: $thismsg=&user_crit_msg($recuname,$recdomain,
2100: &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
2101: $msgtxt,
2102: $env{'form.sendbck'},$env{'form.permanent'},\$sentmessage{$_});
2103: } else {
2104: $r->print(&mt('Sending').' '.$recuname.'@'.$recdomain.': ');
2105: $thismsg=&user_normal_msg($recuname,$recdomain,
2106: &Apache::lonfeedback::clear_out_html($env{'form.subject'}),
2107: $msgtxt,
2108: $content{'citation'},undef,undef,$env{'form.permanent'},\$sentmessage{$_});
2109: }
2110: if (($env{'request.course.id'}) && (($msgtype eq 'critical') ||
2111: ($env{'form.sendmode'} eq 'group'))) {
2112: $specialmsg_status{$recuname.':'.$recdomain} = $thismsg;
2113: if ($thismsg eq 'ok') {
2114: $numspecial ++;
2115: }
2116: }
2117: $r->print($thismsg.'<br />');
2118: $sendstatus.=' '.$thismsg;
2119: }
2120: if (($env{'request.course.id'}) && (($env{'form.sendmode'} eq 'group')
2121: || ($msgtype eq 'critical'))) {
2122: my $subj_prefix;
2123: if ($msgtype eq 'critical') {
2124: $subj_prefix = 'Critical.';
2125: } else {
2126: $subj_prefix = 'Broadcast.';
2127: }
2128: my ($specialmsgid,$specialresult);
2129: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2130: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2131: my $course_str = &Apache::lonnet::escape('['.$cnum.':'.$cdom.']');
2132:
2133: if ($numspecial) {
2134: $specialresult = &user_normal_msg_raw($cnum,$cdom,$subj_prefix.
2135: ' '.$course_str,$savemsg,undef,undef,undef,
2136: undef,undef,\$specialmsgid);
2137: $specialmsgid = &Apache::lonnet::unescape($specialmsgid);
2138: }
2139: if ($specialresult eq 'ok') {
2140: my $record_sent;
2141: my @recusers = ();
2142: my @recudoms = ();
2143: my ($stamp,$msgsubj,$msgname,$msgdom,$msgcount,$context,$pid) =
2144: split(/\:/,&Apache::lonnet::unescape($specialmsgid));
2145: foreach my $recipient (sort(keys(%toaddr))) {
2146: if ($specialmsg_status{$recipient} eq 'ok') {
2147: my $usersubj = $subj_prefix.'['.$recipient.']';
2148: my $usermsgid = &buildmsgid($stamp,$usersubj,$msgname,
2149: $msgdom,$msgcount,$context,$pid);
2150: &user_normal_msg_raw($cnum,$cdom,$subj_prefix.
2151: ' ['.$recipient.']',$sentmessage{$recipient},
2152: undef,undef,undef,undef,$usermsgid);
2153: my ($uname,$udom) = split/:/,$recipient;
2154: push(@recusers,$uname);
2155: push(@recudoms,$udom);
2156: }
2157: }
2158: if (@recusers) {
2159: my $specialmessage;
2160: my $sentsubj = $subj_prefix.' ('.$numspecial.' sent) '.
2161: &Apache::lonfeedback::clear_out_html($env{'form.subject'});
2162: $sentsubj = &HTML::Entities::encode($sentsubj,'<>&"');
2163: my $sentmsgid = &buildmsgid($stamp,$sentsubj,$msgname,
2164: $msgdom,$msgcount,$context,$pid);
2165: ($specialmsgid,$specialmessage) =
2166: &packagemsg(&Apache::lonfeedback::clear_out_html(
2167: $env{'form.subject'}),$savemsg,undef,undef,undef,
2168: \@recusers,\@recudoms,$sentmsgid);
2169: $record_sent = &store_sent_mail($specialmsgid,$specialmessage);
2170: }
2171: } else {
2172: &Apache::lonnet::logthis('Failed to create record of critical message or broadcast in '.$env{'course.'.$env{'request.course.id'}.'.num'}.' at '.$env{'course.'.$env{'request.course.id'}.'.domain'}.' - no msgid generated');
2173: }
2174: }
2175: } else {
2176: &printheader($r,'','No messages sent.');
2177: }
2178: if ($sendstatus=~/^(\s*(?:ok|con_delayed)\s*)*$/) {
2179: $r->print('<br /><font color="green">'.&mt('Completed.').'</font>');
2180: if ($env{'form.displayedcrit'}) {
2181: &discrit($r);
2182: } else {
2183: &Apache::loncommunicate::menu($r);
2184: }
2185: } else {
2186: $r->print(
2187: '<h2><font color="red">'.&mt('Could not deliver message').'</font></h2>'.
2188: &mt('Please use the browser "Back" button and correct the recipient addresses')
2189: );
2190: }
2191: }
2192:
2193: # ===================================================================== Handler
2194:
2195: sub handler {
2196: my $r=shift;
2197:
2198: # ----------------------------------------------------------- Set document type
2199:
2200: &Apache::loncommon::content_type($r,'text/html');
2201: $r->send_http_header;
2202:
2203: return OK if $r->header_only;
2204:
2205: # --------------------------- Get query string for limited number of parameters
2206: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
2207: ['display','replyto','forward','markread','markdel','markunread',
2208: 'sendreply','compose','sendmail','critical','recname','recdom',
2209: 'recordftf','sortedby','block','folder','startdis','interdis',
2210: 'showcommentbaseurl','dismode']);
2211: $sqs='&sortedby='.$env{'form.sortedby'};
2212:
2213: # ------------------------------------------------------ They checked for email
2214: unless ($env{'form.block'}) {
2215: &Apache::lonnet::put('email_status',{'recnewemail'=>0});
2216: }
2217:
2218: # ----------------------------------------------------------------- Breadcrumbs
2219:
2220: &Apache::lonhtmlcommon::clear_breadcrumbs();
2221: &Apache::lonhtmlcommon::add_breadcrumb
2222: ({href=>"/adm/communicate",
2223: text=>"Communication/Messages",
2224: faq=>12,bug=>'Communication Tools',});
2225:
2226: # ------------------------------------------------------------------ Get Folder
2227:
2228: my $folder=$env{'form.folder'};
2229: unless ($folder) {
2230: $folder='';
2231: } else {
2232: $sqs.='&folder='.&Apache::lonnet::escape($folder);
2233: }
2234: # ------------------------------------------------------------ Get Display Mode
2235:
2236: my $dismode=$env{'form.dismode'};
2237: unless ($dismode) {
2238: $dismode='';
2239: } else {
2240: $sqs.='&dismode='.&Apache::lonnet::escape($dismode);
2241: }
2242:
2243: # --------------------------------------------------------------------- Display
2244:
2245: $startdis=$env{'form.startdis'};
2246: $startdis--;
2247: unless ($startdis) { $startdis=0; }
2248:
2249: $interdis=$env{'form.interdis'};
2250: unless ($interdis) { $interdis=20; }
2251: $sqs.='&interdis='.$interdis;
2252:
2253: if ($env{'form.firstview'}) {
2254: $startdis=0;
2255: }
2256: if ($env{'form.lastview'}) {
2257: $startdis=-1;
2258: }
2259: if ($env{'form.prevview'}) {
2260: $startdis--;
2261: }
2262: if ($env{'form.nextview'}) {
2263: $startdis++;
2264: }
2265: my $postedstartdis=$startdis+1;
2266: $sqs.='&startdis='.$postedstartdis;
2267:
2268: # --------------------------------------------------------------- Render Output
2269:
2270: if ($env{'form.display'}) {
2271: &displaymessage($r,$env{'form.display'},$folder);
2272: } elsif ($env{'form.replyto'}) {
2273: &compout($r,'',$env{'form.replyto'},undef,undef,$folder,$dismode);
2274: } elsif ($env{'form.confirm'}) {
2275: &printheader($r,'','Confirmed Receipt');
2276: foreach (keys %env) {
2277: if ($_=~/^form\.rec\_(.*)$/) {
2278: $r->print('<b>'.&mt('Confirming Receipt').':</b> '.
2279: &user_crit_received($1).'<br>');
2280: }
2281: if ($_=~/^form\.reprec\_(.*)$/) {
2282: my $msgid=$1;
2283: $r->print('<b>'.&mt('Confirming Receipt').':</b> '.
2284: &user_crit_received($msgid).'<br>');
2285: &compout($r,'','','',$msgid);
2286: }
2287: }
2288: &discrit($r);
2289: } elsif ($env{'form.critical'}) {
2290: &printheader($r,'','Displaying Critical Messages');
2291: &discrit($r);
2292: } elsif ($env{'form.forward'}) {
2293: &compout($r,$env{'form.forward'},undef,undef,undef,$folder);
2294: } elsif ($env{'form.markdel'}) {
2295: &printheader($r,'','Deleted Message');
2296: &statuschange($env{'form.markdel'},'deleted',$folder);
2297: &Apache::loncommunicate::menu($r);
2298: &disall($r,($folder?$folder:$dismode));
2299: } elsif ($env{'form.markedmove'}) {
2300: my $total=0;
2301: foreach (keys %env) {
2302: if ($_=~/^form\.delmark_(.*)$/) {
2303: &movemsg(&Apache::lonnet::unescape($1),$folder,
2304: $env{'form.movetofolder'});
2305: $total++;
2306: }
2307: }
2308: &printheader($r,'','Moved Messages');
2309: $r->print('Moved '.$total.' message(s)<p>');
2310: &Apache::loncommunicate::menu($r);
2311: &disall($r,($folder?$folder:$dismode));
2312: } elsif ($env{'form.markeddel'}) {
2313: my $total=0;
2314: foreach (keys %env) {
2315: if ($_=~/^form\.delmark_(.*)$/) {
2316: &statuschange(&Apache::lonnet::unescape($1),'deleted',$folder);
2317: $total++;
2318: }
2319: }
2320: &printheader($r,'','Deleted Messages');
2321: $r->print('Deleted '.$total.' message(s)<p>');
2322: &Apache::loncommunicate::menu($r);
2323: &disall($r,($folder?$folder:$dismode));
2324: } elsif ($env{'form.markunread'}) {
2325: &printheader($r,'','Marked Message as Unread');
2326: &statuschange($env{'form.markunread'},'new');
2327: &Apache::loncommunicate::menu($r);
2328: &disall($r,($folder?$folder:$dismode));
2329: } elsif ($env{'form.compose'}) {
2330: &compout($r,'','',$env{'form.compose'});
2331: } elsif ($env{'form.recordftf'}) {
2332: &facetoface($r,$env{'form.recordftf'});
2333: } elsif ($env{'form.block'}) {
2334: &examblock($r,$env{'form.block'});
2335: } elsif ($env{'form.sendmail'}) {
2336: &sendoffmail($r,$folder);
2337: if ($env{'form.storebasecomment'}) {
2338: &storecomment($r);
2339: }
2340: if (($env{'form.rsspost'}) && ($env{'request.course.id'})) {
2341: &Apache::lonrss::addentry($env{'course.'.$env{'request.course.id'}.'.num'},
2342: $env{'course.'.$env{'request.course.id'}.'.domain'},
2343: 'Course_Announcements',
2344: $env{'form.subject'},
2345: $env{'form.message'},'/adm/communicate','public');
2346: }
2347: &disall($r,($folder?$folder:$dismode));
2348: } elsif ($env{'form.newfolder'}) {
2349: &printheader($r,'','New Folder');
2350: &makefolder($env{'form.newfolder'});
2351: &Apache::loncommunicate::menu($r);
2352: &disall($r,$env{'form.newfolder'});
2353: } elsif ($env{'form.showcommentbaseurl'}) {
2354: &storedcommentlisting($r);
2355: } else {
2356: &printheader($r,'','Display All Messages');
2357: &Apache::loncommunicate::menu($r);
2358: &disall($r,($folder?$folder:$dismode));
2359: }
2360: $r->print(&Apache::loncommon::endbodytag().'</html>');
2361: return OK;
2362: }
2363: # ================================================= Main program, reset counter
2364:
2365: BEGIN {
2366: $msgcount=0;
2367: }
2368:
2369: =pod
2370:
2371: =back
2372:
2373: =cut
2374:
2375: 1;
2376:
2377: __END__
2378:
2379:
2380:
2381:
2382:
2383:
2384:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmsg.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface