loncom/interface/lonparmset.pm - view

File: [LON-CAPA] / loncom / interface / lonparmset.pm
Revision 1.10: download - view: text, annotated - select for diffs
Fri Nov 24 20:00:27 2000 UTC (23 years, 6 months ago) by www
Branches: MAIN
CVS tags: HEAD

New cascading parameter scheme and clearer table

1: # The LearningOnline Network with CAPA 2: # Handler to set parameters for assessments 3: # 4: # (Handler to resolve ambiguous file locations 5: # 6: # (TeX Content Handler 7: # 8: # 05/29/00,05/30,10/11 Gerd Kortemeyer) 9: # 10: # 10/11,10/12,10/16 Gerd Kortemeyer) 11: # 12: # 11/20,11/21,11/22,11/23,11/24,11/25 Gerd Kortemeyer 13: 14: package Apache::lonparmset; 15: 16: use strict; 17: use Apache::lonnet; 18: use Apache::Constants qw(:common :http REDIRECT); 19: use GDBM_File; 20: use Apache::lonmeta; 21: 22: 23: my %courseopt; 24: my %useropt; 25: my %bighash; 26: my %parmhash; 27: 28: my @outpar; 29: 30: my @ids; 31: my %symbp; 32: my %mapp; 33: my %typep; 34: 35: my $uname; 36: my $udom; 37: my $uhome; 38: 39: my $csec; 40: 41: my $fcat; 42: 43: # -------------------------------------------- Figure out a cascading parameter 44: 45: sub parmval { 46: my ($what,$id)=@_; 47: my $result=''; 48: # ----------------------------------------------------- Cascading lookup scheme 49: 50: my $symbparm=$symbp{$id}.'.'.$what; 51: my $mapparm=$mapp{$id}.'___(all).'.$what; 52: 53: my $seclevel= 54: $ENV{'request.course.id'}.'.['. 55: $ENV{'request.course.sec'}.'].'.$what; 56: my $seclevelr= 57: $ENV{'request.course.id'}.'.['. 58: $ENV{'request.course.sec'}.'].'.$symbparm; 59: my $seclevelm= 60: $ENV{'request.course.id'}.'.['. 61: $ENV{'request.course.sec'}.'].'.$mapparm; 62: 63: my $courselevel= 64: $ENV{'request.course.id'}.'.'.$what; 65: my $courselevelr= 66: $ENV{'request.course.id'}.'.'.$symbparm; 67: my $courselevelm= 68: $ENV{'request.course.id'}.'.'.$mapparm; 69: 70: # ----------------------------------------------------------- first, check user 71: 72: if ($uname) { 73: if ($useropt{$courselevelr}) { $outpar[1]=$useropt{$courselevelr}; 74: $result=1; } 75: if ($useropt{$courselevelm}) { $outpar[2]=$useropt{$courselevelm}; 76: $result=2; } 77: if ($useropt{$courselevel}) { $outpar[3]=$useropt{$courselevel}; 78: $result=3; } 79: } 80: 81: # -------------------------------------------------------- second, check course 82: 83: if ($courseopt{$seclevelr}) { $outpar[4]=$courseopt{$seclevelr}; 84: $result=4; } 85: if ($courseopt{$seclevelm}) { $outpar[5]=$courseopt{$seclevelm}; 86: $result=5; } 87: if ($courseopt{$seclevel}) { $outpar[6]=$courseopt{$seclevel}; 88: $result=6; } 89: 90: if ($courseopt{$courselevelr}) { $outpar[7]=$courseopt{$courselevelr}; 91: $result=7; } 92: if ($courseopt{$courselevelm}) { $outpar[8]=$courseopt{$courselevelm}; 93: $result=8; } 94: if ($courseopt{$courselevel}) { $outpar[9]=$courseopt{$courselevel}; 95: $result=9; } 96: 97: # ------------------------------------------------------ third, check map parms 98: 99: my $thisparm=$parmhash{$symbparm}; 100: if ($thisparm) { $outpar[10]=$thisparm; 101: $result=10; } 102: 103: # --------------------------------------------- last, look in resource metadata 104: 105: my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta'; 106: if (-e $filename) { 107: my @content; 108: { 109: my $fh=Apache::File->new($filename); 110: @content=<$fh>; 111: } 112: if (join('',@content)=~ 113: /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) { 114: $outpar[11]=$1; 115: $result=11; 116: } 117: } 118: return $result; 119: } 120: 121: # ---------------------------------------------------------------- Sort routine 122: 123: sub bycat { 124: if ($fcat eq '') { 125: $a<=>$b; 126: } else { 127: &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b); 128: } 129: } 130: 131: # ------------------------------------------------------------ Output for value 132: 133: sub valout { 134: my ($value,$type)=@_; 135: return 136: ($value?(($type=~/^date/)?localtime($value):$value):'  '); 137: } 138: 139: # -------------------------------------------------------- Produces link anchor 140: 141: sub plink { 142: my ($type,$dis,$value,$marker,$return,$call)=@_; 143: return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','" 144: .$marker."','".$return."','".$call."'".');">'. 145: &valout($value,$type).'</a>'; 146: } 147: 148: # ================================================================ Main Handler 149: 150: sub handler { 151: my $r=shift; 152: 153: if ($r->header_only) { 154: $r->content_type('text/html'); 155: $r->send_http_header; 156: return OK; 157: } 158: 159: # ----------------------------------------------------- Needs to be in a course 160: 161: if (($ENV{'request.course.fn'}) && 162: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) { 163: # -------------------------------------------------------- Variable declaration 164: 165: %courseopt=(); 166: %useropt=(); 167: %bighash=(); 168: 169: @ids=(); 170: %symbp=(); 171: %typep=(); 172: 173: $uname=$ENV{'form.uname'}; 174: $udom=$ENV{'form.udom'}; 175: unless ($udom) { $uname=''; } 176: $uhome=''; 177: my $message=''; 178: if ($uname) { 179: $uhome=&Apache::lonnet::homeserver($uname,$udom); 180: } 181: if ($uhome eq 'no_host') { 182: $message= 183: "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>"; 184: $uname=''; 185: } 186: 187: $csec=$ENV{'form.csec'}; 188: unless ($csec) { $csec=''; } 189: $fcat=$ENV{'form.fcat'}; 190: unless ($fcat) { $fcat=''; } 191: 192: # ------------------------------------------------------------------- Tie hashs 193: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', 194: &GDBM_READER,0640)) && 195: (tie(%parmhash,'GDBM_File', 196: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) { 197: 198: # -------------------------------------------------------------- Get coursedata 199: my $reply=&Apache::lonnet::reply('dump:'. 200: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'. 201: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata', 202: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}); 203: if ($reply!~/^error\:/) { 204: map { 205: my ($name,$value)=split(/\=/,$_); 206: $courseopt{unescape($name)}=unescape($value); 207: } split(/\&/,$reply); 208: } 209: # --------------------------------------------------- Get userdata (if present) 210: if ($uname) { 211: my $reply= 212: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome); 213: if ($reply!~/^error\:/) { 214: map { 215: my ($name,$value)=split(/\=/,$_); 216: $useropt{unescape($name)}=unescape($value); 217: } split(/\&/,$reply); 218: } 219: } 220: # --------------------------------------------------------- Get all assessments 221: map { 222: if ($_=~/^src\_(\d+)\.(\d+)$/) { 223: my $mapid=$1; 224: my $resid=$2; 225: my $id=$mapid.'.'.$resid; 226: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) { 227: $ids[$#ids+1]=$id; 228: $typep{$id}=$1; 229: $mapp{$id}= 230: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}); 231: $symbp{$id}=$mapp{$id}. 232: '___'.$resid.'___'. 233: &Apache::lonnet::declutter($bighash{$_}); 234: } 235: } 236: } keys %bighash; 237: # ------------------------------------------------------------------- Sort this 238: @ids=sort bycat @ids; 239: # ------------------------------------------------------------------ Start page 240: $r->content_type('text/html'); 241: $r->send_http_header; 242: $r->print(<<ENDHEAD); 243: <html> 244: <head> 245: <title>LON-CAPA Assessment Parameters</title> 246: <script> 247: function pclose() { 248: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms", 249: "height=350,width=350,scrollbars=no,menubar=no"); 250: parmwin.close(); 251: } 252: 253: function pjump(type,dis,value,marker,ret,call) { 254: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type) 255: +"&value="+escape(value)+"&marker="+escape(marker) 256: +"&return="+escape(ret) 257: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms", 258: "height=350,width=350,scrollbars=no,menubar=no"); 259: 260: } 261: </script> 262: </head> 263: <body bgcolor="#FFFFFF" onUnload="pclose()"> 264: <h1>Set Assessment Parameters</h1> 265: <form method="post" action="/adm/parmset" name="parmform"> 266: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2> 267: <b> 268: Section/Group: 269: <input type="text" value="$csec" size="6" name="csec" 270: onBlur="this.form.submit();"> 271: <br> 272: For User 273: <input type="text" value="$uname" size="12" name="uname" 274: onBlur="if (this.form.udom.value) { this.form.submit(); }"> 275: at Domain 276: <input type="text" value="$udom" size="6" name="udom" 277: onBlur="if (this.form.uname.value) { this.form.submit(); }"> 278: </b> 279: ENDHEAD 280: 281: if ($uhome eq 'no_host') { 282: $r->print($message); 283: } 284: $r->print('<p>Sort list by '); 285: $r->print('<select name="fcat" onChange="this.form.submit();">'); 286: my $k; 287: my @sopt=('map','Map','name','Problem Name','deadline','Deadline'); 288: for ($k=0;$k<$#sopt;$k=$k+2) { 289: $r->print('<option value="'.$sopt[$k].'"'); 290: if ($fcat eq $sopt[$k]) { $r->print(' selected'); } 291: $r->print('>'.$sopt[$k+1].'</option>'); 292: } 293: $r->print('</select>'); 294: # ----------------------------------------------------------------- Start Table 295: my $coursespan=$csec?8:5; 296: $r->print(<<ENDTABLEHEAD); 297: <p><table border=2> 298: <tr><td colspan=4></td> 299: <th colspan=$coursespan>Any User</th> 300: ENDTABLEHEAD 301: if ($uname) { 302: $r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>"); 303: } 304: $r->print(<<ENDTABLETWO); 305: </tr><tr><td colspan=4></td> 306: <th colspan=2>Resource Level</th> 307: <th colspan=3>in Course</th> 308: ENDTABLETWO 309: if ($csec) { 310: $r->print("<th colspan=3>in Section/Group $csec</th>"); 311: } 312: $r->print('</tr><tr>'); 313: $r->print(<<ENDTABLEHEADFOUR); 314: <tr><th>Assessment URL and Title</th> 315: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th> 316: <th>from Metadata</th><th>from Enclosing Map</th> 317: <th>general</th><th>for Enclosing Map</th><th>for Resource</th> 318: ENDTABLEHEADFOUR 319: if ($csec) { 320: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); 321: } 322: if ($uname) { 323: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>'); 324: } 325: $r->print('</tr><tr>'); 326: map { 327: # ------------------------------------------------------ Entry for one resource 328: @outpar=(); 329: my $rid=$_; 330: my $thistitle=''; 331: my @part=(0,1,1); 332: my @name=('deadline','sig','tol'); 333: my @display=('Deadline','Significant Figures','Tolerance'); 334: my @type=('date','int','tolerance'); 335: my %metadata=&Apache::lonmeta::unpackagemeta( 336: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1); 337: map { 338: if ($_=~/^parameter\_(\d+)\_(\w+)$/) { 339: $part[$#part+1]=$1; 340: $name[$#name+1]=$2; 341: ($type[$#type+1],$display[$#display+1])= 342: split(/\_\_dis\_\_/,$metadata{$_}); 343: unless ($display[$#display]) { 344: $display[$#display]=$name[$#name]; 345: } 346: } 347: if ($_ eq 'title') { 348: $thistitle=$metadata{$_}; 349: } 350: } keys %metadata; 351: my $totalparms=$#name+1; 352: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'. 353: join(' / ',split(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))). 354: '</font></tt><p><b>'. 355: $bighash{'title_'.$rid}); 356: if ($thistitle) { 357: $r->print(' ('.$thistitle.')'); 358: } 359: $r->print('</b></td><td rowspan='.$totalparms.'>'); 360: $r->print('<tt><font size=-1>'. 361: join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>'); 362: my $i; 363: for ($i=0;$i<$totalparms;$i++) { 364: $r->print("<td>$part[$i]</td><td>$display[$i]</td>"); 365: $r->print('<td>'.&valout($outpar[8],$type[$i]).'</td>'); 366: $r->print('<td>'.&valout($outpar[7],$type[$i]).'</td>'); 367: $r->print('<td>'. 368: &plink($type[$i],$display[$i],$outpar[6]).'</td>'); 369: if ($csec) { 370: $r->print('<td>'. 371: &plink($type[$i],$display[$i],$outpar[5]).'</td>'); 372: } 373: $r->print('<td>'. 374: &plink($type[$i],$display[$i],$outpar[4]).'</td>'); 375: if ($uname) { 376: $r->print('<td>'. 377: &plink($type[$i],$display[$i],$outpar[3]).'</td>'); 378: if ($csec) { 379: $r->print('<td>'. 380: &plink($type[$i],$display[$i],$outpar[2]).'</td>'); 381: } 382: $r->print('<td>'. 383: &plink($type[$i],$display[$i],$outpar[1]).'</td>'); 384: } 385: $r->print("</tr>\n<tr>"); 386: } 387: # -------------------------------------------------- End entry for one resource 388: } @ids; 389: $r->print('</table></form></body></html>'); 390: untie(%bighash); 391: untie(%parmhash); 392: } 393: } else { 394: # ----------------------------- Not in a course, or not allowed to modify parms 395: $ENV{'user.error.msg'}= 396: "/adm/parmset:opa:0:0:Cannot modify assessment parameters"; 397: return HTTP_NOT_ACCEPTABLE; 398: } 399: return OK; 400: } 401: 402: 1; 403: __END__ 404: 405: 406: 407: 408: 409: 410: