Annotation of loncom/interface/lonnotify.pm, revision 1.22

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.19      www        37: use lib '/home/httpd/lib/perl/';
                     38: use LONCAPA;
1.1       raeburn    39: 
                     40: sub handler {
                     41:     my ($r) = @_;
                     42:     &Apache::loncommon::content_type($r,'text/html');
                     43:     $r->send_http_header;
                     44: 
                     45:     if ($r->header_only) {
                     46:         return OK;
                     47:     }
1.2       raeburn    48:     my $cdom = $env{'request.role.domain'};
                     49:     unless (&Apache::lonnet::allowed('psa',$cdom)) {
1.1       raeburn    50:         # Not allowed to broadcast e-mail system-wide 
                     51:         $env{'user.error.msg'}="/adm/notify:psa:0:0:Cannot broadcast e-mail systemwide";
                     52:         return HTTP_NOT_ACCEPTABLE;
                     53:     }
                     54: 
1.2       raeburn    55:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
                     56:                                             ['command']);
1.1       raeburn    57:     my $command = $env{'form.command'};
1.8       raeburn    58:     my $origin = $env{'form.origin'};
                     59: 
1.1       raeburn    60:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.12      albertel   61: 
1.1       raeburn    62:     &Apache::lonhtmlcommon::add_breadcrumb
                     63:         ({href=>'/adm/notify',
1.2       raeburn    64:           text=>"Broadcast E-mail"});
1.1       raeburn    65:     if ($command eq 'process') {
1.20      albertel   66:         &print_request_receipt($r,$command,$cdom);
1.1       raeburn    67:     } elsif ($command eq 'compose') {
1.20      albertel   68:         &print_composition_form($r,$command,$cdom);
1.2       raeburn    69:     } elsif ($command eq 'pick_target') {
1.20      albertel   70:         &print_selection_form($r,$command,$cdom);
1.2       raeburn    71:     } elsif ($command eq 'pick_display') {
1.20      albertel   72:         &print_display_option_form($r,$command,$cdom);
1.2       raeburn    73:     } elsif ($command eq 'display') {
1.20      albertel   74:         &print_display($r,$command,$cdom);
1.1       raeburn    75:     } else {
1.20      albertel   76:         &print_front_page($r,'front',$cdom);
1.1       raeburn    77:     }
                     78:     return OK;
                     79: }
                     80: 
1.12      albertel   81: sub add_script {
                     82:     my ($js) = @_;
                     83:     return '<script type="text/javascript">'."\n".$js."\n".'</script>';
                     84: }
                     85: 
                     86: sub start_page {
1.14      albertel   87:     my ($jscript,$bread_title,$formname) = @_;
1.12      albertel   88: 
1.14      albertel   89:     my $loadcode;
                     90:     if ((defined($env{'form.origin'})) 
                     91: 	&& ($env{'form.command'} eq 'compose' 
                     92: 	    || $env{'form.command'} eq 'pick_target' 
                     93: 	    || $env{'form.command'} eq 'pick_display')) {
                     94:         if ($env{'form.origin'} ne '') {
                     95:             $loadcode = 'javascript:setFormElements(document.'.$env{'form.command'}.')';
                     96:             if (($env{'form.command'} eq 'pick_target') 
                     97: 		&& (($env{'form.origin'} eq 'compose')
                     98: 		    || ($env{'form.origin'} eq 'process'))) {
                     99:                 if ($env{'form.coursepick'} eq 'category') {
                    100:                     $loadcode .= ';javascript:setCourseCat(document.'.$env{'form.command'}.')';
                    101:                 }
                    102:             }
                    103:         }
                    104:     }
                    105:     
1.15      albertel  106:     my $start_page = 
                    107: 	&Apache::loncommon::start_page('Broadcast e-mail to users', $jscript,
1.16      albertel  108: 				       {'add_entries' => 
                    109: 					    {'onload' => $loadcode,},});
1.12      albertel  110:     my $breadcrumbs =
1.18      albertel  111: 	&Apache::lonhtmlcommon::breadcrumbs($bread_title,
1.12      albertel  112: 					    'Broadcast_system_email');
                    113:     my $output = <<"ENDONE";
1.15      albertel  114: $start_page
1.12      albertel  115: $breadcrumbs
                    116: <br />
                    117: <form name="$formname" method="POST">
                    118: ENDONE
                    119: 
                    120:     return $output;
                    121: }
                    122: 
                    123: sub end_page {
                    124:     return '</form>'.&Apache::loncommon::end_page();
                    125: }
                    126: 
1.2       raeburn   127: sub print_front_page {
1.20      albertel  128:     my ($r,$formname,$cdom) = @_;
1.12      albertel  129: 
1.2       raeburn   130:     my $jscript = qq|
                    131: function next_page(caller) {
                    132:     if (caller == 'view') {
                    133:         document.front.command.value="pick_display"
                    134:     }
                    135:     else {
                    136:         document.front.command.value="pick_target"
                    137:     }
                    138:     document.front.submit()
                    139: }
                    140:     |; 
1.12      albertel  141: 
1.14      albertel  142:     my $output = &start_page(&add_script($jscript),
1.12      albertel  143: 			     'Broadcast e-mail to Domain', $formname);
                    144: 
                    145:     $output .= '<input type="hidden" name="command" />';
1.20      albertel  146:     $output .= '<table class="LC_notify_front_page">'.
1.2       raeburn   147:               '<tr><td><a href="javascript:next_page('."'new'".')">'.
                    148:               'Send a new e-mail message to selected users from this domain</a></td></tr><tr>'.
                    149:               '<td><a href="javascript:next_page('."'view'".')">'.
                    150:               'Display e-mail sent by Domain Coordinators in this domain'.
                    151:               '</a></td></tr></table>';
1.12      albertel  152:     $output .= &end_page();
                    153: 
1.2       raeburn   154:     $r->print($output);
                    155:     return;
                    156: }
                    157: 
                    158: sub print_display_option_form {
1.20      albertel  159:     my ($r,$formname,$cdom) = @_;
1.12      albertel  160:     &Apache::lonhtmlcommon::add_breadcrumb({text=>"Display options"});
                    161: 
1.2       raeburn   162:     my $cmd = 'display';
                    163:     my $submit_text = 'Display e-mail';
                    164:     my @roles = ('dc');
                    165:     my $now = time;
1.12      albertel  166: 
1.2       raeburn   167:     my $startdateform = &Apache::lonhtmlcommon::date_setter($formname,
                    168:                                                             'startdate',
                    169:                                                             $now);
                    170:     my $enddateform = &Apache::lonhtmlcommon::date_setter($formname,
                    171:                                                           'enddate',
                    172:                                                           $now);
1.8       raeburn   173:     my %elements = (
                    174:         startdate_month => 'selectbox',
                    175:         startdate_hour => 'selectbox',
                    176:         enddate_month => 'selectbox',
                    177:         enddate_hour => 'selectbox',
                    178:         startdate_day => 'text',
                    179:         startdate_year => 'text',
                    180:         startdate_minute => 'text',
                    181:         startdate_second => 'text',
                    182:         enddate_day => 'text',
                    183:         enddate_year => 'text',
                    184:         enddate_minute => 'text',
                    185:         enddate_second => 'text',
                    186:         sender => 'checkbox',
                    187:     );
                    188:     my $jscript = &Apache::lonhtmlcommon::set_form_elements(\%elements);
1.12      albertel  189: 
1.14      albertel  190:     my $output = &start_page(&add_script($jscript),
1.12      albertel  191: 			     'Broadcast e-mail display options', $formname);
                    192: 
1.20      albertel  193:     $output .= &Apache::lonhtmlcommon::start_pick_box();
                    194:     $output .= &Apache::lonhtmlcommon::row_title(&mt('Date range'));
                    195:     $output .= '<table><tr><td>'.&mt('Earliest to display:').' </td><td>'.
1.2       raeburn   196:                 $startdateform.'</td></tr>';
1.20      albertel  197:     $output .= '<tr><td>'.&mt('Latest to display:').' </td><td>'.$enddateform.
                    198:                '</td></tr></table>';
1.2       raeburn   199:     $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  200:     $output .= &Apache::lonhtmlcommon::row_title(&mt('Choose sender(s)'));
1.4       raeburn   201:     my %personnel = &Apache::lonnet::get_domain_roles($cdom,\@roles);
                    202:     my @domcc = ();
                    203:     foreach my $server (keys %personnel) {
                    204:         foreach my $user (sort(keys %{$personnel{$server}})) {
                    205:             my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
                    206:             unless (grep/^$uname:$udom$/,@domcc) {
                    207:                 my %userinfo = &Apache::lonnet::get('environment',['lastname','firstname'],$udom,$uname);
                    208:                 $output .= '<input type="checkbox" name="sender" value="'.$uname.':'.$udom.'" />&nbsp;'.$userinfo{firstname}.' '.$userinfo{lastname}.'&nbsp;&nbsp;('.$uname.':'.$udom.')';
                    209:                 push (@domcc,$uname.':'.$udom);
                    210:             }
1.2       raeburn   211:         }
                    212:     }
                    213:     $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  214:     $output .= &Apache::lonhtmlcommon::submit_row(&mt('Submit'),$cmd,$submit_text);
1.2       raeburn   215:     $output .= &Apache::lonhtmlcommon::end_pick_box();
1.13      albertel  216:     $output .= qq(<input type="hidden" name="sortby" value="date" />\n).
                    217: 	&end_page();
1.2       raeburn   218:     $r->print($output);
                    219:     return;
                    220: }
                    221: 
                    222: sub print_display {
1.20      albertel  223:     my ($r,$formname,$cdom) = @_;
1.2       raeburn   224:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   225:          ({href=>"javascript:goBack('pick_display')",
1.2       raeburn   226:           text=>"Display options"},
                    227:          {text=>"E-mail display"});
1.12      albertel  228: 
1.2       raeburn   229:     my $msgcount = 0;
                    230:     my $start = &Apache::lonhtmlcommon::get_date_from_form('startdate');
                    231:     my $end = &Apache::lonhtmlcommon::get_date_from_form('enddate');
                    232:     my @senders = &Apache::loncommon::get_env_multiple('form.sender');
1.6       albertel  233:     my %sentmail = &Apache::lonnet::dcmaildump($cdom,$start,$end,\@senders);
1.2       raeburn   234:     my %dcmail = ();
                    235:     my %Sortby = ();
                    236:     my $jscript = <<"ENDSCRIPT";
                    237: function changeSort(caller) {
1.8       raeburn   238:     document.$formname.command.value = '$formname';
1.2       raeburn   239:     document.$formname.sortby.value = caller;
1.8       raeburn   240:     document.$formname.submit();
                    241: }
                    242: function goBack(target) {
                    243:     document.$formname.command.value = target;
                    244:     document.$formname.submit();
1.2       raeburn   245: }
1.8       raeburn   246: 
1.2       raeburn   247: ENDSCRIPT
1.12      albertel  248: 
1.14      albertel  249:     my $output = &start_page(&add_script($jscript),
1.12      albertel  250: 			     'Display Broadcast e-mail', $formname);
1.2       raeburn   251: 
1.9       raeburn   252:     foreach my $msgid (keys(%sentmail)) {
1.10      raeburn   253:         my %content = &Apache::lonmsg::unpackagemsg($sentmail{$msgid});
1.9       raeburn   254:         $msgcount ++;
                    255:         %{$dcmail{$msgid}} = ();
                    256:         foreach my $item (keys(%content)) {
1.10      raeburn   257:             if ($item eq 'recipient') {
                    258:                 foreach my $user (keys(%{$content{recipient}})) {
                    259:                     $dcmail{$msgid}{recipient}{$user} = $content{recipient}{$user};
1.2       raeburn   260:                 }
                    261:             } else {
1.9       raeburn   262:                 $dcmail{$msgid}{$item} = $content{$item};
1.2       raeburn   263:             }
                    264:         }
                    265:     }
1.20      albertel  266:     $output .= &Apache::loncommon::start_data_table();
1.2       raeburn   267:     if ($msgcount > 0) {
1.20      albertel  268:         $output .= &Apache::loncommon::start_data_table_header_row().
                    269: 	    '<th><a href="javascript:changeSort(\'date\')">Date</a></th>'.
                    270: 	    '<th><a href="javascript:changeSort(\'subject\')">Subject</a></th>'.
                    271: 	    '<th><a href="javascript:changeSort(\'sender\')">Sender</a></th>'.
                    272: 	    '<th><a href="javascript:changeSort(\'message\')">Message</a></th>'.
                    273: 	    '<th><a href="javascript:changeSort(\'recipients\')">Recipients</a></th>'.
                    274: 	    &Apache::loncommon::end_data_table_header_row();
                    275: 
1.2       raeburn   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:                 my $recipients = '';
1.17      albertel  279:                 my ($date,undef,$sname,$sdom) =
1.11      raeburn   280:                                   &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   281:                 $date = &Apache::lonlocal::locallocaltime($date);
1.10      raeburn   282:                 foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    283:                     $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   284:                 }
                    285:                 $recipients =~ s/,\s$//;
1.20      albertel  286:                 $output .= &Apache::loncommon::start_data_table_row().
                    287: 		    '<td><small>'.$date.'</small></td>'.
                    288: 		    '<td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td>'.
                    289: 		    '<td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td>'.
                    290: 		    '<td><small>'.$recipients.'</small></td>'."\n".
                    291: 		    &Apache::loncommon::end_data_table_row();
1.2       raeburn   292:             }
                    293:         } else {
                    294:             foreach my $msgid (sort(keys(%dcmail))) {
1.17      albertel  295:                 my ($date,undef,$sname,$sdom) =
1.11      raeburn   296:                                    &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   297:                 if ($env{'form.sortby'} eq 'subject') {
                    298:                     push @{$Sortby{$dcmail{$msgid}{subject}}},$msgid;
                    299:                 } elsif ($env{'form.sortby'} eq 'message') {
                    300:                     push @{$Sortby{$dcmail{$msgid}{message}}},$msgid;
                    301:                 } elsif ($env{'form.sortby'} eq 'recipients') {
                    302:                     my $recipients ='';
1.10      raeburn   303:                     foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    304:                         $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   305:                     }
                    306:                     $recipients =~ s/,\s$//;
                    307:                     push @{$Sortby{$recipients}},$msgid;
                    308:                 } elsif ($env{'form.sortby'} eq 'sender') {
                    309:                     if (@senders > 1) {
                    310:                        push @{$Sortby{$sname.':'.$sdom}},$msgid;
                    311:                     }
                    312:                 }
                    313:             }
                    314:             foreach my $key (sort(keys(%Sortby))) {
                    315:                 foreach my $msgid (@{$Sortby{$key}}) {
                    316:                     my $recipients = '';
                    317:                     if ($env{'form.sortby'} eq 'recipients') {
                    318:                         $recipients = $key;
                    319:                     } else {
1.10      raeburn   320:                         foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    321:                             $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   322:                         }
                    323:                         $recipients =~ s/,\s$//;
                    324:                     }
1.17      albertel  325:                     my ($date,undef,$sname,$sdom) =
1.11      raeburn   326:                                    &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   327:                     $date = &Apache::lonlocal::locallocaltime($date);
1.20      albertel  328:                     $output .=  &Apache::loncommon::start_data_table_row().
                    329: 			'<td><small>'.$date.'</small></td>'.
                    330: 			'<td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td>'.
                    331: 			'<td><small>'.$sname.':'.$sdom.'</small></td>'.
                    332: 			'<td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td>'.
                    333: 			'<td><small>'.$recipients.'</small></td>'."\n".
                    334: 			&Apache::loncommon::end_data_table_row();
1.2       raeburn   335:                 }
                    336:             }
                    337:         }
                    338:     } else {
1.20      albertel  339:         $output .= &Apache::loncommon::start_data_table_empty_row().
                    340: 	    '<td>No mail sent matching supplied criteria</td>'.
                    341: 	    &Apache::loncommon::end_data_table_empty_row();
1.2       raeburn   342:     }
1.20      albertel  343:     $output .= &Apache::loncommon::end_data_table();
1.8       raeburn   344:     $output .= &Apache::lonhtmlcommon::echo_form_input(['sortby','command','origin']);
                    345:     my $curr_sortby;
                    346:     if (defined($env{'form.sortby'})) {
                    347:         $curr_sortby = $env{'form.sortby'};
                    348:     } else {
                    349:         $curr_sortby = 'date';
                    350:     }
                    351:     $output .= qq(<input type="hidden" name="origin" value="$formname" />\n);
                    352:     $output .= qq(<input type="hidden" name="command" />\n);
                    353:     $output .= qq(<input type="hidden" name="sortby" value="$curr_sortby" />\n);
