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