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