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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.188   ! www         4: # $Id: lonparmset.pm,v 1.187 2005/03/17 22:12:52 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
                    477: }
                    478:     $r->print(<<ENDHEAD3);
1.44      albertel  479: <form method="post" action="/adm/parmset" name="parmform">
1.133     www       480: <h4>$lt{'captm'}</h4>
1.137     albertel  481: ENDHEAD3
1.99      albertel  482: 
                    483:     if (!$have_assesments) {
1.133     www       484: 	$r->print('<font color="red">'.&mt('There are no assesment parameters in this course to set.').'</font><br />');	
1.99      albertel  485:     } else {
                    486: 	$r->print(<<ENDHEAD);
1.44      albertel  487: <b>
1.133     www       488: $lt{'sg'}:
1.188   ! www       489: <input type="text" value="$csec" size="6" name="csec" />
        !           490: <br />
1.133     www       491: $lt{'fu'} 
1.188   ! www       492: <input type="text" value="$uname" size="12" name="uname" />
1.133     www       493: $lt{'oi'}
1.188   ! www       494: <input type="text" value="$id" size="12" name="id" /> 
1.133     www       495: $lt{'ad'}
1.81      www       496: $chooseopt
1.44      albertel  497: </b>
                    498: <input type="hidden" value='' name="pres_value">
                    499: <input type="hidden" value='' name="pres_type">
                    500: <input type="hidden" value='' name="pres_marker">
                    501: ENDHEAD
1.99      albertel  502:     }
1.44      albertel  503: }
                    504: 
                    505: sub print_row {
1.66      www       506:     my ($r,$which,$part,$name,$rid,$default,$defaulttype,$display,$defbgone,
1.187     www       507: 	$defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
1.66      www       508: # get the values for the parameter in cascading order
                    509: # empty levels will remain empty
1.44      albertel  510:     my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.187     www       511: 				  $rid,$$default{$which},$uname,$udom,$csec);
1.66      www       512: # get the type for the parameters
                    513: # problem: these may not be set for all levels
                    514:     my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
                    515:                                           $$name{$which}.'.type',
1.187     www       516: 				  $rid,$$defaulttype{$which},$uname,$udom,$csec);
1.66      www       517: # cascade down manually
1.182     albertel  518:     my $cascadetype=$$defaulttype{$which};
                    519:     for (my $i=11;$i>0;$i--) {
1.66      www       520: 	 if ($typeoutpar[$i]) { 
                    521:             $cascadetype=$typeoutpar[$i];
                    522: 	} else {
                    523:             $typeoutpar[$i]=$cascadetype;
                    524:         }
                    525:     }
1.57      albertel  526:     my $parm=$$display{$which};
                    527: 
                    528:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
                    529:         $r->print('<td bgcolor='.$defbgtwo.' align="center">'
                    530:                   .$$part{$which}.'</td>');
                    531:     } else {    
                    532:         $parm=~s|\[.*\]\s||g;
                    533:     }
                    534: 
1.159     albertel  535:     $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57      albertel  536:    
1.44      albertel  537:     my $thismarker=$which;
                    538:     $thismarker=~s/^parameter\_//;
                    539:     my $mprefix=$rid.'&'.$thismarker.'&';
                    540: 
1.57      albertel  541:     if ($parmlev eq 'general') {
                    542: 
                    543:         if ($uname) {
1.66      www       544:             &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  545:         } elsif ($csec) {
1.66      www       546:             &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  547:         } else {
1.182     albertel  548:             &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display); 
1.57      albertel  549:         }
                    550:     } elsif ($parmlev eq 'map') {
                    551: 
                    552:         if ($uname) {
1.66      www       553:             &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  554:         } elsif ($csec) {
1.66      www       555:             &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  556:         } else {
1.182     albertel  557:             &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  558:         }
                    559:     } else {
                    560: 
1.182     albertel  561:         &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  562: 
                    563:         if ($parmlev eq 'brief') {
                    564: 
1.66      www       565:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  566: 
                    567:            if ($csec) {
1.66      www       568:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  569:            }
                    570:            if ($uname) {
1.66      www       571:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  572:            }
                    573:         } else {
                    574: 
1.182     albertel  575:            &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    576:            &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    577:            &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.66      www       578:            &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  579: 
                    580:            if ($csec) {
1.66      www       581:                &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    582:                &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    583:                &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  584:            }
                    585:            if ($uname) {
1.66      www       586:                &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    587:                &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
                    588:                &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57      albertel  589:            }
                    590:         } # end of $brief if/else
                    591:     } # end of $parmlev if/else
                    592: 
1.136     albertel  593:     $r->print('<td bgcolor=#CCCCFF align="center">'.
                    594:                   &valout($outpar[$result],$typeoutpar[$result]).'</td>');
                    595: 
1.57      albertel  596:     if ($parmlev eq 'full' || $parmlev eq 'brief') {
1.136     albertel  597:         my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.57      albertel  598:                                         '.'.$$name{$which},$symbp{$rid});
1.136     albertel  599: 
1.70      albertel  600: # this doesn't seem to work, and I don't think is correct
                    601: #    my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
                    602: #                                      '.'.$$name{$which}.'.type',$symbp{$rid});
                    603: # this seems to work
1.136     albertel  604:         my $sessionvaltype=$typeoutpar[$result];
                    605:         if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
                    606:         $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
1.66      www       607:                   &valout($sessionval,$sessionvaltype).'&nbsp;'.
1.57      albertel  608:                   '</font></td>');
1.136     albertel  609:     }
1.44      albertel  610:     $r->print('</tr>');
1.57      albertel  611:     $r->print("\n");
1.44      albertel  612: }
1.59      matthew   613: 
1.44      albertel  614: sub print_td {
1.66      www       615:     my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57      albertel  616:     $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114     www       617:               ' align="center">');
1.182     albertel  618:     if ($which<8 || $which > 9) {
1.114     www       619: 	$r->print(&plink($$typeoutpar[$which],
                    620: 			 $$display{$value},$$outpar[$which],
                    621: 			 $mprefix."$which",'parmform.pres','psub'));
                    622:     } else {
                    623: 	$r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
                    624:     }
                    625:     $r->print('</td>'."\n");
1.57      albertel  626: }
                    627: 
1.63      bowersj2  628: =pod
                    629: 
                    630: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
                    631: 
                    632: Input: See list below:
                    633: 
                    634: =over 4
                    635: 
                    636: =item B<ids>: An array that will contain all of the ids in the course.
                    637: 
                    638: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
                    639: 
1.171     www       640: =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  641: 
                    642: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
                    643: 
                    644: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
                    645: 
                    646: =item B<allkeys>: hash, full key to part->display value (what's display value?)
                    647: 
                    648: =item B<allmaps>: hash, ???
                    649: 
                    650: =item B<fcat>: ???
                    651: 
                    652: =item B<defp>: hash, ???
                    653: 
                    654: =item B<mapp>: ??
                    655: 
                    656: =item B<symbp>: hash, id->full sym?
                    657: 
                    658: =back
                    659: 
                    660: =cut
                    661: 
                    662: sub extractResourceInformation {
                    663:     my $bighash = shift;
                    664:     my $ids = shift;
                    665:     my $typep = shift;
                    666:     my $keyp = shift;
                    667:     my $allparms = shift;
                    668:     my $allparts = shift;
                    669:     my $allkeys = shift;
                    670:     my $allmaps = shift;
                    671:     my $fcat = shift;
                    672:     my $defp = shift;
                    673:     my $mapp = shift;
                    674:     my $symbp = shift;
1.82      www       675:     my $maptitles=shift;
1.63      bowersj2  676: 
                    677:     foreach (keys %$bighash) {
                    678: 	if ($_=~/^src\_(\d+)\.(\d+)$/) {
1.175     albertel  679: 	    # there are no resources in the 0 level
                    680: 	    if ($1 eq '0') { next; }
1.63      bowersj2  681: 	    my $mapid=$1;
                    682: 	    my $resid=$2;
                    683: 	    my $id=$mapid.'.'.$resid;
                    684: 	    my $srcf=$$bighash{$_};
1.152     albertel  685: 	    if (1) {
1.173     albertel  686: 		$srcf=~/\.(\w+)$/;
1.63      bowersj2  687: 		$$ids[$#$ids+1]=$id;
                    688: 		$$typep{$id}=$1;
                    689: 		$$keyp{$id}='';
1.65      albertel  690: 		foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
1.63      bowersj2  691: 		  if ($_=~/^parameter\_(.*)/) {
                    692:                     my $key=$_;
                    693:                     my $allkey=$1;
                    694:                     $allkey=~s/\_/\./g;
1.173     albertel  695: 		    if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 
                    696: 			'parm') {
                    697: 			next; #hide hidden things
                    698: 		    }
1.63      bowersj2  699:                     my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                    700:                     my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                    701:                     my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                    702:                     my $parmdis = $display;
                    703:                     $parmdis =~ s|(\[Part.*$)||g;
                    704:                     my $partkey = $part;
                    705:                     $partkey =~ tr|_|.|;
                    706:                     $$allparms{$name} = $parmdis;
                    707:                     $$allparts{$part} = "[Part $part]";
                    708:                     $$allkeys{$allkey}=$display;
                    709:                     if ($allkey eq $fcat) {
                    710: 		        $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
                    711: 		    }
                    712: 		    if ($$keyp{$id}) {
                    713: 		        $$keyp{$id}.=','.$key;
                    714: 		    } else {
                    715: 		        $$keyp{$id}=$key;
                    716: 		    }
                    717: 		  }
                    718: 		}
                    719: 		$$mapp{$id}=
                    720: 		    &Apache::lonnet::declutter($$bighash{'map_id_'.$mapid});
                    721:                 $$mapp{$mapid}=$$mapp{$id};
                    722: 		$$allmaps{$mapid}=$$mapp{$id};
1.175     albertel  723: 		if ($mapid eq '1') {
                    724: 		    $$maptitles{$mapid}='Main Course Documents';
                    725: 		} else {
1.180     albertel  726: 		    $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
1.175     albertel  727: 		}
1.82      www       728: 		$$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.181     albertel  729: 		$$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2  730:                 $$symbp{$mapid}=$$mapp{$id}.'___(all)';
                    731: 	    }
                    732: 	}
                    733:     }
                    734: }
                    735: 
1.59      matthew   736: ##################################################
                    737: ##################################################
                    738: 
                    739: =pod
                    740: 
                    741: =item assessparms
                    742: 
                    743: Show assessment data and parameters.  This is a large routine that should
                    744: be simplified and shortened... someday.
                    745: 
                    746: Inputs: $r
                    747: 
                    748: Returns: nothing
                    749: 
1.63      bowersj2  750: Variables used (guessed by Jeremy):
                    751: 
                    752: =over 4
                    753: 
                    754: =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.
                    755: 
                    756: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
                    757: 
                    758: =item B<allmaps>:
                    759: 
                    760: =back
                    761: 
1.59      matthew   762: =cut
                    763: 
                    764: ##################################################
                    765: ##################################################
1.30      www       766: sub assessparms {
1.1       www       767: 
1.43      albertel  768:     my $r=shift;
1.2       www       769: # -------------------------------------------------------- Variable declaration
1.129     www       770:     my %allkeys=();
                    771:     my %allmaps=();
                    772:     my %alllevs=();
1.57      albertel  773: 
1.187     www       774:     my $uname;
                    775:     my $udom;
                    776:     my $uhome;
                    777:     my $csec;
                    778:  
                    779:     my $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
                    780: 
1.57      albertel  781:     $alllevs{'Resource Level'}='full';
                    782:     $alllevs{'Map Level'}='map';
                    783:     $alllevs{'Course Level'}='general';
                    784: 
                    785:     my %allparms;
                    786:     my %allparts;
                    787: 
1.43      albertel  788:     my %defp;
                    789:     %courseopt=();
                    790:     %useropt=();
1.44      albertel  791:     my %bighash=();
1.43      albertel  792: 
                    793:     @ids=();
                    794:     %symbp=();
                    795:     %typep=();
                    796: 
                    797:     my $message='';
                    798: 
                    799:     $csec=$ENV{'form.csec'};
1.188   ! www       800: 
1.172     albertel  801:     if      ($udom=$ENV{'form.udom'}) {
                    802:     } elsif ($udom=$ENV{'request.role.domain'}) {
                    803:     } elsif ($udom=$ENV{'user.domain'}) {
                    804:     } else {
                    805: 	$udom=$r->dir_config('lonDefDomain');
                    806:     }
1.43      albertel  807: 
1.134     albertel  808:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.43      albertel  809:     my $pschp=$ENV{'form.pschp'};
1.134     albertel  810:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76      www       811:     if (!@psprt) { $psprt[0]='0'; }
1.57      albertel  812:     my $showoptions=$ENV{'form.showoptions'};
                    813: 
1.43      albertel  814:     my $pssymb='';
1.57      albertel  815:     my $parmlev='';
1.137     albertel  816:     my $trimheader='';
1.57      albertel  817:     my $prevvisit=$ENV{'form.prevvisit'};
                    818:  
                    819:     unless ($ENV{'form.parmlev'}) {
                    820:         $parmlev = 'map';
                    821:     } else {
                    822:         $parmlev = $ENV{'form.parmlev'};
                    823:     }
1.26      www       824: 
1.29      www       825: # ----------------------------------------------- Was this started from grades?
                    826: 
1.43      albertel  827:     if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
                    828: 	&& (!$ENV{'form.dis'})) {
                    829: 	my $url=$ENV{'form.url'};
                    830: 	$url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                    831: 	$pssymb=&Apache::lonnet::symbread($url);
1.92      albertel  832: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel  833: 	$pschp='';
1.57      albertel  834:         $parmlev = 'full';
1.137     albertel  835:         $trimheader='yes';
1.43      albertel  836:     } elsif ($ENV{'form.symb'}) {
                    837: 	$pssymb=$ENV{'form.symb'};
1.92      albertel  838: 	if (!@pscat) { @pscat=('all'); }
1.43      albertel  839: 	$pschp='';
1.57      albertel  840:         $parmlev = 'full';
1.137     albertel  841:         $trimheader='yes';
1.43      albertel  842:     } else {
                    843: 	$ENV{'form.url'}='';
                    844:     }
                    845: 
                    846:     my $id=$ENV{'form.id'};
                    847:     if (($id) && ($udom)) {
                    848: 	$uname=(&Apache::lonnet::idget($udom,$id))[1];
                    849: 	if ($uname) {
                    850: 	    $id='';
                    851: 	} else {
                    852: 	    $message=
1.133     www       853: 		"<font color=red>".&mt("Unknown ID")." '$id' ".
                    854: 		&mt('at domain')." '$udom'</font>";
1.43      albertel  855: 	}
                    856:     } else {
                    857: 	$uname=$ENV{'form.uname'};
                    858:     }
                    859:     unless ($udom) { $uname=''; }
                    860:     $uhome='';
                    861:     if ($uname) {
                    862: 	$uhome=&Apache::lonnet::homeserver($uname,$udom);
                    863:         if ($uhome eq 'no_host') {
                    864: 	    $message=
1.133     www       865: 		"<font color=red>".&mt("Unknown user")." '$uname' ".
                    866: 		&mt("at domain")." '$udom'</font>";
1.43      albertel  867: 	    $uname='';
1.12      www       868:         } else {
1.103     albertel  869: 	    $csec=&Apache::lonnet::getsection($udom,$uname,
                    870: 					      $ENV{'request.course.id'});
1.43      albertel  871: 	    if ($csec eq '-1') {
                    872: 		$message="<font color=red>".
1.133     www       873: 		    &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
                    874: 		    &mt("not in this course")."</font>";
1.43      albertel  875: 		$uname='';
                    876: 		$csec=$ENV{'form.csec'};
                    877: 	    } else {
                    878: 		my %name=&Apache::lonnet::userenvironment($udom,$uname,
                    879: 		      ('firstname','middlename','lastname','generation','id'));
1.133     www       880: 		$message="\n<p>\n".&mt("Full Name").": ".
1.43      albertel  881: 		    $name{'firstname'}.' '.$name{'middlename'}.' '
                    882: 			.$name{'lastname'}.' '.$name{'generation'}.
1.133     www       883: 			    "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43      albertel  884: 	    }
1.12      www       885:         }
1.43      albertel  886:     }
1.2       www       887: 
1.43      albertel  888:     unless ($csec) { $csec=''; }
1.12      www       889: 
1.44      albertel  890:     my $fcat=$ENV{'form.fcat'};
1.43      albertel  891:     unless ($fcat) { $fcat=''; }
1.2       www       892: 
                    893: # ------------------------------------------------------------------- Tie hashs
1.44      albertel  894:     if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
1.58      albertel  895: 	      &GDBM_READER(),0640))) {
1.44      albertel  896: 	$r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
                    897: 	return ;
                    898:     }
                    899:     if (!(tie(%parmhash,'GDBM_File',
1.58      albertel  900: 	      $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
1.44      albertel  901: 	$r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
                    902: 	return ;
                    903:     }
1.63      bowersj2  904: 
1.14      www       905: # --------------------------------------------------------- Get all assessments
1.188   ! www       906:     &extractResourceInformation(\%bighash, \@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles);
1.63      bowersj2  907: 
1.57      albertel  908:     $mapp{'0.0'} = '';
                    909:     $symbp{'0.0'} = '';
1.99      albertel  910: 
1.14      www       911: # ---------------------------------------------------------- Anything to store?
1.44      albertel  912:     if ($ENV{'form.pres_marker'}) {
1.186     www       913: 	$message.=&storeparm(split(/\&/,$ENV{'form.pres_marker'}),
                    914: 			     $ENV{'form.pres_value'},
1.187     www       915: 			     $ENV{'form.pres_type'},
                    916:                              $uname,$udom,$csec);
1.68      www       917: # ---------------------------------------------------------------- Done storing
1.130     www       918: 	$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       919:     }
1.67      www       920: # --------------------------------------------- Devalidate cache for this child
1.109     albertel  921:     &Apache::lonnet::devalidatecourseresdata(
1.67      www       922:                  $ENV{'course.'.$ENV{'request.course.id'}.'.num'},
                    923:                  $ENV{'course.'.$ENV{'request.course.id'}.'.domain'});
1.109     albertel  924:     &Apache::lonnet::clear_EXT_cache_status();
1.2       www       925: # -------------------------------------------------------------- Get coursedata
1.45      matthew   926:     %courseopt = &Apache::lonnet::dump
                    927:         ('resourcedata',
                    928:          $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
                    929:          $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44      albertel  930: # --------------------------------------------------- Get userdata (if present)
                    931:     if ($uname) {
1.45      matthew   932:         %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
1.44      albertel  933:     }
1.14      www       934: 
1.2       www       935: # ------------------------------------------------------------------- Sort this
1.17      www       936: 
1.44      albertel  937:     @ids=sort  {
                    938: 	if ($fcat eq '') {
                    939: 	    $a<=>$b;
                    940: 	} else {
1.187     www       941: 	    my ($result,@outpar)=&parmval($fcat,$a,$defp{$a},$uname,$udom,$csec);
1.44      albertel  942: 	    my $aparm=$outpar[$result];
1.187     www       943: 	    ($result,@outpar)=&parmval($fcat,$b,$defp{$b},$uname,$udom,$csec);
1.44      albertel  944: 	    my $bparm=$outpar[$result];
                    945: 	    1*$aparm<=>1*$bparm;
                    946: 	}
                    947:     } @ids;
1.57      albertel  948: #----------------------------------------------- if all selected, fill in array
                    949:     if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
                    950:     if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2       www       951: # ------------------------------------------------------------------ Start page
1.63      bowersj2  952: 
1.99      albertel  953:     my $have_assesments=1;
                    954:     if (scalar(keys(%allkeys)) eq 0) { $have_assesments=0; }
                    955: 
1.137     albertel  956:     &startpage($r,$id,$udom,$csec,$uname,$have_assesments,$trimheader);
1.99      albertel  957: 
1.112     albertel  958:     if (!$have_assesments) {
                    959: 	untie(%bighash);
                    960: 	untie(%parmhash);
                    961: 	return '';
                    962:     }
1.44      albertel  963: #    if ($ENV{'form.url'}) {
                    964: #	$r->print('<input type="hidden" value="'.$ENV{'form.url'}.
                    965: #		  '" name="url"><input type="hidden" name="command" value="set">');
                    966: #    }
1.57      albertel  967:     $r->print('<input type="hidden" value="true" name="prevvisit">');
                    968: 
1.44      albertel  969:     foreach ('tolerance','date_default','date_start','date_end',
                    970: 	     'date_interval','int','float','string') {
                    971: 	$r->print('<input type="hidden" value="'.
                    972: 		  $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
                    973:     }
                    974: 
1.57      albertel  975:     $r->print('<h2>'.$message.'</h2><table>');
                    976:                         
1.130     www       977:     my $submitmessage = &mt('Update Section or Specific User');
1.44      albertel  978:     if (!$pssymb) {
1.160     www       979:         $r->print('<tr><td>'.&mt('Select Parameter Level').
                    980:        &Apache::loncommon::help_open_topic('Course_Parameter_Levels').
                    981: 		  '</td><td colspan="2">');
1.57      albertel  982:         $r->print('<select name="parmlev">');
                    983:         foreach (reverse sort keys %alllevs) {
                    984:             $r->print('<option value="'.$alllevs{$_}.'"');
                    985:             if ($parmlev eq $alllevs{$_}) {
                    986:                $r->print(' selected'); 
                    987:             }
                    988:             $r->print('>'.$_.'</option>');
                    989:         }
                    990:         $r->print("</select></td>\n");
                    991: 
1.101     www       992:         $r->print('</tr>');
1.128     albertel  993: 	if ($parmlev ne 'general') {
1.130     www       994: 	    $r->print('<tr><td>'.&mt('Select Enclosing Map or Folder').'</td>');
1.128     albertel  995: 	    $r->print('<td colspan="2"><select name="pschp">');
1.130     www       996: 	    $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
1.128     albertel  997: 	    foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
                    998: 		$r->print('<option value="'.$_.'"');
                    999: 		if (($pschp eq $_)) { $r->print(' selected'); }
                   1000: 		$r->print('>'.$maptitles{$_}.($allmaps{$_}!~/^uploaded/?'  ['.$allmaps{$_}.']':'').'</option>');
                   1001: 	    }
                   1002: 	    $r->print("</select></td></tr>\n");
                   1003: 	}
1.44      albertel 1004:     } else {
1.125     www      1005:         my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.130     www      1006:         $r->print("<tr><td>".&mt('Specific Resource')."</td><td>$resource</td>");
1.57      albertel 1007:         $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
                   1008:         $r->print('</tr>');
                   1009:         $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
                   1010:     }
                   1011: 
1.185     albertel 1012:     $r->print('<tr><td colspan="3"><hr /><label><input type="checkbox"');
1.57      albertel 1013:     if ($showoptions eq 'show') {$r->print(" checked ");}
1.185     albertel 1014:     $r->print(' name="showoptions" value="show" />'.&mt('Show More Options').'</label><hr /></td></tr>');
1.57      albertel 1015: #    $r->print("<tr><td>Show: $showoptions</td></tr>");
                   1016: #    $r->print("<tr><td>pscat: @pscat</td></tr>");
                   1017: #    $r->print("<tr><td>psprt: @psprt</td></tr>");
                   1018: #    $r->print("<tr><td>fcat:  $fcat</td></tr>");
                   1019: 
                   1020:     if ($showoptions eq 'show') {
                   1021:         my $tempkey;
                   1022: 
1.130     www      1023:         $r->print('<tr><td colspan="3" align="center">'.&mt('Select Parameters to View').'</td></tr>');
1.57      albertel 1024: 
1.176     albertel 1025:         $r->print('<tr><td colspan="2"><table><tr>');
1.57      albertel 1026:         my $cnt=0;
                   1027:         foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
                   1028:                       keys %allparms ) {
                   1029:             ++$cnt;
1.176     albertel 1030:             $r->print('</tr><tr>') if ($cnt%2);
1.57      albertel 1031:             $r->print('<td><input type="checkbox" name="pscat" ');
                   1032:             $r->print('value="'.$tempkey.'"');
                   1033:             if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
                   1034:                 $r->print(' checked');
                   1035:             }
1.176     albertel 1036: 	    $r->print('>'.$allparms{$tempkey}.'</td>');
                   1037: 	}
                   1038: 	$r->print('
                   1039: </tr><tr><td>
                   1040: <script type="text/javascript">
                   1041:     function checkall(value, checkName) {
                   1042: 	for (i=0; i<document.forms.parmform.elements.length; i++) {
                   1043:             ele = document.forms.parmform.elements[i];
                   1044:             if (ele.name == checkName) {
                   1045:                 document.forms.parmform.elements[i].checked=value;
                   1046:             }
1.57      albertel 1047:         }
1.176     albertel 1048:     }
                   1049: </script>
                   1050: <input type="button" onclick="checkall(true, \'pscat\')" value="Select All" />
                   1051: </td><td>
                   1052: <input type="button" onclick="checkall(false, \'pscat\')" value="Unselect All" />
                   1053: </td>
                   1054: ');
1.57      albertel 1055:         $r->print('</tr></table>');
                   1056: 
                   1057: #        $r->print('<tr><td>Select Parts</td><td>');
                   1058:         $r->print('<td><select multiple name="psprt" size="5">');
                   1059:         $r->print('<option value="all"');
                   1060:         $r->print(' selected') unless (@psprt);
1.130     www      1061:         $r->print('>'.&mt('All Parts').'</option>');
1.76      www      1062:         my %temphash=();
                   1063:         foreach (@psprt) { $temphash{$_}=1; }
1.57      albertel 1064:         foreach $tempkey (sort keys %allparts) {
                   1065:             unless ($tempkey =~ /\./) {
                   1066:                 $r->print('<option value="'.$tempkey.'"');
1.76      www      1067:                 if ($psprt[0] eq "all" ||  $temphash{$tempkey}) {
1.57      albertel 1068:                     $r->print(' selected');
                   1069:                 }
                   1070:                 $r->print('>'.$allparts{$tempkey}.'</option>');
                   1071:             }
                   1072:         }
                   1073:         $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
                   1074: 
1.130     www      1075:         $r->print('<tr><td>'.&mt('Sort list by').'</td><td>');
1.57      albertel 1076:         $r->print('<select name="fcat">');
1.130     www      1077:         $r->print('<option value="">'.&mt('Enclosing Map or Folder').'</option>');
1.57      albertel 1078:         foreach (sort keys %allkeys) {
                   1079:             $r->print('<option value="'.$_.'"');
                   1080:             if ($fcat eq $_) { $r->print(' selected'); }
                   1081:             $r->print('>'.$allkeys{$_}.'</option>');
                   1082:         }
                   1083:         $r->print('</select></td>');
                   1084: 
                   1085:         $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
                   1086: 
                   1087:     } else { # hide options - include any necessary extras here
                   1088: 
                   1089:         $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
                   1090: 
                   1091:         unless (@pscat) {
                   1092:           foreach (keys %allparms ) {
                   1093:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
                   1094:           }
                   1095:         } else {
                   1096:           foreach (@pscat) {
                   1097:             $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
                   1098:           }
                   1099:         }
                   1100: 
                   1101:         unless (@psprt) {
                   1102:           foreach (keys %allparts ) {
                   1103:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
                   1104:           }
                   1105:         } else {
                   1106:           foreach (@psprt) {
                   1107:             $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
                   1108:           }
                   1109:         }
                   1110: 
1.44      albertel 1111:     }
1.101     www      1112:     $r->print('</table><br />');
                   1113:     if (($prevvisit) || ($pschp) || ($pssymb)) {
1.130     www      1114:         $submitmessage = &mt("Update Course Assessment Parameter Display");
1.101     www      1115:     } else {
1.130     www      1116:         $submitmessage = &mt("Set/Modify Course Assessment Parameters");
1.101     www      1117:     }
                   1118:     $r->print('<input type="submit" name="dis" value="'.$submitmessage.'">');
1.57      albertel 1119: 
1.76      www      1120: #    my @temp_psprt;
                   1121: #    foreach my $t (@psprt) {
                   1122: #	push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
                   1123: #    }
1.57      albertel 1124: 
1.76      www      1125: #    @psprt = @temp_psprt;
1.57      albertel 1126: 
                   1127:     my @temp_pscat;
                   1128:     map {
                   1129:         my $cat = $_;
                   1130:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   1131:     } @pscat;
                   1132: 
                   1133:     @pscat = @temp_pscat;
                   1134: 
                   1135:     if (($prevvisit) || ($pschp) || ($pssymb)) {
1.10      www      1136: # ----------------------------------------------------------------- Start Table
1.57      albertel 1137:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
                   1138:         my $csuname=$ENV{'user.name'};
                   1139:         my $csudom=$ENV{'user.domain'};
                   1140: 
                   1141:         if ($parmlev eq 'full' || $parmlev eq 'brief') {
                   1142:            my $coursespan=$csec?8:5;
                   1143:            $r->print('<p><table border=2>');
                   1144:            $r->print('<tr><td colspan=5></td>');
1.130     www      1145:            $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57      albertel 1146:            if ($uname) {
                   1147:                $r->print("<th colspan=3 rowspan=2>");
1.130     www      1148:                $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57      albertel 1149:            }
1.133     www      1150: 	   my %lt=&Apache::lonlocal::texthash(
                   1151: 				  'pie'    => "Parameter in Effect",
                   1152: 				  'csv'    => "Current Session Value",
                   1153:                                   'at'     => 'at',
                   1154:                                   'rl'     => "Resource Level",
                   1155: 				  'ic'     => 'in Course',
                   1156: 				  'aut'    => "Assessment URL and Title",
1.143     albertel 1157: 				  'type'   => 'Type',
1.133     www      1158: 				  'emof'   => "Enclosing Map or Folder",
1.143     albertel 1159: 				  'part'   => 'Part',
1.133     www      1160:                                   'pn'     => 'Parameter Name',
                   1161: 				  'def'    => 'default',
                   1162: 				  'femof'  => 'from Enclosing Map or Folder',
                   1163: 				  'gen'    => 'general',
                   1164: 				  'foremf' => 'for Enclosing Map or Folder',
                   1165: 				  'fr'     => 'for Resource'
                   1166: 					      );
1.57      albertel 1167:            $r->print(<<ENDTABLETWO);
1.133     www      1168: <th rowspan=3>$lt{'pie'}</th>
                   1169: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182     albertel 1170: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
                   1171: <th colspan=1>$lt{'ic'}</th>
                   1172: 
1.10      www      1173: ENDTABLETWO
1.57      albertel 1174:            if ($csec) {
1.133     www      1175:                 $r->print("<th colspan=3>".
                   1176: 			  &mt("in Section/Group")." $csec</th>");
1.57      albertel 1177:            }
                   1178:            $r->print(<<ENDTABLEHEADFOUR);
1.133     www      1179: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   1180: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.182     albertel 1181: <th>$lt{'gen'}</th><th>$lt{'femof'}</th>
                   1182: <th>$lt{'def'}</th><th>$lt{'foremf'}</th><th>$lt{'fr'}</th>
1.10      www      1183: ENDTABLEHEADFOUR
1.57      albertel 1184: 
                   1185:            if ($csec) {
1.130     www      1186:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1187:            }
                   1188: 
                   1189:            if ($uname) {
1.130     www      1190:                $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57      albertel 1191:            }
                   1192: 
                   1193:            $r->print('</tr>');
                   1194: 
                   1195:            my $defbgone='';
                   1196:            my $defbgtwo='';
                   1197: 
                   1198:            foreach (@ids) {
                   1199: 
                   1200:                 my $rid=$_;
                   1201:                 my ($inmapid)=($rid=~/\.(\d+)$/);
                   1202: 
1.152     albertel 1203:                 if ((!$pssymb && 
                   1204: 		     (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   1205: 		    ||
                   1206: 		    ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      1207: # ------------------------------------------------------ Entry for one resource
1.184     albertel 1208:                     if ($defbgone eq '"#E0E099"') {
                   1209:                         $defbgone='"#E0E0DD"';
1.57      albertel 1210:                     } else {
1.184     albertel 1211:                         $defbgone='"#E0E099"';
1.57      albertel 1212:                     }
1.184     albertel 1213:                     if ($defbgtwo eq '"#FFFF99"') {
                   1214:                         $defbgtwo='"#FFFFDD"';
1.57      albertel 1215:                     } else {
1.184     albertel 1216:                         $defbgtwo='"#FFFF99"';
1.57      albertel 1217:                     }
                   1218:                     my $thistitle='';
                   1219:                     my %name=   ();
                   1220:                     undef %name;
                   1221:                     my %part=   ();
                   1222:                     my %display=();
                   1223:                     my %type=   ();
                   1224:                     my %default=();
                   1225:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1226: 
                   1227:                     foreach (split(/\,/,$keyp{$rid})) {
                   1228:                         my $tempkeyp = $_;
                   1229:                         if (grep $_ eq $tempkeyp, @catmarker) {
                   1230:                           $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
                   1231:                           $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
                   1232:                           $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
                   1233:                           unless ($display{$_}) { $display{$_}=''; }
                   1234:                           $display{$_}.=' ('.$name{$_}.')';
                   1235:                           $default{$_}=&Apache::lonnet::metadata($uri,$_);
                   1236:                           $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
                   1237:                           $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
                   1238:                         }
                   1239:                     }
                   1240:                     my $totalparms=scalar keys %name;
                   1241:                     if ($totalparms>0) {
                   1242:                         my $firstrow=1;
1.180     albertel 1243: 			my $title=&Apache::lonnet::gettitle($uri);
1.57      albertel 1244:                         $r->print('<tr><td bgcolor='.$defbgone.
                   1245:                              ' rowspan='.$totalparms.
                   1246:                              '><tt><font size=-1>'.
                   1247:                              join(' / ',split(/\//,$uri)).
                   1248:                              '</font></tt><p><b>'.
1.154     albertel 1249:                              "<a href=\"javascript:openWindow('".
                   1250: 				  &Apache::lonnet::clutter($uri).
1.57      albertel 1251:                              "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127     albertel 1252:                              " TARGET=_self>$title");
1.57      albertel 1253: 
                   1254:                         if ($thistitle) {
                   1255:                             $r->print(' ('.$thistitle.')');
                   1256:                         }
                   1257:                         $r->print('</a></b></td>');
                   1258:                         $r->print('<td bgcolor='.$defbgtwo.
                   1259:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   1260:                                       '</td>');
                   1261: 
                   1262:                         $r->print('<td bgcolor='.$defbgone.
                   1263:                                       ' rowspan='.$totalparms.
                   1264:                                       '><tt><font size=-1>');
                   1265: 
                   1266:                         $r->print(' / res / ');
                   1267:                         $r->print(join(' / ', split(/\//,$mapp{$rid})));
                   1268: 
                   1269:                         $r->print('</font></tt></td>');
                   1270: 
                   1271:                         foreach (sort keys %name) {
                   1272:                             unless ($firstrow) {
                   1273:                                 $r->print('<tr>');
                   1274:                             } else {
                   1275:                                 undef $firstrow;
                   1276:                             }
                   1277: 
                   1278:                             &print_row($r,$_,\%part,\%name,$rid,\%default,
                   1279:                                        \%type,\%display,$defbgone,$defbgtwo,
1.187     www      1280:                                        $parmlev,$uname,$udom,$csec);
1.57      albertel 1281:                         }
                   1282:                     }
                   1283:                 }
                   1284:             } # end foreach ids
1.43      albertel 1285: # -------------------------------------------------- End entry for one resource
1.57      albertel 1286:             $r->print('</table>');
                   1287:         } # end of  brief/full
                   1288: #--------------------------------------------------- Entry for parm level map
                   1289:         if ($parmlev eq 'map') {
                   1290:             my $defbgone = '"E0E099"';
                   1291:             my $defbgtwo = '"FFFF99"';
                   1292: 
                   1293:             my %maplist;
                   1294: 
                   1295:             if ($pschp eq 'all') {
                   1296:                 %maplist = %allmaps; 
                   1297:             } else {
                   1298:                 %maplist = ($pschp => $mapp{$pschp});
                   1299:             }
                   1300: 
                   1301: #-------------------------------------------- for each map, gather information
                   1302:             my $mapid;
1.60      albertel 1303: 	    foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
                   1304:                 my $maptitle = $maplist{$mapid};
1.57      albertel 1305: 
                   1306: #-----------------------  loop through ids and get all parameter types for map
                   1307: #-----------------------------------------          and associated information
                   1308:                 my %name = ();
                   1309:                 my %part = ();
                   1310:                 my %display = ();
                   1311:                 my %type = ();
                   1312:                 my %default = ();
                   1313:                 my $map = 0;
                   1314: 
                   1315: #		$r->print("Catmarker: @catmarker<br />\n");
                   1316:                
                   1317:                 foreach (@ids) {
                   1318:                   ($map)=(/([\d]*?)\./);
                   1319:                   my $rid = $_;
                   1320:         
                   1321: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   1322: 
                   1323:                   if ($map eq $mapid) {
                   1324:                     my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1325: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   1326: 
                   1327: #--------------------------------------------------------------------
                   1328: # @catmarker contains list of all possible parameters including part #s
                   1329: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1330: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1331: # When storing information, store as part 0
                   1332: # When requesting information, request from full part
                   1333: #-------------------------------------------------------------------
                   1334:                     foreach (split(/\,/,$keyp{$rid})) {
                   1335:                       my $tempkeyp = $_;
                   1336:                       my $fullkeyp = $tempkeyp;
1.73      albertel 1337:                       $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1338:                       
                   1339:                       if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1340:                         $part{$tempkeyp}="0";
                   1341:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1342:                         $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1343:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1344:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1345:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1346:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1347:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1348:                       }
                   1349:                     } # end loop through keys
                   1350:                   }
                   1351:                 } # end loop through ids
                   1352:                                  
                   1353: #---------------------------------------------------- print header information
1.133     www      1354:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      1355:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57      albertel 1356:                 $r->print(<<ENDMAPONE);
                   1357: <center><h4>
1.135     albertel 1358: Set Defaults for All Resources in $foldermap<br />
                   1359: <font color="red"><i>$showtitle</i></font><br />
1.57      albertel 1360: Specifically for
                   1361: ENDMAPONE
                   1362:                 if ($uname) {
                   1363:                     my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1364:                       ('firstname','middlename','lastname','generation', 'id'));
                   1365:                     my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                   1366:                            .$name{'lastname'}.' '.$name{'generation'};
1.135     albertel 1367:                     $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130     www      1368:                         &mt('in')." \n");
1.57      albertel 1369:                 } else {
1.135     albertel 1370:                     $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57      albertel 1371:                 }
                   1372:             
1.135     albertel 1373:                 if ($csec) {$r->print(&mt("Section")." <font color=\"red\"><i>$csec</i></font> ".
1.130     www      1374: 				      &mt('of')." \n")};
1.57      albertel 1375: 
1.135     albertel 1376:                 $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
                   1377:                 $r->print("</h4>\n");
1.57      albertel 1378: #---------------------------------------------------------------- print table
                   1379:                 $r->print('<p><table border="2">');
1.130     www      1380:                 $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1381:                 $r->print('<th>'.&mt('Default Value').'</th>');
                   1382:                 $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1383: 
                   1384: 	        foreach (sort keys %name) {
1.168     matthew  1385:                     $r->print('<tr>');
1.57      albertel 1386:                     &print_row($r,$_,\%part,\%name,$mapid,\%default,
                   1387:                            \%type,\%display,$defbgone,$defbgtwo,
1.187     www      1388:                            $parmlev,$uname,$udom,$csec);
1.57      albertel 1389: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
                   1390:                 }
                   1391:                 $r->print("</table></center>");
                   1392:             } # end each map
                   1393:         } # end of $parmlev eq map
                   1394: #--------------------------------- Entry for parm level general (Course level)
                   1395:         if ($parmlev eq 'general') {
                   1396:             my $defbgone = '"E0E099"';
                   1397:             my $defbgtwo = '"FFFF99"';
                   1398: 
                   1399: #-------------------------------------------- for each map, gather information
                   1400:             my $mapid="0.0";
                   1401: #-----------------------  loop through ids and get all parameter types for map
                   1402: #-----------------------------------------          and associated information
                   1403:             my %name = ();
                   1404:             my %part = ();
                   1405:             my %display = ();
                   1406:             my %type = ();
                   1407:             my %default = ();
                   1408:                
                   1409:             foreach (@ids) {
                   1410:                 my $rid = $_;
                   1411:         
                   1412:                 my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
                   1413: 
                   1414: #--------------------------------------------------------------------
                   1415: # @catmarker contains list of all possible parameters including part #s
                   1416: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   1417: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   1418: # When storing information, store as part 0
                   1419: # When requesting information, request from full part
                   1420: #-------------------------------------------------------------------
                   1421:                 foreach (split(/\,/,$keyp{$rid})) {
                   1422:                   my $tempkeyp = $_;
                   1423:                   my $fullkeyp = $tempkeyp;
1.73      albertel 1424:                   $tempkeyp =~ s/_\w+_/_0_/;
1.57      albertel 1425:                   if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
                   1426:                     $part{$tempkeyp}="0";
                   1427:                     $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   1428:                     $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   1429:                     unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   1430:                     $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73      albertel 1431:                     $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57      albertel 1432:                     $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   1433:                     $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   1434:                   }
                   1435:                 } # end loop through keys
                   1436:             } # end loop through ids
                   1437:                                  
                   1438: #---------------------------------------------------- print header information
1.133     www      1439: 	    my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 1440:             $r->print(<<ENDMAPONE);
1.133     www      1441: <center><h4>$setdef
1.135     albertel 1442: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 1443: ENDMAPONE
                   1444:             if ($uname) {
                   1445:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   1446:                   ('firstname','middlename','lastname','generation', 'id'));
                   1447:                 my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
                   1448:                        .$name{'lastname'}.' '.$name{'generation'};
1.135     albertel 1449:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 1450:             } else {
1.135     albertel 1451:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 1452:             }
                   1453:             
1.135     albertel 1454:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
                   1455:             $r->print("</h4>\n");
1.57      albertel 1456: #---------------------------------------------------------------- print table
                   1457:             $r->print('<p><table border="2">');
1.130     www      1458:             $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
                   1459:             $r->print('<th>'.&mt('Default Value').'</th>');
                   1460:             $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57      albertel 1461: 
                   1462: 	    foreach (sort keys %name) {
1.168     matthew  1463:                 $r->print('<tr>');
1.57      albertel 1464:                 &print_row($r,$_,\%part,\%name,$mapid,\%default,
1.187     www      1465:                        \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
1.57      albertel 1466: #                    $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
                   1467:             }
                   1468:             $r->print("</table></center>");
                   1469:         } # end of $parmlev eq general
1.43      albertel 1470:     }
1.44      albertel 1471:     $r->print('</form></body></html>');
                   1472:     untie(%bighash);
                   1473:     untie(%parmhash);
1.57      albertel 1474: } # end sub assessparms
1.30      www      1475: 
1.59      matthew  1476: 
                   1477: ##################################################
                   1478: ##################################################
                   1479: 
                   1480: =pod
                   1481: 
                   1482: =item crsenv
                   1483: 
1.105     matthew  1484: Show and set course data and parameters.  This is a large routine that should
1.59      matthew  1485: be simplified and shortened... someday.
                   1486: 
                   1487: Inputs: $r
                   1488: 
                   1489: Returns: nothing
                   1490: 
                   1491: =cut
                   1492: 
                   1493: ##################################################
                   1494: ##################################################
1.30      www      1495: sub crsenv {
                   1496:     my $r=shift;
                   1497:     my $setoutput='';
1.64      www      1498:     my $bodytag=&Apache::loncommon::bodytag(
                   1499:                              'Set Course Environment Parameters');
1.45      matthew  1500:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1501:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.105     matthew  1502: 
                   1503:     #
                   1504:     # Go through list of changes
1.38      harris41 1505:     foreach (keys %ENV) {
1.105     matthew  1506:         next if ($_!~/^form\.(.+)\_setparmval$/);
                   1507:         my $name  = $1;
                   1508:         my $value = $ENV{'form.'.$name.'_value'};
                   1509:         if ($name eq 'newp') {
                   1510:             $name = $ENV{'form.newp_name'};
                   1511:         }
                   1512:         if ($name eq 'url') {
                   1513:             $value=~s/^\/res\///;
                   1514:             my $bkuptime=time;
                   1515:             my @tmp = &Apache::lonnet::get
                   1516:                 ('environment',['url'],$dom,$crs);
1.130     www      1517:             $setoutput.=&mt('Backing up previous URL').': '.
1.105     matthew  1518:                 &Apache::lonnet::put
                   1519:                 ('environment',
                   1520:                  {'top level map backup '.$bkuptime => $tmp[1] },
                   1521:                  $dom,$crs).
                   1522:                      '<br>';
                   1523:         }
                   1524:         #
                   1525:         # Deal with modified default spreadsheets
                   1526:         if ($name =~ /^spreadsheet_default_(classcalc|
                   1527:                                             studentcalc|
                   1528:                                             assesscalc)$/x) {
                   1529:             my $sheettype = $1; 
                   1530:             if ($sheettype eq 'classcalc') {
                   1531:                 # no need to do anything since viewing the sheet will
                   1532:                 # cause it to be updated. 
                   1533:             } elsif ($sheettype eq 'studentcalc') {
                   1534:                 # expire all the student spreadsheets
                   1535:                 &Apache::lonnet::expirespread('','','studentcalc');
                   1536:             } else {
                   1537:                 # expire all the assessment spreadsheets 
                   1538:                 #    this includes non-default spreadsheets, but better to
                   1539:                 #    be safe than sorry.
                   1540:                 &Apache::lonnet::expirespread('','','assesscalc');
                   1541:                 # expire all the student spreadsheets
                   1542:                 &Apache::lonnet::expirespread('','','studentcalc');
1.30      www      1543:             }
1.105     matthew  1544:         }
                   1545:         #
1.107     matthew  1546:         # Deal with the enrollment dates
                   1547:         if ($name =~ /^default_enrollment_(start|end)_date$/) {
                   1548:             $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
                   1549:         }
1.178     raeburn  1550:         # Get existing cloners
                   1551:         my @oldcloner = ();
                   1552:         if ($name eq 'cloners') {
                   1553:             my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
                   1554:             if ($clonenames{'cloners'} =~ /,/) {
                   1555:                 @oldcloner = split/,/,$clonenames{'cloners'};
                   1556:             } else {
                   1557:                 $oldcloner[0] = $clonenames{'cloners'};
                   1558:             }
                   1559:         }
1.107     matthew  1560:         #
1.105     matthew  1561:         # Let the user know we made the changes
1.153     albertel 1562:         if ($name && defined($value)) {
1.178     raeburn  1563:             if ($name eq 'cloners') {
                   1564:                 $value =~ s/^,//;
                   1565:                 $value =~ s/,$//;
                   1566:             }
1.105     matthew  1567:             my $put_result = &Apache::lonnet::put('environment',
                   1568:                                                   {$name=>$value},$dom,$crs);
                   1569:             if ($put_result eq 'ok') {
1.130     www      1570:                 $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178     raeburn  1571:                 if ($name eq 'cloners') {
                   1572:                     &change_clone($value,\@oldcloner);
                   1573:                 }
1.179     raeburn  1574:                 # Flush the course logs so course description is immediately updated
                   1575:                 if ($name eq 'description' && defined($value)) {
                   1576:                     &Apache::lonnet::flushcourselogs();
                   1577:                 }
1.105     matthew  1578:             } else {
1.130     www      1579:                 $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
                   1580: 		    ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30      www      1581:             }
                   1582:         }
1.38      harris41 1583:     }
1.108     www      1584: # ------------------------- Re-init course environment entries for this session
                   1585: 
                   1586:     &Apache::lonnet::coursedescription($ENV{'request.course.id'});
1.105     matthew  1587: 
1.30      www      1588: # -------------------------------------------------------- Get parameters again
1.45      matthew  1589: 
                   1590:     my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140     sakharuk 1591:     my $SelectStyleFile=&mt('Select Style File');
1.141     sakharuk 1592:     my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30      www      1593:     my $output='';
1.45      matthew  1594:     if (! exists($values{'con_lost'})) {
1.30      www      1595:         my %descriptions=
1.140     sakharuk 1596: 	    ('url'            => '<b>'.&mt('Top Level Map').'</b> '.
1.46      matthew  1597:                                  '<a href="javascript:openbrowser'.
1.47      matthew  1598:                                  "('envform','url','sequence')\">".
1.140     sakharuk 1599:                                  &mt('Select Map').'</a><br /><font color=red> '.
                   1600:                                  &mt('Modification may make assessment data inaccessible').
                   1601:                                  '</font>',
                   1602:              'description'    => '<b>'.&mt('Course Description').'</b>',
1.158     sakharuk 1603:              'courseid'       => '<b>'.&mt('Course ID or number').
1.140     sakharuk 1604:                                  '</b><br />'.
                   1605:                                  '('.&mt('internal').', '.&mt('optional').')',
1.177     raeburn  1606:              '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      1607:              'grading'        => '<b>'.&mt('Grading').'</b><br />'.
                   1608:                                  '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140     sakharuk 1609:              'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52      www      1610:                     '<a href="javascript:openbrowser'.
                   1611:                     "('envform','default_xml_style'".
1.140     sakharuk 1612:                     ",'sty')\">$SelectStyleFile</a><br>",
1.141     sakharuk 1613:              'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
                   1614:                                  '</b><br />(<tt>user:domain,'.
1.74      www      1615:                                  'user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1616:              'comment.email'  => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74      www      1617:                                  '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1618:              'policy.email'   => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75      albertel 1619:                                  '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141     sakharuk 1620:              'hideemptyrows'  => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158     sakharuk 1621:                                  '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141     sakharuk 1622:              'pageseparators'  => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158     sakharuk 1623:                                  '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141     sakharuk 1624:                                  &mt('changes will not show until next login').')',
1.169     matthew  1625:              '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  1626: 
1.141     sakharuk 1627:              'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
                   1628:                                   '</b><br />"<tt>st</tt>": '.
1.158     sakharuk 1629:                                   &mt('student').', "<tt>ta</tt>": '.
1.118     matthew  1630:                                   'TA, "<tt>in</tt>": '.
1.158     sakharuk 1631:                                   &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118     matthew  1632: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
                   1633:              'plc.users.denied' => 
1.141     sakharuk 1634:                           '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118     matthew  1635:                                  '(<tt>user:domain,user:domain,...</tt>)',
                   1636: 
1.141     sakharuk 1637:              'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
                   1638:                                   '</b><br />"<tt>st</tt>": '.
1.61      albertel 1639:                                   'student, "<tt>ta</tt>": '.
                   1640:                                   'TA, "<tt>in</tt>": '.
1.75      albertel 1641:                                   'instructor;<br /><tt>role,role,...</tt>) '.
1.61      albertel 1642: 	       Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53      www      1643:              'pch.users.denied' => 
1.141     sakharuk 1644:                           '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53      www      1645:                                  '(<tt>user:domain,user:domain,...</tt>)',
1.49      matthew  1646:              'spreadsheet_default_classcalc' 
1.141     sakharuk 1647:                  => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50      matthew  1648:                     '<a href="javascript:openbrowser'.
                   1649:                     "('envform','spreadsheet_default_classcalc'".
1.141     sakharuk 1650:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  1651:              'spreadsheet_default_studentcalc' 
1.141     sakharuk 1652:                  => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50      matthew  1653:                     '<a href="javascript:openbrowser'.
                   1654:                     "('envform','spreadsheet_default_calc'".
1.141     sakharuk 1655:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49      matthew  1656:              'spreadsheet_default_assesscalc' 
1.141     sakharuk 1657:                  => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50      matthew  1658:                     '<a href="javascript:openbrowser'.
                   1659:                     "('envform','spreadsheet_default_assesscalc'".
1.141     sakharuk 1660:                     ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75      albertel 1661: 	     'allow_limited_html_in_feedback'
1.141     sakharuk 1662: 	         => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158     sakharuk 1663: 	            '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170     raeburn  1664:              'allow_discussion_post_editing'
                   1665:                  => '<b>'.&mt('Allow users to edit/delete their own discussion posts').'</b><br />'.
                   1666:                     '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.89      albertel 1667: 	     'rndseed'
1.140     sakharuk 1668: 	         => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
                   1669:                     '<font color="red">'.&mt('Modifying this will make problems').' '.
                   1670:                     &mt('have different numbers and answers').'</font>',
1.151     albertel 1671: 	     'receiptalg'
                   1672: 	         => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
                   1673:                     &mt('This controls how receipt numbers are generated.'),
1.164     sakharuk 1674:              'suppress_tries'
                   1675:                  => '<b>'.&mt('Suppress number of tries in printing').'</b>('.
                   1676:                     &mt('yes if supress').')',
1.113     sakharuk 1677:              'problem_stream_switch'
1.141     sakharuk 1678:                  => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158     sakharuk 1679:                     ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161     sakharuk 1680:              'default_paper_size' 
                   1681:                  => '<b>'.&mt('Default paper type').'</b><br />'.
                   1682:                     ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'. 
                   1683:                     ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'. 
                   1684:                     ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111     sakharuk 1685:              'anonymous_quiz'
1.150     www      1686:                  => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141     sakharuk 1687:                     ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
                   1688:              'default_enrollment_start_date' => '<b>'.&mt('Default beginning date when enrolling students').'</b>',
                   1689:              'default_enrollment_end_date'   => '<b>'.&mt('Default ending date when enrolling students').'</b>',
1.150     www      1690:              'nothideprivileged'   => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
                   1691:                                  '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140     sakharuk 1692:              'languages' => '<b>'.&mt('Languages used').'</b>',
1.115     www      1693:              'disable_receipt_display'
1.141     sakharuk 1694:                  => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158     sakharuk 1695:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163     albertel 1696: 	     'disablesigfigs'
                   1697: 	         => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
                   1698:                     ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.149     albertel 1699: 	     'tthoptions'
                   1700: 	         => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107     matthew  1701:              ); 
1.177     raeburn  1702:         my @Display_Order = ('url','description','courseid','cloners','grading',
1.107     matthew  1703:                              'default_xml_style','pageseparators',
                   1704:                              'question.email','comment.email','policy.email',
1.169     matthew  1705:                              'student_classlist_view',
1.118     matthew  1706:                              'plc.roles.denied','plc.users.denied',
1.107     matthew  1707:                              'pch.roles.denied','pch.users.denied',
                   1708:                              'allow_limited_html_in_feedback',
1.170     raeburn  1709:                              'allow_discussion_post_editing',
1.108     www      1710:                              'languages',
1.150     www      1711: 			     'nothideprivileged',
1.107     matthew  1712:                              'rndseed',
1.151     albertel 1713:                              'receiptalg',
1.107     matthew  1714:                              'problem_stream_switch',
1.164     sakharuk 1715: 			     'suppress_tries',
1.161     sakharuk 1716:                              'default_paper_size',
1.115     www      1717:                              'disable_receipt_display',
1.107     matthew  1718:                              'spreadsheet_default_classcalc',
                   1719:                              'spreadsheet_default_studentcalc',
                   1720:                              'spreadsheet_default_assesscalc', 
                   1721:                              'hideemptyrows',
                   1722:                              'default_enrollment_start_date',
                   1723:                              'default_enrollment_end_date',
1.163     albertel 1724: 			     'tthoptions',
                   1725: 			     'disablesigfigs'
1.107     matthew  1726:                              );
                   1727: 	foreach my $parameter (sort(keys(%values))) {
1.142     raeburn  1728:             unless ($parameter =~ m/^internal\./) {
                   1729:                 if (! $descriptions{$parameter}) {
                   1730:                     $descriptions{$parameter}=$parameter;
                   1731:                     push(@Display_Order,$parameter);
                   1732:                 }
                   1733:             }
1.43      albertel 1734: 	}
1.107     matthew  1735:         foreach my $parameter (@Display_Order) {
                   1736:             my $description = $descriptions{$parameter};
1.51      matthew  1737:             # onchange is javascript to automatically check the 'Set' button.
1.69      www      1738:             my $onchange = 'onFocus="javascript:window.document.forms'.
1.107     matthew  1739:                 "['envform'].elements['".$parameter."_setparmval']".
1.51      matthew  1740:                 '.checked=true;"';
1.107     matthew  1741:             $output .= '<tr><td>'.$description.'</td>';
                   1742:             if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
                   1743:                 $output .= '<td>'.
                   1744:                     &Apache::lonhtmlcommon::date_setter('envform',
                   1745:                                                         $parameter.'_value',
                   1746:                                                         $values{$parameter},
                   1747:                                                         $onchange).
                   1748:                                                         '</td>';
                   1749:             } else {
                   1750:                 $output .= '<td>'.
                   1751:                     &Apache::lonhtmlcommon::textbox($parameter.'_value',
                   1752:                                                     $values{$parameter},
                   1753:                                                     40,$onchange).'</td>';
                   1754:             }
                   1755:             $output .= '<td>'.
                   1756:                 &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
                   1757:                 '</td>';
                   1758:             $output .= "</tr>\n";
1.51      matthew  1759: 	}
1.69      www      1760:         my $onchange = 'onFocus="javascript:window.document.forms'.
1.51      matthew  1761:             '[\'envform\'].elements[\'newp_setparmval\']'.
                   1762:             '.checked=true;"';
1.130     www      1763: 	$output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51      matthew  1764: 	    '<input type="text" size=40 name="newp_name" '.
                   1765:                 $onchange.' /></td><td>'.
                   1766:             '<input type="text" size=40 name="newp_value" '.
                   1767:                 $onchange.' /></td><td>'.
                   1768: 	    '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43      albertel 1769:     }
1.157     sakharuk 1770:     my %lt=&Apache::lonlocal::texthash(
                   1771: 		    'par'   => 'Parameter',
                   1772: 		    'val'   => 'Value',
                   1773: 		    'set'   => 'Set',
                   1774: 		    'sce'   => 'Set Course Environment'
                   1775: 				       );
                   1776: 
1.140     sakharuk 1777:     my $Parameter=&mt('Parameter');
                   1778:     my $Value=&mt('Value');
1.141     sakharuk 1779:     my $Set=&mt('Set');
1.167     albertel 1780:     my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset');
1.183     albertel 1781:     my $html=&Apache::lonxml::xmlbegin();
1.30      www      1782:     $r->print(<<ENDENV);
1.183     albertel 1783: $html
                   1784: <head>
1.46      matthew  1785: <script type="text/javascript" language="Javascript" >
1.155     albertel 1786: $browse_js
1.46      matthew  1787: </script>
1.30      www      1788: <title>LON-CAPA Course Environment</title>
                   1789: </head>
1.64      www      1790: $bodytag
1.30      www      1791: <form method="post" action="/adm/parmset" name="envform">
                   1792: $setoutput
                   1793: <p>
                   1794: <table border=2>
1.157     sakharuk 1795: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30      www      1796: $output
                   1797: </table>
1.157     sakharuk 1798: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30      www      1799: </form>
                   1800: </body>
                   1801: </html>    
                   1802: ENDENV
                   1803: }
1.120     www      1804: ##################################################
1.30      www      1805: 
1.124     www      1806: my $tableopen;
                   1807: 
                   1808: sub tablestart {
                   1809:     if ($tableopen) {
                   1810: 	return '';
                   1811:     } else {
                   1812: 	$tableopen=1;
1.130     www      1813: 	return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
                   1814: 	    &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124     www      1815:     }
                   1816: }
                   1817: 
                   1818: sub tableend {
                   1819:     if ($tableopen) {
                   1820: 	$tableopen=0;
                   1821: 	return '</table>';
                   1822:     } else {
                   1823: 	return'';
                   1824:     }
                   1825: }
                   1826: 
1.120     www      1827: sub overview {
                   1828:     my $r=shift;
                   1829:     my $bodytag=&Apache::loncommon::bodytag(
                   1830:                              'Set/Modify Course Assessment Parameters');
                   1831:     my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1832:     my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.183     albertel 1833:     my $html=&Apache::lonxml::xmlbegin();
1.120     www      1834:     $r->print(<<ENDOVER);
1.183     albertel 1835: $html
1.120     www      1836: <head>
                   1837: <title>LON-CAPA Course Environment</title>
                   1838: </head>
                   1839: $bodytag
1.123     www      1840: <form method="post" action="/adm/parmset" name="overviewform">
1.120     www      1841: <input type="hidden" name="overview" value="1" />
                   1842: ENDOVER
1.124     www      1843: # Setting
                   1844:     my %olddata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   1845:     my %newdata=();
                   1846:     undef %newdata;
                   1847:     my @deldata=();
                   1848:     undef @deldata;
                   1849:     foreach (keys %ENV) {
                   1850: 	if ($_=~/^form\.([a-z]+)\_(.+)$/) {
                   1851: 	    my $cmd=$1;
                   1852: 	    my $thiskey=$2;
                   1853: 	    if ($cmd eq 'set') {
                   1854: 		my $data=$ENV{$_};
                   1855: 		if ($olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
                   1856: 	    } elsif ($cmd eq 'del') {
                   1857: 		push (@deldata,$thiskey);
                   1858: 	    } elsif ($cmd eq 'datepointer') {
                   1859: 		my $data=&Apache::lonhtmlcommon::get_date_from_form($ENV{$_});
1.153     albertel 1860: 		if (defined($data) and $olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
1.124     www      1861: 	    }
                   1862: 	}
                   1863:     }
                   1864: # Store
1.144     www      1865:     my $delentries=$#deldata+1;
                   1866:     my @newdatakeys=keys %newdata;
                   1867:     my $putentries=$#newdatakeys+1;
                   1868:     if ($delentries) {
                   1869: 	if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
                   1870: 	    $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
                   1871: 	} else {
                   1872: 	    $r->print('<h2><font color="red">'.
                   1873: 		      &mt('Error deleting parameters').'</font></h2>');
                   1874: 	}
                   1875:     }
                   1876:     if ($putentries) {
                   1877: 	if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   1878: 	    $r->print('<h2>'.&mt('Stored [_1] parameter(s)</h2>',$putentries));
                   1879: 	} else {
                   1880: 	    $r->print('<h2><font color="red">'.
                   1881: 		      &mt('Error storing parameters').'</font></h2>');
                   1882: 	}
                   1883:     }
1.122     www      1884: # Read and display
                   1885:     my %resourcedata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   1886:     my $oldsection='';
                   1887:     my $oldrealm='';
                   1888:     my $oldpart='';
1.123     www      1889:     my $pointer=0;
1.124     www      1890:     $tableopen=0;
1.145     www      1891:     my $foundkeys=0;
1.122     www      1892:     foreach my $thiskey (sort keys %resourcedata) {
1.123     www      1893: 	if ($resourcedata{$thiskey.'.type'}) {
                   1894: 	    my ($course,$middle,$part,$name)=
                   1895: 		($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130     www      1896: 	    my $section=&mt('All Students');
1.122     www      1897: 	    if ($middle=~/^\[(.*)\]\./) {
1.130     www      1898: 		$section=&mt('Group/Section').': '.$1;
1.122     www      1899: 		$middle=~s/^\[(.*)\]\.//;
                   1900: 	    }
1.123     www      1901: 	    $middle=~s/\.$//;
1.130     www      1902: 	    my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122     www      1903: 	    if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174     albertel 1904: 		$realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122     www      1905: 	    } elsif ($middle) {
1.174     albertel 1906: 		my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   1907: 		$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      1908: 	    }
                   1909: 	    if ($section ne $oldsection) {
1.124     www      1910: 		$r->print(&tableend()."\n<hr /><h1>$section</h1>");
1.122     www      1911: 		$oldsection=$section;
                   1912: 		$oldrealm='';
                   1913: 	    }
                   1914: 	    if ($realm ne $oldrealm) {
1.124     www      1915: 		$r->print(&tableend()."\n<h2>$realm</h2>");
1.122     www      1916: 		$oldrealm=$realm;
                   1917: 		$oldpart='';
                   1918: 	    }
                   1919: 	    if ($part ne $oldpart) {
1.124     www      1920: 		$r->print(&tableend().
1.130     www      1921: 			  "\n<h3><font color='blue'>".&mt('Part').": $part</font></h3>");
1.122     www      1922: 		$oldpart=$part;
                   1923: 	    }
1.123     www      1924: #
                   1925: # Ready to print
                   1926: #
1.124     www      1927: 	    $r->print(&tablestart().'<tr><td><b>'.$name.
                   1928: 		      ':</b></td><td><input type="checkbox" name="del_'.
                   1929: 		      $thiskey.'" /></td><td>');
1.145     www      1930: 	    $foundkeys++;
1.123     www      1931: 	    if ($resourcedata{$thiskey.'.type'}=~/^date/) {
                   1932: 		my $jskey='key_'.$pointer;
                   1933: 		$pointer++;
                   1934: 		$r->print(
                   1935: 			  &Apache::lonhtmlcommon::date_setter('overviewform',
                   1936: 							      $jskey,
                   1937: 						      $resourcedata{$thiskey}).
                   1938: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
                   1939: 			  );
                   1940: 	    } else {
                   1941: 		$r->print(
                   1942: 			  '<input type="text" name="set_'.$thiskey.'" value="'.
                   1943: 			  $resourcedata{$thiskey}.'">');
                   1944: 	    }
1.124     www      1945: 	    $r->print('</td></tr>');
1.122     www      1946: 	}
1.121     www      1947:     }
1.124     www      1948:     
1.145     www      1949:     $r->print(&tableend().'<p>'.
                   1950: 	($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no course or section parameters.')).'</p></form></body></html>');
1.120     www      1951: }
1.121     www      1952: 
1.59      matthew  1953: ##################################################
                   1954: ##################################################
1.178     raeburn  1955:                                                                                             
                   1956: =pod
                   1957:                                                                                             
                   1958: =item change clone
                   1959:                                                                                             
                   1960: Modifies the list of courses a user can clone (stored
                   1961: in the user's environemnt.db file), called when a
                   1962: change is made to the list of users allowed to clone
                   1963: a course.
                   1964:                                                                                             
                   1965: Inputs: $action,$cloner
                   1966: where $action is add or drop, and $cloner is identity of 
                   1967: user for whom cloning ability is to be changed in course. 
                   1968:                                                                                             
                   1969: Returns: 
                   1970: 
                   1971: =cut
                   1972:                                                                                             
                   1973: ##################################################
                   1974: ##################################################
                   1975: 
                   1976: 
                   1977: sub change_clone {
                   1978:     my ($clonelist,$oldcloner) = @_;
                   1979:     my ($uname,$udom);
                   1980:     my $cnum = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
                   1981:     my $cdom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
                   1982:     my $clone_crs = $cnum.':'.$cdom;
                   1983:     
                   1984:     if ($cnum && $cdom) {
                   1985:         my @allowclone = ();
                   1986:         if ($clonelist =~ /,/) {
                   1987:             @allowclone = split/,/,$clonelist;
                   1988:         } else {
                   1989:             $allowclone[0] = $clonelist;
                   1990:         }
                   1991:         foreach my $currclone (@allowclone) {
                   1992:             if (!grep/^$currclone$/,@$oldcloner) {
                   1993:                 ($uname,$udom) = split/:/,$currclone;
                   1994:                 if ($uname && $udom) {
                   1995:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   1996:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   1997:                         if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
                   1998:                             if ($currclonecrs{'cloneable'} eq '') {
                   1999:                                 $currclonecrs{'cloneable'} = $clone_crs;
                   2000:                             } else {
                   2001:                                 $currclonecrs{'cloneable'} .= ','.$clone_crs;
                   2002:                             }
                   2003:                             &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
                   2004:                         }
                   2005:                     }
                   2006:                 }
                   2007:             }
                   2008:         }
                   2009:         foreach my $oldclone (@$oldcloner) {
                   2010:             if (!grep/^$oldclone$/,@allowclone) {
                   2011:                 ($uname,$udom) = split/:/,$oldclone;
                   2012:                 if ($uname && $udom) {
                   2013:                     unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
                   2014:                         my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
                   2015:                         my %newclonecrs = ();
                   2016:                         if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
                   2017:                             if ($currclonecrs{'cloneable'} =~ /,/) {
                   2018:                                 my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
                   2019:                                 foreach (@currclonecrs) {
                   2020:                                     unless ($_ eq $clone_crs) {
                   2021:                                         $newclonecrs{'cloneable'} .= $_.',';
                   2022:                                     }
                   2023:                                 }
                   2024:                                 $newclonecrs{'cloneable'} =~ s/,$//;
                   2025:                             } else {
                   2026:                                 $newclonecrs{'cloneable'} = '';
                   2027:                             }
                   2028:                             &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
                   2029:                         }
                   2030:                     }
                   2031:                 }
                   2032:             }
                   2033:         }
                   2034:     }
                   2035: }
                   2036: 
                   2037: ##################################################
                   2038: ##################################################
1.30      www      2039: 
1.59      matthew  2040: =pod
                   2041: 
1.83      bowersj2 2042: =item * handler
1.59      matthew  2043: 
                   2044: Main handler.  Calls &assessparms and &crsenv subroutines.
                   2045: 
                   2046: =cut
                   2047: 
                   2048: ##################################################
                   2049: ##################################################
1.85      bowersj2 2050:     use Data::Dumper;
1.30      www      2051: sub handler {
1.43      albertel 2052:     my $r=shift;
1.30      www      2053: 
1.43      albertel 2054:     if ($r->header_only) {
1.126     www      2055: 	&Apache::loncommon::content_type($r,'text/html');
1.43      albertel 2056: 	$r->send_http_header;
                   2057: 	return OK;
                   2058:     }
                   2059:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.131     www      2060: 
                   2061: # ----------------------------------------------------------- Clear out garbage
                   2062: 
1.132     albertel 2063:     %courseopt=();
                   2064:     %useropt=();
                   2065:     %parmhash=();
1.131     www      2066: 
1.132     albertel 2067:     @ids=();
                   2068:     %symbp=();
                   2069:     %mapp=();
                   2070:     %typep=();
                   2071:     %keyp=();
1.131     www      2072: 
1.132     albertel 2073:     %maptitles=();
1.83      bowersj2 2074: 
1.30      www      2075: # ----------------------------------------------------- Needs to be in a course
                   2076: 
1.43      albertel 2077:     if (($ENV{'request.course.id'}) && 
1.165     albertel 2078: 	(&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}) || 
                   2079: 	 &Apache::lonnet::allowed('opa',$ENV{'request.course.id'}.'/'.
                   2080: 				  $ENV{'request.course.sec'})
                   2081: 	 )) {
1.106     www      2082: 
1.126     www      2083:         &Apache::loncommon::content_type($r,'text/html');
1.106     www      2084:         $r->send_http_header;
1.30      www      2085: 
1.121     www      2086: 	if (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
1.30      www      2087: # ---------------------------------------------- This is for course environment
1.121     www      2088: # -------------------------- also call if toplevel map coudl not be initialized
                   2089: 	    &crsenv($r);
1.120     www      2090: 	} elsif ($ENV{'form.overview'}) {
1.121     www      2091: # --------------------------------------------------------------- Overview mode
                   2092: 	    &overview($r);
1.43      albertel 2093: 	} else {
1.121     www      2094: # --------------------------------------------------------- Bring up assessment
                   2095: 	    &assessparms($r);
1.43      albertel 2096: 	}
                   2097:     } else {
1.1       www      2098: # ----------------------------- Not in a course, or not allowed to modify parms
1.43      albertel 2099: 	$ENV{'user.error.msg'}=
                   2100: 	    "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   2101: 	return HTTP_NOT_ACCEPTABLE;
                   2102:     }
                   2103:     return OK;
1.1       www      2104: }
                   2105: 
                   2106: 1;
                   2107: __END__
                   2108: 
1.59      matthew  2109: =pod
1.38      harris41 2110: 
                   2111: =back
                   2112: 
                   2113: =cut
1.1       www      2114: 
                   2115: 
                   2116: 

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