Annotation of loncom/interface/lonparmset.pm, revision 1.2
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:
! 26: my @srcp;
! 27: my @typep;
! 28: my @resp;
! 29: my @mapp;
! 30: my @symbp;
! 31:
! 32: my $uname;
! 33: my $udom;
! 34: my $uhome;
! 35:
! 36: my $csec;
! 37:
! 38: # -------------------------------------------- Figure out a cascading parameter
! 39:
! 40: sub parmval {
! 41: my ($what,$idx)=@_;
! 42: # ----------------------------------------------------- Cascading lookup scheme
! 43: my $symbparm=$symbp[$idx].'.'.$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 ($useropt{$reslevel}) { return $useropt{$reslevel}; }
! 55: if ($useropt{$seclevel}) { return $useropt{$seclevel}; }
! 56: if ($useropt{$courselevel}) { return $useropt{$courselevel}; }
! 57:
! 58: # -------------------------------------------------------- second, check course
! 59:
! 60: if ($courseopt{$reslevel}) { return $courseopt{$reslevel}; }
! 61: if ($courseopt{$seclevel}) { return $courseopt{$seclevel}; }
! 62: if ($courseopt{$courselevel}) { return $courseopt{$courselevel}; }
! 63:
! 64: # ------------------------------------------------------ third, check map parms
! 65:
! 66: my $thisparm=$parmhash{$symbparm};
! 67: if ($thisparm) { return $thisparm; }
! 68:
! 69:
! 70: # --------------------------------------------- last, look in resource metadata
! 71:
! 72: my $filename='/home/httpd/res/'.$srcp[$idx].'.meta';
! 73: if (-e $filename) {
! 74: my @content;
! 75: {
! 76: my $fh=Apache::File->new($filename);
! 77: @content=<$fh>;
! 78: }
! 79: if (join('',@content)=~
! 80: /\<$what[^\>]*\>([^\<]*)\<\/$what\>/) {
! 81: return $1;
! 82: }
! 83: }
! 84: return '';
! 85: }
! 86:
1.1 www 87: # ================================================================ Main Handler
88:
89: sub handler {
90: my $r=shift;
91:
92: if ($r->header_only) {
93: $r->content_type('text/html');
94: $r->send_http_header;
95: return OK;
96: }
97:
98: # ----------------------------------------------------- Needs to be in a course
99:
100: if (($ENV{'request.course.fn'}) &&
101: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.2 ! www 102: # -------------------------------------------------------- Variable declaration
! 103:
! 104: %courseopt=();
! 105: %useropt=();
! 106: %bighash=();
! 107:
! 108: @srcp=();
! 109: @typep=();
! 110: @resp=();
! 111: @mapp=();
! 112: @symbp=();
! 113:
! 114: $uname=$ENV{'form.uname'};
! 115: $udom=$ENV{'form.udom'};
! 116: unless ($udom) { $uname=''; }
! 117: $uhome='';
! 118: if ($uname) {
! 119: $uhome=&Apache::lonnet::homeserver($uname,$udom);
! 120: }
! 121:
! 122: $csec=$ENV{'form.csec'};
! 123:
! 124: # ------------------------------------------------------------------- Tie hashs
! 125: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
! 126: &GDBM_READER,0640)) &&
! 127: (tie(%parmhash,'GDBM_File',
! 128: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
! 129:
! 130: # -------------------------------------------------------------- Get coursedata
! 131: my $reply=&Apache::lonnet::reply('dump:'.
! 132: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
! 133: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
! 134: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
! 135: if ($reply!~/^error\:/) {
! 136: map {
! 137: my ($name,$value)=split(/\=/,$_);
! 138: $courseopt{unescape($name)}=unescape($value);
! 139: } split(/\&/,$reply);
! 140: }
! 141: # --------------------------------------------------- Get userdata (if present)
! 142: if ($uname) {
! 143: my $reply=
! 144: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
! 145: if ($reply!~/^error\:/) {
! 146: map {
! 147: my ($name,$value)=split(/\=/,$_);
! 148: $useropt{unescape($name)}=unescape($value);
! 149: } split(/\&/,$reply);
! 150: }
! 151: }
! 152: # --------------------------------------------------------- Get all assessments
! 153: map {
! 154: if ($_=~/^src\_(\d+)\.(\d+)$/) {
! 155: my $mapid=$1;
! 156: my $resid=$2;
! 157: if ($bighash{$_}=~/\.(problem|exam|quiz|assess|survey|form)$/) {
! 158: $typep[$#typep+1]=$1;
! 159: $mapp[$#mapp+1]=$mapid;
! 160: $resp[$#resp+1]=$resid;
! 161: $srcp[$#srcp+1]=&Apache::lonnet::declutter($bighash{$_});
! 162: $symbp[$#symbp+1]=
! 163: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid}).
! 164: '___'.$resid.'___'.$srcp[$#srcp];
! 165: }
! 166: }
! 167: } keys %bighash;
! 168: # ------------------------------------------------------------------- Sort this
1.1 www 169:
1.2 ! www 170: # ------------------------------------------------------------------ Start page
1.1 www 171: $r->content_type('text/html');
172: $r->send_http_header;
173: $r->print('<html><body bgcolor="#FFFFFF">');
174:
175: $r->print('</body></html>');
176: untie(%bighash);
1.2 ! www 177: untie(%parmhash);
1.1 www 178: }
179: } else {
180: # ----------------------------- Not in a course, or not allowed to modify parms
181: $ENV{'user.error.msg'}=
182: "/adm/flip:opa:0:0:Cannot modify assessment parameters";
183: return HTTP_NOT_ACCEPTABLE;
184: }
185: return OK;
186: }
187:
188: 1;
189: __END__
190:
191:
192:
193:
194:
195:
196:
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