loncom/interface/lonmsg.pm - view

File: [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.131: download - view: text, annotated - select for diffs
Sun Jan 30 23:32:29 2005 UTC (19 years, 5 months ago) by www
Branches: MAIN
CVS tags: HEAD

* Display Folder from viewing a new message goes back to
  New Messages instead of INBOX.
* Notification email includes message text

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