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

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

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