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