Annotation of loncom/interface/lonparmset.pm, revision 1.3
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.2 www 12: # 11/20,11/21 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;
20:
1.2 www 21: my %courseopt;
22: my %useropt;
23: my %bighash;
24: my %parmhash;
25:
1.3 ! www 26: my @ids;
! 27: my %symbp;
! 28: my %typep;
1.2 www 29:
30: my $uname;
31: my $udom;
32: my $uhome;
33:
34: my $csec;
35:
1.3 ! www 36: my $fcat;
! 37:
1.2 www 38: # -------------------------------------------- Figure out a cascading parameter
39:
40: sub parmval {
1.3 ! www 41: my ($what,$id)=@_;
1.2 www 42: # ----------------------------------------------------- Cascading lookup scheme
1.3 ! www 43: my $symbparm=$symbp{$id}.'.'.$what;
1.2 www 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:
1.3 ! www 54: if ($uname) {
1.2 www 55: if ($useropt{$reslevel}) { return $useropt{$reslevel}; }
56: if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
57: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
1.3 ! www 58: }
1.2 www 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:
1.3 ! www 73: my $filename='/home/httpd/res/'.$bighash{'src_'.$id}.'.meta';
1.2 www 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:
1.3 ! www 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:
1.1 www 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'}))) {
1.2 www 113: # -------------------------------------------------------- Variable declaration
114:
115: %courseopt=();
116: %useropt=();
117: %bighash=();
118:
1.3 ! www 119: @ids=();
! 120: %symbp=();
! 121: %typep=();
1.2 www 122:
123: $uname=$ENV{'form.uname'};
124: $udom=$ENV{'form.udom'};
125: unless ($udom) { $uname=''; }
126: $uhome='';
1.3 ! www 127: my $message='';
1.2 www 128: if ($uname) {
129: $uhome=&Apache::lonnet::homeserver($uname,$udom);
130: }
1.3 ! www 131: if ($uhome eq 'no_host') {
! 132: $message=
! 133: "<h3><font color=red>Unknown User $uname at Domain $udom</font></h3>";
! 134: $uname='';
! 135: }
1.2 www 136:
137: $csec=$ENV{'form.csec'};
1.3 ! www 138: unless ($csec) { $csec=''; }
! 139: $fcat=$ENV{'form.fcat'};
! 140: unless ($fcat) { $fcat=''; }
1.2 www 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;
1.3 ! www 175: my $id=$mapid.'.'.$resid;
1.2 www 176: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
1.3 ! www 177: $ids[$#ids+1]=$id;
! 178: $typep{$id}=$1;
! 179: $symbp{$id}=
1.2 www 180: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
1.3 ! www 181: '___'.$resid.'___'.
! 182: &Apache::lonnet::declutter($bighash{$_});
1.2 www 183: }
184: }
185: } keys %bighash;
186: # ------------------------------------------------------------------- Sort this
1.3 ! www 187: @ids=sort bycat @ids;
1.2 www 188: # ------------------------------------------------------------------ Start page
1.1 www 189: $r->content_type('text/html');
190: $r->send_http_header;
1.3 ! www 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;
1.1 www 207: $r->print('</body></html>');
208: untie(%bighash);
1.2 www 209: untie(%parmhash);
1.1 www 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>
![[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