[BACK]Return to lonmsg.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/lonmsg.pm between versions 1.1 and 1.3

version 1.1, 2000/10/19 14:20:17 version 1.3, 2000/10/20 14:40:26
Line 10 Line 10
 #  #
 # 10/05 Gerd Kortemeyer)  # 10/05 Gerd Kortemeyer)
 #  #
 # 10/19 Gerd Kortemeyer  # 10/19,10/20 Gerd Kortemeyer
   
 package Apache::lonmsg;  package Apache::lonmsg;
   
 use strict;  use strict;
 use Apache::lonnet();  use Apache::lonnet();
   use vars qw($msgcount);
   use HTML::TokeParser;
   
 # ===================================================================== Package  # ===================================================================== Package
   
 sub package {  sub packagemsg {
     var ($subject,$message)=@_;      my ($subject,$message)=@_;
     $message=~s/\</\&lt\;/g;      $message=~s/\</\&lt\;/g;
     $message=~s/\>/\&gt\;/g;      $message=~s/\>/\&gt\;/g;
     $subject=~s/\</\&lt\;/g;      $subject=~s/\</\&lt\;/g;
     $subject=~s/\>/\&gt\;/g;      $subject=~s/\>/\&gt\;/g;
     return '<sendername>'.$ENV{'user.name'}.'</sendername>'.      my $now=time;
       $msgcount++;
       my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
              $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
       return $msgid,
              '<sendername>'.$ENV{'user.name'}.'</sendername>'.
            '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.             '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
            '<subject>'.$subject.'</subject>'.             '<subject>'.$subject.'</subject>'.
    '<time>'.localtime().'</time>'.     '<time>'.localtime($now).'</time>'.
    '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.     '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.             '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
    '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.     '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
Line 41  sub package { Line 47  sub package {
    '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.     '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
    '<role>'.$ENV{'request.role'}.'</role>'.     '<role>'.$ENV{'request.role'}.'</role>'.
    '<resource>'.$ENV{'request.filename'}.'</resource>'.     '<resource>'.$ENV{'request.filename'}.'</resource>'.
              '<msgid>'.$msgid.'</msgid>'.
    '<message>'.$message.'</message>';     '<message>'.$message.'</message>';
 }  }
   
   # ================================================== Unpack message into a hash
   
   sub unpackagemsg {
       my $message=shift;
       my %content=();
       my $parser=HTML::TokeParser->new(\$message);
       my $token;
       while ($token=$parser->get_token) {
          if ($token->[0] eq 'S') {
      my $entry=$token->[1];
              my $value=$parser->get_text('/'.$entry);
              $content{$entry}=$value;
          }
       }
       return %content;
   }
   
 # =============================== Automated message to the author of a resource  # =============================== Automated message to the author of a resource
   
 sub author_res_msg {  sub author_res_msg {
     my ($filename,$message)=@_;      my ($filename,$message)=@_;
       unless ($message) { return 'empty'; }
     $filename=&Apache::lonnet::declutter($filename);      $filename=&Apache::lonnet::declutter($filename);
     my ($domain,$author,@dummy)=split(/\//,$filename);      my ($domain,$author,@dummy)=split(/\//,$filename);
     my $homeserver=&Apache::lonnet::homeserver($author,$domain);      my $homeserver=&Apache::lonnet::homeserver($author,$domain);
     if ($homeserver ne 'no_host') {      if ($homeserver ne 'no_host') {
        my $id=unpack("%32C*",$message);         my $id=unpack("%32C*",$message);
        &Apache::lonnet::put('res_msgs',$filename.'_'.$id => package($message));         my $msgid;
          ($msgid,$message)=&packagemsg($filename,$message);
          return &Apache::lonnet::reply('put:'.$domain.':'.$author.
            ':nohist_res_msgs:'.
             &Apache::lonnet::escape($filename.'_'.$id).'='.
             &Apache::lonnet::escape($message),$homeserver);
     }      }
       return 'no_host';
 }  }
   
 # ================================================== Critical message to a user  # ================================================== Critical message to a user
   
 sub user_crit_msg {  sub user_crit_msg {
     my ($user,$domain,$subject,$message)=@_;      my ($user,$domain,$subject,$message)=@_;
   # Check if allowed missing
       my $status='';
       my $msgid='undefined';
       unless (($message)&&($user)&&($domain)) { $status='empty'; };
       my $homeserver=&Apache::lonnet::homeserver($user,$domain);
       if ($homeserver ne 'no_host') {
          my $msgid;
          ($msgid,$message)=&packagemsg($subject,$message);
          $status=&Apache::lonnet::cput('critical',$msgid => $message);
       } else {
          $status='no_host';
       }
       &Apache::lonnet::logthis(
         '<font color=yellow>INFO: Sending critical email '.$msgid.
         ', log status: '.
         &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                            $ENV{'user.home'},
         'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
         .$status).'</font>');
       return $status;
   }
   
   # =================================================== Critical message received
   
   sub user_crit_received {
       my $message=shift;
   
   }
   
   # ======================================================== Normal communication
   
   sub user_normal_msg {
       my ($user,$domain,$subject,$message)=@_;
   # Check if allowed missing
       my $status='';
       my $msgid='undefined';
       unless (($message)&&($user)&&($domain)) { $status='empty'; };
       my $homeserver=&Apache::lonnet::homeserver($user,$domain);
       if ($homeserver ne 'no_host') {
          my $msgid;
          ($msgid,$message)=&packagemsg($subject,$message);
          $status=&Apache::lonnet::cput('nohist_email',$msgid => $message);
       } else {
          $status='no_host';
       }
       &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
                            $ENV{'user.home'},
         'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
       return $status;
   }
   
   # ================================================= Main program, reset counter
   
   sub BEGIN {
       $msgcount=0;
 }  }
   
 1;  1;
Removed from v.1.1  
changed lines
  Added in v.1.3

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