Annotation of loncom/interface/lonparmset.pm, revision 1.5
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) {
! 214: parmwin=window.open("/adm/rat/parameter.html?type="+type
! 215: +"&value="+value+"&marker="+marker+"&return="+ret
! 216: +"&call="+call+"&name="+dis,"LONCAPAparms",
! 217: "height=350,width=350,scrollbars=no,menubar=no");
! 218:
! 219: }
! 220: </script>
! 221: </head>
! 222: <body bgcolor="#FFFFFF" onUnload="pclose()">
! 223: <h1>Set Assessment Parameters</h1>
! 224: ENDHEAD
1.3 www 225: $r->print("<h2>Course: $ENV{'course.'.
226: $ENV{'request.course.id'}.'.description'}</h2>");
227: if ($csec) {
228: $r->print("<h3>Section/Group: $csec</h3>");
229: }
230: if ($uname) {
231: $r->print("<h3>For User $uname at Domain $udom");
232: }
233: if ($uhome eq 'no_host') {
234: $r->print($message);
235: }
1.5 ! www 236: $r->print("\n<table border=2>\n<tr>");
1.3 www 237: map {
1.4 www 238: # ------------------------------------------------------ Entry for one resource
1.5 ! www 239: my $rid=$_;
! 240: my $thistitle='';
! 241: my @part=(0,1,1);
! 242: my @name=('deadline','sig','tol');
! 243: my @display=('Deadline','Significant Figures','Tolerance');
! 244: my @type=('date','int','tolerance');
1.4 www 245: my %metadata=&Apache::lonmeta::unpackagemeta(
1.5 ! www 246: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$rid}.'.meta'),1);
1.4 www 247: map {
1.5 ! www 248: if ($_=~/^parameter\_(\d+)\_(\w+)$/) {
! 249: $part[$#part+1]=$1;
! 250: $name[$#name+1]=$2;
! 251: ($type[$#type+1],$display[$#display+1])=
! 252: split(/\_\_dis\_\_/,$metadata{$_});
! 253: unless ($display[$#display]) {
! 254: $display[$#display]=$name[$#name];
! 255: }
! 256: }
! 257: if ($_ eq 'title') {
! 258: $thistitle=$metadata{$_};
1.4 www 259: }
260: } keys %metadata;
1.5 ! www 261: my $totalparms=$#name+1;
! 262: $r->print('<td rowspan='.$totalparms.'><tt><font size=-1>'.
! 263: $bighash{'src_'.$rid}.'</font></tt><p><b>'.
! 264: $bighash{'title_'.$rid});
! 265: if ($thistitle) {
! 266: $r->print(' ('.$thistitle.')');
! 267: }
! 268: $r->print('</b></td>');
! 269: my $i;
! 270: for ($i=0;$i<$totalparms;$i++) {
! 271: $r->print("<td>$part[$i]</td><td>$display[$i]</td>");
! 272: $r->print('<td>'.&plink($type[$i],$display[$i],'987684455').'</td>');
! 273: $r->print("</tr>\n<tr>");
! 274: }
1.4 www 275: # -------------------------------------------------- End entry for one resource
1.3 www 276: } @ids;
1.4 www 277: $r->print('</table></body></html>');
1.1 www 278: untie(%bighash);
1.2 www 279: untie(%parmhash);
1.1 www 280: }
281: } else {
282: # ----------------------------- Not in a course, or not allowed to modify parms
283: $ENV{'user.error.msg'}=
284: "/adm/flip:opa:0:0:Cannot modify assessment parameters";
285: return HTTP_NOT_ACCEPTABLE;
286: }
287: return OK;
288: }
289:
290: 1;
291: __END__
292:
293:
294:
295:
296:
297:
298:
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