Annotation of loncom/interface/lonmsg.pm, revision 1.5
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.5 ! www 13: # 10/19,10/20,10/30 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.5 ! www 21: use Apache::Constants qw(:common);
1.1 www 22:
23: # ===================================================================== Package
24:
1.3 www 25: sub packagemsg {
26: my ($subject,$message)=@_;
1.1 www 27: $message=~s/\</\<\;/g;
28: $message=~s/\>/\>\;/g;
29: $subject=~s/\</\<\;/g;
30: $subject=~s/\>/\>\;/g;
1.2 www 31: my $now=time;
32: $msgcount++;
1.3 www 33: my $msgid=$now.'_'.$ENV{'user.name'}.'_'.
1.2 www 34: $ENV{'user.domain'}.'_'.$msgcount.'_'.$$;
35: return $msgid,
36: '<sendername>'.$ENV{'user.name'}.'</sendername>'.
1.1 www 37: '<senderdomain>'.$ENV{'user.domain'}.'</senderdomain>'.
38: '<subject>'.$subject.'</subject>'.
1.2 www 39: '<time>'.localtime($now).'</time>'.
1.1 www 40: '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
41: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
42: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
43: '<browsertype>'.$ENV{'browser.type'}.'</browsertype>'.
44: '<browseros>'.$ENV{'browser.os'}.'</browseros>'.
45: '<browserversion>'.$ENV{'browser.version'}.'</browserversion>'.
46: '<browsermathml>'.$ENV{'browser.mathml'}.'</browsermathml>'.
47: '<browserraw>'.$ENV{'HTTP_USER_AGENT'}.'</browserraw>'.
48: '<courseid>'.$ENV{'request.course.id'}.'</courseid>'.
49: '<role>'.$ENV{'request.role'}.'</role>'.
50: '<resource>'.$ENV{'request.filename'}.'</resource>'.
1.2 www 51: '<msgid>'.$msgid.'</msgid>'.
1.1 www 52: '<message>'.$message.'</message>';
53: }
54:
1.2 www 55: # ================================================== Unpack message into a hash
56:
1.3 www 57: sub unpackagemsg {
1.2 www 58: my $message=shift;
59: my %content=();
60: my $parser=HTML::TokeParser->new(\$message);
61: my $token;
62: while ($token=$parser->get_token) {
63: if ($token->[0] eq 'S') {
64: my $entry=$token->[1];
65: my $value=$parser->get_text('/'.$entry);
66: $content{$entry}=$value;
67: }
68: }
69: return %content;
70: }
71:
1.1 www 72: # =============================== Automated message to the author of a resource
73:
74: sub author_res_msg {
75: my ($filename,$message)=@_;
1.2 www 76: unless ($message) { return 'empty'; }
1.1 www 77: $filename=&Apache::lonnet::declutter($filename);
78: my ($domain,$author,@dummy)=split(/\//,$filename);
79: my $homeserver=&Apache::lonnet::homeserver($author,$domain);
80: if ($homeserver ne 'no_host') {
81: my $id=unpack("%32C*",$message);
1.2 www 82: my $msgid;
1.3 www 83: ($msgid,$message)=&packagemsg($filename,$message);
84: return &Apache::lonnet::reply('put:'.$domain.':'.$author.
85: ':nohist_res_msgs:'.
86: &Apache::lonnet::escape($filename.'_'.$id).'='.
87: &Apache::lonnet::escape($message),$homeserver);
1.1 www 88: }
1.2 www 89: return 'no_host';
1.1 www 90: }
91:
92: # ================================================== Critical message to a user
93:
94: sub user_crit_msg {
95: my ($user,$domain,$subject,$message)=@_;
1.2 www 96: # Check if allowed missing
97: my $status='';
98: my $msgid='undefined';
99: unless (($message)&&($user)&&($domain)) { $status='empty'; };
100: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
101: if ($homeserver ne 'no_host') {
102: my $msgid;
1.3 www 103: ($msgid,$message)=&packagemsg($subject,$message);
1.4 www 104: $status=&Apache::lonnet::critical(
105: 'put:'.$domain.':'.$user.':critical:'.
106: &Apache::lonnet::escape($msgid).'='.
107: &Apache::lonnet::escape($message),$homeserver);
1.2 www 108: } else {
109: $status='no_host';
110: }
111: &Apache::lonnet::logthis(
1.4 www 112: 'Sending critical email '.$msgid.
1.2 www 113: ', log status: '.
114: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
115: $ENV{'user.home'},
116: 'Sending critical '.$msgid.' to '.$user.' at '.$domain.' with status: '
1.4 www 117: .$status));
1.2 www 118: return $status;
119: }
120:
121: # =================================================== Critical message received
122:
123: sub user_crit_received {
124: my $message=shift;
1.4 www 125: my %contents=&unpackagemsg($message);
1.5 ! www 126: my $status='rec: '.
! 127: &user_normal_msg($contents{'sendername'},$contents{'senderdomain'},
1.4 www 128: 'Receipt: '.$ENV{'user.name'}.' at '.$ENV{'user.domain'},
129: 'User '.$ENV{'user.name'}.' at '.$ENV{'user.domain'}.
130: ' acknowledged receipt of message "'.
131: $contents{'subject'}.'" dated '.$contents{'time'}.".\n\n"
132: .'Message ID: '.$contents{'msgid'});
1.5 ! www 133: $status.=' trans: '.
! 134: &Apache::lonnet::put('nohist_email',$contents{'msgid'} => $message);
! 135: $status.=' del: '.
! 136: &Apache::lonnet::del('critical',$contents{'msgid'});
! 137: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
! 138: $ENV{'user.home'},'Received critical message '.
! 139: $contents{'msgid'}.
! 140: ', '.$status);
1.2 www 141: }
142:
143: # ======================================================== Normal communication
144:
145: sub user_normal_msg {
146: my ($user,$domain,$subject,$message)=@_;
147: # Check if allowed missing
148: my $status='';
149: my $msgid='undefined';
150: unless (($message)&&($user)&&($domain)) { $status='empty'; };
151: my $homeserver=&Apache::lonnet::homeserver($user,$domain);
152: if ($homeserver ne 'no_host') {
153: my $msgid;
1.3 www 154: ($msgid,$message)=&packagemsg($subject,$message);
1.4 www 155: $status=&Apache::lonnet::critical(
156: 'put:'.$domain.':'.$user.':nohist_email:'.
157: &Apache::lonnet::escape($msgid).'='.
158: &Apache::lonnet::escape($message),$homeserver);
1.2 www 159: } else {
160: $status='no_host';
161: }
162: &Apache::lonnet::log($ENV{'user.domain'},$ENV{'user.name'},
163: $ENV{'user.home'},
164: 'Sending '.$msgid.' to '.$user.' at '.$domain.' with status: '.$status);
165: return $status;
166: }
167:
1.5 ! www 168: # ===================================================================== Handler
! 169:
! 170: sub handler {
! 171: my $r=shift;
! 172:
! 173: # ----------------------------------------------------------- Set document type
! 174:
! 175: $r->content_type('text/html');
! 176: $r->send_http_header;
! 177:
! 178: return OK if $r->header_only;
! 179:
! 180: # --------------------------------------------------------------- Render Output
! 181:
! 182: $r->print('<html><head><title>EMail and Messaging</title></head>');
! 183: $r->print('<body bgcolor="#FFFFFF">');
! 184: $r->print('<h1>EMail</h1>');
! 185: $r->print('</body></html>');
! 186: return OK;
! 187:
! 188: }
1.2 www 189: # ================================================= Main program, reset counter
190:
191: sub BEGIN {
192: $msgcount=0;
1.1 www 193: }
194:
195: 1;
196: __END__
197:
198:
199:
200:
201:
202:
203:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonmsg.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface