File:  [LON-CAPA] / loncom / interface / lonsupportreq.pm
Revision 1.13: download - view: text, annotated - select for diffs
Sat Dec 18 22:30:28 2004 UTC (19 years, 5 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD
More comprehensive checking of valid e-mail address if browser supports javascript regex.

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

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