File:  [LON-CAPA] / loncom / interface / lonmsg.pm
Revision 1.4: download - view: text, annotated - select for diffs
Fri Oct 20 18:06:08 2000 UTC (23 years, 8 months ago) by www
Branches: MAIN
CVS tags: HEAD
Bug Fixes and Received Function

    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::critical(
  104:            'put:'.$domain.':'.$user.':critical:'.
  105:            &Apache::lonnet::escape($msgid).'='.
  106:            &Apache::lonnet::escape($message),$homeserver);
  107:     } else {
  108:        $status='no_host';
  109:     }
  110:     &Apache::lonnet::logthis(
  111:       'Sending critical email '.$msgid.
  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: '
  116:       .$status));
  117:     return $status;
  118: }
  119: 
  120: # =================================================== Critical message received
  121: 
  122: sub user_crit_received {
  123:     my $message=shift;
  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'});
  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;
  147:        ($msgid,$message)=&packagemsg($subject,$message);
  148:        $status=&Apache::lonnet::critical(
  149:            'put:'.$domain.':'.$user.':nohist_email:'.
  150:            &Apache::lonnet::escape($msgid).'='.
  151:            &Apache::lonnet::escape($message),$homeserver);
  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;
  165: }
  166: 
  167: 1;
  168: __END__
  169: 
  170: 
  171: 
  172: 
  173: 
  174: 
  175: 

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