Annotation of loncom/interface/lonparmset.pm, revision 1.78

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

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