Annotation of loncom/interface/lonsupportreq.pm, revision 1.49

1.24      albertel    1: #
1.49    ! raeburn     2: # $Id: lonsupportreq.pm,v 1.48 2008/03/24 01:11:36 www Exp $
1.24      albertel    3: #
                      4: # Copyright Michigan State University Board of Trustees
                      5: #
                      6: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      7: #
                      8: # LON-CAPA is free software; you can redistribute it and/or modify
                      9: # it under the terms of the GNU General Public License as published by
                     10: # the Free Software Foundation; either version 2 of the License, or
                     11: # (at your option) any later version.
                     12: #
                     13: # LON-CAPA is distributed in the hope that it will be useful,
                     14: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     15: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     16: # GNU General Public License for more details.
                     17: #
                     18: # You should have received a copy of the GNU General Public License
                     19: # along with LON-CAPA; if not, write to the Free Software
                     20: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     21: #
                     22: # /home/httpd/html/adm/gpl.txt
                     23: #
                     24: # http://www.lon-capa.org/
                     25: #
                     26: 
1.1       raeburn    27: package Apache::lonsupportreq;
                     28: 
                     29: use strict;
1.5       raeburn    30: use MIME::Types;
                     31: use MIME::Lite;
1.27      raeburn    32: use CGI::Cookie();
1.1       raeburn    33: use Apache::Constants qw(:common);
1.2       albertel   34: use Apache::loncommon();
1.43      raeburn    35: use Apache::lonhtmlcommon;
1.24      albertel   36: use Apache::lonnet;
1.1       raeburn    37: use Apache::lonlocal;
1.34      albertel   38: use Apache::lonacc();
1.38      raeburn    39: use Apache::courseclassifier;
1.35      www        40: use LONCAPA;
                     41:  
1.1       raeburn    42: 
                     43: sub handler {
1.2       albertel   44:     my ($r) = @_;
                     45:     &Apache::loncommon::content_type($r,'text/html');
1.1       raeburn    46:     $r->send_http_header;
                     47: 
                     48:     if ($r->header_only) {
                     49:         return OK;
                     50:     }
1.42      albertel   51:     if ($r->uri eq '/adm/helpdesk') {
                     52: 	&Apache::lonlocal::get_language_handle($r);
                     53:     }
                     54: 
1.12      raeburn    55:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['origurl','function']);
                     56:     if ($r->uri eq '/adm/helpdesk') {
1.34      albertel   57:         &Apache::lonacc::get_posted_cgi($r);
1.12      raeburn    58:     }
1.25      albertel   59:     my $function = $env{'form.function'};
1.35      www        60:     my $origurl = &unescape($env{'form.origurl'});
1.44      raeburn    61:     my $command = $env{'form.command'};
1.12      raeburn    62: 
1.44      raeburn    63:     if ($command eq 'process') {
1.1       raeburn    64:         &print_request_receipt($r,$origurl,$function);
                     65:     } else {
                     66:         &print_request_form($r,$origurl,$function);
                     67:     }
                     68:     return OK;
                     69: }
                     70:     
                     71: sub print_request_form {
                     72:     my ($r,$origurl,$function) = @_;
1.29      raeburn    73:     my ($os,$browser,$bversion,$uhost,$uname,$udom,$uhome,$urole,$usec,$email,$cid,$cdom,$cnum,$ctitle,$ccode,$sectionlist,$lastname,$firstname,$server,$formname);
1.44      raeburn    74:     $function = &Apache::loncommon::get_users_function() if (!$function);
1.10      raeburn    75:     $ccode = '';
1.25      albertel   76:     $os = $env{'browser.os'};
                     77:     $browser = $env{'browser.type'};
                     78:     $bversion = $env{'browser.version'};
                     79:     $uhost = $env{'request.host'};
                     80:     $uname = $env{'user.name'};
                     81:     $udom = $env{'user.domain'};
                     82:     $uhome = $env{'user.home'};
                     83:     $urole = $env{'request.role'};
                     84:     $usec = $env{'request.course.sec'};
                     85:     $cid = $env{'request.course.id'};
1.29      raeburn    86:     $formname = 'logproblem';
1.40      raeburn    87:     my $machine = &Apache::lonnet::absolute_url();
                     88:     if ($origurl =~ m-^https?://-) {
1.21      raeburn    89:         $server = $origurl;
                     90:     } else {
1.40      raeburn    91:         $server = $machine.$origurl;
1.21      raeburn    92:     }
1.44      raeburn    93:     my $showserver = $server;
                     94:     $showserver =~ s/\?.*$//;
1.40      raeburn    95:     my %lt = &Apache::lonlocal::texthash (
                     96:                   email => 'The e-mail address you entered',
                     97:                   notv => 'is not a valid e-mail address',
                     98:                   rsub => 'You must include a subject',
                     99:                   rdes => 'You must include a description',
                    100:                   name => 'Name',
                    101:                   subm => 'Submit Request',
1.46      raeburn   102:                   emad => 'Your e-mail address',
                    103:                   emac => 'Cc', 
1.40      raeburn   104:                   unme => 'username',
                    105:                   doma => 'domain',
1.44      raeburn   106:                   entu => 'Enter the username you use to log-in to LON-CAPA',
                    107:                   chdo => 'Choose your LON-CAPA domain',
                    108:                   entr => 'Enter the username you use to log-in to LON-CAPA, and your domain.',
1.40      raeburn   109:                   urlp => 'URL of page',
                    110:                   phon => 'Phone',
                    111:                   crsd => 'Course Details',
                    112:                   enin => 'Enter institutional course code',
                    113:                   pick => 'Pick',
                    114:                   enct => 'Enter course title',
                    115:                   secn => 'Section Number',
                    116:                   sele => 'Select',
                    117:                   titl => 'Title',
                    118:                   lsec => 'LON-CAPA sec',
                    119:                   subj => 'Subject',
                    120:                   detd => 'Detailed Description',
                    121:                   opfi => 'Optional file upload',
1.44      raeburn   122:                   uplf => 'Upload a file (e.g., a screenshot) relevant to your help request (128 KB max.)',
1.40      raeburn   123:                   fini => 'Finish',
                    124:                   clfm => 'Clear Form',
                    125:     );
                    126:     my $scripttag = (<<"END");
1.5       raeburn   127: function validate() {
1.13      raeburn   128:     if (validmail(document.logproblem.email) == false) {
1.40      raeburn   129:         alert("$lt{'email'}: "+document.logproblem.email.value+" $lt{'notv'}.");
                    130:         return;
                    131:     }
                    132:     if (document.logproblem.subject.value == '') {
                    133:         alert("$lt{'rsub'}.");
                    134:         return;
                    135:     }
                    136:     if (document.logproblem.description.value == '') {
                    137:         alert("$lt{'rdes'}.");
1.13      raeburn   138:         return;
1.5       raeburn   139:     }
                    140:     document.logproblem.submit();
                    141: }
1.13      raeburn   142: 
1.40      raeburn   143: END
1.43      raeburn   144:     $scripttag .= &Apache::lonhtmlcommon::javascript_valid_email();
1.44      raeburn   145:     if ($cid) {
                    146:         $cdom = $env{'course.'.$cid.'.domain'};
                    147:         $cnum = $env{'course.'.$cid.'.num'};
1.1       raeburn   148:     }
                    149:     if ($cdom && $cnum) {
                    150:         my %csettings = &Apache::lonnet::get('environment',['description','internal.coursecode','internal.sectionnums'],$cdom,$cnum);
                    151:         $ctitle = $csettings{'description'};
                    152:         $ccode = $csettings{'internal.coursecode'};
                    153:         $sectionlist = $csettings{'internal.sectionnums'};
                    154:     }
1.44      raeburn   155: 
                    156:     if ($env{'environment.permanentemail'}) {
                    157:         $email = $env{'environment.permanentemail'};
                    158:     } elsif ($env{'environment.critnotification'}) {
1.25      albertel  159:         $email = $env{'environment.critnotification'};
1.44      raeburn   160:     } elsif ($env{'environment.notification'}) {
1.25      albertel  161:         $email = $env{'environment.notification'};
1.1       raeburn   162:     }
1.25      albertel  163:     if ($env{'environment.lastname'}) {
                    164:         $lastname = $env{'environment.lastname'};
1.1       raeburn   165:     }
1.25      albertel  166:     if ($env{'environment.firstname'}) {
                    167:         $firstname = $env{'environment.firstname'};
1.1       raeburn   168:     }
1.40      raeburn   169:     my @sections = split(/,/,$sectionlist);
                    170:     my %groupid;
                    171:     foreach my $section (@sections) {
                    172:         my ($sec,$grp) = split(/:/,$section);
1.1       raeburn   173:         $groupid{$sec} = $grp;
                    174:     }
1.19      raeburn   175:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['codedom']);
1.45      raeburn   176:     my $codedom = &get_domain();
1.21      raeburn   177:     my $details_title;
                    178:     if ($codedom) {
                    179:         $details_title = '<br />('.$codedom.')';
                    180:     }
1.40      raeburn   181:     my %coursecodes;
                    182:     my %codes;
                    183:     my @codetitles;
                    184:     my %cat_titles;
                    185:     my %cat_order;
                    186:     my %idlist;
                    187:     my %idnums;
                    188:     my %idlist_titles;
1.1       raeburn   189:     my $caller = 'global';
                    190:     my $totcodes = 0;
                    191:     my $format_reply;
1.6       raeburn   192:     my $jscript = '';
1.22      raeburn   193:     my $loaditems = qq|
                    194: function initialize_codes() {
                    195:     return;
                    196: }
                    197:     |;
1.1       raeburn   198:     if ($cnum) {
                    199:         $coursecodes{$cnum} = $ccode;
                    200:         if ($ccode eq '') {
1.38      raeburn   201:             $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
1.1       raeburn   202:         } else {
                    203:             $coursecodes{$cnum} = $ccode;
                    204:             $caller = $cnum;
                    205:             $totcodes ++;
                    206:         }
                    207:     } else { 
1.38      raeburn   208:         $totcodes = &Apache::courseclassifier::retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
1.1       raeburn   209:     }
                    210:     if ($totcodes > 0) {
1.6       raeburn   211:         if ($ccode eq '') {
1.22      raeburn   212:             $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
                    213:             if ($format_reply eq 'ok') {
                    214:                 my $numtypes = @codetitles;
1.38      raeburn   215:                 &Apache::courseclassifier::build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
                    216:                 my ($scripttext,$longtitles) = &Apache::courseclassifier::javascript_definitions(\@codetitles,\%idlist,\%idlist_titles,\%idnums,\%cat_titles);
                    217:                 my $longtitles_str = join('","',@{$longtitles});
                    218:                 my $allidlist = $idlist{$codetitles[0]};
                    219:                 $jscript .= &Apache::courseclassifier::courseset_js_start($formname,$longtitles_str,$allidlist);
                    220:                 $jscript .= $scripttext;
                    221:                 $jscript .= &Apache::courseclassifier::javascript_code_selections($formname,@codetitles);
1.22      raeburn   222:                 $loaditems = '';
                    223:             }
1.6       raeburn   224:         }
1.1       raeburn   225:     }
1.30      albertel  226: 	
1.44      raeburn   227:     my $js = '<script type="text/javascript">'."\n$scripttag\n$jscript\n".
1.31      albertel  228: 	'</script>';
1.33      albertel  229:     my %add_entries = (topmargin    => "0",
                    230: 		       marginheight => "0",
                    231: 		       onLoad       =>"initialize_codes()",);
                    232: 
1.44      raeburn   233:     
                    234:     $r->print(&Apache::loncommon::start_page('Support Request',$js,
1.31      albertel  235: 				       { 'function'    => $function,
1.33      albertel  236: 					 'add_entries' => \%add_entries,
1.44      raeburn   237: 					 'only_body'   => 1,}));
1.15      raeburn   238:     if ($r->uri eq '/adm/helpdesk') {
1.14      raeburn   239:         &print_header($r,$origurl);
                    240:     }
