loncom/interface/lonmsg.pm - view

File: [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.214: download - view: text, annotated - select for diffs
Tue Nov 4 04:18:22 2008 UTC (15 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: version_2_8_X, HEAD

- New <group></group> entry in packaged message to store group for group broadcasts.
- Email to permanentemail, only send if notification has not also been sent to same address.
- process_sent_mail() takes extra argument - recipid, so it can be passed to &packagemsg() for access to recipients by type (To, Cc, Bcc, Broadcast etc.).

1: # The LearningOnline Network with CAPA 2: # Routines for messaging 3: # 4: # $Id: lonmsg.pm,v 1.214 2008/11/04 04:18:22 raeburn Exp $ 5: # 6: # Copyright Michigan State University Board of Trustees 7: # 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA). 9: # 10: # LON-CAPA is free software; you can redistribute it and/or modify 11: # it under the terms of the GNU General Public License as published by 12: # the Free Software Foundation; either version 2 of the License, or 13: # (at your option) any later version. 14: # 15: # LON-CAPA is distributed in the hope that it will be useful, 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18: # GNU General Public License for more details. 19: # 20: # You should have received a copy of the GNU General Public License 21: # along with LON-CAPA; if not, write to the Free Software 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 23: # 24: # /home/httpd/html/adm/gpl.txt 25: # 26: # http://www.lon-capa.org/ 27: # 28: 29: package Apache::lonmsg; 30: 31: =pod 32: 33: =head1 NAME 34: 35: Apache::lonmsg: supports internal messaging 36: 37: =head1 SYNOPSIS 38: 39: lonmsg provides routines for sending messages. 40: 41: Right now, this document will cover just how to send a message, since 42: it is likely you will not need to programmatically read messages, 43: since lonmsg already implements that functionality. 44: 45: The routines used to package messages and unpackage messages are not 46: only used by lonmsg when creating/extracting messages for LON-CAPA's 47: internal messaging system, but also by lonnotify.pm which is available 48: for use by Domain Coordinators to broadcast standard e-mail to specified 49: users in their domain. The XML packaging used in the two cases is very 50: similar. The differences are the use of <recuser>$uname</recuser> and 51: <recdomain>$udom</recdomain> in stored internal messages, compared 52: with <recipient username="$uname:$udom">$email</recipient> in stored 53: Domain Coordinator e-mail for the storage of information about 54: recipients of the message/e-mail. 55: 56: =head1 FUNCTIONS 57: 58: =over 4 59: 60: =cut 61: 62: use strict; 63: use Apache::lonnet; 64: use HTML::TokeParser(); 65: use Apache::lonlocal; 66: use Mail::Send; 67: use LONCAPA qw(:DEFAULT :match); 68: 69: { 70: my $uniq; 71: sub get_uniq { 72: $uniq++; 73: return $uniq; 74: } 75: } 76: 77: # ===================================================================== Package 78: 79: sub packagemsg { 80: my ($subject,$message,$citation,$baseurl,$attachmenturl, 81: $recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error,$recipid)=@_; 82: $message =&HTML::Entities::encode($message,'<>&"'); 83: $citation=&HTML::Entities::encode($citation,'<>&"'); 84: $subject =&HTML::Entities::encode($subject,'<>&"'); 85: #remove machine specification 86: $baseurl =~ s|^http://[^/]+/|/|; 87: $baseurl =&HTML::Entities::encode($baseurl,'<>&"'); 88: #remove machine specification 89: $attachmenturl =~ s|^http://[^/]+/|/|; 90: $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"'); 91: my $course_context = &get_course_context(); 92: my $now=time; 93: my $msgcount = &get_uniq(); 94: unless(defined($msgid)) { 95: $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'}, 96: $msgcount,$course_context,$symb,$error,$$); 97: } 98: my $result = '<sendername>'.$env{'user.name'}.'</sendername>'. 99: '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'. 100: '<subject>'.$subject.'</subject>'. 101: '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'; 102: if (defined($crsmsgid)) { 103: $result.= '<courseid>'.$course_context.'</courseid>'. 104: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. 105: '<msgid>'.$msgid.'</msgid>'. 106: '<coursemsgid>'.$crsmsgid.'</coursemsgid>'. 107: '<message>'.$message.'</message>'; 108: return ($msgid,$result); 109: } 110: $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'. 111: '<host>'.$ENV{'HTTP_HOST'}.'</host>'. 112: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'. 113: '<browsertype>'.$env{'browser.type'}.'</browsertype>'. 114: '<browseros>'.$env{'browser.os'}.'</browseros>'. 115: '<browserversion>'.$env{'browser.version'}.'</browserversion>'. 116: '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'. 117: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'. 118: '<courseid>'.$course_context.'</courseid>'. 119: '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'. 120: '<role>'.$env{'request.role'}.'</role>'. 121: '<resource>'.$env{'request.filename'}.'</resource>'. 122: '<msgid>'.$msgid.'</msgid>'; 123: if (defined($env{'form.group'})) { 124: $result .= '<group>'.$env{'form.group'}.'</group>'; 125: } 126: if (ref($recuser) eq 'ARRAY') { 127: for (my $i=0; $i<@{$recuser}; $i++) { 128: if ($type eq 'dcmail') { 129: my ($username,$email) = split(/:/,$$recuser[$i]); 130: $username = &unescape($username); 131: $email = &unescape($email); 132: $username = &HTML::Entities::encode($username,'<>&"'); 133: $email = &HTML::Entities::encode($email,'<>&"'); 134: $result .= '<recipient username="'.$username.'">'. 135: $email.'</recipient>'; 136: } else { 137: $result .= '<recuser>'.$$recuser[$i].'</recuser>'. 138: '<recdomain>'.$$recdomain[$i].'</recdomain>'; 139: } 140: } 141: } else { 142: $result .= '<recuser>'.$recuser.'</recuser>'. 143: '<recdomain>'.$recdomain.'</recdomain>'; 144: } 145: $result .= '<message>'.$message.'</message>'; 146: if (defined($citation)) { 147: $result.='<citation>'.$citation.'</citation>'; 148: } 149: if (defined($baseurl)) { 150: $result.= '<baseurl>'.$baseurl.'</baseurl>'; 151: } 152: if (defined($attachmenturl)) { 153: $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>'; 154: } 155: if (defined($symb)) { 156: $result.= '<symb>'.$symb.'</symb>'; 157: if ($course_context ne '') { 158: if ($course_context eq $env{'request.course.id'}) { 159: my $resource_title = &Apache::lonnet::gettitle($symb); 160: if (defined($resource_title)) { 161: $result .= '<resource_title>'.$resource_title.'</resource_title>'; 162: } 163: } 164: } 165: } 166: if (defined($recipid)) { 167: $result.= '<recipid>'.$recipid.'</recipid>'; 168: } 169: if ($env{'form.can_reply'} eq 'N') { 170: $result .= '<noreplies>1</noreplies>'; 171: } 172: if ($env{'form.reply_to_addr'}) { 173: my ($replytoname,$replytodom) = split(/:/,$env{'form.reply_to_addr'}); 174: if (!($replytoname eq $env{'user.name'} && $replytodom eq $env{'user.domain'})) { 175: if (&Apache::lonnet::homeserver($replytoname,$replytodom) ne 'no_host') { 176: $result .= '<replytoaddr>'.$env{'form.reply_to_addr'}.'</replytoaddr>'; 177: } 178: } 179: } 180: return ($msgid,$result); 181: } 182: 183: sub get_course_context { 184: my $course_context; 185: my $msgkey; 186: if (defined($env{'form.replyid'})) { 187: $msgkey = $env{'form.replyid'}; 188: } elsif (defined($env{'form.forwid'})) { 189: $msgkey = $env{'form.forwid'} 190: } elsif (defined($env{'form.multiforwid'})) { 191: $msgkey = $env{'form.multiforwid'}; 192: } 193: if ($msgkey ne '') { 194: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)= 195: split(/\:/,&unescape($msgkey)); 196: $course_context = $origcid; 197: } 198: foreach my $key (keys(%env)) { 199: if ($key=~/^form\.(rep)?rec\_(.*)$/) { 200: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) = 201: split(/\:/,&unescape($2)); 202: $course_context = $origcid; 203: last; 204: } 205: } 206: if ($course_context eq '') { 207: $course_context = $env{'request.course.id'}; 208: } 209: return $course_context; 210: } 211: 212: # ================================================== Unpack message into a hash 213: 214: sub unpackagemsg { 215: my ($message,$notoken,$noattachmentlink)=@_; 216: my %content=(); 217: my $parser=HTML::TokeParser->new(\$message); 218: my $token; 219: while ($token=$parser->get_token) { 220: if ($token->[0] eq 'S') { 221: my $entry=$token->[1]; 222: my $value=$parser->get_text('/'.$entry); 223: if (($entry eq 'recuser') || ($entry eq 'recdomain')) { 224: push(@{$content{$entry}},$value); 225: } elsif ($entry eq 'recipient') { 226: my $username = $token->[2]{'username'}; 227: $username = &HTML::Entities::decode($username,'<>&"'); 228: $content{$entry}{$username} = $value; 229: } else { 230: $content{$entry}=$value; 231: } 232: } 233: } 234: if (!exists($content{'recuser'})) { $content{'recuser'} = []; } 235: if (($content{'attachmenturl'}) && (!$noattachmentlink)) { 236: my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|); 237: if ($notoken) { 238: $content{'message'}.=''.&mt('Attachment').': <tt>'.$fname.'</tt>'; 239: } else { 240: &Apache::lonnet::allowuploaded('/adm/msg', 241: $content{'attachmenturl'}); 242: $content{'message'}.=''.&mt('Attachment'). 243: ': <a href="'.$content{'attachmenturl'}.'"><tt>'. 244: $fname.'</tt></a>'; 245: } 246: } 247: return %content; 248: } 249: 250: # ======================================================= Get info out of msgid 251: 252: sub buildmsgid { 253: my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_; 254: $subject=&escape($subject); 255: $symb = &escape($symb); 256: return(&escape($now.':'.$subject.':'.$uname.':'. 257: $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error)); 258: } 259: 260: sub unpackmsgid { 261: my ($msgid,$folder,$skipstatus,$status_cache)=@_; 262: $msgid=&unescape($msgid); 263: my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid, 264: $processid,$symb,$error) = split(/\:/,&unescape($msgid)); 265: $shortsubj = &unescape($shortsubj); 266: $shortsubj = &HTML::Entities::decode($shortsubj); 267: $symb = &unescape($symb); 268: if (!defined($processid)) { $fromcid = ''; } 269: my %status=(); 270: unless ($skipstatus) { 271: if (ref($status_cache)) { 272: $status{$msgid} = $status_cache->{$msgid}; 273: } else { 274: my $suffix=&foldersuffix($folder); 275: %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]); 276: } 277: if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; } 278: unless ($status{$msgid}) { $status{$msgid}='new'; } 279: } 280: return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error); 281: } 282: 283: 284: sub sendemail { 285: my ($to,$subject,$body,$to_uname,$to_udom,$user_lh)=@_; 286: my %senderemails=&Apache::loncommon::getemails(); 287: my $senderaddress=''; 288: foreach my $type ('notification','permanentemail','critnotification') { 289: if ($senderemails{$type}) { 290: $senderaddress=$senderemails{$type}; 291: } 292: } 293: $body= 294: "*** ".&mt_user($user_lh,'This is an automatic message generated by the LON-CAPA system.')."\n". 295: "*** ".($senderaddress?&mt_user($user_lh,'You can reply to this message'):&mt_user($user_lh,'Please do not reply to this address.')."\n*** ". 296: &mt_user($user_lh,'A reply will not be received by the recipient!'))."\n\n".$body; 297: my $msg = new Mail::Send; 298: $msg->to($to); 299: $msg->subject('[LON-CAPA] '.$subject); 300: if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); } 301: if (my $fh = $msg->open()) { 302: print $fh $body; 303: $fh->close; 304: } 305: } 306: 307: # ==================================================== Send notification emails 308: 309: sub sendnotification { 310: my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_; 311: my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'}; 312: unless ($sender=~/\w/) { 313: $sender=$env{'user.name'}.':'.$env{'user.domain'}; 314: } 315: my $critical=($crit?' critical':''); 316: 317: $text=~s/\&lt\;/\</gs; 318: $text=~s/\&gt\;/\>/gs; 319: my $url='http://'. 320: &Apache::lonnet::hostname(&Apache::lonnet::homeserver($touname,$toudom)). 321: '/adm/email?username='.$touname.'&domain='.$toudom; 322: my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid, 323: $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid); 324: my ($coursetext,$body,$bodybegin,$bodysubj,$bodyend); 325: my $user_lh = &user_lang($touname,$toudom,$fromcid); 326: if ($fromcid ne '') { 327: $coursetext = "\n".&mt_user($user_lh,'Course').': '; 328: if ($env{'course.'.$fromcid.'.description'} ne '') { 329: $coursetext .= $env{'course.'.$fromcid.'.description'}; 330: } else { 331: my %coursehash = &Apache::lonnet::coursedescription($fromcid,); 332: if ($coursehash{'description'} ne '') { 333: $coursetext .= $coursehash{'description'}; 334: } 335: } 336: $coursetext .= "\n\n"; 337: } 338: my @recipients = split(/,/,$to); 339: $bodybegin = $coursetext. 340: &mt_user($user_lh, 341: 'You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '; 342: $bodysubj = &mt_user($user_lh,'The subject is 343: 344: [_1] 345: 346: ',$subj)."\n". 347: '=== '.&mt_user($user_lh,'Excerpt')." ============================================================ 348: "; 349: $bodyend = " 350: ======================================================================== 351: 352: ".&mt_user($user_lh,'Use 353: 354: [_1] 355: 356: to access the full message.',$url); 357: my %userenv = &Apache::lonnet::get('environment',['notifywithhtml'],$toudom,$touname); 358: my $subject = &mt_user($user_lh,"'New' $critical message from ").$sender; 359: 360: my ($blocked,$blocktext); 361: if (!$crit) { 362: my %setters; 363: my ($startblock,$endblock) = 364: &Apache::loncommon::blockcheck(\%setters,'com',$touname,$toudom); 365: if ($startblock && $endblock) { 366: $blocked = 1; 367: my $showstart = &Apache::lonlocal::locallocaltime($startblock); 368: my $showend = &Apache::lonlocal::locallocaltime($endblock); 369: $blocktext = &mt_user($user_lh,'LON-CAPA messages sent to you between [_1] and [_2] will be inaccessible until the end of this time period, because you are a student in a course with an active communications block.',$showstart,$showend); 370: } 371: } 372: if ($userenv{'notifywithhtml'} ne '') { 373: my @htmlexcerpt = split(/,/,$userenv{'notifywithhtml'}); 374: foreach my $addr (@recipients) { 375: if ($blocked) { 376: $body = $bodybegin."\n".$blocktext."\n".$bodyend; 377: } else { 378: my $sendtext = $text; 379: if (!grep/^\Q$addr\E/,@htmlexcerpt) { 380: $sendtext =~ s/\<\/*[^\>]+\>//gs; 381: } 382: $body = $bodybegin.$bodysubj.$sendtext.$bodyend; 383: } 384: &sendemail($addr,$subject,$body,$touname,$toudom,$user_lh); 385: } 386: } else { 387: if ($blocked) { 388: $body = $bodybegin."\n".$blocktext."\n".$bodyend; 389: } else { 390: $text =~ s/\<\/*[^\>]+\>//gs; 391: $body = $bodybegin.$bodysubj.$text.$bodyend; 392: } 393: &sendemail($to,$subject,$body,$touname,$toudom,$user_lh); 394: } 395: } 396: # ============================================================= Check for email 397: 398: sub newmail { 399: if ((time-$env{'user.mailcheck.time'})>300) { 400: my %what=&Apache::lonnet::get('email_status',['recnewemail']); 401: &Apache::lonnet::appenv({'user.mailcheck.time'=>time}); 402: if ($what{'recnewemail'}>0) { return 1; } 403: } 404: return 0; 405: } 406: 407: # =============================== Automated message to the author of a resource 408: 409: =pod 410: 411: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner 412: of the resource with the URI $filename. 413: 414: =cut 415: 416: sub author_res_msg { 417: my ($filename,$message)=@_; 418: unless ($message) { return 'empty'; } 419: $filename=&Apache::lonnet::declutter($filename); 420: my ($domain,$author,@dummy)=split(/\//,$filename); 421: my $homeserver=&Apache::lonnet::homeserver($author,$domain); 422: if ($homeserver ne 'no_host') { 423: my $id=unpack("%32C*",$message); 424: $message .= " This error occurred on machine ". 425: $Apache::lonnet::perlvar{'lonHostID'}.""; 426: my $msgid; 427: ($msgid,$message)=&packagemsg($filename,$message); 428: return &Apache::lonnet::reply('put:'.$domain.':'.$author. 429: ':nohist_res_msgs:'. 430: &escape($filename.'_'.$id).'='. 431: &escape($message),$homeserver); 432: } 433: return 'no_host'; 434: } 435: 436: # =========================================== Retrieve author resource messages 437: 438: sub retrieve_author_res_msg { 439: my $url=shift; 440: $url=&Apache::lonnet::declutter($url); 441: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 442: my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author); 443: my $msgs=''; 444: foreach (keys %errormsgs) { 445: if ($_=~/^\Q$url\E\_\d+$/) { 446: my %content=&unpackagemsg($errormsgs{$_}); 447: $msgs.='<img src="/adm/lonMisc/bomb.gif" />'. 448: $content{'time'}.': '.$content{'message'}. 449: ' '; 450: } 451: } 452: return $msgs; 453: } 454: 455: 456: # =============================== Delete all author messages related to one URL 457: 458: sub del_url_author_res_msg { 459: my $url=shift; 460: $url=&Apache::lonnet::declutter($url); 461: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 462: my @delmsgs=(); 463: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 464: if ($_=~/^\Q$url\E\_\d+$/) { 465: push (@delmsgs,$_); 466: } 467: } 468: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); 469: } 470: # =================================== Clear out all author messages in URL path 471: 472: sub clear_author_res_msg { 473: my $url=shift; 474: $url=&Apache::lonnet::declutter($url); 475: my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//); 476: my @delmsgs=(); 477: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 478: if ($_=~/^\Q$url\E/) { 479: push (@delmsgs,$_); 480: } 481: } 482: return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author); 483: } 484: # ================= Return hash with URLs for which there is a resource message 485: 486: sub all_url_author_res_msg { 487: my ($author,$domain)=@_; 488: my %returnhash=(); 489: foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) { 490: $_=~/^(.+)\_\d+/; 491: $returnhash{$1}=1; 492: } 493: return %returnhash; 494: } 495: 496: # ====================================== Add a comment to the User Notes screen 497: 498: sub store_instructor_comment { 499: my ($msg,$uname,$udom) = @_; 500: my $cid = $env{'request.course.id'}; 501: my $cnum = $env{'course.'.$cid.'.num'}; 502: my $cdom = $env{'course.'.$cid.'.domain'}; 503: my $subject= &mt('Record').' ['.$uname.':'.$udom.']'; 504: my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg); 505: if ($result eq 'ok' || $result eq 'con_delayed') { 506: 507: } 508: return $result; 509: } 510: 511: # ================================================== Critical message to a user 512: 513: sub user_crit_msg_raw { 514: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, 515: $nosentstore,$recipid,$attachmenturl)=@_; 516: # Check if allowed missing 517: my ($status,$packed_message); 518: my $msgid='undefined'; 519: unless (($message)&&($user)&&($domain)) { $status='empty'; }; 520: my $text=$message; 521: my $homeserver=&Apache::lonnet::homeserver($user,$domain); 522: if ($homeserver ne 'no_host') { 523: ($msgid,$packed_message)=&packagemsg($subject,$message,undef,undef, 524: $attachmenturl,undef,undef,undef,undef,undef, 525: undef,undef,$recipid); 526: if ($sendback) { $packed_message.='<sendback>true</sendback>'; } 527: $status=&Apache::lonnet::cput('critical', {$msgid => $packed_message}, 528: $domain,$user); 529: if (defined($sentmessage)) { 530: $$sentmessage = $packed_message; 531: } 532: if (!$nosentstore) { 533: (undef,my $packed_message_no_citation) = 534: &packagemsg($subject,$message,undef,undef,$attachmenturl,$user, 535: $domain,$msgid); 536: if ($status eq 'ok' || $status eq 'con_delayed') { 537: &store_sent_mail($msgid,$packed_message_no_citation); 538: } 539: } 540: } else { 541: $status='no_host'; 542: } 543: 544: # Notifications 545: my %userenv = &Apache::loncommon::getemails($user,$domain); 546: if ($userenv{'critnotification'}) { 547: &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1, 548: $text,$msgid); 549: } 550: if ($toperm && $userenv{'permanentemail'}) { 551: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1, 552: $text,$msgid); 553: } 554: # Log this 555: &Apache::lonnet::logthis( 556: 'Sending critical email '.$msgid. 557: ', log status: '. 558: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 559: $env{'user.home'}, 560: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: ' 561: .$status)); 562: return $status; 563: } 564: 565: # New routine that respects "forward" and calls old routine 566: 567: =pod 568: 569: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback, $nosentstore,$recipid,$attachmenturl)>: 570: Sends a critical message $message to the $user at $domain. If $sendback 571: is true, a receipt will be sent to the current user when $user receives 572: the message. 573: 574: Additionally it will check if the user has a Forwarding address 575: set, and send the message to that address instead 576: 577: returns 578: - in array context a list of results for each message that was sent 579: - in scalar context a space seperated list of results for each 580: message sent 581: 582: =cut 583: 584: sub user_crit_msg { 585: my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage, 586: $nosentstore,$recipid,$attachmenturl)=@_; 587: my @status; 588: my %userenv = &Apache::lonnet::get('environment',['msgforward'], 589: $domain,$user); 590: my $msgforward=$userenv{'msgforward'}; 591: if ($msgforward) { 592: foreach my $addr (split(/\,/,$msgforward)) { 593: my ($forwuser,$forwdomain)=split(/\:/,$addr); 594: push(@status, 595: &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message, 596: $sendback,$toperm,$sentmessage,$nosentstore, 597: $recipid,$attachmenturl)); 598: } 599: } else { 600: push(@status, 601: &user_crit_msg_raw($user,$domain,$subject,$message,$sendback, 602: $toperm,$sentmessage,$nosentstore,$recipid, 603: $attachmenturl)); 604: } 605: if (wantarray) { 606: return @status; 607: } 608: return join(' ',@status); 609: } 610: 611: # =================================================== Critical message received 612: 613: sub user_crit_received { 614: my $msgid=shift; 615: my %message=&Apache::lonnet::get('critical',[$msgid]); 616: my %contents=&unpackagemsg($message{$msgid},1); 617: my $destname = $contents{'sendername'}; 618: my $destdom = $contents{'senderdomain'}; 619: if ($contents{'replytoaddr'}) { 620: my ($repname,$repdom) = split(/:/,$contents{'replytoaddr'}); 621: if (&Apache::lonnet::homeserver($repname,$repdom) ne 'no_host') { 622: $destname = $repname; 623: $destdom = $repdom; 624: } 625: } 626: my $status='rec: '.($contents{'sendback'}? 627: &user_normal_msg($destname,$destdom,&mt('Receipt').': '.$env{'user.name'}. 628: ' '.&mt('at').' '.$env{'user.domain'}.', '. 629: $contents{'subject'},&mt('User').' '.$env{'user.name'}. 630: ' '.&mt('at').' '.$env{'user.domain'}. 631: ' acknowledged receipt of message'."\n".' "'. 632: $contents{'subject'}.'"'."\n".&mt('dated').' '. 633: $contents{'time'}.".\n" 634: ):'no msg req'); 635: $status.=' trans: '. 636: &Apache::lonnet::put( 637: 'nohist_email',{$contents{'msgid'} => $message{$msgid}}); 638: $status.=' del: '. 639: &Apache::lonnet::del('critical',[$contents{'msgid'}]); 640: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 641: $env{'user.home'},'Received critical message '. 642: $contents{'msgid'}. 643: ', '.$status); 644: return $status; 645: } 646: 647: # ======================================================== Normal communication 648: 649: sub user_normal_msg_raw { 650: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, 651: $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle, 652: $error,$nosentstore,$recipid)=@_; 653: # Check if allowed missing 654: my ($status,$packed_message); 655: my $msgid='undefined'; 656: my $text=$message; 657: unless (($message)&&($user)&&($domain)) { $status='empty'; }; 658: my $homeserver=&Apache::lonnet::homeserver($user,$domain); 659: if ($homeserver ne 'no_host') { 660: ($msgid,$packed_message)= 661: &packagemsg($subject,$message,$citation,$baseurl, 662: $attachmenturl,$user,$domain,$currid, 663: undef,$crsmsgid,$symb,$error,$recipid); 664: 665: # Store in user folder 666: $status= 667: &Apache::lonnet::cput('nohist_email',{$msgid => $packed_message}, 668: $domain,$user); 669: # Save new message received time 670: &Apache::lonnet::put 671: ('email_status',{'recnewemail'=>time},$domain,$user); 672: # Into sent-mail folder if sent mail storage required 673: if (!$nosentstore) { 674: (undef,my $packed_message_no_citation) = 675: &packagemsg($subject,$message,undef,$baseurl,$attachmenturl, 676: $user,$domain,$currid,undef,$crsmsgid,$symb,$error); 677: if ($status eq 'ok' || $status eq 'con_delayed') { 678: &store_sent_mail($msgid,$packed_message_no_citation); 679: } 680: } 681: if (ref($newid) eq 'SCALAR') { 682: $$newid = $msgid; 683: } 684: if (ref($sentmessage) eq 'SCALAR') { 685: $$sentmessage = $packed_message; 686: } 687: # Notifications 688: my %userenv = &Apache::loncommon::getemails($user,$domain); 689: if ($userenv{'notification'}) { 690: &sendnotification($userenv{'notification'},$user,$domain,$subject,0, 691: $text,$msgid); 692: } 693: if ($toperm && $userenv{'permanentemail'}) { 694: if ((!$userenv{'notification'}) || ($userenv{'notification'} ne $userenv{'permanentemail'})) { 695: &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0, 696: $text,$msgid); 697: } 698: } 699: &Apache::lonnet::log($env{'user.domain'},$env{'user.name'}, 700: $env{'user.home'}, 701: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status); 702: } else { 703: $status='no_host'; 704: } 705: return $status; 706: } 707: 708: # New routine that respects "forward" and calls old routine 709: 710: =pod 711: 712: =item * B<user_normal_msg($user, $domain, $subject, $message, $citation, 713: $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, 714: $error,$nosentstore,$recipid)>: 715: Sends a message to the $user at $domain, with subject $subject and message $message. 716: 717: Additionally it will check if the user has a Forwarding address 718: set, and send the message to that address instead 719: 720: returns 721: - in array context a list of results for each message that was sent 722: - in scalar context a space seperated list of results for each 723: message sent 724: 725: =cut 726: 727: sub user_normal_msg { 728: my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl, 729: $toperm,$sentmessage,$symb,$restitle,$error,$nosentstore,$recipid)=@_; 730: my @status; 731: my %userenv = &Apache::lonnet::get('environment',['msgforward'], 732: $domain,$user); 733: my $msgforward=$userenv{'msgforward'}; 734: if ($msgforward) { 735: foreach (split(/\,/,$msgforward)) { 736: my ($forwuser,$forwdomain)=split(/\:/,$_); 737: push(@status, 738: &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message, 739: $citation,$baseurl,$attachmenturl,$toperm, 740: undef,undef,$sentmessage,undef,$symb, 741: $restitle,$error,$nosentstore,$recipid)); 742: } 743: } else { 744: push(@status,&user_normal_msg_raw($user,$domain,$subject,$message, 745: $citation,$baseurl,$attachmenturl,$toperm, 746: undef,undef,$sentmessage,undef,$symb, 747: $restitle,$error,$nosentstore,$recipid)); 748: } 749: if (wantarray) { 750: return @status; 751: } 752: return join(' ',@status); 753: } 754: 755: sub process_sent_mail { 756: my ($msgsubj,$subj_prefix,$numsent,$stamp,$msgname,$msgdom,$msgcount,$context,$pid,$savemsg,$recusers,$recudoms,$baseurl,$attachmenturl,$symb,$error,$senderuname,$senderdom,$recipid) = @_; 757: my $sentsubj; 758: if ($numsent > 1) { 759: $sentsubj = $subj_prefix.' ('.$numsent.' sent) '.$msgsubj; 760: } else { 761: if ($subj_prefix) { 762: $sentsubj = $subj_prefix.' '; 763: } 764: $sentsubj .= $msgsubj; 765: } 766: $sentsubj = &HTML::Entities::encode($sentsubj,'<>&"'); 767: my $sentmsgid = 768: &buildmsgid($stamp,$sentsubj,$msgname,$msgdom,$msgcount,$context,$pid); 769: (undef,my $sentmessage) = 770: &packagemsg($msgsubj,$savemsg,undef,$baseurl,$attachmenturl,$recusers, 771: $recudoms,$sentmsgid,undef,undef,$symb,$error,$recipid); 772: my $status = &store_sent_mail($sentmsgid,$sentmessage,$senderuname, 773: $senderdom); 774: return $status; 775: } 776: 777: sub store_sent_mail { 778: my ($msgid,$message,$senderuname,$senderdom) = @_; 779: if ($senderuname eq '') { 780: $senderuname = $env{'user.name'}; 781: } 782: if ($senderdom eq '') { 783: $senderdom = $env{'user.domain'}; 784: } 785: my $status =' '.&Apache::lonnet::cput('nohist_email_sent', 786: {$msgid => $message}, 787: $senderdom,$senderuname); 788: return $status; 789: } 790: 791: sub store_recipients { 792: my ($subject,$sendername,$senderdom,$reciphash) = @_; 793: my $context = &get_course_context(); 794: my $now = time(); 795: my $msgcount = &get_uniq(); 796: my $recipid = 797: &buildmsgid($now,$subject,$sendername,$senderdom,$msgcount,$context,$$); 798: my %recipinfo = ( 799: $recipid => $reciphash, 800: ); 801: my $status = &Apache::lonnet::put('nohist_emailrecip',\%recipinfo, 802: $senderdom,$sendername); 803: if ($status eq 'ok') { 804: return ($recipid,$status); 805: } else { 806: return (undef,$status); 807: } 808: } 809: 810: # =============================================================== Folder suffix 811: 812: sub foldersuffix { 813: my $folder=shift; 814: unless ($folder) { return ''; } 815: my $suffix; 816: my %folderhash = &get_user_folders($folder); 817: if (ref($folderhash{$folder}) eq 'HASH') { 818: $suffix = '_'.&escape($folderhash{$folder}{'id'}); 819: } else { 820: $suffix = '_'.&escape($folder); 821: } 822: return $suffix; 823: } 824: 825: # ========================================================= User-defined folders 826: 827: sub get_user_folders { 828: my ($folder) = @_; 829: my %userfolders = 830: &Apache::lonnet::dump('email_folders',undef,undef,$folder); 831: my $lock = "\0".'lock_counter'; # locks db while counter incremented 832: my $counter = "\0".'idcount'; # used in suffix for email db files 833: if (defined($userfolders{$lock})) { 834: delete($userfolders{$lock}); 835: } 836: if (defined($userfolders{$counter})) { 837: delete($userfolders{$counter}); 838: } 839: return %userfolders; 840: } 841: 842: sub secapply { 843: my $rec=shift; 844: my $defaultflag=shift; 845: $rec=~s/\s+//g; 846: $rec=~s/\@/\:/g; 847: my ($adr,$sections_or_groups)=($rec=~/^([^$]+)\(([^$]+)\)/); 848: if ($sections_or_groups) { 849: foreach my $item (split(/\;/,$sections_or_groups)) { 850: if (($item eq $env{'request.course.sec'}) || 851: ($defaultflag && ($item eq '*'))) { 852: return $adr; 853: } elsif ($env{'request.course.groups'}) { 854: my @usersgroups = split(/:/,$env{'request.course.groups'}); 855: if (grep(/^\Q$item\E$/,@usersgroups)) { 856: return $adr; 857: } 858: } 859: } 860: } else { 861: return $rec; 862: } 863: return ''; 864: } 865: 866: =pod 867: 868: =item * B<decide_receiver($feedurl,$author,$question,$course,$policy,$defaultflag)>: 869: 870: Arguments 871: $feedurl - /res/ url of resource (only need if $author is true) 872: $author,$question,$course,$policy - all true/false parameters 873: if true will attempt to find the addresses of user that should receive 874: this type of feedback (author - feedback to author of resource $feedurl, 875: $question 'Resource Content Questions', $course 'Course Content Question', 876: $policy 'Course Policy') 877: (Additionally it also checks $env for whether the corresponding form.<name> 878: element exists, for ease of use in a html response context) 879: 880: $defaultflag - (internal should be left blank) if true gather addresses 881: that aren't for a section even if I have a section 882: (used for reccursion internally, first we look for 883: addresses for our specific section then we recurse 884: and look for non section addresses) 885: 886: Returns 887: $typestyle - string of html text, describing what addresses were found 888: %to - a hash, which keys are addresses of users to send messages to 889: the keys will look like name:domain 890: 891: =cut 892: 893: sub decide_receiver { 894: my ($feedurl,$author,$question,$course,$policy,$defaultflag) = @_; 895: &Apache::lonenc::check_decrypt(\$feedurl); 896: my $typestyle=''; 897: my %to=(); 898: if ($env{'form.discuss'} eq 'author' ||$author) { 899: $typestyle.='Submitting as Author Feedback '; 900: $feedurl=~ m{^/res/($LONCAPA::domain_re)/($LONCAPA::username_re)/}; 901: $to{$2.':'.$1}=1; 902: } 903: my $cid = $env{'request.course.id'}; 904: if ($env{'form.discuss'} eq 'question' ||$question) { 905: $typestyle.=&mt('Submitting as Question').' '; 906: foreach my $item (split(/\,/,$env{'course.'.$cid.'.question.email'})) { 907: my $rec=&secapply($item,$defaultflag); 908: if ($rec) { $to{$rec}=1; } 909: } 910: } 911: if ($env{'form.discuss'} eq 'course' ||$course) { 912: $typestyle.=&mt('Submitting as Comment').' '; 913: foreach my $item (split(/\,/,$env{'course.'.$cid.'.comment.email'})) { 914: my $rec=&secapply($item,$defaultflag); 915: if ($rec) { $to{$rec}=1; } 916: } 917: } 918: if ($env{'form.discuss'} eq 'policy' ||$policy) { 919: $typestyle.=&mt('Submitting as Policy Feedback').' '; 920: foreach my $item (split(/\,/,$env{'course.'.$cid.'.policy.email'})) { 921: my $rec=&secapply($item,$defaultflag); 922: if ($rec) { $to{$rec}=1; } 923: } 924: } 925: if ((scalar(%to) eq '0') && (!$defaultflag)) { 926: ($typestyle,%to)= 927: &decide_receiver($feedurl,$author,$question,$course,$policy,1); 928: } 929: return ($typestyle,%to); 930: } 931: 932: sub user_lang { 933: my ($touname,$toudom,$fromcid) = @_; 934: my @userlangs; 935: if (($fromcid ne '') && ($env{'course.'.$fromcid.'.languages'} ne '')) { 936: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/, 937: $env{'course.'.$fromcid.'.languages'})); 938: } else { 939: my %langhash = &Apache::lonnet::get('environment',['languages'],$toudom,$touname); 940: if ($langhash{'languages'} ne '') { 941: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'}); 942: } else { 943: my %domdefs = &Apache::lonnet::get_domain_defaults($toudom); 944: if ($domdefs{'lang_def'} ne '') { 945: @userlangs = ($domdefs{'lang_def'}); 946: } 947: } 948: } 949: my @languages=&Apache::loncommon::get_genlanguages(@userlangs); 950: my $user_lh = Apache::localize->get_handle(@languages); 951: return $user_lh; 952: } 953: 954: =pod 955: 956: =back 957: 958: =cut 959: 960: 1; 961: __END__ 962: