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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.189   ! www         4: # $Id: lonparmset.pm,v 1.188 2005/03/17 22:34:24 www Exp $
1.40      albertel    5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.59      matthew    28: ###################################################################
                     29: ###################################################################
                     30: 
                     31: =pod
                     32: 
                     33: =head1 NAME
                     34: 
                     35: lonparmset - Handler to set parameters for assessments and course
                     36: 
                     37: =head1 SYNOPSIS
                     38: 
                     39: lonparmset provides an interface to setting course parameters. 
                     40: 
                     41: =head1 DESCRIPTION
                     42: 
                     43: This module sets coursewide and assessment parameters.
                     44: 
                     45: =head1 INTERNAL SUBROUTINES
                     46: 
                     47: =over 4
                     48: 
                     49: =cut
                     50: 
                     51: ###################################################################
                     52: ###################################################################
1.1       www        53: 
                     54: package Apache::lonparmset;
                     55: 
                     56: use strict;
                     57: use Apache::lonnet;
                     58: use Apache::Constants qw(:common :http REDIRECT);
1.88      matthew    59: use Apache::lonhtmlcommon();
1.36      albertel   60: use Apache::loncommon;
1.1       www        61: use GDBM_File;
1.57      albertel   62: use Apache::lonhomework;
                     63: use Apache::lonxml;
1.130     www        64: use Apache::lonlocal;
1.1       www        65: 
1.2       www        66: my %courseopt;
                     67: my %useropt;
                     68: my %parmhash;
                     69: 
1.3       www        70: my @ids;
                     71: my %symbp;
1.10      www        72: my %mapp;
1.3       www        73: my %typep;
1.16      www        74: my %keyp;
1.2       www        75: 
1.82      www        76: my %maptitles;
                     77: 
1.59      matthew    78: ##################################################
                     79: ##################################################
                     80: 
                     81: =pod
                     82: 
                     83: =item parmval
                     84: 
                     85: Figure out a cascading parameter.
                     86: 
1.71      albertel   87: Inputs:  $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162     albertel   88:          $id   - a bighash Id number
1.71      albertel   89:          $def  - the resource's default value   'stupid emacs
                     90: 
                     91: Returns:  A list, the first item is the index into the remaining list of items of parm valuse that is the active one, the list consists of parm values at the 11 possible levels
                     92: 
1.182     albertel   93: 11 - General Course
                     94: 10 - Map or Folder level in course
                     95: 9- resource default
                     96: 8- map default
1.71      albertel   97: 7 - resource level in course
                     98: 6 - General for section
1.82      www        99: 5 - Map or Folder level for section
1.71      albertel  100: 4 - resource level in section
                    101: 3 - General for specific student
1.82      www       102: 2 - Map or Folder level for specific student
1.71      albertel  103: 1 - resource level for specific student
1.2       www       104: 
1.59      matthew   105: =cut
                    106: 
                    107: ##################################################
                    108: ##################################################
1.2       www       109: sub parmval {
1.187     www       110:     my ($what,$id,$def,$uname,$udom,$csec)=@_;
1.8       www       111:     my $result='';
1.44      albertel  112:     my @outpar=();
1.2       www       113: # ----------------------------------------------------- Cascading lookup scheme
1.10      www       114: 
1.43      albertel  115:     my $symbparm=$symbp{$id}.'.'.$what;
                    116:     my $mapparm=$mapp{$id}.'___(all).'.$what;
1.10      www       117: 
1.43      albertel  118:     my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
                    119:     my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    120:     my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    121: 
                    122:     my $courselevel=$ENV{'request.course.id'}.'.'.$what;
                    123:     my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
                    124:     my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
1.2       www       125: 
1.11      www       126: 
                    127: 
1.182     albertel  128: # --------------------------------------------------------- first, check course
1.11      www       129: 
1.71      albertel  130:     if (defined($courseopt{$courselevel})) {
1.182     albertel  131: 	$outpar[11]=$courseopt{$courselevel};
                    132: 	$result=11;
1.43      albertel  133:     }
1.11      www       134: 
1.71      albertel  135:     if (defined($courseopt{$courselevelm})) {
1.182     albertel  136: 	$outpar[10]=$courseopt{$courselevelm};
                    137: 	$result=10;
1.43      albertel  138:     }
1.11      www       139: 
1.182     albertel  140: # ------------------------------------------------------- second, check default
                    141: 
                    142:     if (defined($def)) { $outpar[9]=$def; $result=9; }
                    143: 
                    144: # ------------------------------------------------------ third, check map parms
                    145: 
                    146:     my $thisparm=$parmhash{$symbparm};
                    147:     if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
                    148: 
1.71      albertel  149:     if (defined($courseopt{$courselevelr})) {
1.43      albertel  150: 	$outpar[7]=$courseopt{$courselevelr};
                    151: 	$result=7;
                    152:     }
1.11      www       153: 
1.182     albertel  154: # ------------------------------------------------------ fourth, back to course
1.71      albertel  155:     if (defined($csec)) {
                    156:         if (defined($courseopt{$seclevel})) {
1.43      albertel  157: 	    $outpar[6]=$courseopt{$seclevel};
                    158: 	    $result=6;
                    159: 	}
1.71      albertel  160:         if (defined($courseopt{$seclevelm})) {
1.43      albertel  161: 	    $outpar[5]=$courseopt{$seclevelm};
                    162: 	    $result=5;
                    163: 	}
                    164: 
1.71      albertel  165:         if (defined($courseopt{$seclevelr})) {
1.43      albertel  166: 	    $outpar[4]=$courseopt{$seclevelr};
                    167: 	    $result=4;
                    168: 	}
                    169:     }
1.11      www       170: 
1.182     albertel  171: # ---------------------------------------------------------- fifth, check user
1.11      www       172: 
1.71      albertel  173:     if (defined($uname)) {
                    174: 	if (defined($useropt{$courselevel})) {
1.43      albertel  175: 	    $outpar[3]=$useropt{$courselevel};
                    176: 	    $result=3;
                    177: 	}
1.10      www       178: 
1.71      albertel  179: 	if (defined($useropt{$courselevelm})) {
1.43      albertel  180: 	    $outpar[2]=$useropt{$courselevelm};
                    181: 	    $result=2;
                    182: 	}
1.2       www       183: 
1.71      albertel  184: 	if (defined($useropt{$courselevelr})) {
1.43      albertel  185: 	    $outpar[1]=$useropt{$courselevelr};
                    186: 	    $result=1;
                    187: 	}
                    188:     }
1.44      albertel  189:     return ($result,@outpar);
1.2       www       190: }
                    191: 
1.186     www       192: 
                    193: ##################################################
                    194: ##################################################
                    195: #
                    196: # Store a parameter
                    197: #
                    198: # Takes
                    199: # - resource id
                    200: # - name of parameter
                    201: # - level
                    202: # - new value
                    203: # - new type
1.187     www       204: # - username
                    205: # - userdomain
                    206: 
1.186     www       207: sub storeparm {
1.187     www       208:     my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
1.186     www       209:     $spnam=~s/\_([^\_]+)$/\.$1/;
                    210: # ---------------------------------------------------------- Construct prefixes
                    211:     
                    212:     my $symbparm=$symbp{$sresid}.'.'.$spnam;
                    213:     my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
                    214:     
                    215:     my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
                    216:     my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
                    217:     my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
                    218:     
                    219:     my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
                    220:     my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
                    221:     my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
                    222:     
                    223:     my $storeunder='';
                    224:     if (($snum==11) || ($snum==3)) { $storeunder=$courselevel; }
                    225:     if (($snum==10) || ($snum==2)) { $storeunder=$courselevelm; }
                    226:     if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
                    227:     if ($snum==6) { $storeunder=$seclevel; }
                    228:     if ($snum==5) { $storeunder=$seclevelm; }
                    229:     if ($snum==4) { $storeunder=$seclevelr; }
                    230:     
                    231:     my $delete;
                    232:     if ($nval eq '') { $delete=1;}
                    233:     my %storecontent = ($storeunder         => $nval,
                    234: 			$storeunder.'.type' => $ntype);
                    235:     my $reply='';
                    236:     if ($snum>3) {
                    237: # ---------------------------------------------------------------- Store Course
                    238: #
                    239: # Expire sheets
                    240: 	&Apache::lonnet::expirespread('','','studentcalc');
                    241: 	if (($snum==7) || ($snum==4)) {
                    242: 	    &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
                    243: 	} elsif (($snum==8) || ($snum==5)) {
                    244: 	    &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
                    245: 	} else {
                    246: 	    &Apache::lonnet::expirespread('','','assesscalc');
                    247: 	}
                    248: # Store parameter
                    249: 	if ($delete) {
                    250: 	    $reply=&Apache::lonnet::del
                    251: 		('resourcedata',[keys(%storecontent)],
                    252: 		 $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    253: 		 $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
                    254: 	} else {
                    255: 	    $reply=&Apache::lonnet::cput
                    256: 		('resourcedata',\%storecontent,
                    257: 		 $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    258: 		 $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
                    259: 	}
                    260:     } else {
                    261: # ------------------------------------------------------------------ Store User
                    262: #
                    263: # Expire sheets
                    264: 	&Apache::lonnet::expirespread($uname,$udom,'studentcalc');
                    265: 	if ($snum==1) {
                    266: 	    &Apache::lonnet::expirespread
                    267: 		($uname,$udom,'assesscalc',$symbp{$sresid});
                    268: 	} elsif ($snum==2) {
                    269: 	    &Apache::lonnet::expirespread
                    270: 		($uname,$udom,'assesscalc',$mapp{$sresid});
                    271: 	} else {
                    272: 	    &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
                    273: 	}
                    274: # Store parameter
                    275: 	if ($delete) {
                    276: 	    $reply=&Apache::lonnet::del
                    277: 		('resourcedata',[keys(%storecontent)],$udom,$uname);
                    278: 	} else {
                    279: 	    $reply=&Apache::lonnet::cput
                    280: 		('resourcedata',\%storecontent,$udom,$uname);
                    281: 	}
                    282:     }
                    283:     
                    284:     if ($reply=~/^error\:(.*)/) {
                    285: 	return "<font color=red>Write Error: $1</font>";
                    286:     }
                    287:     return '';
                    288: }
                    289: 
1.59      matthew   290: ##################################################
                    291: ##################################################
                    292: 
                    293: =pod
                    294: 
                    295: =item valout
                    296: 
                    297: Format a value for output.
                    298: 
                    299: Inputs:  $value, $type
                    300: 
                    301: Returns: $value, formatted for output.  If $type indicates it is a date,
                    302: localtime($value) is returned.
1.9       www       303: 
1.59      matthew   304: =cut
                    305: 
                    306: ##################################################
                    307: ##################################################
1.9       www       308: sub valout {
                    309:     my ($value,$type)=@_;
1.59      matthew   310:     my $result = '';
                    311:     # Values of zero are valid.
                    312:     if (! $value && $value ne '0') {
1.71      albertel  313: 	$result = '&nbsp;&nbsp;';
1.59      matthew   314:     } else {
1.66      www       315:         if ($type eq 'date_interval') {
                    316:             my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
                    317:             $year=$year-70;
                    318:             $mday--;
                    319:             if ($year) {
                    320: 		$result.=$year.' yrs ';
                    321:             }
                    322:             if ($mon) {
                    323: 		$result.=$mon.' mths ';
                    324:             }
                    325:             if ($mday) {
                    326: 		$result.=$mday.' days ';
                    327:             }
                    328:             if ($hour) {
                    329: 		$result.=$hour.' hrs ';
                    330:             }
                    331:             if ($min) {
                    332: 		$result.=$min.' mins ';
                    333:             }
                    334:             if ($sec) {
                    335: 		$result.=$sec.' secs ';
                    336:             }
                    337:             $result=~s/\s+$//;
                    338:         } elsif ($type=~/^date/) {
1.59      matthew   339:             $result = localtime($value);
                    340:         } else {
                    341:             $result = $value;
                    342:         }
                    343:     }
                    344:     return $result;
1.9       www       345: }
                    346: 
1.59      matthew   347: ##################################################
                    348: ##################################################
                    349: 
                    350: =pod
1.5       www       351: 
1.59      matthew   352: =item plink
                    353: 
                    354: Produces a link anchor.
                    355: 
                    356: Inputs: $type,$dis,$value,$marker,$return,$call
                    357: 
                    358: Returns: scalar with html code for a link which will envoke the 
                    359: javascript function 'pjump'.
                    360: 
                    361: =cut
                    362: 
                    363: ##################################################
                    364: ##################################################
1.5       www       365: sub plink {
                    366:     my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23      www       367:     my $winvalue=$value;
                    368:     unless ($winvalue) {
                    369: 	if ($type=~/^date/) {
                    370:             $winvalue=$ENV{'form.recent_'.$type};
                    371:         } else {
                    372:             $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
                    373:         }
                    374:     }
                    375:     return 
1.43      albertel  376: 	'<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
                    377: 	    .$marker."','".$return."','".$call."'".');">'.
                    378: 		&valout($value,$type).'</a><a name="'.$marker.'"></a>';
1.5       www       379: }
                    380: 
1.44      albertel  381: 
                    382: sub startpage {
1.137     albertel  383:     my ($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader)=@_;
1.99      albertel  384: 
1.120     www       385:     my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
1.98      www       386:                                             'onUnload="pclose()"');
1.81      www       387:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                    388:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                    389:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88      matthew   390:     my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.133     www       391:     my %lt=&Apache::lonlocal::texthash(
                    392: 		    'cep'   => "Course Environment Parameters",
                    393: 		    'scep'  => "Set Course Environment Parameters",
                    394: 		    'smcap' => "Set/Modify Course Assessment Parameter",
                    395: 		    'mcap'  => "Modify Course Assessment Parameters",
                    396: 		    'caphm' => "Course Assessment Parameter - Helper Mode",
                    397: 		    'capom' => "Course Assessment Parameters - Overview Mode",
                    398:                     'captm' => "Course Assessments Parameters - Table Mode",
                    399: 		    'sg'    => "Section/Group",
                    400: 		    'fu'    => "For User",
                    401: 		    'oi'    => "or ID",
                    402: 		    'ad'    => "at Domain"
                    403: 				       );
1.148     www       404:     my $overallhelp=
1.166     albertel  405: 	&Apache::loncommon::help_open_menu('','Setting Parameters','Course_Setting_Parameters','',10,'Instructor Interface');
1.146     www       406:     my $assessparmhelp=&Apache::loncommon::help_open_topic("Cascading_Parameters","Assessment Parameters");
1.183     albertel  407:     my $html=&Apache::lonxml::xmlbegin();
1.44      albertel  408:     $r->print(<<ENDHEAD);
1.183     albertel  409: $html
1.44      albertel  410: <head>
                    411: <title>LON-CAPA Course Parameters</title>
                    412: <script>
                    413: 
                    414:     function pclose() {
                    415:         parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
                    416:                  "height=350,width=350,scrollbars=no,menubar=no");
                    417:         parmwin.close();
                    418:     }
                    419: 
1.88      matthew   420:     $pjump_def
1.44      albertel  421: 
                    422:     function psub() {
                    423:         pclose();
                    424:         if (document.parmform.pres_marker.value!='') {
                    425:             document.parmform.action+='#'+document.parmform.pres_marker.value;
                    426:             var typedef=new Array();
                    427:             typedef=document.parmform.pres_type.value.split('_');
                    428:            if (document.parmform.pres_type.value!='') {
                    429:             if (typedef[0]=='date') {
                    430:                 eval('document.parmform.recent_'+
                    431:                      document.parmform.pres_type.value+
                    432: 		     '.value=document.parmform.pres_value.value;');
                    433:             } else {
                    434:                 eval('document.parmform.recent_'+typedef[0]+
                    435: 		     '.value=document.parmform.pres_value.value;');
                    436:             }
                    437: 	   }
                    438:             document.parmform.submit();
                    439:         } else {
                    440:             document.parmform.pres_value.value='';
                    441:             document.parmform.pres_marker.value='';
                    442:         }
                    443:     }
                    444: 
1.57      albertel  445:     function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
                    446:         var options = "width=" + w + ",height=" + h + ",";
                    447:         options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
                    448:         options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
                    449:         var newWin = window.open(url, wdwName, options);
                    450:         newWin.focus();
                    451:     }
1.44      albertel  452: </script>
1.81      www       453: $selscript
1.44      albertel  454: </head>
1.64      www       455: $bodytag
1.166     albertel  456: $overallhelp
1.137     albertel  457: ENDHEAD
1.91      bowersj2  458: 
1.137     albertel  459:     unless ($trimheader) {$r->print(<<ENDHEAD2);
1.44      albertel  460: <form method="post" action="/adm/parmset" name="envform">
1.133     www       461: <h4>$lt{'cep'}</h4>
                    462: <input type="submit" name="crsenv" value="$lt{'scep'}" />
1.120     www       463: </form>
                    464: <hr />
1.146     www       465: $assessparmhelp
1.120     www       466: <form method="post" action="/adm/helper/parameter.helper" name="helpform">
1.133     www       467: <h4>$lt{'caphm'}</h4>
                    468: <input type="submit" value="$lt{'smcap'}" />
1.120     www       469: </form>
                    470: <hr />
                    471: <form method="post" action="/adm/parmset" name="overview">
1.133     www       472: <h4>$lt{'capom'}</h4>
                    473: <input type="submit" name="overview" value="$lt{'mcap'}" />
1.44      albertel  474: </form>
1.101     www       475: <hr />
1.137     albertel  476: ENDHEAD2
1.189   ! www       477:     }
        !           478:     my %sectionhash=();
        !           479:     my $sections='';
        !           480:     if (&Apache::loncommon::get_sections(
        !           481:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
        !           482:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
        !           483: 					 \%sectionhash)) {
        !           484:         $sections=$lt{'sg'}.': <select name="csec">';
        !           485: 	foreach ('',sort keys %sectionhash) {
        !           486: 	    $sections.='<option value="'.$_.'"'.
        !           487: 		($_ eq $csec?'selected="selected"':'').'>'.$_.'</option>';
        !           488:         }
        !           489:         $sections.='</select>';
        !           490:      }
        !           491:      $r->print(<<ENDHEAD3);
1.44      albertel  492: <form method="post" action="/adm/parmset" name="parmform">
1.133     www       493: <h4>$lt{'captm'}</h4>
1.137     albertel  494: ENDHEAD3
1.99      albertel  495: 
                    496:     if (!$have_assesments) {
1.133     www       497: 	$r->print('<font color="red">'.&mt('There are no assesment parameters in this course to set.').'</font><br />');	
1.99      albertel  498:     } else {
                    499: 	$r->print(<<ENDHEAD);
1.44      albertel  500: <b>
1.189   ! www       501: $sections
1.188     www       502: <br />
1.133     www       503: $lt{'fu'} 
1.188     www       504: <input type="text" value="$uname" size="12" name="uname" />
1.133     www       505: $lt{'oi'}
1.188     www       506: <input type="text" value="$id" size="12" name="id" /> 
1.133     www       507: $lt{'ad'}
1.81      www       508: $chooseopt
1.44      albertel  509: </b>
                    510: <input type="hidden" value='' name="pres_value">
                    511: <input type="hidden" value='' name="pres_type">
                    512: <input type="hidden" value='' name="pres_marker">
                    513: ENDHEAD
1.99      albertel  514:     }
1.44      albertel  515: }
                    516: 
                    517: sub print_row {
1.66      www       518:     my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone,
1.187     www       519: 	$defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
1.66      www       520: # get the values for the parameter in cascading order
                    521: # empty levels will remain empty
1.44      albertel  522:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.187     www       523: 				  $rid,$$default{$which},$uname,$udom,$csec);
1.66      www       524: # get the type for the parameters
                    525: # problem: these may not be set for all levels
                    526:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
                    527:                                           $$name{$which}.'.type',
1.187     www       528: 				  $rid,$$defaulttype{$which},$uname,$udom,$csec);
1.66      www       529: # cascade down manually
1.182     albertel  530:     my $cascadetype=$$defaulttype{$which};
                    531:     for (my $i=11;$i>0;$i--) {
1.66      www       532: 	 if ($typeoutpar[$i]) { 
                    533:             $cascadetype=$typeoutpar[$i];
                    534: 	} else {
                    535:             $typeoutpar[$i]=$cascadetype;
                    536:         }
                    537:     }
1.57      albertel  538:     my $parm=$$display{$which};
                    539: 
                    540:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
                    541:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                    542:                   .$$part{$which}.'</td>');
                    543:     } else {    
                    544:         $parm=~s|\[.*\]\s||g;
                    545:     }
                    546: 
1.159     albertel  547:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57      albertel  548:    
1.44      albertel  549:     my $thismarker=$which;
                    550:     $thismarker=~s/^parameter\_//;
                    551:     my $mprefix=$rid.'&'.$thismarker.'&';
                    552: 
1.57      albertel  553:     if ($parmlev eq 'general') {
                    554: 
                    555:         if ($uname) {
1.66      www       556:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  557:         } elsif ($csec) {
1.66      www       558:             &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  559:         } else {
1.182     albertel  560:             &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  561:         }
                    562:     } elsif ($parmlev eq 'map') {
                    563: 
                    564:         if ($uname) {
1.66      www       565:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  566:         } elsif ($csec) {
1.66      www       567:             &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  568:         } else {
1.182     albertel  569:             &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  570:         }
                    571:     } else {
                    572: 
1.182     albertel  573:         &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  574: 
                    575:         if ($parmlev eq 'brief') {
                    576: 
1.66      www       577:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  578: 
                    579:            if ($csec) {
1.66      www       580:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  581:            }
                    582:            if ($uname) {
1.66      www       583:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  584:            }
                    585:         } else {
                    586: 
1.182     albertel  587:            &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    588:            &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    589:            &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.66      www       590:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  591: 
                    592:            if ($csec) {
1.66      www       593:                &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    594:                &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    595:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  596:            }
                    597:            if ($uname) {
1.66      www       598:                &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    599:                &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    600:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  601:            }
                    602:         } # end of $brief if/else
                    603:     } # end of $parmlev if/else
                    604: 
1.136     albertel  605:     $r->print('<td bgcolor=#CCCCFF align="center">'.
                    606:                   &valout($outpar[$result],$typeoutpar[$result]).'</td>');
                    607: 
1.57      albertel  608:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
1.136     albertel  609:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.57      albertel  610:                                         '.'.$$name{$which},$symbp{$rid});
1.136     albertel  611: 
1.70      albertel  612: # this doesn't seem to work, and I don't think is correct
                    613: #    my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
                    614: #                                      '.'.$$name{$which}.'.type',$symbp{$rid});
                    615: # this seems to work
1.136     albertel  616:         my $sessionvaltype=$typeoutpar[$result];
                    617:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
                    618:         $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
1.66      www       619:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel  620:                   '</font></td>');
1.136     albertel  621:     }
1.44      albertel  622:     $r->print('</tr>');
1.57      albertel  623:     $r->print("\n");
1.44      albertel  624: }
1.59      matthew   625: 
1.44      albertel  626: sub print_td {
1.66      www       627:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57      albertel  628:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114     www       629:               ' align="center">');
1.182     albertel  630:     if ($which<8 || $which > 9) {
1.114     www       631: 	$r->print(&plink($$typeoutpar[$which],
                    632: 			 $$display{$value},$$outpar[$which],
                    633: 			 $mprefix."$which",'parmform.pres','psub'));
                    634:     } else {
                    635: 	$r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
                    636:     }
                    637:     $r->print('</td>'."\n");
1.57      albertel  638: }
                    639: 
1.63      bowersj2  640: =pod
                    641: 
                    642: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
                    643: 
                    644: Input: See list below:
                    645: 
                    646: =over 4
                    647: 
                    648: =item B<ids>: An array that will contain all of the ids in the course.
                    649: 
                    650: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
                    651: 
1.171     www       652: =item B<keyp>: hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.63      bowersj2  653: 
                    654: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
                    655: 
                    656: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    657: 
                    658: =item B<allkeys>: hash, full key to part->display value (what's display value?)
                    659: 
                    660: =item B<allmaps>: hash, ???
                    661: 
                    662: =item B<fcat>: ???
                    663: 
                    664: =item B<defp>: hash, ???
                    665: 
                    666: =item B<mapp>: ??
                    667: 
                    668: =item B<symbp>: hash, id->full sym?
                    669: 
                    670: =back
                    671: 
                    672: =cut
                    673: 
                    674: sub extractResourceInformation {
                    675:     my $bighash = shift;
                    676:     my $ids = shift;
                    677:     my $typep = shift;
                    678:     my $keyp = shift;
                    679:     my $allparms = shift;
                    680:     my $allparts = shift;
                    681:     my $allkeys = shift;
                    682:     my $allmaps = shift;
                    683:     my $fcat = shift;
                    684:     my $defp = shift;
                    685:     my $mapp = shift;
                    686:     my $symbp = shift;
1.82      www       687:     my $maptitles=shift;
1.63      bowersj2  688: 
                    689:     foreach (keys %$bighash) {
                    690: 	if ($_=~/^src\_(\d+)\.(\d+)$/) {
1.175     albertel  691: 	    # there are no resources in the 0 level
                    692: 	    if ($1 eq '0') { next; }
1.63      bowersj2  693: 	    my $mapid=$1;
                    694: 	    my $resid=$2;
                    695: 	    my $id=$mapid.'.'.$resid;
                    696: 	    my $srcf=$$bighash{$_};
1.152     albertel  697: 	    if (1) {
1.173     albertel  698: 		$srcf=~/\.(\w+)$/;
1.63      bowersj2  699: 		$$ids[$#$ids+1]=$id;
                    700: 		$$typep{$id}=$1;
                    701: 		$$keyp{$id}='';
1.65      albertel  702: 		foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
1.63      bowersj2  703: 		  if ($_=~/^parameter\_(.*)/) {
                    704:                     my $key=$_;
                    705:                     my $allkey=$1;
                    706:                     $allkey=~s/\_/\./g;
1.173     albertel  707: 		    if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 
                    708: 			'parm') {
                    709: 			next; #hide hidden things
                    710: 		    }
1.63      bowersj2  711:                     my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                    712:                     my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                    713:                     my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                    714:                     my $parmdis = $display;
                    715:                     $parmdis =~ s|(\[Part.*$)||g;
                    716:                     my $partkey = $part;
                    717:                     $partkey =~ tr|_|.|;
                    718:                     $$allparms{$name} = $parmdis;
                    719:                     $$allparts{$part} = "[Part $part]";
                    720:                     $$allkeys{$allkey}=$display;
                    721:                     if ($allkey eq $fcat) {
                    722: 		        $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
                    723: 		    }
                    724: 		    if ($$keyp{$id}) {
                    725: 		        $$keyp{$id}.=','.$key;
                    726: 		    } else {
                    727: 		        $$keyp{$id}=$key;
                    728: 		    }
                    729: 		  }
                    730: 		}
                    731: 		$$mapp{$id}=
                    732: 		    &Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});
                    733:                 $$mapp{$mapid}=$$mapp{$id};
                    734: 		$$allmaps{$mapid}=$$mapp{$id};
1.175     albertel  735: 		if ($mapid eq '1') {
                    736: 		    $$maptitles{$mapid}='Main Course Documents';
                    737: 		} else {
1.180     albertel  738: 		    $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
1.175     albertel  739: 		}
1.82      www       740: 		$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.181     albertel  741: 		$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2  742:                 $$symbp{$mapid}=$$mapp{$id}.'___(all)';
                    743: 	    }
                    744: 	}
                    745:     }
                    746: }
                    747: 
1.59      matthew   748: ##################################################
                    749: ##################################################
                    750: 
                    751: =pod
                    752: 
                    753: =item assessparms
                    754: 
                    755: Show assessment data and parameters.  This is a large routine that should
                    756: be simplified and shortened... someday.
                    757: 
                    758: Inputs: $r
                    759: 
                    760: Returns: nothing
                    761: 
1.63      bowersj2  762: Variables used (guessed by Jeremy):
                    763: 
                    764: =over 4
                    765: 
                    766: =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.
                    767: 
                    768: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    769: 
                    770: =item B<allmaps>:
                    771: 
                    772: =back
                    773: 
1.59      matthew   774: =cut
                    775: 
                    776: ##################################################
                    777: ##################################################
1.30      www       778: sub assessparms {
1.1       www       779: 
1.43      albertel  780:     my $r=shift;
1.2       www       781: # -------------------------------------------------------- Variable declaration
1.129     www       782:     my %allkeys=();
                    783:     my %allmaps=();
                    784:     my %alllevs=();
1.57      albertel  785: 
1.187     www       786:     my $uname;
                    787:     my $udom;
                    788:     my $uhome;
                    789:     my $csec;
                    790:  
                    791:     my $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
                    792: 
1.57      albertel  793:     $alllevs{'Resource Level'}='full';
                    794:     $alllevs{'Map Level'}='map';
                    795:     $alllevs{'Course Level'}='general';
                    796: 
                    797:     my %allparms;
                    798:     my %allparts;
                    799: 
1.43      albertel  800:     my %defp;
                    801:     %courseopt=();
                    802:     %useropt=();
1.44      albertel  803:     my %bighash=();
1.43      albertel  804: 
                    805:     @ids=();
                    806:     %symbp=();
                    807:     %typep=();
                    808: 
                    809:     my $message='';
                    810: 
                    811:     $csec=$ENV{'form.csec'};
1.188     www       812: 
1.172     albertel  813:     if      ($udom=$ENV{'form.udom'}) {
                    814:     } elsif ($udom=$ENV{'request.role.domain'}) {
                    815:     } elsif ($udom=$ENV{'user.domain'}) {
                    816:     } else {
                    817: 	$udom=$r->dir_config('lonDefDomain');
                    818:     }
1.43      albertel  819: 
1.134     albertel  820:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.43      albertel  821:     my $pschp=$ENV{'form.pschp'};
1.134     albertel  822:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76      www       823:     if (!@psprt) { $psprt[0]='0'; }
1.57      albertel  824:     my $showoptions=$ENV{'form.showoptions'};
                    825: 
1.43      albertel  826:     my $pssymb='';
1.57      albertel  827:     my $parmlev='';
1.137     albertel  828:     my $trimheader='';
1.57      albertel  829:     my $prevvisit=$ENV{'form.prevvisit'};
                    830:  
                    831:     unless ($ENV{'form.parmlev'}) {
                    832:         $parmlev = 'map';
                    833:     } else {
                    834:         $parmlev = $ENV{'form.parmlev'};
                    835:     }
1.26      www       836: 
1.29      www       837: # ----------------------------------------------- Was this started from grades?
                    838: 
1.43      albertel  839:     if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
                    840: 	&& (!$ENV{'form.dis'})) {
                    841: 	my $url=$ENV{'form.url'};
                    842: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    843: 	$pssymb=&Apache::lonnet::symbread($url);
1.92      albertel  844: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel  845: 	$pschp='';
1.57      albertel  846:         $parmlev = 'full';
1.137     albertel  847:         $trimheader='yes';
1.43      albertel  848:     } elsif ($ENV{'form.symb'}) {
                    849: 	$pssymb=$ENV{'form.symb'};
1.92      albertel  850: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel  851: 	$pschp='';
1.57      albertel  852:         $parmlev = 'full';
1.137     albertel  853:         $trimheader='yes';
1.43      albertel  854:     } else {
                    855: 	$ENV{'form.url'}='';
                    856:     }
                    857: 
                    858:     my $id=$ENV{'form.id'};
                    859:     if (($id) && ($udom)) {
                    860: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                    861: 	if ($uname) {
                    862: 	    $id='';
                    863: 	} else {
                    864: 	    $message=
1.133     www       865: 		"<font color=red>".&mt("Unknown ID")." '$id' ".
                    866: 		&mt('at domain')." '$udom'</font>";
1.43      albertel  867: 	}
                    868:     } else {
                    869: 	$uname=$ENV{'form.uname'};
                    870:     }
                    871:     unless ($udom) { $uname=''; }
                    872:     $uhome='';
                    873:     if ($uname) {
                    874: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                    875:         if ($uhome eq 'no_host') {
                    876: 	    $message=
1.133     www       877: 		"<font color=red>".&mt("Unknown user")." '$uname' ".
                    878: 		&mt("at domain")." '$udom'</font>";
1.43      albertel  879: 	    $uname='';
1.12      www       880:         } else {
1.103     albertel  881: 	    $csec=&Apache::lonnet::getsection($udom,$uname,
                    882: 					      $ENV{'request.course.id'});
1.43      albertel  883: 	    if ($csec eq '-1') {
                    884: 		$message="<font color=red>".
1.133     www       885: 		    &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                    886: 		    &mt("not in this course")."</font>";
1.43      albertel  887: 		$uname='';
                    888: 		$csec=$ENV{'form.csec'};
                    889: 	    } else {
                    890: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                    891: 		      ('firstname','middlename','lastname','generation','id'));
1.133     www       892: 		$message="\n<p>\n".&mt("Full Name").": ".
1.43      albertel  893: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                    894: 			.$name{'lastname'}.' '.$name{'generation'}.
1.133     www       895: 			    "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43      albertel  896: 	    }
1.12      www       897:         }
1.43      albertel  898:     }
1.2       www       899: 
1.43      albertel  900:     unless ($csec) { $csec=''; }
1.12      www       901: 
1.44      albertel  902:     my $fcat=$ENV{'form.fcat'};
1.43      albertel  903:     unless ($fcat) { $fcat=''; }
1.2       www       904: 
                    905: # ------------------------------------------------------------------- Tie hashs
1.44      albertel  906:     if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
1.58      albertel  907: 	      &GDBM_READER(),0640))) {
1.44      albertel  908: 	$r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
                    909: 	return ;
                    910:     }
                    911:     if (!(tie(%parmhash,'GDBM_File',
1.58      albertel  912: 	      $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
1.44      albertel  913: 	$r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
                    914: 	return ;
                    915:     }
1.63      bowersj2  916: 
1.14      www       917: # --------------------------------------------------------- Get all assessments
1.188     www       918:     &extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles);
1.63      bowersj2  919: 
1.57      albertel  920:     $mapp{'0.0'} = '';
                    921:     $symbp{'0.0'} = '';
1.99      albertel  922: 
1.14      www       923: # ---------------------------------------------------------- Anything to store?
1.44      albertel  924:     if ($ENV{'form.pres_marker'}) {
1.186     www       925: 	$message.=&storeparm(split(/\&/,$ENV{'form.pres_marker'}),
                    926: 			     $ENV{'form.pres_value'},
1.187     www       927: 			     $ENV{'form.pres_type'},
                    928:                              $uname,$udom,$csec);
1.68      www       929: # ---------------------------------------------------------------- Done storing
1.130     www       930: 	$message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';
1.68      www       931:     }
1.67      www       932: # --------------------------------------------- Devalidate cache for this child
1.109     albertel  933:     &Apache::lonnet::devalidatecourseresdata(
1.67      www       934:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
                    935:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
1.109     albertel  936:     &Apache::lonnet::clear_EXT_cache_status();
1.2       www       937: # -------------------------------------------------------------- Get coursedata
1.45      matthew   938:     %courseopt = &Apache::lonnet::dump
                    939:         ('resourcedata',
                    940:          $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    941:          $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44      albertel  942: # --------------------------------------------------- Get userdata (if present)
                    943:     if ($uname) {
1.45      matthew   944:         %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
1.44      albertel  945:     }
1.14      www       946: 
1.2       www       947: # ------------------------------------------------------------------- Sort this
1.17      www       948: 
1.44      albertel  949:     @ids=sort  {
                    950: 	if ($fcat eq '') {
                    951: 	    $a<=>$b;
                    952: 	} else {
1.187     www       953: 	    my ($result,@outpar)=&parmval($fcat,$a,$defp{$a},$uname,$udom,$csec);
1.44      albertel  954: 	    my $aparm=$outpar[$result];
1.187     www       955: 	    ($result,@outpar)=&parmval($fcat,$b,$defp{$b},$uname,$udom,$csec);
1.44      albertel  956: 	    my $bparm=$outpar[$result];
                    957: 	    1*$aparm<=>1*$bparm;
                    958: 	}
                    959:     } @ids;
1.57      albertel  960: #----------------------------------------------- if all selected, fill in array
                    961:     if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
                    962:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www       963: # ------------------------------------------------------------------ Start page
1.63      bowersj2  964: 
1.99      albertel  965:     my $have_assesments=1;
                    966:     if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; }
                    967: 
1.137     albertel  968:     &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);
1.99      albertel  969: 
1.112     albertel  970:     if (!$have_assesments) {
                    971: 	untie(%bighash);
                    972: 	untie(%parmhash);
                    973: 	return '';
                    974:     }
1.44      albertel  975: #    if ($ENV{'form.url'}) {
                    976: #	$r->print('<input type="hidden" value="'.$ENV{'form.url'}.
                    977: #		  '" name="url"><input type="hidden" name="command" value="set">');
                    978: #    }
1.57      albertel  979:     $r->print('<input type="hidden" value="true" name="prevvisit">');
                    980: 
1.44      albertel  981:     foreach ('tolerance','date_default','date_start','date_end',
                    982: 	     'date_interval','int','float','string') {
                    983: 	$r->print('<input type="hidden" value="'.
                    984: 		  $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
                    985:     }
                    986: 
1.57      albertel  987:     $r->print('<h2>'.$message.'</h2><table>');
                    988:                         
1.130     www       989:     my $submitmessage = &mt('Update Section or Specific User');
1.44      albertel  990:     if (!$pssymb) {
1.160     www       991:         $r->print('<tr><td>'.&mt('Select Parameter Level').
                    992:        &Apache::loncommon::help_open_topic('Course_Parameter_Levels').
                    993: 		  '</td><td colspan="2">');
1.57      albertel  994:         $r->print('<select name="parmlev">');
                    995:         foreach (reverse sort keys %alllevs) {
                    996:             $r->print('<option value="'.$alllevs{$_}.'"');
                    997:             if ($parmlev eq $alllevs{$_}) {
                    998:                $r->print(' selected'); 
                    999:             }
                   1000:             $r->print('>'.$_.'</option>');
                   1001:         }
                   1002:         $r->print("</select></td>\n");
                   1003: 
1.101     www      1004:         $r->print('</tr>');
1.128     albertel 1005: 	if ($parmlev ne 'general') {
1.130     www      1006: 	    $r->print('<tr><td>'.&mt('Select Enclosing Map or Folder').'</td>');
1.128     albertel 1007: 	    $r->print('<td colspan="2"><select name="pschp">');
1.130     www      1008: 	    $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
1.128     albertel 1009: 	    foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
                   1010: 		$r->print('<option value="'.$_.'"');
                   1011: 		if (($pschp eq $_)) { $r->print(' selected'); }
                   1012: 		$r->print('>'.$maptitles{$_}.($allmaps{$_}!~/^uploaded/?'  ['.$allmaps{$_}.']':'').'</option>');
                   1013: 	    }
                   1014: 	    $r->print("</select></td></tr>\n");
                   1015: 	}
1.44      albertel 1016:     } else {
1.125     www      1017:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.130     www      1018:         $r->print("<tr><td>".&mt('Specific Resource')."</td><td>$resource</td>");
1.57      albertel 1019:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
                   1020:         $r->print('</tr>');
                   1021:         $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
                   1022:     }
                   1023: 
1.185     albertel 1024:     $r->print('<tr><td colspan="3"><hr /><label><input type="checkbox"');
1.57      albertel 1025:     if ($showoptions eq 'show') {$r->print(" checked ");}
1.185     albertel 1026:     $r->print(' name="showoptions" value="show" />'.&mt('Show More Options').'</label><hr /></td></tr>');
1.57      albertel 1027: #    $r->print("<tr><td>Show: $showoptions</td></tr>");
                   1028: #    $r->print("<tr><td>pscat: @pscat</td></tr>");
                   1029: #    $r->print("<tr><td>psprt: @psprt</td></tr>");
                   1030: #    $r->print("<tr><td>fcat:  $fcat</td></tr>");
                   1031: 
                   1032:     if ($showoptions eq 'show') {
                   1033:         my $tempkey;
                   1034: 
1.130     www      1035:         $r->print('<tr><td colspan="3" align="center">'.&mt('Select Parameters to View').'</td></tr>');
1.57      albertel 1036: 
1.176     albertel 1037:         $r->print('<tr><td colspan="2"><table><tr>');
1.57      albertel 1038:         my $cnt=0;
                   1039:         foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
                   1040:                       keys %allparms ) {
                   1041:             ++$cnt;
1.176     albertel 1042:             $r->print('</tr><tr>') if ($cnt%2);
1.57      albertel 1043:             $r->print('<td><input type="checkbox" name="pscat" ');
                   1044:             $r->print('value="'.$tempkey.'"');
                   1045:             if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
                   1046:                 $r->print(' checked');
                   1047:             }
1.176     albertel 1048: 	    $r->print('>'.$allparms{$tempkey}.'</td>');
                   1049: 	}
                   1050: 	$r->print('
                   1051: </tr><tr><td>
                   1052: <script type="text/javascript">
                   1053:     function checkall(value, checkName) {
                   1054: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                   1055:             ele = document.forms.parmform.elements[i];
                   1056:             if (ele.name == checkName) {
                   1057:                 document.forms.parmform.elements[i].checked=value;
                   1058:             }
1.57      albertel 1059:         }
1.176     albertel 1060:     }
                   1061: </script>
                   1062: <input type="button" onclick="checkall(true, \'pscat\')" value="Select All" />
                   1063: </td><td>
                   1064: <input type="button" onclick="checkall(false, \'pscat\')" value="Unselect All" />
                   1065: </td>
                   1066: ');
1.57      albertel 1067:         $r->print('</tr></table>');
                   1068: 
                   1069: #        $r->print('<tr><td>Select Parts</td><td>');
                   1070:         $r->print('<td><select multiple name="psprt" size="5">');
                   1071:         $r->print('<option value="all"');
                   1072:         $r->print(' selected') unless (@psprt);
1.130     www      1073:         $r->print('>'.&mt('All Parts').'</option>');
1.76      www      1074:         my %temphash=();
                   1075:         foreach (@psprt) { $temphash{$_}=1; }
1.57      albertel 1076:         foreach $tempkey (sort keys %allparts) {
                   1077:             unless ($tempkey =~ /\./) {
                   1078:                 $r->print('<option value="'.$tempkey.'"');
1.76      www      1079:                 if ($psprt[0] eq "all" ||  $temphash{$tempkey}) {
1.57      albertel 1080:                     $r->print(' selected');
                   1081:                 }
                   1082:                 $r->print('>'.$allparts{$tempkey}.'</option>');
                   1083:             }
                   1084:         }
                   1085:         $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
                   1086: 
1.130     www      1087:         $r->print('<tr><td>'.&mt('Sort list by').'</td><td>');
1.57      albertel 1088:         $r->print('<select name="fcat">');
1.130     www      1089:         $r->print('<option value="">'.&mt('Enclosing Map or Folder').'</option>');
1.57      albertel 1090:         foreach (sort keys %allkeys) {
                   1091:             $r->print('<option value="'.$_.'"');
                   1092:             if ($fcat eq $_) { $r->print(' selected'); }
                   1093:             $r->print('>'.$allkeys{$_}.'</option>');
                   1094:         }
                   1095:         $r->print('</select></td>');
                   1096: 
                   1097:         $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
                   1098: 
                   1099:     } else { # hide options - include any necessary extras here
                   1100: 
                   1101:         $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
                   1102: 
                   1103:         unless (@pscat) {
                   1104:           foreach (keys %allparms ) {
                   1105:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
                   1106:           }
                   1107:         } else {
                   1108:           foreach (@pscat) {
                   1109:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
                   1110:           }
                   1111:         }
                   1112: 
                   1113:         unless (@psprt) {
                   1114:           foreach (keys %allparts ) {
                   1115:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
                   1116:           }
                   1117:         } else {
                   1118:           foreach (@psprt) {
                   1119:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
                   1120:           }
                   1121:         }
                   1122: 
1.44      albertel 1123:     }
1.101     www      1124:     $r->print('</table><br />');
                   1125:     if (($prevvisit) || ($pschp) || ($pssymb)) {
1.130     www      1126:         $submitmessage = &mt("Update Course Assessment Parameter Display");
1.101     www      1127:     } else {
1.130     www      1128:         $submitmessage = &mt("Set/Modify Course Assessment Parameters");
1.101     www      1129:     }
                   1130:     $r->print('<input type="submit" name="dis" value="'.$submitmessage.'">');
1.57      albertel 1131: 
1.76      www      1132: #    my @temp_psprt;
                   1133: #    foreach my $t (@psprt) {
                   1134: #	push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
                   1135: #    }
1.57      albertel 1136: 
1.76      www      1137: #    @psprt = @temp_psprt;
1.57      albertel 1138: 
                   1139:     my @temp_pscat;
                   1140:     map {
                   1141:         my $cat = $_;
                   1142:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   1143:     } @pscat;
                   1144: 
                   1145:     @pscat = @temp_pscat;
                   1146: 
                   1147:     if (($prevvisit) || ($pschp) || ($pssymb)) {
1.10      www      1148: # ----------------------------------------------------------------- Start Table
1.57      albertel 1149:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
                   1150:         my $csuname=$ENV{'user.name'};
                   1151:         my $csudom=$ENV{'user.domain'};
                   1152: 
                   1153:         if ($parmlev eq 'full' || $parmlev eq 'brief') {
                   1154:            my $coursespan=$csec?8:5;
                   1155:            $r->print('<p><table border=2>');
                   1156:            $r->print('<tr><td colspan=5></td>');
1.130     www      1157:            $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57      albertel 1158:            if ($uname) {
                   1159:                $r->print("<th colspan=3 rowspan=2>");
1.130     www      1160:                $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57      albertel 1161:            }
1.133     www      1162: 	   my %lt=&Apache::lonlocal::texthash(
                   1163: 				  'pie'    => "Parameter in Effect",
                   1164: 				  'csv'    => "Current Session Value",
                   1165:                                   'at'     => 'at',
                   1166:                                   'rl'     => "Resource Level",
                   1167: 				  'ic'     => 'in Course',
                   1168: 				  'aut'    => "Assessment URL and Title",
1.143     albertel 1169: 				  'type'   => 'Type',
1.133     www      1170: 				  'emof'   => "Enclosing Map or Folder",
1.143     albertel 1171: 				  'part'   => 'Part',
1.133     www      1172:                                   'pn'     => 'Parameter Name',
                   1173: 				  'def'    => 'default',
                   1174: 				  'femof'  => 'from Enclosing Map or Folder',
                   1175: 				  'gen'    => 'general',
                   1176: 				  'foremf' => 'for Enclosing Map or Folder',
                   1177: 				  'fr'     => 'for Resource'
                   1178: 					      );
1.57      albertel 1179:            $r->print(<<ENDTABLETWO);
1.133     www      1180: <th rowspan=3>$lt{'pie'}</th>
                   1181: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182     albertel 1182: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
                   1183: <th colspan=1>$lt{'ic'}</th>
                   1184: 
1.10      www      1185: ENDTABLETWO
1.57      albertel 1186:            if ($csec) {
1.133     www      1187:                 $r->print("<th colspan=3>".
                   1188: 			  &mt("in Section/Group")." $csec</th>");
1.57      albertel 1189:            }
                   1190:            $r->print(<<ENDTABLEHEADFOUR);
1.133     www      1191: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   1192: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.182     albertel 1193: <th>$lt{'gen'}</th><th>$lt{'femof'}</th>
                   1194: <th>$lt{'def'}</th><th>$lt{'foremf'}</th><th>$lt{'fr'}</th>
1.10      www      1195: ENDTABLEHEADFOUR
1.57      albertel 1196: 
                   1197:            if ($csec) {
1.130     www      1198:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1199:            }
                   1200: 
                   1201:            if ($uname) {
1.130     www      1202:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1203:            }
                   1204: 
                   1205:            $r->print('</tr>');
                   1206: 
                   1207:            my $defbgone='';
                   1208:            my $defbgtwo='';
                   1209: 
                   1210:            foreach (@ids) {
                   1211: 
                   1212:                 my $rid=$_;
                   1213:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   1214: 
1.152     albertel 1215:                 if ((!$pssymb && 
                   1216: 		     (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   1217: 		    ||
                   1218: 		    ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      1219: # ------------------------------------------------------ Entry for one resource
1.184     albertel 1220:                     if ($defbgone eq '"#E0E099"') {
                   1221:                         $defbgone='"#E0E0DD"';
1.57      albertel 1222:                     } else {
1.184     albertel 1223:                         $defbgone='"#E0E099"';
1.57      albertel 1224:                     }
1.184     albertel 1225:                     if ($defbgtwo eq '"#FFFF99"') {
                   1226:                         $defbgtwo='"#FFFFDD"';
1.57      albertel 1227:                     } else {
1.184     albertel 1228:                         $defbgtwo='"#FFFF99"';
1.57      albertel 1229:                     }
                   1230:                     my $thistitle='';
                   1231:                     my %name=   ();
                   1232:                     undef %name;
                   1233:                     my %part=   ();
                   1234:                     my %display=();
                   1235:                     my %type=   ();
                   1236:                     my %default=();
                   1237:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1238: 
                   1239:                     foreach (split(/\,/,$keyp{$rid})) {
                   1240:                         my $tempkeyp = $_;
                   1241:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   1242:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   1243:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                   1244:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                   1245:                           unless ($display{$_}) { $display{$_}=''; }
                   1246:                           $display{$_}.=' ('.$name{$_}.')';
                   1247:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   1248:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   1249:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   1250:                         }
                   1251:                     }
                   1252:                     my $totalparms=scalar keys %name;
                   1253:                     if ($totalparms>0) {
                   1254:                         my $firstrow=1;
1.180     albertel 1255: 			my $title=&Apache::lonnet::gettitle($uri);
1.57      albertel 1256:                         $r->print('<tr><td bgcolor='.$defbgone.
                   1257:                              ' rowspan='.$totalparms.
                   1258:                              '><tt><font size=-1>'.
                   1259:                              join(' / ',split(/\//,$uri)).
                   1260:                              '</font></tt><p><b>'.
1.154     albertel 1261:                              "<a href=\"javascript:openWindow('".
                   1262: 				  &Apache::lonnet::clutter($uri).
1.57      albertel 1263:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127     albertel 1264:                              " TARGET=_self>$title");
1.57      albertel 1265: 
                   1266:                         if ($thistitle) {
                   1267:                             $r->print(' ('.$thistitle.')');
                   1268:                         }
                   1269:                         $r->print('</a></b></td>');
                   1270:                         $r->print('<td bgcolor='.$defbgtwo.
                   1271:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   1272:                                       '</td>');
                   1273: 
                   1274:                         $r->print('<td bgcolor='.$defbgone.
                   1275:                                       ' rowspan='.$totalparms.
                   1276:                                       '><tt><font size=-1>');
                   1277: 
                   1278:                         $r->print(' / res / ');
                   1279:                         $r->print(join(' / ', split(/\//,$mapp{$rid})));
                   1280: 
                   1281:                         $r->print('</font></tt></td>');
                   1282: 
                   1283:                         foreach (sort keys %name) {
                   1284:                             unless ($firstrow) {
                   1285:                                 $r->print('<tr>');
                   1286:                             } else {
                   1287:                                 undef $firstrow;
                   1288:                             }
                   1289: 
                   1290:                             &print_row($r,$_,\%part,\%name,$rid,\%default,
                   1291:                                        \%type,\%display,$defbgone,$defbgtwo,
1.187     www      1292:                                        $parmlev,$uname,$udom,$csec);
1.57      albertel 1293:                         }
                   1294:                     }
                   1295:                 }
                   1296:             } # end foreach ids
1.43      albertel 1297: # -------------------------------------------------- End entry for one resource
1.57      albertel 1298:             $r->print('</table>');
                   1299:         } # end of  brief/full
                   1300: #--------------------------------------------------- Entry for parm level map
                   1301:         if ($parmlev eq 'map') {
                   1302:             my $defbgone = '"E0E099"';
                   1303:             my $defbgtwo = '"FFFF99"';
                   1304: 
                   1305:             my %maplist;
                   1306: 
                   1307:             if ($pschp eq 'all') {
                   1308:                 %maplist = %allmaps; 
                   1309:             } else {
                   1310:                 %maplist = ($pschp => $mapp{$pschp});
                   1311:             }
                   1312: 
                   1313: #-------------------------------------------- for each map, gather information
                   1314:             my $mapid;
1.60      albertel 1315: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   1316:                 my $maptitle = $maplist{$mapid};
1.57      albertel 1317: 
                   1318: #-----------------------  loop through ids and get all parameter types for map
                   1319: #-----------------------------------------          and associated information
                   1320:                 my %name = ();
                   1321:                 my %part = ();
                   1322:                 my %display = ();
                   1323:                 my %type = ();
                   1324:                 my %default = ();
                   1325:                 my $map = 0;
                   1326: 
                   1327: #		$r->print("Catmarker: @catmarker<br />\n");
                   1328:                
                   1329:                 foreach (@ids) {
                   1330:                   ($map)=(/([\d]*?)\./);
                   1331:                   my $rid = $_;
                   1332:         
                   1333: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   1334: 
                   1335:                   if ($map eq $mapid) {
                   1336:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1337: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   1338: 
                   1339: #--------------------------------------------------------------------
                   1340: # @catmarker contains list of all possible parameters including part #s
                   1341: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1342: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1343: # When storing information, store as part 0
                   1344: # When requesting information, request from full part
                   1345: #-------------------------------------------------------------------
                   1346:                     foreach (split(/\,/,$keyp{$rid})) {
                   1347:                       my $tempkeyp = $_;
                   1348:                       my $fullkeyp = $tempkeyp;
1.73      albertel 1349:                       $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1350:                       
                   1351:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1352:                         $part{$tempkeyp}="0";
                   1353:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1354:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1355:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1356:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1357:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1358:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1359:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1360:                       }
                   1361:                     } # end loop through keys
                   1362:                   }
                   1363:                 } # end loop through ids
                   1364:                                  
                   1365: #---------------------------------------------------- print header information
1.133     www      1366:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      1367:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57      albertel 1368:                 $r->print(<<ENDMAPONE);
                   1369: <center><h4>
1.135     albertel 1370: Set Defaults for All Resources in $foldermap<br />
                   1371: <font color="red"><i>$showtitle</i></font><br />
1.57      albertel 1372: Specifically for
                   1373: ENDMAPONE
                   1374:                 if ($uname) {
                   1375:                     my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1376:                       ('firstname','middlename','lastname','generation', 'id'));
                   1377:                     my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                   1378:                            .$name{'lastname'}.' '.$name{'generation'};
1.135     albertel 1379:                     $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130     www      1380:                         &mt('in')." \n");
1.57      albertel 1381:                 } else {
1.135     albertel 1382:                     $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57      albertel 1383:                 }
                   1384:             
1.135     albertel 1385:                 if ($csec) {$r->print(&mt("Section")." <font color=\"red\"><i>$csec</i></font> ".
1.130     www      1386: 				      &mt('of')." \n")};
1.57      albertel 1387: 
1.135     albertel 1388:                 $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
                   1389:                 $r->print("</h4>\n");
1.57      albertel 1390: #---------------------------------------------------------------- print table
                   1391:                 $r->print('<p><table border="2">');
1.130     www      1392:                 $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1393:                 $r->print('<th>'.&mt('Default Value').'</th>');
                   1394:                 $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1395: 
                   1396: 	        foreach (sort keys %name) {
1.168     matthew  1397:                     $r->print('<tr>');
1.57      albertel 1398:                     &print_row($r,$_,\%part,\%name,$mapid,\%default,
                   1399:                            \%type,\%display,$defbgone,$defbgtwo,
1.187     www      1400:                            $parmlev,$uname,$udom,$csec);
1.57      albertel 1401: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
                   1402:                 }
                   1403:                 $r->print("</table></center>");
                   1404:             } # end each map
                   1405:         } # end of $parmlev eq map
                   1406: #--------------------------------- Entry for parm level general (Course level)
                   1407:         if ($parmlev eq 'general') {
                   1408:             my $defbgone = '"E0E099"';
                   1409:             my $defbgtwo = '"FFFF99"';
                   1410: 
                   1411: #-------------------------------------------- for each map, gather information
                   1412:             my $mapid="0.0";
                   1413: #-----------------------  loop through ids and get all parameter types for map
                   1414: #-----------------------------------------          and associated information
                   1415:             my %name = ();
                   1416:             my %part = ();
                   1417:             my %display = ();
                   1418:             my %type = ();
                   1419:             my %default = ();
                   1420:                
                   1421:             foreach (@ids) {
                   1422:                 my $rid = $_;
                   1423:         
                   1424:                 my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1425: 
                   1426: #--------------------------------------------------------------------
                   1427: # @catmarker contains list of all possible parameters including part #s
                   1428: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1429: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1430: # When storing information, store as part 0
                   1431: # When requesting information, request from full part
                   1432: #-------------------------------------------------------------------
                   1433:                 foreach (split(/\,/,$keyp{$rid})) {
                   1434:                   my $tempkeyp = $_;
                   1435:                   my $fullkeyp = $tempkeyp;
1.73      albertel 1436:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1437:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1438:                     $part{$tempkeyp}="0";
                   1439:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1440:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1441:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1442:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1443:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1444:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1445:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1446:                   }
                   1447:                 } # end loop through keys
                   1448:             } # end loop through ids
                   1449:                                  
                   1450: #---------------------------------------------------- print header information
1.133     www      1451: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 1452:             $r->print(<<ENDMAPONE);
1.133     www      1453: <center><h4>$setdef
1.135     albertel 1454: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 1455: ENDMAPONE
                   1456:             if ($uname) {
                   1457:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1458:                   ('firstname','middlename','lastname','generation', 'id'));
                   1459:                 my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                   1460:                        .$name{'lastname'}.' '.$name{'generation'};
1.135     albertel 1461:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 1462:             } else {
1.135     albertel 1463:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 1464:             }
                   1465:             
1.135     albertel 1466:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
                   1467:             $r->print("</h4>\n");
1.57      albertel 1468: #---------------------------------------------------------------- print table
                   1469:             $r->print('<p><table border="2">');
1.130     www      1470:             $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1471:             $r->print('<th>'.&mt('Default Value').'</th>');
                   1472:             $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1473: 
                   1474: 	    foreach (sort keys %name) {
1.168     matthew  1475:                 $r->print('<tr>');
1.57      albertel 1476:                 &print_row($r,$_,\%part,\%name,$mapid,\%default,
1.187     www      1477:                        \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
1.57      albertel 1478: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
                   1479:             }
                   1480:             $r->print("</table></center>");
                   1481:         } # end of $parmlev eq general
1.43      albertel 1482:     }
1.44      albertel 1483:     $r->print('</form></body></html>');
                   1484:     untie(%bighash);
                   1485:     untie(%parmhash);
1.57      albertel 1486: } # end sub assessparms
1.30      www      1487: 
1.59      matthew  1488: 
                   1489: ##################################################
                   1490: ##################################################
                   1491: 
                   1492: =pod
                   1493: 
                   1494: =item crsenv
                   1495: 
1.105     matthew  1496: Show and set course data and parameters.  This is a large routine that should
1.59      matthew  1497: be simplified and shortened... someday.
                   1498: 
                   1499: Inputs: $r
                   1500: 
                   1501: Returns: nothing
                   1502: 
                   1503: =cut
                   1504: 
                   1505: ##################################################
                   1506: ##################################################
1.30      www      1507: sub crsenv {
                   1508:     my $r=shift;
                   1509:     my $setoutput='';
1.64      www      1510:     my $bodytag=&Apache::loncommon::bodytag(
                   1511:                              'Set Course Environment Parameters');
1.45      matthew  1512:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1513:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.105     matthew  1514: 
                   1515:     #
                   1516:     # Go through list of changes
1.38      harris41 1517:     foreach (keys %ENV) {
1.105     matthew  1518:         next if ($_!~/^form\.(.+)\_setparmval$/);
                   1519:         my $name  = $1;
                   1520:         my $value = $ENV{'form.'.$name.'_value'};
                   1521:         if ($name eq 'newp') {
                   1522:             $name = $ENV{'form.newp_name'};
                   1523:         }
                   1524:         if ($name eq 'url') {
                   1525:             $value=~s/^\/res\///;
                   1526:             my $bkuptime=time;
                   1527:             my @tmp = &Apache::lonnet::get
                   1528:                 ('environment',['url'],$dom,$crs);
1.130     www      1529:             $setoutput.=&mt('Backing up previous URL').': '.
1.105     matthew  1530:                 &Apache::lonnet::put
                   1531:                 ('environment',
                   1532:                  {'top level map backup '.$bkuptime => $tmp[1] },
                   1533:                  $dom,$crs).
                   1534:                      '<br>';
                   1535:         }
                   1536:         #
                   1537:         # Deal with modified default spreadsheets
                   1538:         if ($name =~ /^spreadsheet_default_(classcalc|
                   1539:                                             studentcalc|
                   1540:                                             assesscalc)$/x) {
                   1541:             my $sheettype = $1; 
                   1542:             if ($sheettype eq 'classcalc') {
                   1543:                 # no need to do anything since viewing the sheet will
                   1544:                 # cause it to be updated. 
                   1545:             } elsif ($sheettype eq 'studentcalc') {
                   1546:                 # expire all the student spreadsheets
                   1547:                 &Apache::lonnet::expirespread('','','studentcalc');
                   1548:             } else {
                   1549:                 # expire all the assessment spreadsheets 
                   1550:                 #    this includes non-default spreadsheets, but better to
                   1551:                 #    be safe than sorry.
                   1552:                 &Apache::lonnet::expirespread('','','assesscalc');
                   1553:                 # expire all the student spreadsheets
                   1554:                 &Apache::lonnet::expirespread('','','studentcalc');
1.30      www      1555:             }
1.105     matthew  1556:         }
                   1557:         #
1.107     matthew  1558:         # Deal with the enrollment dates
                   1559:         if ($name =~ /^default_enrollment_(start|end)_date$/) {
                   1560:             $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
                   1561:         }
1.178     raeburn  1562:         # Get existing cloners
                   1563:         my @oldcloner = ();
                   1564:         if ($name eq 'cloners') {
                   1565:             my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
                   1566:             if ($clonenames{'cloners'} =~ /,/) {
                   1567:                 @oldcloner = split/,/,$clonenames{'cloners'};
                   1568:             } else {
                   1569:                 $oldcloner[0] = $clonenames{'cloners'};
                   1570:             }
                   1571:         }
1.107     matthew  1572:         #
1.105     matthew  1573:         # Let the user know we made the changes
1.153     albertel 1574:         if ($name && defined($value)) {
1.178     raeburn  1575:             if ($name eq 'cloners') {
                   1576:                 $value =~ s/^,//;
                   1577:                 $value =~ s/,$//;
                   1578:             }
1.105     matthew  1579:             my $put_result = &Apache::lonnet::put('environment',
                   1580:                                                   {$name=>$value},$dom,$crs);
                   1581:             if ($put_result eq 'ok') {
1.130     www      1582:                 $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178     raeburn  1583:                 if ($name eq 'cloners') {
                   1584:                     &change_clone($value,\@oldcloner);
                   1585:                 }
1.179     raeburn  1586:                 # Flush the course logs so course description is immediately updated
                   1587:                 if ($name eq 'description' && defined($value)) {
                   1588:                     &Apache::lonnet::flushcourselogs();
                   1589:                 }
1.105     matthew  1590:             } else {
1.130     www      1591:                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
                   1592: 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30      www      1593:             }
                   1594:         }
1.38      harris41 1595:     }
1.108     www      1596: # ------------------------- Re-init course environment entries for this session
                   1597: 
                   1598:     &Apache::lonnet::coursedescription($ENV{'request.course.id'});
1.105     matthew  1599: 
1.30      www      1600: # -------------------------------------------------------- Get parameters again
1.45      matthew  1601: 
                   1602:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140     sakharuk 1603:     my $SelectStyleFile=&mt('Select Style File');
1.141     sakharuk 1604:     my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30      www      1605:     my $output='';
1.45      matthew  1606:     if (! exists($values{'con_lost'})) {
1.30      www      1607:         my %descriptions=
1.140     sakharuk 1608: 	    ('url'            => '<b>'.&mt('Top Level Map').'</b> '.
1.46      matthew  1609:                                  '<a href="javascript:openbrowser'.
1.47      matthew  1610:                                  "('envform','url','sequence')\">".
1.140     sakharuk 1611:                                  &mt('Select Map').'</a><br /><font color=red> '.
                   1612:                                  &mt('Modification may make assessment data inaccessible').
                   1613:                                  '</font>',
                   1614:              'description'    => '<b>'.&mt('Course Description').'</b>',
1.158     sakharuk 1615:              'courseid'       => '<b>'.&mt('Course ID or number').
1.140     sakharuk 1616:                                  '</b><br />'.
                   1617:                                  '('.&mt('internal').', '.&mt('optional').')',
1.177     raeburn  1618:              'cloners'        => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
1.150     www      1619:              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                   1620:                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140     sakharuk 1621:              'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52      www      1622:                     '<a href="javascript:openbrowser'.
                   1623:                     "('envform','default_xml_style'".
1.140     sakharuk 1624:                     ",'sty')\">$SelectStyleFile</a><br>",
1.141     sakharuk 1625:              'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
                   1626:                                  '</b><br />(<tt>user:domain,'.
1.74      www      1627:                                  'user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1628:              'comment.email'  => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74      www      1629:                                  '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1630:              'policy.email'   => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75      albertel 1631:                                  '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1632:              'hideemptyrows'  => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158     sakharuk 1633:                                  '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141     sakharuk 1634:              'pageseparators'  => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158     sakharuk 1635:                                  '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141     sakharuk 1636:                                  &mt('changes will not show until next login').')',
1.169     matthew  1637:              'student_classlist_view' => '<b>'.&mt('Allow students to view classlist.').'</b>'.&mt('("all":students can view all sections,"section":students can only view their own section.blank or "disabled" prevents student view.'),
1.118     matthew  1638: 
1.141     sakharuk 1639:              'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
                   1640:                                   '</b><br />"<tt>st</tt>": '.
1.158     sakharuk 1641:                                   &mt('student').', "<tt>ta</tt>": '.
1.118     matthew  1642:                                   'TA, "<tt>in</tt>": '.
1.158     sakharuk 1643:                                   &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118     matthew  1644: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                   1645:              'plc.users.denied' => 
1.141     sakharuk 1646:                           '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118     matthew  1647:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   1648: 
1.141     sakharuk 1649:              'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
                   1650:                                   '</b><br />"<tt>st</tt>": '.
1.61      albertel 1651:                                   'student, "<tt>ta</tt>": '.
                   1652:                                   'TA, "<tt>in</tt>": '.
1.75      albertel 1653:                                   'instructor;<br /><tt>role,role,...</tt>) '.
1.61      albertel 1654: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53      www      1655:              'pch.users.denied' => 
1.141     sakharuk 1656:                           '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53      www      1657:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  1658:              'spreadsheet_default_classcalc' 
1.141     sakharuk 1659:                  => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50      matthew  1660:                     '<a href="javascript:openbrowser'.
                   1661:                     "('envform','spreadsheet_default_classcalc'".
1.141     sakharuk 1662:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  1663:              'spreadsheet_default_studentcalc' 
1.141     sakharuk 1664:                  => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50      matthew  1665:                     '<a href="javascript:openbrowser'.
                   1666:                     "('envform','spreadsheet_default_calc'".
1.141     sakharuk 1667:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  1668:              'spreadsheet_default_assesscalc' 
1.141     sakharuk 1669:                  => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50      matthew  1670:                     '<a href="javascript:openbrowser'.
                   1671:                     "('envform','spreadsheet_default_assesscalc'".
1.141     sakharuk 1672:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75      albertel 1673: 	     'allow_limited_html_in_feedback'
1.141     sakharuk 1674: 	         => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158     sakharuk 1675: 	            '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170     raeburn  1676:              'allow_discussion_post_editing'
                   1677:                  => '<b>'.&mt('Allow users to edit/delete their own discussion posts').'</b><br />'.
                   1678:                     '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.89      albertel 1679: 	     'rndseed'
1.140     sakharuk 1680: 	         => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
                   1681:                     '<font color="red">'.&mt('Modifying this will make problems').' '.
                   1682:                     &mt('have different numbers and answers').'</font>',
1.151     albertel 1683: 	     'receiptalg'
                   1684: 	         => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
                   1685:                     &mt('This controls how receipt numbers are generated.'),
1.164     sakharuk 1686:              'suppress_tries'
                   1687:                  => '<b>'.&mt('Suppress number of tries in printing').'</b>('.
                   1688:                     &mt('yes if supress').')',
1.113     sakharuk 1689:              'problem_stream_switch'
1.141     sakharuk 1690:                  => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158     sakharuk 1691:                     ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161     sakharuk 1692:              'default_paper_size' 
                   1693:                  => '<b>'.&mt('Default paper type').'</b><br />'.
                   1694:                     ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'. 
                   1695:                     ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'. 
                   1696:                     ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111     sakharuk 1697:              'anonymous_quiz'
1.150     www      1698:                  => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141     sakharuk 1699:                     ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
                   1700:              'default_enrollment_start_date' => '<b>'.&mt('Default beginning date when enrolling students').'</b>',
                   1701:              'default_enrollment_end_date'   => '<b>'.&mt('Default ending date when enrolling students').'</b>',
1.150     www      1702:              'nothideprivileged'   => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
                   1703:                                  '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140     sakharuk 1704:              'languages' => '<b>'.&mt('Languages used').'</b>',
1.115     www      1705:              'disable_receipt_display'
1.141     sakharuk 1706:                  => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158     sakharuk 1707:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163     albertel 1708: 	     'disablesigfigs'
                   1709: 	         => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
                   1710:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.149     albertel 1711: 	     'tthoptions'
                   1712: 	         => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107     matthew  1713:              ); 
1.177     raeburn  1714:         my @Display_Order = ('url','description','courseid','cloners','grading',
1.107     matthew  1715:                              'default_xml_style','pageseparators',
                   1716:                              'question.email','comment.email','policy.email',
1.169     matthew  1717:                              'student_classlist_view',
1.118     matthew  1718:                              'plc.roles.denied','plc.users.denied',
1.107     matthew  1719:                              'pch.roles.denied','pch.users.denied',
                   1720:                              'allow_limited_html_in_feedback',
1.170     raeburn  1721:                              'allow_discussion_post_editing',
1.108     www      1722:                              'languages',
1.150     www      1723: 			     'nothideprivileged',
1.107     matthew  1724:                              'rndseed',
1.151     albertel 1725:                              'receiptalg',
1.107     matthew  1726:                              'problem_stream_switch',
1.164     sakharuk 1727: 			     'suppress_tries',
1.161     sakharuk 1728:                              'default_paper_size',
1.115     www      1729:                              'disable_receipt_display',
1.107     matthew  1730:                              'spreadsheet_default_classcalc',
                   1731:                              'spreadsheet_default_studentcalc',
                   1732:                              'spreadsheet_default_assesscalc', 
                   1733:                              'hideemptyrows',
                   1734:                              'default_enrollment_start_date',
                   1735:                              'default_enrollment_end_date',
1.163     albertel 1736: 			     'tthoptions',
                   1737: 			     'disablesigfigs'
1.107     matthew  1738:                              );
                   1739: 	foreach my $parameter (sort(keys(%values))) {
1.142     raeburn  1740:             unless ($parameter =~ m/^internal\./) {
                   1741:                 if (! $descriptions{$parameter}) {
                   1742:                     $descriptions{$parameter}=$parameter;
                   1743:                     push(@Display_Order,$parameter);
                   1744:                 }
                   1745:             }
1.43      albertel 1746: 	}
1.107     matthew  1747:         foreach my $parameter (@Display_Order) {
                   1748:             my $description = $descriptions{$parameter};
1.51      matthew  1749:             # onchange is javascript to automatically check the 'Set' button.
1.69      www      1750:             my $onchange = 'onFocus="javascript:window.document.forms'.
1.107     matthew  1751:                 "['envform'].elements['".$parameter."_setparmval']".
1.51      matthew  1752:                 '.checked=true;"';
1.107     matthew  1753:             $output .= '<tr><td>'.$description.'</td>';
                   1754:             if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
                   1755:                 $output .= '<td>'.
                   1756:                     &Apache::lonhtmlcommon::date_setter('envform',
                   1757:                                                         $parameter.'_value',
                   1758:                                                         $values{$parameter},
                   1759:                                                         $onchange).
                   1760:                                                         '</td>';
                   1761:             } else {
                   1762:                 $output .= '<td>'.
                   1763:                     &Apache::lonhtmlcommon::textbox($parameter.'_value',
                   1764:                                                     $values{$parameter},
                   1765:                                                     40,$onchange).'</td>';
                   1766:             }
                   1767:             $output .= '<td>'.
                   1768:                 &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                   1769:                 '</td>';
                   1770:             $output .= "</tr>\n";
1.51      matthew  1771: 	}
1.69      www      1772:         my $onchange = 'onFocus="javascript:window.document.forms'.
1.51      matthew  1773:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   1774:             '.checked=true;"';
1.130     www      1775: 	$output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51      matthew  1776: 	    '<input type="text" size=40 name="newp_name" '.
                   1777:                 $onchange.' /></td><td>'.
                   1778:             '<input type="text" size=40 name="newp_value" '.
                   1779:                 $onchange.' /></td><td>'.
                   1780: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 1781:     }
1.157     sakharuk 1782:     my %lt=&Apache::lonlocal::texthash(
                   1783: 		    'par'   => 'Parameter',
                   1784: 		    'val'   => 'Value',
                   1785: 		    'set'   => 'Set',
                   1786: 		    'sce'   => 'Set Course Environment'
                   1787: 				       );
                   1788: 
1.140     sakharuk 1789:     my $Parameter=&mt('Parameter');
                   1790:     my $Value=&mt('Value');
1.141     sakharuk 1791:     my $Set=&mt('Set');
1.167     albertel 1792:     my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset');
1.183     albertel 1793:     my $html=&Apache::lonxml::xmlbegin();
1.30      www      1794:     $r->print(<<ENDENV);
1.183     albertel 1795: $html
                   1796: <head>
1.46      matthew  1797: <script type="text/javascript" language="Javascript" >
1.155     albertel 1798: $browse_js
1.46      matthew  1799: </script>
1.30      www      1800: <title>LON-CAPA Course Environment</title>
                   1801: </head>
1.64      www      1802: $bodytag
1.30      www      1803: <form method="post" action="/adm/parmset" name="envform">
                   1804: $setoutput
                   1805: <p>
                   1806: <table border=2>
1.157     sakharuk 1807: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30      www      1808: $output
                   1809: </table>
1.157     sakharuk 1810: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30      www      1811: </form>
                   1812: </body>
                   1813: </html>    
                   1814: ENDENV
                   1815: }
1.120     www      1816: ##################################################
1.30      www      1817: 
1.124     www      1818: my $tableopen;
                   1819: 
                   1820: sub tablestart {
                   1821:     if ($tableopen) {
                   1822: 	return '';
                   1823:     } else {
                   1824: 	$tableopen=1;
1.130     www      1825: 	return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
                   1826: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      1827:     }
                   1828: }
                   1829: 
                   1830: sub tableend {
                   1831:     if ($tableopen) {
                   1832: 	$tableopen=0;
                   1833: 	return '</table>';
                   1834:     } else {
                   1835: 	return'';
                   1836:     }
                   1837: }
                   1838: 
1.120     www      1839: sub overview {
                   1840:     my $r=shift;
                   1841:     my $bodytag=&Apache::loncommon::bodytag(
                   1842:                              'Set/Modify Course Assessment Parameters');
                   1843:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1844:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.183     albertel 1845:     my $html=&Apache::lonxml::xmlbegin();
1.120     www      1846:     $r->print(<<ENDOVER);
1.183     albertel 1847: $html
1.120     www      1848: <head>
                   1849: <title>LON-CAPA Course Environment</title>
                   1850: </head>
                   1851: $bodytag
1.123     www      1852: <form method="post" action="/adm/parmset" name="overviewform">
1.120     www      1853: <input type="hidden" name="overview" value="1" />
                   1854: ENDOVER
1.124     www      1855: # Setting
                   1856:     my %olddata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   1857:     my %newdata=();
                   1858:     undef %newdata;
                   1859:     my @deldata=();
                   1860:     undef @deldata;
                   1861:     foreach (keys %ENV) {
                   1862: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   1863: 	    my $cmd=$1;
                   1864: 	    my $thiskey=$2;
                   1865: 	    if ($cmd eq 'set') {
                   1866: 		my $data=$ENV{$_};
                   1867: 		if ($olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
                   1868: 	    } elsif ($cmd eq 'del') {
                   1869: 		push (@deldata,$thiskey);
                   1870: 	    } elsif ($cmd eq 'datepointer') {
                   1871: 		my $data=&Apache::lonhtmlcommon::get_date_from_form($ENV{$_});
1.153     albertel 1872: 		if (defined($data) and $olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
1.124     www      1873: 	    }
                   1874: 	}
                   1875:     }
                   1876: # Store
1.144     www      1877:     my $delentries=$#deldata+1;
                   1878:     my @newdatakeys=keys %newdata;
                   1879:     my $putentries=$#newdatakeys+1;
                   1880:     if ($delentries) {
                   1881: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   1882: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   1883: 	} else {
                   1884: 	    $r->print('<h2><font color="red">'.
                   1885: 		      &mt('Error deleting parameters').'</font></h2>');
                   1886: 	}
                   1887:     }
                   1888:     if ($putentries) {
                   1889: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   1890: 	    $r->print('<h2>'.&mt('Stored [_1] parameter(s)</h2>',$putentries));
                   1891: 	} else {
                   1892: 	    $r->print('<h2><font color="red">'.
                   1893: 		      &mt('Error storing parameters').'</font></h2>');
                   1894: 	}
                   1895:     }
1.122     www      1896: # Read and display
                   1897:     my %resourcedata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   1898:     my $oldsection='';
                   1899:     my $oldrealm='';
                   1900:     my $oldpart='';
1.123     www      1901:     my $pointer=0;
1.124     www      1902:     $tableopen=0;
1.145     www      1903:     my $foundkeys=0;
1.122     www      1904:     foreach my $thiskey (sort keys %resourcedata) {
1.123     www      1905: 	if ($resourcedata{$thiskey.'.type'}) {
                   1906: 	    my ($course,$middle,$part,$name)=
                   1907: 		($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      1908: 	    my $section=&mt('All Students');
1.122     www      1909: 	    if ($middle=~/^\[(.*)\]\./) {
1.130     www      1910: 		$section=&mt('Group/Section').': '.$1;
1.122     www      1911: 		$middle=~s/^\[(.*)\]\.//;
                   1912: 	    }
1.123     www      1913: 	    $middle=~s/\.$//;
1.130     www      1914: 	    my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122     www      1915: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174     albertel 1916: 		$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122     www      1917: 	    } elsif ($middle) {
1.174     albertel 1918: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   1919: 		$realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
1.122     www      1920: 	    }
                   1921: 	    if ($section ne $oldsection) {
1.124     www      1922: 		$r->print(&tableend()."\n<hr /><h1>$section</h1>");
1.122     www      1923: 		$oldsection=$section;
                   1924: 		$oldrealm='';
                   1925: 	    }
                   1926: 	    if ($realm ne $oldrealm) {
1.124     www      1927: 		$r->print(&tableend()."\n<h2>$realm</h2>");
1.122     www      1928: 		$oldrealm=$realm;
                   1929: 		$oldpart='';
                   1930: 	    }
                   1931: 	    if ($part ne $oldpart) {
1.124     www      1932: 		$r->print(&tableend().
1.130     www      1933: 			  "\n<h3><font color='blue'>".&mt('Part').": $part</font></h3>");
1.122     www      1934: 		$oldpart=$part;
                   1935: 	    }
1.123     www      1936: #
                   1937: # Ready to print
                   1938: #
1.124     www      1939: 	    $r->print(&tablestart().'<tr><td><b>'.$name.
                   1940: 		      ':</b></td><td><input type="checkbox" name="del_'.
                   1941: 		      $thiskey.'" /></td><td>');
1.145     www      1942: 	    $foundkeys++;
1.123     www      1943: 	    if ($resourcedata{$thiskey.'.type'}=~/^date/) {
                   1944: 		my $jskey='key_'.$pointer;
                   1945: 		$pointer++;
                   1946: 		$r->print(
                   1947: 			  &Apache::lonhtmlcommon::date_setter('overviewform',
                   1948: 							      $jskey,
                   1949: 						      $resourcedata{$thiskey}).
                   1950: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
                   1951: 			  );
                   1952: 	    } else {
                   1953: 		$r->print(
                   1954: 			  '<input type="text" name="set_'.$thiskey.'" value="'.
                   1955: 			  $resourcedata{$thiskey}.'">');
                   1956: 	    }
1.124     www      1957: 	    $r->print('</td></tr>');
1.122     www      1958: 	}
1.121     www      1959:     }
1.124     www      1960:     
1.145     www      1961:     $r->print(&tableend().'<p>'.
                   1962: 	($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no course or section parameters.')).'</p></form></body></html>');
1.120     www      1963: }
1.121     www      1964: 
1.59      matthew  1965: ##################################################
                   1966: ##################################################
1.178     raeburn  1967:                                                                                             
                   1968: =pod
                   1969:                                                                                             
                   1970: =item change clone
                   1971:                                                                                             
                   1972: Modifies the list of courses a user can clone (stored
                   1973: in the user's environemnt.db file), called when a
                   1974: change is made to the list of users allowed to clone
                   1975: a course.
                   1976:                                                                                             
                   1977: Inputs: $action,$cloner
                   1978: where $action is add or drop, and $cloner is identity of 
                   1979: user for whom cloning ability is to be changed in course. 
                   1980:                                                                                             
                   1981: Returns: 
                   1982: 
                   1983: =cut
                   1984:                                                                                             
                   1985: ##################################################
                   1986: ##################################################
                   1987: 
                   1988: 
                   1989: sub change_clone {
                   1990:     my ($clonelist,$oldcloner) = @_;
                   1991:     my ($uname,$udom);
                   1992:     my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
                   1993:     my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1994:     my $clone_crs = $cnum.':'.$cdom;
                   1995:     
                   1996:     if ($cnum && $cdom) {
                   1997:         my @allowclone = ();
                   1998:         if ($clonelist =~ /,/) {
                   1999:             @allowclone = split/,/,$clonelist;
                   2000:         } else {
                   2001:             $allowclone[0] = $clonelist;
                   2002:         }
                   2003:         foreach my $currclone (@allowclone) {
                   2004:             if (!grep/^$currclone$/,@$oldcloner) {
                   2005:                 ($uname,$udom) = split/:/,$currclone;
                   2006:                 if ($uname && $udom) {
                   2007:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2008:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2009:                         if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   2010:                             if ($currclonecrs{'cloneable'} eq '') {
                   2011:                                 $currclonecrs{'cloneable'} = $clone_crs;
                   2012:                             } else {
                   2013:                                 $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   2014:                             }
                   2015:                             &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                   2016:                         }
                   2017:                     }
                   2018:                 }
                   2019:             }
                   2020:         }
                   2021:         foreach my $oldclone (@$oldcloner) {
                   2022:             if (!grep/^$oldclone$/,@allowclone) {
                   2023:                 ($uname,$udom) = split/:/,$oldclone;
                   2024:                 if ($uname && $udom) {
                   2025:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2026:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2027:                         my %newclonecrs = ();
                   2028:                         if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   2029:                             if ($currclonecrs{'cloneable'} =~ /,/) {
                   2030:                                 my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   2031:                                 foreach (@currclonecrs) {
                   2032:                                     unless ($_ eq $clone_crs) {
                   2033:                                         $newclonecrs{'cloneable'} .= $_.',';
                   2034:                                     }
                   2035:                                 }
                   2036:                                 $newclonecrs{'cloneable'} =~ s/,$//;
                   2037:                             } else {
                   2038:                                 $newclonecrs{'cloneable'} = '';
                   2039:                             }
                   2040:                             &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                   2041:                         }
                   2042:                     }
                   2043:                 }
                   2044:             }
                   2045:         }
                   2046:     }
                   2047: }
                   2048: 
                   2049: ##################################################
                   2050: ##################################################
1.30      www      2051: 
1.59      matthew  2052: =pod
                   2053: 
1.83      bowersj2 2054: =item * handler
1.59      matthew  2055: 
                   2056: Main handler.  Calls &assessparms and &crsenv subroutines.
                   2057: 
                   2058: =cut
                   2059: 
                   2060: ##################################################
                   2061: ##################################################
1.85      bowersj2 2062:     use Data::Dumper;
1.30      www      2063: sub handler {
1.43      albertel 2064:     my $r=shift;
1.30      www      2065: 
1.43      albertel 2066:     if ($r->header_only) {
1.126     www      2067: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 2068: 	$r->send_http_header;
                   2069: 	return OK;
                   2070:     }
                   2071:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.131     www      2072: 
                   2073: # ----------------------------------------------------------- Clear out garbage
                   2074: 
1.132     albertel 2075:     %courseopt=();
                   2076:     %useropt=();
                   2077:     %parmhash=();
1.131     www      2078: 
1.132     albertel 2079:     @ids=();
                   2080:     %symbp=();
                   2081:     %mapp=();
                   2082:     %typep=();
                   2083:     %keyp=();
1.131     www      2084: 
1.132     albertel 2085:     %maptitles=();
1.83      bowersj2 2086: 
1.30      www      2087: # ----------------------------------------------------- Needs to be in a course
                   2088: 
1.43      albertel 2089:     if (($ENV{'request.course.id'}) && 
1.165     albertel 2090: 	(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}) || 
                   2091: 	 &Apache::lonnet::allowed('opa',$ENV{'request.course.id'}.'/'.
                   2092: 				  $ENV{'request.course.sec'})
                   2093: 	 )) {
1.106     www      2094: 
1.126     www      2095:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      2096:         $r->send_http_header;
1.30      www      2097: 
1.121     www      2098: 	if (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
1.30      www      2099: # ---------------------------------------------- This is for course environment
1.121     www      2100: # -------------------------- also call if toplevel map coudl not be initialized
                   2101: 	    &crsenv($r);
1.120     www      2102: 	} elsif ($ENV{'form.overview'}) {
1.121     www      2103: # --------------------------------------------------------------- Overview mode
                   2104: 	    &overview($r);
1.43      albertel 2105: 	} else {
1.121     www      2106: # --------------------------------------------------------- Bring up assessment
                   2107: 	    &assessparms($r);
1.43      albertel 2108: 	}
                   2109:     } else {
1.1       www      2110: # ----------------------------- Not in a course, or not allowed to modify parms
1.43      albertel 2111: 	$ENV{'user.error.msg'}=
                   2112: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   2113: 	return HTTP_NOT_ACCEPTABLE;
                   2114:     }
                   2115:     return OK;
1.1       www      2116: }
                   2117: 
                   2118: 1;
                   2119: __END__
                   2120: 
1.59      matthew  2121: =pod
1.38      harris41 2122: 
                   2123: =back
                   2124: 
                   2125: =cut
1.1       www      2126: 
                   2127: 
                   2128: 

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