Annotation of loncom/interface/lonparmset.pm, revision 1.4
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.4 ! www 12: # 11/20,11/21,11/22 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.1 www 100: # ================================================================ Main Handler
101:
102: sub handler {
103: my $r=shift;
104:
105: if ($r->header_only) {
106: $r->content_type('text/html');
107: $r->send_http_header;
108: return OK;
109: }
110:
111: # ----------------------------------------------------- Needs to be in a course
112:
113: if (($ENV{'request.course.fn'}) &&
114: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.2 www 115: # -------------------------------------------------------- Variable declaration
116:
117: %courseopt=();
118: %useropt=();
119: %bighash=();
120:
1.3 www 121: @ids=();
122: %symbp=();
123: %typep=();
1.2 www 124:
125: $uname=$ENV{'form.uname'};
126: $udom=$ENV{'form.udom'};
127: unless ($udom) { $uname=''; }
128: $uhome='';
1.3 www 129: my $message='';
1.2 www 130: if ($uname) {
131: $uhome=&Apache::lonnet::homeserver($uname,$udom);
132: }
1.3 www 133: if ($uhome eq 'no_host') {
134: $message=
135: "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
136: $uname='';
137: }
1.2 www 138:
139: $csec=$ENV{'form.csec'};
1.3 www 140: unless ($csec) { $csec=''; }
141: $fcat=$ENV{'form.fcat'};
142: unless ($fcat) { $fcat=''; }
1.2 www 143:
144: # ------------------------------------------------------------------- Tie hashs
145: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
146: &GDBM_READER,0640)) &&
147: (tie(%parmhash,'GDBM_File',
148: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
149:
150: # -------------------------------------------------------------- Get coursedata
151: my $reply=&Apache::lonnet::reply('dump:'.
152: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
153: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
154: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
155: if ($reply!~/^error\:/) {
156: map {
157: my ($name,$value)=split(/\=/,$_);
158: $courseopt{unescape($name)}=unescape($value);
159: } split(/\&/,$reply);
160: }
161: # --------------------------------------------------- Get userdata (if present)
162: if ($uname) {
163: my $reply=
164: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
165: if ($reply!~/^error\:/) {
166: map {
167: my ($name,$value)=split(/\=/,$_);
168: $useropt{unescape($name)}=unescape($value);
169: } split(/\&/,$reply);
170: }
171: }
172: # --------------------------------------------------------- Get all assessments
173: map {
174: if ($_=~/^src\_(\d+)\.(\d+)$/) {
175: my $mapid=$1;
176: my $resid=$2;
1.3 www 177: my $id=$mapid.'.'.$resid;
1.2 www 178: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3 www 179: $ids[$#ids+1]=$id;
180: $typep{$id}=$1;
181: $symbp{$id}=
1.2 www 182: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1.3 www 183: '___'.$resid.'___'.
184: &Apache::lonnet::declutter($bighash{$_});
1.2 www 185: }
186: }
187: } keys %bighash;
188: # ------------------------------------------------------------------- Sort this
1.3 www 189: @ids=sort bycat @ids;
1.2 www 190: # ------------------------------------------------------------------ Start page
1.1 www 191: $r->content_type('text/html');
192: $r->send_http_header;
1.3 www 193: $r->print(
194: '<html><body bgcolor="#FFFFFF"><h1>Set Assessment Parameters</h1>');
195: $r->print("<h2>Course: $ENV{'course.'.
196: $ENV{'request.course.id'}.'.description'}</h2>");
197: if ($csec) {
198: $r->print("<h3>Section/Group: $csec</h3>");
199: }
200: if ($uname) {
201: $r->print("<h3>For User $uname at Domain $udom");
202: }
203: if ($uhome eq 'no_host') {
204: $r->print($message);
205: }
1.4 ! www 206: $r->print('<table border=2>');
1.3 www 207: map {
1.4 ! www 208: $r->print('<tr>');
! 209: # ------------------------------------------------------ Entry for one resource
! 210: my %metadata=&Apache::lonmeta::unpackagemeta(
! 211: &Apache::lonnet::getfile('/home/httpd/html/'.$bighash{'src_'.$_}.'.meta'),1);
! 212: map {
! 213: if ($_=~/^parameter\_(\d+)\_(\w+)\_\_dis\_\_(.+)$/) {
! 214: my $part=$1;
! 215: my $name=$2;
! 216: my $display=$3;
! 217: my $type=$metadata{$_};
! 218: }
! 219: } keys %metadata;
! 220: # -------------------------------------------------- End entry for one resource
! 221: $r->print('</tr>');
1.3 www 222: } @ids;
1.4 ! www 223: $r->print('</table></body></html>');
1.1 www 224: untie(%bighash);
1.2 www 225: untie(%parmhash);
1.1 www 226: }
227: } else {
228: # ----------------------------- Not in a course, or not allowed to modify parms
229: $ENV{'user.error.msg'}=
230: "/adm/flip:opa:0:0:Cannot modify assessment parameters";
231: return HTTP_NOT_ACCEPTABLE;
232: }
233: return OK;
234: }
235:
236: 1;
237: __END__
238:
239:
240:
241:
242:
243:
244:
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