Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

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

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: 
                     24: sub package {
                     25:     var ($subject,$message)=@_;
                     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++;
        !            32:     $msgid=$now.'_'.$ENV{'user.name'}.'_'.
        !            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: 
        !            56: sub unpackage {
        !            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;
        !            82:        ($msgid,$message)=package($filename,$message);
        !            83:        return &Apache::lonnet::put(
        !            84:                               'nohist_res_msgs',$filename.'_'.$id => $message);
1.1       www        85:     }
1.2     ! www        86:     return 'no_host';
1.1       www        87: }
                     88: 
                     89: # ================================================== Critical message to a user
                     90: 
                     91: sub user_crit_msg {
                     92:     my ($user,$domain,$subject,$message)=@_;
1.2     ! www        93: # Check if allowed missing
        !            94:     my $status='';
        !            95:     my $msgid='undefined';
        !            96:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
        !            97:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
        !            98:     if ($homeserver ne 'no_host') {
        !            99:        my $msgid;
        !           100:        ($msgid,$message)=package($filename,$message);
        !           101:        $status=&Apache::lonnet::cput('critical',$msgid => $message);
        !           102:     } else {
        !           103:        $status='no_host';
        !           104:     }
        !           105:     &Apache::lonnet::logthis(
        !           106:       '<font color=yellow>INFO: Sending critical email '.$msgid.
        !           107:       ', log status: '.
        !           108:       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
        !           109:                          $ENV{'user.home'},
        !           110:       'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
        !           111:       .$status).'</font>');
        !           112:     return $status;
        !           113: }
        !           114: 
        !           115: # =================================================== Critical message received
        !           116: 
        !           117: sub user_crit_received {
        !           118:     my $message=shift;
        !           119: 
        !           120: }
        !           121: 
        !           122: # ======================================================== Normal communication
        !           123: 
        !           124: sub user_normal_msg {
        !           125:     my ($user,$domain,$subject,$message)=@_;
        !           126: # Check if allowed missing
        !           127:     my $status='';
        !           128:     my $msgid='undefined';
        !           129:     unless (($message)&&($user)&&($domain)) { $status='empty'; };
        !           130:     my $homeserver=&Apache::lonnet::homeserver($user,$domain);
        !           131:     if ($homeserver ne 'no_host') {
        !           132:        my $msgid;
        !           133:        ($msgid,$message)=package($filename,$message);
        !           134:        $status=&Apache::lonnet::cput('nohist_email',$msgid => $message);
        !           135:     } else {
        !           136:        $status='no_host';
        !           137:     }
        !           138:     &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
        !           139:                          $ENV{'user.home'},
        !           140:       'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
        !           141:     return $status;
        !           142: }
        !           143: 
        !           144: # ================================================= Main program, reset counter
        !           145: 
        !           146: sub BEGIN {
        !           147:     $msgcount=0;
1.1       www       148: }
                    149: 
                    150: 1;
                    151: __END__
                    152: 
                    153: 
                    154: 
                    155: 
                    156: 
                    157: 
                    158: