File:  [LON-CAPA] / loncom / interface / lonnotify.pm
Revision 1.2: download - view: text, annotated - select for diffs
Tue Oct 4 20:17:51 2005 UTC (18 years, 7 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Enhancement request 3339. Added ability to store e-mail broadcast to users, and to retrieve e-mail, flitered by time window and/or senders. Expanded use of breadcrumbs.  Improvements in display of e-mail receipt. Some work still required: add domain_roles_get() to lonnet; complete localization, complete work on breadcrumbs.

    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;
   34: use Mail::Send;
   35: use HTML::TokeParser;
   36: use HTML::Entities;
   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:     }
   46:     my $cdom = $env{'request.role.domain'};
   47:     unless (&Apache::lonnet::allowed('psa',$cdom)) {
   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: 
   53:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
   54:                                             ['command']);
   55:     my $command = $env{'form.command'};
   56:     &Apache::lonhtmlcommon::clear_breadcrumbs();
   57:     my %ltext=&Apache::lonlocal::texthash(
   58:                'note' => 'Notification E-mail',
   59:     );
   60:     my $function = &Apache::loncommon::get_users_function();
   61:     my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
   62:     my $bodytag = &Apache::loncommon::bodytag('Broadcast e-mail to users');
   63:     my $html=&Apache::lonxml::xmlbegin();
   64:     &Apache::lonhtmlcommon::add_breadcrumb
   65:         ({href=>'/adm/notify',
   66:           text=>"Broadcast E-mail"});
   67:     if ($command eq 'process') {
   68:         &print_request_receipt($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   69:     } elsif ($command eq 'compose') {
   70:         &print_composition_form($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   71:     } elsif ($command eq 'pick_target') {
   72:         &print_selection_form($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   73:     } elsif ($command eq 'pick_display') {
   74:         &print_display_option_form($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   75:     } elsif ($command eq 'display') {
   76:         &print_display($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   77:     } else {
   78:         &print_front_page($r,$cdom,$tablecolor,$bodytag,$html,\%ltext);
   79:     }
   80:     return OK;
   81: }
   82: 
   83: sub print_front_page {
   84:     my ($r,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
   85:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
   86:             (undef,'Broadcast e-mail to Domain','Broadcast_system_email');
   87:     my $jscript = qq|
   88: function next_page(caller) {
   89:     if (caller == 'view') {
   90:         document.front.command.value="pick_display"
   91:     }
   92:     else {
   93:         document.front.command.value="pick_target"
   94:     }
   95:     document.front.submit()
   96: }
   97:     |; 
   98:     my %lt=&Apache::lonlocal::texthash(
   99:                'note' => 'Notification E-mail',
  100:     );
  101:     my $output = <<"ENDONE";
  102: $html
  103: <head>
  104:  <title>LON-CAPA $lt{'note'}</title>
  105: <script type"text/javascript">
  106: $jscript
  107: </script>
  108: </head>
  109: $bodytag
  110: $breadcrumbs
  111: <br />
  112: ENDONE
  113:     $output .= '<form name="front" method="post">'.
  114:               '<input type="hidden" name="command" />';
  115:     $output .= &Apache::lonhtmlcommon::start_pick_box();
  116:     $output .= '<table cellspacing="8" cellpadding="8">'.
  117:               '<tr><td><a href="javascript:next_page('."'new'".')">'.
  118:               'Send a new e-mail message to selected users from this domain</a></td></tr><tr>'.
  119:               '<td><a href="javascript:next_page('."'view'".')">'.
  120:               'Display e-mail sent by Domain Coordinators in this domain'.
  121:               '</a></td></tr></table>';
  122:     $output .= &Apache::lonhtmlcommon::end_pick_box();
  123:     $output .= qq(
  124: </form>
  125: </body>
  126: </html>);
  127:     $r->print($output);
  128:     return;
  129: }
  130: 
  131: sub print_display_option_form {
  132:     my ($r,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
  133:     &Apache::lonhtmlcommon::add_breadcrumb
  134:          ({text=>"Display options"});
  135:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
  136:             (undef,'Broadcast e-mail display options','Broadcast_system_email');
  137:     my $table_width = '';
  138:     my $col_width = '200';
  139:     my $formname = 'display_options';
  140:     my $cmd = 'display';
  141:     my $submit_text = 'Display e-mail';
  142:     my @roles = ('dc');
  143:     my $now = time;
  144:     my %lt=&Apache::lonlocal::texthash(
  145:                'note' => 'Notification E-mail',
  146:     );
  147:     my $startdateform = &Apache::lonhtmlcommon::date_setter($formname,
  148:                                                             'startdate',
  149:                                                             $now);
  150:     my $enddateform = &Apache::lonhtmlcommon::date_setter($formname,
  151:                                                           'enddate',
  152:                                                           $now);
  153:     my $jscript;
  154:     my %totals = ();
  155:     my %personnel = ();
  156:     my $output = <<"ENDONE";
  157: $html
  158: <head>
  159:  <title>LON-CAPA $lt{'note'}</title>
  160: <script type"text/javascript">
  161: $jscript
  162: </script>
  163: </head>
  164: $bodytag
  165: $breadcrumbs
  166: <br />
  167: <form method="post" name="$formname">
  168: ENDONE
  169:     $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
  170:     $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Date range'));
  171:     $output .= '<td><table><tr><td>Earliest to display: </td><td>'.
  172:                 $startdateform.'</td></tr>';
  173:     $output .= '<tr><td>Latest to display: </td><td>'.$enddateform.
  174:                '</td></tr></table></td>';
  175:     $output .= &Apache::lonhtmlcommon::row_closure();
  176:     $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Choose sender(s)'));
  177: # FIXME - need to complete work on domain_roles_get
  178: #    &Apache::lonnet::domain_roles_get($cdom,\@roles,\%personnel,%totals);
  179:     $output .= '<td>';
  180:     if ($totals{'dc'} > 0) {
  181:         foreach my $user (sort(keys(%{$personnel{'dc'}}))) {
  182:             my ($uname,$udom) = split(/:/,$user);
  183:             my %userinfo = &Apache::lonnet::get('environment',['lastname','firstname'],$udom,$uname);
  184:             $output .= '<input type="checkbox" name="sender" value="'.$user.'" />&nbsp;'.$userinfo{firstname}.' '.$userinfo{lastname}.'&nbsp;&nbsp;('.$user.')';
  185:         }
  186:     }
  187:     $output .= '</td>';
  188:     $output .= &Apache::lonhtmlcommon::row_closure();
  189:     $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),$cmd,$submit_text);
  190:     $output .= &Apache::lonhtmlcommon::end_pick_box();
  191:     $output .= qq(
  192: <input type="hidden" name="sortby" value="date" />
  193: </form>
  194: </body>
  195: </html>);
  196:     $r->print($output);
  197:     return;
  198: }
  199: 
  200: sub print_display {
  201:     my ($r,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
  202:     &Apache::lonhtmlcommon::add_breadcrumb
  203:          ({href=>'/adm/notify?command=pick_display',
  204:           text=>"Display options"},
  205:          {text=>"E-mail display"});
  206:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
  207:             (undef,'Display Broadcast e-mail','Broadcast_system_email');
  208:     my $table_width = '';
  209:     my $col_width = '200';
  210:     my $rowColor1 = "#ffffff";
  211:     my $rowColor2 = "#eeeeee";
  212:     my $rowColor;
  213:     my $msgcount = 0;
  214:     my $formname = 'display_sent';
  215:     my $start = &Apache::lonhtmlcommon::get_date_from_form('startdate');
  216:     my $end = &Apache::lonhtmlcommon::get_date_from_form('enddate');
  217:     my @senders = &Apache::loncommon::get_env_multiple('form.sender');
  218:     my $senderlist = join('&',@senders); 
  219:     my %sentmail = &Apache::lonnet::dcmaildump($cdom,$start,$end,$senderlist);
  220:     my %dcmail = ();
  221:     my %Sortby = ();
  222:     my $jscript = <<"ENDSCRIPT";
  223: function changeSort(caller) {
  224:     document.$formname.sortby.value = caller;
  225:     document.$formname.submit();   
  226: }
  227: ENDSCRIPT
  228:     my $output = <<"ENDONE";
  229: $html
  230: <head>
  231:  <title>LON-CAPA $$ltext{'note'}</title>
  232:  <script type"text/javascript">
  233: $jscript
  234:  </script>
  235: </head>
  236: $bodytag
  237: $breadcrumbs
  238: <br />
  239: <form method="post" name="$formname">
  240: ENDONE
  241: 
  242:     foreach my $server (keys(%sentmail)) {
  243:         foreach my $msgid (keys(%{$sentmail{$server}})) {
  244:             my %content = &unpackagemail($sentmail{$server}{$msgid});
  245:             if (defined($dcmail{$msgid})) {
  246:                 foreach my $user (keys(%{$content{'recipients'}})) {
  247:                     $dcmail{$msgid}{recipients}{$user} = $content{recipients}{$user};
  248:                 }
  249:             } else {
  250:                 $msgcount ++;
  251:                 %{$dcmail{$msgid}} = ();
  252:                 foreach my $item (keys(%content)) {
  253:                     if ($item eq 'recipients') {
  254:                         foreach my $user (keys(%{$content{recipients}})) {
  255:                             $dcmail{$msgid}{recipients}{$user} = $content{recipients}{$user};
  256:                         }
  257:                     } else {
  258:                         $dcmail{$msgid}{$item} = $content{$item};
  259:                     }
  260:                 }
  261:             }
  262:         }
  263:     }
  264:     $output .= &Apache::lonhtmlcommon::start_pick_box();
  265:     if ($msgcount > 0) {
  266:         my $rowNum = 0;
  267:         $output .= '<tr><td><table cellpadding="4" cellspacing="2" width="100%">
  268:                    <tr bgcolor="'.$tablecolor.'" align="center">
  269:                    <td><b><a href="javascript:changeSort('."'date'".')">Date</a></b></td>
  270:                    <td><b><a href="javascript:changeSort('."'subject'".')">Subject</a></b></td>
  271:                    <td><b><a href="javascript:changeSort('."'sender'".')">Sender</a></b></td>
  272:                    <td><b><a href="javascript:changeSort('."'message'".')">Message</a></b></td>
  273:                    <td><b><a href="javascript:changeSort('."'recipients'".')">Recipients</a></b></td>
  274:                    </tr>';
  275:         if (($env{'form.sortby'} eq 'date') || ($env{'form.sortby'} eq '') || (!defined($env{'form.sortby'})) || (($env{'form.sortby'} eq 'sender') && (@senders <= 1))) {
  276:             foreach my $msgid (sort(keys(%dcmail))) {
  277:                 if ($rowNum %2 == 1) {
  278:                     $rowColor = $rowColor1;
  279:                 } else {
  280:                     $rowColor = $rowColor2;
  281:                 }
  282:                 my $recipients = '';
  283:                 my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
  284:                 $date = &Apache::lonlocal::locallocaltime($date);
  285:                 foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
  286:                     $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
  287:                 }
  288:                 $recipients =~ s/,\s$//;
  289:                 $output .= '<tr bgcolor="'.$rowColor.'"><td><small>'.$date.'</small></td><td><small>'.$dcmail{$msgid}{subject}.'</small></td><td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.$dcmail{$msgid}{message}.'</small></td><td><small>'.$recipients.'</small></td></tr>'."\n";
  290:                 $rowNum ++;
  291:             }
  292:         } else {
  293:             foreach my $msgid (sort(keys(%dcmail))) {
  294:                 my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
  295:                 if ($env{'form.sortby'} eq 'subject') {
  296:                     push @{$Sortby{$dcmail{$msgid}{subject}}},$msgid;
  297:                 } elsif ($env{'form.sortby'} eq 'message') {
  298:                     push @{$Sortby{$dcmail{$msgid}{message}}},$msgid;
  299:                 } elsif ($env{'form.sortby'} eq 'recipients') {
  300:                     my $recipients ='';
  301:                     foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
  302:                         $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
  303:                     }
  304:                     $recipients =~ s/,\s$//;
  305:                     push @{$Sortby{$recipients}},$msgid;
  306:                 } elsif ($env{'form.sortby'} eq 'sender') {
  307:                     if (@senders > 1) {
  308:                        push @{$Sortby{$sname.':'.$sdom}},$msgid;
  309:                     }
  310:                 }
  311:             }
  312:             foreach my $key (sort(keys(%Sortby))) {
  313:                 foreach my $msgid (@{$Sortby{$key}}) {
  314:                     if ($rowNum %2 == 1) {
  315:                         $rowColor = $rowColor1;
  316:                     } else {
  317:                         $rowColor = $rowColor2;
  318:                     }
  319:                     my $recipients = '';
  320:                     if ($env{'form.sortby'} eq 'recipients') {
  321:                         $recipients = $key;
  322:                     } else {
  323:                         foreach my $user (sort(keys(%{$dcmail{$msgid}{recipients}}))) {
  324:                             $recipients .= $dcmail{$msgid}{recipients}{$user}.', ';
  325:                         }
  326:                         $recipients =~ s/,\s$//;
  327:                     }
  328:                     my ($date,$subj,$sname,$sdom,$cdom) = split(/:/,$msgid,5);
  329:                     $date = &Apache::lonlocal::locallocaltime($date);
  330:                     $output .=  '<tr bgcolor="'.$rowColor.'"><td><small>'.$date.'</small></td><td><small>'.$dcmail{$msgid}{subject}.'</small></td><td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.$dcmail{$msgid}{message}.'</small></td><td><small>'.$recipients.'</small></td></tr>'."\n";
  331:                     $rowNum ++;
  332:                 }
  333:             }
  334:         }
  335:         $output .= '</table></td></tr>';
  336:     } else {
  337:         $output .= '<tr bgcolor="#ffffff"><td>&nbsp;</td><td><br><center><i><b><small>&nbsp;&nbsp;No mail sent matching supplied criteria&nbsp;&nbsp;</small><br><br></b></i></td><td>&nbsp;</td></tr>';
  338:     }
  339:     $output .= &Apache::lonhtmlcommon::end_pick_box();
  340:     $output .= &echo_form_input();
  341:     unless (defined($env{'form.sortby'})) {
  342:         $output .= qq(<input type="hidden" name="sortby" value="date" />\n);
  343:     } 
  344:     $output .= qq(
  345: </form>
  346: </body>
  347: </html>);
  348:     $r->print($output);
  349:     return;
  350: }
  351: 
  352: sub print_selection_form {
  353:     my ($r,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
  354:     my %coursecodes = ();
  355:     my %codes = ();
  356:     my @codetitles = ();
  357:     my %cat_titles = ();
  358:     my %cat_order = ();
  359:     my %idlist = ();
  360:     my %idnums = ();
  361:     my %idlist_titles = ();
  362:     my $caller = 'global';
  363:     my $totcodes = 0;
  364:     my $format_reply;
  365:     my $jscript = '';
  366:     my $formname = 'rolefilter';
  367:     my $table_width = '100%';
  368:     my $col_width = '200';
  369:     my %lt=&Apache::lonlocal::texthash(
  370:                'note' => 'Notification E-mail', 
  371:                'buil' => 'Building valid e-mail address from username, if missing from preferences:',
  372:                'kerb' => 'Kerberos: enter default for each realm used in the domain, with comma separation of entries',
  373:                'infs' => 'Internal, Filesystem and Local authentication: enter single default.',
  374:                'comp' => 'Compose Message'
  375:            );
  376:     my $loaditems = qq|
  377: function initialize_codes() {
  378:     return;
  379: }
  380:     |;
  381:     &Apache::lonhtmlcommon::add_breadcrumb
  382:           ({text=>"Select Audience"});
  383: 
  384:     $totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$cdom,$totcodes);
  385:     if ($totcodes > 0) {
  386:         $format_reply = &Apache::lonnet::auto_instcode_format($caller,$cdom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
  387:         if ($format_reply eq 'ok') {
  388:             my $numtypes = @codetitles;
  389:             &Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
  390:             &Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
  391:             $loaditems = '';
  392:         }
  393:     }
  394: 
  395:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
  396:             (undef,'Choose e-mail audience','Broadcast_system_email');
  397:     my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($cdom,$cdom);
  398:     my $output = <<"ENDONE";
  399: $html
  400: <head>
  401:  <title>LON-CAPA $lt{'note'}</title>
  402: <script type"text/javascript">
  403: $jscript
  404: </script>
  405: $cb_jscript
  406: </head>
  407: $bodytag
  408: $breadcrumbs
  409: <br />
  410: <form method="post" name="$formname">
  411: ENDONE
  412:    $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
  413:    my @roles = ('cc','in','ta','ep','ad','st','cr');
  414:    my %longtypes = ();
  415:    my %authtypes = ();
  416:    &form_elements(\%longtypes,\%authtypes);
  417:    my $descrip = $lt{'buil'}.' 
  418: <ul>
  419: <li>'.$lt{'kerb'}.'<br />(e.g., MSU.EDU=msu.edu, MSUE.EDU=msue.msu.edu).</li>
  420: <li>'.$lt{'infs'}.'</li>
  421: </ul>'."\n";
  422:    my $submit_text = $lt{'comp'};
  423:    my $cmd = 'compose';
  424:    $output .= &Apache::lonhtmlcommon::role_select_row(\@roles,$col_width,$tablecolor,'Roles');
  425:    $output .= &Apache::lonhtmlcommon::course_select_row($col_width,$tablecolor,'Courses',$formname,$totcodes,\@codetitles,\%idlist,\%idlist_titles);
  426:    $output .= &Apache::lonhtmlcommon::status_select_row(\%longtypes,$col_width,$tablecolor,&mt('Access status'));
  427:    $output .= &Apache::lonhtmlcommon::email_default_row(\%authtypes,$col_width,$tablecolor,&mt('Username -> Email conversion'),$descrip);
  428:    $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),$cmd,$submit_text);
  429:    $output .= &Apache::lonhtmlcommon::end_pick_box();
  430:    $output .= qq(
  431: </form>
  432: </body>
  433: </html>);
  434:     $r->print($output);
  435:     return;
  436: }
  437: 
  438: sub print_composition_form {
  439:     my ($r,$cdom,$tablecolor,$bodytag,$html,$ltext) = @_;
  440:     &Apache::lonhtmlcommon::add_breadcrumb
  441:         ({href=>'/adm/notify?command=pick_target',
  442:           text=>"Select Audience"},
  443:          {text=>"Compose Message"});
  444:     my $jscript = &Apache::loncommon::check_uncheck_jscript();
  445:     my $breadcrumbs = (&Apache::lonhtmlcommon::breadcrumbs
  446:         (undef,'Broadcast e-mail to users','Broadcast_system_email'));
  447: 
  448:     my %lt=&Apache::lonlocal::texthash(
  449:                       'note' => 'Notification E-mail',
  450:                       'nore' => 'No recipients identified',
  451:                       'emad' => 'e-mail address',
  452:                    );
  453:     $r->print(<<ENDONE);
  454: $html
  455: <head>
  456:  <title>LON-CAPA $lt{'note'}</title>
  457: <script type"text/javascript">
  458: $jscript
  459: </script>
  460: </head>
  461: $bodytag $breadcrumbs
  462: <br /> 
  463: ENDONE
  464:     my $coursefilter = $env{'form.coursepick'};
  465:     my %courses = ();
  466:     if ($coursefilter eq 'all') {
  467:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.','.','.','.');
  468:     } elsif ($coursefilter eq 'category') {
  469:         my $instcode = '';
  470:         my @cats = ('Semester','Year','Department','Number');
  471:         foreach my $category (@cats) {
  472:             if (defined($env{'form.'.$category})) {
  473:                 unless ($env{'form.'.$category} eq '-1') {
  474:                     $instcode .= $env{'form.'.$category};
  475:                 }
  476:             }
  477:         }
  478:         if ($instcode eq '') {
  479:             $instcode = '.';
  480:         }
  481:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.',$instcode,'.','.');
  482:     } elsif ($coursefilter eq 'specific') {
  483:         if ($env{'form.coursetotal'} > 1) {
  484:             my @course_ids = split(/&&/,$env{'form.courselist'});
  485:             foreach (@course_ids) {
  486:                 $courses{$_} = '';
  487:             }
  488:         } else {
  489:             $courses{$env{'form.courselist'}} = '';
  490:         }
  491:     }
  492: 
  493:     my @types = &Apache::loncommon::get_env_multiple('form.types');
  494:     my @roles = &Apache::loncommon::get_env_multiple('form.roles');
  495: 
  496:     my %longtypes = ();
  497:     my %authtypes = ();
  498:     my %email_defaults = ();
  499:     my $table_width = '100%';
  500:     my $col_width = '200';
  501: 
  502:     &form_elements(\%longtypes,\%authtypes);
  503:     foreach my $auth (%authtypes) {
  504:         if (exists($env{'form.'.$auth})) {
  505:              my $default = $env{'form.'.$auth};
  506:              $default =~ s/^,+//;
  507:              $default =~ s/,+$//;
  508:              if ($auth =~ /^krb/) {
  509:                  %{$email_defaults{$auth}} = ();
  510:                  if ($default =~ /,/) {
  511:                      my @items = split(/,/,$default);
  512:                      foreach my $item (@items) {
  513:                          my ($realm,$value) = split(/=/,$item);
  514:                          $email_defaults{$auth}{$realm} = $value;
  515:                      }
  516:                  } else {
  517:                      my ($realm,$value) = split(/=/,$default);
  518:                      $email_defaults{$auth}{$realm} = $value;
  519:                  }
  520:              } else {
  521:                  $email_defaults{$auth} = $default;
  522:              }
  523:          }
  524:     }
  525: 
  526:     my $sender = &get_user_info($env{'user.name'},%email_defaults);
  527: 
  528:     my %recipients = ();
  529:     my %users = ();
  530:     my %access = ();
  531:     my $totalrecip = 0;
  532:     my @unmatched = ();
  533:     foreach my $role (@roles) {
  534:         %{$users{$role}} = ();
  535:     }
  536:     foreach my $type (@types) {
  537:         $access{$type} = $type;
  538:     }
  539:     foreach my $course_id (keys(%courses)) {
  540:         my ($cdom,$cnum) = split(/_/,$course_id);
  541:         &Apache::loncommon::get_course_users($cdom,$cnum,\%access,\@roles,\%users);
  542:     }
  543:     foreach my $role (keys(%users)) {
  544:         foreach my $user (keys(%{$users{$role}})) {
  545:             unless (defined($recipients{$user})) {
  546:                 $recipients{$user} = &get_user_info($user,%email_defaults);
  547:                 if ($recipients{$user} eq '') {
  548:                     push @unmatched, $user;
  549:                 } else {
  550:                     $totalrecip ++;
  551:                 } 
  552:             }
  553:         }
  554:     }
  555:     my $output  = '<form name="compose" method="post">'."\n";
  556:   
  557:     if ($totalrecip > 0) {
  558:         $output .= &Apache::lonhtmlcommon::start_pick_box($table_width);
  559:         $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Subject'));
  560:         $output .= ' <td><input type="text" name="subject" size="30" /></td>';
  561:         $output .= &Apache::lonhtmlcommon::row_closure();
  562:         $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Message'));
  563:         $output .= '  <td><textarea name="message" id="message"
  564:                       cols="60" rows="10" wrap="hard"></textarea></td>';
  565:         $output .= &Apache::lonhtmlcommon::row_closure();
  566:         $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Recipients'));
  567:         $output .= '<td><input type="button" value="check all" 
  568:                     onclick="javascript:checkAll(document.compose.recipient)" />
  569:                     &nbsp;&nbsp;<input type="button" value="uncheck all"
  570:                     onclick="javascript:uncheckAll(document.compose.recipient)" />
  571:                     <br /><table border="0">';
  572:         if (keys(%recipients) > 0) {
  573:             $output .= '<tr><td>&nbsp;</td><td><small><b>username:domain</b></small></td><td>&nbsp;&nbsp;</td><td><small><b>'.$lt{'emad'}.'</b></small></td></tr>';
  574:         }
  575:         foreach my $username (sort(keys(%recipients))) {
  576:             if ($recipients{$username} =~ /\@/) {
  577:                 my $value=&Apache::lonnet::escape($username).':'.&Apache::lonnet::escape($recipients{$username});
  578:                 $output .= '<tr><td><input type="checkbox" name="recipient" value="'.$value.'" checked="checked" /></td><td>'.$username.'</td><td>&nbsp;&nbsp;</td><td>'.$recipients{$username}.'</td></tr>';
  579:             }
  580:         }
  581:         $output .= '</table></td>';
  582:         $output .= &Apache::lonhtmlcommon::row_closure();
  583:         $output .= &Apache::lonhtmlcommon::row_title($col_width,$tablecolor,&mt('Sender e-mail address'));
  584:         $output .= '<td><input type="text" name="sender" value="'.$sender.'" /></td>';
  585:         $output .= &Apache::lonhtmlcommon::row_closure();
  586:         $output .= &Apache::lonhtmlcommon::submit_row($col_width,$tablecolor,&mt('Submit'),'process',&mt('Send Message'));
  587:         $output .= &Apache::lonhtmlcommon::end_pick_box();
  588:     } else {
  589:         $output .= $lt{'nore'};
  590:     }
  591:     $output .= &echo_form_input('command');
  592:     $output .= '</form></body></html>';
  593:     $r->print($output);
  594:     return;
  595: }
  596: 
  597: 
  598: sub print_request_receipt {
  599:     my ($r,$dom,$tablecolor,$bodytag,$html,$ltext) =@_;
  600:     my @recipients = &Apache::loncommon::get_env_multiple('form.recipient');
  601:     my $subject = $env{'form.subject'};
  602:     my $message = $env{'form.message'};
  603:     my $from = $env{'form.sender'};
  604:     my $jscript = <<ENDSCRIPT;
  605: function showCompose() {
  606:     document.goback.command.value = 'compose';
  607:     document.goback.submit();
  608: }
  609: ENDSCRIPT
  610:     &Apache::lonhtmlcommon::add_breadcrumb
  611:         ({href=>'/adm/notify?command=pick_target',
  612:           text=>"Select audience"});
  613:     &Apache::lonhtmlcommon::add_breadcrumb
  614:         ({href=>'javascript:showCompose()',
  615:           text=>"Compose Message"});
  616:     &Apache::lonhtmlcommon::add_breadcrumb
  617:         ({href=>'/adm/notify?command=process',
  618:           text=>"Outcome"});
  619:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs
  620:             (undef,'E-mail Delivery','Broadcast_system_email');
  621:     my $output = <<ENDONE;
  622: $html
  623: <head>
  624:  <title>LON-CAPA Notification E-mail</title>
  625: <script type"text/javascript">
  626: $jscript
  627: </script>
  628: </head>
  629: $bodytag
  630: $breadcrumbs
  631: <br />
  632: <form name="goback" method="post">
  633: ENDONE
  634:     $output .= &Apache::lonhtmlcommon::start_pick_box();
  635:     my @deliveries = ();
  636:     &broadcast_email(\@recipients,$subject,$from,$message,\@deliveries);
  637:     if (@deliveries > 0) {
  638:         $output .= '<tr>
  639:                      <td>
  640:                       <table cellpadding="4" cellspacing="2" width="100%">
  641:                        <tr bgcolor="'.$tablecolor.'" align="center">
  642:                         <td><b>Status</b></td>
  643:                         <td><b>Subject</b></td>
  644:                         <td><b>Message</b></td>
  645:                         <td><b>Recipients</b></td>
  646:                        </tr>
  647:                        <tr bgcolor="#eeeeee">
  648:                         <td valign="middle">Sent</td>
  649:                         <td valign="middle">'.$subject.'</td>
  650:                         <td valign="middle">'.$message.'</td>
  651:                         <td>';
  652:         foreach my $person (@deliveries) {
  653:             my ($username,$email) = split(/:/,$person);
  654:             $output .= &Apache::lonnet::unescape($email).'&nbsp;('.&Apache::lonnet::unescape($username).')<br />'."\n";
  655:         }
  656:         $output .= '</td>
  657:                    </tr>
  658:                   </table>
  659:                  </td>
  660:                 </tr>';
  661:         &store_mail($subject,$message,$dom,\@deliveries);
  662:     } else {
  663:         $output .= 'No mail sent - no recipients identified'; 
  664:     }
  665:     $output .= &Apache::lonhtmlcommon::end_pick_box();
  666:     $output .= '<br /><a href="/adm/notify">Send another message?</a>'."\n";
  667:     $output .= &echo_form_input();
  668:     $output .= '
  669: </form>
  670: </body>
  671: </html>';
  672:     $r->print($output);
  673:     return;
  674: }
  675: 
  676: sub broadcast_email {
  677:     my ($recipients,$subject,$from,$message,$deliveries,$ltext)=@_;
  678: # find some way to spread out delivery for large numbers of recipients.
  679:     foreach my $user (@{$recipients}) {
  680:         my $msg = new Mail::Send;
  681:         my ($username,$to) = split(/:/,$user);
  682:         $username = &Apache::lonnet::unescape($username);
  683:         $to = &Apache::lonnet::unescape($to);
  684:         $msg->to($to);
  685:         $msg->subject($subject);
  686:         $msg->add('From',"$from");
  687:         if (my $fh = $msg->open()) {
  688:             print $fh $message;
  689:             $fh->close;
  690:             push(@{$deliveries},$user); 
  691:         }
  692:     }
  693: }
  694: 
  695: sub get_user_info {
  696:     my ($user,%email_defaults,$ltext) = @_;
  697:     my ($uname,$udom) = split(/:/,$user);
  698:     my %userinfo = &Apache::lonnet::get('environment',['permanenetemail','notification','critnotification',],$udom,$uname);
  699:     my @emailtypes = ('permanentemail','critnotification','notification');
  700:     my $email = '';
  701:     foreach my $type (@emailtypes) {
  702:         $email = $userinfo{$type};
  703:         if ($email =~ /\@/) {
  704:             last;
  705:         }
  706:     }
  707:     if ($email eq '') {
  708:         my $authinfo  = &Apache::lonnet::queryauthenticate($uname,$udom);
  709:         my ($authtype,$autharg) = split(/:/,$authinfo);
  710:         if ($authtype =~ /^krb/) {
  711:             if (defined($email_defaults{$authtype}{$autharg})) {
  712:                 $email = $uname.'@'.$email_defaults{$authtype}{$autharg};
  713:             }
  714:         } else {
  715:             if (defined($email_defaults{$authtype})) {
  716:                 $email = $uname.'@'.$email_defaults{$authtype};
  717:             }
  718:         }
  719:     }
  720:     return $email;
  721: }
  722: 
  723: sub form_elements {
  724:    my ($longtypes,$authtypes,$ltext) = @_;
  725:    %{$longtypes} = (
  726:                    active => 'Currently has access',
  727:                    previous => 'Previously had access',
  728:                    future => 'Will have future access',
  729:                    );
  730:    %{$authtypes} = (
  731:                    krb4 => 'Kerberos 4',
  732:                    krb5 => 'Kerberos 5',
  733:                    int => 'Internal (LON-CAPA)',
  734:                    unix => 'Filesystem (UNIX)',
  735:                    local => 'Local/Customized',
  736:                    );
  737:    return;
  738: }
  739: 
  740: sub store_mail {
  741:     my ($subject,$message,$domain,$recipients,$attachmenturl,$ltext) = @_;
  742:     my %status = ();
  743:     my %servers = ();
  744:     my $msgid=&packagemail($subject,$message,$domain,
  745:                            $recipients,\%servers,$attachmenturl);
  746: # Store in dc email db files on appropriate servers.
  747:     foreach my $server (keys(%servers)) {
  748: # FIXME This needs to be via a subroutine in lonnet
  749:         $status{$server} = &Apache::lonnet::critical(
  750:            'dcmailput:'.$domain.':'.&Apache::lonnet::escape($msgid).'='.
  751:            &Apache::lonnet::escape($servers{$server}),$server);
  752:     }
  753: }
  754: 
  755: sub packagemail {
  756:     my ($subject,$message,$dom,$recipients,$servers,$attachmenturl,$ltext) = @_;
  757:     my %record = ();
  758:     my $partsubj=$subject;
  759:     $partsubj=&Apache::lonnet::escape($partsubj);
  760:     $message =&HTML::Entities::encode($message,'<>&"');
  761:     $subject =&HTML::Entities::encode($subject,'<>&"');
  762:     #remove machine specification
  763:     $attachmenturl =~ s|^http://[^/]+/|/|;
  764:     $attachmenturl =&HTML::Entities::encode($attachmenturl,'<>&"');
  765:     my $now=time;
  766:     my $msgid= &Apache::lonnet::escape($now).':'.$partsubj.':'.
  767:            &Apache::lonnet::escape($env{'user.name'}).':'.
  768:            &Apache::lonnet::escape($env{'user.domain'}).':'.
  769:            &Apache::lonnet::escape($dom).':'.$$;
  770:     my $result='<sendername>'.$env{'user.name'}.'</sendername>'.
  771:            '<senderdomain>'.$env{'user.domain'}.'</senderdomain>'.
  772:            '<time>'.&Apache::lonlocal::locallocaltime($now).'</time>'.
  773:            '<servername>'.$ENV{'SERVER_NAME'}.'</servername>'.
  774:            '<host>'.$ENV{'HTTP_HOST'}.'</host>'.
  775:            '<client>'.$ENV{'REMOTE_ADDR'}.'</client>'.
  776:            '<msgid>'.$msgid.'</msgid>'.
  777:            '<dcdomain>'.$dom.'</dcdomain>'.
  778:            '<subject>'.$subject.'</subject>'.
  779:            '<message>'.$message.'</message>'."\n";
  780:     if (defined($attachmenturl)) {
  781:         $result.= '<attachmenturl>'.$attachmenturl.'</attachmenturl>';
  782:     }
  783:     foreach my $recip (@{$recipients}) {
  784:         my ($username,$email) = split(/:/,$recip);
  785:         $username = &Apache::lonnet::unescape($username);
  786:         $email = &Apache::lonnet::unescape($email);
  787:         my ($uname,$udom) = split(/:/,$username);
  788:         my $uhom=&Apache::lonnet::homeserver($uname,$udom);
  789:         if ($uhom ne 'no_host') {
  790:             $username = &HTML::Entities::encode($username,'<>&"');
  791:             $email = &HTML::Entities::encode($email,'<>&"');
  792:             $record{$uhom} .= '<recipient username="'.$username.'">'.
  793:                               $email.'</recipient>';
  794:         }
  795:     }
  796:     foreach my $server (keys(%record)) {
  797:         $$servers{$server} = $result.$record{$server};
  798:     }
  799:     return $msgid;
  800: }
  801: 
  802: sub unpackagemail {
  803:     my ($message,$notoken,$ltext)=@_;
  804:     my $parser=HTML::TokeParser->new(\$message);
  805:     my $token;
  806:     my %content=();
  807:     %{$content{recipients}} = ();
  808:     while ($token=$parser->get_token()) {
  809:         if ($token->[0] eq 'S') {
  810:             my $entry=$token->[1];
  811:             my $value=$parser->get_text('/'.$entry);
  812:             my ($username,$email);
  813:             if ($entry eq 'recipient') {
  814:                 my $attr = $token->[2];
  815:                 $username = $$attr{'username'};
  816:                 $username = &HTML::Entities::decode($username,'<>&"');
  817:                 $content{recipients}{$username} = 
  818:                       &HTML::Entities::decode($value,'<>&"');
  819:             } elsif ($entry eq 'subject' || $entry eq 'message') {
  820:                 $content{$entry}=&HTML::Entities::decode($value,'<>&"');
  821:             } else {
  822:                 $content{$entry}=$value;
  823:             }
  824:         }
  825:     }
  826:     if ($content{'attachmenturl'}) {
  827:         my ($fname)=($content{'attachmenturl'}=~m|/([^/]+)$|);
  828:         if ($notoken) {
  829:             $content{'message'}.='<p>'.&mt('Attachment').': <tt>'.$fname.'</tt>';       } else {
  830:             &Apache::lonnet::allowuploaded('/adm/notify',
  831:                                           $content{'attachmenturl'});
  832:             $content{'message'}.='<p>'.&mt('Attachment').
  833:                ': <a href="'.$content{'attachmenturl'}.'"><tt>'.
  834:                $fname.'</tt></a>';
  835:         }
  836:     }
  837:     return %content;
  838: }
  839: 
  840: sub echo_form_input {
  841:     my (@excluded) = @_;
  842:     my $output = '';
  843:     foreach my $key (keys(%env)) {
  844:         if ($key =~ /^form\.(.+)$/) {
  845:             if ((!@excluded) || (!grep/^$1$/,@excluded)) {
  846:                 if (ref($env{$key})) {
  847:                     foreach my $value (@{$env{$key}}) {
  848:                         $output .= qq(<input type="hidden" name="$1" value="$value" />\n);
  849:                     }
  850:                 } else {
  851:                     $output .= qq(<input type="hidden" name="$1" value="$env{$key}" />\n);
  852:                 }
  853:             }
  854:         }
  855:     }
  856:     return $output;
  857: }
  858: 
  859: 1;

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