Annotation of loncom/interface/lonnotify.pm, revision 1.9
1.1 raeburn 1: #
2: # Copyright Michigan State University Board of Trustees
3: #
4: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
5: #
6: # LON-CAPA is free software; you can redistribute it and/or modify
7: # it under the terms of the GNU General Public License as published by
8: # the Free Software Foundation; either version 2 of the License, or
9: # (at your option) any later version.
10: #
11: # LON-CAPA is distributed in the hope that it will be useful,
12: # but WITHOUT ANY WARRANTY; without even the implied warranty of
13: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14: # GNU General Public License for more details.
15: #
16: # You should have received a copy of the GNU General Public License
17: # along with LON-CAPA; if not, write to the Free Software
18: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
19: #
20: # /home/httpd/html/adm/gpl.txt
21: #
22: # http://www.lon-capa.org/
23: #
24:
25: package Apache::lonnotify;
26:
27: use strict;
28: use Apache::lonnet;
29: use Apache::loncommon;
30: use Apache::lonsupportreq;
31: use LONCAPA::Enrollment;
32: use Apache::Constants qw(:common :http);
33: use Apache::lonlocal;
1.2 raeburn 34: use Mail::Send;
35: use HTML::TokeParser;
36: use HTML::Entities;
1.1 raeburn 37:
38: sub handler {
39: my ($r) = @_;
40: &Apache::loncommon::content_type($r,'text/html');
41: $r->send_http_header;
42:
43: if ($r->header_only) {
44: return OK;
45: }
1.2 raeburn 46: my $cdom = $env{'request.role.domain'};
47: unless (&Apache::lonnet::allowed('psa',$cdom)) {
1.1 raeburn 48: # Not allowed to broadcast e-mail system-wide
49: $env{'user.error.msg'}="/adm/notify:psa:0:0:Cannot broadcast e-mail systemwide";
50: return HTTP_NOT_ACCEPTABLE;
51: }
52:
1.2 raeburn 53: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
54: ['command']);
1.1 raeburn 55: my $command = $env{'form.command'};
1.8 raeburn 56: my $origin = $env{'form.origin'};
57:
1.1 raeburn 58: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.2 raeburn 59: my %ltext=&Apache::lonlocal::texthash(
60: 'note' => 'Notification E-mail',
61: );
62: my $function = &Apache::loncommon::get_users_function();
1.8 raeburn 63: my $loadcode;
1.2 raeburn 64: my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
1.8 raeburn 65: if ((defined($env{'form.origin'})) && ($command eq 'compose' || $command eq 'pick_target' || $command eq 'pick_display')) {
66: unless ($env{'form.origin'} eq '') {
67: $loadcode = 'javascript:setFormElements(document.'.$env{'form.command'}.')';
68: if (($command eq 'pick_target') && (
69: ($origin eq 'compose') || ($origin eq 'process'))) {
70: if ($env{'form.coursepick'} eq 'category') {
71: $loadcode .= ';javascript:setCourseCat(document.'.$env{'form.command'}.')';
72: }
73: }
74: }
75: }
76: my $loaditems = ' onLoad="'.$loadcode.'" ';
77: my $bodytag = &Apache::loncommon::bodytag('Broadcast e-mail to users',$function,$loaditems);
1.2 raeburn 78: my $html=&Apache::lonxml::xmlbegin();
1.1 raeburn 79: &Apache::lonhtmlcommon::add_breadcrumb
80: ({href=>'/adm/notify',
1.2 raeburn 81: text=>"Broadcast E-mail"});
1.1 raeburn 82: if ($command eq 'process') {
1.8 raeburn 83: &print_request_receipt($r,$command,$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.1 raeburn 84: } elsif ($command eq 'compose') {
1.8 raeburn 85: &print_composition_form($r,$command,$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.2 raeburn 86: } elsif ($command eq 'pick_target') {
1.8 raeburn 87: &print_selection_form($r,$command,$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.2 raeburn 88: } elsif ($command eq 'pick_display') {
1.8 raeburn 89: &print_display_option_form($r,$command,$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.2 raeburn 90: } elsif ($command eq 'display') {
1.8 raeburn 91: &print_display($r,$command,$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.1 raeburn 92: } else {
1.8 raeburn 93: &print_front_page($r,'front',$cdom,$tablecolor,$bodytag,$html,\%ltext);
1.1 raeburn 94: }
95: return OK;
96: }
97:
1.2 raeburn 98: sub print_front_page {
1.8 raeburn 99: my ($r,$formname,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
1.2 raeburn 100: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
101: (undef,'Broadcast e-mail to Domain','Broadcast_system_email');
102: my $jscript = qq|
103: function next_page(caller) {
104: if (caller == 'view') {
105: document.front.command.value="pick_display"
106: }
107: else {
108: document.front.command.value="pick_target"
109: }
110: document.front.submit()
111: }
112: |;
113: my %lt=&Apache::lonlocal::texthash(
114: 'note' => 'Notification E-mail',
115: );
116: my $output = <<"ENDONE";
117: $html
118: <head>
119: <title>LON-CAPA $lt{'note'}</title>
120: <script type"text/javascript">
121: $jscript
122: </script>
123: </head>
124: $bodytag
125: $breadcrumbs
126: <br />
127: ENDONE
1.8 raeburn 128: $output .= '<form name="'.$formname.'" method="post">'.
1.2 raeburn 129: '<input type="hidden" name="command" />';
130: $output .= &Apache::lonhtmlcommon::start_pick_box();
131: $output .= '<table cellspacing="8" cellpadding="8">'.
132: '<tr><td><a href="javascript:next_page('."'new'".')">'.
133: 'Send a new e-mail message to selected users from this domain</a></td></tr><tr>'.
134: '<td><a href="javascript:next_page('."'view'".')">'.
135: 'Display e-mail sent by Domain Coordinators in this domain'.
136: '</a></td></tr></table>';
137: $output .= &Apache::lonhtmlcommon::end_pick_box();
138: $output .= qq(
139: </form>
140: </body>
141: </html>);
142: $r->print($output);
143: return;
144: }
145:
146: sub print_display_option_form {
1.8 raeburn 147: my ($r,$formname,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
1.2 raeburn 148: &Apache::lonhtmlcommon::add_breadcrumb
149: ({text=>"Display options"});
150: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
151: (undef,'Broadcast e-mail display options','Broadcast_system_email');
152: my $table_width = '';
153: my $col_width = '200';
154: my $cmd = 'display';
155: my $submit_text = 'Display e-mail';
156: my @roles = ('dc');
157: my $now = time;
158: my %lt=&Apache::lonlocal::texthash(
159: 'note' => 'Notification E-mail',
160: );
161: my $startdateform = &Apache::lonhtmlcommon::date_setter($formname,
162: 'startdate',
163: $now);
164: my $enddateform = &Apache::lonhtmlcommon::date_setter($formname,
165: 'enddate',
166: $now);
1.8 raeburn 167: my %elements = (
168: startdate_month => 'selectbox',
169: startdate_hour => 'selectbox',
170: enddate_month => 'selectbox',
171: enddate_hour => 'selectbox',
172: startdate_day => 'text',
173: startdate_year => 'text',
174: startdate_minute => 'text',
175: startdate_second => 'text',
176: enddate_day => 'text',
177: enddate_year => 'text',
178: enddate_minute => 'text',
179: enddate_second => 'text',
180: sender => 'checkbox',
181: );
182: my $jscript = &Apache::lonhtmlcommon::set_form_elements(\%elements);
1.2 raeburn 183: my $output = <<"ENDONE";
184: $html
185: <head>
186: <title>LON-CAPA $lt{'note'}</title>
187: <script type"text/javascript">
188: $jscript
189: </script>
190: </head>
191: $bodytag
192: $breadcrumbs
193: <br />
194: <form method="post" name="$formname">
195: ENDONE
196: $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
197: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Date range'));
198: $output .= '<td><table><tr><td>Earliest to display: </td><td>'.
199: $startdateform.'</td></tr>';
200: $output .= '<tr><td>Latest to display: </td><td>'.$enddateform.
201: '</td></tr></table></td>';
202: $output .= &Apache::lonhtmlcommon::row_closure();
203: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Choose sender(s)'));
1.4 raeburn 204: my %personnel = &Apache::lonnet::get_domain_roles($cdom,\@roles);
1.2 raeburn 205: $output .= '<td>';
1.4 raeburn 206: my @domcc = ();
207: foreach my $server (keys %personnel) {
208: foreach my $user (sort(keys %{$personnel{$server}})) {
209: my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
210: unless (grep/^$uname:$udom$/,@domcc) {
211: my %userinfo = &Apache::lonnet::get('environment',['lastname','firstname'],$udom,$uname);
212: $output .= '<input type="checkbox" name="sender" value="'.$uname.':'.$udom.'" /> '.$userinfo{firstname}.' '.$userinfo{lastname}.' ('.$uname.':'.$udom.')';
213: push (@domcc,$uname.':'.$udom);
214: }
1.2 raeburn 215: }
216: }
217: $output .= '</td>';
218: $output .= &Apache::lonhtmlcommon::row_closure();
219: $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),$cmd,$submit_text);
220: $output .= &Apache::lonhtmlcommon::end_pick_box();
221: $output .= qq(
222: <input type="hidden" name="sortby" value="date" />
223: </form>
224: </body>
225: </html>);
226: $r->print($output);
227: return;
228: }
229:
230: sub print_display {
1.8 raeburn 231: my ($r,$formname,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
1.2 raeburn 232: &Apache::lonhtmlcommon::add_breadcrumb
1.8 raeburn 233: ({href=>"javascript:goBack('pick_display')",
1.2 raeburn 234: text=>"Display options"},
235: {text=>"E-mail display"});
236: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
237: (undef,'Display Broadcast e-mail','Broadcast_system_email');
238: my $table_width = '';
239: my $col_width = '200';
240: my $rowColor1 = "#ffffff";
241: my $rowColor2 = "#eeeeee";
242: my $rowColor;
243: my $msgcount = 0;
244: my $start = &Apache::lonhtmlcommon::get_date_from_form('startdate');
245: my $end = &Apache::lonhtmlcommon::get_date_from_form('enddate');
246: my @senders = &Apache::loncommon::get_env_multiple('form.sender');
1.6 albertel 247: my %sentmail = &Apache::lonnet::dcmaildump($cdom,$start,$end,\@senders);
1.2 raeburn 248: my %dcmail = ();
249: my %Sortby = ();
250: my $jscript = <<"ENDSCRIPT";
251: function changeSort(caller) {
1.8 raeburn 252: document.$formname.command.value = '$formname';
1.2 raeburn 253: document.$formname.sortby.value = caller;
1.8 raeburn 254: document.$formname.submit();
255: }
256: function goBack(target) {
257: document.$formname.command.value = target;
258: document.$formname.submit();
1.2 raeburn 259: }
1.8 raeburn 260:
1.2 raeburn 261: ENDSCRIPT
262: my $output = <<"ENDONE";
263: $html
264: <head>
265: <title>LON-CAPA $$ltext{'note'}</title>
266: <script type"text/javascript">
267: $jscript
268: </script>
269: </head>
270: $bodytag
271: $breadcrumbs
272: <br />
273: <form method="post" name="$formname">
274: ENDONE
275:
1.9 ! raeburn 276: foreach my $msgid (keys(%sentmail)) {
! 277: my %content = &unpackagemail($sentmail{$msgid});
! 278: $msgcount ++;
! 279: %{$dcmail{$msgid}} = ();
! 280: foreach my $item (keys(%content)) {
! 281: if ($item eq 'recipients') {
! 282: foreach my $user (keys(%{$content{recipients}})) {
1.2 raeburn 283: $dcmail{$msgid}{recipients}{$user} = $content{recipients}{$user};
284: }
285: } else {
1.9 ! raeburn 286: $dcmail{$msgid}{$item} = $content{$item};
1.2 raeburn 287: }
288: }
289: }
290: $output .= &Apache::lonhtmlcommon::start_pick_box();
291: if ($msgcount > 0) {
292: my $rowNum = 0;
293: $output .= '<tr><td><table cellpadding="4" cellspacing="2" width="100%">
294: <tr bgcolor="'.$tablecolor.'" align="center">
295: <td><b><a href="javascript:changeSort('."'date'".')">Date</a></b></td>
296: <td><b><a href="javascript:changeSort('."'subject'".')">Subject</a></b></td>
297: <td><b><a href="javascript:changeSort('."'sender'".')">Sender</a></b></td>
298: <td><b><a href="javascript:changeSort('."'message'".')">Message</a></b></td>
299: <td><b><a href="javascript:changeSort('."'recipients'".')">Recipients</a></b></td>
300: </tr>';
301: if (($env{'form.sortby'} eq 'date') || ($env{'form.sortby'} eq '') || (!defined($env{'form.sortby'})) || (($env{'form.sortby'} eq 'sender') && (@senders <= 1))) {
302: foreach my $msgid (sort(keys(%dcmail))) {
303: if ($rowNum %2 == 1) {
304: $rowColor = $rowColor1;
305: } else {
306: $rowColor = $rowColor2;
307: }
308: my $recipients = '';
309: my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
310: $date = &Apache::lonlocal::locallocaltime($date);
311: foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
312: $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
313: }
314: $recipients =~ s/,\s$//;
1.5 raeburn 315: $output .= '<tr bgcolor="'.$rowColor.'"><td><small>'.$date.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td><td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td><td><small>'.$recipients.'</small></td></tr>'."\n";
1.2 raeburn 316: $rowNum ++;
317: }
318: } else {
319: foreach my $msgid (sort(keys(%dcmail))) {
320: my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
321: if ($env{'form.sortby'} eq 'subject') {
322: push @{$Sortby{$dcmail{$msgid}{subject}}},$msgid;
323: } elsif ($env{'form.sortby'} eq 'message') {
324: push @{$Sortby{$dcmail{$msgid}{message}}},$msgid;
325: } elsif ($env{'form.sortby'} eq 'recipients') {
326: my $recipients ='';
327: foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
328: $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
329: }
330: $recipients =~ s/,\s$//;
331: push @{$Sortby{$recipients}},$msgid;
332: } elsif ($env{'form.sortby'} eq 'sender') {
333: if (@senders > 1) {
334: push @{$Sortby{$sname.':'.$sdom}},$msgid;
335: }
336: }
337: }
338: foreach my $key (sort(keys(%Sortby))) {
339: foreach my $msgid (@{$Sortby{$key}}) {
340: if ($rowNum %2 == 1) {
341: $rowColor = $rowColor1;
342: } else {
343: $rowColor = $rowColor2;
344: }
345: my $recipients = '';
346: if ($env{'form.sortby'} eq 'recipients') {
347: $recipients = $key;
348: } else {
349: foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
350: $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
351: }
352: $recipients =~ s/,\s$//;
353: }
1.5 raeburn 354:
1.2 raeburn 355: my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
356: $date = &Apache::lonlocal::locallocaltime($date);
1.5 raeburn 357: $output .= '<tr bgcolor="'.$rowColor.'"><td><small>'.$date.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td><td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td><td><small>'.$recipients.'</small></td></tr>'."\n";
1.2 raeburn 358: $rowNum ++;
359: }
360: }
361: }
362: $output .= '</table></td></tr>';
363: } else {
364: $output .= '<tr bgcolor="#ffffff"><td> </td><td><br><center><i><b><small> No mail sent matching supplied criteria </small><br><br></b></i></td><td> </td></tr>';
365: }
366: $output .= &Apache::lonhtmlcommon::end_pick_box();
1.8 raeburn 367: $output .= &Apache::lonhtmlcommon::echo_form_input(['sortby','command','origin']);
368: my $curr_sortby;
369: if (defined($env{'form.sortby'})) {
370: $curr_sortby = $env{'form.sortby'};
371: } else {
372: $curr_sortby = 'date';
373: }
374: $output .= qq(<input type="hidden" name="origin" value="$formname" />\n);
375: $output .= qq(<input type="hidden" name="command" />\n);
376: $output .= qq(<input type="hidden" name="sortby" value="$curr_sortby" />\n);
1.2 raeburn 377: $output .= qq(
378: </form>
379: </body>
380: </html>);
381: $r->print($output);
382: return;
383: }
384:
1.1 raeburn 385: sub print_selection_form {
1.8 raeburn 386: my ($r,$formname,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
1.1 raeburn 387: my %coursecodes = ();
388: my %codes = ();
389: my @codetitles = ();
390: my %cat_titles = ();
391: my %cat_order = ();
392: my %idlist = ();
393: my %idnums = ();
394: my %idlist_titles = ();
395: my $caller = 'global';
396: my $totcodes = 0;
397: my $format_reply;
398: my $jscript = '';
1.2 raeburn 399: my $table_width = '100%';
400: my $col_width = '200';
401: my %lt=&Apache::lonlocal::texthash(
402: 'note' => 'Notification E-mail',
403: 'buil' => 'Building valid e-mail address from username, if missing from preferences:',
404: 'kerb' => 'Kerberos: enter default for each realm used in the domain, with comma separation of entries',
405: 'infs' => 'Internal, Filesystem and Local authentication: enter single default.',
406: 'comp' => 'Compose Message'
407: );
408: &Apache::lonhtmlcommon::add_breadcrumb
409: ({text=>"Select Audience"});
410:
1.1 raeburn 411: $totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$cdom,$totcodes);
412: if ($totcodes > 0) {
413: $format_reply = &Apache::lonnet::auto_instcode_format($caller,$cdom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
414: if ($format_reply eq 'ok') {
415: my $numtypes = @codetitles;
416: &Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
1.2 raeburn 417: &Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
1.1 raeburn 418: }
419: }
420:
421: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
1.2 raeburn 422: (undef,'Choose e-mail audience','Broadcast_system_email');
1.3 albertel 423: my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($cdom);
1.8 raeburn 424:
425: my %elements = (
426: roles => 'selectbox',
427: types => 'selectbox',
428: Year => 'selectbox',
429: coursepick => 'radio',
430: coursetotal => 'text',
431: courselist => 'text',
432: internal => 'text',
433: krb4 => 'text',
434: krb5 => 'text',
435: local => 'text',
436: unix => 'text',
437: );
438: $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
439: if ($env{'form.coursepick'} eq 'category') {
440: $jscript .= qq|
441: function setCourseCat(formname) {
442: if (formname.Year.options[formname.Year.selectedIndex].value == -1) {
443: return;
444: }
445: courseSet('Year');
446: for (var j=0; j<formname.Semester.length; j++) {
447: if (formname.Semester.options[j].value == "$env{'form.Semester'}") {
448: formname.Semester.options[j].selected = true;
449: }
450: }
451: if (formname.Semester.options[formname.Semester.selectedIndex].value == -1) {
452: return;
453: }
454: courseSet('Semester');
455: for (var j=0; j<formname.Department.length; j++) {
456: if (formname.Department.options[j].value == "$env{'form.Department'}") {
457: formname.Department.options[j].selected = true;
458: }
459: }
460: if (formname.Department.options[formname.Department.selectedIndex].value == -1) {
461: return;
462: }
463: courseSet('Department');
464: for (var j=0; j<formname.Number.length; j++) {
465: if (formname.Number.options[j].value == "$env{'form.Number'}") {
466: formname.Number.options[j].selected = true;
467: }
468: }
469: }
470: |;
471: }
1.2 raeburn 472: my $output = <<"ENDONE";
1.1 raeburn 473: $html
474: <head>
1.2 raeburn 475: <title>LON-CAPA $lt{'note'}</title>
1.1 raeburn 476: <script type"text/javascript">
477: $jscript
478: </script>
1.2 raeburn 479: $cb_jscript
1.1 raeburn 480: </head>
481: $bodytag
482: $breadcrumbs
483: <br />
1.2 raeburn 484: <form method="post" name="$formname">
1.1 raeburn 485: ENDONE
1.2 raeburn 486: $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
1.8 raeburn 487: my @roles = ('ow','cc','in','ta','ep','st','cr');
1.2 raeburn 488: my %longtypes = ();
489: my %authtypes = ();
490: &form_elements(\%longtypes,\%authtypes);
491: my $descrip = $lt{'buil'}.'
492: <ul>
493: <li>'.$lt{'kerb'}.'<br />(e.g., MSU.EDU=msu.edu, MSUE.EDU=msue.msu.edu).</li>
494: <li>'.$lt{'infs'}.'</li>
495: </ul>'."\n";
496: my $submit_text = $lt{'comp'};
497: my $cmd = 'compose';
498: $output .= &Apache::lonhtmlcommon::role_select_row(\@roles,$col_width,$tablecolor,'Roles');
499: $output .= &Apache::lonhtmlcommon::course_select_row($col_width,$tablecolor,'Courses',$formname,$totcodes,\@codetitles,\%idlist,\%idlist_titles);
500: $output .= &Apache::lonhtmlcommon::status_select_row(\%longtypes,$col_width,$tablecolor,&mt('Access status'));
501: $output .= &Apache::lonhtmlcommon::email_default_row(\%authtypes,$col_width,$tablecolor,&mt('Username -> Email conversion'),$descrip);
502: $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),$cmd,$submit_text);
503: $output .= &Apache::lonhtmlcommon::end_pick_box();
504: $output .= qq(
1.1 raeburn 505: </form>
506: </body>
1.2 raeburn 507: </html>);
508: $r->print($output);
1.1 raeburn 509: return;
510: }
511:
512: sub print_composition_form {
1.8 raeburn 513: my ($r,$formname,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
1.1 raeburn 514: &Apache::lonhtmlcommon::add_breadcrumb
1.8 raeburn 515: ({href=>"javascript:goBack('pick_target')",
1.2 raeburn 516: text=>"Select Audience"},
517: {text=>"Compose Message"});
518: my $jscript = &Apache::loncommon::check_uncheck_jscript();
1.8 raeburn 519: $jscript .= qq|
520: function goBack(target) {
521: document.$formname.command.value = target;
522: document.$formname.submit();
523: }
524: |;
1.1 raeburn 525: my $breadcrumbs = (&Apache::lonhtmlcommon::breadcrumbs
526: (undef,'Broadcast e-mail to users','Broadcast_system_email'));
527:
1.2 raeburn 528: my %lt=&Apache::lonlocal::texthash(
529: 'note' => 'Notification E-mail',
530: 'nore' => 'No recipients identified',
531: 'emad' => 'e-mail address',
532: );
1.8 raeburn 533: my %elements = (
534: subject => 'text',
535: message => 'text',
536: sender => 'text',
537: recipient => 'checkbox',
538: );
539: $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
540:
1.1 raeburn 541: $r->print(<<ENDONE);
542: $html
543: <head>
1.2 raeburn 544: <title>LON-CAPA $lt{'note'}</title>
1.7 raeburn 545: <script type="text/javascript">
1.1 raeburn 546: $jscript
547: </script>
548: </head>
549: $bodytag $breadcrumbs
550: <br />
551: ENDONE
1.2 raeburn 552: my $coursefilter = $env{'form.coursepick'};
553: my %courses = ();
554: if ($coursefilter eq 'all') {
555: %courses = &Apache::lonnet::courseiddump($cdom,'.','.','.','.','.');
556: } elsif ($coursefilter eq 'category') {
557: my $instcode = '';
558: my @cats = ('Semester','Year','Department','Number');
559: foreach my $category (@cats) {
560: if (defined($env{'form.'.$category})) {
561: unless ($env{'form.'.$category} eq '-1') {
562: $instcode .= $env{'form.'.$category};
563: }
1.1 raeburn 564: }
565: }
1.2 raeburn 566: if ($instcode eq '') {
567: $instcode = '.';
568: }
569: %courses = &Apache::lonnet::courseiddump($cdom,'.','.',$instcode,'.','.');
570: } elsif ($coursefilter eq 'specific') {
571: if ($env{'form.coursetotal'} > 1) {
572: my @course_ids = split(/&&/,$env{'form.courselist'});
573: foreach (@course_ids) {
574: $courses{$_} = '';
575: }
576: } else {
577: $courses{$env{'form.courselist'}} = '';
578: }
1.1 raeburn 579: }
1.2 raeburn 580:
581: my @types = &Apache::loncommon::get_env_multiple('form.types');
582: my @roles = &Apache::loncommon::get_env_multiple('form.roles');
583:
584: my %longtypes = ();
585: my %authtypes = ();
586: my %email_defaults = ();
587: my $table_width = '100%';
588: my $col_width = '200';
589:
590: &form_elements(\%longtypes,\%authtypes);
1.3 albertel 591: foreach my $auth (keys(%authtypes)) {
1.2 raeburn 592: if (exists($env{'form.'.$auth})) {
593: my $default = $env{'form.'.$auth};
594: $default =~ s/^,+//;
595: $default =~ s/,+$//;
596: if ($auth =~ /^krb/) {
597: %{$email_defaults{$auth}} = ();
598: if ($default =~ /,/) {
599: my @items = split(/,/,$default);
600: foreach my $item (@items) {
601: my ($realm,$value) = split(/=/,$item);
602: $email_defaults{$auth}{$realm} = $value;
603: }
604: } else {
605: my ($realm,$value) = split(/=/,$default);
606: $email_defaults{$auth}{$realm} = $value;
607: }
608: } else {
609: $email_defaults{$auth} = $default;
610: }
611: }
1.1 raeburn 612: }
1.2 raeburn 613:
614: my $sender = &get_user_info($env{'user.name'},%email_defaults);
615:
1.1 raeburn 616: my %recipients = ();
1.2 raeburn 617: my %users = ();
618: my %access = ();
1.8 raeburn 619: my @sections = ();
1.2 raeburn 620: my $totalrecip = 0;
621: my @unmatched = ();
622: foreach my $role (@roles) {
623: %{$users{$role}} = ();
624: }
625: foreach my $type (@types) {
626: $access{$type} = $type;
627: }
628: foreach my $course_id (keys(%courses)) {
629: my ($cdom,$cnum) = split(/_/,$course_id);
1.8 raeburn 630: &Apache::loncommon::get_course_users($cdom,$cnum,\%access,\@roles,\@sections,\%users);
1.2 raeburn 631: }
632: foreach my $role (keys(%users)) {
633: foreach my $user (keys(%{$users{$role}})) {
634: unless (defined($recipients{$user})) {
635: $recipients{$user} = &get_user_info($user,%email_defaults);
636: if ($recipients{$user} eq '') {
637: push @unmatched, $user;
638: } else {
639: $totalrecip ++;
640: }
641: }
642: }
1.1 raeburn 643: }
1.8 raeburn 644: my $output = '<form name="'.$formname.'" method="post">'."\n";
1.2 raeburn 645:
646: if ($totalrecip > 0) {
647: $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
648: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Subject'));
649: $output .= ' <td><input type="text" name="subject" size="30" /></td>';
650: $output .= &Apache::lonhtmlcommon::row_closure();
651: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Message'));
652: $output .= ' <td><textarea name="message" id="message"
653: cols="60" rows="10" wrap="hard"></textarea></td>';
654: $output .= &Apache::lonhtmlcommon::row_closure();
655: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Recipients'));
656: $output .= '<td><input type="button" value="check all"
657: onclick="javascript:checkAll(document.compose.recipient)" />
658: <input type="button" value="uncheck all"
659: onclick="javascript:uncheckAll(document.compose.recipient)" />
660: <br /><table border="0">';
661: if (keys(%recipients) > 0) {
662: $output .= '<tr><td> </td><td><small><b>username:domain</b></small></td><td> </td><td><small><b>'.$lt{'emad'}.'</b></small></td></tr>';
663: }
664: foreach my $username (sort(keys(%recipients))) {
1.1 raeburn 665: if ($recipients{$username} =~ /\@/) {
666: my $value=&Apache::lonnet::escape($username).':'.&Apache::lonnet::escape($recipients{$username});
1.8 raeburn 667: $output .= '<tr><td><input type="checkbox" name="recipient" value="'.$value.'" /></td><td>'.$username.'</td><td> </td><td>'.$recipients{$username}.'</td></tr>';
1.1 raeburn 668: }
669: }
1.5 raeburn 670: $output .= '</table>';
671: if (@unmatched) {
672: $output .= '<br /><br />'.&mt('Could not determine e-mail addresses for the following users:').'<ul>';
673: foreach my $username (sort @unmatched) {
674: $output .= '<li>'.$username.'</li>';
675: }
676: $output .= '</ul>';
677: }
678: $output .= '</td>';
1.2 raeburn 679: $output .= &Apache::lonhtmlcommon::row_closure();
680: $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Sender e-mail address'));
681: $output .= '<td><input type="text" name="sender" value="'.$sender.'" /></td>';
682: $output .= &Apache::lonhtmlcommon::row_closure();
683: $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),'process',&mt('Send Message'));
684: $output .= &Apache::lonhtmlcommon::end_pick_box();
1.1 raeburn 685: } else {
1.8 raeburn 686: $output .= $lt{'nore'}."\n".
687: '<input type="hidden" name="command" value="" />'."\n";
1.1 raeburn 688: }
1.8 raeburn 689: $output .= '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
690: $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin','subject','message','recipient','sender'],);
1.2 raeburn 691: $output .= '</form></body></html>';
692: $r->print($output);
1.1 raeburn 693: return;
694: }
695:
696:
697: sub print_request_receipt {
1.8 raeburn 698: my ($r,$formname,$dom,$tablecolor,$bodytag,$html,$ltext) =@_;
1.2 raeburn 699: my @recipients = &Apache::loncommon::get_env_multiple('form.recipient');
1.1 raeburn 700: my $subject = $env{'form.subject'};
701: my $message = $env{'form.message'};
1.2 raeburn 702: my $from = $env{'form.sender'};
703: my $jscript = <<ENDSCRIPT;
1.8 raeburn 704: function goBack(target) {
705: document.$formname.command.value = target;
706: document.$formname.submit();
1.2 raeburn 707: }
708: ENDSCRIPT
709: &Apache::lonhtmlcommon::add_breadcrumb
1.8 raeburn 710: ({href=>"javascript:goBack('pick_target')",
1.2 raeburn 711: text=>"Select audience"});
712: &Apache::lonhtmlcommon::add_breadcrumb
1.8 raeburn 713: ({href=>"javascript:goBack('compose')",
1.2 raeburn 714: text=>"Compose Message"});
715: &Apache::lonhtmlcommon::add_breadcrumb
1.8 raeburn 716: ({href=>"/adm/notify?command=process",
1.2 raeburn 717: text=>"Outcome"});
1.1 raeburn 718: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
1.2 raeburn 719: (undef,'E-mail Delivery','Broadcast_system_email');
720: my $output = <<ENDONE;
1.1 raeburn 721: $html
722: <head>
723: <title>LON-CAPA Notification E-mail</title>
1.8 raeburn 724: <script type="text/javascript">
1.1 raeburn 725: $jscript
726: </script>
727: </head>
728: $bodytag
729: $breadcrumbs
1.2 raeburn 730: <br />
1.8 raeburn 731: <form name="$formname" method="post">
1.1 raeburn 732: ENDONE
1.2 raeburn 733: $output .= &Apache::lonhtmlcommon::start_pick_box();
734: my @deliveries = ();
735: &broadcast_email(\@recipients,$subject,$from,$message,\@deliveries);
736: if (@deliveries > 0) {
1.5 raeburn 737: &store_mail($subject,$message,$dom,\@deliveries);
1.2 raeburn 738: $output .= '<tr>
739: <td>
740: <table cellpadding="4" cellspacing="2" width="100%">
741: <tr bgcolor="'.$tablecolor.'" align="center">
742: <td><b>Status</b></td>
743: <td><b>Subject</b></td>
744: <td><b>Message</b></td>
745: <td><b>Recipients</b></td>
746: </tr>
747: <tr bgcolor="#eeeeee">
748: <td valign="middle">Sent</td>
1.5 raeburn 749: <td valign="middle">'.&cr_to_br($subject).'</td>
750: <td valign="middle">'.&cr_to_br($message).'</td>
1.2 raeburn 751: <td>';
752: foreach my $person (@deliveries) {
753: my ($username,$email) = split(/:/,$person);
754: $output .= &Apache::lonnet::unescape($email).' ('.&Apache::lonnet::unescape($username).')<br />'."\n";
755: }
756: $output .= '</td>
757: </tr>
758: </table>
759: </td>
760: </tr>';
761: &store_mail($subject,$message,$dom,\@deliveries);
762: } else {
763: $output .= 'No mail sent - no recipients identified';
1.1 raeburn 764: }
1.2 raeburn 765: $output .= &Apache::lonhtmlcommon::end_pick_box();
766: $output .= '<br /><a href="/adm/notify">Send another message?</a>'."\n";
1.8 raeburn 767: $output .= '<input type="hidden" name="command" />'."\n".
768: '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
769: $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin']);
1.2 raeburn 770: $output .= '
771: </form>
772: </body>
773: </html>';
774: $r->print($output);
1.1 raeburn 775: return;
776: }
777:
1.2 raeburn 778: sub broadcast_email {
779: my ($recipients,$subject,$from,$message,$deliveries,$ltext)=@_;
1.8 raeburn 780: # Should implement staggered delivery for large numbers of recipients?.
1.2 raeburn 781: foreach my $user (@{$recipients}) {
782: my $msg = new Mail::Send;
783: my ($username,$to) = split(/:/,$user);
784: $username = &Apache::lonnet::unescape($username);
785: $to = &Apache::lonnet::unescape($to);
786: $msg->to($to);
787: $msg->subject($subject);
788: $msg->add('From',"$from");
789: if (my $fh = $msg->open()) {
790: print $fh $message;
791: $fh->close;
792: push(@{$deliveries},$user);
793: }
794: }
795: }
796:
797: sub get_user_info {
1.5 raeburn 798: my ($user,%email_defaults) = @_;
1.2 raeburn 799: my ($uname,$udom) = split(/:/,$user);
800: my @emailtypes = ('permanentemail','critnotification','notification');
1.3 albertel 801: my %userinfo = &Apache::lonnet::get('environment',\@emailtypes,$udom,$uname);
1.2 raeburn 802: my $email = '';
803: foreach my $type (@emailtypes) {
804: $email = $userinfo{$type};
805: if ($email =~ /\@/) {
806: last;
807: }
808: }
809: if ($email eq '') {
810: my $authinfo = &Apache::lonnet::queryauthenticate($uname,$udom);
811: my ($authtype,$autharg) = split(/:/,$authinfo);
812: if ($authtype =~ /^krb/) {
813: if (defined($email_defaults{$authtype}{$autharg})) {
814: $email = $uname.'@'.$email_defaults{$authtype}{$autharg};
815: }
816: } else {
1.5 raeburn 817: if ((defined($email_defaults{$authtype})) && ($email_defaults{$authtype} ne '')) {
1.2 raeburn 818: $email = $uname.'@'.$email_defaults{$authtype};
819: }
820: }
821: }
822: return $email;
823: }
824:
825: sub form_elements {
826: my ($longtypes,$authtypes,$ltext) = @_;
827: %{$longtypes} = (
828: active => 'Currently has access',
829: previous => 'Previously had access',
830: future => 'Will have future access',
831: );
832: %{$authtypes} = (
833: krb4 => 'Kerberos 4',
834: krb5 => 'Kerberos 5',
1.5 raeburn 835: internal => 'Internal (LON-CAPA)',
1.2 raeburn 836: unix => 'Filesystem (UNIX)',
837: local => 'Local/Customized',
838: );
839: return;
840: }
841:
842: sub store_mail {
843: my ($subject,$message,$domain,$recipients,$attachmenturl,$ltext) = @_;
1.9 ! raeburn 844: my $msgid;
! 845: ($msgid,$message) = &packagemail($subject,$message,$domain,$recipients,
! 846: $attachmenturl);
! 847: # Store in dc email db files on primary library server for domain.
! 848: my $server = $Apache::lonnet::domain_primary{$domain};
! 849: if (defined($server)) {
! 850: unless (&Apache::lonnet::dcmailput($domain,$msgid,$message,$server)
! 851: eq 'ok') {
! 852: &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
! 853: $domain.' for server: '. $server.'. Message ID was '.$msgid);
1.4 raeburn 854: }
1.9 ! raeburn 855: } else {
! 856: &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
! 857: $domain.' as no primary server identified. Message ID was '.$msgid);
1.2 raeburn 858: }
859: }
860:
861: sub packagemail {
1.9 ! raeburn 862: my ($subject,$message,$dom,$recipients,$attachmenturl) = @_;
1.2 raeburn 863: my %record = ();
864: my $partsubj=$subject;
865: $partsubj=&Apache::lonnet::escape($partsubj);
866: $message =&HTML::Entities::encode($message,'<>&"');
867: $subject =&HTML::Entities::encode($subject,'<>&"');
868: #remove machine specification
869: $attachmenturl =~ s|^http://[^/]+/|/|;
870: $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
871: my $now=time;
872: my $msgid= &Apache::lonnet::escape($now).':'.$partsubj.':'.
873: &Apache::lonnet::escape($env{'user.name'}).':'.
874: &Apache::lonnet::escape($env{'user.domain'}).':'.
875: &Apache::lonnet::escape($dom).':'.$$;
876: my $result='<sendername>'.$env{'user.name'}.'</sendername>'.
877: '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
878: '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'.
879: '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
880: '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
881: '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
882: '<msgid>'.$msgid.'</msgid>'.
883: '<dcdomain>'.$dom.'</dcdomain>'.
884: '<subject>'.$subject.'</subject>'.
885: '<message>'.$message.'</message>'."\n";
886: if (defined($attachmenturl)) {
887: $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
888: }
889: foreach my $recip (@{$recipients}) {
890: my ($username,$email) = split(/:/,$recip);
891: $username = &Apache::lonnet::unescape($username);
892: $email = &Apache::lonnet::unescape($email);
1.9 ! raeburn 893: $username = &HTML::Entities::encode($username,'<>&"');
! 894: $email = &HTML::Entities::encode($email,'<>&"');
! 895: $result .= '<recipient username="'.$username.'">'.
1.2 raeburn 896: $email.'</recipient>';
897: }
1.9 ! raeburn 898: return ($msgid,$result);
1.2 raeburn 899: }
900:
901: sub unpackagemail {
902: my ($message,$notoken,$ltext)=@_;
903: my $parser=HTML::TokeParser->new(\$message);
904: my $token;
905: my %content=();
906: %{$content{recipients}} = ();
907: while ($token=$parser->get_token()) {
908: if ($token->[0] eq 'S') {
909: my $entry=$token->[1];
910: my $value=$parser->get_text('/'.$entry);
911: my ($username,$email);
912: if ($entry eq 'recipient') {
1.3 albertel 913: $username = $token->[2]{'username'};
1.2 raeburn 914: $username = &HTML::Entities::decode($username,'<>&"');
915: $content{recipients}{$username} =
916: &HTML::Entities::decode($value,'<>&"');
917: } elsif ($entry eq 'subject' || $entry eq 'message') {
918: $content{$entry}=&HTML::Entities::decode($value,'<>&"');
919: } else {
920: $content{$entry}=$value;
921: }
922: }
923: }
924: if ($content{'attachmenturl'}) {
925: my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
926: if ($notoken) {
927: $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>'; } else {
928: &Apache::lonnet::allowuploaded('/adm/notify',
929: $content{'attachmenturl'});
930: $content{'message'}.='<p>'.&mt('Attachment').
931: ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
932: $fname.'</tt></a>';
933: }
934: }
935: return %content;
936: }
937:
1.5 raeburn 938: sub cr_to_br {
939: my $incoming = shift;
940: $incoming =~ s/\n/\<br \/\>/g;
941: return $incoming;
942: }
943:
1.1 raeburn 944: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>