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 %typep;
33:
34: my $uname;
35: my $udom;
36: my $uhome;
37:
38: my $csec;
39:
40: my $fcat;
41:
42: # -------------------------------------------- Figure out a cascading parameter
43:
44: sub parmval {
45: my ($what,$id)=@_;
46: my $result='';
47: # ----------------------------------------------------- Cascading lookup scheme
48: my $symbparm=$symbp{$id}.'.'.$what;
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
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; }
66: }
67: # -------------------------------------------------------- second, check course
68:
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; }
75:
76: # ------------------------------------------------------ third, check map parms
77:
78: my $thisparm=$parmhash{$symbparm};
79: if ($thisparm) { $result=$thisparm;
80: $outpar[7]=$result; }
81:
82: # --------------------------------------------- last, look in resource metadata
83:
84: my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
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\>/) {
93: $result=$1;
94: $outpar[8]=$result;
95: }
96: }
97: return $result;
98: }
99:
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:
110: # ------------------------------------------------------------ Output for value
111:
112: sub valout {
113: my ($value,$type)=@_;
114: return
115: ($value?(($type=~/^date/)?localtime($value):$value):' ');
116: }
117:
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."','"
123: .$marker."','".$return."','".$call."'".');">'.
124: &valout($value,$type).'</a>';
125: }
126:
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'}))) {
142: # -------------------------------------------------------- Variable declaration
143:
144: %courseopt=();
145: %useropt=();
146: %bighash=();
147:
148: @ids=();
149: %symbp=();
150: %typep=();
151:
152: $uname=$ENV{'form.uname'};
153: $udom=$ENV{'form.udom'};
154: unless ($udom) { $uname=''; }
155: $uhome='';
156: my $message='';
157: if ($uname) {
158: $uhome=&Apache::lonnet::homeserver($uname,$udom);
159: }
160: if ($uhome eq 'no_host') {
161: $message=
162: "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";
163: $uname='';
164: }
165:
166: $csec=$ENV{'form.csec'};
167: unless ($csec) { $csec=''; }
168: $fcat=$ENV{'form.fcat'};
169: unless ($fcat) { $fcat=''; }
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;
204: my $id=$mapid.'.'.$resid;
205: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
206: $ids[$#ids+1]=$id;
207: $typep{$id}=$1;
208: $symbp{$id}=
209: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
210: '___'.$resid.'___'.
211: &Apache::lonnet::declutter($bighash{$_});
212: }
213: }
214: } keys %bighash;
215: # ------------------------------------------------------------------- Sort this
216: @ids=sort bycat @ids;
217: # ------------------------------------------------------------------ Start page
218: $r->content_type('text/html');
219: $r->send_http_header;
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) {
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",
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>
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>
257: ENDHEAD
258:
259: if ($uhome eq 'no_host') {
260: $r->print($message);
261: }
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>');
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>');
290: map {
291: # ------------------------------------------------------ Entry for one resource
292: @outpar=();
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');
299: my %metadata=&Apache::lonmeta::unpackagemeta(
300: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
301: map {
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{$_};
313: }
314: } keys %metadata;
315: my $totalparms=$#name+1;
316: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
317: join(' / ',split(/\//,$bighash{'src_'.$rid})).'</font></tt><p><b>'.
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++) {
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: }
346: $r->print("</tr>\n<tr>");
347: }
348: # -------------------------------------------------- End entry for one resource
349: } @ids;
350: $r->print('</table></form></body></html>');
351: untie(%bighash);
352: untie(%parmhash);
353: }
354: } else {
355: # ----------------------------- Not in a course, or not allowed to modify parms
356: $ENV{'user.error.msg'}=
357: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
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