Annotation of loncom/interface/lonparmset.pm, revision 1.8
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.8 ! www 12: # 11/20,11/21,11/22,11/23,11/24 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.5 www 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."','"
1.8 ! www 115: .$marker."','".$return."','".$call."'".');">'.
! 116: ($value?(($type=~/^date/)?localtime($value):$value):' ').'</a>';
1.5 www 117: }
118:
1.1 www 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'}))) {
1.2 www 134: # -------------------------------------------------------- Variable declaration
135:
136: %courseopt=();
137: %useropt=();
138: %bighash=();
139:
1.3 www 140: @ids=();
141: %symbp=();
142: %typep=();
1.2 www 143:
144: $uname=$ENV{'form.uname'};
145: $udom=$ENV{'form.udom'};
146: unless ($udom) { $uname=''; }
147: $uhome='';
1.3 www 148: my $message='';
1.2 www 149: if ($uname) {
150: $uhome=&Apache::lonnet::homeserver($uname,$udom);
151: }
1.3 www 152: if ($uhome eq 'no_host') {
153: $message=
1.8 ! www 154: "<h3><font color=red>Unknown user '$uname' at domain '$udom'</font></h3>";
1.3 www 155: $uname='';
156: }
1.2 www 157:
158: $csec=$ENV{'form.csec'};
1.3 www 159: unless ($csec) { $csec=''; }
160: $fcat=$ENV{'form.fcat'};
161: unless ($fcat) { $fcat=''; }
1.2 www 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;
1.3 www 196: my $id=$mapid.'.'.$resid;
1.2 www 197: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3 www 198: $ids[$#ids+1]=$id;
199: $typep{$id}=$1;
200: $symbp{$id}=
1.2 www 201: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1.3 www 202: '___'.$resid.'___'.
203: &Apache::lonnet::declutter($bighash{$_});
1.2 www 204: }
205: }
206: } keys %bighash;
207: # ------------------------------------------------------------------- Sort this
1.3 www 208: @ids=sort bycat @ids;
1.2 www 209: # ------------------------------------------------------------------ Start page
1.1 www 210: $r->content_type('text/html');
211: $r->send_http_header;
1.5 www 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) {
1.6 www 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",
1.5 www 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>
1.8 ! www 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>
1.5 www 249: ENDHEAD
1.8 ! www 250:
1.3 www 251: if ($uhome eq 'no_host') {
252: $r->print($message);
253: }
1.8 ! www 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>");
1.3 www 265: map {
1.4 www 266: # ------------------------------------------------------ Entry for one resource
1.8 ! www 267: @outpar=();
1.5 www 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');
1.4 www 274: my %metadata=&Apache::lonmeta::unpackagemeta(
1.5 www 275: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
1.4 www 276: map {
1.5 www 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{$_};
1.4 www 288: }
289: } keys %metadata;
1.5 www 290: my $totalparms=$#name+1;
291: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
1.8 ! www 292: join(' / ',split(/\//,$bighash{'src_'.$rid})).'</font></tt><p><b>'.
1.5 www 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>");
1.8 ! www 301: my $j;
! 302: for ($j=1;$j<=7;$j++) {
! 303: $r->print('<td>'.&plink($type[$i],$display[$i],$outpar[$j]).'</td>');}
1.5 www 304: $r->print("</tr>\n<tr>");
305: }
1.4 www 306: # -------------------------------------------------- End entry for one resource
1.3 www 307: } @ids;
1.8 ! www 308: $r->print('</table></form></body></html>');
1.1 www 309: untie(%bighash);
1.2 www 310: untie(%parmhash);
1.1 www 311: }
312: } else {
313: # ----------------------------- Not in a course, or not allowed to modify parms
314: $ENV{'user.error.msg'}=
1.7 www 315: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
1.1 www 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