1.44      raeburn   241:     $r->print('<form method="post" name="logproblem" enctype="multipart/form-data">'."\n");
                    242:     my $output = &Apache::lonhtmlcommon::start_pick_box().
                    243:                  &Apache::lonhtmlcommon::row_title($lt{'name'},undef,'LC_oddrow_value')."\n";
1.1       raeburn   244:     my $fullname = '';
                    245:     if ((defined($lastname) && $lastname ne '') && (defined($firstname) && $firstname ne '')) {
                    246:         $fullname = "$firstname $lastname"; 
1.44      raeburn   247:         $output .= $fullname.'<input type="hidden" name="username" value="'.&HTML::Entities::encode($fullname,'"<>&').'" />';
1.1       raeburn   248:     } else {
                    249:         if (defined($firstname) && $firstname ne '') {
                    250:             $fullname = $firstname;
                    251:         } elsif (defined($lastname) && $lastname ne '') {
1.44      raeburn   252:             $fullname = " $lastname";
1.1       raeburn   253:         }
1.44      raeburn   254:         $output .= '<input type="text" size="20" name="username" value="'.&HTML::Entities::encode($fullname,'"<>&').'" />';
1.1       raeburn   255:     }
1.44      raeburn   256:     $output .= '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="'.$lt{'subm'}.'" onclick="validate()" />&nbsp;'.
                    257:                 &Apache::lonhtmlcommon::row_closure()."\n".
                    258:                 &Apache::lonhtmlcommon::row_title($lt{'emad'},undef,'LC_evenrow_value').
                    259:                 '<input type="text" size="20" name="email" value="'.
                    260:                 &HTML::Entities::encode($email,'"<>&').'" /><br />'."\n".
                    261:                 &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   262:                 &Apache::lonhtmlcommon::row_title($lt{'emac'},undef,'LC_oddrow_value').
                    263:                 '<input type="text" size="50" name="cc" value="" /><br />'."\n".
                    264:                 &Apache::lonhtmlcommon::row_closure().
                    265:                 &Apache::lonhtmlcommon::row_title("$lt{'unme'}/$lt{'doma'}",undef,'LC_evenrow_value');
1.44      raeburn   266:     my $udom_input = '<input type="hidden" name="udom" value="'.
                    267:                      &HTML::Entities::encode($udom,'"<>&').'" />';
                    268:     my $uname_input = '<input type="hidden" name="uname" value="'.
                    269:                       &HTML::Entities::encode($uname,'"<>&').'" />'; 
1.1       raeburn   270:     if (defined($uname) && defined($udom)) {
1.44      raeburn   271:         $output .= '<i>'.$lt{'unme'}.'</i>:&nbsp;'.$uname.'&nbsp;&nbsp;<i>'.$lt{'doma'}.'</i>:&nbsp;'.$udom.$udom_input.$uname_input;
1.1       raeburn   272:     } else {
                    273:         my $udomform = '';
                    274:         my $unameform = '';
                    275:         if (defined($udom)) {
1.44      raeburn   276:             $output .= $lt{'entu'};
                    277:         } elsif (defined($uname)) {
                    278:             $output .= $lt{'chdo'};
                    279:         } else {
                    280:             $output .= $lt{'entr'};
                    281:         }
                    282:         $output .= '<br />';
                    283:         if (defined($udom)) {
1.40      raeburn   284:             $udomform = '<i>'.$lt{'doma'}.'</i>:&nbsp;'.$udom.$udom_input;
1.1       raeburn   285:         } elsif (defined($uname)) {
1.40      raeburn   286:             $unameform = '<i>'.$lt{'unme'}.'</i>:&nbsp;'.$uname.'&nbsp;&nbsp;'.$uname_input;
1.1       raeburn   287:         }
                    288:         if ($udomform eq '') {
1.40      raeburn   289:             $udomform = '<i>'.$lt{'doma'}.'</i>:&nbsp;';
1.19      raeburn   290:             $udomform .= &Apache::loncommon::select_dom_form($codedom,'udom');
1.1       raeburn   291:         }
                    292:         if ($unameform eq '') {
1.40      raeburn   293:             $unameform= '<i>'.$lt{'unme'}.'</i>:&nbsp;<input type="text" size="12" name="uname" value="'.$uname.'" />&nbsp;&nbsp;';
1.1       raeburn   294:         }
1.44      raeburn   295:         $output .= $unameform.$udomform;
1.1       raeburn   296:     }
1.44      raeburn   297:     $output .= &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   298:                &Apache::lonhtmlcommon::row_title("$lt{'urlp'}",undef,'LC_oddrow_value').
1.44      raeburn   299:                $showserver.'<input type="hidden" name="sourceurl" value="'.
                    300:                &HTML::Entities::encode($server,'"<>&').'" />'.
                    301:                &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   302:                &Apache::lonhtmlcommon::row_title("$lt{'phon'}",undef,'LC_evenrow_value').
1.44      raeburn   303:                '<input type="text" size="15" name="phone" /><br />'.
                    304:                &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   305:                &Apache::lonhtmlcommon::row_title("$lt{'crsd'}$details_title",undef,'LC_oddrow_value');
                    306:     if ($cnum) {
1.10      raeburn   307:         if ($coursecodes{$cnum}) {
1.40      raeburn   308:             foreach my $item (@codetitles) {
1.44      raeburn   309:                 $output .= '<i>'.$item.'</i>:&nbsp;'.$codes{$cnum}{$item}.';&nbsp;';
1.10      raeburn   310:             }
1.44      raeburn   311:             $output .= '&nbsp;<input type="hidden" name="coursecode" value="'.&HTML::Entities::encode($coursecodes{$cnum},'"<>&').'" />';
1.10      raeburn   312:         } else {
1.44      raeburn   313:             $output .= $lt{'enin'}.':&nbsp;
                    314:                   <input type="text" name="coursecode" size="15" value="" />';
1.1       raeburn   315:         }
                    316:     } else {
1.10      raeburn   317:         if ($totcodes > 0) {
                    318:             my $numtitles = @codetitles;
                    319:             if ($numtitles == 0) {
1.44      raeburn   320:                 $output .= $lt{'enin'}.':&nbsp;
                    321:                   <input type="text" name="coursecode" size="15" value="" />';
1.10      raeburn   322:             } else {
                    323:                 my $lasttitle = $numtitles;
                    324:                 if ($numtitles > 4) {
                    325:                     $lasttitle = 4;
                    326:                 } 
1.44      raeburn   327:                 $output .= '<table><tr><td>'.$codetitles[0].'<br />'."\n".
                    328:                       '<select name="'.$codetitles[0].'" onchange="courseSet('."'$codetitles[0]'".')">'."\n".
                    329:                       ' <option value="-1" />'.$lt{'sele'}."\n";
1.10      raeburn   330:                 my @items = ();
1.20      raeburn   331:                 my @longitems = ();
1.10      raeburn   332:                 if ($idlist{$codetitles[0]} =~ /","/) {
1.40      raeburn   333:                     @items = split(/","/,$idlist{$codetitles[0]});
1.10      raeburn   334:                 } else {
                    335:                     $items[0] = $idlist{$codetitles[0]};
                    336:                 }
1.20      raeburn   337:                 if (defined($idlist_titles{$codetitles[0]})) {
                    338:                     if ($idlist_titles{$codetitles[0]} =~ /","/) {
1.40      raeburn   339:                         @longitems = split(/","/,$idlist_titles{$codetitles[0]});
1.20      raeburn   340:                     } else {
                    341:                         $longitems[0] = $idlist_titles{$codetitles[0]};
                    342:                     }
1.22      raeburn   343:                     for (my $i=0; $i<@longitems; $i++) {
                    344:                         if ($longitems[$i] eq '') {
                    345:                             $longitems[$i] = $items[$i];
                    346:                         }
                    347:                     }
1.20      raeburn   348:                 } else {
                    349:                     @longitems = @items;
                    350:                 }
                    351:                 for (my $i=0; $i<@items; $i++) {
1.44      raeburn   352:                     $output .= ' <option value="'.$items[$i].'">'.$longitems[$i].'</option>'."\n";
1.10      raeburn   353:                 }
1.44      raeburn   354:                 $output .= '</select></td>';
1.10      raeburn   355:                 for (my $i=1; $i<$numtitles; $i++) {
1.44      raeburn   356:                     $output .= '<td>'.$codetitles[$i].'<br />'."\n".
                    357:                      '<select name="'.$codetitles[$i].'" onchange="courseSet('."'$codetitles[$i]'".')">'."\n".
1.40      raeburn   358:                      '<option value="-1">&lt;-'.$lt{'pick'}.' '.$codetitles[$i-1].'</option>'."\n".
1.10      raeburn   359:                      '</select>'."\n".
1.44      raeburn   360:                      '</td>'."\n";
1.10      raeburn   361:                 }
1.44      raeburn   362:                 $output .= '</tr></table>';
1.10      raeburn   363:                 if ($numtitles > 4) {
1.44      raeburn   364:                     $output .= '<br /><br />'.$codetitles[$numtitles].'<br />'."\n".
                    365:                           '<select name="'.$codetitles[$numtitles].'" onchange="courseSet('."'$codetitles[$numtitles]'".')">'."\n".
1.40      raeburn   366:                           '<option value="-1">&lt;-'.$lt{'pick'}.' '.$codetitles[$numtitles-1].'</option>'."\n".
1.44      raeburn   367:                           '</select>'."\n";
1.10      raeburn   368:                 }
                    369:             }
                    370:         } else {
1.44      raeburn   371:             $output .= $lt{'enin'}.':&nbsp;
                    372:                   <input type="text" name="coursecode" size="15" value="" />';
1.10      raeburn   373:         }
1.1       raeburn   374:     }
                    375:     if ($ctitle) {
1.44      raeburn   376:         $output .= '<br /><i>'.$lt{'titl'}.'</i>:&nbsp;'.$ctitle.
                    377:                    '<input type="hidden" name="title" value="'.
                    378:                    &HTML::Entities::encode($ctitle,'"<>&').'" />'."\n";
1.1       raeburn   379:     } else {
1.44      raeburn   380:         $output .= '<br />'.$lt{'enct'}.':&nbsp;
                    381:                  <input type="text" name="title" size="25" value="" />'."\n";
1.1       raeburn   382:     }
1.44      raeburn   383:     $output .= &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   384:                &Apache::lonhtmlcommon::row_title($lt{'secn'},undef,'LC_evenrow_value');
1.1       raeburn   385:     if ($sectionlist) {
1.44      raeburn   386:         $output .= "<select name=\"section\"\n>".
                    387:                    "  <option value=\"\" selected=\"selected\">$lt{'sele'}</option>\n";
1.40      raeburn   388:         foreach my $id (sort(keys(%groupid))) {
                    389:             if ($id eq $groupid{$id} || $groupid{$id} eq '') {
1.44      raeburn   390:                 $output .= "  <option value=".
                    391:                            &HTML::Entities::encode($id,'"<>&').
                    392:                            " >$id</option>\n";
1.1       raeburn   393:             } else {
1.44      raeburn   394:                 $output .= "  <option value=".
                    395:                            &HTML::Entities::encode($id,'"<>&').
                    396:                            " >$id - ($lt{'lsec'}: $groupid{$id})</option>\n";
1.1       raeburn   397:             }
                    398:         }
1.44      raeburn   399:         $output .= "</select>";
1.1       raeburn   400:     } else {
1.44      raeburn   401:         $output .= '<input type="text" name="section" size="10" />';
1.1       raeburn   402:     }
1.44      raeburn   403:     $output .= &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   404:                &Apache::lonhtmlcommon::row_title($lt{'subj'},undef,'LC_oddrow_value').
1.44      raeburn   405:                '  <input type="text" size="40" name="subject" />'."\n".
                    406:                &Apache::lonhtmlcommon::row_closure().