1.13      albertel  354:     $output .= &end_page();
1.2       raeburn   355:     $r->print($output);
                    356:     return;
                    357: }
                    358: 
1.1       raeburn   359: sub print_selection_form {
1.20      albertel  360:     my ($r,$formname,$cdom) = @_;
1.1       raeburn   361:     my %coursecodes = ();
                    362:     my %codes = ();
                    363:     my @codetitles = ();
                    364:     my %cat_titles = ();
                    365:     my %cat_order = ();
                    366:     my %idlist = ();
                    367:     my %idnums = ();
                    368:     my %idlist_titles = ();
                    369:     my $caller = 'global';
                    370:     my $totcodes = 0;
                    371:     my $format_reply;
                    372:     my $jscript = '';
1.2       raeburn   373:     my %lt=&Apache::lonlocal::texthash(
                    374:                'buil' => 'Building valid e-mail address from username, if missing from preferences:',
                    375:                'kerb' => 'Kerberos: enter default for each realm used in the domain, with comma separation of entries',
                    376:                'infs' => 'Internal, Filesystem and Local authentication: enter single default.',
                    377:                'comp' => 'Compose Message'
                    378:            );
                    379:     &Apache::lonhtmlcommon::add_breadcrumb
                    380:           ({text=>"Select Audience"});
                    381: 
1.1       raeburn   382:     $totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$cdom,$totcodes);
                    383:     if ($totcodes > 0) {
                    384:         $format_reply = &Apache::lonnet::auto_instcode_format($caller,$cdom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
                    385:         if ($format_reply eq 'ok') {
                    386:             my $numtypes = @codetitles;
                    387:             &Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
1.2       raeburn   388:             &Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
1.1       raeburn   389:         }
                    390:     }
                    391: 
1.3       albertel  392:     my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($cdom);
1.8       raeburn   393: 
                    394:     my %elements = (
                    395:                      roles => 'selectbox',
                    396:                      types => 'selectbox',
                    397:                      Year => 'selectbox',
                    398:                      coursepick => 'radio',
                    399:                      coursetotal => 'text',
                    400:                      courselist => 'text',
                    401:                      internal => 'text',
                    402:                      krb4 => 'text',
                    403:                      krb5 => 'text',
                    404:                      local => 'text',
                    405:                      unix => 'text',
                    406:                    );
                    407:     $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
                    408:     if ($env{'form.coursepick'} eq 'category') {
                    409:         $jscript .= qq|
                    410: function setCourseCat(formname) {
                    411:     if (formname.Year.options[formname.Year.selectedIndex].value == -1) {
                    412:         return;
                    413:     }
                    414:     courseSet('Year');
                    415:     for (var j=0; j<formname.Semester.length; j++) {
                    416:         if (formname.Semester.options[j].value == "$env{'form.Semester'}") {
                    417:             formname.Semester.options[j].selected = true;
                    418:         }
                    419:     }
                    420:     if (formname.Semester.options[formname.Semester.selectedIndex].value == -1) {
                    421:         return;
                    422:     }
                    423:     courseSet('Semester');
                    424:     for (var j=0; j<formname.Department.length; j++) {
                    425:         if (formname.Department.options[j].value == "$env{'form.Department'}") {
                    426:             formname.Department.options[j].selected = true;
                    427:         }
                    428:     }
                    429:     if (formname.Department.options[formname.Department.selectedIndex].value == -1) {
                    430:         return;
                    431:     }
                    432:     courseSet('Department');
                    433:     for (var j=0; j<formname.Number.length; j++) {
                    434:         if (formname.Number.options[j].value == "$env{'form.Number'}") {
                    435:             formname.Number.options[j].selected = true;
                    436:         }
                    437:     }
                    438: }
                    439: |; 
                    440:     }
1.12      albertel  441: 
                    442: 
                    443:     my $output = &start_page(&add_script($jscript).$cb_jscript,
1.14      albertel  444: 			     'Choose e-mail audience', $formname);
1.12      albertel  445: 
1.20      albertel  446:     $output .= &Apache::lonhtmlcommon::start_pick_box();
1.13      albertel  447:     my @roles = ('ow','cc','in','ta','ep','st','cr');
                    448:     my %longtypes = ();
                    449:     my %authtypes = ();
                    450:     &form_elements(\%longtypes,\%authtypes);
                    451:     my $descrip = $lt{'buil'}.' 
1.2       raeburn   452: <ul>
                    453: <li>'.$lt{'kerb'}.'<br />(e.g., MSU.EDU=msu.edu, MSUE.EDU=msue.msu.edu).</li>
                    454: <li>'.$lt{'infs'}.'</li>
                    455: </ul>'."\n";
1.13      albertel  456:     my $submit_text = $lt{'comp'};
                    457:     my $cmd = 'compose';
1.20      albertel  458:     $output .= &Apache::lonhtmlcommon::role_select_row(\@roles,'Roles');
                    459:     $output .= &Apache::lonhtmlcommon::course_select_row('Courses',$formname,$totcodes,\@codetitles,\%idlist,\%idlist_titles);
                    460:     $output .= &Apache::lonhtmlcommon::status_select_row(\%longtypes,&mt('Access status'));
                    461:     $output .= &Apache::lonhtmlcommon::email_default_row(\%authtypes,&mt('Username -> Email conversion'),$descrip);
                    462:     $output .= &Apache::lonhtmlcommon::submit_row(&mt('Submit'),$cmd,$submit_text);
1.13      albertel  463:     $output .= &Apache::lonhtmlcommon::end_pick_box();
                    464:     $output .= &end_page();
1.2       raeburn   465:     $r->print($output);
1.1       raeburn   466:     return;
                    467: }
                    468: 
                    469: sub print_composition_form {
1.20      albertel  470:     my ($r,$formname,$cdom) = @_;
1.1       raeburn   471:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   472:         ({href=>"javascript:goBack('pick_target')",
1.2       raeburn   473:           text=>"Select Audience"},
                    474:          {text=>"Compose Message"});
                    475:     my $jscript = &Apache::loncommon::check_uncheck_jscript();
1.8       raeburn   476:     $jscript .= qq|
                    477: function goBack(target) {
                    478:     document.$formname.command.value = target;
                    479:     document.$formname.submit();
                    480: }
                    481: |;
1.1       raeburn   482: 
1.2       raeburn   483:     my %lt=&Apache::lonlocal::texthash(
                    484:                       'nore' => 'No recipients identified',
                    485:                       'emad' => 'e-mail address',
                    486:                    );
1.8       raeburn   487:     my %elements = (
                    488:                      subject => 'text',
                    489:                      message => 'text',
                    490:                      sender => 'text',
                    491:                      recipient => 'checkbox',
                    492:                    );
                    493:     $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
                    494: 
1.14      albertel  495:     $r->print(&start_page(&add_script($jscript),
1.12      albertel  496: 			  'Broadcast e-mail to users', $formname));
                    497: 
1.2       raeburn   498:     my $coursefilter = $env{'form.coursepick'};
                    499:     my %courses = ();
                    500:     if ($coursefilter eq 'all') {
1.22    ! raeburn   501:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.','.','.','.',
        !           502:                                                  undef,undef,'Course');
1.2       raeburn   503:     } elsif ($coursefilter eq 'category') {
                    504:         my $instcode = '';
                    505:         my @cats = ('Semester','Year','Department','Number');
                    506:         foreach my $category (@cats) {
                    507:             if (defined($env{'form.'.$category})) {
                    508:                 unless ($env{'form.'.$category} eq '-1') {
                    509:                     $instcode .= $env{'form.'.$category};
                    510:                 }
1.1       raeburn   511:             }
                    512:         }
1.2       raeburn   513:         if ($instcode eq '') {
                    514:             $instcode = '.';
                    515:         }
1.22    ! raeburn   516:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.',$instcode,'.','.',
        !           517:                                                  undef,undef,'Course');
