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

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

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