File:  [LON-CAPA] / loncom / interface / lonparmset.pm
Revision 1.57: download - view: text, annotated - select for diffs
Thu Aug 8 17:03:20 2002 UTC (21 years, 9 months ago) by albertel
Branches: MAIN
CVS tags: HEAD
- commit Mark Lucas's lonparmset

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

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