1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
4: # $Id: lonparmset.pm,v 1.43 2002/02/12 00:14:07 albertel Exp $
5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
28: # (Handler to resolve ambiguous file locations
29: #
30: # (TeX Content Handler
31: #
32: # YEAR=2000
33: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
34: #
35: # 10/11,10/12,10/16 Gerd Kortemeyer)
36: #
37: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
38: # 12/08,12/12,
39: # YEAR=2001
40: # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09,
41: # 07/05,07/06,08/08,08/09,09/01,09/21 Gerd Kortemeyer
42: # 12/17 Scott Harrison
43: # 12/19 Guy Albertelli
44: # 12/26,12/27 Gerd Kortemeyer
45: #
46: ###
47:
48: package Apache::lonparmset;
49:
50: use strict;
51: use Apache::lonnet;
52: use Apache::Constants qw(:common :http REDIRECT);
53: use Apache::loncommon;
54: use GDBM_File;
55:
56:
57: my %courseopt;
58: my %useropt;
59: my %bighash;
60: my %parmhash;
61:
62: my @outpar;
63:
64: my @ids;
65: my %symbp;
66: my %mapp;
67: my %typep;
68: my %keyp;
69:
70: my $uname;
71: my $udom;
72: my $uhome;
73:
74: my $csec;
75:
76: my $fcat;
77:
78: # -------------------------------------------- Figure out a cascading parameter
79:
80: sub parmval {
81: my ($what,$id,$def)=@_;
82: my $result='';
83: @outpar=();
84: # ----------------------------------------------------- Cascading lookup scheme
85:
86: my $symbparm=$symbp{$id}.'.'.$what;
87: my $mapparm=$mapp{$id}.'___(all).'.$what;
88:
89: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
90: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
91: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
92:
93: my $courselevel=$ENV{'request.course.id'}.'.'.$what;
94: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
95: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
96:
97: # -------------------------------------------------------- first, check default
98:
99: if ($def) { $outpar[11]=$def; $result=11; }
100:
101: # ----------------------------------------------------- second, check map parms
102:
103: my $thisparm=$parmhash{$symbparm};
104: if ($thisparm) { $outpar[10]=$thisparm; $result=10; }
105:
106: # --------------------------------------------------------- third, check course
107:
108: if ($courseopt{$courselevel}) {
109: $outpar[9]=$courseopt{$courselevel};
110: $result=9;
111: }
112:
113: if ($courseopt{$courselevelm}) {
114: $outpar[8]=$courseopt{$courselevelm};
115: $result=8;
116: }
117:
118: if ($courseopt{$courselevelr}) {
119: $outpar[7]=$courseopt{$courselevelr};
120: $result=7;
121: }
122:
123: if ($csec) {
124: if ($courseopt{$seclevel}) {
125: $outpar[6]=$courseopt{$seclevel};
126: $result=6;
127: }
128: if ($courseopt{$seclevelm}) {
129: $outpar[5]=$courseopt{$seclevelm};
130: $result=5;
131: }
132:
133: if ($courseopt{$seclevelr}) {
134: $outpar[4]=$courseopt{$seclevelr};
135: $result=4;
136: }
137: }
138:
139: # ---------------------------------------------------------- fourth, check user
140:
141: if ($uname) {
142: if ($useropt{$courselevel}) {
143: $outpar[3]=$useropt{$courselevel};
144: $result=3;
145: }
146:
147: if ($useropt{$courselevelm}) {
148: $outpar[2]=$useropt{$courselevelm};
149: $result=2;
150: }
151:
152: if ($useropt{$courselevelr}) {
153: $outpar[1]=$useropt{$courselevelr};
154: $result=1;
155: }
156: }
157:
158: return $result;
159: }
160:
161: # ------------------------------------------------------------ Output for value
162:
163: sub valout {
164: my ($value,$type)=@_;
165: return ($value?(($type=~/^date/)?localtime($value):$value):' ');
166: }
167:
168: # -------------------------------------------------------- Produces link anchor
169:
170: sub plink {
171: my ($type,$dis,$value,$marker,$return,$call)=@_;
172: my $winvalue=$value;
173: unless ($winvalue) {
174: if ($type=~/^date/) {
175: $winvalue=$ENV{'form.recent_'.$type};
176: } else {
177: $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
178: }
179: }
180: return
181: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
182: .$marker."','".$return."','".$call."'".');">'.
183: &valout($value,$type).'</a><a name="'.$marker.'"></a>';
184: }
185:
186: sub assessparms {
187:
188: my $r=shift;
189: # -------------------------------------------------------- Variable declaration
190: my %allkeys;
191: my %allmaps;
192: my %defp;
193: %courseopt=();
194: %useropt=();
195: %bighash=();
196:
197: @ids=();
198: %symbp=();
199: %typep=();
200:
201: my $message='';
202:
203: $csec=$ENV{'form.csec'};
204: $udom=$ENV{'form.udom'};
205: unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
206:
207: my $pscat=$ENV{'form.pscat'};
208: my $pschp=$ENV{'form.pschp'};
209: my $pssymb='';
210:
211: # ----------------------------------------------- Was this started from grades?
212:
213: if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
214: && (!$ENV{'form.dis'})) {
215: my $url=$ENV{'form.url'};
216: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
217: $pssymb=&Apache::lonnet::symbread($url);
218: $pscat='all';
219: $pschp='';
220: } elsif ($ENV{'form.symb'}) {
221: $pssymb=$ENV{'form.symb'};
222: $pscat='all';
223: $pschp='';
224: } else {
225: $ENV{'form.url'}='';
226: }
227:
228: my $id=$ENV{'form.id'};
229: if (($id) && ($udom)) {
230: $uname=(&Apache::lonnet::idget($udom,$id))[1];
231: if ($uname) {
232: $id='';
233: } else {
234: $message=
235: "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
236: }
237: } else {
238: $uname=$ENV{'form.uname'};
239: }
240: unless ($udom) { $uname=''; }
241: $uhome='';
242: if ($uname) {
243: $uhome=&Apache::lonnet::homeserver($uname,$udom);
244: if ($uhome eq 'no_host') {
245: $message=
246: "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
247: $uname='';
248: } else {
249: $csec=&Apache::lonnet::usection($udom,$uname,
250: $ENV{'request.course.id'});
251: if ($csec eq '-1') {
252: $message="<font color=red>".
253: "User '$uname' at domain '$udom' not in this course</font>";
254: $uname='';
255: $csec=$ENV{'form.csec'};
256: } else {
257: my %name=&Apache::lonnet::userenvironment($udom,$uname,
258: ('firstname','middlename','lastname','generation','id'));
259: $message="\n<p>\nFull Name: ".
260: $name{'firstname'}.' '.$name{'middlename'}.' '
261: .$name{'lastname'}.' '.$name{'generation'}.
262: "<br>\nID: ".$name{'id'}.'<p>';
263: }
264: }
265: }
266:
267: unless ($csec) { $csec=''; }
268:
269: $fcat=$ENV{'form.fcat'};
270: unless ($fcat) { $fcat=''; }
271:
272: # ------------------------------------------------------------------- Tie hashs
273: if ((tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
274: &GDBM_READER,0640)) &&
275: (tie(%parmhash,'GDBM_File',
276: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
277:
278: # --------------------------------------------------------- Get all assessments
279: foreach (keys %bighash) {
280: if ($_=~/^src\_(\d+)\.(\d+)$/) {
281: my $mapid=$1;
282: my $resid=$2;
283: my $id=$mapid.'.'.$resid;
284: my $srcf=$bighash{$_};
285: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
286: $ids[$#ids+1]=$id;
287: $typep{$id}=$1;
288: $keyp{$id}='';
289: foreach (split(/\,/,
290: &Apache::lonnet::metadata($srcf,'keys'))) {
291: if ($_=~/^parameter\_(.*)/) {
292: my $key=$_;
293: my $allkey=$1;
294: $allkey=~s/\_/\./;
295: my $display=
296: &Apache::lonnet::metadata($srcf,$key.'.display');
297: unless ($display) {
298: $display=
299: &Apache::lonnet::metadata($srcf,$key.'.name');
300: }
301: $allkeys{$allkey}=$display;
302: if ($allkey eq $fcat) {
303: $defp{$id}=
304: &Apache::lonnet::metadata($srcf,$key);
305: }
306: if ($keyp{$id}) {
307: $keyp{$id}.=','.$key;
308: } else {
309: $keyp{$id}=$key;
310: }
311: }
312: }
313: $mapp{$id}=
314: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
315: $allmaps{$mapid}=$mapp{$id};
316: $symbp{$id}=$mapp{$id}.
317: '___'.$resid.'___'.
318: &Apache::lonnet::declutter($srcf);
319: }
320: }
321: }
322: # ---------------------------------------------------------- Anything to store?
323: if ($ENV{'form.pres_marker'}) {
324: my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
325: $spnam=~s/\_([^\_]+)$/\.$1/;
326: # ---------------------------------------------------------- Construct prefixes
327:
328: my $symbparm=$symbp{$sresid}.'.'.$spnam;
329: my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
330:
331: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
332: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
333: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
334:
335: my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
336: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
337: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
338:
339: my $storeunder='';
340: if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
341: if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
342: if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
343: if ($snum==6) { $storeunder=$seclevel; }
344: if ($snum==5) { $storeunder=$seclevelm; }
345: if ($snum==4) { $storeunder=$seclevelr; }
346: $storeunder=&Apache::lonnet::escape($storeunder);
347:
348: my $storecontent=
349: $storeunder.'='.
350: &Apache::lonnet::escape($ENV{'form.pres_value'}).'&'.
351: $storeunder.'.type='.
352: &Apache::lonnet::escape($ENV{'form.pres_type'});
353:
354: my $reply='';
355: if ($snum>3) {
356: # ---------------------------------------------------------------- Store Course
357: #
358: # Expire sheets
359: &Apache::lonnet::expirespread('','','studentcalc');
360: if (($snum==7) || ($snum==4)) {
361: &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
362: } elsif (($snum==8) || ($snum==5)) {
363: &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
364: } else {
365: &Apache::lonnet::expirespread('','','assesscalc');
366: }
367:
368: # Store parameter
369: $reply=&Apache::lonnet::critical('put:'.
370: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
371: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata:'.
372: $storecontent,
373: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
374: } else {
375: # ------------------------------------------------------------------ Store User
376: #
377: # Expire sheets
378: &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
379: if ($snum==1) {
380: &Apache::lonnet::expirespread
381: ($uname,$udom,'assesscalc',$symbp{$sresid});
382: } elsif ($snum==2) {
383: &Apache::lonnet::expirespread
384: ($uname,$udom,'assesscalc',$mapp{$sresid});
385: } else {
386: &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
387: }
388:
389: # Store parameter
390: $reply=
391: &Apache::lonnet::critical('put:'.$udom.':'.$uname.':resourcedata:'.
392: $storecontent,$uhome);
393: }
394:
395: if ($reply=~/^error\:(.*)/) {
396: $message.="<font color=red>Write Error: $1</font>";
397: }
398: # ---------------------------------------------------------------- Done storing
399: }
400: # -------------------------------------------------------------- Get coursedata
401: my $reply=&Apache::lonnet::reply('dump:'.
402: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.':'.
403: $ENV{'course.'.$ENV{'request.course.id'}.'.num'}.':resourcedata',
404: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
405: if ($reply!~/^error\:/) {
406: foreach (split(/\&/,$reply)) {
407: my ($name,$value)=split(/\=/,$_);
408: $courseopt{&Apache::lonnet::unescape($name)}=
409: &Apache::lonnet::unescape($value);
410: }
411: }
412: # --------------------------------------------------- Get userdata (if present)
413: if ($uname) {
414: my $reply=
415: &Apache::lonnet::reply('dump:'.$udom.':'.$uname.':resourcedata',$uhome);
416: if ($reply!~/^error\:/) {
417: foreach (split(/\&/,$reply)) {
418: my ($name,$value)=split(/\=/,$_);
419: $useropt{&Apache::lonnet::unescape($name)}=
420: &Apache::lonnet::unescape($value);
421: }
422: }
423: }
424:
425: # ------------------------------------------------------------------- Sort this
426:
427: @ids=sort {
428: if ($fcat eq '') {
429: $a<=>$b;
430: } else {
431: 1*$outpar[&parmval($fcat,$a,$defp{$a})]<=>
432: 1*$outpar[&parmval($fcat,$b,$defp{$b})];
433: }
434: } @ids;
435:
436: # ------------------------------------------------------------------ Start page
437: $r->content_type('text/html');
438: $r->send_http_header;
439: $r->print(<<ENDHEAD);
440: <html>
441: <head>
442: <title>LON-CAPA Course Parameters</title>
443: <script>
444:
445: function pclose() {
446: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
447: "height=350,width=350,scrollbars=no,menubar=no");
448: parmwin.close();
449: }
450:
451: function pjump(type,dis,value,marker,ret,call) {
452: document.parmform.pres_marker.value='';
453: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
454: +"&value="+escape(value)+"&marker="+escape(marker)
455: +"&return="+escape(ret)
456: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
457: "height=350,width=350,scrollbars=no,menubar=no");
458:
459: }
460:
461: function psub() {
462: pclose();
463: if (document.parmform.pres_marker.value!='') {
464: document.parmform.action+='#'+document.parmform.pres_marker.value;
465: var typedef=new Array();
466: typedef=document.parmform.pres_type.value.split('_');
467: if (document.parmform.pres_type.value!='') {
468: if (typedef[0]=='date') {
469: eval('document.parmform.recent_'+
470: document.parmform.pres_type.value+
471: '.value=document.parmform.pres_value.value;');
472: } else {
473: eval('document.parmform.recent_'+typedef[0]+
474: '.value=document.parmform.pres_value.value;');
475: }
476: }
477: document.parmform.submit();
478: } else {
479: document.parmform.pres_value.value='';
480: document.parmform.pres_marker.value='';
481: }
482: }
483:
484: </script>
485: </head>
486: <body bgcolor="#FFFFFF" onUnload="pclose()">
487: <h1>Set Course Parameters</h1>
488: <form method="post" action="/adm/parmset" name="envform">
489: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
490: <h3>Course Environment</h3>
491: <input type="submit" name="crsenv" value="Set Course Environment">
492: </form>
493: <form method="post" action="/adm/parmset" name="parmform">
494: <h3>Course Assessments</h3>
495: <b>
496: Section/Group:
497: <input type="text" value="$csec" size="6" name="csec">
498: <br>
499: For User
500: <input type="text" value="$uname" size="12" name="uname">
501: or ID
502: <input type="text" value="$id" size="12" name="id">
503: at Domain
504: <input type="text" value="$udom" size="6" name="udom">
505: </b>
506: <input type="hidden" value='' name="pres_value">
507: <input type="hidden" value='' name="pres_type">
508: <input type="hidden" value='' name="pres_marker">
509: ENDHEAD
510: if ($ENV{'form.url'}) {
511: $r->print('<input type="hidden" value="'.$ENV{'form.url'}.
512: '" name="url"><input type="hidden" name="command" value="set">');
513: }
514: foreach ('tolerance','date_default','date_start','date_end',
515: 'date_interval','int','float','string') {
516: $r->print('<input type="hidden" value="'.
517: $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
518: }
519:
520: $r->print('<h2>'.$message.'</h2><table><tr><td>Sort list by</td><td>');
521: $r->print('<select name="fcat">');
522: $r->print('<option value="">Enclosing Map</option>');
523: foreach (reverse sort keys %allkeys) {
524: $r->print('<option value="'.$_.'"');
525: if ($fcat eq $_) { $r->print(' selected'); }
526: $r->print('>'.$allkeys{$_}.'</option>');
527: }
528: $r->print('</select></tr><tr><td>Select Enclosing Map</td><td><select name=pschp>');
529: $r->print('<option value=all>All Maps</option>');
530: foreach (keys %allmaps) {
531: $r->print('<option value="'.$_.'"');
532: if (($pssymb=~/^$allmaps{$_}/) ||
533: ($pschp eq $_)) { $r->print(' selected'); }
534: $r->print('>'.$allmaps{$_}.'</option>');
535: }
536: $r->print('</select></td></tr><tr><td>Select Parameter</td><td><select name=pscat>');
537: $r->print('<option value=all>All Parameters</option>');
538: foreach (reverse sort keys %allkeys) {
539: $r->print('<option value="'.$_.'"');
540: if ($pscat eq $_) { $r->print(' selected'); }
541: $r->print('>'.$allkeys{$_}.'</option>');
542: }
543: $r->print('</select></td></tr></table><br><input name=dis type="submit" value="Display">');
544: if (($pscat) || ($pschp) || ($pssymb)) {
545: # ----------------------------------------------------------------- Start Table
546: my $catmarker='parameter_'.$pscat;
547: $catmarker=~s/\./\_/g;
548: my $coursespan=$csec?8:5;
549: my $csuname=$ENV{'user.name'};
550: my $csudom=$ENV{'user.domain'};
551: $r->print(<<ENDTABLEHEAD);
552: <p><table border=2>
553: <tr><td colspan=5></td>
554: <th colspan=$coursespan>Any User</th>
555: ENDTABLEHEAD
556: if ($uname) {
557: $r->print("<th colspan=3 rowspan=2>User $uname at Domain $udom</th>");
558: }
559: $r->print(<<ENDTABLETWO);
560: <th rowspan=3>Parameter in Effect</th>
561: <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th>
562: </tr><tr><td colspan=5></td>
563: <th colspan=2>Resource Level</th>
564: <th colspan=3>in Course</th>
565: ENDTABLETWO
566: if ($csec) {
567: $r->print("<th colspan=3>in Section/Group $csec</th>");
568: }
569: $r->print(<<ENDTABLEHEADFOUR);
570: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
571: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
572: <th>default</th><th>from Enclosing Map</th>
573: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
574: ENDTABLEHEADFOUR
575: if ($csec) {
576: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
577: }
578: if ($uname) {
579: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
580: }
581: $r->print('</tr>');
582: my $defbgone='';
583: my $defbgtwo='';
584: foreach (@ids) {
585: my $rid=$_;
586: my ($inmapid)=($rid=~/\.(\d+)$/);
587: if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
588: ($pssymb eq $mapp{$rid}.'___'.$inmapid.'___'.
589: &Apache::lonnet::declutter($bighash{'src_'.$rid}))) {
590: # ------------------------------------------------------ Entry for one resource
591: if ($defbgone eq '"E0E099"') {
592: $defbgone='"E0E0DD"';
593: } else {
594: $defbgone='"E0E099"';
595: }
596: if ($defbgtwo eq '"FFFF99"') {
597: $defbgtwo='"FFFFDD"';
598: } else {
599: $defbgtwo='"FFFF99"';
600: }
601: @outpar=();
602: my $thistitle='';
603: my %name= ();
604: undef %name;
605: my %part= ();
606: my %display=();
607: my %type= ();
608: my %default=();
609: my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
610:
611: foreach (split(/\,/,$keyp{$rid})) {
612: if (($_ eq $catmarker) || ($pscat eq 'all')) {
613: $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
614: $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
615: $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
616: unless ($display{$_}) { $display{$_}=''; }
617: $display{$_}.=' ('.$name{$_}.')';
618: $default{$_}=&Apache::lonnet::metadata($uri,$_);
619: $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
620: $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
621: }
622: }
623: my $totalparms=scalar keys %name;
624: if ($totalparms>0) {
625: my $firstrow=1;
626: $r->print('<tr><td bgcolor='.$defbgone.
627: ' rowspan='.$totalparms.'><tt><font size=-1>'.
628: join(' / ',split(/\//,$uri)).
629: '</font></tt><p><b>'.
630: $bighash{'title_'.$rid});
631: if ($thistitle) {
632: $r->print(' ('.$thistitle.')');
633: }
634: $r->print('</b></td>');
635: $r->print('<td bgcolor='.$defbgtwo.
636: ' rowspan='.$totalparms.'>'.$typep{$rid}.'</td>');
637: $r->print('<td bgcolor='.$defbgone.
638: ' rowspan='.$totalparms.'><tt><font size=-1>'.
639: join(' / ',split(/\//,$mapp{$rid})).'</font></tt></td>');
640: foreach (sort keys %name) {
641: my $result=&parmval($part{$_}.'.'.$name{$_},$rid,$default{$_});
642: unless ($firstrow) {
643: $r->print('<tr>');
644: } else {
645: $firstrow=0;
646: }
647: $r->print("<td bgcolor=".$defbgtwo.
648: ">$part{$_}</td><td bgcolor=".$defbgone.
649: ">$display{$_}</td>");
650: my $thismarker=$_;
651: $thismarker=~s/^parameter\_//;
652: my $mprefix=$rid.'&'.$thismarker.'&';
653:
654: $r->print('<td bgcolor='.
655: (($result==11)?'"#AAFFAA"':'#FFDDDD').'>'.
656: &valout($outpar[11],$type{$_}).'</td>');
657: $r->print('<td bgcolor='.
658: (($result==10)?'"#AAFFAA"':'#FFDDDD').'>'.
659: &valout($outpar[10],$type{$_}).'</td>');
660:
661: $r->print('<td bgcolor='.
662: (($result==9)?'"#AAFFAA"':$defbgone).'>'.
663: &plink($type{$_},$display{$_},$outpar[9],$mprefix.'9',
664: 'parmform.pres','psub').'</td>');
665: $r->print('<td bgcolor='.
666: (($result==8)?'"#AAFFAA"':$defbgone).'>'.
667: &plink($type{$_},$display{$_},$outpar[8],$mprefix.'8',
668: 'parmform.pres','psub').'</td>');
669: $r->print('<td bgcolor='.
670: (($result==7)?'"#AAFFAA"':$defbgone).'>'.
671: &plink($type{$_},$display{$_},$outpar[7],$mprefix.'7',
672: 'parmform.pres','psub').'</td>');
673:
674: if ($csec) {
675: $r->print('<td bgcolor='.
676: (($result==6)?'"#AAFFAA"':$defbgtwo).'>'.
677: &plink($type{$_},$display{$_},$outpar[6],$mprefix.'6',
678: 'parmform.pres','psub').'</td>');
679: $r->print('<td bgcolor='.
680: (($result==5)?'"#AAFFAA"':$defbgtwo).'>'.
681: &plink($type{$_},$display{$_},$outpar[5],$mprefix.'5',
682: 'parmform.pres','psub').'</td>');
683: $r->print('<td bgcolor='.
684: (($result==4)?'"#AAFFAA"':$defbgtwo).'>'.
685: &plink($type{$_},$display{$_},$outpar[4],$mprefix.'4',
686: 'parmform.pres','psub').'</td>');
687: }
688:
689: if ($uname) {
690: $r->print('<td bgcolor='.
691: (($result==3)?'"#AAFFAA"':$defbgone).'>'.
692: &plink($type{$_},$display{$_},$outpar[3],$mprefix.'3',
693: 'parmform.pres','psub').'</td>');
694: $r->print('<td bgcolor='.
695: (($result==2)?'"#AAFFAA"':$defbgone).'>'.
696: &plink($type{$_},$display{$_},$outpar[2],$mprefix.'2',
697: 'parmform.pres','psub').'</td>');
698: $r->print('<td bgcolor='.
699: (($result==1)?'"#AAFFAA"':$defbgone).'>'.
700: &plink($type{$_},$display{$_},$outpar[1],$mprefix.'1',
701: 'parmform.pres','psub').'</td>');
702: }
703: $r->print('<td bgcolor=#CCCCFF>'.&valout($outpar[$result],$type{$_}).'</td>');
704: my $sessionval=&Apache::lonnet::EXT('resource.'.$part{$_}.
705: '.'.$name{$_},$mapp{$rid}.'___'.$inmapid.'___'.$uri);
706: if (($type{$_}=~/^date/) && ($sessionval))
707: { $sessionval=localtime($sessionval); }
708: $r->print('<td bgcolor=#999999><font color=#FFFFFF>'.$sessionval.' '.
709: '</font></td>');
710: $r->print("</tr>");
711: }
712: }
713: # -------------------------------------------------- End entry for one resource
714: }
715: }
716: $r->print('</table>');
717: }
718: $r->print('</form></body></html>');
719: untie(%bighash);
720: untie(%parmhash);
721: }
722: }
723:
724: sub crsenv {
725: my $r=shift;
726: my $setoutput='';
727: # -------------------------------------------------- Go through list of changes
728: foreach (keys %ENV) {
729: if ($_=~/^form\.(.+)\_setparmval$/) {
730: my $name=$1;
731: my $value=$ENV{'form.'.$name.'_value'};
732: if ($name eq 'newp') {
733: $name=$ENV{'form.newp_name'};
734: }
735: if ($name eq 'url') {
736: $value=~s/^\/res\///;
737: $setoutput.='Backing up previous URL: '.
738: &Apache::lonnet::reply('put:'.
739: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
740: ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
741: ':environment:'.
742: &Apache::lonnet::escape('top level map backup '.
743: time).'='.
744: &Apache::lonnet::reply('get:'.
745: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
746: ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
747: ':environment:url',
748: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}),
749: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}).
750: '<br>';
751:
752: }
753: if ($name) {
754: $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
755: $value.'</tt>: '.
756: &Apache::lonnet::reply('put:'.
757: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
758: ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
759: ':environment:'.
760: &Apache::lonnet::escape($name).'='.
761: &Apache::lonnet::escape($value),
762: $ENV{'course.'.$ENV{'request.course.id'}.'.home'}).
763: '<br>';
764: }
765: }
766: }
767: # -------------------------------------------------------- Get parameters again
768: my $rep=&Apache::lonnet::reply
769: ('dump:'.$ENV{'course.'.$ENV{'request.course.id'}.'.domain'}.
770: ':'.$ENV{'course.'.$ENV{'request.course.id'}.'.num'}.
771: ':environment',
772: $ENV{'course.'.$ENV{'request.course.id'}.'.home'});
773: my $output='';
774: if ($rep ne 'con_lost') {
775: my %values;
776: my %descriptions=
777: ('url' => '<b>Top Level Map</b><br><font color=red> Modification may make assessment data inaccessible</font>',
778: 'description' => '<b>Course Description</b>',
779: 'courseid' => '<b>Course ID or number</b><br>(internal, optional)',
780: 'question.email' => '<b>Feedback Addresses for Content Questions</b><br>(<tt>user:domain,user:domain,...</tt>)',
781: 'comment.email' => '<b>Feedback Addresses for Comments</b><br>(<tt>user:domain,user:domain,...</tt>)',
782: 'policy.email' => '<b>Feedback Addresses for Course Policy</b><br>(<tt>user:domain,user:domain,...</tt>)',
783: 'hideemptyrows' => '<b>Hide Empty Rows in Spreadsheets</b><br>("<tt>yes</tt>" for default hiding)',
784: 'pch.roles.denied'=> '<b>Disallow Resource Discussion for Students</b><br>"<tt>st</tt>": student, "<tt>ta</tt>": TA, "<tt>in</tt>": instructor;<br><tt>role,role,...</tt>)'
785: );
786:
787: foreach (split(/\&/,$rep)) {
788: my ($name,$value)=split(/\=/,$_);
789: $name=&Apache::lonnet::unescape($name);
790: $values{$name}=&Apache::lonnet::unescape($value);
791: unless ($descriptions{$name}) {
792: $descriptions{$name}=$name;
793: }
794: }
795: foreach (sort keys %descriptions) {
796: $output.='<tr><td>'.$descriptions{$_}.'</td><td><input name="'.
797: $_.'_value" size=40 value="'.
798: $values{$_}.
799: '"></td><td><input type=checkbox name="'.$_.
800: '_setparmval"></td></tr>';
801: }
802: $output.='<tr><td><i>Create New Environment Variable</i><br>'.
803: '<input type="text" size=40 name="newp_name"></td><td>'.
804: '<input type="text" size=40 name="newp_value"></td><td>'.
805: '<input type="checkbox" name="newp_setparmval"></td></tr>';
806: }
807: $r->print(<<ENDENV);
808: <html>
809: <head>
810: <title>LON-CAPA Course Environment</title>
811: </head>
812: <body bgcolor="#FFFFFF">
813: <h1>Set Course Parameters</h1>
814: <form method="post" action="/adm/parmset" name="envform">
815: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
816: <h3>Course Environment</h3>
817: $setoutput
818: <p>
819: <table border=2>
820: <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr>
821: $output
822: </table>
823: <input type="submit" name="crsenv" value="Set Course Environment">
824: </form>
825: </body>
826: </html>
827: ENDENV
828: }
829:
830: # ================================================================ Main Handler
831:
832: sub handler {
833: my $r=shift;
834:
835: if ($r->header_only) {
836: $r->content_type('text/html');
837: $r->send_http_header;
838: return OK;
839: }
840: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
841: # ----------------------------------------------------- Needs to be in a course
842:
843: if (($ENV{'request.course.id'}) &&
844: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
845:
846: unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
847: # --------------------------------------------------------- Bring up assessment
848: &assessparms($r);
849: # ---------------------------------------------- This is for course environment
850: } else {
851: &crsenv($r);
852: }
853: } else {
854: # ----------------------------- Not in a course, or not allowed to modify parms
855: $ENV{'user.error.msg'}=
856: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
857: return HTTP_NOT_ACCEPTABLE;
858: }
859: return OK;
860: }
861:
862: 1;
863: __END__
864:
865:
866: =head1 NAME
867:
868: Apache::lonparmset - Handler to set parameters for assessments
869:
870: =head1 SYNOPSIS
871:
872: Invoked by /etc/httpd/conf/srm.conf:
873:
874: <Location /adm/parmset>
875: PerlAccessHandler Apache::lonacc
876: SetHandler perl-script
877: PerlHandler Apache::lonparmset
878: ErrorDocument 403 /adm/login
879: ErrorDocument 406 /adm/roles
880: ErrorDocument 500 /adm/errorhandler
881: </Location>
882:
883: =head1 INTRODUCTION
884:
885: This module sets assessment parameters.
886:
887: This is part of the LearningOnline Network with CAPA project
888: described at http://www.lon-capa.org.
889:
890: =head1 HANDLER SUBROUTINE
891:
892: This routine is called by Apache and mod_perl.
893:
894: =over 4
895:
896: =item *
897:
898: need to be in course
899:
900: =item *
901:
902: bring up assessment screen or course environment
903:
904: =back
905:
906: =head1 OTHER SUBROUTINES
907:
908: =over 4
909:
910: =item *
911:
912: parmval() : figure out a cascading parameter
913:
914: =item *
915:
916: valout() : output for value
917:
918: =item *
919:
920: plink() : produces link anchor
921:
922: =item *
923:
924: assessparms() : show assess data and parameters
925:
926: =item *
927:
928: crsenv() : for the course environment
929:
930: =back
931:
932: =cut
933:
934:
935:
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