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 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:
21: my %courseopt;
22: my %useropt;
23: my %bighash;
24: my %parmhash;
25:
26: my @ids;
27: my %symbp;
28: my %typep;
29:
30: my $uname;
31: my $udom;
32: my $uhome;
33:
34: my $csec;
35:
36: my $fcat;
37:
38: # -------------------------------------------- Figure out a cascading parameter
39:
40: sub parmval {
41: my ($what,$id)=@_;
42: # ----------------------------------------------------- Cascading lookup scheme
43: my $symbparm=$symbp{$id}.'.'.$what;
44: my $reslevel=
45: $ENV{'request.course.id'}.'.'.$symbparm;
46: my $seclevel=
47: $ENV{'request.course.id'}.'.'.
48: $ENV{'request.course.sec'}.'.'.$what;
49: my $courselevel=
50: $ENV{'request.course.id'}.'.'.$what;
51:
52: # ----------------------------------------------------------- first, check user
53:
54: if ($uname) {
55: if ($useropt{$reslevel}) { return $useropt{$reslevel}; }
56: if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
57: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
58: }
59:
60: # -------------------------------------------------------- second, check course
61:
62: if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }
63: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
64: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
65:
66: # ------------------------------------------------------ third, check map parms
67:
68: my $thisparm=$parmhash{$symbparm};
69: if ($thisparm) { return $thisparm; }
70:
71: # --------------------------------------------- last, look in resource metadata
72:
73: my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
74: if (-e $filename) {
75: my @content;
76: {
77: my $fh=Apache::File->new($filename);
78: @content=<$fh>;
79: }
80: if (join('',@content)=~
81: /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {
82: return $1;
83: }
84: }
85: return '';
86: }
87:
88: # ---------------------------------------------------------------- Sort routine
89:
90: sub bycat {
91: if ($fcat eq '') {
92: $a<=>$b;
93: } else {
94: &parmval('0.'.$fcat,$a)<=>&parmval('0.'.$fcat,$b);
95: }
96: }
97:
98: # ================================================================ Main Handler
99:
100: sub handler {
101: my $r=shift;
102:
103: if ($r->header_only) {
104: $r->content_type('text/html');
105: $r->send_http_header;
106: return OK;
107: }
108:
109: # ----------------------------------------------------- Needs to be in a course
110:
111: if (($ENV{'request.course.fn'}) &&
112: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
113: # -------------------------------------------------------- Variable declaration
114:
115: %courseopt=();
116: %useropt=();
117: %bighash=();
118:
119: @ids=();
120: %symbp=();
121: %typep=();
122:
123: $uname=$ENV{'form.uname'};
124: $udom=$ENV{'form.udom'};
125: unless ($udom) { $uname=''; }
126: $uhome='';
127: my $message='';
128: if ($uname) {
129: $uhome=&Apache::lonnet::homeserver($uname,$udom);
130: }
131: if ($uhome eq 'no_host') {
132: $message=
133: "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
134: $uname='';
135: }
136:
137: $csec=$ENV{'form.csec'};
138: unless ($csec) { $csec=''; }
139: $fcat=$ENV{'form.fcat'};
140: unless ($fcat) { $fcat=''; }
141:
142: # ------------------------------------------------------------------- Tie hashs
143: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
144: &GDBM_READER,0640)) &&
145: (tie(%parmhash,'GDBM_File',
146: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
147:
148: # -------------------------------------------------------------- Get coursedata
149: my $reply=&Apache::lonnet::reply('dump:'.
150: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
151: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
152: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
153: if ($reply!~/^error\:/) {
154: map {
155: my ($name,$value)=split(/\=/,$_);
156: $courseopt{unescape($name)}=unescape($value);
157: } split(/\&/,$reply);
158: }
159: # --------------------------------------------------- Get userdata (if present)
160: if ($uname) {
161: my $reply=
162: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
163: if ($reply!~/^error\:/) {
164: map {
165: my ($name,$value)=split(/\=/,$_);
166: $useropt{unescape($name)}=unescape($value);
167: } split(/\&/,$reply);
168: }
169: }
170: # --------------------------------------------------------- Get all assessments
171: map {
172: if ($_=~/^src\_(\d+)\.(\d+)$/) {
173: my $mapid=$1;
174: my $resid=$2;
175: my $id=$mapid.'.'.$resid;
176: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
177: $ids[$#ids+1]=$id;
178: $typep{$id}=$1;
179: $symbp{$id}=
180: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
181: '___'.$resid.'___'.
182: &Apache::lonnet::declutter($bighash{$_});
183: }
184: }
185: } keys %bighash;
186: # ------------------------------------------------------------------- Sort this
187: @ids=sort bycat @ids;
188: # ------------------------------------------------------------------ Start page
189: $r->content_type('text/html');
190: $r->send_http_header;
191: $r->print(
192: '<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');
193: $r->print("<h2>Course: $ENV{'course.'.
194: $ENV{'request.course.id'}.'.description'}</h2>");
195: if ($csec) {
196: $r->print("<h3>Section/Group: $csec</h3>");
197: }
198: if ($uname) {
199: $r->print("<h3>For User $uname at Domain $udom");
200: }
201: if ($uhome eq 'no_host') {
202: $r->print($message);
203: }
204: map {
205: $r->print($_.'<br>');
206: } @ids;
207: $r->print('</body></html>');
208: untie(%bighash);
209: untie(%parmhash);
210: }
211: } else {
212: # ----------------------------- Not in a course, or not allowed to modify parms
213: $ENV{'user.error.msg'}=
214: "/adm/flip:opa:0:0:Cannot modify assessment parameters";
215: return HTTP_NOT_ACCEPTABLE;
216: }
217: return OK;
218: }
219:
220: 1;
221: __END__
222:
223:
224:
225:
226:
227:
228:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>