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

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

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