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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: #
                      3: # Routines for messaging
                      4: #
                      5: # (Routines to control the menu
                      6: #
                      7: # (TeX Conversion Module
                      8: #
                      9: # 05/29/00,05/30 Gerd Kortemeyer)
                     10: #
                     11: # 10/05 Gerd Kortemeyer)
                     12: #
1.2       www        13: # 10/19,10/20 Gerd Kortemeyer
1.1       www        14: 
                     15: package Apache::lonmsg;
                     16: 
                     17: use strict;
                     18: use Apache::lonnet();
1.2       www        19: use vars qw($msgcount);
                     20: use HTML::TokeParser;
1.1       www        21: 
                     22: # ===================================================================== Package
                     23: 
1.3       www        24: sub packagemsg {
                     25:     my ($subject,$message)=@_;
1.1       www        26:     $message=~s/\</\&lt\;/g;
                     27:     $message=~s/\>/\&gt\;/g;
                     28:     $subject=~s/\</\&lt\;/g;
                     29:     $subject=~s/\>/\&gt\;/g;
1.2       www        30:     my $now=time;
                     31:     $msgcount++;
1.3       www        32:     my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
1.2       www        33:            $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
                     34:     return $msgid,
                     35:            '<sendername>'.$ENV{'user.name'}.'</sendername>'.
1.1       www        36:            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
                     37:            '<subject>'.$subject.'</subject>'.
1.2       www        38: 	   '<time>'.localtime($now).'</time>'.
1.1       www        39: 	   '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
                     40:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
                     41: 	   '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
                     42: 	   '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
                     43: 	   '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
                     44: 	   '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
                     45:            '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
                     46: 	   '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
                     47: 	   '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
                     48: 	   '<role>'.$ENV{'request.role'}.'</role>'.
                     49: 	   '<resource>'.$ENV{'request.filename'}.'</resource>'.
1.2       www        50:            '<msgid>'.$msgid.'</msgid>'.
1.1       www        51: 	   '<message>'.$message.'</message>';
                     52: }
                     53: 
1.2       www        54: # ================================================== Unpack message into a hash
                     55: 
1.3       www        56: sub unpackagemsg {
1.2       www        57:     my $message=shift;
                     58:     my %content=();
                     59:     my $parser=HTML::TokeParser->new(\$message);
                     60:     my $token;
                     61:     while ($token=$parser->get_token) {
                     62:        if ($token->[0] eq 'S') {
                     63: 	   my $entry=$token->[1];
                     64:            my $value=$parser->get_text('/'.$entry);
                     65:            $content{$entry}=$value;
                     66:        }
                     67:     }
                     68:     return %content;
                     69: }
                     70: 
1.1       www        71: # =============================== Automated message to the author of a resource
                     72: 
                     73: sub author_res_msg {
                     74:     my ($filename,$message)=@_;
1.2       www        75:     unless ($message) { return 'empty'; }
1.1       www        76:     $filename=&Apache::lonnet::declutter($filename);
                     77:     my ($domain,$author,@dummy)=split(/\//,$filename);
                     78:     my $homeserver=&Apache::lonnet::homeserver($author,$domain);
                     79:     if ($homeserver ne 'no_host') {
                     80:        my $id=unpack("%32C*",$message);
1.2       www        81:        my $msgid;
1.3       www        82:        ($msgid,$message)=&packagemsg($filename,$message);
                     83:        return &Apache::lonnet::reply('put:'.$domain.':'.$author.
                     84:          ':nohist_res_msgs:'.
                     85:           &Apache::lonnet::escape($filename.'_'.$id).'='.
                     86:           &Apache::lonnet::escape($message),$homeserver);
1.1       www        87:     }
1.2       www        88:     return 'no_host';
1.1       www        89: }
                     90: 
                     91: # ================================================== Critical message to a user
                     92: 
                     93: sub user_crit_msg {
                     94:     my ($user,$domain,$subject,$message)=@_;
1.2       www        95: # Check if allowed missing
                     96:     my $status='';
                     97:     my $msgid='undefined';
                     98:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
                     99:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    100:     if ($homeserver ne 'no_host') {
                    101:        my $msgid;
1.3       www       102:        ($msgid,$message)=&packagemsg($subject,$message);
1.4     ! www       103:        $status=&Apache::lonnet::critical(
        !           104:            'put:'.$domain.':'.$user.':critical:'.
        !           105:            &Apache::lonnet::escape($msgid).'='.
        !           106:            &Apache::lonnet::escape($message),$homeserver);
1.2       www       107:     } else {
                    108:        $status='no_host';
                    109:     }
                    110:     &Apache::lonnet::logthis(
1.4     ! www       111:       'Sending critical email '.$msgid.
1.2       www       112:       ', log status: '.
                    113:       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                    114:                          $ENV{'user.home'},
                    115:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
1.4     ! www       116:       .$status));
1.2       www       117:     return $status;
                    118: }
                    119: 
                    120: # =================================================== Critical message received
                    121: 
                    122: sub user_crit_received {
                    123:     my $message=shift;
1.4     ! www       124:     my %contents=&unpackagemsg($message);
        !           125:     &Apache::lonnet::log('Received critical message '.$contents{'msgid'});
        !           126:     &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
        !           127:                      'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
        !           128:                      'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
        !           129:                      ' acknowledged receipt of message "'.
        !           130:                      $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
        !           131:                      .'Message ID: '.$contents{'msgid'});
        !           132:     &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
        !           133:     &Apache::lonnet::del('critical',$contents{'msgid'});
1.2       www       134: }
                    135: 
                    136: # ======================================================== Normal communication
                    137: 
                    138: sub user_normal_msg {
                    139:     my ($user,$domain,$subject,$message)=@_;
                    140: # Check if allowed missing
                    141:     my $status='';
                    142:     my $msgid='undefined';
                    143:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
                    144:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    145:     if ($homeserver ne 'no_host') {
                    146:        my $msgid;
1.3       www       147:        ($msgid,$message)=&packagemsg($subject,$message);
1.4     ! www       148:        $status=&Apache::lonnet::critical(
        !           149:            'put:'.$domain.':'.$user.':nohist_email:'.
        !           150:            &Apache::lonnet::escape($msgid).'='.
        !           151:            &Apache::lonnet::escape($message),$homeserver);
1.2       www       152:     } else {
                    153:        $status='no_host';
                    154:     }
                    155:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                    156:                          $ENV{'user.home'},
                    157:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
                    158:     return $status;
                    159: }
                    160: 
                    161: # ================================================= Main program, reset counter
                    162: 
                    163: sub BEGIN {
                    164:     $msgcount=0;
1.1       www       165: }
                    166: 
                    167: 1;
                    168: __END__
                    169: 
                    170: 
                    171: 
                    172: 
                    173: 
                    174: 
                    175: 

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