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

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

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