Annotation of loncom/interface/lonmsg.pm, revision 1.196

1.1       www         1: # The LearningOnline Network with CAPA
1.26      albertel    2: # Routines for messaging
                      3: #
1.196   ! www         4: # $Id: lonmsg.pm,v 1.195 2006/12/28 19:43:24 raeburn Exp $
1.26      albertel    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/
1.1       www        27: #
1.75      www        28: 
1.1       www        29: package Apache::lonmsg;
                     30: 
                     31: use strict;
1.140     albertel   32: use Apache::lonnet;
1.47      albertel   33: use HTML::TokeParser();
1.180     albertel   34: use Apache::lonlocal;
1.53      www        35: use Mail::Send;
1.187     albertel   36: use LONCAPA qw(:DEFAULT :match);
1.180     albertel   37: 
                     38: {
                     39:     my $uniq;
                     40:     sub get_uniq {
                     41: 	$uniq++;
                     42: 	return $uniq;
                     43:     }
                     44: }
1.65      www        45: 
1.1       www        46: # ===================================================================== Package
                     47: 
1.3       www        48: sub packagemsg {
1.108     www        49:     my ($subject,$message,$citation,$baseurl,$attachmenturl,
1.191     raeburn    50: 	$recuser,$recdomain,$msgid,$type,$crsmsgid,$symb,$error)=@_;
1.96      albertel   51:     $message =&HTML::Entities::encode($message,'<>&"');
                     52:     $citation=&HTML::Entities::encode($citation,'<>&"');
                     53:     $subject =&HTML::Entities::encode($subject,'<>&"');
1.49      albertel   54:     #remove machine specification
                     55:     $baseurl =~ s|^http://[^/]+/|/|;
1.96      albertel   56:     $baseurl =&HTML::Entities::encode($baseurl,'<>&"');
1.51      www        57:     #remove machine specification
                     58:     $attachmenturl =~ s|^http://[^/]+/|/|;
1.96      albertel   59:     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
1.158     raeburn    60:     my $course_context;
                     61:     if (defined($env{'form.replyid'})) {
                     62:         my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid)=
1.184     www        63:                    split(/\:/,&unescape($env{'form.replyid'}));
1.158     raeburn    64:         $course_context = $origcid;
                     65:     }
1.160     raeburn    66:     foreach my $key (keys(%env)) {
                     67:         if ($key=~/^form\.(rep)?rec\_(.*)$/) {
                     68:             my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$origcid) =
1.184     www        69:                                     split(/\:/,&unescape($2));
1.160     raeburn    70:             $course_context = $origcid;
                     71:             last;
                     72:         }
                     73:     }
1.158     raeburn    74:     unless(defined($course_context)) {
                     75:         $course_context = $env{'request.course.id'};
                     76:     }
1.2       www        77:     my $now=time;
1.180     albertel   78:     my $msgcount = &get_uniq();
1.156     raeburn    79:     unless(defined($msgid)) {
1.159     raeburn    80:         $msgid = &buildmsgid($now,$subject,$env{'user.name'},$env{'user.domain'},
1.191     raeburn    81:                            $msgcount,$course_context,$symb,$error,$$);
1.156     raeburn    82:     }
1.174     raeburn    83:     my $result = '<sendername>'.$env{'user.name'}.'</sendername>'.
1.140     albertel   84:            '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
1.1       www        85:            '<subject>'.$subject.'</subject>'.
1.174     raeburn    86:            '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>';
                     87:     if (defined($crsmsgid)) {
                     88:         $result.= '<courseid>'.$course_context.'</courseid>'.
                     89:                   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                     90:                   '<msgid>'.$msgid.'</msgid>'.
                     91:                   '<coursemsgid>'.$crsmsgid.'</coursemsgid>'.
                     92:                   '<message>'.$message.'</message>';
                     93:         return ($msgid,$result);
                     94:     }
                     95:     $result .= '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
1.1       www        96:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
                     97: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
1.140     albertel   98: 	   '<browsertype>'.$env{'browser.type'}.'</browsertype>'.
                     99: 	   '<browseros>'.$env{'browser.os'}.'</browseros>'.
                    100: 	   '<browserversion>'.$env{'browser.version'}.'</browserversion>'.
                    101:            '<browsermathml>'.$env{'browser.mathml'}.'</browsermathml>'.
