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

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

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