File:  [LON-CAPA] / loncom / interface / lonsupportreq.pm
Revision 1.19: download - view: text, annotated - select for diffs
Thu Dec 30 16:18:16 2004 UTC (19 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
Retrieve domain information from query string (if one was passed in from 'Contact Helpdesk' link on log-in page). Actually store course information from select boxes and include in message sent to SupportEmail address.  Make more generic and less MSU specific.

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

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