1.1       www       102: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
1.158     raeburn   103: 	   '<courseid>'.$course_context.'</courseid>'.
1.140     albertel  104: 	   '<coursesec>'.$env{'request.course.sec'}.'</coursesec>'.
                    105: 	   '<role>'.$env{'request.role'}.'</role>'.
                    106: 	   '<resource>'.$env{'request.filename'}.'</resource>'.
1.156     raeburn   107:            '<msgid>'.$msgid.'</msgid>';
                    108:     if (ref($recuser) eq 'ARRAY') {
                    109:         for (my $i=0; $i<@{$recuser}; $i++) {
1.162     raeburn   110:             if ($type eq 'dcmail') {
                    111:                 my ($username,$email) = split(/:/,$$recuser[$i]);
1.184     www       112:                 $username = &unescape($username);
                    113:                 $email = &unescape($email);
1.162     raeburn   114:                 $username = &HTML::Entities::encode($username,'<>&"');
                    115:                 $email = &HTML::Entities::encode($email,'<>&"');
                    116:                 $result .= '<recipient username="'.$username.'">'.
                    117:                                             $email.'</recipient>';
                    118:             } else {
                    119:                 $result .= '<recuser>'.$$recuser[$i].'</recuser>'.
                    120:                            '<recdomain>'.$$recdomain[$i].'</recdomain>';
                    121:             }
1.156     raeburn   122:         }
                    123:     } else {
                    124:         $result .= '<recuser>'.$recuser.'</recuser>'.
                    125:                    '<recdomain>'.$recdomain.'</recdomain>';
                    126:     }
                    127:     $result .= '<message>'.$message.'</message>';
1.49      albertel  128:     if (defined($citation)) {
                    129: 	$result.='<citation>'.$citation.'</citation>';
                    130:     }
                    131:     if (defined($baseurl)) {
                    132: 	$result.= '<baseurl>'.$baseurl.'</baseurl>';
                    133:     }
1.51      www       134:     if (defined($attachmenturl)) {
1.52      www       135: 	$result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
1.51      www       136:     }
1.191     raeburn   137:     if (defined($symb)) {
                    138:         $result.= '<symb>'.$symb.'</symb>';
                    139:         if (defined($course_context)) {
                    140:             if ($course_context eq $env{'request.course.id'}) {
                    141:                 my $resource_title = &Apache::lonnet::gettitle($symb);
                    142:                 if (defined($resource_title)) {
                    143:                     $result .= '<resource_title>'.$resource_title.'</resource_title>';
                    144:                 }
                    145:             }
                    146:         }
                    147:     }
                    148:     return ($msgid,$result);
1.1       www       149: }
                    150: 
1.2       www       151: # ================================================== Unpack message into a hash
                    152: 
1.3       www       153: sub unpackagemsg {
1.52      www       154:     my ($message,$notoken)=@_;
1.2       www       155:     my %content=();
                    156:     my $parser=HTML::TokeParser->new(\$message);
                    157:     my $token;
                    158:     while ($token=$parser->get_token) {
                    159:        if ($token->[0] eq 'S') {
                    160: 	   my $entry=$token->[1];
                    161:            my $value=$parser->get_text('/'.$entry);
1.156     raeburn   162:            if (($entry eq 'recuser') || ($entry eq 'recdomain')) {
                    163:                push(@{$content{$entry}},$value);
1.162     raeburn   164:            } elsif ($entry eq 'recipient') {
                    165:                my $username = $token->[2]{'username'};
                    166:                $username = &HTML::Entities::decode($username,'<>&"');
                    167:                $content{$entry}{$username} = $value;
1.156     raeburn   168:            } else {
                    169:                $content{$entry}=$value;
                    170:            }
1.2       www       171:        }
                    172:     }
1.168     albertel  173:     if (!exists($content{'recuser'})) { $content{'recuser'} = []; }
1.52      www       174:     if ($content{'attachmenturl'}) {
1.100     albertel  175:        my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
1.52      www       176:        if ($notoken) {
1.100     albertel  177: 	   $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';
1.52      www       178:        } else {
1.99      albertel  179: 	   &Apache::lonnet::allowuploaded('/adm/msg',
                    180: 					  $content{'attachmenturl'});
                    181: 	   $content{'message'}.='<p>'.&mt('Attachment').
                    182: 	       ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
1.100     albertel  183: 	       $fname.'</tt></a>';
1.52      www       184:        }
                    185:     }
1.2       www       186:     return %content;
                    187: }
                    188: 
