Annotation of loncom/interface/lonparmset.pm, revision 1.10
1.1 www 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: #
1.9 www 12: # 11/20,11/21,11/22,11/23,11/24,11/25 Gerd Kortemeyer
1.1 www 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;
1.4 www 20: use Apache::lonmeta;
21:
1.1 www 22:
1.2 www 23: my %courseopt;
24: my %useropt;
25: my %bighash;
26: my %parmhash;
27:
1.8 www 28: my @outpar;
29:
1.3 www 30: my @ids;
31: my %symbp;
1.10 ! www 32: my %mapp;
1.3 www 33: my %typep;
1.2 www 34:
35: my $uname;
36: my $udom;
37: my $uhome;
38:
39: my $csec;
40:
1.3 www 41: my $fcat;
42:
1.2 www 43: # -------------------------------------------- Figure out a cascading parameter
44:
45: sub parmval {
1.3 www 46: my ($what,$id)=@_;
1.8 www 47: my $result='';
1.2 www 48: # ----------------------------------------------------- Cascading lookup scheme
1.10 ! www 49:
1.3 www 50: my $symbparm=$symbp{$id}.'.'.$what;
1.10 ! www 51: my $mapparm=$mapp{$id}.'___(all).'.$what;
! 52:
1.2 www 53: my $seclevel=
1.10 ! www 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:
1.2 www 63: my $courselevel=
64: $ENV{'request.course.id'}.'.'.$what;
1.10 ! www 65: my $courselevelr=
! 66: $ENV{'request.course.id'}.'.'.$symbparm;
! 67: my $courselevelm=
! 68: $ENV{'request.course.id'}.'.'.$mapparm;
1.2 www 69:
70: # ----------------------------------------------------------- first, check user
1.8 www 71:
72: if ($uname) {
1.10 ! www 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; }
1.3 www 79: }
1.10 ! www 80:
1.2 www 81: # -------------------------------------------------------- second, check course
82:
1.10 ! www 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; }
1.2 www 96:
97: # ------------------------------------------------------ third, check map parms
98:
99: my $thisparm=$parmhash{$symbparm};
1.10 ! www 100: if ($thisparm) { $outpar[10]=$thisparm;
! 101: $result=10; }
1.2 www 102:
103: # --------------------------------------------- last, look in resource metadata
104:
1.3 www 105: my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
1.2 www 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\>/) {
1.10 ! www 114: $outpar[11]=$1;
! 115: $result=11;
1.2 www 116: }
117: }
1.8 www 118: return $result;
1.2 www 119: }
120:
1.3 www 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:
1.9 www 131: # ------------------------------------------------------------ Output for value
132:
133: sub valout {
134: my ($value,$type)=@_;
135: return
136: ($value?(($type=~/^date/)?localtime($value):$value):' ');
137: }
138:
1.5 www 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."','"
1.8 www 144: .$marker."','".$return."','".$call."'".');">'.
1.9 www 145: &valout($value,$type).'</a>';
1.5 www 146: }
147:
1.1 www 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'}))) {
1.2 www 163: # -------------------------------------------------------- Variable declaration
164:
165: %courseopt=();
166: %useropt=();
167: %bighash=();
168:
1.3 www 169: @ids=();
170: %symbp=();
171: %typep=();
1.2 www 172:
173: $uname=$ENV{'form.uname'};
174: $udom=$ENV{'form.udom'};
175: unless ($udom) { $uname=''; }
176: $uhome='';
1.3 www 177: my $message='';
1.2 www 178: if ($uname) {
179: $uhome=&Apache::lonnet::homeserver($uname,$udom);
180: }
1.3 www 181: if ($uhome eq 'no_host') {
182: $message=
1.8 www 183: "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";
1.3 www 184: $uname='';
185: }
1.2 www 186:
187: $csec=$ENV{'form.csec'};
1.3 www 188: unless ($csec) { $csec=''; }
189: $fcat=$ENV{'form.fcat'};
190: unless ($fcat) { $fcat=''; }
1.2 www 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;
1.3 www 225: my $id=$mapid.'.'.$resid;
1.2 www 226: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3 www 227: $ids[$#ids+1]=$id;
228: $typep{$id}=$1;
1.10 ! www 229: $mapp{$id}=
! 230: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
! 231: $symbp{$id}=$mapp{$id}.
1.3 www 232: '___'.$resid.'___'.
233: &Apache::lonnet::declutter($bighash{$_});
1.2 www 234: }
235: }
236: } keys %bighash;
237: # ------------------------------------------------------------------- Sort this
1.3 www 238: @ids=sort bycat @ids;
1.2 www 239: # ------------------------------------------------------------------ Start page
1.1 www 240: $r->content_type('text/html');
241: $r->send_http_header;
1.5 www 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) {
1.6 www 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",
1.5 www 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>
1.8 www 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>
1.5 www 279: ENDHEAD
1.8 www 280:
1.3 www 281: if ($uhome eq 'no_host') {
282: $r->print($message);
283: }
1.8 www 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>');
1.10 ! www 294: # ----------------------------------------------------------------- Start Table
! 295: my $coursespan=$csec?8:5;
1.9 www 296: $r->print(<<ENDTABLEHEAD);
297: <p><table border=2>
1.10 ! www 298: <tr><td colspan=4></td>
! 299: <th colspan=$coursespan>Any User</th>
1.9 www 300: ENDTABLEHEAD
1.10 ! www 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
1.9 www 309: if ($csec) {
1.10 ! www 310: $r->print("<th colspan=3>in Section/Group $csec</th>");
1.9 www 311: }
1.10 ! www 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>');
1.3 www 326: map {
1.4 www 327: # ------------------------------------------------------ Entry for one resource
1.8 www 328: @outpar=();
1.5 www 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');
1.4 www 335: my %metadata=&Apache::lonmeta::unpackagemeta(
1.5 www 336: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
1.4 www 337: map {
1.5 www 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{$_};
1.4 www 349: }
350: } keys %metadata;
1.5 www 351: my $totalparms=$#name+1;
352: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
1.10 ! www 353: join(' / ',split(/\//,&Apache::lonnet::declutter($bighash{'src_'.$rid}))).
! 354: '</font></tt><p><b>'.
1.5 www 355: $bighash{'title_'.$rid});
356: if ($thistitle) {
357: $r->print(' ('.$thistitle.')');
358: }
1.10 ! www 359: $r->print('</b></td><td rowspan='.$totalparms.'>');
! 360: $r->print('<tt><font size=-1>'.
! 361: join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
1.5 www 362: my $i;
363: for ($i=0;$i<$totalparms;$i++) {
1.9 www 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: }
1.5 www 385: $r->print("</tr>\n<tr>");
386: }
1.4 www 387: # -------------------------------------------------- End entry for one resource
1.3 www 388: } @ids;
1.8 www 389: $r->print('</table></form></body></html>');
1.1 www 390: untie(%bighash);
1.2 www 391: untie(%parmhash);
1.1 www 392: }
393: } else {
394: # ----------------------------- Not in a course, or not allowed to modify parms
395: $ENV{'user.error.msg'}=
1.7 www 396: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
1.1 www 397: return HTTP_NOT_ACCEPTABLE;
398: }
399: return OK;
400: }
401:
402: 1;
403: __END__
404:
405:
406:
407:
408:
409:
410:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonparmset.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface