File:  [LON-CAPA] / loncom / interface / lonparmset.pm
Revision 1.70: download - view: text, annotated - select for diffs
Tue Oct 1 06:21:23 2002 UTC (21 years, 8 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- fixes BUG#799, &EXT seems to not properly handle a
resource.0.weight.type request

    1: # The LearningOnline Network with CAPA
    2: # Handler to set parameters for assessments
    3: #
    4: # $Id: lonparmset.pm,v 1.70 2002/10/01 06:21:23 albertel Exp $
    5: #
    6: # Copyright Michigan State University Board of Trustees
    7: #
    8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
    9: #
   10: # LON-CAPA is free software; you can redistribute it and/or modify
   11: # it under the terms of the GNU General Public License as published by
   12: # the Free Software Foundation; either version 2 of the License, or
   13: # (at your option) any later version.
   14: #
   15: # LON-CAPA is distributed in the hope that it will be useful,
   16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   18: # GNU General Public License for more details.
   19: #
   20: # You should have received a copy of the GNU General Public License
   21: # along with LON-CAPA; if not, write to the Free Software
   22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   23: #
   24: # /home/httpd/html/adm/gpl.txt
   25: #
   26: # http://www.lon-capa.org/
   27: #
   28: ###################################################################
   29: ###################################################################
   30: 
   31: =pod
   32: 
   33: =head1 NAME
   34: 
   35: lonparmset - Handler to set parameters for assessments and course
   36: 
   37: =head1 SYNOPSIS
   38: 
   39: lonparmset provides an interface to setting course parameters. 
   40: 
   41: =head1 DESCRIPTION
   42: 
   43: This module sets coursewide and assessment parameters.
   44: 
   45: =head1 INTERNAL SUBROUTINES
   46: 
   47: =over 4
   48: 
   49: =cut
   50: 
   51: ###################################################################
   52: ###################################################################
   53: 
   54: package Apache::lonparmset;
   55: 
   56: use strict;
   57: use Apache::lonnet;
   58: use Apache::Constants qw(:common :http REDIRECT);
   59: use Apache::loncommon;
   60: use GDBM_File;
   61: use Apache::lonhomework;
   62: use Apache::lonxml;
   63: 
   64: 
   65: my %courseopt;
   66: my %useropt;
   67: my %parmhash;
   68: 
   69: my @ids;
   70: my %symbp;
   71: my %mapp;
   72: my %typep;
   73: my %keyp;
   74: 
   75: my $uname;
   76: my $udom;
   77: my $uhome;
   78: my $csec;
   79: my $coursename;
   80: 
   81: ##################################################
   82: ##################################################
   83: 
   84: =pod
   85: 
   86: =item parmval
   87: 
   88: Figure out a cascading parameter.
   89: 
   90: Inputs:  $what $id $def
   91: 
   92: Returns: I am not entirely sure.
   93: 
   94: =cut
   95: 
   96: ##################################################
   97: ##################################################
   98: sub parmval {
   99:     my ($what,$id,$def)=@_;
  100:     my $result='';
  101:     my @outpar=();
  102: # ----------------------------------------------------- Cascading lookup scheme
  103: 
  104:     my $symbparm=$symbp{$id}.'.'.$what;
  105:     my $mapparm=$mapp{$id}.'___(all).'.$what;
  106: 
  107:     my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
  108:     my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
  109:     my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
  110: 
  111:     my $courselevel=$ENV{'request.course.id'}.'.'.$what;
  112:     my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
  113:     my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
  114: 
  115: # -------------------------------------------------------- first, check default
  116: 
  117:     if ($def) { $outpar[11]=$def; $result=11; }
  118: 
  119: # ----------------------------------------------------- second, check map parms
  120: 
  121:     my $thisparm=$parmhash{$symbparm};
  122:     if ($thisparm) { $outpar[10]=$thisparm; $result=10; }
  123: 
  124: # --------------------------------------------------------- third, check course
  125: 
  126:     if ($courseopt{$courselevel}) {
  127: 	$outpar[9]=$courseopt{$courselevel};
  128: 	$result=9;
  129:     }
  130: 
  131:     if ($courseopt{$courselevelm}) {
  132: 	$outpar[8]=$courseopt{$courselevelm};
  133: 	$result=8;
  134:     }
  135: 
  136:     if ($courseopt{$courselevelr}) {
  137: 	$outpar[7]=$courseopt{$courselevelr};
  138: 	$result=7;
  139:     }
  140: 
  141:     if ($csec) {
  142:         if ($courseopt{$seclevel}) {
  143: 	    $outpar[6]=$courseopt{$seclevel};
  144: 	    $result=6;
  145: 	}
  146:         if ($courseopt{$seclevelm}) {
  147: 	    $outpar[5]=$courseopt{$seclevelm};
  148: 	    $result=5;
  149: 	}
  150: 
  151:         if ($courseopt{$seclevelr}) {
  152: 	    $outpar[4]=$courseopt{$seclevelr};
  153: 	    $result=4;
  154: 	}
  155:     }
  156: 
  157: # ---------------------------------------------------------- fourth, check user
  158: 
  159:     if ($uname) {
  160: 	if ($useropt{$courselevel}) {
  161: 	    $outpar[3]=$useropt{$courselevel};
  162: 	    $result=3;
  163: 	}
  164: 
  165: 	if ($useropt{$courselevelm}) {
  166: 	    $outpar[2]=$useropt{$courselevelm};
  167: 	    $result=2;
  168: 	}
  169: 
  170: 	if ($useropt{$courselevelr}) {
  171: 	    $outpar[1]=$useropt{$courselevelr};
  172: 	    $result=1;
  173: 	}
  174:     }
  175: 
  176:     return ($result,@outpar);
  177: }
  178: 
  179: ##################################################
  180: ##################################################
  181: 
  182: =pod
  183: 
  184: =item valout
  185: 
  186: Format a value for output.
  187: 
  188: Inputs:  $value, $type
  189: 
  190: Returns: $value, formatted for output.  If $type indicates it is a date,
  191: localtime($value) is returned.
  192: 
  193: =cut
  194: 
  195: ##################################################
  196: ##################################################
  197: sub valout {
  198:     my ($value,$type)=@_;
  199:     my $result = '';
  200:     # Values of zero are valid.
  201:     if (! $value && $value ne '0') {
  202:         $result = '  ';
  203:     } else {
  204:         if ($type eq 'date_interval') {
  205:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
  206:             $year=$year-70;
  207:             $mday--;
  208:             if ($year) {
  209: 		$result.=$year.' yrs ';
  210:             }
  211:             if ($mon) {
  212: 		$result.=$mon.' mths ';
  213:             }
  214:             if ($mday) {
  215: 		$result.=$mday.' days ';
  216:             }
  217:             if ($hour) {
  218: 		$result.=$hour.' hrs ';
  219:             }
  220:             if ($min) {
  221: 		$result.=$min.' mins ';
  222:             }
  223:             if ($sec) {
  224: 		$result.=$sec.' secs ';
  225:             }
  226:             $result=~s/\s+$//;
  227:         } elsif ($type=~/^date/) {
  228:             $result = localtime($value);
  229:         } else {
  230:             $result = $value;
  231:         }
  232:     }
  233:     return $result;
  234: }
  235: 
  236: ##################################################
  237: ##################################################
  238: 
  239: =pod
  240: 
  241: =item plink
  242: 
  243: Produces a link anchor.
  244: 
  245: Inputs: $type,$dis,$value,$marker,$return,$call
  246: 
  247: Returns: scalar with html code for a link which will envoke the 
  248: javascript function 'pjump'.
  249: 
  250: =cut
  251: 
  252: ##################################################
  253: ##################################################
  254: sub plink {
  255:     my ($type,$dis,$value,$marker,$return,$call)=@_;
  256:     my $winvalue=$value;
  257:     unless ($winvalue) {
  258: 	if ($type=~/^date/) {
  259:             $winvalue=$ENV{'form.recent_'.$type};
  260:         } else {
  261:             $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
  262:         }
  263:     }
  264:     return 
  265: 	'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
  266: 	    .$marker."','".$return."','".$call."'".');">'.
  267: 		&valout($value,$type).'</a><a name="'.$marker.'"></a>';
  268: }
  269: 
  270: 
  271: sub startpage {
  272:     my ($r,$id,$udom,$csec,$uname)=@_;
  273:     $r->content_type('text/html');
  274:     $r->send_http_header;
  275:  
  276:     my $bodytag=&Apache::loncommon::bodytag('Set Course Parameters','',
  277:                                             'onUnload="pclose()"');
  278:     $r->print(<<ENDHEAD);
  279: <html>
  280: <head>
  281: <title>LON-CAPA Course Parameters</title>
  282: <script>
  283: 
  284:     function pclose() {
  285:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
  286:                  "height=350,width=350,scrollbars=no,menubar=no");
  287:         parmwin.close();
  288:     }
  289: 
  290:     function pjump(type,dis,value,marker,ret,call) {
  291:         document.parmform.pres_marker.value='';
  292:         parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
  293:                  +"&value="+escape(value)+"&marker="+escape(marker)
  294:                  +"&return="+escape(ret)
  295:                  +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
  296:                  "height=350,width=350,scrollbars=no,menubar=no");
  297: 
  298:     }
  299: 
  300:     function psub() {
  301:         pclose();
  302:         if (document.parmform.pres_marker.value!='') {
  303:             document.parmform.action+='#'+document.parmform.pres_marker.value;
  304:             var typedef=new Array();
  305:             typedef=document.parmform.pres_type.value.split('_');
  306:            if (document.parmform.pres_type.value!='') {
  307:             if (typedef[0]=='date') {
  308:                 eval('document.parmform.recent_'+
  309:                      document.parmform.pres_type.value+
  310: 		     '.value=document.parmform.pres_value.value;');
  311:             } else {
  312:                 eval('document.parmform.recent_'+typedef[0]+
  313: 		     '.value=document.parmform.pres_value.value;');
  314:             }
  315: 	   }
  316:             document.parmform.submit();
  317:         } else {
  318:             document.parmform.pres_value.value='';
  319:             document.parmform.pres_marker.value='';
  320:         }
  321:     }
  322: 
  323:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
  324:         var options = "width=" + w + ",height=" + h + ",";
  325:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
  326:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
  327:         var newWin = window.open(url, wdwName, options);
  328:         newWin.focus();
  329:     }
  330: </script>
  331: </head>
  332: $bodytag
  333: <form method="post" action="/adm/parmset" name="envform">
  334: <h3>Course Environment</h3>
  335: <input type="submit" name="crsenv" value="Set Course Environment">
  336: </form>
  337: <form method="post" action="/adm/parmset" name="parmform">
  338: <h3>Course Assessments</h3>
  339: <b>
  340: Section/Group:
  341: <input type="text" value="$csec" size="6" name="csec">
  342: <br>
  343: For User 
  344: <input type="text" value="$uname" size="12" name="uname">
  345: or ID
  346: <input type="text" value="$id" size="12" name="id"> 
  347: at Domain 
  348: <input type="text" value="$udom" size="6" name="udom">
  349: </b>
  350: <input type="hidden" value='' name="pres_value">
  351: <input type="hidden" value='' name="pres_type">
  352: <input type="hidden" value='' name="pres_marker">
  353: ENDHEAD
  354: 
  355: }
  356: 
  357: sub print_row {
  358:     my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone,
  359: 	$defbgtwo,$parmlev)=@_;
  360: # get the values for the parameter in cascading order
  361: # empty levels will remain empty
  362:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
  363: 				  $rid,$$default{$which});
  364: # get the type for the parameters
  365: # problem: these may not be set for all levels
  366:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
  367:                                           $$name{$which}.'.type',
  368: 				  $rid,$$defaulttype{$which});
  369: # cascade down manually
  370:     my $cascadetype=$defaulttype;
  371:     for (my $i=$#typeoutpar;$i>0;$i--) {
  372: 	 if ($typeoutpar[$i]) { 
  373:             $cascadetype=$typeoutpar[$i];
  374: 	} else {
  375:             $typeoutpar[$i]=$cascadetype;
  376:         }
  377:     }
  378:  
  379:     my $parm=$$display{$which};
  380: 
  381:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
  382:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
  383:                   .$$part{$which}.'</td>');
  384:     } else {    
  385:         $parm=~s|\[.*\]\s||g;
  386:     }
  387: 
  388:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
  389:    
  390:     my $thismarker=$which;
  391:     $thismarker=~s/^parameter\_//;
  392:     my $mprefix=$rid.'&'.$thismarker.'&';
  393: 
  394:     if ($parmlev eq 'general') {
  395: 
  396:         if ($uname) {
  397:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  398:         } elsif ($csec) {
  399:             &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
  400:         } else {
  401:             &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
  402:         }
  403:     } elsif ($parmlev eq 'map') {
  404: 
  405:         if ($uname) {
  406:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  407:         } elsif ($csec) {
  408:             &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  409:         } else {
  410:             &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  411:         }
  412:     } else {
  413: 
  414:         &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  415: 
  416:         if ($parmlev eq 'brief') {
  417: 
  418:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  419: 
  420:            if ($csec) {
  421:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  422:            }
  423:            if ($uname) {
  424:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  425:            }
  426:         } else {
  427: 
  428:            &print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  429:            &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  430:            &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  431:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  432: 
  433:            if ($csec) {
  434:                &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  435:                &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  436:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  437:            }
  438:            if ($uname) {
  439:                &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  440:                &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  441:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
  442:            }
  443:         } # end of $brief if/else
  444:     } # end of $parmlev if/else
  445: 
  446:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
  447:         $r->print('<td bgcolor=#CCCCFF align="center">'.
  448:                   &valout($outpar[$result],$typeoutpar[$result]).'</td>');
  449:     }
  450:     my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
  451:                                         '.'.$$name{$which},$symbp{$rid});
  452: # this doesn't seem to work, and I don't think is correct
  453: #    my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
  454: #                                      '.'.$$name{$which}.'.type',$symbp{$rid});
  455: # this seems to work
  456:     my $sessionvaltype=$typeoutpar[$result];
  457:     $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
  458:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
  459:                   '</font></td>');
  460:     $r->print('</tr>');
  461:     $r->print("\n");
  462: }
  463: 
  464: sub print_td {
  465:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
  466:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
  467:               ' align="center">'.
  468:               &plink($$typeoutpar[$which],$$display{$value},$$outpar[$which],
  469:                      $mprefix."$which",'parmform.pres','psub').'</td>'."\n");
  470: }
  471: 
  472: sub get_env_multiple {
  473:     my ($name) = @_;
  474:     my @values;
  475:     if (defined($ENV{$name})) {
  476:         # exists is it an array
  477:         if (ref($ENV{$name})) {
  478:             @values=@{ $ENV{$name} };
  479:         } else {
  480:             $values[0]=$ENV{$name};
  481:         }
  482:     }
  483:     return(@values);
  484: }
  485: 
  486: =pod
  487: 
  488: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
  489: 
  490: Input: See list below:
  491: 
  492: =over 4
  493: 
  494: =item B<ids>: An array that will contain all of the ids in the course.
  495: 
  496: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
  497: 
  498: =item B<keyp>: hash, id->key list, will contain a comma seperated list of the meta-data keys available for the given id
  499: 
  500: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
  501: 
  502: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
  503: 
  504: =item B<allkeys>: hash, full key to part->display value (what's display value?)
  505: 
  506: =item B<allmaps>: hash, ???
  507: 
  508: =item B<fcat>: ???
  509: 
  510: =item B<defp>: hash, ???
  511: 
  512: =item B<mapp>: ??
  513: 
  514: =item B<symbp>: hash, id->full sym?
  515: 
  516: =back
  517: 
  518: =cut
  519: 
  520: sub extractResourceInformation {
  521:     my $bighash = shift;
  522:     my $ids = shift;
  523:     my $typep = shift;
  524:     my $keyp = shift;
  525:     my $allparms = shift;
  526:     my $allparts = shift;
  527:     my $allkeys = shift;
  528:     my $allmaps = shift;
  529:     my $fcat = shift;
  530:     my $defp = shift;
  531:     my $mapp = shift;
  532:     my $symbp = shift;
  533: 
  534:     foreach (keys %$bighash) {
  535: 	if ($_=~/^src\_(\d+)\.(\d+)$/) {
  536: 	    my $mapid=$1;
  537: 	    my $resid=$2;
  538: 	    my $id=$mapid.'.'.$resid;
  539: 	    my $srcf=$$bighash{$_};
  540: 	    if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
  541: 		$$ids[$#$ids+1]=$id;
  542: 		$$typep{$id}=$1;
  543: 		$$keyp{$id}='';
  544: 		foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
  545: 		  if ($_=~/^parameter\_(.*)/) {
  546:                     my $key=$_;
  547:                     my $allkey=$1;
  548:                     $allkey=~s/\_/\./g;
  549:                     my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
  550:                     my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
  551:                     my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
  552:                     my $parmdis = $display;
  553:                     $parmdis =~ s|(\[Part.*$)||g;
  554:                     my $partkey = $part;
  555:                     $partkey =~ tr|_|.|;
  556:                     $$allparms{$name} = $parmdis;
  557:                     $$allparts{$part} = "[Part $part]";
  558:                     $$allkeys{$allkey}=$display;
  559:                     if ($allkey eq $fcat) {
  560: 		        $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
  561: 		    }
  562: 		    if ($$keyp{$id}) {
  563: 		        $$keyp{$id}.=','.$key;
  564: 		    } else {
  565: 		        $$keyp{$id}=$key;
  566: 		    }
  567: 		  }
  568: 		}
  569: 		$$mapp{$id}=
  570: 		    &Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});
  571:                 $$mapp{$mapid}=$$mapp{$id};
  572: 		$$allmaps{$mapid}=$$mapp{$id};
  573: 		$$symbp{$id}=$$mapp{$id}.
  574: 			'___'.$resid.'___'.
  575: 			    &Apache::lonnet::declutter($srcf);
  576:                 $$symbp{$mapid}=$$mapp{$id}.'___(all)';
  577: 	    }
  578: 	}
  579:     }
  580: }
  581: 
  582: ##################################################
  583: ##################################################
  584: 
  585: =pod
  586: 
  587: =item assessparms
  588: 
  589: Show assessment data and parameters.  This is a large routine that should
  590: be simplified and shortened... someday.
  591: 
  592: Inputs: $r
  593: 
  594: Returns: nothing
  595: 
  596: Variables used (guessed by Jeremy):
  597: 
  598: =over 4
  599: 
  600: =item B<pscat>: ParameterS CATegories? ends up a list of the types of parameters that exist, e.g., tol, weight, acc, opendate, duedate, answerdate, sig, maxtries, type.
  601: 
  602: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
  603: 
  604: =item B<allmaps>:
  605: 
  606: =back
  607: 
  608: =cut
  609: 
  610: ##################################################
  611: ##################################################
  612: sub assessparms {
  613: 
  614:     my $r=shift;
  615: # -------------------------------------------------------- Variable declaration
  616:     my %allkeys;
  617:     my %allmaps;
  618:     my %alllevs;
  619: 
  620:     $alllevs{'Resource Level'}='full';
  621: #    $alllevs{'Resource Level [BRIEF]'}='brief';
  622:     $alllevs{'Map Level'}='map';
  623:     $alllevs{'Course Level'}='general';
  624: 
  625:     my %allparms;
  626:     my %allparts;
  627: 
  628:     my %defp;
  629:     %courseopt=();
  630:     %useropt=();
  631:     my %bighash=();
  632: 
  633:     @ids=();
  634:     %symbp=();
  635:     %typep=();
  636: 
  637:     my $message='';
  638: 
  639:     $csec=$ENV{'form.csec'};
  640:     $udom=$ENV{'form.udom'};
  641:     unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
  642: 
  643:     my @pscat=&get_env_multiple('form.pscat');
  644:     my $pschp=$ENV{'form.pschp'};
  645:     my @psprt=&get_env_multiple('form.psprt');
  646:     my $showoptions=$ENV{'form.showoptions'};
  647: 
  648:     my $pssymb='';
  649:     my $parmlev='';
  650:     my $prevvisit=$ENV{'form.prevvisit'};
  651: 
  652: #    unless ($parmlev==$ENV{'form.parmlev'}) {
  653: #        $parmlev = 'full';
  654: #    }
  655:  
  656:     unless ($ENV{'form.parmlev'}) {
  657:         $parmlev = 'map';
  658:     } else {
  659:         $parmlev = $ENV{'form.parmlev'};
  660:     }
  661: 
  662: # ----------------------------------------------- Was this started from grades?
  663: 
  664:     if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
  665: 	&& (!$ENV{'form.dis'})) {
  666: 	my $url=$ENV{'form.url'};
  667: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
  668: 	$pssymb=&Apache::lonnet::symbread($url);
  669: 	@pscat='all';
  670: 	$pschp='';
  671:         $parmlev = 'full';
  672:     } elsif ($ENV{'form.symb'}) {
  673: 	$pssymb=$ENV{'form.symb'};
  674: 	@pscat='all';
  675: 	$pschp='';
  676:         $parmlev = 'full';
  677:     } else {
  678: 	$ENV{'form.url'}='';
  679:     }
  680: 
  681:     my $id=$ENV{'form.id'};
  682:     if (($id) && ($udom)) {
  683: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
  684: 	if ($uname) {
  685: 	    $id='';
  686: 	} else {
  687: 	    $message=
  688: 		"<font color=red>Unknown ID '$id' at domain '$udom'</font>";
  689: 	}
  690:     } else {
  691: 	$uname=$ENV{'form.uname'};
  692:     }
  693:     unless ($udom) { $uname=''; }
  694:     $uhome='';
  695:     if ($uname) {
  696: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
  697:         if ($uhome eq 'no_host') {
  698: 	    $message=
  699: 		"<font color=red>Unknown user '$uname' at domain '$udom'</font>";
  700: 	    $uname='';
  701:         } else {
  702: 	    $csec=&Apache::lonnet::usection($udom,$uname,
  703: 					    $ENV{'request.course.id'});
  704: 	    if ($csec eq '-1') {
  705: 		$message="<font color=red>".
  706: 		    "User '$uname' at domain '$udom' not ".
  707:                     "in this course</font>";
  708: 		$uname='';
  709: 		$csec=$ENV{'form.csec'};
  710: 	    } else {
  711: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
  712: 		      ('firstname','middlename','lastname','generation','id'));
  713: 		$message="\n<p>\nFull Name: ".
  714: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
  715: 			.$name{'lastname'}.' '.$name{'generation'}.
  716: 			    "<br>\nID: ".$name{'id'}.'<p>';
  717: 	    }
  718:         }
  719:     }
  720: 
  721:     unless ($csec) { $csec=''; }
  722: 
  723:     my $fcat=$ENV{'form.fcat'};
  724:     unless ($fcat) { $fcat=''; }
  725: 
  726: # ------------------------------------------------------------------- Tie hashs
  727:     if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
  728: 	      &GDBM_READER(),0640))) {
  729: 	$r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
  730: 	return ;
  731:     }
  732:     if (!(tie(%parmhash,'GDBM_File',
  733: 	      $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
  734: 	$r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
  735: 	return ;
  736:     }
  737: 
  738: # --------------------------------------------------------- Get all assessments
  739:     extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp);
  740: 
  741:     $mapp{'0.0'} = '';
  742:     $symbp{'0.0'} = '';
  743: # ---------------------------------------------------------- Anything to store?
  744:     if ($ENV{'form.pres_marker'}) {
  745: 	my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
  746: 	$spnam=~s/\_([^\_]+)$/\.$1/;
  747: # ---------------------------------------------------------- Construct prefixes
  748: 
  749: 	my $symbparm=$symbp{$sresid}.'.'.$spnam;
  750: 	my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
  751: 	
  752: 	my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
  753: 	my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
  754: 	my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
  755: 	
  756: 	my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
  757: 	my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
  758: 	my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
  759: 	
  760: 	my $storeunder='';
  761: 	if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
  762: 	if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
  763: 	if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
  764: 	if ($snum==6) { $storeunder=$seclevel; }
  765: 	if ($snum==5) { $storeunder=$seclevelm; }
  766: 	if ($snum==4) { $storeunder=$seclevelr; }
  767: 	
  768:         my %storecontent = ($storeunder         => $ENV{'form.pres_value'},
  769:                             $storeunder.'.type' => $ENV{'form.pres_type'});
  770: 	my $reply='';
  771: 	if ($snum>3) {
  772: # ---------------------------------------------------------------- Store Course
  773: #
  774: # Expire sheets
  775: 	    &Apache::lonnet::expirespread('','','studentcalc');
  776: 	    if (($snum==7) || ($snum==4)) {
  777: 		&Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
  778: 	    } elsif (($snum==8) || ($snum==5)) {
  779: 		&Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
  780: 	    } else {
  781: 		&Apache::lonnet::expirespread('','','assesscalc');
  782: 	    }
  783: # Store parameter
  784:             $reply=&Apache::lonnet::cput
  785:                 ('resourcedata',\%storecontent,
  786:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  787:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  788: 	} else {
  789: # ------------------------------------------------------------------ Store User
  790: #
  791: # Expire sheets
  792: 	    &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
  793: 	    if ($snum==1) {
  794: 		&Apache::lonnet::expirespread
  795: 		    ($uname,$udom,'assesscalc',$symbp{$sresid});
  796: 	    } elsif ($snum==2) {
  797: 		&Apache::lonnet::expirespread
  798: 		    ($uname,$udom,'assesscalc',$mapp{$sresid});
  799: 	    } else {
  800: 		&Apache::lonnet::expirespread($uname,$udom,'assesscalc');
  801: 	    }
  802: # Store parameter
  803: 	    $reply=&Apache::lonnet::cput
  804:                 ('resourcedata',\%storecontent,$udom,$uname);
  805: 	}
  806: 
  807: 	if ($reply=~/^error\:(.*)/) {
  808: 	    $message.="<font color=red>Write Error: $1</font>";
  809: 	}
  810: # ---------------------------------------------------------------- Done storing
  811:     }
  812: # --------------------------------------------- Devalidate cache for this child
  813:         &Apache::lonnet::devalidatecourseresdata(
  814:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
  815:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
  816: # -------------------------------------------------------------- Get coursedata
  817:     %courseopt = &Apache::lonnet::dump
  818:         ('resourcedata',
  819:          $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
  820:          $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
  821: # --------------------------------------------------- Get userdata (if present)
  822:     if ($uname) {
  823:         %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
  824:     }
  825: 
  826: # ------------------------------------------------------------------- Sort this
  827: 
  828:     @ids=sort  {
  829: 	if ($fcat eq '') {
  830: 	    $a<=>$b;
  831: 	} else {
  832: 	    my ($result,@outpar)=&parmval($fcat,$a,$defp{$a});
  833: 	    my $aparm=$outpar[$result];
  834: 	    ($result,@outpar)=&parmval($fcat,$b,$defp{$b});
  835: 	    my $bparm=$outpar[$result];
  836: 	    1*$aparm<=>1*$bparm;
  837: 	}
  838:     } @ids;
  839: #----------------------------------------------- if all selected, fill in array
  840:     if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
  841:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
  842: # ------------------------------------------------------------------ Start page
  843: 
  844:     &startpage($r,$id,$udom,$csec,$uname);
  845: #    if ($ENV{'form.url'}) {
  846: #	$r->print('<input type="hidden" value="'.$ENV{'form.url'}.
  847: #		  '" name="url"><input type="hidden" name="command" value="set">');
  848: #    }
  849:     $r->print('<input type="hidden" value="true" name="prevvisit">');
  850: 
  851:     foreach ('tolerance','date_default','date_start','date_end',
  852: 	     'date_interval','int','float','string') {
  853: 	$r->print('<input type="hidden" value="'.
  854: 		  $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
  855:     }
  856: 
  857:     $r->print('<h2>'.$message.'</h2><table>');
  858:                         
  859:     $r->print('<tr><td><hr /></td></tr>');
  860: 
  861:     my $submitmessage;
  862:     if (($prevvisit) || ($pschp) || ($pssymb)) {
  863:         $submitmessage = "Update Display";
  864:     } else {
  865:         $submitmessage = "Display";
  866:     }
  867:     if (!$pssymb) {
  868:         $r->print('<tr><td>Select Parameter Level</td><td>');
  869:         $r->print('<select name="parmlev">');
  870:         foreach (reverse sort keys %alllevs) {
  871:             $r->print('<option value="'.$alllevs{$_}.'"');
  872:             if ($parmlev eq $alllevs{$_}) {
  873:                $r->print(' selected'); 
  874:             }
  875:             $r->print('>'.$_.'</option>');
  876:         }
  877:         $r->print("</select></td>\n");
  878:     
  879:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
  880: 
  881:         $r->print('</tr><tr><td><hr /></td>');
  882: 
  883:         $r->print('<tr><td>Select Enclosing Map</td>');
  884:         $r->print('<td colspan="2"><select name="pschp">');
  885:         $r->print('<option value="all">All Maps</option>');
  886:         foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
  887:             $r->print('<option value="'.$_.'"');
  888:             if (($pschp eq $_)) { $r->print(' selected'); }
  889:             $r->print('>/res/'.$allmaps{$_}.'</option>');
  890:         }
  891:         $r->print("</select></td></tr>\n");
  892:     } else {
  893:         my ($map,$id,$resource)=split(/___/,$pssymb);
  894:         $r->print("<tr><td>Specific Resource</td><td>$resource</td>");
  895:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
  896:         $r->print('</tr>');
  897:         $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
  898:     }
  899: 
  900:     $r->print('<tr><td colspan="3"><hr /><input type="checkbox"');
  901:     if ($showoptions eq 'show') {$r->print(" checked ");}
  902:     $r->print(' name="showoptions" value="show" onclick="form.submit();">Show More Options<hr /></td></tr>');
  903: #    $r->print("<tr><td>Show: $showoptions</td></tr>");
  904: #    $r->print("<tr><td>pscat: @pscat</td></tr>");
  905: #    $r->print("<tr><td>psprt: @psprt</td></tr>");
  906: #    $r->print("<tr><td>fcat:  $fcat</td></tr>");
  907: 
  908:     if ($showoptions eq 'show') {
  909:         my $tempkey;
  910: 
  911:         $r->print('<tr><td colspan="3" align="center">Select Parameters to View</td></tr>');
  912: 
  913:         $r->print('<tr><td colspan="2"><table>');
  914:         $r->print('<tr><td><input type="checkbox" name="pscat" value="all"');
  915:         $r->print(' checked') unless (@pscat);
  916:         $r->print('>All Parameters</td>');
  917: 
  918:         my $cnt=0;
  919: 
  920:         foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
  921:                       keys %allparms ) {
  922:             ++$cnt;
  923:             $r->print('</tr><tr>') unless ($cnt%2);
  924:             $r->print('<td><input type="checkbox" name="pscat" ');
  925:             $r->print('value="'.$tempkey.'"');
  926:             if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
  927:                 $r->print(' checked');
  928:             }
  929:             $r->print('>'.$allparms{$tempkey}.'</td>');
  930:         }
  931:         $r->print('</tr></table>');
  932: 
  933: #        $r->print('<tr><td>Select Parts</td><td>');
  934:         $r->print('<td><select multiple name="psprt" size="5">');
  935:         $r->print('<option value="all"');
  936:         $r->print(' selected') unless (@psprt);
  937:         $r->print('>All Parts</option>');
  938:         foreach $tempkey (sort keys %allparts) {
  939:             unless ($tempkey =~ /\./) {
  940:                 $r->print('<option value="'.$tempkey.'"');
  941:                 if ($psprt[0] eq "all" ||  grep $_ == $tempkey, @psprt) {
  942:                     $r->print(' selected');
  943:                 }
  944:                 $r->print('>'.$allparts{$tempkey}.'</option>');
  945:             }
  946:         }
  947:         $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
  948: 
  949:         $r->print('<tr><td>Sort list by</td><td>');
  950:         $r->print('<select name="fcat">');
  951:         $r->print('<option value="">Enclosing Map</option>');
  952:         foreach (sort keys %allkeys) {
  953:             $r->print('<option value="'.$_.'"');
  954:             if ($fcat eq $_) { $r->print(' selected'); }
  955:             $r->print('>'.$allkeys{$_}.'</option>');
  956:         }
  957:         $r->print('</select></td>');
  958: 
  959:         $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
  960: 
  961:     } else { # hide options - include any necessary extras here
  962: 
  963:         $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
  964: 
  965:         unless (@pscat) {
  966:           foreach (keys %allparms ) {
  967:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
  968:           }
  969:         } else {
  970:           foreach (@pscat) {
  971:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
  972:           }
  973:         }
  974: 
  975:         unless (@psprt) {
  976:           foreach (keys %allparts ) {
  977:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
  978:           }
  979:         } else {
  980:           foreach (@psprt) {
  981:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
  982:           }
  983:         }
  984: 
  985:     }
  986:     $r->print('</table>');
  987: 
  988:     my @temp_psprt;
  989:     foreach my $t (@psprt) {
  990: 	push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
  991:     }
  992: 
  993:     @psprt = @temp_psprt;
  994: 
  995:     my @temp_pscat;
  996:     map {
  997:         my $cat = $_;
  998:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
  999:     } @pscat;
 1000: 
 1001:     @pscat = @temp_pscat;
 1002: 
 1003:     if (($prevvisit) || ($pschp) || ($pssymb)) {
 1004: # ----------------------------------------------------------------- Start Table
 1005:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
 1006:         my $csuname=$ENV{'user.name'};
 1007:         my $csudom=$ENV{'user.domain'};
 1008: 
 1009: 
 1010:         if ($parmlev eq 'full' || $parmlev eq 'brief') {
 1011: 
 1012:            my $coursespan=$csec?8:5;
 1013:            $r->print('<p><table border=2>');
 1014:            $r->print('<tr><td colspan=5></td>');
 1015:            $r->print('<th colspan='.($coursespan).'>Any User</th>');
 1016:            if ($uname) {
 1017:                $r->print("<th colspan=3 rowspan=2>");
 1018:                $r->print("User $uname at Domain $udom</th>");
 1019:            }
 1020:            $r->print(<<ENDTABLETWO);
 1021: <th rowspan=3>Parameter in Effect</th>
 1022: <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th>
 1023: </tr><tr><td colspan=5></td><th colspan=2>Resource Level</th>
 1024: <th colspan=3>in Course</th>
 1025: ENDTABLETWO
 1026:            if ($csec) {
 1027:                 $r->print("<th colspan=3>in Section/Group $csec</th>");
 1028:            }
 1029:            $r->print(<<ENDTABLEHEADFOUR);
 1030: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
 1031: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
 1032: <th>default</th><th>from Enclosing Map</th>
 1033: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
 1034: ENDTABLEHEADFOUR
 1035: 
 1036:            if ($csec) {
 1037:                $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
 1038:            }
 1039: 
 1040:            if ($uname) {
 1041:                $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
 1042:            }
 1043: 
 1044:            $r->print('</tr>');
 1045: 
 1046:            my $defbgone='';
 1047:            my $defbgtwo='';
 1048: 
 1049:            foreach (@ids) {
 1050: 
 1051:                 my $rid=$_;
 1052:                 my ($inmapid)=($rid=~/\.(\d+)$/);
 1053: 
 1054:                 if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
 1055:                     ($pssymb eq $symbp{$rid})) {
 1056: # ------------------------------------------------------ Entry for one resource
 1057:                     if ($defbgone eq '"E0E099"') {
 1058:                         $defbgone='"E0E0DD"';
 1059:                     } else {
 1060:                         $defbgone='"E0E099"';
 1061:                     }
 1062:                     if ($defbgtwo eq '"FFFF99"') {
 1063:                         $defbgtwo='"FFFFDD"';
 1064:                     } else {
 1065:                         $defbgtwo='"FFFF99"';
 1066:                     }
 1067:                     my $thistitle='';
 1068:                     my %name=   ();
 1069:                     undef %name;
 1070:                     my %part=   ();
 1071:                     my %display=();
 1072:                     my %type=   ();
 1073:                     my %default=();
 1074:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
 1075: 
 1076:                     foreach (split(/\,/,$keyp{$rid})) {
 1077:                         my $tempkeyp = $_;
 1078:                         if (grep $_ eq $tempkeyp, @catmarker) {
 1079:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
 1080:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
 1081:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
 1082:                           unless ($display{$_}) { $display{$_}=''; }
 1083:                           $display{$_}.=' ('.$name{$_}.')';
 1084:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
 1085:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
 1086:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
 1087:                         }
 1088:                     }
 1089:                     my $totalparms=scalar keys %name;
 1090:                     if ($totalparms>0) {
 1091:                         my $firstrow=1;
 1092: 
 1093:                         $r->print('<tr><td bgcolor='.$defbgone.
 1094:                              ' rowspan='.$totalparms.
 1095:                              '><tt><font size=-1>'.
 1096:                              join(' / ',split(/\//,$uri)).
 1097:                              '</font></tt><p><b>'.
 1098:                              "<a href=\"javascript:openWindow('/res/".$uri.
 1099:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
 1100:                              " TARGET=_self>$bighash{'title_'.$rid}");
 1101: 
 1102:                         if ($thistitle) {
 1103:                             $r->print(' ('.$thistitle.')');
 1104:                         }
 1105:                         $r->print('</a></b></td>');
 1106:                         $r->print('<td bgcolor='.$defbgtwo.
 1107:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
 1108:                                       '</td>');
 1109: 
 1110:                         $r->print('<td bgcolor='.$defbgone.
 1111:                                       ' rowspan='.$totalparms.
 1112:                                       '><tt><font size=-1>');
 1113: 
 1114:                         $r->print(' / res / ');
 1115:                         $r->print(join(' / ', split(/\//,$mapp{$rid})));
 1116: 
 1117:                         $r->print('</font></tt></td>');
 1118: 
 1119:                         foreach (sort keys %name) {
 1120:                             unless ($firstrow) {
 1121:                                 $r->print('<tr>');
 1122:                             } else {
 1123:                                 undef $firstrow;
 1124:                             }
 1125: 
 1126:                             &print_row($r,$_,\%part,\%name,$rid,\%default,
 1127:                                        \%type,\%display,$defbgone,$defbgtwo,
 1128:                                        $parmlev);
 1129:                         }
 1130:                     }
 1131:                 }
 1132:             } # end foreach ids
 1133: # -------------------------------------------------- End entry for one resource
 1134:             $r->print('</table>');
 1135:         } # end of  brief/full
 1136: #--------------------------------------------------- Entry for parm level map
 1137:         if ($parmlev eq 'map') {
 1138:             my $defbgone = '"E0E099"';
 1139:             my $defbgtwo = '"FFFF99"';
 1140: 
 1141:             my %maplist;
 1142: 
 1143:             if ($pschp eq 'all') {
 1144:                 %maplist = %allmaps; 
 1145:             } else {
 1146:                 %maplist = ($pschp => $mapp{$pschp});
 1147:             }
 1148: 
 1149: #-------------------------------------------- for each map, gather information
 1150:             my $mapid;
 1151: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
 1152:                 my $maptitle = $maplist{$mapid};
 1153: 
 1154: #-----------------------  loop through ids and get all parameter types for map
 1155: #-----------------------------------------          and associated information
 1156:                 my %name = ();
 1157:                 my %part = ();
 1158:                 my %display = ();
 1159:                 my %type = ();
 1160:                 my %default = ();
 1161:                 my $map = 0;
 1162: 
 1163: #		$r->print("Catmarker: @catmarker<br />\n");
 1164:                
 1165:                 foreach (@ids) {
 1166:                   ($map)=(/([\d]*?)\./);
 1167:                   my $rid = $_;
 1168:         
 1169: #                  $r->print("$mapid:$map:   $rid <br /> \n");
 1170: 
 1171:                   if ($map eq $mapid) {
 1172:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
 1173: #                    $r->print("Keys: $keyp{$rid} <br />\n");
 1174: 
 1175: #--------------------------------------------------------------------
 1176: # @catmarker contains list of all possible parameters including part #s
 1177: # $fullkeyp contains the full part/id # for the extraction of proper parameters
 1178: # $tempkeyp contains part 0 only (no ids - ie, subparts)
 1179: # When storing information, store as part 0
 1180: # When requesting information, request from full part
 1181: #-------------------------------------------------------------------
 1182:                     foreach (split(/\,/,$keyp{$rid})) {
 1183:                       my $tempkeyp = $_;
 1184:                       my $fullkeyp = $tempkeyp;
 1185:                       $tempkeyp =~ s/_[\d_]+_/_0_/;
 1186:                       
 1187:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
 1188:                         $part{$tempkeyp}="0";
 1189:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
 1190:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
 1191:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
 1192:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
 1193:                         $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
 1194:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
 1195:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
 1196:                       }
 1197:                     } # end loop through keys
 1198:                   }
 1199:                 } # end loop through ids
 1200:                                  
 1201: #---------------------------------------------------- print header information
 1202:                 $r->print(<<ENDMAPONE);
 1203: <center><h4>
 1204: <font color="red">Set Defaults for All Resources in map
 1205: <i>$maptitle</i><br />
 1206: Specifically for
 1207: ENDMAPONE
 1208:                 if ($uname) {
 1209:                     my %name=&Apache::lonnet::userenvironment($udom,$uname,
 1210:                       ('firstname','middlename','lastname','generation', 'id'));
 1211:                     my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
 1212:                            .$name{'lastname'}.' '.$name{'generation'};
 1213:                     $r->print("User <i>$uname \($person\) </i> in \n");
 1214:                 } else {
 1215:                     $r->print("<i>all</i> users in \n");
 1216:                 }
 1217:             
 1218:                 if ($csec) {$r->print("Section <i>$csec</i> of \n")};
 1219: 
 1220:                 $r->print("<i>$coursename</i><br />");
 1221:                 $r->print("</font></h4>\n");
 1222: #---------------------------------------------------------------- print table
 1223:                 $r->print('<p><table border="2">');
 1224:                 $r->print('<tr><th>Parameter Name</th>');
 1225:                 $r->print('<th>Default Value</th>');
 1226:                 $r->print('<th>Parameter in Effect</th></tr>');
 1227: 
 1228: 	        foreach (sort keys %name) {
 1229:                     &print_row($r,$_,\%part,\%name,$mapid,\%default,
 1230:                            \%type,\%display,$defbgone,$defbgtwo,
 1231:                            $parmlev);
 1232: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
 1233:                 }
 1234:                 $r->print("</table></center>");
 1235:             } # end each map
 1236:         } # end of $parmlev eq map
 1237: #--------------------------------- Entry for parm level general (Course level)
 1238:         if ($parmlev eq 'general') {
 1239:             my $defbgone = '"E0E099"';
 1240:             my $defbgtwo = '"FFFF99"';
 1241: 
 1242: #-------------------------------------------- for each map, gather information
 1243:             my $mapid="0.0";
 1244: #-----------------------  loop through ids and get all parameter types for map
 1245: #-----------------------------------------          and associated information
 1246:             my %name = ();
 1247:             my %part = ();
 1248:             my %display = ();
 1249:             my %type = ();
 1250:             my %default = ();
 1251:                
 1252:             foreach (@ids) {
 1253:                 my $rid = $_;
 1254:         
 1255:                 my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
 1256: 
 1257: #--------------------------------------------------------------------
 1258: # @catmarker contains list of all possible parameters including part #s
 1259: # $fullkeyp contains the full part/id # for the extraction of proper parameters
 1260: # $tempkeyp contains part 0 only (no ids - ie, subparts)
 1261: # When storing information, store as part 0
 1262: # When requesting information, request from full part
 1263: #-------------------------------------------------------------------
 1264:                 foreach (split(/\,/,$keyp{$rid})) {
 1265:                   my $tempkeyp = $_;
 1266:                   my $fullkeyp = $tempkeyp;
 1267:                   $tempkeyp =~ s/_[\d_]+_/_0_/;
 1268:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
 1269:                     $part{$tempkeyp}="0";
 1270:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
 1271:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
 1272:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
 1273:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
 1274:                     $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
 1275:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
 1276:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
 1277:                   }
 1278:                 } # end loop through keys
 1279:             } # end loop through ids
 1280:                                  
 1281: #---------------------------------------------------- print header information
 1282:             $r->print(<<ENDMAPONE);
 1283: <center><h4>
 1284: <font color="red">Set Defaults for All Resources in Course
 1285: <i>$coursename</i><br />
 1286: ENDMAPONE
 1287:             if ($uname) {
 1288:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
 1289:                   ('firstname','middlename','lastname','generation', 'id'));
 1290:                 my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
 1291:                        .$name{'lastname'}.' '.$name{'generation'};
 1292:                 $r->print(" User <i>$uname \($person\) </i> \n");
 1293:             } else {
 1294:                 $r->print("<i>ALL</i> USERS \n");
 1295:             }
 1296:             
 1297:             if ($csec) {$r->print("Section <i>$csec</i>\n")};
 1298:             $r->print("</font></h4>\n");
 1299: #---------------------------------------------------------------- print table
 1300:             $r->print('<p><table border="2">');
 1301:             $r->print('<tr><th>Parameter Name</th>');
 1302:             $r->print('<th>Default Value</th>');
 1303:             $r->print('<th>Parameter in Effect</th></tr>');
 1304: 
 1305: 	    foreach (sort keys %name) {
 1306:                 &print_row($r,$_,\%part,\%name,$mapid,\%default,
 1307:                        \%type,\%display,$defbgone,$defbgtwo,$parmlev);
 1308: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
 1309:             }
 1310:             $r->print("</table></center>");
 1311:         } # end of $parmlev eq general
 1312:     }
 1313:     $r->print('</form></body></html>');
 1314:     untie(%bighash);
 1315:     untie(%parmhash);
 1316: } # end sub assessparms
 1317: 
 1318: 
 1319: ##################################################
 1320: ##################################################
 1321: 
 1322: =pod
 1323: 
 1324: =item crsenv
 1325: 
 1326: Show course data and parameters.  This is a large routine that should
 1327: be simplified and shortened... someday.
 1328: 
 1329: Inputs: $r
 1330: 
 1331: Returns: nothing
 1332: 
 1333: =cut
 1334: 
 1335: ##################################################
 1336: ##################################################
 1337: sub crsenv {
 1338:     my $r=shift;
 1339:     my $setoutput='';
 1340:     my $bodytag=&Apache::loncommon::bodytag(
 1341:                              'Set Course Environment Parameters');
 1342:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
 1343:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
 1344: # -------------------------------------------------- Go through list of changes
 1345:     foreach (keys %ENV) {
 1346: 	if ($_=~/^form\.(.+)\_setparmval$/) {
 1347:             my $name=$1;
 1348:             my $value=$ENV{'form.'.$name.'_value'};
 1349:             if ($name eq 'newp') {
 1350:                 $name=$ENV{'form.newp_name'};
 1351:             }
 1352:             if ($name eq 'url') {
 1353: 		$value=~s/^\/res\///;
 1354:                 my $bkuptime=time;
 1355:                 my @tmp = &Apache::lonnet::get
 1356:                     ('environment',['url'],$dom,$crs);
 1357:                 $setoutput.='Backing up previous URL: '.
 1358:                     &Apache::lonnet::put
 1359:                         ('environment',
 1360:                          {'top level map backup '.$bkuptime => $tmp[1] },
 1361:                          $dom,$crs).
 1362:                     '<br>';
 1363:             }
 1364:             if ($name) {
 1365:                 $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
 1366:                     $value.'</tt>: '.
 1367:                     &Apache::lonnet::put
 1368:                             ('environment',{$name=>$value},$dom,$crs).
 1369:                     '<br>';
 1370: 	    }
 1371:         }
 1372:     }
 1373: # -------------------------------------------------------- Get parameters again
 1374: 
 1375:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
 1376:     my $output='';
 1377:     if (! exists($values{'con_lost'})) {
 1378:         my %descriptions=
 1379: 	    ('url'            => '<b>Top Level Map</b> '.
 1380:                                  '<a href="javascript:openbrowser'.
 1381:                                  "('envform','url','sequence')\">".
 1382:                                  'Browse</a><br><font color=red> '.
 1383:                                  'Modification may make assessment data '.
 1384:                                  'inaccessible</font>',
 1385:              'description'    => '<b>Course Description</b>',
 1386:              'courseid'       => '<b>Course ID or number</b><br>'.
 1387:                                  '(internal, optional)',
 1388:              'default_xml_style' => '<b>Default XML Style File</b> '.
 1389:                     '<a href="javascript:openbrowser'.
 1390:                     "('envform','default_xml_style'".
 1391:                     ",'sty')\">Browse</a><br>",
 1392:              'question.email' => '<b>Feedback Addresses for Content '.
 1393:                                  'Questions</b><br>(<tt>user:domain,'.
 1394:                                  'user:domain,...</tt>)',
 1395:              'comment.email'  => '<b>Feedback Addresses for Comments</b><br>'.
 1396:                                  '(<tt>user:domain,user:domain,...</tt>)',
 1397:              'policy.email'   => '<b>Feedback Addresses for Course Policy</b>'.
 1398:                                  '<br>(<tt>user:domain,user:domain,...</tt>)',
 1399:              'hideemptyrows'  => '<b>Hide Empty Rows in Spreadsheets</b><br>'.
 1400:                                  '("<tt>yes</tt>" for default hiding)',
 1401:              'pageseparators'  => '<b>Visibly Separate Items on Pages</b><br>'.
 1402:                                  '("<tt>yes</tt>" for visible separation)',
 1403:              'pch.roles.denied'=> '<b>Disallow Resource Discussion for '.
 1404:                                   'Roles</b><br>"<tt>st</tt>": '.
 1405:                                   'student, "<tt>ta</tt>": '.
 1406:                                   'TA, "<tt>in</tt>": '.
 1407:                                   'instructor;<br><tt>role,role,...</tt>) '.
 1408: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
 1409:              'pch.users.denied' => 
 1410:                           '<b>Disallow Resource Discussion for Users</b><br>'.
 1411:                                  '(<tt>user:domain,user:domain,...</tt>)',
 1412:              'spreadsheet_default_classcalc' 
 1413:                  => '<b>Default Course Spreadsheet</b> '.
 1414:                     '<a href="javascript:openbrowser'.
 1415:                     "('envform','spreadsheet_default_classcalc'".
 1416:                     ",'spreadsheet')\">Browse</a><br>",
 1417:              'spreadsheet_default_studentcalc' 
 1418:                  => '<b>Default Student Spreadsheet</b> '.
 1419:                     '<a href="javascript:openbrowser'.
 1420:                     "('envform','spreadsheet_default_calc'".
 1421:                     ",'spreadsheet')\">Browse</a><br>",
 1422:              'spreadsheet_default_assesscalc' 
 1423:                  => '<b>Default Assessment Spreadsheet</b> '.
 1424:                     '<a href="javascript:openbrowser'.
 1425:                     "('envform','spreadsheet_default_assesscalc'".
 1426:                     ",'spreadsheet')\">Browse</a><br>",
 1427:              );
 1428: 	foreach (keys(%values)) {
 1429: 	    unless ($descriptions{$_}) {
 1430: 		$descriptions{$_}=$_;
 1431: 	    }
 1432: 	}
 1433: 	foreach (sort keys %descriptions) {
 1434:             # onchange is javascript to automatically check the 'Set' button.
 1435:             my $onchange = 'onFocus="javascript:window.document.forms'.
 1436:                 '[\'envform\'].elements[\''.$_.'_setparmval\']'.
 1437:                 '.checked=true;"';
 1438: 	    $output.='<tr><td>'.$descriptions{$_}.'</td>'.
 1439:                 '<td><input name="'.$_.'_value" size=40 '.
 1440:                 'value="'.$values{$_}.'" '.$onchange.' /></td>'.
 1441:                 '<td><input type=checkbox name="'.$_.'_setparmval"></td>'.
 1442:                 '</tr>'."\n";
 1443: 	}
 1444:         my $onchange = 'onFocus="javascript:window.document.forms'.
 1445:             '[\'envform\'].elements[\'newp_setparmval\']'.
 1446:             '.checked=true;"';
 1447: 	$output.='<tr><td><i>Create New Environment Variable</i><br />'.
 1448: 	    '<input type="text" size=40 name="newp_name" '.
 1449:                 $onchange.' /></td><td>'.
 1450:             '<input type="text" size=40 name="newp_value" '.
 1451:                 $onchange.' /></td><td>'.
 1452: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
 1453:     }
 1454:     $r->print(<<ENDENV);
 1455: <html>
 1456: <script type="text/javascript" language="Javascript" >
 1457:     var editbrowser;
 1458:     function openbrowser(formname,elementname,only,omit) {
 1459:         var url = '/res/?';
 1460:         if (editbrowser == null) {
 1461:             url += 'launch=1&';
 1462:         }
 1463:         url += 'catalogmode=interactive&';
 1464:         url += 'mode=parmset&';
 1465:         url += 'form=' + formname + '&';
 1466:         if (only != null) {
 1467:             url += 'only=' + only + '&';
 1468:         } 
 1469:         if (omit != null) {
 1470:             url += 'omit=' + omit + '&';
 1471:         }
 1472:         url += 'element=' + elementname + '';
 1473:         var title = 'Browser';
 1474:         var options = 'scrollbars=1,resizable=1,menubar=0';
 1475:         options += ',width=700,height=600';
 1476:         editbrowser = open(url,title,options,'1');
 1477:         editbrowser.focus();
 1478:     }
 1479: </script>
 1480: <head>
 1481: <title>LON-CAPA Course Environment</title>
 1482: </head>
 1483: $bodytag
 1484: <form method="post" action="/adm/parmset" name="envform">
 1485: $setoutput
 1486: <p>
 1487: <table border=2>
 1488: <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr>
 1489: $output
 1490: </table>
 1491: <input type="submit" name="crsenv" value="Set Course Environment">
 1492: </form>
 1493: </body>
 1494: </html>    
 1495: ENDENV
 1496: }
 1497: 
 1498: ##################################################
 1499: ##################################################
 1500: 
 1501: =pod
 1502: 
 1503: =item handler
 1504: 
 1505: Main handler.  Calls &assessparms and &crsenv subroutines.
 1506: 
 1507: =cut
 1508: 
 1509: ##################################################
 1510: ##################################################
 1511: sub handler {
 1512:     my $r=shift;
 1513: 
 1514:     if ($r->header_only) {
 1515: 	$r->content_type('text/html');
 1516: 	$r->send_http_header;
 1517: 	return OK;
 1518:     }
 1519:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
 1520: # ----------------------------------------------------- Needs to be in a course
 1521: 
 1522:     if (($ENV{'request.course.id'}) && 
 1523: 	(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
 1524:  
 1525:         $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
 1526: 
 1527: 	unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
 1528: # --------------------------------------------------------- Bring up assessment
 1529: 	    &assessparms($r);
 1530: # ---------------------------------------------- This is for course environment
 1531: 	} else {
 1532: 	    &crsenv($r);
 1533: 	}
 1534:     } else {
 1535: # ----------------------------- Not in a course, or not allowed to modify parms
 1536: 	$ENV{'user.error.msg'}=
 1537: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
 1538: 	return HTTP_NOT_ACCEPTABLE;
 1539:     }
 1540:     return OK;
 1541: }
 1542: 
 1543: 1;
 1544: __END__
 1545: 
 1546: =pod
 1547: 
 1548: =back
 1549: 
 1550: =cut
 1551: 
 1552: 
 1553: 

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