File:  [LON-CAPA] / loncom / interface / lonnotify.pm
Revision 1.5: download - view: text, annotated - select for diffs
Thu Oct 13 22:37:40 2005 UTC (18 years, 8 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Allow course owner to be selected as a role on 'Select audience' page.
Display users for whom e-mail addresses could not be identified on 'Compose Page'.
Convert returns to <br /> when displaying sent messages.

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

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