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 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: # -------------------------------------------------------- Produces link anchor
111:
112: sub plink {
113: my ($type,$dis,$value,$marker,$return,$call)=@_;
114: return '<a href="javascript:pjump('."'".$type."','".$dis."','".$value."','"
115: .$marker."','".$return."','".$call."'".');">'.
116: ($value?(($type=~/^date/)?localtime($value):$value):' ').'</a>';
117: }
118:
119: # ================================================================ Main Handler
120:
121: sub handler {
122: my $r=shift;
123:
124: if ($r->header_only) {
125: $r->content_type('text/html');
126: $r->send_http_header;
127: return OK;
128: }
129:
130: # ----------------------------------------------------- Needs to be in a course
131:
132: if (($ENV{'request.course.fn'}) &&
133: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
134: # -------------------------------------------------------- Variable declaration
135:
136: %courseopt=();
137: %useropt=();
138: %bighash=();
139:
140: @ids=();
141: %symbp=();
142: %typep=();
143:
144: $uname=$ENV{'form.uname'};
145: $udom=$ENV{'form.udom'};
146: unless ($udom) { $uname=''; }
147: $uhome='';
148: my $message='';
149: if ($uname) {
150: $uhome=&Apache::lonnet::homeserver($uname,$udom);
151: }
152: if ($uhome eq 'no_host') {
153: $message=
154: "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";
155: $uname='';
156: }
157:
158: $csec=$ENV{'form.csec'};
159: unless ($csec) { $csec=''; }
160: $fcat=$ENV{'form.fcat'};
161: unless ($fcat) { $fcat=''; }
162:
163: # ------------------------------------------------------------------- Tie hashs
164: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
165: &GDBM_READER,0640)) &&
166: (tie(%parmhash,'GDBM_File',
167: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
168:
169: # -------------------------------------------------------------- Get coursedata
170: my $reply=&Apache::lonnet::reply('dump:'.
171: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
172: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
173: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
174: if ($reply!~/^error\:/) {
175: map {
176: my ($name,$value)=split(/\=/,$_);
177: $courseopt{unescape($name)}=unescape($value);
178: } split(/\&/,$reply);
179: }
180: # --------------------------------------------------- Get userdata (if present)
181: if ($uname) {
182: my $reply=
183: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
184: if ($reply!~/^error\:/) {
185: map {
186: my ($name,$value)=split(/\=/,$_);
187: $useropt{unescape($name)}=unescape($value);
188: } split(/\&/,$reply);
189: }
190: }
191: # --------------------------------------------------------- Get all assessments
192: map {
193: if ($_=~/^src\_(\d+)\.(\d+)$/) {
194: my $mapid=$1;
195: my $resid=$2;
196: my $id=$mapid.'.'.$resid;
197: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
198: $ids[$#ids+1]=$id;
199: $typep{$id}=$1;
200: $symbp{$id}=
201: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
202: '___'.$resid.'___'.
203: &Apache::lonnet::declutter($bighash{$_});
204: }
205: }
206: } keys %bighash;
207: # ------------------------------------------------------------------- Sort this
208: @ids=sort bycat @ids;
209: # ------------------------------------------------------------------ Start page
210: $r->content_type('text/html');
211: $r->send_http_header;
212: $r->print(<<ENDHEAD);
213: <html>
214: <head>
215: <title>LON-CAPA Assessment Parameters</title>
216: <script>
217: function pclose() {
218: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
219: "height=350,width=350,scrollbars=no,menubar=no");
220: parmwin.close();
221: }
222:
223: function pjump(type,dis,value,marker,ret,call) {
224: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
225: +"&value="+escape(value)+"&marker="+escape(marker)
226: +"&return="+escape(ret)
227: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
228: "height=350,width=350,scrollbars=no,menubar=no");
229:
230: }
231: </script>
232: </head>
233: <body bgcolor="#FFFFFF" onUnload="pclose()">
234: <h1>Set Assessment Parameters</h1>
235: <form method="post" action="/adm/parmset" name="parmform">
236: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
237: <b>
238: Section/Group:
239: <input type="text" value="$csec" size="6" name="csec"
240: onBlur="this.form.submit();">
241: <br>
242: For User
243: <input type="text" value="$uname" size="12" name="uname"
244: onBlur="if (this.form.udom.value) { this.form.submit(); }">
245: at Domain
246: <input type="text" value="$udom" size="6" name="udom"
247: onBlur="if (this.form.uname.value) { this.form.submit(); }">
248: </b>
249: ENDHEAD
250:
251: if ($uhome eq 'no_host') {
252: $r->print($message);
253: }
254: $r->print('<p>Sort list by ');
255: $r->print('<select name="fcat" onChange="this.form.submit();">');
256: my $k;
257: my @sopt=('map','Map','name','Problem Name','deadline','Deadline');
258: for ($k=0;$k<$#sopt;$k=$k+2) {
259: $r->print('<option value="'.$sopt[$k].'"');
260: if ($fcat eq $sopt[$k]) { $r->print(' selected'); }
261: $r->print('>'.$sopt[$k+1].'</option>');
262: }
263: $r->print('</select>');
264: $r->print("\n<p><table border=2>\n<tr>");
265: map {
266: # ------------------------------------------------------ Entry for one resource
267: @outpar=();
268: my $rid=$_;
269: my $thistitle='';
270: my @part=(0,1,1);
271: my @name=('deadline','sig','tol');
272: my @display=('Deadline','Significant Figures','Tolerance');
273: my @type=('date','int','tolerance');
274: my %metadata=&Apache::lonmeta::unpackagemeta(
275: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
276: map {
277: if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
278: $part[$#part+1]=$1;
279: $name[$#name+1]=$2;
280: ($type[$#type+1],$display[$#display+1])=
281: split(/\_\_dis\_\_/,$metadata{$_});
282: unless ($display[$#display]) {
283: $display[$#display]=$name[$#name];
284: }
285: }
286: if ($_ eq 'title') {
287: $thistitle=$metadata{$_};
288: }
289: } keys %metadata;
290: my $totalparms=$#name+1;
291: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
292: join(' / ',split(/\//,$bighash{'src_'.$rid})).'</font></tt><p><b>'.
293: $bighash{'title_'.$rid});
294: if ($thistitle) {
295: $r->print(' ('.$thistitle.')');
296: }
297: $r->print('</b></td>');
298: my $i;
299: for ($i=0;$i<$totalparms;$i++) {
300: $r->print("<td>$part[$i]</td><td>$display[$i]</td>");
301: my $j;
302: for ($j=1;$j<=7;$j++) {
303: $r->print('<td>'.&plink($type[$i],$display[$i],$outpar[$j]).'</td>');}
304: $r->print("</tr>\n<tr>");
305: }
306: # -------------------------------------------------- End entry for one resource
307: } @ids;
308: $r->print('</table></form></body></html>');
309: untie(%bighash);
310: untie(%parmhash);
311: }
312: } else {
313: # ----------------------------- Not in a course, or not allowed to modify parms
314: $ENV{'user.error.msg'}=
315: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
316: return HTTP_NOT_ACCEPTABLE;
317: }
318: return OK;
319: }
320:
321: 1;
322: __END__
323:
324:
325:
326:
327:
328:
329:
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