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

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

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