File:  [LON-CAPA] / loncom / interface / lonsupportreq.pm
Revision 1.18: download - view: text, annotated - select for diffs
Mon Dec 20 21:09:29 2004 UTC (19 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: version_1_3_0, HEAD
xhtml compliance.

    1: package Apache::lonsupportreq;
    2: 
    3: use strict;
    4: use lib qw(/home/httpd/lib/perl);
    5: use MIME::Types;
    6: use MIME::Lite;
    7: use Apache::Constants qw(:common);
    8: use Apache::loncommon();
    9: use Apache::lonnet();
   10: use Apache::lonlocal;
   11: 
   12: sub handler {
   13:     my ($r) = @_;
   14:     &Apache::loncommon::content_type($r,'text/html');
   15:     $r->send_http_header;
   16: 
   17:     if ($r->header_only) {
   18:         return OK;
   19:     }
   20:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['origurl','function']);
   21:     if ($r->uri eq '/adm/helpdesk') {
   22:         &Apache::loncommon::get_posted_cgi($r);
   23:     }
   24:     my $function = $ENV{'form.function'};
   25:     my $origurl = &Apache::lonnet::unescape($ENV{'form.origurl'});
   26:     my $action = $ENV{'form.action'};
   27: 
   28:     if ($action eq 'process') {
   29:         &print_request_receipt($r,$origurl,$function);
   30:     } else {
   31:         &print_request_form($r,$origurl,$function);
   32:     }
   33:     return OK;
   34: }
   35:     
   36: sub print_request_form {
   37:     my ($r,$origurl,$function) = @_;
   38:     my ($os,$browser,$bversion,$uhost,$uname,$udom,$uhome,$urole,$usec,$email,$cid,$cdom,$cnum,$ctitle,$ccode,$sectionlist,$lastname,$firstname,$server);
   39:     my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0",marginheight="0"',1);
   40:     my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
   41:     if (($tablecolor eq '') || ($tablecolor eq '#FFFFFF')) {
   42:         $tablecolor = '#EEEE99';
   43:     }
   44:     $ccode = '';
   45:     $os = $ENV{'browser.os'};
   46:     $browser = $ENV{'browser.type'};
   47:     $bversion = $ENV{'browser.version'};
   48:     $uhost = $ENV{'request.host'};
   49:     $uname = $ENV{'user.name'};
   50:     $udom = $ENV{'user.domain'};
   51:     $uhome = $ENV{'user.home'};
   52:     $urole = $ENV{'request.role'};
   53:     $usec = $ENV{'request.course.sec'};
   54:     $cid = $ENV{'request.course.id'};
   55:     $server = $ENV{'SERVER_NAME'};
   56:     my $scripttag = (<<'END');
   57: function validate() {
   58:     if (validmail(document.logproblem.email) == false) {
   59:         alert("The e-mail address you entered: "+document.logproblem.email.value+" is not a valid e-mail address.");
   60:         return;
   61:     }
   62:     document.logproblem.submit();
   63: }
   64: 
   65: function validmail(field) {
   66:     var str = field.value;
   67:     if (window.RegExp) {
   68:         var reg1str = "(@.*@)|(\\.\\.)|(@\\.)|(\\.@)|(^\\.)";
   69:         var reg2str = "^.+\\@(\\[?)[a-zA-Z0-9\\-\\.]+\\.([a-zA-Z]{2,3}|[0-9]{1,3})(\\]?)$";
   70:         var reg1 = new RegExp(reg1str);
   71:         var reg2 = new RegExp(reg2str);
   72:         if (!reg1.test(str) && reg2.test(str)) {
   73:             return true;
   74:         }
   75:         return false;
   76:     }
   77:     else
   78:     {
   79:         if(str.indexOf("@") >= 0) {
   80:             return true;
   81:         }
   82:         return false;
   83:     }
   84: }
   85: END
   86:     if ($cid =~ m/_/) {
   87:         ($cdom,$cnum) = split/_/,$cid;
   88:     }
   89:     if ($cdom && $cnum) {
   90:         my %csettings = &Apache::lonnet::get('environment',['description','internal.coursecode','internal.sectionnums'],$cdom,$cnum);
   91:         $ctitle = $csettings{'description'};
   92:         $ccode = $csettings{'internal.coursecode'};
   93:         $sectionlist = $csettings{'internal.sectionnums'};
   94:     }
   95:     if ($ENV{'environment.critnotification'}) {
   96:         $email = $ENV{'environment.critnotification'};
   97:     }
   98:     if (!$email && $ENV{'environment.notification'}) {
   99:         $email = $ENV{'environment.notification'};
  100:     }
  101:     if ($ENV{'environment.lastname'}) {
  102:         $lastname = $ENV{'environment.lastname'};
  103:     }
  104:     if ($ENV{'environment.firstname'}) {
  105:         $firstname = $ENV{'environment.firstname'};
  106:     }
  107:     my @sections = split/,/,$sectionlist;
  108:     my %groupid = ();
  109:     foreach (@sections) {
  110:         my ($sec,$grp) = split/:/,$_;
  111:         $groupid{$sec} = $grp;
  112:     }
  113:     my $defdom = $Apache::lonnet::perlvar{'lonDefDomain'};
  114:     my $codedom = $defdom;
  115:     my %coursecodes = ();
  116:     my %codes = ();
  117:     my @codetitles = ();
  118:     my %cat_titles = ();
  119:     my %cat_order = ();
  120:     my %idlist = ();
  121:     my %idnums = ();
  122:     my %idlist_titles = ();
  123:     my $caller = 'global';
  124:     my $totcodes = 0;
  125:     my $format_reply;
  126:     my $jscript = '';
  127:     
  128:     if ($cdom) {
  129:         $codedom = $cdom;
  130:     }
  131:     if ($cnum) {
  132:         $coursecodes{$cnum} = $ccode;
  133:         if ($ccode eq '') {
  134:             $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
  135:         } else {
  136:             $coursecodes{$cnum} = $ccode;
  137:             $caller = $cnum;
  138:             $totcodes ++;
  139:         }
  140:     } else { 
  141:         $totcodes = &retrieve_instcodes(\%coursecodes,$codedom,$totcodes);
  142:     }
  143:     if ($totcodes > 0) {
  144:         $format_reply = &Apache::lonnet::auto_instcode_format($caller,$codedom,\%coursecodes,\%codes,\@codetitles,\%cat_titles,\%cat_order);
  145:         if ($ccode eq '') {
  146:             my $numtypes = @codetitles;
  147:             &build_code_selections(\%codes,\@codetitles,\%cat_titles,\%cat_order,\%idlist,\%idnums,\%idlist_titles);
  148:             &javascript_code_selections($numtypes,\$jscript,\%idlist,\%idnums,\%idlist_titles,\@codetitles);
  149:         }
  150:     }
  151:     $r->print(<<ENDHEAD);
  152: <html>
  153: <head>
  154:  <title>LON-CAPA support request</title>
  155: <script type"text/javascript">
  156: $scripttag
  157: $jscript
  158: </script>
  159: </head>
  160: $bodytag
  161: ENDHEAD
  162:     if ($r->uri eq '/adm/helpdesk') {
  163:         &print_header($r,$origurl);
  164:     }
  165:     $r->print(<<"END");
  166: <form method="post" name="logproblem" enctype="multipart/form-data">
  167:  <table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
  168:   <tr>
  169:    <td>
  170:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
  171:      <tr>
  172:       <td>
  173:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
  174:         <tr>
  175:          <td>
  176: 	  <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
  177:            <tr>
  178:             <td width="140" bgcolor="$tablecolor">
  179:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  180:               <tr>
  181:                <td align="right"><b>Name:</b>
  182:                </td>
  183:               </tr>
  184:              </table>
  185:             </td>
  186:             <td width="100%" valign="top">
  187:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  188:               <tr>
  189:                <td>
  190: END
  191:     my $fullname = '';
  192:     if ((defined($lastname) && $lastname ne '') && (defined($firstname) && $firstname ne '')) {
  193:         $fullname = "$firstname $lastname"; 
  194:         $r->print("$fullname<input type=\"hidden\" name=\"username\" value=\"$fullname\" />");
  195:     } else {
  196:         if (defined($firstname) && $firstname ne '') {
  197:             $fullname = $firstname;
  198:         } elsif (defined($lastname) && $lastname ne '') {
  199:             $fullname= " $lastname";
  200:         }
  201:         $r->print('<input type="text" size="20" name="username" value="'.$fullname.'" />');
  202:     }
  203:     $r->print(<<END);
  204:                 &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="Submit Request" onClick="validate()" />&nbsp;
  205:                </td>
  206:               </tr>
  207:              </table>
  208:             </td>
  209:            </tr>
  210:            <tr>
  211:             <td width="100%" colspan="2" bgcolor="#000000">
  212:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  213:             </td>
  214:            </tr>
  215:            <tr>
  216:             <td width="140" bgcolor="$tablecolor">
  217:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  218:               <tr>
  219:                <td align="right"><b>E-mail address:</b>
  220:                </td>
  221:               </tr>
  222:              </table>
  223:             </td>
  224:             <td width="100%" valign="top">
  225:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  226:               <tr>
  227:                <td>
  228:                 <input type="text" size="20" name="email" value="$email" /><br />
  229:                </td>
  230:               </tr>
  231:              </table>
  232:             </td>
  233:            </tr>
  234:            <tr>
  235:             <td width="100%" colspan="2" bgcolor="#000000">
  236:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  237:             </td>
  238:            </tr>
  239:            <tr>
  240:             <td width="140" bgcolor="$tablecolor">
  241:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  242:               <tr>
  243:                <td align="right"><b>username/domain:</b>
  244:                </td>
  245:               </tr>
  246:              </table>
  247:             </td>
  248:             <td width="100%" valign="top">
  249:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  250:               <tr>
  251:                <td>
  252: END
  253:     my $udom_input = '<input type="hidden" name="udom" value="'.$udom.'" />';
  254:     my $uname_input = '<input type="hidden" name="uname" value="'.$uname.'" />'; 
  255:     if (defined($uname) && defined($udom)) {
  256:         $r->print('<i>username</i>:&nbsp;'.$uname.'&nbsp;&nbsp;<i>domain</i>:&nbsp;'.$udom.$udom_input.$uname_input);
  257:     } else {
  258:         my $udomform = '';
  259:         my $unameform = '';
  260:         if (defined($udom)) {
  261:             $udomform = '<i>domain</i>:&nbsp;'.$udom.$udom_input;
  262:         } elsif (defined($uname)) {
  263:             $unameform = '<i>username</i>:&nbsp;'.$uname.'&nbsp;&nbsp;'.$uname_input;
  264:         }
  265:         if ($udomform eq '') {
  266:             $udomform = '<i>domain</i>:&nbsp;';
  267:             $udomform .= &Apache::loncommon::select_dom_form($defdom,'udom');
  268:         }
  269:         if ($unameform eq '') {
  270:             $unameform= '<i>username</i>:&nbsp;<input type="text" size="20" name="loncname" value="'.$uname.'" />&nbsp;&nbsp;';
  271:         }
  272:         $r->print($unameform.$udomform.'<br />Enter the username you use to log-in to your LON-CAPA system, and choose your domain.');
  273:     }
  274:     $r->print(<<END);
  275:                </td>
  276:               </tr>
  277:              </table>
  278:             </td>
  279:            </tr>
  280:            <tr>
  281:             <td width="100%" colspan="2" bgcolor="#000000">
  282:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  283:             </td>
  284:            </tr>
  285:            <tr>
  286:             <td width="140" bgcolor="$tablecolor">
  287:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  288:               <tr>
  289:                <td align="right"><b>URL of page:</b>
  290:                </td>
  291:               </tr>
  292:              </table>
  293:             </td>
  294:             <td width="100%" valign="top">
  295:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  296:               <tr>
  297:                <td>
  298:                 http://$server$origurl<input type="hidden" name="sourceurl" value="http://$server$origurl" />
  299:                </td>
  300:               </tr>
  301:              </table>
  302:             </td>
  303:            </tr>
  304:            <tr>
  305:             <td width="100%" colspan="2" bgcolor="#000000">
  306:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  307:             </td>
  308:            </tr>
  309:            <tr>
  310:             <td width="140" bgcolor="$tablecolor">
  311:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  312:               <tr>
  313:                <td align="right"><b>Phone #:</b>
  314:                </td>
  315:               </tr>
  316:              </table>
  317:             </td>
  318:             <td width="100%" valign="top">
  319:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  320:               <tr>
  321:                <td>
  322:                 <input type="text" size="15" name="phone"><br>
  323:                </td>
  324:               </tr>
  325:              </table>
  326:             </td>
  327:            </tr>
  328:            <tr>
  329:             <td width="100%" colspan="2" bgcolor="#000000">
  330:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  331:             </td>
  332:            </tr>
  333:            <tr>
  334:             <td width="140" bgcolor="$tablecolor">
  335:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  336:               <tr>
  337:                <td align="right"><b>Course Details:</b>
  338:                </td>
  339:               </tr>
  340:              </table>
  341:             </td>
  342:             <td width="100%" valign="top">
  343:              <table border="0" cellpadding="3" cellspacing="3">
  344:               <tr>
  345:                <td>
  346: END
  347:     if ($cnum) { 
  348:         if ($coursecodes{$cnum}) {
  349:             foreach (@codetitles) {
  350:                 $r->print('<i>'.$_.'</i>:&nbsp;'.$codes{$cnum}{$_}.';&nbsp;');
  351:             }
  352:             $r->print('&nbsp;<input type="hidden" name="coursecode" value="'.$coursecodes{$cnum}.'" />');
  353:         } else {
  354:             $r->print('Enter institutional course code:&nbsp;
  355:                   <input type="text" name="coursecode" size="15" value="" />');
  356:         }
  357:     } else {
  358:         if ($totcodes > 0) {
  359:             my $numtitles = @codetitles;
  360:             if ($numtitles == 0) {
  361:                 $r->print('Enter institutional course code:&nbsp;
  362:                   <input type="text" name="coursecode" size="15" value="" />');
  363:             } else {
  364:                 my $lasttitle = $numtitles;
  365:                 if ($numtitles > 4) {
  366:                     $lasttitle = 4;
  367:                 } 
  368:                 $r->print('<table><tr><td>'.$codetitles[0].'<br />'."\n".
  369:                       '<select name="'.$codetitles[0].'" onChange="courseSet('."'$codetitles[0]'".')">'."\n".
  370:                       ' <option value="-1" />Select'."\n");
  371:                 my @items = ();
  372:                 if ($idlist{$codetitles[0]} =~ /","/) {
  373:                     @items = split/","/,$idlist{$codetitles[0]};
  374:                 } else {
  375:                     $items[0] = $idlist{$codetitles[0]};
  376:                 }
  377:                 foreach (@items) {
  378:                     $r->print(' <option value="'.$_.'" />'.$_);
  379:                 }
  380:                 $r->print('</select></td>');
  381:                 for (my $i=1; $i<$numtitles; $i++) {
  382:                     $r->print('<td>'.$codetitles[$i].'<br />'."\n".
  383:                      '<select name="'.$codetitles[$i].'" onChange="courseSet('."'$codetitles[$i]'".')">'."\n".
  384:                      '<option value="-1">&lt;-Pick '.$codetitles[$i-1].'</option>'."\n".
  385:                      '</select>'."\n".
  386:                      '</td>'
  387:                     );
  388:                 }
  389:                 $r->print('</tr></table>');
  390:                 if ($numtitles > 4) {
  391:                     $r->print('<br /><br />'.$codetitles[$numtitles].'<br />'."\n".
  392:                           '<select name="'.$codetitles[$numtitles].'" onChange="courseSet('."'$codetitles[$numtitles]'".')">'."\n".
  393:                           '<option value="-1">&lt;-Pick '.$codetitles[$numtitles-1].'</option>'."\n".
  394:                           '</select>'."\n");
  395:                 }
  396:             }
  397:         } else {
  398:             $r->print('Enter institutional course code:&nbsp;
  399:                   <input type="text" name="coursecode" size="15" value="" />');
  400:         }
  401:     }
  402:     if ($ctitle) {
  403:         $r->print('<br /><i>Title</i>:&nbsp;'.$ctitle.'<input type="hidden" name="title" value="'.$ctitle.'" />');
  404:     } else {
  405:         $r->print('<br />Enter course title:&nbsp;
  406:                  <input type="text" name="title" size="25" value="" />');
  407:     }
  408:     $r->print(<<END);
  409:                </td>
  410:               </tr>
  411:              </table>
  412:             </td>
  413:            </tr>
  414:            <tr>
  415:             <td width="100%" colspan="2" bgcolor="#000000">
  416:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  417:             </td>
  418:            </tr>
  419:            <tr>
  420:             <td width="140" bgcolor="$tablecolor">
  421:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  422:               <tr>
  423:                <td align="right"><b>Section Number: </b>
  424:                </td>
  425:               </tr>
  426:              </table>
  427:             </td>
  428:             <td width="100%" valign="top">
  429:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  430:               <tr>
  431:                <td>
  432: END
  433:     if ($sectionlist) {
  434:         $r->print("<select name=\"section\">");
  435:         foreach (sort keys %groupid) {
  436:             if ($_ eq $groupid{$_} || $groupid{$_} eq '') {
  437:                 $r->print("<option value=\"$_\" />$_");
  438:             } else {
  439:                 $r->print("<option value=\"$_\" />$_ - (LON-CAPA sec: $groupid{$_})");
  440:             }
  441:         }
  442:         $r->print("</select>");
  443:     } else {
  444:         $r->print("<input type=\"text\" name=\"section\" size=\"10\"/>");
  445:     }
  446:     $r->print(<<END);
  447:                </td>
  448:               </tr>
  449:              </table>
  450:             </td>
  451:            </tr>
  452:            <tr>
  453:             <td width="100%" colspan="2" bgcolor="#000000">
  454:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  455:             </td>
  456:            </tr>
  457:            <tr>
  458:             <td width="140" bgcolor="$tablecolor">
  459:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  460:               <tr>
  461:                <td align="right"><b>Subject</b>
  462:                </td>
  463:               </tr>
  464:              </table>
  465:             </td>
  466:             <td width="100%" valign="top">
  467:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  468:               <tr>
  469:                <td>
  470:                 <input type="text" size="40" name="subject">
  471:                </td>
  472:               </tr>
  473:              </table>
  474:             </td>
  475:            </tr>
  476:            <tr>
  477:             <td width="100%" colspan="2" bgcolor="#000000">
  478:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  479:             </td>
  480:            </tr>
  481:            <tr>
  482:             <td width="140" bgcolor="$tablecolor">
  483:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  484:               <tr>
  485:                <td align="right"><b>Detailed description:</b>
  486:                </td>
  487:               </tr>
  488:              </table>
  489:             </td>
  490:             <td width="100%" valign="top">
  491:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  492:               <tr>
  493:                <td>
  494:                 <textarea rows="10" cols="45" name="description" wrap="virtual"></textarea>
  495:                </td>
  496:               </tr>
  497:              </table>
  498:             </td>
  499:            </tr>
  500:            <tr>
  501: 	    <td width="100%" colspan="2" bgcolor="#000000">
  502:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  503: 	    </td>
  504: 	   </tr>
  505: END
  506:     if (defined($ENV{'user.name'})) {
  507:         $r->print(<<END);
  508:            <tr>
  509:             <td width="140" bgcolor="$tablecolor">
  510:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  511:               <tr>
  512:                <td align="right"><b>Optional file upload:</b>
  513:                </td>
  514:               </tr>
  515:              </table>
  516:             </td>
  517:             <td width="100%" valign="top">
  518:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  519:               <tr>
  520:                <td>
  521:                 <input type="file" name="screenshot" size="20" /><br />Upload a file (e.g., a screenshot) relevant to your support request (128 KB max. size).
  522:                </td>
  523:               </tr>
  524:              </table>
  525:             </td>
  526:            </tr>
  527:            <tr>
  528:             <td width="100%" colspan="2" bgcolor="#000000">
  529:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  530:             </td>
  531:            </tr>
  532: END
  533:     }
  534:     $r->print(<<END);
  535:            <tr>
  536:             <td width="140" bgcolor="$tablecolor">
  537:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  538:               <tr>
  539:                <td align="right"><b>Finish:</b>
  540:                </td>
  541:               </tr>
  542:              </table>
  543:             </td>
  544:             <td width="100%" valign="top">
  545:              <table border="0" cellpadding="8" cellspacing="0">
  546:               <tr>
  547:                <td>
  548:                 <input type="hidden" name="action" value="process" />
  549:                 <input type="button" value="Submit Request" onClick="validate()"/> &nbsp;
  550:                </td>
  551:                <td>&nbsp;</td>
  552:                <td>
  553:                 <input type="reset" value="Clear Form">
  554:                </td>
  555:               </tr>
  556:              </table>
  557:             </td>
  558:            </tr>
  559:           </table>
  560:          </td>
  561:         </tr>
  562:        </table>
  563:       </td>
  564:      </tr>
  565:     </table>
  566:    </td>
  567:   </tr>
  568:  </table>
  569: </form>
  570: </body>
  571: </html>
  572: END
  573:     return;
  574: }
  575: 
  576: sub print_request_receipt {
  577:     my ($r,$url,$function) = @_;
  578:     my @envvars = ('lonID','HTTP_HOST','HTTP_USER_AGENT','REMOTE_ADDR','SERVER_ADDR','SERVER_NAME','browser.os','browser.type','browser.version','user.home','request.role');
  579:     my @loncvars = ('user.name','user.domain','request.course.sec','request.course.id');
  580: 
  581:     my $bodytag = &Apache::loncommon::bodytag('',$function,'topmargin="0" marginheight="0"',1);
  582:     my $admin = $Apache::lonnet::perlvar{'lonAdminMail'};
  583:     my $to =  $Apache::lonnet::perlvar{'lonSupportEMail'};
  584:     my $from = $admin;
  585:     my $reporttime = &Apache::lonlocal::locallocaltime(time);
  586:     my $fontcolor = &Apache::loncommon::designparm($function.'.font');
  587:     my $vlinkcolor = &Apache::loncommon::designparm($function.'.vlink');
  588:     my $tablecolor = &Apache::loncommon::designparm($function.'.tabbg');
  589:     my @formvars = ('username','email','uname','udom','sourceurl','phone','section','coursecode','title','subject','description','screenshot');
  590:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},\@formvars);
  591: 
  592:     my $supportmsg = qq|
  593: Name: $ENV{'form.username'}
  594: Email: $ENV{'form.email'}
  595: Username/domain: $ENV{'form.uname'} - $ENV{'form.udom'}
  596: Tel: $ENV{'form.phone'}
  597: Course Information: $ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'}
  598: Subject: $ENV{'form.subject'}
  599: Description: $ENV{'form.description'}
  600: URL: $ENV{'form.sourceurl'}
  601: Date/Time: $reporttime
  602: 
  603:     |;
  604:     my $descrip = $ENV{'form.description'};
  605:     $descrip =~ s#\n#<br />#g;
  606:     my $displaymsg = qq|
  607: <font color="$fontcolor">Name:</font><font color="$vlinkcolor"> $ENV{'form.username'}</font><br />
  608: <font color="$fontcolor">Email: </font><font color="$vlinkcolor">$ENV{'form.email'}</font><br />
  609: <font color="$fontcolor">Username/domain: </font><font color="$vlinkcolor">$ENV{'form.uname'} - $ENV{'form.udom'}</font><br />
  610: <font color="$fontcolor">Tel: </font><font color="$vlinkcolor">$ENV{'form.phone'}</font><br />
  611: <font color="$fontcolor">Course Information: </font><font color="$vlinkcolor">$ENV{'form.title'} - $ENV{'form.coursecode'} - section: $ENV{'form.section'}</font><br />
  612: <font color="$fontcolor">Subject: </font><font color="$vlinkcolor">$ENV{'form.subject'}</font><br />
  613: <font color="$fontcolor">Description: </font><font color="$vlinkcolor">$descrip</font><br />
  614: <font color="$fontcolor">URL: </font><font color="$vlinkcolor">$ENV{'form.sourceurl'}</font><br />
  615: <font color="$fontcolor">Date/Time: </font><font color="$vlinkcolor">$reporttime</font><br />
  616:     |;
  617:     $r->print(<<"END");
  618: <html>
  619: <head>
  620:  <title>LON-CAPA support request recorded</title>
  621: </head>
  622: $bodytag
  623: <form name="logproblem">
  624: <input type="hidden" name="action" value="result" />
  625: </form>
  626: END
  627:     if ($r->uri eq '/adm/helpdesk') {
  628:         &print_header($r,$url,'process');
  629:     }
  630:     if ($to =~ m/^[^\@]+\@[^\@]+$/) {
  631:         $r->print("<h3>A support request has been sent to $to</h3>");
  632:     } else {
  633:         $to = $admin;
  634:         if ($to =~ m/^[^\@]+\@[^\@]+$/) {
  635:             $r->print("<h3>A support request has been sent to $to</h3>");
  636: END
  637:         } else {
  638:             $r->print(<<END);
  639:  <h3>Warning: Problem with support e-mail address</h3>
  640: As the e-mail address provided for this LON-CAPA server ($to) 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. Instead a copy has been sent to the LON-CAPA support team at Michigan State University. 
  641: END
  642:             $to = 'helpdesk@lon-capa.org';
  643:         }
  644:     }
  645:     if (defined($ENV{'form.email'})) {
  646:         if ($ENV{'form.email'} =~ m/^[^\@]+\@[^\@]+$/) {
  647:             $from = $ENV{'form.email'};
  648:         }
  649:     }
  650: 
  651:     my $subject = $ENV{'form.subject'};
  652:     $subject =~ s#(`)#'#g;
  653:     $subject =~ s#\$#\(\$\)#g;
  654:     $supportmsg =~ s#(`)#'#g;
  655:     $supportmsg =~ s#\$#\(\$\)#g;
  656:     $displaymsg =~ s#(`)#'#g;
  657:     $displaymsg =~ s#\$#\(\$\)#g;
  658:     my $fname;
  659: 
  660:     my $attachmentpath = '';
  661:     my $attachmentsize = '';
  662:     if (defined($ENV{'user.name'})) {
  663:         if ($ENV{'form.screenshot.filename'}) {
  664:             $attachmentsize = length($ENV{'form.screenshot'});
  665:             if ($attachmentsize > 131072) {
  666:                 $displaymsg .= "<br />The uploaded screenshot file ($attachmentsize bytes) included with your request exceeded the maximum allowed size - 128 KB, and has therefore been discarded.";
  667:             } else {
  668:                 $attachmentpath=&Apache::lonnet::userfileupload('screenshot',undef,'helprequests');
  669:             }
  670:         }
  671:     }
  672: 
  673:     if ($attachmentpath =~ m-/([^/]+)$-) {
  674:         $fname = $1;
  675:         $displaymsg .= "<br />An uploaded screenshot file - $fname ($attachmentsize bytes) was included in the request sent by $ENV{'user.name'} from LON-CAPA domain: $ENV{'user.domain'}";
  676:         $supportmsg .= "\n";
  677:         foreach (@envvars) {
  678:             $supportmsg .= "$_: $ENV{$_}\n";
  679:         }
  680:     }
  681:  
  682:     my $msg = MIME::Lite->new(
  683:                  From    => $from,
  684:                  To      => $to,
  685:                  Subject => $subject,
  686:                  Type    =>'TEXT',
  687:                  Data    => $supportmsg,
  688:                  );
  689: 
  690:     if ($attachmentpath) {
  691:         my ($type, $encoding) = MIME::Types::by_suffix($attachmentpath);
  692:         $msg->attach(Type     => $type,
  693:                      Path     => $attachmentpath,
  694:                      Filename => $fname
  695:                      );
  696: 
  697:     } else {
  698:         my $envdata = '';
  699:         foreach (@envvars) {
  700:             $envdata .= "$_: $ENV{$_}\n";
  701:         }
  702:         foreach (@loncvars) {
  703:             $envdata .= "$_: $ENV{$_}\n";
  704:         }
  705:         $msg->attach(Type => 'TEXT',
  706:                      Data => $envdata);
  707:     }
  708: 
  709: ### Send it:
  710:     # ->send can cause an sh launch which can pass all of %ENV along
  711:     # which can be to large for /bin/sh's little mind
  712:     my %oldENV=%ENV;
  713:     undef(%ENV);
  714:     $msg->send('sendmail');
  715:     %ENV=%oldENV;
  716:     undef(%oldENV);
  717: 
  718:     if ($attachmentpath =~ m#$Apache::lonnet::perlvar{'lonDaemons'}/tmp/helprequests/(\d+)/[^/]+#) {
  719:         unlink($attachmentpath);
  720:     }
  721:     $r->print(qq|
  722:  <b>Your support request contained the following information</b>:<br /><br />
  723:  <table width="580" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
  724:   <tr>
  725:    <td>
  726:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
  727:      <tr>
  728:       <td>
  729:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
  730:         <tr>
  731:          <td>
  732:           <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
  733:            <tr>
  734:             <td width="140" bgcolor="$tablecolor">
  735:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  736:               <tr>
  737:                <td align="right"><b>Information supplied</b>
  738:                </td>
  739:               </tr>
  740:              </table>
  741:             </td>
  742:             <td width="100%" valign="top">
  743:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  744:               <tr>
  745:                <td>$displaymsg</td>
  746:               </tr>
  747:              </table>
  748:             </td>
  749:            </tr>
  750:            <tr>
  751:             <td width="100%" colspan="2" bgcolor="#000000">
  752:              <img src="/adm/lonMisc/blackdot.gif" /><br />
  753:             </td>
  754:            </tr>
  755:            <tr>
  756:             <td width="140" bgcolor="$tablecolor">
  757:              <table width="140" border="0" cellpadding="8" cellspacing="0">
  758:               <tr>
  759:                <td align="right"><b>Additional information recorded</b>
  760:                </td>
  761:               </tr>
  762:              </table>
  763:             </td>
  764:             <td width="100%" valign="top">
  765:              <table width="100%" border="0" cellpadding="8" cellspacing="0">
  766:               <tr>
  767:                <td>
  768:     |);
  769:     foreach (@envvars) {
  770:         unless($ENV{$_} eq '') { 
  771:             $r->print("$_:&nbsp;<font color='$vlinkcolor'>$ENV{$_}</font>, ");
  772:         }
  773:     }
  774:     $r->print("
  775:                </td>
  776:               </tr>
  777:              </table>
  778:             </td>
  779:            </tr>
  780:           </table>
  781:          </td>
  782:         </tr>
  783:        </table>
  784:       </td>
  785:      </tr>
  786:     </table>
  787:    </td>
  788:   </tr>
  789:  </table>
  790: </body>
  791: </html>
  792:     ");
  793: }
  794: 
  795: sub print_header {
  796:     my ($r,$origurl,$action) = @_;
  797:     my $location=&Apache::loncommon::lonhttpdurl("/adm");
  798:     my $tablecolor = '#EEEE99';
  799:     my ($component_url);
  800:     my $helpdesk_link = '<a href="javascript:validate()">';
  801:     if ($action eq 'process') {
  802:         $helpdesk_link = '<a href="/adm/helpdesk">';
  803:     }
  804:     my %lt = &Apache::lonlocal::texthash (
  805:                                            login => 'Log-in help',
  806:                                            ask   => 'Ask helpdesk',
  807:                                            getst => 'Getting started guide',
  808:                                            back =>  'Back to last location'
  809:                                          );  
  810:     $r->print(<<END);
  811: <table width="620" border="0" cellspacing="0" cellpadding="0" height="55">   <tr height="50">    <td width='5'>&nbsp;</td>
  812:    <td>
  813:     <fieldset><legend><img src="$location/lonIcons/minilogo.gif" height='20' width='29' valign='bottom' />&nbsp;&nbsp;<b><font size="+1">LON-CAPA help/support</font></b></legend>
  814:  <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#000000">
  815:   <tr>
  816:    <td>
  817:     <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#000000">
  818:      <tr>
  819:       <td>
  820:        <table width="100%" border="0" cellpadding="0" cellspacing="0" bgcolor="#ffffff">
  821:         <tr>
  822:          <td>
  823:           <table width="100%" border="0" cellpadding="0" cellspacing="1" bgcolor="#ffffff">
  824:            <tr bgcolor="$tablecolor">
  825:             <td align="center"><img src="$location/help/gif/smallHelp.gif" border="0" alt="(Login help)" valign="middle" />&nbsp;<b><a href="/adm/loginproblems.html">$lt{'login'}</a></td>
  826:             <td align="center">&nbsp;<b>$helpdesk_link<img src="$location/lonIcons/helpdesk.gif" border="0" alt="(Ask helpdesk)" valign="middle" />&nbsp;$lt{'ask'}</a></b>&nbsp;</td>
  827:             <td align="center">&nbsp;<b><a href="/adm/gettingstarted.html">$lt{'getst'}</a></td>
  828:             <td align="center">&nbsp;<b><a href="$origurl" target="_top"><img src="$location/lonIcons/move_up.gif" border="0" alt="(Back to last location)" valign="middle" />&nbsp;$lt{'back'}</a></b>&nbsp;</td>
  829:            </tr>
  830:           </table>
  831:          </td>
  832:         </tr>
  833:        </table>
  834:       </td>
  835:      </tr>
  836:     </table>
  837:    </td>
  838:   </tr>
  839:  </table>
  840: </fieldset>
  841:   </td>
  842:   <td width='5'>&nbsp;</td>
  843:  </tr>
  844:  <tr height='5'>
  845:   <td colspan='3' height='5'>&nbsp;</td>
  846:  </tr>
  847: END
  848:     unless ($action eq 'process') {
  849:         $r->print('
  850:  <tr>
  851:   <td colspan="3">'.&mt('
  852: Please read the "Log-in help" and "Getting started guide" if you can not log-in').'.  '.&mt('If your problem is still unresolved, the form below can be used to send a question to the LON-CAPA helpdesk').'.<br /><font size="-1"><b>'.&mt('Note').':</b> '.&mt('Student questions about course content should be directed to the course instructor').'.</font><br /><br />
  853:   </td>
  854:  </tr>');
  855:     }
  856:     $r->print('
  857: </table>');
  858:     return;
  859: }
  860: 
  861: sub retrieve_instcodes {
  862:     my ($coursecodes,$codedom,$totcodes) = @_;
  863:     my %courses = &Apache::lonnet::courseiddump($codedom,'.',1,'.','.');
  864:     foreach my $course (keys %courses) {
  865:         if ($courses{$course} =~ m/^[^:]*:([^:]+)/) {
  866:             $$coursecodes{$course} = &Apache::lonnet::unescape($1);
  867:             $totcodes ++;
  868:         }
  869:     }
  870:     return $totcodes;
  871: }
  872: 
  873: sub build_code_selections {
  874:     my ($codes,$codetitles,$cat_titles,$cat_order,$idlist,$idnums,$idlist_titles) = @_;
  875:     my %idarrays = ();
  876:     for (my $i=1; $i<@{$codetitles}; $i++) {
  877:         %{$idarrays{$$codetitles[$i]}} = ();
  878:     }
  879:     foreach my $cid (sort keys %{$codes}) {
  880:         &recurse_list($cid,$codetitles,$codes,0,\%idarrays);
  881:     }
  882:     for (my $num=0; $num<@{$codetitles}; $num++) {
  883:         if ($num == 0) {
  884:             my @contents = ();
  885:             my @contents_titles = ();
  886:             &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[0]}},\@contents);
  887:             if (defined($$cat_titles{$$codetitles[0]})) {
  888:                 foreach (@contents) {
  889:                     push @contents_titles, $$cat_titles{$$codetitles[0]}{$_};
  890:                 }
  891:             }
  892:             $$idlist{$$codetitles[0]} = join('","',@contents);
  893:             $$idnums{$$codetitles[0]} = scalar(@contents);
  894:             if (defined($$cat_titles{$$codetitles[0]})) {
  895:                 $$idlist_titles{$$codetitles[0]} = join('","',@contents_titles);
  896:             }
  897:         } elsif ($num == 1) {
  898:             %{$$idlist{$$codetitles[1]}} = ();
  899:             %{$$idlist_titles{$$codetitles[1]}} = ();
  900:             foreach my $key_a (keys %{$idarrays{$$codetitles[1]}}) {
  901:                 my @sorted_a = ();
  902:                 my @sorted_a_titles = ();
  903:                 &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[1]}{$key_a}},\@sorted_a);
  904:                 if (defined($$cat_titles{$$codetitles[1]})) {
  905:                     foreach (@sorted_a) {
  906:                         push @sorted_a_titles, $$cat_titles{$$codetitles[1]}{$_};
  907:                     }
  908:                 }
  909:                 $$idlist{$$codetitles[1]}{$key_a} = join('","',@sorted_a);
  910:                 $$idnums{$$codetitles[1]}{$key_a} = scalar(@sorted_a);
  911:                 if (defined($$cat_titles{$$codetitles[1]})) {
  912:                     $$idlist_titles{$$codetitles[1]}{$key_a} = join('","',@sorted_a_titles);
  913:                 }
  914:             }
  915:         } elsif ($num == 2) {
  916:             %{$$idlist{$$codetitles[2]}} = ();
  917:             %{$$idlist_titles{$$codetitles[2]}} = ();
  918:             foreach my $key_a (keys %{$idarrays{$$codetitles[2]}}) {
  919:                 %{$$idlist{$$codetitles[2]}{$key_a}} = ();
  920:                 %{$$idlist_titles{$$codetitles[2]}{$key_a}} = ();
  921:                 foreach my $key_b (keys %{$idarrays{$$codetitles[2]}{$key_a}}) {
  922:                     my @sorted_b = ();
  923:                     my @sorted_b_titles = ();
  924:                     &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[2]}{$key_a}{$key_b}},\@sorted_b);
  925:                     if (defined($$cat_titles{$$codetitles[1]})) {
  926:                         foreach (@sorted_b) {
  927:                             push @sorted_b_titles, $$cat_titles{$$codetitles[1]}{$_};
  928:                         }
  929:                     }
  930:                     $$idlist{$$codetitles[2]}{$key_a}{$key_b} = join('","',@sorted_b);
  931:                     $$idnums{$$codetitles[2]}{$key_a}{$key_b} = scalar(@sorted_b);
  932:                     if (defined($$cat_titles{$$codetitles[2]})) {
  933:                         $$idlist_titles{$$codetitles[2]}{$key_a}{$key_b} = join('","',@sorted_b_titles);
  934:                     }
  935:                 }
  936:             }
  937:         } elsif ($num == 3) {
  938:             %{$$idlist{$$codetitles[3]}} = ();
  939:             foreach my $key_a (keys %{$idarrays{$$codetitles[3]}}) {
  940:                 %{$$idlist{$$codetitles[3]}{$key_a}} = ();
  941:                 foreach my $key_b (keys %{$idarrays{$$codetitles[3]}{$key_a}}) {
  942:                     %{$$idlist{$$codetitles[3]}{$key_a}{$key_b}} = ();
  943:                     foreach my $key_c (keys %{$idarrays{$$codetitles[3]}{$key_a}{$key_b}}) {
  944:                         my @sorted_c = ();
  945:                         &sort_cats($num,$cat_order,$codetitles,\@{$idarrays{$$codetitles[3]}{$key_a}{$key_b}{$key_c}},\@sorted_c);
  946:                         $$idlist{$$codetitles[3]}{$key_a}{$key_b}{$key_c} = join('","',@sorted_c);
  947:                         $$idnums{$$codetitles[3]}{$key_a}{$key_b}{$key_c} = scalar(@sorted_c);
  948:                     }
  949:                 }
  950:             }
  951:         } elsif ($num == 4) {
  952:             %{$$idlist{$$codetitles[4]}} = ();
  953:             foreach my $key_a (keys %{$idarrays{$$codetitles[4]}}) {
  954:                 %{$$idlist{$$codetitles[4]}{$key_a}} = ();
  955:                 foreach my $key_b (keys %{$idarrays{$$codetitles[4]}{$key_a}}) {
  956:                     %{$$idlist{$$codetitles[4]}{$key_a}{$key_b}} = ();
  957:                     foreach my $key_c (keys %{$idarrays{$$codetitles[4]}{$key_a}{$key_b}}) {
  958:                         %{$$idlist{$$codetitles[4]}{$key_a}{$key_b}{$key_c}} = ();
  959:                         foreach my $key_d (keys %{$idarrays{$$codetitles[4]}{$key_a}{$key_b}{$key_c}}) {
  960:                             my @sorted_d = ();
  961:                             &sort_cats($num,$cat_order,$codetitles,$idarrays{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d},\@sorted_d);
  962:                             $$idlist{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d} = join('","',@sorted_d);
  963:                             $$idnums{$$codetitles[4]}{$key_a}{$key_b}{$key_c}{$key_d} = scalar(@sorted_d);
  964:                         }
  965:                     }
  966:                 }
  967:             }
  968:         }
  969:     }
  970: }
  971: 
  972: sub sort_cats {
  973:     my ($num,$cat_order,$codetitles,$idsarrayref,$sorted) = @_;
  974:     my @unsorted = @{$idsarrayref};
  975:     if (defined($$cat_order{$$codetitles[$num]})) {
  976:         foreach (@{$$cat_order{$$codetitles[$num]}}) {
  977:             if (grep/^$_$/,@unsorted) {
  978:                 push @{$sorted}, $_;
  979:             }
  980:         }
  981:     } else {
  982:         @{$sorted} = sort (@unsorted);
  983:     }
  984: }
  985: 
  986: 
  987: sub recurse_list {
  988:     my ($cid,$codetitles,$codes,$num,$idarrays) = @_;
  989:     if ($num == 0) {
  990:         if (!grep/^$$codes{$cid}{$$codetitles[0]}$/,@{$$idarrays{$$codetitles[0]}}) {
  991:             push @{$$idarrays{$$codetitles[0]}}, $$codes{$cid}{$$codetitles[0]};
  992:         }
  993:     } elsif ($num == 1) {
  994:         if (defined($$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}})) {
  995:             if (!grep/^$$codes{$cid}{$$codetitles[1]}$/,@{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}}) {
  996:                 push @{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}}, $$codes{$cid}{$$codetitles[1]};
  997:             }
  998:         } else {
  999:             @{$$idarrays{$$codetitles[1]}{$$codes{$cid}{$$codetitles[0]}}} = ("$$codes{$cid}{$$codetitles[1]}");
 1000:         }
 1001:     } elsif ($num == 2) {
 1002:         if (defined($$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}})) {
 1003:             if (defined($$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
 1004:                 if (!grep/^$$codes{$cid}{$$codetitles[2]}$/,@{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}}) {
 1005:                     push @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}}, $$codes{$cid}{$$codetitles[2]};
 1006:                 }
 1007:             } else {
 1008:                 @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ("$$codes{$cid}{$$codetitles[2]}");
 1009:             }
 1010:         } else {
 1011:             %{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}} = ();
 1012:             @{$$idarrays{$$codetitles[2]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ("$$codes{$cid}{$$codetitles[2]}");
 1013:         }
 1014:     } elsif ($num == 3) {
 1015:         if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}})) {
 1016:             if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
 1017:                 if (defined($$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}})) {
 1018:                     if (!grep/^$$codes{$cid}{$$codetitles[3]}$/,@{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}}) {
 1019:                         push @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}}, $$codes{$cid}{$$codetitles[3]};
 1020:                     }
 1021:                 } else {
 1022:                     @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
 1023:                 }
 1024:             } else {
 1025:                 %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
 1026:                 @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
 1027:             }
 1028:         } else {
 1029:             %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}} = ();
 1030:             %{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
 1031:             @{$$idarrays{$$codetitles[3]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ("$$codes{$cid}{$$codetitles[3]}");
 1032:         }
 1033:     } elsif ($num == 4) {
 1034:         if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}})) {
 1035:             if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}})) {
 1036:                 if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}})) {
 1037:                     if (defined($$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}})) {
 1038:                         if (!grep/^$$codes{$cid}{$$codetitles[4]}$/,@{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}}) {
 1039:                             push @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}}, $$codes{$cid}{$$codetitles[4]};
 1040:                         }
 1041:                     } else {
 1042:                         @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
 1043:                     }
 1044:                 } else {
 1045:                     %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
 1046:                     @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
 1047:                 }
 1048:             } else {
 1049:                 %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
 1050:                 %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
 1051:                 @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[4]}");
 1052:             }
 1053:         } else {
 1054:             %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}} = ();
 1055:             %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}} = ();
 1056:             %{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[2]}}} = ();
 1057:             @{$$idarrays{$$codetitles[4]}{$$codes{$cid}{$$codetitles[0]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[1]}}{$$codes{$cid}{$$codetitles[3]}}} = ("$$codes{$cid}{$$codetitles[3]}");
 1058:         }
 1059:     }
 1060:     $num ++;
 1061:     if ($num <@{$codetitles}) {
 1062:         &recurse_list($cid,$codetitles,$codes,$num,$idarrays);
 1063:     }
 1064: }
 1065: 
 1066: sub javascript_code_selections {
 1067:     my ($numcats,$script_tag,$idlist,$idnums,$idlist_titles,$codetitles) = @_;
 1068:     my $numtitles = @{$codetitles};
 1069:     my @seltitles = (); 
 1070:     for (my $j=0; $j<$numtitles; $j++) {
 1071:         $seltitles[$j] = 'id'.$$codetitles[$j];
 1072:     }
 1073:     my $seltitle_str = join('","',@seltitles);
 1074:     $$script_tag .= <<END;
 1075: function courseSet(caller) {
 1076:     var ids = new Array ("$seltitle_str");
 1077:     var formitems = new Array ($numtitles);
 1078:     var idyr = document.logproblem.Year.selectedIndex
 1079:     var idsem  = document.logproblem.Semester.selectedIndex
 1080:     var iddept = document.logproblem.Department.selectedIndex
 1081:     var idclass = document.logproblem.Number.selectedIndex
 1082:     var idyears = new Array("$$idlist{$$codetitles[0]}");
 1083:     var idsems = new Array ($$idnums{$$codetitles[0]});
 1084:     var idsemlongs = new Array ($$idnums{$$codetitles[0]});
 1085:     var idcodes = new Array ($$idnums{$$codetitles[0]});
 1086:     var idcourses = new Array ($$idnums{$$codetitles[0]});
 1087: END
 1088:     my @sort_a = split/","/,$$idlist{$$codetitles[0]}; 
 1089:     for (my $j=0; $j<@sort_a; $j++) {
 1090:         $$script_tag .= qq| idsems[$j] = new Array("$$idlist{$$codetitles[1]}{$sort_a[$j]}")\n|;
 1091:         $$script_tag .= qq| idsemlongs[$j] = new Array("$$idlist_titles{$$codetitles[1]}{$sort_a[$j]}")\n|;
 1092:         $$script_tag .= qq| idcodes[$j] = new Array($$idnums{$$codetitles[1]}{$sort_a[$j]})\n|;
 1093:         $$script_tag .= qq| idcourses[$j] = new Array($$idnums{$$codetitles[1]}{$sort_a[$j]})\n|;
 1094:         my @sort_b = split/","/,$$idlist{$$codetitles[1]}{$sort_a[$j]};
 1095:         for (my $k=0; $k<@sort_b; $k++) {
 1096:             my $idcode_entry = $$idlist{$$codetitles[2]}{$sort_a[$j]}{$sort_b[$k]};
 1097:             $$script_tag .= qq| idcodes[$j][$k] = new Array("$idcode_entry")\n|;
 1098:             $$script_tag .= qq| idcourses[$j][$k] = new Array($$idnums{$$codetitles[2]}{$sort_a[$j]}{$sort_b[$k]})\n|;
 1099:             my @sort_c = split/","/,$$idlist{$$codetitles[2]}{$sort_a[$j]}{$sort_b[$k]};
 1100:             for (my $l=0; $l<@sort_c; $l++) {
 1101:                 my $idcourse_entry = $$idlist{$$codetitles[3]}{$sort_a[$j]}{$sort_b[$k]}{$sort_c[$l]};
 1102:                 $$script_tag .= qq| idcourses[$j][$k][$l] = new Array("$idcourse_entry")\n|;
 1103:             }
 1104:         }
 1105:     }
 1106:     $$script_tag .= (<<END_OF_BLOCK);
 1107:  if (caller == "Year") {
 1108:    document.logproblem.Department.length = 0
 1109:    document.logproblem.Number.length = 0
 1110:    document.logproblem.Department.options[0] = new Option("<-Pick Semester.","-1",true,true)
 1111:    document.logproblem.Number.options[0] = new Option("<-Pick Department","-1",true,true)
 1112:    if (idyr == 0) {
 1113:     document.logproblem.Semester.length = 0
 1114:     document.logproblem.Semester.options[0] = new Option("<-Pick Year","-1",true,true)
 1115:    }
 1116:    else {
 1117:     document.logproblem.Semester.length = 0
 1118:     document.logproblem.Semester.options[0] = new Option("Select","-1",true,true)
 1119:     for (var i=0; i<idsems[idyr-1].length; i++) {
 1120:       document.logproblem.Semester.options[i+1] = new Option(idsemlongs[idyr-1][i],idsems[idyr-1][i],false,false)
 1121:     }
 1122:    }
 1123:    document.logproblem.Semester.selectedIndex = 0;
 1124:  }
 1125:  if (caller == "Semester") {
 1126:    document.logproblem.Department.length = 0
 1127:    document.logproblem.Number.length = 0
 1128:    document.logproblem.Number.options[0] = new Option("<-Pick Department.","-1",true,true)
 1129:    if (idsem == 0) {
 1130:      document.logproblem.Department.options[0] = new Option("<-Pick Semester.","-1",true,true)
 1131:      document.logproblem.Department.options[0] = new Option("<-Pick Semester","-1",true,true)
 1132:    }
 1133:    else {
 1134:     document.logproblem.Department.options[0] = new Option("Select","-1",true,true)    
 1135:     for (var i=0; i<idcodes[idyr-1][idsem-1].length; i++) {
 1136:       document.logproblem.Department.options[i+1] = new Option(idcodes[idyr-1][idsem-1][i],idcodes[idyr-1][idsem-1][i],false,false)
 1137:     }
 1138:    }
 1139:    document.logproblem.Department.selectedIndex = 0
 1140:  }
 1141:  if (caller == "Department") {
 1142:    document.logproblem.Number.length = 0
 1143:    if (iddept == 0) {
 1144:      document.logproblem.Number.options[0] = new Option("<-Pick Department.","-1",true,true)
 1145:    }
 1146:    else {
 1147:     document.logproblem.Number.options[0] = new Option("Select","-1",true,true)
 1148:     for (var i=0; i<idcourses[idyr-1][idsem-1][iddept-1].length; i++) {
 1149:       document.logproblem.Number.options[i+1] = new Option(idcourses[idyr-1][idsem-1][iddept-1][i],idcourses[idyr-1][idsem-1][iddept-1][i],false,false)
 1150:     }
 1151:    }
 1152:    document.logproblem.Number.selectedIndex = 0
 1153:  }
 1154: }
 1155: END_OF_BLOCK
 1156: }
 1157: 
 1158: 1;

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