1.46      raeburn   407:                &Apache::lonhtmlcommon::row_title($lt{'detd'},undef,'LC_evenrow_value').
1.44      raeburn   408:                '  <textarea rows="10" cols="45" name="description" wrap="virtual"></textarea>'.
                    409:                &Apache::lonhtmlcommon::row_closure();
                    410:     my $lastrow = 'LC_evenrow_value';
1.25      albertel  411:     if (defined($env{'user.name'})) {
1.46      raeburn   412:         $output .= &Apache::lonhtmlcommon::row_title($lt{'opfi'},undef,'LC_oddrow_value').
1.44      raeburn   413:                    ' <input type="file" name="screenshot" size="20" /><br />'.$lt{'uplf'}."\n".
                    414:         &Apache::lonhtmlcommon::row_closure();
                    415:         $lastrow = 'LC_oddrow_value';
1.5       raeburn   416:     }
1.44      raeburn   417:     $output .= &Apache::lonhtmlcommon::row_title($lt{'fini'},undef,$lastrow);
                    418:     $output .= <<END;
1.1       raeburn   419:              <table border="0" cellpadding="8" cellspacing="0">
                    420:               <tr>
                    421:                <td>
1.44      raeburn   422:                 <input type="hidden" name="command" value="process" />
                    423:                 <input type="button" value="$lt{'subm'}" onclick="validate()" /> &nbsp;
1.1       raeburn   424:                </td>
                    425:                <td>&nbsp;</td>
                    426:                <td>
1.44      raeburn   427:                 <input type="reset" value="$lt{'clfm'}" />
1.1       raeburn   428:                </td>
                    429:               </tr>
                    430:              </table>
1.44      raeburn   431: END
                    432:     $output .= &Apache::lonhtmlcommon::row_closure(1);
                    433:     $output .= &Apache::lonhtmlcommon::end_pick_box();
                    434:     $r->print(<<END);
                    435: $output
1.14      raeburn   436: </form>
1.44      raeburn   437: <br />
1.1       raeburn   438: END
1.30      albertel  439:     $r->print(&Apache::loncommon::end_page());
1.5       raeburn   440:     return;
1.1       raeburn   441: }
                    442: 
                    443: sub print_request_receipt {
                    444:     my ($r,$url,$function) = @_;
1.26      raeburn   445:     my @ENVvars = ('HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME');
                    446:     my @envvars = ('browser.os','browser.type','browser.version','user.home','request.role');
1.5       raeburn   447:     my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
1.27      raeburn   448:     my @cookievars = ('lonID');
1.5       raeburn   449: 
                    450:     my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
1.45      raeburn   451:     my $origmail = $Apache::lonnet::perlvar{'lonSupportEMail'};
                    452:     my $defdom = &get_domain();
                    453:     my $to = &Apache::loncommon::build_recipient_list(undef,'helpdeskmail',
                    454:                                                       $defdom,$origmail);
1.5       raeburn   455:     my $from = $admin;
1.1       raeburn   456:     my $reporttime = &Apache::lonlocal::locallocaltime(time);
1.14      raeburn   457:     my @formvars = ('username','email','uname','udom','sourceurl','phone','section','coursecode','title','subject','description','screenshot');
1.20      raeburn   458: 
1.1       raeburn   459:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},\@formvars);
1.25      albertel  460:     my $coursecode = $env{'form.coursecode'};
1.19      raeburn   461:     if ($coursecode eq '') {
1.25      albertel  462:         if (defined($env{'form.Year'})) {
                    463:             $coursecode .= $env{'form.Year'};
1.19      raeburn   464:         }
1.25      albertel  465:         if (defined($env{'form.Semester'})) {
                    466:             $coursecode .= $env{'form.Semester'};
1.19      raeburn   467:         }
1.25      albertel  468:         if (defined($env{'form.Department'})) {
                    469:             $coursecode .= $env{'form.Department'};
1.19      raeburn   470:         }
1.25      albertel  471:         if (defined($env{'form.Number'})) {
                    472:             $coursecode .= $env{'form.Number'};
1.19      raeburn   473:         }
                    474:     }
1.40      raeburn   475:     my %lt = &Apache::lonlocal::texthash (
1.44      raeburn   476:                  username    => 'Name',
                    477:                  email       => 'Email',
1.46      raeburn   478:                  cc          => 'Cc',
1.44      raeburn   479:                  user        => 'Username/domain',
                    480:                  phone       => 'Phone',
                    481:                  crsi        => 'Course Information',
                    482:                  subject     => 'Subject',
                    483:                  description => 'Description',
                    484:                  sourceurl   => 'URL',
                    485:                  date        => 'Date/Time',
                    486:                  secn        => 'Section',
                    487:                  asup        => 'A support request has been sent to',
                    488:                  warn        => 'Warning: Problem with support e-mail address',
                    489:                  your        => 'Your support request contained the following information',
                    490:                  sect        => 'section',
                    491:                  info        => 'Information supplied',
                    492:                  adin        => 'Additional information recorded',
1.40      raeburn   493:     );
1.46      raeburn   494: 
                    495:     my (@ok_ccs,@bad_ccs,$badccmsg,$okcclist);
                    496:     if (defined($env{'form.cc'})) {
                    497:         my @ccs;
                    498:         if ($env{'form.cc'} =~ /,/) {
                    499:             @ccs = split(/,/,$env{'form.cc'});
                    500:         } else {
                    501:             $env{'form.cc'} =~ s/^\s+//;
                    502:             $env{'form.cc'} =~ s/\s+$//;
                    503:             @ccs = $env{'form.cc'};
                    504:         }
                    505:         foreach my $cc (@ccs) {
                    506:             $cc =~ s/^\s+//g;
                    507:             $cc =~ s/\s+$//g;
                    508:             if ($cc =~ m/^[^\@]+\@[^\@]+$/) {
                    509:                 if (!(grep(/^\Q$cc\E$/,@ok_ccs))) {
                    510:                     push(@ok_ccs,$cc);
                    511:                 }
                    512:             } else {
                    513:                 if (!(grep(/^\Q$cc\E$/,@bad_ccs))) {
                    514:                     push(@bad_ccs,$cc);
                    515:                 }
                    516:             }
                    517:         }
                    518:         if (@ok_ccs > 0) {
                    519:            $okcclist = join(', ',@ok_ccs); 
                    520:         } 
                    521:         if (@bad_ccs == 1) {
                    522:             $badccmsg .= '<br />'.&mt('The following Cc e-mail address is invalid: ').$bad_ccs[0];
                    523:         } elsif (@bad_ccs > 1) {
                    524:             my $bad_cc_string = join(', ',@bad_ccs);
                    525:             $badccmsg .= '<br />'.&mt('The following Cc e-mail addresses are invalid: ').$bad_cc_string;
                    526:         }
                    527:     }
