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

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

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