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

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

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