1.44      raeburn   528:     $env{'form.user'} = "'".$env{'form.uname'}.':'.$env{'form.udom'}."'";
                    529:     $env{'form.csri'} = $env{'form.title'}.' - '.$coursecode.' - '.$lt{'sect'}.': '.$env{'form.section'};
                    530:     my $supportmsg = <<END;
                    531: $lt{'username'}: $env{'form.username'}
1.40      raeburn   532: $lt{'email'}: $env{'form.email'}
1.46      raeburn   533: $lt{'cc'}: $okcclist
1.44      raeburn   534: $lt{'user'}: $env{'form.user'}
                    535: $lt{'phone'}: $env{'form.phone'}
                    536: $lt{'crsi'}: $env{'form.csri'}
                    537: $lt{'subject'}: $env{'form.subject'}
                    538: $lt{'description'}: $env{'form.description'}
                    539: $lt{'sourceurl'}: $env{'form.sourceurl'}
1.40      raeburn   540: $lt{'date'}: $reporttime
1.1       raeburn   541: 
1.44      raeburn   542: END
                    543:     my $displaymsg;
1.46      raeburn   544:     foreach my $item ('username','email','cc','user','phone','crsi','subject','description','sourceurl') {
1.44      raeburn   545:         if ($env{'form.'.$item} ne '') {
                    546:             if ($item eq 'description') {
                    547:                 my $descrip = $env{'form.description'};
                    548:                 $descrip =~ s|\n|<br />|g;
                    549:                 $displaymsg .= 
                    550:                     '<span class="LC_helpform_receipt_cat">'.
                    551:                     "$lt{$item}</span>: $descrip<br />\n";
                    552:             } elsif ($item eq 'sourceurl') {
                    553:                 my $showurl = $env{'form.sourceurl'};
                    554:                 $showurl =~ s/\?.*$//;
                    555:                 $displaymsg .= 
                    556:                     '<span class="LC_helpform_receipt_cat">'.
                    557:                     "$lt{$item}</span>: $showurl<br />\n";
1.46      raeburn   558:             } elsif ($item eq 'cc') {
                    559:                 $displaymsg .=
                    560:                     '<span class="LC_helpform_receipt_cat">'.
                    561:                     "$lt{$item}</span>: $okcclist<br />\n";
1.44      raeburn   562:             } else {
                    563:                 $displaymsg .= 
                    564:                     '<span class="LC_helpform_receipt_cat">'.
                    565:                     "$lt{$item}</span>: $env{'form.'.$item}<br />\n";
                    566:             }
                    567:         }
                    568:     }
                    569:     $displaymsg .= '<span class="LC_helpform_receipt_cat">'.
                    570:                    $lt{'date'}.'</span>: '.$reporttime.'<br />'."\n";
1.32      albertel  571: 
                    572:     my $start_page = 
                    573: 	&Apache::loncommon::start_page('Support request recorded',undef,
1.33      albertel  574: 				       {'function'    => $function,
                    575: 					'add_entries' => {
                    576: 					    topmargin    => "0",
                    577: 					    marginheight => "0",
                    578: 					},
                    579: 					'only_body'   => 1,});
1.32      albertel  580: 
1.14      raeburn   581:     $r->print(<<"END");
1.32      albertel  582: $start_page
1.16      raeburn   583: <form name="logproblem">
1.44      raeburn   584: <input type="hidden" name="command" value="result" />
1.16      raeburn   585: </form>
1.1       raeburn   586: END
1.14      raeburn   587:     if ($r->uri eq '/adm/helpdesk') {
                    588:         &print_header($r,$url,'process');
                    589:     }
1.45      raeburn   590:     my $bad_email = 0;
                    591:     if ($to =~ /,/) {
                    592:         my @ok_email; 
                    593:         foreach my $email (split(/,/,$to)) {
                    594:             if ($email =~ m/^[^\@]+\@[^\@]+$/) {
1.46      raeburn   595:                 if (!grep(/^\Q$email\E$/,@ok_email)) {
                    596:                     push(@ok_email,$email);
                    597:                 }
1.45      raeburn   598:             }
                    599:         }
                    600:         if (@ok_email > 0) {
                    601:             $to = join(',',@ok_email);
                    602:         } elsif ($admin =~ m/^[^\@]+\@[^\@]+$/) {
                    603:             $to = $admin;
                    604:         } else {
                    605:             $bad_email = 1;
                    606:         }
                    607:     } elsif ($to !~ m/^[^\@]+\@[^\@]+$/) {
                    608:         if ($admin =~ m/^[^\@]+\@[^\@]+$/) {
                    609:             $to = $admin;
1.9       raeburn   610:         } else {
1.45      raeburn   611:             $bad_email = 1;
                    612:         }
                    613:     }
                    614:     if ($bad_email) {
                    615:         $r->print('
1.40      raeburn   616:  <h3>'.$lt{'warn'}.'</h3>'.
                    617: &mt('As the e-mail address provided for this LON-CAPA server ([_1]) does not appear to be a valid e-mail address, your support request has <b>not</b> been sent to the LON-CAPA support staff or administrator at your institution.',$to).' '.&mt('Instead a copy has been sent to the LON-CAPA support team at Michigan State University.')); 
1.9       raeburn   618:             $to = 'helpdesk@lon-capa.org';
1.45      raeburn   619:     } else {
                    620:         $r->print('<h3>'.$lt{'asup'}.' '.$to.'</h3>');
1.1       raeburn   621:     }
1.25      albertel  622:     if (defined($env{'form.email'})) {
1.46      raeburn   623:         $env{'form.email'} =~ s/^\s+//;
                    624:         $env{'form.email'} =~ s/\s+$//;
1.25      albertel  625:         if ($env{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
                    626:             $from = $env{'form.email'};
1.5       raeburn   627:         }
                    628:     }
                    629: 
1.46      raeburn   630:     if (defined($env{'form.cc'})) {
                    631:         if ($badccmsg) {
                    632:             $displaymsg .= $badccmsg;
                    633:         }
                    634:     }
                    635: 
1.25      albertel  636:     my $subject = $env{'form.subject'};
1.44      raeburn   637:     $subject =~ s/(`)/'/g;
                    638:     $subject =~ s/\$/\(\$\)/g;
                    639:     $supportmsg =~ s/(`)/'/g;
                    640:     $supportmsg =~ s/\$/\(\$\)/g;
                    641:     $displaymsg =~ s/(`)/'/g;
                    642:     $displaymsg =~ s/\$/\(\$\)/g;
1.5       raeburn   643:     my $fname;
                    644: 
                    645:     my $attachmentpath = '';
                    646:     my $attachmentsize = '';
1.25      albertel  647:     if (defined($env{'user.name'})) {
                    648:         if ($env{'form.screenshot.filename'}) {
                    649:             $attachmentsize = length($env{'form.screenshot'});
1.5       raeburn   650:             if ($attachmentsize > 131072) {
1.40      raeburn   651:                 $displaymsg .= '<br />'.&mt('The uploaded screenshot file ([_1] bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.',$attachmentsize);
1.5       raeburn   652:             } else {
                    653:                 $attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
                    654:             }
                    655:         }
                    656:     }
                    657: 
1.40      raeburn   658:     my %cookies;
1.27      raeburn   659:     my $cookie=CGI::Cookie->parse($r->header_in('Cookie'));
1.39      albertel  660:     if ($$cookie{'lonID'} =~ /lonID=($LONCAPA::handle_re);/) {
1.27      raeburn   661:         $cookies{'lonID'} = $1;
                    662:     }
                    663: 
1.5       raeburn   664:     if ($attachmentpath =~ m-/([^/]+)$-) {
                    665:         $fname = $1;
1.44      raeburn   666:         $displaymsg .= '<br />'.&mt('An uploaded screenshot file \'[_1]\' ([_2] bytes) was included in the request sent by [_3].',$fname,$attachmentsize,$env{'user.name'}.': '.$env{'user.domain'});
1.5       raeburn   667:         $supportmsg .= "\n";
1.40      raeburn   668:         foreach my $var (@cookievars) {
                    669:             $supportmsg .= "$var: $cookies{$var}\n";
1.27      raeburn   670:         }
1.40      raeburn   671:         foreach my $var(@ENVvars) {
                    672:             $supportmsg .= "$var: $ENV{$var}\n";
1.26      raeburn   673:         }
1.40      raeburn   674:         foreach my $var (@envvars) {
                    675:             $supportmsg .= "$var: $env{$var}\n";
1.5       raeburn   676:         }
                    677:     }
                    678:  
                    679:     my $msg = MIME::Lite->new(
                    680:                  From    => $from,
                    681:                  To      => $to,
                    682:                  Subject => $subject,
                    683:                  Type    =>'TEXT',
                    684:                  Data    => $supportmsg,
                    685:                  );
1.46      raeburn   686:     if (@ok_ccs > 0) {
                    687:         my $cc_string = join(', ',@ok_ccs);
                    688:         $msg->add("Cc" => $cc_string);
                    689:     }
1.5       raeburn   690: 
                    691:     if ($attachmentpath) {
                    692:         my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
                    693:         $msg->attach(Type     => $type,
                    694:                      Path     => $attachmentpath,
                    695:                      Filename => $fname
                    696:                      );
                    697: 
                    698:     } else {
                    699:         my $envdata = '';
1.40      raeburn   700:         foreach my $var (@cookievars) {
                    701:             $envdata .= "$var: $cookies{$var}\n";
1.27      raeburn   702:         }
1.40      raeburn   703:         foreach my $var (@ENVvars) {
                    704:             $envdata .= "$var: $ENV{$var}\n";
1.26      raeburn   705:         }
1.40      raeburn   706:         foreach my $var (@envvars) {
                    707:             $envdata .= "$var: $env{$var}\n";
1.5       raeburn   708:         }
1.40      raeburn   709:         foreach my $var (@loncvars) {
                    710:             $envdata .= "$var: $env{$var}\n";
1.5       raeburn   711:         }
                    712:         $msg->attach(Type => 'TEXT',
                    713:                      Data => $envdata);
                    714:     }
                    715: 
                    716: ### Send it:
                    717:     $msg->send('sendmail');
                    718: 
1.44      raeburn   719:     if ($attachmentpath =~ m|$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+|) {
1.5       raeburn   720:         unlink($attachmentpath);
                    721:     }
1.44      raeburn   722:     $r->print('<b>'.$lt{'your'}.'</b>:<br /><br />'."\n");
                    723:     $r->print(&Apache::lonhtmlcommon::start_pick_box('LC_helpform_receipt').
                    724:               &Apache::lonhtmlcommon::row_title($lt{'info'},undef,'LC_oddrow_value')."\n".$displaymsg."\n".
                    725:               &Apache::lonhtmlcommon::row_closure().
                    726:               &Apache::lonhtmlcommon::row_title($lt{'adin'},undef,'LC_evenrow_value'));
                    727:     my $envmsg;
1.40      raeburn   728:     foreach my $var (@cookievars) {
1.44      raeburn   729:         if ($cookies{$var} ne '') {
                    730:             $envmsg.= '<span class="LC_helpform_receipt_cat">'.
                    731:                       $var.'</span>:&nbsp;'.$cookies{$var}.', ';
1.27      raeburn   732:         }
                    733:     }
1.40      raeburn   734:     foreach my $var (@ENVvars) {
1.44      raeburn   735:         if ($ENV{$var} ne '') {
                    736:             $envmsg .= '<span class="LC_helpform_receipt_cat">'.
                    737:                        $var.'</span>:&nbsp;'.$ENV{$var}.', ';
1.26      raeburn   738:         }
                    739:     }
1.40      raeburn   740:     foreach my $var (@envvars) {
1.44      raeburn   741:         if ($env{$var} ne '') { 
                    742:             $envmsg .= '<span class="LC_helpform_receipt_cat">'.
                    743:                        $var.'</span>:&nbsp;'.$env{$var}.', ';
1.5       raeburn   744:         }
1.1       raeburn   745:     }
1.44      raeburn   746:     $envmsg =~ s/, $//;
                    747:     $r->print($envmsg."\n".
                    748:               &Apache::lonhtmlcommon::row_closure(1)."\n".
                    749:               &Apache::lonhtmlcommon::end_pick_box()."\n".
                    750:               &Apache::loncommon::end_page());
1.1       raeburn   751: }
                    752: 
1.14      raeburn   753: sub print_header {
1.44      raeburn   754:     my ($r,$origurl,$command) = @_;
1.14      raeburn   755:     my $location=&Apache::loncommon::lonhttpdurl("/adm");
                    756:     my ($component_url);
                    757:     my $helpdesk_link = '<a href="javascript:validate()">';
1.44      raeburn   758:     if ($command eq 'process') {
1.14      raeburn   759:         $helpdesk_link = '<a href="/adm/helpdesk">';
                    760:     }
                    761:     my %lt = &Apache::lonlocal::texthash (
                    762:                                            login => 'Log-in help',
                    763:                                            ask   => 'Ask helpdesk',
                    764:                                            getst => 'Getting started guide',
1.47      bisitz    765:                                            back =>  'Back to last location',
                    766:                                            headline => 'help/support',
1.21      raeburn   767:                                          );
1.47      bisitz    768:     my ($getstartlink,$reviewtext);
1.21      raeburn   769:     if (-e $Apache::lonnet::perlvar{'lonDocRoot'}.'/adm/gettingstarted.html') {
                    770:         $getstartlink = qq|<td align="center">&nbsp;<b><a href="/adm/gettingstarted.html">$lt{'getst'}</a></td>|;
1.47      bisitz    771:         $reviewtext = &mt('Please review the information in "Log-in help" and the "Getting started" guide if you are unable to log-in.');
                    772:     } else {
                    773:         $reviewtext = &mt('Please review the information in "Log-in help" if you are unable to log-in.');
1.21      raeburn   774:     }
1.14      raeburn   775:     $r->print(<<END);
                    776: <table width="620" border="0" cellspacing="0" cellpadding="0" height="55">   <tr height="50">    <td width='5'>&nbsp;</td>
                    777:    <td>
1.47      bisitz    778:     <fieldset><legend><img src="$location/lonIcons/minilogo.gif" height='20' width='29' valign='bottom' />&nbsp;&nbsp;<b><font size="+1">LON-CAPA $lt{'headline'}</font></b></legend>
1.44      raeburn   779:  <table id="LC_helpmenu_links">
                    780:    <tr>
1.49    ! raeburn   781:     <td align="center"><span class="LC_nobreak"><img src="$location/help/help.png" border="0" alt="($lt{'login'})" valign="middle" />&nbsp;<b><a href="/adm/loginproblems.html">$lt{'login'}</a></b>&nbsp;</span></td>
1.44      raeburn   782:     <td align="center"><span class="LC_nobreak">&nbsp;<b>$helpdesk_link<img src="$location/lonIcons/helpdesk.gif" border="0" alt="($lt{'ask'})" valign="middle" />&nbsp;$lt{'ask'}</a></b>&nbsp;</span></td>$getstartlink
                    783:     <td align="center"><span class="LC_nobreak">&nbsp;<b><a href="$origurl" target="_top"><img src="$location/lonIcons/move_up.gif" border="0" alt="($lt{'back'})" valign="middle" />&nbsp;$lt{'back'}</a></b>&nbsp;</span></td>
                    784:    </tr>
1.14      raeburn   785:  </table>
                    786: </fieldset>
                    787:   </td>
                    788:   <td width='5'>&nbsp;</td>
                    789:  </tr>
                    790:  <tr height='5'>
                    791:   <td colspan='3' height='5'>&nbsp;</td>
                    792:  </tr>
                    793: END
1.44      raeburn   794:     if  ($command ne 'process') {
1.14      raeburn   795:         $r->print('
                    796:  <tr>
1.47      bisitz    797:   <td colspan="3">'.$reviewtext.' '
                    798: .&mt('If your problem is still unresolved, the form below can be used to send a question to the LON-CAPA helpdesk.').'<br />'
                    799: .'<font size="-1"><b>'.&mt('Students').'</b>: '.&mt('Do <b>not</b> use this form to ask questions about course content.').' '
                    800: .&mt('Contact your instructor instead.')
                    801: .'</font><br /><br />
1.14      raeburn   802:   </td>
                    803:  </tr>');
                    804:     }
                    805:     $r->print('
                    806: </table>');
                    807:     return;
                    808: }
                    809: 
1.45      raeburn   810: sub get_domain {
                    811:     my $codedom;
                    812:     if (exists($env{'form.codedom'})) {
                    813:         $codedom = $env{'form.codedom'};
                    814:     } elsif ($env{'request.course.id'}) {
                    815:         $codedom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    816:     } elsif ($env{'request.role.domain'}) {
                    817:         $codedom = $env{'request.role.domain'};
                    818:     } else {
                    819:         $codedom = $Apache::lonnet::perlvar{'lonDefDomain'};
                    820:     }
                    821:     return $codedom;
                    822: }
                    823: 
1.1       raeburn   824: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.