Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

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

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.2       www       103:        $status=&Apache::lonnet::cput('critical',$msgid => $message);
                    104:     } else {
                    105:        $status='no_host';
                    106:     }
                    107:     &Apache::lonnet::logthis(
                    108:       '<font color=yellow>INFO: Sending critical email '.$msgid.
                    109:       ', log status: '.
                    110:       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                    111:                          $ENV{'user.home'},
                    112:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
                    113:       .$status).'</font>');
                    114:     return $status;
                    115: }
                    116: 
                    117: # =================================================== Critical message received
                    118: 
                    119: sub user_crit_received {
                    120:     my $message=shift;
                    121: 
                    122: }
                    123: 
                    124: # ======================================================== Normal communication
                    125: 
                    126: sub user_normal_msg {
                    127:     my ($user,$domain,$subject,$message)=@_;
                    128: # Check if allowed missing
                    129:     my $status='';
                    130:     my $msgid='undefined';
                    131:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
                    132:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
                    133:     if ($homeserver ne 'no_host') {
                    134:        my $msgid;
1.3     ! www       135:        ($msgid,$message)=&packagemsg($subject,$message);
1.2       www       136:        $status=&Apache::lonnet::cput('nohist_email',$msgid => $message);
                    137:     } else {
                    138:        $status='no_host';
                    139:     }
                    140:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                    141:                          $ENV{'user.home'},
                    142:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
                    143:     return $status;
                    144: }
                    145: 
                    146: # ================================================= Main program, reset counter
                    147: 
                    148: sub BEGIN {
                    149:     $msgcount=0;
1.1       www       150: }
                    151: 
                    152: 1;
                    153: __END__
                    154: 
                    155: 
                    156: 
                    157: 
                    158: 
                    159: 
                    160: