File:  [LON-CAPA] / loncom / interface / lonparmset.pm
Revision 1.29: download - view: text, annotated - select for diffs
Thu May 10 01:06:06 2001 UTC (23 years, 1 month ago) by www
Branches: MAIN
CVS tags: HEAD
Can be called from homeworkmenu

    1: # The LearningOnline Network with CAPA
    2: # Handler to set parameters for assessments
    3: #
    4: # (Handler to resolve ambiguous file locations
    5: #
    6: # (TeX Content Handler
    7: #
    8: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
    9: #
   10: # 10/11,10/12,10/16 Gerd Kortemeyer)
   11: #
   12: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
   13: # 12/08,12/12,
   14: # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09 Gerd Kortemeyer
   15: 
   16: package Apache::lonparmset;
   17: 
   18: use strict;
   19: use Apache::lonnet;
   20: use Apache::Constants qw(:common :http REDIRECT);
   21: use GDBM_File;
   22: 
   23: 
   24: my %courseopt;
   25: my %useropt;
   26: my %bighash;
   27: my %parmhash;
   28: 
   29: my @outpar;
   30: 
   31: my @ids;
   32: my %symbp;
   33: my %mapp;
   34: my %typep;
   35: my %keyp;
   36: my %defp;
   37: 
   38: my %allkeys;
   39: my %allmaps;
   40: 
   41: my $uname;
   42: my $udom;
   43: my $uhome;
   44: 
   45: my $csec;
   46: 
   47: my $fcat;
   48: 
   49: # -------------------------------------------- Figure out a cascading parameter
   50: 
   51: sub parmval {
   52:     my ($what,$id,$def)=@_;
   53:     my $result='';
   54:     @outpar=();
   55: # ----------------------------------------------------- Cascading lookup scheme
   56: 
   57:        my $symbparm=$symbp{$id}.'.'.$what;
   58:        my $mapparm=$mapp{$id}.'___(all).'.$what;
   59: 
   60:        my $seclevel=
   61:             $ENV{'request.course.id'}.'.['.
   62: 		$csec.'].'.$what;
   63:        my $seclevelr=
   64:             $ENV{'request.course.id'}.'.['.
   65: 		$csec.'].'.$symbparm;
   66:        my $seclevelm=
   67:             $ENV{'request.course.id'}.'.['.
   68: 		$csec.'].'.$mapparm;
   69: 
   70:        my $courselevel=
   71:             $ENV{'request.course.id'}.'.'.$what;
   72:        my $courselevelr=
   73:             $ENV{'request.course.id'}.'.'.$symbparm;
   74:        my $courselevelm=
   75:             $ENV{'request.course.id'}.'.'.$mapparm;
   76: 
   77: # -------------------------------------------------------- first, check default
   78: 
   79:        if ($def) { $outpar[11]=$def;
   80:                    $result=11; }
   81: 
   82: # ----------------------------------------------------- second, check map parms
   83: 
   84:        my $thisparm=$parmhash{$symbparm};
   85:        if ($thisparm) { $outpar[10]=$thisparm;  
   86:                         $result=10; }
   87: 
   88: # --------------------------------------------------------- third, check course
   89: 
   90:        if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel};  
   91:                                        $result=9; }
   92: 
   93:        if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; 
   94:                                         $result=8; }
   95: 
   96:        if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; 
   97:                                         $result=7; }
   98: 
   99:        if ($csec) {
  100: 
  101:         if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel};  
  102:                                     $result=6; }
  103: 
  104:         if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm};  
  105:                                      $result=5; }  
  106:  
  107:         if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr};  
  108:                                      $result=4; }
  109:   
  110:       }
  111: 
  112: # ---------------------------------------------------------- fourth, check user
  113:       
  114:       if ($uname) { 
  115: 
  116:        if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel};  
  117:                                      $result=3; }
  118: 
  119:        if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; 
  120:                                       $result=2; }
  121: 
  122:        if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; 
  123:                                       $result=1; }
  124: 
  125:       }
  126:      
  127:     return $result;
  128: }
  129: 
  130: # ------------------------------------------------------------ Output for value
  131: 
  132: sub valout {
  133:     my ($value,$type)=@_;
  134:     return
  135: 	($value?(($type=~/^date/)?localtime($value):$value):'  ');
  136: }
  137: 
  138: # -------------------------------------------------------- Produces link anchor
  139: 
  140: sub plink {
  141:     my ($type,$dis,$value,$marker,$return,$call)=@_;
  142:     my $winvalue=$value;
  143:     unless ($winvalue) {
  144: 	if ($type=~/^date/) {
  145:             $winvalue=$ENV{'form.recent_'.$type};
  146:         } else {
  147:             $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
  148:         }
  149:     }
  150:     return 
  151:       '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
  152:       .$marker."','".$return."','".$call."'".');">'.
  153:       &valout($value,$type).'</a><a name="'.$marker.'"></a>';
  154: }
  155: 
  156: # ================================================================ Main Handler
  157: 
  158: sub handler {
  159:    my $r=shift;
  160: 
  161:    if ($r->header_only) {
  162:       $r->content_type('text/html');
  163:       $r->send_http_header;
  164:       return OK;
  165:    }
  166: 
  167: # ----------------------------------------------------- Needs to be in a course
  168: 
  169:    if (($ENV{'request.course.fn'}) && 
  170:        (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
  171: # -------------------------------------------------------- Variable declaration
  172: 
  173:       %courseopt=();
  174:       %useropt=();
  175:       %bighash=();
  176: 
  177:       @ids=();
  178:       %symbp=();
  179:       %typep=();
  180: 
  181:       my $message='';
  182: 
  183:       $csec=$ENV{'form.csec'};
  184:       $udom=$ENV{'form.udom'};
  185:       unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
  186: 
  187:       my $pscat=$ENV{'form.pscat'};
  188:       my $pschp=$ENV{'form.pschp'};
  189:       my $pssymb='';
  190: 
  191: # ----------------------------------------------- Was this started from grades?
  192: 
  193:       if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
  194:           && (!$ENV{'form.dis'})) {
  195: 	  my $url=$ENV{'form.url'};
  196:           $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
  197:           $pssymb=&Apache::lonnet::symbread($url);
  198:           $pscat='all';
  199:           $pschp='';
  200:       } else {
  201:           $ENV{'form.url'}='';
  202:       }
  203:  
  204:       my $id=$ENV{'form.id'};
  205:       if (($id) && ($udom)) {
  206:           $uname=(&Apache::lonnet::idget($udom,$id))[1];
  207:           if ($uname) {
  208: 	      $id='';
  209:           } else {
  210:               $message=
  211:      "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
  212:           }
  213:       } else {
  214:           $uname=$ENV{'form.uname'};
  215:       }
  216:       unless ($udom) { $uname=''; }
  217:       $uhome='';
  218:       if ($uname) {
  219: 	  $uhome=&Apache::lonnet::homeserver($uname,$udom);
  220:       
  221:         if ($uhome eq 'no_host') { 
  222:           $message=
  223:      "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
  224:           $uname=''; 
  225:         } else {
  226:           $csec=&Apache::lonnet::usection(
  227: 				       $udom,$uname,$ENV{'request.course.id'});
  228:           if ($csec eq '-1') {
  229:              $message="<font color=red>".
  230:               "User '$uname' at domain '$udom' not in this course</font>";
  231:               $uname='';
  232:               $csec=$ENV{'form.csec'};
  233: 	 } else {
  234:               my %name=&Apache::lonnet::userenvironment($udom,$uname,
  235: 		('firstname','middlename','lastname','generation','id'));
  236:               $message="\n<p>\nFull Name: ".
  237:                           $name{'firstname'}.' '.$name{'middlename'}
  238: 	                 .$name{'lastname'}.' '.$name{'generation'}.
  239:                        "<br>\nID: ".$name{'id'}.'<p>';
  240:          }
  241:         }
  242:       }
  243: 
  244:       unless ($csec) { $csec=''; }
  245: 
  246:       $fcat=$ENV{'form.fcat'};
  247:       unless ($fcat) { $fcat=''; }
  248: 
  249: # ------------------------------------------------------------------- Tie hashs
  250:       if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  251:                        &GDBM_READER,0640)) &&
  252:           (tie(%parmhash,'GDBM_File',
  253:            $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
  254: 
  255: # --------------------------------------------------------- Get all assessments
  256: 	undef %allkeys;
  257:         undef %allmaps;
  258:         undef %defp;
  259:         map {
  260: 	    if ($_=~/^src\_(\d+)\.(\d+)$/) {
  261: 	       my $mapid=$1;
  262:                my $resid=$2;
  263:                my $id=$mapid.'.'.$resid;
  264:                my $srcf=$bighash{$_};
  265:                if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  266: 		   $ids[$#ids+1]=$id;
  267:                    $typep{$id}=$1;
  268:                    $keyp{$id}='';
  269:                    map {
  270:                        if ($_=~/^parameter\_(.*)/) {
  271: 			  my $key=$_;
  272:                           my $allkey=$1;
  273:                           $allkey=~s/\_/\./;
  274:                           my $display=
  275: 			      &Apache::lonnet::metadata($srcf,$key.'.display');
  276:                           unless ($display) {
  277:                               $display=
  278: 			         &Apache::lonnet::metadata($srcf,$key.'.name');
  279:                           }
  280:                           $allkeys{$allkey}=$display;
  281:                           if ($allkey eq $fcat) {
  282:                              $defp{$id}=
  283:                               &Apache::lonnet::metadata($srcf,$key);
  284: 			  }
  285:                           if ($keyp{$id}) {
  286: 			      $keyp{$id}.=','.$key;
  287:                           } else {
  288:                               $keyp{$id}=$key;
  289: 		          }
  290: 		       }
  291:                    } split(/\,/,
  292:                       &Apache::lonnet::metadata($srcf,'keys'));
  293:                    $mapp{$id}=
  294: 		       &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
  295:                    $allmaps{$mapid}=$mapp{$id};
  296:                    $symbp{$id}=$mapp{$id}.
  297: 			'___'.$resid.'___'.
  298: 			    &Apache::lonnet::declutter($srcf);
  299: 	       }
  300:             }
  301:         } keys %bighash;
  302: # ---------------------------------------------------------- Anything to store?
  303:         if ($ENV{'form.pres_marker'}) {
  304:        my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
  305:        $spnam=~s/\_/\./;
  306: # ---------------------------------------------------------- Construct prefixes
  307: 
  308:        my $symbparm=$symbp{$sresid}.'.'.$spnam;
  309:        my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
  310: 
  311:        my $seclevel=
  312:             $ENV{'request.course.id'}.'.['.
  313: 		$csec.'].'.$spnam;
  314:        my $seclevelr=
  315:             $ENV{'request.course.id'}.'.['.
  316: 		$csec.'].'.$symbparm;
  317:        my $seclevelm=
  318:             $ENV{'request.course.id'}.'.['.
  319: 		$csec.'].'.$mapparm;
  320: 
  321:        my $courselevel=
  322:             $ENV{'request.course.id'}.'.'.$spnam;
  323:        my $courselevelr=
  324:             $ENV{'request.course.id'}.'.'.$symbparm;
  325:        my $courselevelm=
  326:             $ENV{'request.course.id'}.'.'.$mapparm;
  327: 
  328:        my $storeunder='';
  329:        if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
  330:        if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
  331:        if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
  332:        if ($snum==6) { $storeunder=$seclevel; }
  333:        if ($snum==5) { $storeunder=$seclevelm; }
  334:        if ($snum==4) { $storeunder=$seclevelr; }
  335:        $storeunder=&Apache::lonnet::escape($storeunder);
  336:  
  337:        my $storecontent=
  338:     $storeunder.'='.&Apache::lonnet::escape($ENV{'form.pres_value'}).'&'.
  339:     $storeunder.'.type='.&Apache::lonnet::escape($ENV{'form.pres_type'});
  340: 
  341:        my $reply='';
  342:            if ($snum>3) {
  343: # ---------------------------------------------------------------- Store Course
  344: #
  345: # Expire sheets
  346: 	    &Apache::lonnet::expirespread('','','studentcalc');
  347:             if (($snum==7) || ($snum==4)) {
  348: 	     &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
  349:             } elsif (($snum==8) || ($snum==5)) {
  350: 	     &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
  351:             } else {
  352: 	     &Apache::lonnet::expirespread('','','assesscalc');
  353:             }
  354: 
  355: # Store parameter
  356:             $reply=&Apache::lonnet::critical('put:'.
  357:              $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
  358:              $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'.
  359:              $storecontent,
  360:              $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  361:            } else {
  362: # ------------------------------------------------------------------ Store User
  363: #
  364: # Expire sheets
  365: 	    &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
  366:             if ($snum==1) {
  367: 		&Apache::lonnet::expirespread
  368:                     ($uname,$udom,'assesscalc',$symbp{$sresid});
  369:             } elsif ($snum==2) {
  370: 		&Apache::lonnet::expirespread
  371:                     ($uname,$udom,'assesscalc',$mapp{$sresid});
  372:             } else {
  373: 		&Apache::lonnet::expirespread($uname,$udom,'assesscalc');
  374:             }
  375:                 
  376: # Store parameter
  377:             $reply=
  378:             &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'.
  379:              $storecontent,$uhome);
  380:            }
  381: 
  382:          if ($reply=~/^error\:(.*)/) {
  383: 	     $message.="<font color=red>Write Error: $1</font>";
  384: 	 }
  385: # ---------------------------------------------------------------- Done storing
  386:    }
  387: # -------------------------------------------------------------- Get coursedata
  388:         my $reply=&Apache::lonnet::reply('dump:'.
  389:               $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
  390:               $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
  391:               $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
  392:         if ($reply!~/^error\:/) {
  393:            map {
  394:              my ($name,$value)=split(/\=/,$_);
  395:              $courseopt{&Apache::lonnet::unescape($name)}=
  396:                         &Apache::lonnet::unescape($value);  
  397:            } split(/\&/,$reply);
  398:         }
  399: # --------------------------------------------------- Get userdata (if present)
  400:         if ($uname) {
  401:            my $reply=
  402:        &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
  403:            if ($reply!~/^error\:/) {
  404:               map {
  405:                 my ($name,$value)=split(/\=/,$_);
  406:                 $useropt{&Apache::lonnet::unescape($name)}=
  407:                          &Apache::lonnet::unescape($value);
  408:               } split(/\&/,$reply);
  409:            }
  410:         }
  411: 
  412: # ------------------------------------------------------------------- Sort this
  413: 
  414:         @ids=sort  {  
  415:            if ($fcat eq '') {
  416:               $a<=>$b;
  417:            } else {
  418:               1*$outpar[&parmval($fcat,$a,$defp{$a})]<=>
  419:               1*$outpar[&parmval($fcat,$b,$defp{$b})];
  420:            } 
  421:        } @ids;
  422: 
  423: # ------------------------------------------------------------------ Start page
  424:          $r->content_type('text/html');
  425:          $r->send_http_header;
  426: 	$r->print(<<ENDHEAD);
  427: <html>
  428: <head>
  429: <title>LON-CAPA Assessment Parameters</title>
  430: <script>
  431: 
  432:     function pclose() {
  433:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
  434:                  "height=350,width=350,scrollbars=no,menubar=no");
  435:         parmwin.close();
  436:     }
  437: 
  438:     function pjump(type,dis,value,marker,ret,call) {
  439:         document.parmform.pres_marker.value='';
  440:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
  441:                  +"&value="+escape(value)+"&marker="+escape(marker)
  442:                  +"&return="+escape(ret)
  443:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
  444:                  "height=350,width=350,scrollbars=no,menubar=no");
  445: 
  446:     }
  447: 
  448:     function psub() {
  449:         pclose();
  450:         if (document.parmform.pres_marker.value!='') {
  451:             document.parmform.action+='#'+document.parmform.pres_marker.value;
  452:             var typedef=new Array();
  453:             typedef=document.parmform.pres_type.value.split('_');
  454:            if (document.parmform.pres_type.value!='') {
  455:             if (typedef[0]=='date') {
  456:                 eval('document.parmform.recent_'+
  457:                      document.parmform.pres_type.value+
  458: 		     '.value=document.parmform.pres_value.value;');
  459:             } else {
  460:                 eval('document.parmform.recent_'+typedef[0]+
  461: 		     '.value=document.parmform.pres_value.value;');
  462:             }
  463: 	   }
  464:             document.parmform.submit();
  465:         } else {
  466:             document.parmform.pres_value.value='';
  467:             document.parmform.pres_marker.value='';
  468:         }
  469:     }
  470: 
  471: </script>
  472: </head>
  473: <body bgcolor="#FFFFFF" onUnload="pclose()">
  474: <h1>Set Assessment Parameters</h1>
  475: <form method="post" action="/adm/parmset" name="parmform">
  476: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
  477: <b>
  478: Section/Group: 
  479: <input type="text" value="$csec" size="6" name="csec">
  480: <br>
  481: For User 
  482: <input type="text" value="$uname" size="12" name="uname">
  483: or ID
  484: <input type="text" value="$id" size="12" name="id"> 
  485: at Domain 
  486: <input type="text" value="$udom" size="6" name="udom">
  487: </b>
  488: <input type="hidden" value='' name="pres_value">
  489: <input type="hidden" value='' name="pres_type">
  490: <input type="hidden" value='' name="pres_marker"> 
  491: ENDHEAD
  492:     if ($ENV{'form.url'}) {
  493: 	$r->print('<input type="hidden" value="'.$ENV{'form.url'}.
  494: 	      '" name="url"><input type="hidden" name="command" value="set">');
  495:     }
  496:     map {
  497:       $r->print('<input type="hidden" value="'.
  498:           $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
  499:     } ('tolerance','date_default','date_start','date_end','date_interval',
  500:        'int','float','string');
  501: 
  502:         $r->print('<h2>'.$message.'</h2><table><tr><td>Sort list by</td><td>');
  503: 	$r->print('<select name="fcat">');
  504:         $r->print('<option value="">Enclosing Map</option>');
  505:         map {
  506: 	    $r->print('<option value="'.$_.'"');
  507:             if ($fcat eq $_) { $r->print(' selected'); }
  508:             $r->print('>'.$allkeys{$_}.'</option>');
  509:         } keys %allkeys;
  510:        $r->print(
  511:     '</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>');
  512:         $r->print('<option value=all>All Maps</option>');
  513:         map {
  514: 	    $r->print('<option value="'.$_.'"');
  515:             if (($pssymb=~/^$allmaps{$_}/) || 
  516:                 ($pschp eq $_)) { $r->print(' selected'); }
  517:             $r->print('>'.$allmaps{$_}.'</option>');
  518:         } keys %allmaps;
  519:         $r->print(
  520:  '</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>');
  521:         $r->print('<option value=all>All Parameters</option>');
  522:         map {
  523: 	    $r->print('<option value="'.$_.'"');
  524:             if ($pscat eq $_) { $r->print(' selected'); }
  525:             $r->print('>'.$allkeys{$_}.'</option>');
  526:         } keys %allkeys;
  527:         $r->print(
  528: '</select></td></tr></table><br><input name=dis type="submit" value="Display">'
  529:                  );
  530:       if (($pscat) || ($pschp) || ($pssymb)) {
  531: # ----------------------------------------------------------------- Start Table
  532: 	my $catmarker='parameter_'.$pscat;
  533:         $catmarker=~s/\./\_/g;
  534:         my $coursespan=$csec?8:5;
  535: 	 $r->print(<<ENDTABLEHEAD);
  536: <p><table border=2>
  537: <tr><td colspan=5></td>
  538: <th colspan=$coursespan>Any User</th>
  539: ENDTABLEHEAD
  540:     if ($uname) {
  541: 	$r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>");
  542:     }
  543:     $r->print(<<ENDTABLETWO);
  544: <th rowspan=3>Parameter in Effect</th></tr><tr><td colspan=5></td>
  545: <th colspan=2>Resource Level</th>
  546: <th colspan=3>in Course</th>
  547: ENDTABLETWO
  548:     if ($csec) {
  549: 	$r->print("<th colspan=3>in Section/Group $csec</th>");
  550:     }
  551:     $r->print(<<ENDTABLEHEADFOUR);
  552: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
  553: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
  554: <th>default</th><th>from Enclosing Map</th>
  555: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
  556: ENDTABLEHEADFOUR
  557:     if ($csec) {
  558:   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
  559:     }
  560:     if ($uname) {
  561:   $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
  562:     }
  563: 	$r->print('</tr><tr>');
  564:          my $defbgone='';
  565:          my $defbgtwo='';
  566:  	 map {
  567:            my $rid=$_;
  568:            my ($inmapid)=($rid=~/\.(\d+)$/);
  569:            if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
  570:                ($pssymb eq $mapp{$rid}.'___'.$inmapid.'___'.
  571:                 &Apache::lonnet::declutter($bighash{'src_'.$rid}))) {
  572: # ------------------------------------------------------ Entry for one resource
  573: 	     if ($defbgone eq '"E0E099"') {
  574: 		 $defbgone='"E0E0DD"';
  575:              } else {
  576:                  $defbgone='"E0E099"';
  577: 	     }
  578: 	     if ($defbgtwo eq '"FFFF99"') {
  579: 		 $defbgtwo='"FFFFDD"';
  580:              } else {
  581:                  $defbgtwo='"FFFF99"';
  582: 	     }
  583: 	    @outpar=();
  584:             my $thistitle='';
  585:             my %name=   ();
  586:             my %part=   ();
  587: 	    my %display=();
  588: 	    my %type=   ();
  589:             my %default=();
  590:             my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
  591: 
  592:             map {
  593: 		$part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
  594:                 $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
  595:                 $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
  596:                 unless ($display{$_}) { $display{$_}=''; }
  597:                 $display{$_}.=' ('.$name{$_}.')';
  598:                 $default{$_}=&Apache::lonnet::metadata($uri,$_);
  599:                 $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
  600:                 $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
  601:             } split(/\,/,$keyp{$rid});
  602: 
  603: 	    my $totalparms=scalar keys %name;
  604: 	    my $isdef=1;
  605: 	    unless ($totalparms) { $totalparms=1; $isdef=0; }
  606: 	    if ($pscat ne 'all') { $totalparms=1; }
  607:             $r->print('<td bgcolor='.$defbgone.
  608:                 ' rowspan='.$totalparms.'><tt><font size=-1>'.
  609:                 join(' / ',split(/\//,$uri)).
  610:                 '</font></tt><p><b>'.
  611:                       $bighash{'title_'.$rid});
  612:             if ($thistitle) {
  613: 		$r->print(' ('.$thistitle.')');
  614:             }
  615:             $r->print('</b></td>');
  616:             $r->print('<td bgcolor='.$defbgtwo.
  617:                     ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
  618:             $r->print('<td bgcolor='.$defbgone.
  619:                     ' rowspan='.$totalparms.'><tt><font size=-1>'.
  620: 		      join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
  621: 	  if ($isdef) {
  622:             map {
  623: 	     if (($_ eq $catmarker) || ($pscat eq 'all')) {
  624: 	       my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
  625: 
  626:                $r->print("<td bgcolor=".$defbgtwo.
  627:                   ">$part{$_}</td><td bgcolor=".$defbgone.
  628:                   ">$display{$_}</td>");
  629:                my $thismarker=$_;
  630:                $thismarker=~s/^parameter\_//; 
  631:                my $mprefix=$rid.'&'.$thismarker.'&';
  632: 
  633:                $r->print('<td bgcolor='.
  634:                 (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.
  635:              &valout($outpar[11],$type{$_}).'</td>');
  636:                $r->print('<td bgcolor='.
  637:                 (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.
  638:              &valout($outpar[10],$type{$_}).'</td>');
  639: 
  640:                $r->print('<td bgcolor='.
  641:                 (($result==9)?'"#AAFFAA"':$defbgone).'>'.
  642:              &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
  643:                     'parmform.pres','psub').'</td>');
  644:                $r->print('<td bgcolor='.
  645:                 (($result==8)?'"#AAFFAA"':$defbgone).'>'.
  646:              &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
  647:                     'parmform.pres','psub').'</td>');
  648:                $r->print('<td bgcolor='.
  649:                 (($result==7)?'"#AAFFAA"':$defbgone).'>'.
  650:              &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
  651:                     'parmform.pres','psub').'</td>');
  652: 
  653:                if ($csec) {
  654:                  $r->print('<td bgcolor='.
  655:                    (($result==6)?'"#AAFFAA"':$defbgtwo).'>'.
  656:              &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
  657:                     'parmform.pres','psub').'</td>');
  658:                  $r->print('<td bgcolor='.
  659:                    (($result==5)?'"#AAFFAA"':$defbgtwo).'>'.
  660:              &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
  661:                     'parmform.pres','psub').'</td>');
  662:                  $r->print('<td bgcolor='.
  663:                     (($result==4)?'"#AAFFAA"':$defbgtwo).'>'.
  664:              &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
  665:                     'parmform.pres','psub').'</td>');
  666:                }
  667: 
  668:                if ($uname) {
  669:                  $r->print('<td bgcolor='.
  670:                     (($result==3)?'"#AAFFAA"':$defbgone).'>'.
  671:              &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
  672:                     'parmform.pres','psub').'</td>');
  673:                  $r->print('<td bgcolor='.
  674:                     (($result==2)?'"#AAFFAA"':$defbgone).'>'.
  675:              &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
  676:                     'parmform.pres','psub').'</td>');
  677:                  $r->print('<td bgcolor='.
  678:                    (($result==1)?'"#AAFFAA"':$defbgone).'>'.
  679:              &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
  680:                     'parmform.pres','psub').'</td>');
  681:                }
  682:                $r->print(
  683:         '<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$type{$_}).'</td>');
  684:                $r->print("</tr>\n<tr>");
  685: 	   }
  686: 	   } sort keys %name;
  687: 	} else {
  688:  	    $r->print("</tr>\n<tr>");
  689:         }
  690: # -------------------------------------------------- End entry for one resource
  691: 	 }
  692: 	 } @ids;
  693:          $r->print('</table>');
  694:       }
  695: 	$r->print('</form></body></html>');
  696:          untie(%bighash);
  697: 	 untie(%parmhash);
  698:       }
  699:    } else {
  700: # ----------------------------- Not in a course, or not allowed to modify parms
  701:       $ENV{'user.error.msg'}=
  702:         "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
  703:       return HTTP_NOT_ACCEPTABLE; 
  704:    }
  705:    return OK;
  706: }
  707: 
  708: 1;
  709: __END__
  710: 
  711: 
  712: 
  713: 

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