1.2       raeburn   518:     } elsif ($coursefilter eq 'specific') {
                    519:         if ($env{'form.coursetotal'} > 1) {
                    520:             my @course_ids = split(/&&/,$env{'form.courselist'});
                    521:             foreach (@course_ids) {
                    522:                 $courses{$_} = '';
                    523:             }
                    524:         } else {
                    525:             $courses{$env{'form.courselist'}} = '';
                    526:         }
1.1       raeburn   527:     }
1.2       raeburn   528: 
                    529:     my @types = &Apache::loncommon::get_env_multiple('form.types');
                    530:     my @roles = &Apache::loncommon::get_env_multiple('form.roles');
                    531: 
                    532:     my %longtypes = ();
                    533:     my %authtypes = ();
                    534:     my %email_defaults = ();
                    535: 
                    536:     &form_elements(\%longtypes,\%authtypes);
1.3       albertel  537:     foreach my $auth (keys(%authtypes)) {
1.2       raeburn   538:         if (exists($env{'form.'.$auth})) {
                    539:              my $default = $env{'form.'.$auth};
                    540:              $default =~ s/^,+//;
                    541:              $default =~ s/,+$//;
                    542:              if ($auth =~ /^krb/) {
                    543:                  %{$email_defaults{$auth}} = ();
                    544:                  if ($default =~ /,/) {
                    545:                      my @items = split(/,/,$default);
                    546:                      foreach my $item (@items) {
                    547:                          my ($realm,$value) = split(/=/,$item);
                    548:                          $email_defaults{$auth}{$realm} = $value;
                    549:                      }
                    550:                  } else {
                    551:                      my ($realm,$value) = split(/=/,$default);
                    552:                      $email_defaults{$auth}{$realm} = $value;
                    553:                  }
                    554:              } else {
                    555:                  $email_defaults{$auth} = $default;
                    556:              }
                    557:          }
1.1       raeburn   558:     }
1.2       raeburn   559: 
                    560:     my $sender = &get_user_info($env{'user.name'},%email_defaults);
                    561: 
1.1       raeburn   562:     my %recipients = ();
1.2       raeburn   563:     my %users = ();
                    564:     my %access = ();
1.8       raeburn   565:     my @sections = ();
1.2       raeburn   566:     my $totalrecip = 0;
                    567:     my @unmatched = ();
                    568:     foreach my $role (@roles) {
                    569:         %{$users{$role}} = ();
                    570:     }
                    571:     foreach my $type (@types) {
                    572:         $access{$type} = $type;
                    573:     }
                    574:     foreach my $course_id (keys(%courses)) {
                    575:         my ($cdom,$cnum) = split(/_/,$course_id);
1.8       raeburn   576:         &Apache::loncommon::get_course_users($cdom,$cnum,\%access,\@roles,\@sections,\%users);
1.2       raeburn   577:     }
                    578:     foreach my $role (keys(%users)) {
                    579:         foreach my $user (keys(%{$users{$role}})) {
                    580:             unless (defined($recipients{$user})) {
                    581:                 $recipients{$user} = &get_user_info($user,%email_defaults);
                    582:                 if ($recipients{$user} eq '') {
                    583:                     push @unmatched, $user;
                    584:                 } else {
                    585:                     $totalrecip ++;
                    586:                 } 
                    587:             }
                    588:         }
1.1       raeburn   589:     }
1.12      albertel  590:     my $output;
1.2       raeburn   591:   
                    592:     if ($totalrecip > 0) {
1.20      albertel  593:         $output .= &Apache::lonhtmlcommon::start_pick_box();
                    594:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Subject'));
                    595:         $output .= '<input type="text" name="subject" size="30" />';
1.2       raeburn   596:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  597:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Message'));
                    598:         $output .= '  <textarea name="message" id="message"
                    599:                       cols="60" rows="10" wrap="hard"></textarea>';
1.2       raeburn   600:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  601:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Recipients'));
                    602:         $output .= '<input type="button" value="check all" 
1.2       raeburn   603:                     onclick="javascript:checkAll(document.compose.recipient)" />
                    604:                     &nbsp;&nbsp;<input type="button" value="uncheck all"
                    605:                     onclick="javascript:uncheckAll(document.compose.recipient)" />
1.20      albertel  606:                     <br />';
                    607: 	$output .= &Apache::loncommon::start_data_table();
1.2       raeburn   608:         if (keys(%recipients) > 0) {
1.20      albertel  609: 	    $output .= &Apache::loncommon::start_data_table_header_row();
                    610:             $output .= '<th>&nbsp;<th>username:domain</th><th>&nbsp;&nbsp;</th><th>'.$lt{'emad'}.'</th>';
                    611: 	    $output .= &Apache::loncommon::end_data_table_header_row();
1.2       raeburn   612:         }
                    613:         foreach my $username (sort(keys(%recipients))) {
1.20      albertel  614: 	    $output .= &Apache::loncommon::start_data_table_row();
1.1       raeburn   615:             if ($recipients{$username} =~ /\@/) {
1.19      www       616:                 my $value=&escape($username).':'.&escape($recipients{$username});
1.20      albertel  617:                 $output .= '<td><input type="checkbox" name="recipient" value="'.$value.'" /></td><td>'.$username.'</td><td>&nbsp;&nbsp;</td><td>'.$recipients{$username}.'</td>';
1.1       raeburn   618:             }
1.20      albertel  619: 	    $output .= &Apache::loncommon::end_data_table_row();
1.1       raeburn   620:         }
1.20      albertel  621:         $output .= &Apache::loncommon::end_data_table();
1.5       raeburn   622:         if (@unmatched) {
                    623:             $output .= '<br /><br />'.&mt('Could not determine e-mail addresses for the following users:').'<ul>';
                    624:             foreach my $username (sort @unmatched) {
                    625:                 $output .= '<li>'.$username.'</li>';
                    626:             }
                    627:             $output .= '</ul>';
                    628:         }
1.2       raeburn   629:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  630:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Sender e-mail address'));
                    631:         $output .= '<input type="text" name="sender" value="'.$sender.'" />';
1.2       raeburn   632:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20      albertel  633:         $output .= &Apache::lonhtmlcommon::submit_row(&mt('Submit'),'process',&mt('Send Message'));
1.2       raeburn   634:         $output .= &Apache::lonhtmlcommon::end_pick_box();
1.1       raeburn   635:     } else {
1.8       raeburn   636:         $output .= $lt{'nore'}."\n".
                    637:                    '<input type="hidden" name="command" value="" />'."\n";
1.1       raeburn   638:     }
1.8       raeburn   639:     $output .= '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
                    640:     $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin','subject','message','recipient','sender'],);