1.6       www       189: # ======================================================= Get info out of msgid
                    190: 
1.159     raeburn   191: sub buildmsgid {
1.191     raeburn   192:     my ($now,$subject,$uname,$udom,$msgcount,$course_context,$symb,$error,$pid) = @_;
1.184     www       193:     $subject=&escape($subject);
1.192     raeburn   194:     $symb = &escape($symb);
1.184     www       195:     return(&escape($now.':'.$subject.':'.$uname.':'.
1.191     raeburn   196:            $udom.':'.$msgcount.':'.$course_context.':'.$pid.':'.$symb.':'.$error));
1.159     raeburn   197: }
                    198: 
1.6       www       199: sub unpackmsgid {
1.169     albertel  200:     my ($msgid,$folder,$skipstatus,$status_cache)=@_;
1.184     www       201:     $msgid=&unescape($msgid);
1.167     raeburn   202:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$count,$fromcid,
1.191     raeburn   203:         $processid,$symb,$error) = split(/\:/,&unescape($msgid));
1.184     www       204:     $shortsubj = &unescape($shortsubj);
1.182     albertel  205:     $shortsubj = &HTML::Entities::decode($shortsubj);
1.192     raeburn   206:     $symb = &unescape($symb);
1.167     raeburn   207:     if (!defined($processid)) { $fromcid = ''; }
1.164     raeburn   208:     my %status=();
                    209:     unless ($skipstatus) {
1.169     albertel  210: 	if (ref($status_cache)) {
                    211: 	    $status{$msgid} = $status_cache->{$msgid};
                    212: 	} else {
                    213: 	    my $suffix=&foldersuffix($folder);
                    214: 	    %status=&Apache::lonnet::get('email_status'.$suffix,[$msgid]);
                    215: 	}
                    216: 	if ($status{$msgid}=~/^error\:/) { $status{$msgid}=''; }
1.164     raeburn   217:         unless ($status{$msgid}) { $status{$msgid}='new'; }
                    218:     }
1.191     raeburn   219:     return ($sendtime,$shortsubj,$fromname,$fromdomain,$status{$msgid},$fromcid,$symb,$error);
1.141     raeburn   220: }
1.6       www       221: 
1.53      www       222: 
                    223: sub sendemail {
                    224:     my ($to,$subject,$body)=@_;
1.186     www       225:     my %senderemails=&Apache::loncommon::getemails();
                    226:     my $senderaddress='';
                    227:     foreach my $type ('notification','permanentemail','critnotification') {
                    228: 	if ($senderemails{$type}) {
                    229: 	    $senderaddress=$senderemails{$type};
                    230: 	}
                    231:     }
1.53      www       232:     $body=
1.67      www       233:     "*** ".&mt('This is an automatic message generated by the LON-CAPA system.')."\n".
1.186     www       234:     "*** ".($senderaddress?&mt('You can reply to this message'):&mt('Please do not reply to this address.')."\n*** ".
                    235: 	    &mt('A reply will not be received by the recipient!'))."\n\n".$body;
1.53      www       236:     my $msg = new Mail::Send;
                    237:     $msg->to($to);
                    238:     $msg->subject('[LON-CAPA] '.$subject);
1.188     www       239:     if ($senderaddress) { $msg->add('Reply-to',$senderaddress); $msg->add('From',$senderaddress); }
1.97      matthew   240:     if (my $fh = $msg->open()) {
1.172     albertel  241: 	print $fh $body;
                    242: 	$fh->close;
1.68      www       243:     }
1.53      www       244: }
                    245: 
                    246: # ==================================================== Send notification emails
                    247: 
                    248: sub sendnotification {
1.194     raeburn   249:     my ($to,$touname,$toudom,$subj,$crit,$text,$msgid)=@_;
1.140     albertel  250:     my $sender=$env{'environment.firstname'}.' '.$env{'environment.lastname'};
1.131     www       251:     unless ($sender=~/\w/) { 
1.172     albertel  252: 	$sender=$env{'user.name'}.'@'.$env{'user.domain'};
1.131     www       253:     }
1.53      www       254:     my $critical=($crit?' critical':'');
1.131     www       255:     $text=~s/\&lt\;/\</gs;
                    256:     $text=~s/\&gt\;/\>/gs;
                    257:     $text=~s/\<\/*[^\>]+\>//gs;
1.53      www       258:     my $url='http://'.
                    259:       $Apache::lonnet::hostname{&Apache::lonnet::homeserver($touname,$toudom)}.
1.54      www       260:       '/adm/email?username='.$touname.'&domain='.$toudom;
1.194     raeburn   261:     my ($sendtime,$shortsubj,$fromname,$fromdomain,$status,$fromcid,
                    262:         $symb,$error) = &Apache::lonmsg::unpackmsgid($msgid);
                    263:     my $coursetext;
                    264:     if ($fromcid ne '') {
                    265:         $coursetext = "\n".&mt('Course').': ';
                    266:         if ($env{'course.'.$fromcid.'.description'} ne '') {
                    267:             $coursetext .= $env{'course.'.$fromcid.'.description'};
                    268:         } else {
                    269:             my %coursehash = &Apache::lonnet::coursedescription($fromcid,);
                    270:             if ($coursehash{'description'} ne '') {
                    271:                 $coursetext .= $coursehash{'description'};
                    272:             }
                    273:         }
                    274:         $coursetext .= "\n\n";
                    275:     }
                    276:     my $body = $coursetext. 
1.195     raeburn   277:                &mt('You received a'.$critical.' message from [_1] in LON-CAPA.',$sender).' '.&mt('The subject is 
1.53      www       278: 
1.195     raeburn   279:  [_1]
1.53      www       280: 
1.195     raeburn   281: ',$subj)."\n".
1.194     raeburn   282: '=== '.&mt('Excerpt')." ============================================================
1.131     www       283: $text
                    284: ========================================================================
                    285: 
1.195     raeburn   286: ".&mt('Use 
1.53      www       287: 
1.195     raeburn   288:  [_1]
1.53      www       289: 
1.195     raeburn   290: to access the full message.',$url);
1.53      www       291:     &sendemail($to,'New'.$critical.' message from '.$sender,$body);
                    292: }
1.40      www       293: # ============================================================= Check for email
                    294: 
                    295: sub newmail {
1.140     albertel  296:     if ((time-$env{'user.mailcheck.time'})>300) {
1.40      www       297:         my %what=&Apache::lonnet::get('email_status',['recnewemail']);
                    298:         &Apache::lonnet::appenv('user.mailcheck.time'=>time);
                    299:         if ($what{'recnewemail'}>0) { return 1; }
                    300:     }
                    301:     return 0;
                    302: }
                    303: 
1.1       www       304: # =============================== Automated message to the author of a resource
                    305: 
1.58      bowersj2  306: =pod
                    307: 
                    308: =item * B<author_res_msg($filename, $message)>: Sends message $message to the owner
                    309:     of the resource with the URI $filename.
                    310: 
                    311: =cut
                    312: 
1.1       www       313: sub author_res_msg {
                    314:     my ($filename,$message)=@_;
1.2       www       315:     unless ($message) { return 'empty'; }
1.1       www       316:     $filename=&Apache::lonnet::declutter($filename);
1.72      www       317:     my ($domain,$author,@dummy)=split(/\//,$filename);
1.1       www       318:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
                    319:     if ($homeserver ne 'no_host') {
                    320:        my $id=unpack("%32C*",$message);
1.181     albertel  321:        $message .= " <p>This error occurred on machine ".
                    322: 	   $Apache::lonnet::perlvar{'lonHostID'}."</p>";
1.2       www       323:        my $msgid;
1.72      www       324:        ($msgid,$message)=&packagemsg($filename,$message);
1.3       www       325:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
1.72      www       326:          ':nohist_res_msgs:'.
1.184     www       327:           &escape($filename.'_'.$id).'='.
                    328:           &escape($message),$homeserver);
1.1       www       329:     }
1.2       www       330:     return 'no_host';
1.73      www       331: }
                    332: 
                    333: # =========================================== Retrieve author resource messages
                    334: 
                    335: sub retrieve_author_res_msg {
1.75      www       336:     my $url=shift;
1.73      www       337:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  338:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.76      www       339:     my %errormsgs=&Apache::lonnet::dump('nohist_res_msgs',$domain,$author);
1.73      www       340:     my $msgs='';
                    341:     foreach (keys %errormsgs) {
1.80      www       342: 	if ($_=~/^\Q$url\E\_\d+$/) {
1.73      www       343: 	    my %content=&unpackagemsg($errormsgs{$_});
1.74      www       344: 	    $msgs.='<p><img src="/adm/lonMisc/bomb.gif" /><b>'.
                    345: 		$content{'time'}.'</b>: '.$content{'message'}.
                    346: 		'<br /></p>';
1.73      www       347: 	}
                    348:     } 
                    349:     return $msgs;     
                    350: }
                    351: 
                    352: 
                    353: # =============================== Delete all author messages related to one URL
                    354: 
                    355: sub del_url_author_res_msg {
1.75      www       356:     my $url=shift;
1.73      www       357:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  358:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.77      www       359:     my @delmsgs=();
                    360:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
                    361: 	if ($_=~/^\Q$url\E\_\d+$/) {
                    362: 	    push (@delmsgs,$_);
                    363: 	}
                    364:     }
                    365:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
1.73      www       366: }
1.152     www       367: # =================================== Clear out all author messages in URL path
1.73      www       368: 
1.152     www       369: sub clear_author_res_msg {
                    370:     my $url=shift;
                    371:     $url=&Apache::lonnet::declutter($url);
1.187     albertel  372:     my ($domain,$author)=($url=~/^($match_domain)\/($match_username)\//);
1.152     www       373:     my @delmsgs=();
                    374:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
                    375: 	if ($_=~/^\Q$url\E/) {
                    376: 	    push (@delmsgs,$_);
                    377: 	}
                    378:     }
                    379:     return &Apache::lonnet::del('nohist_res_msgs',\@delmsgs,$domain,$author);
                    380: }
1.73      www       381: # ================= Return hash with URLs for which there is a resource message
                    382: 
                    383: sub all_url_author_res_msg {
                    384:     my ($author,$domain)=@_;
1.75      www       385:     my %returnhash=();
1.76      www       386:     foreach (&Apache::lonnet::getkeys('nohist_res_msgs',$domain,$author)) {
1.75      www       387: 	$_=~/^(.+)\_\d+/;
                    388: 	$returnhash{$1}=1;
                    389:     }
                    390:     return %returnhash;
1.1       www       391: }
                    392: 
1.185     albertel  393: # ====================================== Add a comment to the User Notes screen
                    394: 
                    395: sub store_instructor_comment {
                    396:     my ($msg,$uname,$udom) = @_;
                    397:     my $cid  = $env{'request.course.id'};
                    398:     my $cnum = $env{'course.'.$cid.'.num'};
                    399:     my $cdom = $env{'course.'.$cid.'.domain'};
                    400:     my $subject= &mt('Record').' ['.$uname.':'.$udom.']';
                    401:     my $result = &user_normal_msg_raw($cnum,$cdom,$subject,$msg);
                    402:     return $result;
                    403: }
                    404: 
1.1       www       405: # ================================================== Critical message to a user
                    406: 
1.38      www       407: sub user_crit_msg_raw {
1.159     raeburn   408:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
1.2       www       409: # Check if allowed missing
1.190     raeburn   410:     my ($status,$packed_message);
1.2       www       411:     my $msgid='undefined';
                    412:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
1.131     www       413:     my $text=$message;
1.2       www       414:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    415:     if ($homeserver ne 'no_host') {
1.190     raeburn   416:        ($msgid,$packed_message)=&packagemsg($subject,$message);
                    417:        if ($sendback) { $packed_message.='<sendback>true</sendback>'; }
1.4       www       418:        $status=&Apache::lonnet::critical(
                    419:            'put:'.$domain.':'.$user.':critical:'.
1.184     www       420:            &escape($msgid).'='.
1.190     raeburn   421:            &escape($packed_message),$homeserver);
1.159     raeburn   422:         if (defined($sentmessage)) {
1.190     raeburn   423:             $$sentmessage = $packed_message;
1.159     raeburn   424:         }
1.193     raeburn   425:         if ($env{'request.course.id'} eq '') {
                    426:             (undef,my $packed_message_no_citation) =
1.190     raeburn   427:             &packagemsg($subject,$message,undef,undef,undef,$user,$domain,
                    428:                         $msgid);
1.193     raeburn   429:             if ($status eq 'ok' || $status eq 'con_delayed') {
                    430:                 &store_sent_mail($msgid,$packed_message_no_citation);
                    431:             }
                    432:         }
1.2       www       433:     } else {
                    434:        $status='no_host';
                    435:     }
1.190     raeburn   436: 
1.53      www       437: # Notifications
1.186     www       438:     my %userenv = &Apache::loncommon::getemails($user,$domain);
1.53      www       439:     if ($userenv{'critnotification'}) {
1.131     www       440:       &sendnotification($userenv{'critnotification'},$user,$domain,$subject,1,
1.194     raeburn   441: 			$text,$msgid);
1.53      www       442:     }
1.132     www       443:     if ($toperm && $userenv{'permanentemail'}) {
                    444:       &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,1,
1.194     raeburn   445: 			$text,$msgid);
1.132     www       446:     }
1.53      www       447: # Log this
1.2       www       448:     &Apache::lonnet::logthis(
1.4       www       449:       'Sending critical email '.$msgid.
1.2       www       450:       ', log status: '.
1.140     albertel  451:       &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                    452:                          $env{'user.home'},
1.2       www       453:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
1.4       www       454:       .$status));
1.2       www       455:     return $status;
                    456: }
                    457: 
1.38      www       458: # New routine that respects "forward" and calls old routine
                    459: 
1.58      bowersj2  460: =pod
                    461: 
                    462: =item * B<user_crit_msg($user, $domain, $subject, $message, $sendback)>: Sends
                    463:     a critical message $message to the $user at $domain. If $sendback is true,
                    464:     a reciept will be sent to the current user when $user recieves the message.
                    465: 
1.183     albertel  466:     Additionally it will check if the user has a Forwarding address
                    467:     set, and send the message to that address instead
                    468: 
                    469:     returns 
                    470:       - in array context a list of results for each message that was sent
                    471:       - in scalar context a space seperated list of results for each 
                    472:            message sent
                    473: 
1.58      bowersj2  474: =cut
                    475: 
1.38      www       476: sub user_crit_msg {
1.159     raeburn   477:     my ($user,$domain,$subject,$message,$sendback,$toperm,$sentmessage)=@_;
1.183     albertel  478:     my @status;
1.38      www       479:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                    480:                                        $domain,$user);
                    481:     my $msgforward=$userenv{'msgforward'};
                    482:     if ($msgforward) {
1.183     albertel  483:        foreach my $addr (split(/\,/,$msgforward)) {
                    484: 	 my ($forwuser,$forwdomain)=split(/\:/,$addr);
                    485:          push(@status,
                    486: 	      &user_crit_msg_raw($forwuser,$forwdomain,$subject,$message,
                    487: 				 $sendback,$toperm,$sentmessage));
1.38      www       488:        }
                    489:     } else { 
1.183     albertel  490: 	push(@status,
                    491: 	     &user_crit_msg_raw($user,$domain,$subject,$message,$sendback,
                    492: 				$toperm,$sentmessage));
1.38      www       493:     }
1.183     albertel  494:     if (wantarray) {
                    495: 	return @status;
                    496:     }
                    497:     return join(' ',@status);
1.38      www       498: }
                    499: 
1.2       www       500: # =================================================== Critical message received
                    501: 
                    502: sub user_crit_received {
1.12      www       503:     my $msgid=shift;
                    504:     my %message=&Apache::lonnet::get('critical',[$msgid]);
1.52      www       505:     my %contents=&unpackagemsg($message{$msgid},1);
1.24      www       506:     my $status='rec: '.($contents{'sendback'}?
1.5       www       507:      &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
1.140     albertel  508:                      &mt('Receipt').': '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.', '.$contents{'subject'},
                    509:                      &mt('User').' '.$env{'user.name'}.' '.&mt('at').' '.$env{'user.domain'}.
1.42      www       510:                      ' acknowledged receipt of message'."\n".'   "'.
1.67      www       511:                      $contents{'subject'}.'"'."\n".&mt('dated').' '.
1.42      www       512:                      $contents{'time'}.".\n"
                    513:                      ):'no msg req');
1.5       www       514:     $status.=' trans: '.
1.12      www       515:      &Apache::lonnet::put(
                    516:      'nohist_email',{$contents{'msgid'} => $message{$msgid}});
1.5       www       517:     $status.=' del: '.
1.9       albertel  518:      &Apache::lonnet::del('critical',[$contents{'msgid'}]);
1.140     albertel  519:     &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
                    520:                          $env{'user.home'},'Received critical message '.
1.5       www       521:                          $contents{'msgid'}.
                    522:                          ', '.$status);
1.12      www       523:     return $status;
1.2       www       524: }
                    525: 
                    526: # ======================================================== Normal communication
                    527: 
1.38      www       528: sub user_normal_msg_raw {
1.132     www       529:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
1.191     raeburn   530:         $toperm,$currid,$newid,$sentmessage,$crsmsgid,$symb,$restitle,
                    531:         $error)=@_;
1.2       www       532: # Check if allowed missing
1.173     albertel  533:     my ($status,$packed_message);
1.2       www       534:     my $msgid='undefined';
1.131     www       535:     my $text=$message;
1.2       www       536:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
                    537:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    538:     if ($homeserver ne 'no_host') {
1.173     albertel  539:        ($msgid,$packed_message)=
                    540: 	                 &packagemsg($subject,$message,$citation,$baseurl,
1.174     raeburn   541:                                      $attachmenturl,$user,$domain,$currid,
1.191     raeburn   542:                                      undef,$crsmsgid,$symb,$error);
1.174     raeburn   543: 
1.108     www       544: # Store in user folder
1.4       www       545:        $status=&Apache::lonnet::critical(
                    546:            'put:'.$domain.':'.$user.':nohist_email:'.
1.184     www       547:            &escape($msgid).'='.
                    548:            &escape($packed_message),$homeserver);
1.108     www       549: # Save new message received time
1.40      www       550:        &Apache::lonnet::put
                    551:                          ('email_status',{'recnewemail'=>time},$domain,$user);
1.159     raeburn   552: # Into sent-mail folder unless a broadcast message or critical message
                    553:        unless (($env{'request.course.id'}) && 
                    554:                (($env{'form.sendmode'} eq 'group')  || 
                    555:                (($env{'form.critmsg'}) || ($env{'form.sendbck'})) &&
1.196   ! www       556: 		(&Apache::lonnet::allowed('srm',$env{'request.course.id'})
        !           557: 		 || &Apache::lonnet::allowed('srm',$env{'request.course.id'}.
        !           558: 					     '/'.$env{'request.course.sec'})))) {
1.190     raeburn   559:            (undef,my $packed_message_no_citation) =
                    560:                &packagemsg($subject,$message,undef,$baseurl,$attachmenturl,
1.191     raeburn   561:                            $user,$domain,$currid,undef,$crsmsgid,$symb,$error);
1.193     raeburn   562:            if ($status eq 'ok' || $status eq 'con_delayed') {
                    563:                &store_sent_mail($msgid,$packed_message_no_citation);
                    564:            }
1.156     raeburn   565:        }
1.196   ! www       566:        if (defined($newid)) {
        !           567: 	   $$newid = $msgid;
        !           568:        }
        !           569:        if (defined($sentmessage)) {
        !           570: 	   $$sentmessage = $packed_message;
        !           571:        }
        !           572: # Notifications
        !           573:        my %userenv = &Apache::lonnet::get('environment',['notification',
        !           574: 							 'permanentemail'],
        !           575: 					  $domain,$user);
        !           576:        if ($userenv{'notification'}) {
        !           577: 	   &sendnotification($userenv{'notification'},$user,$domain,$subject,0,
        !           578: 			     $text,$msgid);
        !           579:        }
        !           580:        if ($toperm && $userenv{'permanentemail'}) {
        !           581: 	   &sendnotification($userenv{'permanentemail'},$user,$domain,$subject,0,
        !           582: 			     $text,$msgid);
        !           583:        }
        !           584:        &Apache::lonnet::log($env{'user.domain'},$env{'user.name'},
        !           585: 			    $env{'user.home'},
        !           586: 			    'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
        !           587:    } else {
1.2       www       588:        $status='no_host';
1.196   ! www       589:    }
1.2       www       590:     return $status;
                    591: }
1.38      www       592: 
                    593: # New routine that respects "forward" and calls old routine
                    594: 
1.58      bowersj2  595: =pod
                    596: 
1.191     raeburn   597: =item * B<user_normal_msg($user, $domain, $subject, $message, $citation,
                    598:        $baseurl, $attachmenturl, $toperm, $sentmessage, $symb, $restitle, $error)>:
                    599:  Sends a message to the  $user at $domain, with subject $subject and message $message.
1.58      bowersj2  600: 
                    601: =cut
                    602: 
1.38      www       603: sub user_normal_msg {
1.132     www       604:     my ($user,$domain,$subject,$message,$citation,$baseurl,$attachmenturl,
1.191     raeburn   605: 	$toperm,$sentmessage,$symb,$restitle,$error)=@_;
1.38      www       606:     my $status='';
                    607:     my %userenv = &Apache::lonnet::get('environment',['msgforward'],
                    608:                                        $domain,$user);
                    609:     my $msgforward=$userenv{'msgforward'};
                    610:     if ($msgforward) {
1.171     banghart  611:         foreach (split(/\,/,$msgforward)) {
1.172     albertel  612: 	    my ($forwuser,$forwdomain)=split(/\:/,$_);
                    613: 	    $status.=
1.171     banghart  614: 	        &user_normal_msg_raw($forwuser,$forwdomain,$subject,$message,
1.172     albertel  615: 				     $citation,$baseurl,$attachmenturl,$toperm,
1.191     raeburn   616: 				     undef,undef,$sentmessage,undef,$symb,$restitle,$error).' ';
1.171     banghart  617:         }
1.191     raeburn   618:     } else {
1.172     albertel  619: 	$status=&user_normal_msg_raw($user,$domain,$subject,$message,
                    620: 				     $citation,$baseurl,$attachmenturl,$toperm,
1.191     raeburn   621: 				     undef,undef,$sentmessage,undef,$symb,$restitle,$error);
1.38      www       622:     }
                    623:     return $status;
                    624: }
                    625: 
1.156     raeburn   626: sub store_sent_mail {
                    627:     my ($msgid,$message) = @_;
1.171     banghart  628:     my $status =' '.&Apache::lonnet::critical(
                    629:                'put:'.$env{'user.domain'}.':'.$env{'user.name'}.
                    630:                                           ':nohist_email_sent:'.
1.184     www       631:                &escape($msgid).'='.
                    632:                &escape($message),$env{'user.home'});
1.156     raeburn   633:     return $status;
                    634: }
1.2       www       635: 
1.106     www       636: # =============================================================== Folder suffix
                    637: 
                    638: sub foldersuffix {
                    639:     my $folder=shift;
                    640:     unless ($folder) { return ''; }
1.189     raeburn   641:     my $suffix;
                    642:     my %folderhash = &get_user_folders($folder);
                    643:     if (ref($folderhash{$folder}) eq 'HASH') {
                    644:         $suffix = '_'.&escape($folderhash{$folder}{'id'});
                    645:     } else {
                    646:         $suffix = '_'.&escape($folder);
                    647:     }
                    648:     return $suffix;
                    649: }
                    650: 
                    651: # ========================================================= User-defined folders 
                    652: 
                    653: sub get_user_folders {
                    654:     my ($folder) = @_;
                    655:     my %userfolders = 
                    656:           &Apache::lonnet::dump('email_folders',undef,undef,$folder);
                    657:     my $lock = "\0".'lock_counter'; # locks db while counter incremented
                    658:     my $counter = "\0".'idcount';   # used in suffix for email db files
                    659:     if (defined($userfolders{$lock})) {
                    660:         delete($userfolders{$lock});
                    661:     }
                    662:     if (defined($userfolders{$counter})) {
                    663:         delete($userfolders{$counter});
                    664:     }
                    665:     return %userfolders;
1.106     www       666: }
                    667: 
1.180     albertel  668: 1;
1.1       www       669: __END__
                    670: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>