Return to lonmsg.pm CVS log

Up to [LON-CAPA] / loncom / interface

Bug fixes

    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: #
   13: # 10/19,10/20 Gerd Kortemeyer
   14: 
   15: package Apache::lonmsg;
   16: 
   17: use strict;
   18: use Apache::lonnet();
   19: use vars qw($msgcount);
   20: use HTML::TokeParser;
   21: 
   22: # ===================================================================== Package
   23: 
   24: sub packagemsg {
   25:     my ($subject,$message)=@_;
   26:     $message=~s/\</\&lt\;/g;
   27:     $message=~s/\>/\&gt\;/g;
   28:     $subject=~s/\</\&lt\;/g;
   29:     $subject=~s/\>/\&gt\;/g;
   30:     my $now=time;
   31:     $msgcount++;
   32:     my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
   33:            $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
   34:     return $msgid,
   35:            '<sendername>'.$ENV{'user.name'}.'</sendername>'.
   36:            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
   37:            '<subject>'.$subject.'</subject>'.
   38: 	   '<time>'.localtime($now).'</time>'.
   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>'.
   50:            '<msgid>'.$msgid.'</msgid>'.
   51: 	   '<message>'.$message.'</message>';
   52: }
   53: 
   54: # ================================================== Unpack message into a hash
   55: 
   56: sub unpackagemsg {
   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: 
   71: # =============================== Automated message to the author of a resource
   72: 
   73: sub author_res_msg {
   74:     my ($filename,$message)=@_;
   75:     unless ($message) { return 'empty'; }
   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);
   81:        my $msgid;
   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);
   87:     }
   88:     return 'no_host';
   89: }
   90: 
   91: # ================================================== Critical message to a user
   92: 
   93: sub user_crit_msg {
   94:     my ($user,$domain,$subject,$message)=@_;
   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;
  102:        ($msgid,$message)=&packagemsg($subject,$message);
  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;
  135:        ($msgid,$message)=&packagemsg($subject,$message);
  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;
  150: }
  151: 
  152: 1;
  153: __END__
  154: 
  155: 
  156: 
  157: 
  158: 
  159: 
  160: