loncom/interface/lonmsg.pm - view

File: [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.124: download - view: text, annotated - select for diffs
Wed Dec 15 01:17:09 2004 UTC (19 years, 6 months ago) by www
Branches: MAIN
CVS tags: HEAD

Bug #3709: ISE on PREVIOUS

I could not get the ISE on line 956 to happen by using PREVIOUS, in spite of
doing lots of PREVIOUS, NEXT, FIRST, LAST - but I could make it happen with
an empty folder.

Detecting empty folders now. Will keep on trying.

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