1.13      albertel  641:     $output .= &end_page();
1.2       raeburn   642:     $r->print($output);
1.1       raeburn   643:     return;
                    644: }
                    645: 
                    646: 
                    647: sub print_request_receipt {
1.20      albertel  648:     my ($r,$formname,$dom) =@_;
1.2       raeburn   649:     my @recipients = &Apache::loncommon::get_env_multiple('form.recipient');
1.1       raeburn   650:     my $subject = $env{'form.subject'};
                    651:     my $message = $env{'form.message'};
1.2       raeburn   652:     my $from = $env{'form.sender'};
                    653:     my $jscript = <<ENDSCRIPT;
1.8       raeburn   654: function goBack(target) {
                    655:     document.$formname.command.value = target;
                    656:     document.$formname.submit();
1.2       raeburn   657: }
                    658: ENDSCRIPT
1.12      albertel  659: 
1.2       raeburn   660:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   661:         ({href=>"javascript:goBack('pick_target')",
1.2       raeburn   662:           text=>"Select audience"});
                    663:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   664:         ({href=>"javascript:goBack('compose')",
1.2       raeburn   665:           text=>"Compose Message"});
                    666:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   667:         ({href=>"/adm/notify?command=process",
1.2       raeburn   668:           text=>"Outcome"});
1.12      albertel  669: 
                    670: 
1.14      albertel  671:     my $output = &start_page(&add_script($jscript), 'E-mail Delivery',
                    672: 			     $formname);
1.12      albertel  673: 
1.20      albertel  674: 
1.2       raeburn   675:     my @deliveries = ();
                    676:     &broadcast_email(\@recipients,$subject,$from,$message,\@deliveries);
                    677:     if (@deliveries > 0) {
1.20      albertel  678: 	$output .= &Apache::loncommon::start_data_table();
1.5       raeburn   679:         &store_mail($subject,$message,$dom,\@deliveries);
1.20      albertel  680:         $output .= &Apache::loncommon::start_data_table_header_row().
                    681: 	    '<th>'.&mt('Status').'</th>'.
                    682: 	    '<th>'.&mt('Subject').'</th>'.
                    683: 	    '<th>'.&mt('Message').'</th>'.
                    684: 	    '<th>'.&mt('Recipents').'</th>'.
                    685: 	    &Apache::loncommon::end_data_table_header_row();
                    686: 	$output .= &Apache::loncommon::start_data_table_row().
                    687: 	    '<td valign="middle">'.&mt('Sent').'</td>'.
                    688: 	    '<td valign="middle">'.&cr_to_br($subject).'</td>'.
                    689: 	    '<td valign="middle">'.&cr_to_br($message).'</td>'.
                    690: 	    '<td>';
1.2       raeburn   691:         foreach my $person (@deliveries) {
                    692:             my ($username,$email) = split(/:/,$person);
1.19      www       693:             $output .= &unescape($email).'&nbsp;('.&unescape($username).')<br />'."\n";
1.2       raeburn   694:         }
1.20      albertel  695:         $output .= '</td>'.
                    696: 	    &Apache::loncommon::end_data_table_row().
                    697: 	    &Apache::loncommon::end_data_table();
1.2       raeburn   698:     } else {
                    699:         $output .= 'No mail sent - no recipients identified'; 
1.1       raeburn   700:     }
1.2       raeburn   701:     $output .= '<br /><a href="/adm/notify">Send another message?</a>'."\n";
1.8       raeburn   702:     $output .= '<input type="hidden" name="command" />'."\n".
                    703:                '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
                    704:     $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin']);
1.13      albertel  705:     $output .= &end_page();
1.2       raeburn   706:     $r->print($output);
1.1       raeburn   707:     return;
                    708: }
                    709: 
