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

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

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