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

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) {
                    268:         my $rowNum = 0;
1.20    ! albertel  269:         $output .= &Apache::loncommon::start_data_table_header_row().
        !           270: 	    '<th><a href="javascript:changeSort(\'date\')">Date</a></th>'.
        !           271: 	    '<th><a href="javascript:changeSort(\'subject\')">Subject</a></th>'.
        !           272: 	    '<th><a href="javascript:changeSort(\'sender\')">Sender</a></th>'.
        !           273: 	    '<th><a href="javascript:changeSort(\'message\')">Message</a></th>'.
        !           274: 	    '<th><a href="javascript:changeSort(\'recipients\')">Recipients</a></th>'.
        !           275: 	    &Apache::loncommon::end_data_table_header_row();
        !           276: 
1.2       raeburn   277:         if (($env{'form.sortby'} eq 'date') || ($env{'form.sortby'} eq '') || (!defined($env{'form.sortby'})) || (($env{'form.sortby'} eq 'sender') && (@senders <= 1))) {
                    278:             foreach my $msgid (sort(keys(%dcmail))) {
                    279:                 my $recipients = '';
1.17      albertel  280:                 my ($date,undef,$sname,$sdom) =
1.11      raeburn   281:                                   &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   282:                 $date = &Apache::lonlocal::locallocaltime($date);
1.10      raeburn   283:                 foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    284:                     $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   285:                 }
                    286:                 $recipients =~ s/,\s$//;
1.20    ! albertel  287:                 $output .= &Apache::loncommon::start_data_table_row().
        !           288: 		    '<td><small>'.$date.'</small></td>'.
        !           289: 		    '<td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td>'.
        !           290: 		    '<td><small>'.$sname.':'.$sdom.'</small></td><td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td>'.
        !           291: 		    '<td><small>'.$recipients.'</small></td>'."\n".
        !           292: 		    &Apache::loncommon::end_data_table_row();
1.2       raeburn   293:             }
                    294:         } else {
                    295:             foreach my $msgid (sort(keys(%dcmail))) {
1.17      albertel  296:                 my ($date,undef,$sname,$sdom) =
1.11      raeburn   297:                                    &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   298:                 if ($env{'form.sortby'} eq 'subject') {
                    299:                     push @{$Sortby{$dcmail{$msgid}{subject}}},$msgid;
                    300:                 } elsif ($env{'form.sortby'} eq 'message') {
                    301:                     push @{$Sortby{$dcmail{$msgid}{message}}},$msgid;
                    302:                 } elsif ($env{'form.sortby'} eq 'recipients') {
                    303:                     my $recipients ='';
1.10      raeburn   304:                     foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    305:                         $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   306:                     }
                    307:                     $recipients =~ s/,\s$//;
                    308:                     push @{$Sortby{$recipients}},$msgid;
                    309:                 } elsif ($env{'form.sortby'} eq 'sender') {
                    310:                     if (@senders > 1) {
                    311:                        push @{$Sortby{$sname.':'.$sdom}},$msgid;
                    312:                     }
                    313:                 }
                    314:             }
                    315:             foreach my $key (sort(keys(%Sortby))) {
                    316:                 foreach my $msgid (@{$Sortby{$key}}) {
                    317:                     my $recipients = '';
                    318:                     if ($env{'form.sortby'} eq 'recipients') {
                    319:                         $recipients = $key;
                    320:                     } else {
1.10      raeburn   321:                         foreach my $user (sort(keys(%{$dcmail{$msgid}{recipient}}))) {
                    322:                             $recipients .= $dcmail{$msgid}{recipient}{$user}.', ';
1.2       raeburn   323:                         }
                    324:                         $recipients =~ s/,\s$//;
                    325:                     }
1.17      albertel  326:                     my ($date,undef,$sname,$sdom) =
1.11      raeburn   327:                                    &Apache::lonmsg::unpackmsgid($msgid,undef,1);
1.2       raeburn   328:                     $date = &Apache::lonlocal::locallocaltime($date);
1.20    ! albertel  329:                     $output .=  &Apache::loncommon::start_data_table_row().
        !           330: 			'<td><small>'.$date.'</small></td>'.
        !           331: 			'<td><small>'.&cr_to_br($dcmail{$msgid}{subject}).'</small></td>'.
        !           332: 			'<td><small>'.$sname.':'.$sdom.'</small></td>'.
        !           333: 			'<td><small>'.&cr_to_br($dcmail{$msgid}{message}).'</small></td>'.
        !           334: 			'<td><small>'.$recipients.'</small></td>'."\n".
        !           335: 			&Apache::loncommon::end_data_table_row();
1.2       raeburn   336:                 }
                    337:             }
                    338:         }
                    339:     } else {
1.20    ! albertel  340:         $output .= &Apache::loncommon::start_data_table_empty_row().
        !           341: 	    '<td>No mail sent matching supplied criteria</td>'.
        !           342: 	    &Apache::loncommon::end_data_table_empty_row();
1.2       raeburn   343:     }
1.20    ! albertel  344:     $output .= &Apache::loncommon::end_data_table();
1.8       raeburn   345:     $output .= &Apache::lonhtmlcommon::echo_form_input(['sortby','command','origin']);
                    346:     my $curr_sortby;
                    347:     if (defined($env{'form.sortby'})) {
                    348:         $curr_sortby = $env{'form.sortby'};
                    349:     } else {
                    350:         $curr_sortby = 'date';
                    351:     }
                    352:     $output .= qq(<input type="hidden" name="origin" value="$formname" />\n);
                    353:     $output .= qq(<input type="hidden" name="command" />\n);
                    354:     $output .= qq(<input type="hidden" name="sortby" value="$curr_sortby" />\n);
1.13      albertel  355:     $output .= &end_page();
1.2       raeburn   356:     $r->print($output);
                    357:     return;
                    358: }
                    359: 
1.1       raeburn   360: sub print_selection_form {
1.20    ! albertel  361:     my ($r,$formname,$cdom) = @_;
1.1       raeburn   362:     my %coursecodes = ();
                    363:     my %codes = ();
                    364:     my @codetitles = ();
                    365:     my %cat_titles = ();
                    366:     my %cat_order = ();
                    367:     my %idlist = ();
                    368:     my %idnums = ();
                    369:     my %idlist_titles = ();
                    370:     my $caller = 'global';
                    371:     my $totcodes = 0;
                    372:     my $format_reply;
                    373:     my $jscript = '';
1.2       raeburn   374:     my %lt=&Apache::lonlocal::texthash(
                    375:                'buil' => 'Building valid e-mail address from username, if missing from preferences:',
                    376:                'kerb' => 'Kerberos: enter default for each realm used in the domain, with comma separation of entries',
                    377:                'infs' => 'Internal, Filesystem and Local authentication: enter single default.',
                    378:                'comp' => 'Compose Message'
                    379:            );
                    380:     &Apache::lonhtmlcommon::add_breadcrumb
                    381:           ({text=>"Select Audience"});
                    382: 
1.1       raeburn   383:     $totcodes = &Apache::lonsupportreq::retrieve_instcodes(\%coursecodes,$cdom,$totcodes);
                    384:     if ($totcodes > 0) {
                    385:         $format_reply = &Apache::lonnet::auto_instcode_format($caller,$cdom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
                    386:         if ($format_reply eq 'ok') {
                    387:             my $numtypes = @codetitles;
                    388:             &Apache::lonsupportreq::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
1.2       raeburn   389:             &Apache::lonsupportreq::javascript_code_selections($formname,$numtypes,\%cat_titles,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
1.1       raeburn   390:         }
                    391:     }
                    392: 
1.3       albertel  393:     my $cb_jscript = &Apache::loncommon::coursebrowser_javascript($cdom);
1.8       raeburn   394: 
                    395:     my %elements = (
                    396:                      roles => 'selectbox',
                    397:                      types => 'selectbox',
                    398:                      Year => 'selectbox',
                    399:                      coursepick => 'radio',
                    400:                      coursetotal => 'text',
                    401:                      courselist => 'text',
                    402:                      internal => 'text',
                    403:                      krb4 => 'text',
                    404:                      krb5 => 'text',
                    405:                      local => 'text',
                    406:                      unix => 'text',
                    407:                    );
                    408:     $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
                    409:     if ($env{'form.coursepick'} eq 'category') {
                    410:         $jscript .= qq|
                    411: function setCourseCat(formname) {
                    412:     if (formname.Year.options[formname.Year.selectedIndex].value == -1) {
                    413:         return;
                    414:     }
                    415:     courseSet('Year');
                    416:     for (var j=0; j<formname.Semester.length; j++) {
                    417:         if (formname.Semester.options[j].value == "$env{'form.Semester'}") {
                    418:             formname.Semester.options[j].selected = true;
                    419:         }
                    420:     }
                    421:     if (formname.Semester.options[formname.Semester.selectedIndex].value == -1) {
                    422:         return;
                    423:     }
                    424:     courseSet('Semester');
                    425:     for (var j=0; j<formname.Department.length; j++) {
                    426:         if (formname.Department.options[j].value == "$env{'form.Department'}") {
                    427:             formname.Department.options[j].selected = true;
                    428:         }
                    429:     }
                    430:     if (formname.Department.options[formname.Department.selectedIndex].value == -1) {
                    431:         return;
                    432:     }
                    433:     courseSet('Department');
                    434:     for (var j=0; j<formname.Number.length; j++) {
                    435:         if (formname.Number.options[j].value == "$env{'form.Number'}") {
                    436:             formname.Number.options[j].selected = true;
                    437:         }
                    438:     }
                    439: }
                    440: |; 
                    441:     }
1.12      albertel  442: 
                    443: 
                    444:     my $output = &start_page(&add_script($jscript).$cb_jscript,
1.14      albertel  445: 			     'Choose e-mail audience', $formname);
1.12      albertel  446: 
1.20    ! albertel  447:     $output .= &Apache::lonhtmlcommon::start_pick_box();
1.13      albertel  448:     my @roles = ('ow','cc','in','ta','ep','st','cr');
                    449:     my %longtypes = ();
                    450:     my %authtypes = ();
                    451:     &form_elements(\%longtypes,\%authtypes);
                    452:     my $descrip = $lt{'buil'}.' 
1.2       raeburn   453: <ul>
                    454: <li>'.$lt{'kerb'}.'<br />(e.g., MSU.EDU=msu.edu, MSUE.EDU=msue.msu.edu).</li>
                    455: <li>'.$lt{'infs'}.'</li>
                    456: </ul>'."\n";
1.13      albertel  457:     my $submit_text = $lt{'comp'};
                    458:     my $cmd = 'compose';
1.20    ! albertel  459:     $output .= &Apache::lonhtmlcommon::role_select_row(\@roles,'Roles');
        !           460:     $output .= &Apache::lonhtmlcommon::course_select_row('Courses',$formname,$totcodes,\@codetitles,\%idlist,\%idlist_titles);
        !           461:     $output .= &Apache::lonhtmlcommon::status_select_row(\%longtypes,&mt('Access status'));
        !           462:     $output .= &Apache::lonhtmlcommon::email_default_row(\%authtypes,&mt('Username -> Email conversion'),$descrip);
        !           463:     $output .= &Apache::lonhtmlcommon::submit_row(&mt('Submit'),$cmd,$submit_text);
1.13      albertel  464:     $output .= &Apache::lonhtmlcommon::end_pick_box();
                    465:     $output .= &end_page();
1.2       raeburn   466:     $r->print($output);
1.1       raeburn   467:     return;
                    468: }
                    469: 
                    470: sub print_composition_form {
1.20    ! albertel  471:     my ($r,$formname,$cdom) = @_;
1.1       raeburn   472:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   473:         ({href=>"javascript:goBack('pick_target')",
1.2       raeburn   474:           text=>"Select Audience"},
                    475:          {text=>"Compose Message"});
                    476:     my $jscript = &Apache::loncommon::check_uncheck_jscript();
1.8       raeburn   477:     $jscript .= qq|
                    478: function goBack(target) {
                    479:     document.$formname.command.value = target;
                    480:     document.$formname.submit();
                    481: }
                    482: |;
1.1       raeburn   483: 
1.2       raeburn   484:     my %lt=&Apache::lonlocal::texthash(
                    485:                       'nore' => 'No recipients identified',
                    486:                       'emad' => 'e-mail address',
                    487:                    );
1.8       raeburn   488:     my %elements = (
                    489:                      subject => 'text',
                    490:                      message => 'text',
                    491:                      sender => 'text',
                    492:                      recipient => 'checkbox',
                    493:                    );
                    494:     $jscript .= &Apache::lonhtmlcommon::set_form_elements(\%elements);
                    495: 
1.14      albertel  496:     $r->print(&start_page(&add_script($jscript),
1.12      albertel  497: 			  'Broadcast e-mail to users', $formname));
                    498: 
1.2       raeburn   499:     my $coursefilter = $env{'form.coursepick'};
                    500:     my %courses = ();
                    501:     if ($coursefilter eq 'all') {
                    502:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.','.','.','.');
                    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:         }
                    516:         %courses = &Apache::lonnet::courseiddump($cdom,'.','.',$instcode,'.','.');
                    517:     } elsif ($coursefilter eq 'specific') {
                    518:         if ($env{'form.coursetotal'} > 1) {
                    519:             my @course_ids = split(/&&/,$env{'form.courselist'});
                    520:             foreach (@course_ids) {
                    521:                 $courses{$_} = '';
                    522:             }
                    523:         } else {
                    524:             $courses{$env{'form.courselist'}} = '';
                    525:         }
1.1       raeburn   526:     }
1.2       raeburn   527: 
                    528:     my @types = &Apache::loncommon::get_env_multiple('form.types');
                    529:     my @roles = &Apache::loncommon::get_env_multiple('form.roles');
                    530: 
                    531:     my %longtypes = ();
                    532:     my %authtypes = ();
                    533:     my %email_defaults = ();
                    534: 
                    535:     &form_elements(\%longtypes,\%authtypes);
1.3       albertel  536:     foreach my $auth (keys(%authtypes)) {
1.2       raeburn   537:         if (exists($env{'form.'.$auth})) {
                    538:              my $default = $env{'form.'.$auth};
                    539:              $default =~ s/^,+//;
                    540:              $default =~ s/,+$//;
                    541:              if ($auth =~ /^krb/) {
                    542:                  %{$email_defaults{$auth}} = ();
                    543:                  if ($default =~ /,/) {
                    544:                      my @items = split(/,/,$default);
                    545:                      foreach my $item (@items) {
                    546:                          my ($realm,$value) = split(/=/,$item);
                    547:                          $email_defaults{$auth}{$realm} = $value;
                    548:                      }
                    549:                  } else {
                    550:                      my ($realm,$value) = split(/=/,$default);
                    551:                      $email_defaults{$auth}{$realm} = $value;
                    552:                  }
                    553:              } else {
                    554:                  $email_defaults{$auth} = $default;
                    555:              }
                    556:          }
1.1       raeburn   557:     }
1.2       raeburn   558: 
                    559:     my $sender = &get_user_info($env{'user.name'},%email_defaults);
                    560: 
1.1       raeburn   561:     my %recipients = ();
1.2       raeburn   562:     my %users = ();
                    563:     my %access = ();
1.8       raeburn   564:     my @sections = ();
1.2       raeburn   565:     my $totalrecip = 0;
                    566:     my @unmatched = ();
                    567:     foreach my $role (@roles) {
                    568:         %{$users{$role}} = ();
                    569:     }
                    570:     foreach my $type (@types) {
                    571:         $access{$type} = $type;
                    572:     }
                    573:     foreach my $course_id (keys(%courses)) {
                    574:         my ($cdom,$cnum) = split(/_/,$course_id);
1.8       raeburn   575:         &Apache::loncommon::get_course_users($cdom,$cnum,\%access,\@roles,\@sections,\%users);
1.2       raeburn   576:     }
                    577:     foreach my $role (keys(%users)) {
                    578:         foreach my $user (keys(%{$users{$role}})) {
                    579:             unless (defined($recipients{$user})) {
                    580:                 $recipients{$user} = &get_user_info($user,%email_defaults);
                    581:                 if ($recipients{$user} eq '') {
                    582:                     push @unmatched, $user;
                    583:                 } else {
                    584:                     $totalrecip ++;
                    585:                 } 
                    586:             }
                    587:         }
1.1       raeburn   588:     }
1.12      albertel  589:     my $output;
1.2       raeburn   590:   
                    591:     if ($totalrecip > 0) {
1.20    ! albertel  592:         $output .= &Apache::lonhtmlcommon::start_pick_box();
        !           593:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Subject'));
        !           594:         $output .= '<input type="text" name="subject" size="30" />';
1.2       raeburn   595:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20    ! albertel  596:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Message'));
        !           597:         $output .= '  <textarea name="message" id="message"
        !           598:                       cols="60" rows="10" wrap="hard"></textarea>';
1.2       raeburn   599:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20    ! albertel  600:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Recipients'));
        !           601:         $output .= '<input type="button" value="check all" 
1.2       raeburn   602:                     onclick="javascript:checkAll(document.compose.recipient)" />
                    603:                     &nbsp;&nbsp;<input type="button" value="uncheck all"
                    604:                     onclick="javascript:uncheckAll(document.compose.recipient)" />
1.20    ! albertel  605:                     <br />';
        !           606: 	$output .= &Apache::loncommon::start_data_table();
1.2       raeburn   607:         if (keys(%recipients) > 0) {
1.20    ! albertel  608: 	    $output .= &Apache::loncommon::start_data_table_header_row();
        !           609:             $output .= '<th>&nbsp;<th>username:domain</th><th>&nbsp;&nbsp;</th><th>'.$lt{'emad'}.'</th>';
        !           610: 	    $output .= &Apache::loncommon::end_data_table_header_row();
1.2       raeburn   611:         }
                    612:         foreach my $username (sort(keys(%recipients))) {
1.20    ! albertel  613: 	    $output .= &Apache::loncommon::start_data_table_row();
1.1       raeburn   614:             if ($recipients{$username} =~ /\@/) {
1.19      www       615:                 my $value=&escape($username).':'.&escape($recipients{$username});
1.20    ! albertel  616:                 $output .= '<td><input type="checkbox" name="recipient" value="'.$value.'" /></td><td>'.$username.'</td><td>&nbsp;&nbsp;</td><td>'.$recipients{$username}.'</td>';
1.1       raeburn   617:             }
1.20    ! albertel  618: 	    $output .= &Apache::loncommon::end_data_table_row();
1.1       raeburn   619:         }
1.20    ! albertel  620:         $output .= &Apache::loncommon::end_data_table();
1.5       raeburn   621:         if (@unmatched) {
                    622:             $output .= '<br /><br />'.&mt('Could not determine e-mail addresses for the following users:').'<ul>';
                    623:             foreach my $username (sort @unmatched) {
                    624:                 $output .= '<li>'.$username.'</li>';
                    625:             }
                    626:             $output .= '</ul>';
                    627:         }
1.2       raeburn   628:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20    ! albertel  629:         $output .= &Apache::lonhtmlcommon::row_title(&mt('Sender e-mail address'));
        !           630:         $output .= '<input type="text" name="sender" value="'.$sender.'" />';
1.2       raeburn   631:         $output .= &Apache::lonhtmlcommon::row_closure();
1.20    ! albertel  632:         $output .= &Apache::lonhtmlcommon::submit_row(&mt('Submit'),'process',&mt('Send Message'));
1.2       raeburn   633:         $output .= &Apache::lonhtmlcommon::end_pick_box();
1.1       raeburn   634:     } else {
1.8       raeburn   635:         $output .= $lt{'nore'}."\n".
                    636:                    '<input type="hidden" name="command" value="" />'."\n";
1.1       raeburn   637:     }
1.8       raeburn   638:     $output .= '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
                    639:     $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin','subject','message','recipient','sender'],);
1.13      albertel  640:     $output .= &end_page();
1.2       raeburn   641:     $r->print($output);
1.1       raeburn   642:     return;
                    643: }
                    644: 
                    645: 
                    646: sub print_request_receipt {
1.20    ! albertel  647:     my ($r,$formname,$dom) =@_;
1.2       raeburn   648:     my @recipients = &Apache::loncommon::get_env_multiple('form.recipient');
1.1       raeburn   649:     my $subject = $env{'form.subject'};
                    650:     my $message = $env{'form.message'};
1.2       raeburn   651:     my $from = $env{'form.sender'};
                    652:     my $jscript = <<ENDSCRIPT;
1.8       raeburn   653: function goBack(target) {
                    654:     document.$formname.command.value = target;
                    655:     document.$formname.submit();
1.2       raeburn   656: }
                    657: ENDSCRIPT
1.12      albertel  658: 
1.2       raeburn   659:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   660:         ({href=>"javascript:goBack('pick_target')",
1.2       raeburn   661:           text=>"Select audience"});
                    662:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   663:         ({href=>"javascript:goBack('compose')",
1.2       raeburn   664:           text=>"Compose Message"});
                    665:     &Apache::lonhtmlcommon::add_breadcrumb
1.8       raeburn   666:         ({href=>"/adm/notify?command=process",
1.2       raeburn   667:           text=>"Outcome"});
1.12      albertel  668: 
                    669: 
1.14      albertel  670:     my $output = &start_page(&add_script($jscript), 'E-mail Delivery',
                    671: 			     $formname);
1.12      albertel  672: 
1.20    ! albertel  673: 
1.2       raeburn   674:     my @deliveries = ();
                    675:     &broadcast_email(\@recipients,$subject,$from,$message,\@deliveries);
                    676:     if (@deliveries > 0) {
1.20    ! albertel  677: 	$output .= &Apache::loncommon::start_data_table();
1.5       raeburn   678:         &store_mail($subject,$message,$dom,\@deliveries);
1.20    ! albertel  679:         $output .= &Apache::loncommon::start_data_table_header_row().
        !           680: 	    '<th>'.&mt('Status').'</th>'.
        !           681: 	    '<th>'.&mt('Subject').'</th>'.
        !           682: 	    '<th>'.&mt('Message').'</th>'.
        !           683: 	    '<th>'.&mt('Recipents').'</th>'.
        !           684: 	    &Apache::loncommon::end_data_table_header_row();
        !           685: 	$output .= &Apache::loncommon::start_data_table_row().
        !           686: 	    '<td valign="middle">'.&mt('Sent').'</td>'.
        !           687: 	    '<td valign="middle">'.&cr_to_br($subject).'</td>'.
        !           688: 	    '<td valign="middle">'.&cr_to_br($message).'</td>'.
        !           689: 	    '<td>';
1.2       raeburn   690:         foreach my $person (@deliveries) {
                    691:             my ($username,$email) = split(/:/,$person);
1.19      www       692:             $output .= &unescape($email).'&nbsp;('.&unescape($username).')<br />'."\n";
1.2       raeburn   693:         }
1.20    ! albertel  694:         $output .= '</td>'.
        !           695: 	    &Apache::loncommon::end_data_table_row().
        !           696: 	    &Apache::loncommon::end_data_table();
1.2       raeburn   697:     } else {
                    698:         $output .= 'No mail sent - no recipients identified'; 
1.1       raeburn   699:     }
1.2       raeburn   700:     $output .= '<br /><a href="/adm/notify">Send another message?</a>'."\n";
1.8       raeburn   701:     $output .= '<input type="hidden" name="command" />'."\n".
                    702:                '<input type="hidden" name="origin" value="'.$formname.'" />'."\n";
                    703:     $output .= &Apache::lonhtmlcommon::echo_form_input(['command','origin']);
1.13      albertel  704:     $output .= &end_page();
1.2       raeburn   705:     $r->print($output);
1.1       raeburn   706:     return;
                    707: }
                    708: 
1.2       raeburn   709: sub broadcast_email {
1.12      albertel  710:     my ($recipients,$subject,$from,$message,$deliveries)=@_;
1.8       raeburn   711: # Should implement staggered delivery for large numbers of recipients?.
1.2       raeburn   712:     foreach my $user (@{$recipients}) {
                    713:         my $msg = new Mail::Send;
                    714:         my ($username,$to) = split(/:/,$user);
1.19      www       715:         $username = &unescape($username);
                    716:         $to = &unescape($to);
1.2       raeburn   717:         $msg->to($to);
                    718:         $msg->subject($subject);
                    719:         $msg->add('From',"$from");
                    720:         if (my $fh = $msg->open()) {
                    721:             print $fh $message;
                    722:             $fh->close;
                    723:             push(@{$deliveries},$user); 
                    724:         }
                    725:     }
                    726: }
                    727: 
                    728: sub get_user_info {
1.5       raeburn   729:     my ($user,%email_defaults) = @_;
1.2       raeburn   730:     my ($uname,$udom) = split(/:/,$user);
                    731:     my @emailtypes = ('permanentemail','critnotification','notification');
1.3       albertel  732:     my %userinfo = &Apache::lonnet::get('environment',\@emailtypes,$udom,$uname);
1.2       raeburn   733:     my $email = '';
                    734:     foreach my $type (@emailtypes) {
                    735:         $email = $userinfo{$type};
                    736:         if ($email =~ /\@/) {
                    737:             last;
                    738:         }
                    739:     }
                    740:     if ($email eq '') {
                    741:         my $authinfo  = &Apache::lonnet::queryauthenticate($uname,$udom);
                    742:         my ($authtype,$autharg) = split(/:/,$authinfo);
                    743:         if ($authtype =~ /^krb/) {
                    744:             if (defined($email_defaults{$authtype}{$autharg})) {
                    745:                 $email = $uname.'@'.$email_defaults{$authtype}{$autharg};
                    746:             }
                    747:         } else {
1.5       raeburn   748:             if ((defined($email_defaults{$authtype})) && ($email_defaults{$authtype} ne '')) {
1.2       raeburn   749:                 $email = $uname.'@'.$email_defaults{$authtype};
                    750:             }
                    751:         }
                    752:     }
                    753:     return $email;
                    754: }
                    755: 
                    756: sub form_elements {
1.12      albertel  757:    my ($longtypes,$authtypes) = @_;
1.2       raeburn   758:    %{$longtypes} = (
                    759:                    active => 'Currently has access',
                    760:                    previous => 'Previously had access',
                    761:                    future => 'Will have future access',
                    762:                    );
                    763:    %{$authtypes} = (
                    764:                    krb4 => 'Kerberos 4',
                    765:                    krb5 => 'Kerberos 5',
1.5       raeburn   766:                    internal => 'Internal (LON-CAPA)',
1.2       raeburn   767:                    unix => 'Filesystem (UNIX)',
                    768:                    local => 'Local/Customized',
                    769:                    );
                    770:    return;
                    771: }
                    772: 
                    773: sub store_mail {
1.12      albertel  774:     my ($subject,$message,$domain,$recipients,$attachmenturl) = @_;
1.9       raeburn   775:     my $msgid;
1.10      raeburn   776:     ($msgid,$message) = &Apache::lonmsg::packagemsg($subject,$message,undef,undef,
                    777:                         $attachmenturl,$recipients,undef,undef,'dcmail');
                    778: 
1.9       raeburn   779: # Store in dc email db files on primary library server for domain.
                    780:     my $server = $Apache::lonnet::domain_primary{$domain};
                    781:     if (defined($server)) {
                    782:         unless (&Apache::lonnet::dcmailput($domain,$msgid,$message,$server) 
                    783:                                                             eq 'ok') {
                    784:             &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
                    785:                  $domain.' for server: '. $server.'.  Message ID was '.$msgid);
1.4       raeburn   786:         }
1.9       raeburn   787:     } else {
                    788:         &Apache::lonnet::logthis('Storage of dc mail failed for domain'.
                    789:            $domain.' as no primary server identified. Message ID was '.$msgid);
1.2       raeburn   790:     }
                    791: }
                    792: 
1.5       raeburn   793: sub cr_to_br {
                    794:     my $incoming = shift;
                    795:     $incoming =~ s/\n/\<br \/\>/g;
                    796:     return $incoming;
                    797: }
                    798: 
1.1       raeburn   799: 1;

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