1.2       raeburn   710: sub broadcast_email {
1.12      albertel  711:     my ($recipients,$subject,$from,$message,$deliveries)=@_;
1.8       raeburn   712: # Should implement staggered delivery for large numbers of recipients?.
1.2       raeburn   713:     foreach my $user (@{$recipients}) {
                    714:         my $msg = new Mail::Send;
                    715:         my ($username,$to) = split(/:/,$user);
1.19      www       716:         $username = &unescape($username);
                    717:         $to = &unescape($to);
1.2       raeburn   718:         $msg->to($to);
                    719:         $msg->subject($subject);
                    720:         $msg->add('From',"$from");
                    721:         if (my $fh = $msg->open()) {
                    722:             print $fh $message;
                    723:             $fh->close;
                    724:             push(@{$deliveries},$user); 
                    725:         }
                    726:     }
                    727: }
                    728: 
                    729: sub get_user_info {
1.5       raeburn   730:     my ($user,%email_defaults) = @_;
1.2       raeburn   731:     my ($uname,$udom) = split(/:/,$user);
                    732:     my @emailtypes = ('permanentemail','critnotification','notification');
1.3       albertel  733:     my %userinfo = &Apache::lonnet::get('environment',\@emailtypes,$udom,$uname);
1.2       raeburn   734:     my $email = '';
                    735:     foreach my $type (@emailtypes) {
                    736:         $email = $userinfo{$type};
                    737:         if ($email =~ /\@/) {
                    738:             last;
                    739:         }
                    740:     }
                    741:     if ($email eq '') {
                    742:         my $authinfo  = &Apache::lonnet::queryauthenticate($uname,$udom);
                    743:         my ($authtype,$autharg) = split(/:/,$authinfo);
                    744:         if ($authtype =~ /^krb/) {
                    745:             if (defined($email_defaults{$authtype}{$autharg})) {
                    746:                 $email = $uname.'@'.$email_defaults{$authtype}{$autharg};
                    747:             }
                    748:         } else {
1.5       raeburn   749:             if ((defined($email_defaults{$authtype})) && ($email_defaults{$authtype} ne '')) {
1.2       raeburn   750:                 $email = $uname.'@'.$email_defaults{$authtype};
                    751:             }
                    752:         }
                    753:     }
                    754:     return $email;
                    755: }
                    756: 
                    757: sub form_elements {
1.12      albertel  758:    my ($longtypes,$authtypes) = @_;
1.2       raeburn   759:    %{$longtypes} = (
                    760:                    active => 'Currently has access',
                    761:                    previous => 'Previously had access',
                    762:                    future => 'Will have future access',
                    763:                    );
                    764:    %{$authtypes} = (
                    765:                    krb4 => 'Kerberos 4',
                    766:                    krb5 => 'Kerberos 5',
1.5       raeburn   767:                    internal => 'Internal (LON-CAPA)',
1.2       raeburn   768:                    unix => 'Filesystem (UNIX)',
                    769:                    local => 'Local/Customized',
                    770:                    );
                    771:    return;
                    772: }
                    773: 
                    774: sub store_mail {
1.12      albertel  775:     my ($subject,$message,$domain,$recipients,$attachmenturl) = @_;
1.9       raeburn   776:     my $msgid;
1.10      raeburn   777:     ($msgid,$message) = &Apache::lonmsg::packagemsg($subject,$message,undef,undef,
                    778:                         $attachmenturl,$recipients,undef,undef,'dcmail');
                    779: 
1.9       raeburn   780: # Store in dc email db files on primary library server for domain.
                    781:     my $server = $Apache::lonnet::domain_primary{$domain};
                    782:     if (defined($server)) {
                    783:         unless (&Apache::lonnet::dcmailput($domain,$msgid,$message,$server) 
                    784:                                                             eq 'ok') {
                    785:             &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
                    786:                  $domain.' for server: '. $server.'.  Message ID was '.$msgid);
1.4       raeburn   787:         }
1.9       raeburn   788:     } else {
                    789:         &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
                    790:            $domain.' as no primary server identified. Message ID was '.$msgid);
1.2       raeburn   791:     }
                    792: }
                    793: 
1.5       raeburn   794: sub cr_to_br {
                    795:     my $incoming = shift;
                    796:     $incoming =~ s/\n/\<br \/\>/g;
                    797:     return $incoming;
                    798: }
                    799: 
1.1       raeburn   800: 1;

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