loncom/interface/lonparmset.pm - view

File: [LON-CAPA] / loncom / interface / lonparmset.pm
Revision 1.45: download - view: text, annotated - select for diffs
Wed Mar 13 21:24:24 2002 UTC (22 years, 3 months ago) by matthew
Branches: MAIN
CVS tags: HEAD

Replaced lonnet::reply and lonnet::critical with more appropriate wrapper
functions: lonnet::put, lonnet::dump, lonnet::get, lonnet::cput.  Minor
formatting changes.

1: # The LearningOnline Network with CAPA 2: # Handler to set parameters for assessments 3: # 4: # $Id: lonparmset.pm,v 1.45 2002/03/13 21:24:24 matthew Exp $ 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: # 28: # (Handler to resolve ambiguous file locations 29: # 30: # (TeX Content Handler 31: # 32: # YEAR=2000 33: # 05/29/00,05/30,10/11 Gerd Kortemeyer) 34: # 35: # 10/11,10/12,10/16 Gerd Kortemeyer) 36: # 37: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28, 38: # 12/08,12/12, 39: # YEAR=2001 40: # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09, 41: # 07/05,07/06,08/08,08/09,09/01,09/21 Gerd Kortemeyer 42: # 12/17 Scott Harrison 43: # 12/19 Guy Albertelli 44: # 12/26,12/27 Gerd Kortemeyer 45: # 46: ### 47: 48: package Apache::lonparmset; 49: 50: use strict; 51: use Apache::lonnet; 52: use Apache::Constants qw(:common :http REDIRECT); 53: use Apache::loncommon; 54: use GDBM_File; 55: 56: 57: my %courseopt; 58: my %useropt; 59: my %parmhash; 60: 61: my @ids; 62: my %symbp; 63: my %mapp; 64: my %typep; 65: my %keyp; 66: 67: my $uname; 68: my $udom; 69: my $uhome; 70: my $csec; 71: 72: # -------------------------------------------- Figure out a cascading parameter 73: 74: sub parmval { 75: my ($what,$id,$def)=@_; 76: my $result=''; 77: my @outpar=(); 78: # ----------------------------------------------------- Cascading lookup scheme 79: 80: my $symbparm=$symbp{$id}.'.'.$what; 81: my $mapparm=$mapp{$id}.'___(all).'.$what; 82: 83: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what; 84: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm; 85: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm; 86: 87: my $courselevel=$ENV{'request.course.id'}.'.'.$what; 88: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; 89: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; 90: 91: # -------------------------------------------------------- first, check default 92: 93: if ($def) { $outpar[11]=$def; $result=11; } 94: 95: # ----------------------------------------------------- second, check map parms 96: 97: my $thisparm=$parmhash{$symbparm}; 98: if ($thisparm) { $outpar[10]=$thisparm; $result=10; } 99: 100: # --------------------------------------------------------- third, check course 101: 102: if ($courseopt{$courselevel}) { 103: $outpar[9]=$courseopt{$courselevel}; 104: $result=9; 105: } 106: 107: if ($courseopt{$courselevelm}) { 108: $outpar[8]=$courseopt{$courselevelm}; 109: $result=8; 110: } 111: 112: if ($courseopt{$courselevelr}) { 113: $outpar[7]=$courseopt{$courselevelr}; 114: $result=7; 115: } 116: 117: if ($csec) { 118: if ($courseopt{$seclevel}) { 119: $outpar[6]=$courseopt{$seclevel}; 120: $result=6; 121: } 122: if ($courseopt{$seclevelm}) { 123: $outpar[5]=$courseopt{$seclevelm}; 124: $result=5; 125: } 126: 127: if ($courseopt{$seclevelr}) { 128: $outpar[4]=$courseopt{$seclevelr}; 129: $result=4; 130: } 131: } 132: 133: # ---------------------------------------------------------- fourth, check user 134: 135: if ($uname) { 136: if ($useropt{$courselevel}) { 137: $outpar[3]=$useropt{$courselevel}; 138: $result=3; 139: } 140: 141: if ($useropt{$courselevelm}) { 142: $outpar[2]=$useropt{$courselevelm}; 143: $result=2; 144: } 145: 146: if ($useropt{$courselevelr}) { 147: $outpar[1]=$useropt{$courselevelr}; 148: $result=1; 149: } 150: } 151: 152: return ($result,@outpar); 153: } 154: 155: # ------------------------------------------------------------ Output for value 156: 157: sub valout { 158: my ($value,$type)=@_; 159: return ($value?(($type=~/^date/)?localtime($value):$value):'  '); 160: } 161: 162: # -------------------------------------------------------- Produces link anchor 163: 164: sub plink { 165: my ($type,$dis,$value,$marker,$return,$call)=@_; 166: my $winvalue=$value; 167: unless ($winvalue) { 168: if ($type=~/^date/) { 169: $winvalue=$ENV{'form.recent_'.$type}; 170: } else { 171: $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]}; 172: } 173: } 174: return 175: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','" 176: .$marker."','".$return."','".$call."'".');">'. 177: &valout($value,$type).'</a><a name="'.$marker.'"></a>'; 178: } 179: 180: 181: sub startpage { 182: my ($r,$id,$udom,$csec,$uname)=@_; 183: $r->content_type('text/html'); 184: $r->send_http_header; 185: $r->print(<<ENDHEAD); 186: <html> 187: <head> 188: <title>LON-CAPA Course Parameters</title> 189: <script> 190: 191: function pclose() { 192: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", 193: "height=350,width=350,scrollbars=no,menubar=no"); 194: parmwin.close(); 195: } 196: 197: function pjump(type,dis,value,marker,ret,call) { 198: document.parmform.pres_marker.value=''; 199: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) 200: +"&value="+escape(value)+"&marker="+escape(marker) 201: +"&return="+escape(ret) 202: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms", 203: "height=350,width=350,scrollbars=no,menubar=no"); 204: 205: } 206: 207: function psub() { 208: pclose(); 209: if (document.parmform.pres_marker.value!='') { 210: document.parmform.action+='#'+document.parmform.pres_marker.value; 211: var typedef=new Array(); 212: typedef=document.parmform.pres_type.value.split('_'); 213: if (document.parmform.pres_type.value!='') { 214: if (typedef[0]=='date') { 215: eval('document.parmform.recent_'+ 216: document.parmform.pres_type.value+ 217: '.value=document.parmform.pres_value.value;'); 218: } else { 219: eval('document.parmform.recent_'+typedef[0]+ 220: '.value=document.parmform.pres_value.value;'); 221: } 222: } 223: document.parmform.submit(); 224: } else { 225: document.parmform.pres_value.value=''; 226: document.parmform.pres_marker.value=''; 227: } 228: } 229: 230: </script> 231: </head> 232: <body bgcolor="#FFFFFF" onUnload="pclose()"> 233: <h1>Set Course Parameters</h1> 234: <form method="post" action="/adm/parmset" name="envform"> 235: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2> 236: <h3>Course Environment</h3> 237: <input type="submit" name="crsenv" value="Set Course Environment"> 238: </form> 239: <form method="post" action="/adm/parmset" name="parmform"> 240: <h3>Course Assessments</h3> 241: <b> 242: Section/Group: 243: <input type="text" value="$csec" size="6" name="csec"> 244: <br> 245: For User 246: <input type="text" value="$uname" size="12" name="uname"> 247: or ID 248: <input type="text" value="$id" size="12" name="id"> 249: at Domain 250: <input type="text" value="$udom" size="6" name="udom"> 251: </b> 252: <input type="hidden" value='' name="pres_value"> 253: <input type="hidden" value='' name="pres_type"> 254: <input type="hidden" value='' name="pres_marker"> 255: ENDHEAD 256: 257: } 258: 259: sub print_row { 260: my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone, 261: $defbgtwo)=@_; 262: my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which}, 263: $rid,$$default{$which}); 264: $r->print("<td bgcolor=".$defbgtwo. 265: '>'.$$part{$which}.'</td><td bgcolor='.$defbgone. 266: '>'.$$display{$which}.'</td>'); 267: my $thismarker=$which; 268: $thismarker=~s/^parameter\_//; 269: my $mprefix=$rid.'&'.$thismarker.'&'; 270: 271: &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display); 272: &print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display); 273: &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 274: &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 275: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 276: if ($csec) { 277: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); 278: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); 279: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display); 280: } 281: if ($uname) { 282: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 283: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 284: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display); 285: } 286: $r->print('<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$$type{$which}).'</td>'); 287: my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}. 288: '.'.$$name{$which},$symbp{$rid}); 289: $r->print('<td bgcolor=#999999><font color=#FFFFFF>'. 290: &valout($sessionval,$$type{$which}).' '. 291: '</font></td>'); 292: $r->print('</tr>'); 293: } 294: 295: sub print_td { 296: my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_; 297: $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).'>'. 298: &plink($$type{$value},$$display{$value},$$outpar[$which], 299: $mprefix."$which",'parmform.pres','psub').'</td>'); 300: } 301: 302: sub assessparms { 303: 304: my $r=shift; 305: # -------------------------------------------------------- Variable declaration 306: my %allkeys; 307: my %allmaps; 308: my %defp; 309: %courseopt=(); 310: %useropt=(); 311: my %bighash=(); 312: 313: @ids=(); 314: %symbp=(); 315: %typep=(); 316: 317: my $message=''; 318: 319: $csec=$ENV{'form.csec'}; 320: $udom=$ENV{'form.udom'}; 321: unless ($udom) { $udom=$r->dir_config('lonDefDomain'); } 322: 323: my $pscat=$ENV{'form.pscat'}; 324: my $pschp=$ENV{'form.pschp'}; 325: my $pssymb=''; 326: 327: # ----------------------------------------------- Was this started from grades? 328: 329: if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'}) 330: && (!$ENV{'form.dis'})) { 331: my $url=$ENV{'form.url'}; 332: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--; 333: $pssymb=&Apache::lonnet::symbread($url); 334: $pscat='all'; 335: $pschp=''; 336: } elsif ($ENV{'form.symb'}) { 337: $pssymb=$ENV{'form.symb'}; 338: $pscat='all'; 339: $pschp=''; 340: } else { 341: $ENV{'form.url'}=''; 342: } 343: 344: my $id=$ENV{'form.id'}; 345: if (($id) && ($udom)) { 346: $uname=(&Apache::lonnet::idget($udom,$id))[1]; 347: if ($uname) { 348: $id=''; 349: } else { 350: $message= 351: "<font color=red>Unknown ID '$id' at domain '$udom'</font>"; 352: } 353: } else { 354: $uname=$ENV{'form.uname'}; 355: } 356: unless ($udom) { $uname=''; } 357: $uhome=''; 358: if ($uname) { 359: $uhome=&Apache::lonnet::homeserver($uname,$udom); 360: if ($uhome eq 'no_host') { 361: $message= 362: "<font color=red>Unknown user '$uname' at domain '$udom'</font>"; 363: $uname=''; 364: } else { 365: $csec=&Apache::lonnet::usection($udom,$uname, 366: $ENV{'request.course.id'}); 367: if ($csec eq '-1') { 368: $message="<font color=red>". 369: "User '$uname' at domain '$udom' not ". 370: "in this course</font>"; 371: $uname=''; 372: $csec=$ENV{'form.csec'}; 373: } else { 374: my %name=&Apache::lonnet::userenvironment($udom,$uname, 375: ('firstname','middlename','lastname','generation','id')); 376: $message="\n<p>\nFull Name: ". 377: $name{'firstname'}.' '.$name{'middlename'}.' ' 378: .$name{'lastname'}.' '.$name{'generation'}. 379: "<br>\nID: ".$name{'id'}.'<p>'; 380: } 381: } 382: } 383: 384: unless ($csec) { $csec=''; } 385: 386: my $fcat=$ENV{'form.fcat'}; 387: unless ($fcat) { $fcat=''; } 388: 389: # ------------------------------------------------------------------- Tie hashs 390: if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', 391: &GDBM_READER,0640))) { 392: $r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)"); 393: return ; 394: } 395: if (!(tie(%parmhash,'GDBM_File', 396: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { 397: $r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)"); 398: return ; 399: } 400: # --------------------------------------------------------- Get all assessments 401: foreach (keys %bighash) { 402: if ($_=~/^src\_(\d+)\.(\d+)$/) { 403: my $mapid=$1; 404: my $resid=$2; 405: my $id=$mapid.'.'.$resid; 406: my $srcf=$bighash{$_}; 407: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) { 408: $ids[$#ids+1]=$id; 409: $typep{$id}=$1; 410: $keyp{$id}=''; 411: foreach (split(/\,/, 412: &Apache::lonnet::metadata($srcf,'keys'))) { 413: if ($_=~/^parameter\_(.*)/) { 414: my $key=$_; 415: my $allkey=$1; 416: $allkey=~s/\_/\./; 417: my $display= 418: &Apache::lonnet::metadata($srcf,$key.'.display'); 419: unless ($display) { 420: $display= 421: &Apache::lonnet::metadata($srcf,$key.'.name'); 422: } 423: $allkeys{$allkey}=$display; 424: if ($allkey eq $fcat) { 425: $defp{$id}= 426: &Apache::lonnet::metadata($srcf,$key); 427: } 428: if ($keyp{$id}) { 429: $keyp{$id}.=','.$key; 430: } else { 431: $keyp{$id}=$key; 432: } 433: } 434: } 435: $mapp{$id}= 436: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); 437: $allmaps{$mapid}=$mapp{$id}; 438: $symbp{$id}=$mapp{$id}. 439: '___'.$resid.'___'. 440: &Apache::lonnet::declutter($srcf); 441: } 442: } 443: } 444: # ---------------------------------------------------------- Anything to store? 445: if ($ENV{'form.pres_marker'}) { 446: my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'}); 447: $spnam=~s/\_([^\_]+)$/\.$1/; 448: # ---------------------------------------------------------- Construct prefixes 449: 450: my $symbparm=$symbp{$sresid}.'.'.$spnam; 451: my $mapparm=$mapp{$sresid}.'___(all).'.$spnam; 452: 453: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam; 454: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm; 455: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm; 456: 457: my $courselevel=$ENV{'request.course.id'}.'.'.$spnam; 458: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm; 459: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm; 460: 461: my $storeunder=''; 462: if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; } 463: if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; } 464: if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; } 465: if ($snum==6) { $storeunder=$seclevel; } 466: if ($snum==5) { $storeunder=$seclevelm; } 467: if ($snum==4) { $storeunder=$seclevelr; } 468: 469: my %storecontent = ($storeunder => $ENV{'form.pres_value'}, 470: $storeunder.'type' => $ENV{'form.pres_type'}); 471: my $reply=''; 472: if ($snum>3) { 473: # ---------------------------------------------------------------- Store Course 474: # 475: # Expire sheets 476: &Apache::lonnet::expirespread('','','studentcalc'); 477: if (($snum==7) || ($snum==4)) { 478: &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid}); 479: } elsif (($snum==8) || ($snum==5)) { 480: &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid}); 481: } else { 482: &Apache::lonnet::expirespread('','','assesscalc'); 483: } 484: # Store parameter 485: $reply=&Apache::lonnet::cput 486: ('resourcedata',\%storecontent, 487: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 488: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 489: } else { 490: # ------------------------------------------------------------------ Store User 491: # 492: # Expire sheets 493: &Apache::lonnet::expirespread($uname,$udom,'studentcalc'); 494: if ($snum==1) { 495: &Apache::lonnet::expirespread 496: ($uname,$udom,'assesscalc',$symbp{$sresid}); 497: } elsif ($snum==2) { 498: &Apache::lonnet::expirespread 499: ($uname,$udom,'assesscalc',$mapp{$sresid}); 500: } else { 501: &Apache::lonnet::expirespread($uname,$udom,'assesscalc'); 502: } 503: # Store parameter 504: $reply=&Apache::lonnet::cput 505: ('resourcedata',\%storecontent,$udom,$uname); 506: } 507: 508: if ($reply=~/^error\:(.*)/) { 509: $message.="<font color=red>Write Error: $1</font>"; 510: } 511: # ---------------------------------------------------------------- Done storing 512: } 513: # -------------------------------------------------------------- Get coursedata 514: %courseopt = &Apache::lonnet::dump 515: ('resourcedata', 516: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, 517: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}); 518: # --------------------------------------------------- Get userdata (if present) 519: if ($uname) { 520: %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname); 521: } 522: 523: # ------------------------------------------------------------------- Sort this 524: 525: @ids=sort { 526: if ($fcat eq '') { 527: $a<=>$b; 528: } else { 529: my ($result,@outpar)=&parmval($fcat,$a,$defp{$a}); 530: my $aparm=$outpar[$result]; 531: ($result,@outpar)=&parmval($fcat,$b,$defp{$b}); 532: my $bparm=$outpar[$result]; 533: 1*$aparm<=>1*$bparm; 534: } 535: } @ids; 536: 537: # ------------------------------------------------------------------ Start page 538: &startpage($r,$id,$udom,$csec,$uname); 539: # if ($ENV{'form.url'}) { 540: # $r->print('<input type="hidden" value="'.$ENV{'form.url'}. 541: # '" name="url"><input type="hidden" name="command" value="set">'); 542: # } 543: foreach ('tolerance','date_default','date_start','date_end', 544: 'date_interval','int','float','string') { 545: $r->print('<input type="hidden" value="'. 546: $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">'); 547: } 548: 549: $r->print('<h2>'.$message.'</h2><table><tr><td>Sort list by</td><td>'); 550: $r->print('<select name="fcat">'); 551: $r->print('<option value="">Enclosing Map</option>'); 552: foreach (reverse sort keys %allkeys) { 553: $r->print('<option value="'.$_.'"'); 554: if ($fcat eq $_) { $r->print(' selected'); } 555: $r->print('>'.$allkeys{$_}.'</option>'); 556: } 557: if (!$pssymb) { 558: $r->print('</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>'); 559: $r->print('<option value=all>All Maps</option>'); 560: foreach (keys %allmaps) { 561: $r->print('<option value="'.$_.'"'); 562: if (($pssymb=~/^$allmaps{$_}/) || 563: ($pschp eq $_)) { $r->print(' selected'); } 564: $r->print('>'.$allmaps{$_}.'</option>'); 565: } 566: } else { 567: my ($map,$id,$resource)=split(/___/,$pssymb); 568: $r->print('<tr><td>Specfic Resource</td><td> </td></tr>'); 569: $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">'); 570: } 571: $r->print('</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>'); 572: $r->print('<option value=all>All Parameters</option>'); 573: foreach (reverse sort keys %allkeys) { 574: $r->print('<option value="'.$_.'"'); 575: if ($pscat eq $_) { $r->print(' selected'); } 576: $r->print('>'.$allkeys{$_}.'</option>'); 577: } 578: $r->print('</select></td></tr></table><br><input name=dis type="submit" value="Display">'); 579: if (($pscat) || ($pschp) || ($pssymb)) { 580: # ----------------------------------------------------------------- Start Table 581: my $catmarker='parameter_'.$pscat; 582: $catmarker=~s/\./\_/g; 583: my $coursespan=$csec?8:5; 584: my $csuname=$ENV{'user.name'}; 585: my $csudom=$ENV{'user.domain'}; 586: $r->print(<<ENDTABLEHEAD); 587: <p><table border=2> 588: <tr><td colspan=5></td> 589: <th colspan=$coursespan>Any User</th> 590: ENDTABLEHEAD 591: if ($uname) { 592: $r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>"); 593: } 594: $r->print(<<ENDTABLETWO); 595: <th rowspan=3>Parameter in Effect</th> 596: <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th> 597: </tr><tr><td colspan=5></td> 598: <th colspan=2>Resource Level</th> 599: <th colspan=3>in Course</th> 600: ENDTABLETWO 601: if ($csec) { 602: $r->print("<th colspan=3>in Section/Group $csec</th>"); 603: } 604: $r->print(<<ENDTABLEHEADFOUR); 605: </tr><tr><th>Assessment URL and Title</th><th>Type</th> 606: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th> 607: <th>default</th><th>from Enclosing Map</th> 608: <th>general</th><th>for Enclosing Map</th><th>for Resource</th> 609: ENDTABLEHEADFOUR 610: if ($csec) { 611: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); 612: } 613: if ($uname) { 614: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); 615: } 616: $r->print('</tr>'); 617: my $defbgone=''; 618: my $defbgtwo=''; 619: foreach (@ids) { 620: my $rid=$_; 621: my ($inmapid)=($rid=~/\.(\d+)$/); 622: if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) || 623: ($pssymb eq $symbp{$rid})) { 624: # ------------------------------------------------------ Entry for one resource 625: if ($defbgone eq '"E0E099"') { 626: $defbgone='"E0E0DD"'; 627: } else { 628: $defbgone='"E0E099"'; 629: } 630: if ($defbgtwo eq '"FFFF99"') { 631: $defbgtwo='"FFFFDD"'; 632: } else { 633: $defbgtwo='"FFFF99"'; 634: } 635: my $thistitle=''; 636: my %name= (); 637: undef %name; 638: my %part= (); 639: my %display=(); 640: my %type= (); 641: my %default=(); 642: my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid}); 643: 644: foreach (split(/\,/,$keyp{$rid})) { 645: if (($_ eq $catmarker) || ($pscat eq 'all')) { 646: $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part'); 647: $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name'); 648: $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display'); 649: unless ($display{$_}) { $display{$_}=''; } 650: $display{$_}.=' ('.$name{$_}.')'; 651: $default{$_}=&Apache::lonnet::metadata($uri,$_); 652: $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type'); 653: $thistitle=&Apache::lonnet::metadata($uri,$_.'.title'); 654: } 655: } 656: my $totalparms=scalar keys %name; 657: if ($totalparms>0) { 658: my $firstrow=1; 659: $r->print('<tr><td bgcolor='.$defbgone. 660: ' rowspan='.$totalparms.'><tt><font size=-1>'. 661: join(' / ',split(/\//,$uri)). 662: '</font></tt><p><b>'. 663: $bighash{'title_'.$rid}); 664: if ($thistitle) { 665: $r->print(' ('.$thistitle.')'); 666: } 667: $r->print('</b></td>'); 668: $r->print('<td bgcolor='.$defbgtwo. 669: ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>'); 670: $r->print('<td bgcolor='.$defbgone. 671: ' rowspan='.$totalparms.'><tt><font size=-1>'. 672: join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>'); 673: foreach (sort keys %name) { 674: unless ($firstrow) { 675: $r->print('<tr>'); 676: } else { 677: $firstrow=0; 678: } 679: &print_row($r,$_,\%part,\%name,$rid,\%default, 680: \%type,\%display,$defbgone,$defbgtwo); 681: } 682: } 683: # -------------------------------------------------- End entry for one resource 684: } 685: } 686: $r->print('</table>'); 687: } 688: $r->print('</form></body></html>'); 689: untie(%bighash); 690: untie(%parmhash); 691: } 692: 693: # Set course environment parameters 694: sub crsenv { 695: my $r=shift; 696: my $setoutput=''; 697: my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}; 698: my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'}; 699: # -------------------------------------------------- Go through list of changes 700: foreach (keys %ENV) { 701: if ($_=~/^form\.(.+)\_setparmval$/) { 702: my $name=$1; 703: my $value=$ENV{'form.'.$name.'_value'}; 704: if ($name eq 'newp') { 705: $name=$ENV{'form.newp_name'}; 706: } 707: if ($name eq 'url') { 708: $value=~s/^\/res\///; 709: my @tmp = &Apache::lonnet::get 710: ('environment',['url'],$dom,$crs); 711: $setoutput.='Backing up previous URL: '. 712: &Apache::lonnet::put 713: ('environment', 714: {'top level map backup ' => $tmp[1] }, 715: $dom,$crs). 716: '<br>'; 717: } 718: if ($name) { 719: $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'. 720: $value.'</tt>: '. 721: &Apache::lonnet::put 722: ('environment',{$name=>$value},$dom,$crs). 723: '<br>'; 724: } 725: } 726: } 727: # -------------------------------------------------------- Get parameters again 728: 729: my %values=&Apache::lonnet::dump('environment',$dom,$crs); 730: my $output=''; 731: if (! exists($values{'con_lost'})) { 732: my %descriptions= 733: ('url' => '<b>Top Level Map</b><br><font color=red> '. 734: 'Modification may make assessment data '. 735: 'inaccessible</font>', 736: 'description' => '<b>Course Description</b>', 737: 'courseid' => '<b>Course ID or number</b><br>'. 738: '(internal, optional)', 739: 'question.email' => '<b>Feedback Addresses for Content '. 740: 'Questions</b><br>(<tt>user:domain,'. 741: 'user:domain,...</tt>)', 742: 'comment.email' => '<b>Feedback Addresses for Comments</b><br>'. 743: '(<tt>user:domain,user:domain,...</tt>)', 744: 'policy.email' => '<b>Feedback Addresses for Course Policy</b>'. 745: '<br>(<tt>user:domain,user:domain,...</tt>)', 746: 'hideemptyrows' => '<b>Hide Empty Rows in Spreadsheets</b><br>'. 747: '("<tt>yes</tt>" for default hiding)', 748: 'pch.roles.denied'=> '<b>Disallow Resource Discussion for '. 749: 'Students</b><br>"<tt>st</tt>": '. 750: 'student, "<tt>ta</tt>": '. 751: 'TA, "<tt>in</tt>": '. 752: 'instructor;<br><tt>role,role,...</tt>)' 753: ); 754: foreach (keys(%values)) { 755: unless ($descriptions{$_}) { 756: $descriptions{$_}=$_; 757: } 758: } 759: foreach (sort keys %descriptions) { 760: $output.='<tr><td>'.$descriptions{$_}.'</td><td><input name="'. 761: $_.'_value" size=40 value="'. 762: $values{$_}.'"></td><td><input type=checkbox name="'. 763: $_.'_setparmval"></td></tr>'; 764: } 765: $output.='<tr><td><i>Create New Environment Variable</i><br>'. 766: '<input type="text" size=40 name="newp_name" ></td><td>'. 767: '<input type="text" size=40 name="newp_value" ></td><td>'. 768: '<input type="checkbox" name="newp_setparmval"></td></tr>'; 769: } 770: $r->print(<<ENDENV); 771: <html> 772: <head> 773: <title>LON-CAPA Course Environment</title> 774: </head> 775: <body bgcolor="#FFFFFF"> 776: <h1>Set Course Parameters</h1> 777: <form method="post" action="/adm/parmset" name="envform"> 778: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2> 779: <h3>Course Environment</h3> 780: $setoutput 781: <p> 782: <table border=2> 783: <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr> 784: $output 785: </table> 786: <input type="submit" name="crsenv" value="Set Course Environment"> 787: </form> 788: </body> 789: </html> 790: ENDENV 791: } 792: 793: # ================================================================ Main Handler 794: 795: sub handler { 796: my $r=shift; 797: 798: if ($r->header_only) { 799: $r->content_type('text/html'); 800: $r->send_http_header; 801: return OK; 802: } 803: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'}); 804: # ----------------------------------------------------- Needs to be in a course 805: 806: if (($ENV{'request.course.id'}) && 807: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { 808: 809: unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) { 810: # --------------------------------------------------------- Bring up assessment 811: &assessparms($r); 812: # ---------------------------------------------- This is for course environment 813: } else { 814: &crsenv($r); 815: } 816: } else { 817: # ----------------------------- Not in a course, or not allowed to modify parms 818: $ENV{'user.error.msg'}= 819: "/adm/parmset:opa:0:0:Cannot modify assessment parameters"; 820: return HTTP_NOT_ACCEPTABLE; 821: } 822: return OK; 823: } 824: 825: 1; 826: __END__ 827: 828: 829: =head1 NAME 830: 831: Apache::lonparmset - Handler to set parameters for assessments 832: 833: =head1 SYNOPSIS 834: 835: Invoked by /etc/httpd/conf/srm.conf: 836: 837: <Location /adm/parmset> 838: PerlAccessHandler Apache::lonacc 839: SetHandler perl-script 840: PerlHandler Apache::lonparmset 841: ErrorDocument 403 /adm/login 842: ErrorDocument 406 /adm/roles 843: ErrorDocument 500 /adm/errorhandler 844: </Location> 845: 846: =head1 INTRODUCTION 847: 848: This module sets assessment parameters. 849: 850: This is part of the LearningOnline Network with CAPA project 851: described at http://www.lon-capa.org. 852: 853: =head1 HANDLER SUBROUTINE 854: 855: This routine is called by Apache and mod_perl. 856: 857: =over 4 858: 859: =item * 860: 861: need to be in course 862: 863: =item * 864: 865: bring up assessment screen or course environment 866: 867: =back 868: 869: =head1 OTHER SUBROUTINES 870: 871: =over 4 872: 873: =item * 874: 875: parmval() : figure out a cascading parameter 876: 877: =item * 878: 879: valout() : format a value for output 880: 881: =item * 882: 883: plink() : produces link anchor 884: 885: =item * 886: 887: assessparms() : show assess data and parameters 888: 889: =item * 890: 891: crsenv() : for the course environment 892: 893: =back 894: 895: =cut 896: 897: 898:

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.