Annotation of loncom/interface/lonparmset.pm, revision 1.58
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
1.58 ! albertel 4: # $Id: lonparmset.pm,v 1.57 2002/08/08 17:03:20 albertel Exp $
1.40 albertel 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: #
1.1 www 28: # (Handler to resolve ambiguous file locations
29: #
30: # (TeX Content Handler
31: #
1.38 harris41 32: # YEAR=2000
1.1 www 33: # 05/29/00,05/30,10/11 Gerd Kortemeyer)
34: #
35: # 10/11,10/12,10/16 Gerd Kortemeyer)
36: #
1.20 www 37: # 11/20,11/21,11/22,11/23,11/24,11/25,11/27,11/28,
1.21 www 38: # 12/08,12/12,
1.38 harris41 39: # YEAR=2001
1.30 www 40: # 16/01/01,02/08,03/20,03/23,03/24,03/26,05/09,
1.35 www 41: # 07/05,07/06,08/08,08/09,09/01,09/21 Gerd Kortemeyer
1.38 harris41 42: # 12/17 Scott Harrison
1.41 www 43: # 12/19 Guy Albertelli
1.42 www 44: # 12/26,12/27 Gerd Kortemeyer
1.38 harris41 45: #
1.55 bowersj2 46: # YEAR=2002
47: # 7/19 Jeremy Bowers
1.38 harris41 48: ###
1.1 www 49:
50: package Apache::lonparmset;
51:
52: use strict;
53: use Apache::lonnet;
54: use Apache::Constants qw(:common :http REDIRECT);
1.36 albertel 55: use Apache::loncommon;
1.1 www 56: use GDBM_File;
1.57 albertel 57: use Apache::lonhomework;
58: use Apache::lonxml;
1.4 www 59:
1.1 www 60:
1.2 www 61: my %courseopt;
62: my %useropt;
63: my %parmhash;
64:
1.3 www 65: my @ids;
66: my %symbp;
1.10 www 67: my %mapp;
1.3 www 68: my %typep;
1.16 www 69: my %keyp;
1.2 www 70:
71: my $uname;
72: my $udom;
73: my $uhome;
74: my $csec;
1.57 albertel 75: my $coursename;
1.2 www 76:
77: # -------------------------------------------- Figure out a cascading parameter
78:
79: sub parmval {
1.11 www 80: my ($what,$id,$def)=@_;
1.8 www 81: my $result='';
1.44 albertel 82: my @outpar=();
1.2 www 83: # ----------------------------------------------------- Cascading lookup scheme
1.10 www 84:
1.43 albertel 85: my $symbparm=$symbp{$id}.'.'.$what;
86: my $mapparm=$mapp{$id}.'___(all).'.$what;
1.10 www 87:
1.43 albertel 88: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$what;
89: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
90: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
91:
92: my $courselevel=$ENV{'request.course.id'}.'.'.$what;
93: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
94: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
1.2 www 95:
1.11 www 96: # -------------------------------------------------------- first, check default
97:
1.43 albertel 98: if ($def) { $outpar[11]=$def; $result=11; }
1.11 www 99:
100: # ----------------------------------------------------- second, check map parms
101:
1.43 albertel 102: my $thisparm=$parmhash{$symbparm};
103: if ($thisparm) { $outpar[10]=$thisparm; $result=10; }
1.11 www 104:
105: # --------------------------------------------------------- third, check course
106:
1.43 albertel 107: if ($courseopt{$courselevel}) {
108: $outpar[9]=$courseopt{$courselevel};
109: $result=9;
110: }
1.11 www 111:
1.43 albertel 112: if ($courseopt{$courselevelm}) {
113: $outpar[8]=$courseopt{$courselevelm};
114: $result=8;
115: }
1.11 www 116:
1.43 albertel 117: if ($courseopt{$courselevelr}) {
118: $outpar[7]=$courseopt{$courselevelr};
119: $result=7;
120: }
1.11 www 121:
1.43 albertel 122: if ($csec) {
123: if ($courseopt{$seclevel}) {
124: $outpar[6]=$courseopt{$seclevel};
125: $result=6;
126: }
127: if ($courseopt{$seclevelm}) {
128: $outpar[5]=$courseopt{$seclevelm};
129: $result=5;
130: }
131:
132: if ($courseopt{$seclevelr}) {
133: $outpar[4]=$courseopt{$seclevelr};
134: $result=4;
135: }
136: }
1.11 www 137:
138: # ---------------------------------------------------------- fourth, check user
139:
1.43 albertel 140: if ($uname) {
141: if ($useropt{$courselevel}) {
142: $outpar[3]=$useropt{$courselevel};
143: $result=3;
144: }
1.10 www 145:
1.43 albertel 146: if ($useropt{$courselevelm}) {
147: $outpar[2]=$useropt{$courselevelm};
148: $result=2;
149: }
1.2 www 150:
1.43 albertel 151: if ($useropt{$courselevelr}) {
152: $outpar[1]=$useropt{$courselevelr};
153: $result=1;
154: }
155: }
1.10 www 156:
1.44 albertel 157: return ($result,@outpar);
1.2 www 158: }
159:
1.9 www 160: # ------------------------------------------------------------ Output for value
161:
162: sub valout {
163: my ($value,$type)=@_;
1.43 albertel 164: return ($value?(($type=~/^date/)?localtime($value):$value):' ');
1.9 www 165: }
166:
1.5 www 167: # -------------------------------------------------------- Produces link anchor
168:
169: sub plink {
170: my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23 www 171: my $winvalue=$value;
172: unless ($winvalue) {
173: if ($type=~/^date/) {
174: $winvalue=$ENV{'form.recent_'.$type};
175: } else {
176: $winvalue=$ENV{'form.recent_'.(split(/\_/,$type))[0]};
177: }
178: }
179: return
1.43 albertel 180: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
181: .$marker."','".$return."','".$call."'".');">'.
182: &valout($value,$type).'</a><a name="'.$marker.'"></a>';
1.5 www 183: }
184:
1.44 albertel 185:
186: sub startpage {
187: my ($r,$id,$udom,$csec,$uname)=@_;
188: $r->content_type('text/html');
189: $r->send_http_header;
190: $r->print(<<ENDHEAD);
191: <html>
192: <head>
193: <title>LON-CAPA Course Parameters</title>
194: <script>
195:
196: function pclose() {
197: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
198: "height=350,width=350,scrollbars=no,menubar=no");
199: parmwin.close();
200: }
201:
202: function pjump(type,dis,value,marker,ret,call) {
203: document.parmform.pres_marker.value='';
204: parmwin=window.open("/adm/rat/parameter.html?type="+escape(type)
205: +"&value="+escape(value)+"&marker="+escape(marker)
206: +"&return="+escape(ret)
207: +"&call="+escape(call)+"&name="+escape(dis),"LONCAPAparms",
208: "height=350,width=350,scrollbars=no,menubar=no");
209:
210: }
211:
212: function psub() {
213: pclose();
214: if (document.parmform.pres_marker.value!='') {
215: document.parmform.action+='#'+document.parmform.pres_marker.value;
216: var typedef=new Array();
217: typedef=document.parmform.pres_type.value.split('_');
218: if (document.parmform.pres_type.value!='') {
219: if (typedef[0]=='date') {
220: eval('document.parmform.recent_'+
221: document.parmform.pres_type.value+
222: '.value=document.parmform.pres_value.value;');
223: } else {
224: eval('document.parmform.recent_'+typedef[0]+
225: '.value=document.parmform.pres_value.value;');
226: }
227: }
228: document.parmform.submit();
229: } else {
230: document.parmform.pres_value.value='';
231: document.parmform.pres_marker.value='';
232: }
233: }
234:
1.57 albertel 235: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
236: var options = "width=" + w + ",height=" + h + ",";
237: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
238: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
239: var newWin = window.open(url, wdwName, options);
240: newWin.focus();
241: }
1.44 albertel 242: </script>
243: </head>
244: <body bgcolor="#FFFFFF" onUnload="pclose()">
1.57 albertel 245: <h1>Set Course Parameters for Course:
246: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h1>
1.44 albertel 247: <form method="post" action="/adm/parmset" name="envform">
248: <h3>Course Environment</h3>
249: <input type="submit" name="crsenv" value="Set Course Environment">
250: </form>
251: <form method="post" action="/adm/parmset" name="parmform">
252: <h3>Course Assessments</h3>
253: <b>
254: Section/Group:
255: <input type="text" value="$csec" size="6" name="csec">
256: <br>
257: For User
258: <input type="text" value="$uname" size="12" name="uname">
259: or ID
260: <input type="text" value="$id" size="12" name="id">
261: at Domain
262: <input type="text" value="$udom" size="6" name="udom">
263: </b>
264: <input type="hidden" value='' name="pres_value">
265: <input type="hidden" value='' name="pres_type">
266: <input type="hidden" value='' name="pres_marker">
267: ENDHEAD
268:
269: }
270:
271: sub print_row {
272: my ($r,$which,$part,$name,$rid,$default,$type,$display,$defbgone,
1.57 albertel 273: $defbgtwo,$parmlev)=@_;
1.44 albertel 274: my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
275: $rid,$$default{$which});
1.57 albertel 276: my $parm=$$display{$which};
277:
278: if ($parmlev eq 'full' || $parmlev eq 'brief') {
279: $r->print('<td bgcolor='.$defbgtwo.' align="center">'
280: .$$part{$which}.'</td>');
281: } else {
282: $parm=~s|\[.*\]\s||g;
283: }
284:
285: $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
286:
1.44 albertel 287: my $thismarker=$which;
288: $thismarker=~s/^parameter\_//;
289: my $mprefix=$rid.'&'.$thismarker.'&';
290:
1.57 albertel 291: if ($parmlev eq 'general') {
292:
293: if ($uname) {
294: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
295: } elsif ($csec) {
296: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
297: } else {
298: &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
299: }
300: } elsif ($parmlev eq 'map') {
301:
302: if ($uname) {
303: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
304: } elsif ($csec) {
305: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
306: } else {
307: &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
308: }
309: } else {
310:
311: &print_td($r,11,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
312:
313: if ($parmlev eq 'brief') {
314:
315: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
316:
317: if ($csec) {
318: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
319: }
320: if ($uname) {
321: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
322: }
323: } else {
324:
325: &print_td($r,10,'#FFDDDD',$result,\@outpar,$mprefix,$_,$type,$display);
326: &print_td($r,9,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
327: &print_td($r,8,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
328: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
329:
330: if ($csec) {
331: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
332: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
333: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,$type,$display);
334: }
335: if ($uname) {
336: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
337: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
338: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,$type,$display);
339: }
340: } # end of $brief if/else
341: } # end of $parmlev if/else
342:
343: if ($parmlev eq 'full' || $parmlev eq 'brief') {
344: $r->print('<td bgcolor=#CCCCFF align="center">'.
345: &valout($outpar[$result],$$type{$which}).'</td>');
346:
347: }
1.44 albertel 348: my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.57 albertel 349: '.'.$$name{$which},$symbp{$rid});
350: $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
351: &valout($sessionval,$$type{$which}).' '.
352: '</font></td>');
1.44 albertel 353: $r->print('</tr>');
1.57 albertel 354: $r->print("\n");
1.44 albertel 355: }
356: sub print_td {
357: my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$type,$display)=@_;
1.57 albertel 358: $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
359: ' align="center">'.
360: &plink($$type{$value},$$display{$value},$$outpar[$which],
361: $mprefix."$which",'parmform.pres','psub').'</td>'."\n");
362: }
363:
364: sub get_env_multiple {
365: my ($name) = @_;
366: my @values;
367: if (defined($ENV{$name})) {
368: # exists is it an array
369: if (ref($ENV{$name})) {
370: @values=@{ $ENV{$name} };
371: } else {
372: $values[0]=$ENV{$name};
373: }
374: }
375: return(@values);
1.44 albertel 376: }
377:
1.30 www 378: sub assessparms {
1.1 www 379:
1.43 albertel 380: my $r=shift;
1.2 www 381: # -------------------------------------------------------- Variable declaration
1.43 albertel 382: my %allkeys;
383: my %allmaps;
1.57 albertel 384: my %alllevs;
385:
386: $alllevs{'Resource Level'}='full';
387: # $alllevs{'Resource Level [BRIEF]'}='brief';
388: $alllevs{'Map Level'}='map';
389: $alllevs{'Course Level'}='general';
390:
391: my %allparms;
392: my %allparts;
393:
1.43 albertel 394: my %defp;
395: %courseopt=();
396: %useropt=();
1.44 albertel 397: my %bighash=();
1.43 albertel 398:
399: @ids=();
400: %symbp=();
401: %typep=();
402:
403: my $message='';
404:
405: $csec=$ENV{'form.csec'};
406: $udom=$ENV{'form.udom'};
407: unless ($udom) { $udom=$r->dir_config('lonDefDomain'); }
408:
1.57 albertel 409: my @pscat=&get_env_multiple('form.pscat');
1.43 albertel 410: my $pschp=$ENV{'form.pschp'};
1.57 albertel 411: my @psprt=&get_env_multiple('form.psprt');
412: my $showoptions=$ENV{'form.showoptions'};
413:
1.43 albertel 414: my $pssymb='';
1.57 albertel 415: my $parmlev='';
416: my $prevvisit=$ENV{'form.prevvisit'};
417:
418: # unless ($parmlev==$ENV{'form.parmlev'}) {
419: # $parmlev = 'full';
420: # }
421:
422: unless ($ENV{'form.parmlev'}) {
423: $parmlev = 'map';
424: } else {
425: $parmlev = $ENV{'form.parmlev'};
426: }
1.26 www 427:
1.29 www 428: # ----------------------------------------------- Was this started from grades?
429:
1.43 albertel 430: if (($ENV{'form.command'} eq 'set') && ($ENV{'form.url'})
431: && (!$ENV{'form.dis'})) {
432: my $url=$ENV{'form.url'};
433: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
434: $pssymb=&Apache::lonnet::symbread($url);
1.57 albertel 435: @pscat='all';
1.43 albertel 436: $pschp='';
1.57 albertel 437: $parmlev = 'full';
1.43 albertel 438: } elsif ($ENV{'form.symb'}) {
439: $pssymb=$ENV{'form.symb'};
1.57 albertel 440: @pscat='all';
1.43 albertel 441: $pschp='';
1.57 albertel 442: $parmlev = 'full';
1.43 albertel 443: } else {
444: $ENV{'form.url'}='';
445: }
446:
447: my $id=$ENV{'form.id'};
448: if (($id) && ($udom)) {
449: $uname=(&Apache::lonnet::idget($udom,$id))[1];
450: if ($uname) {
451: $id='';
452: } else {
453: $message=
454: "<font color=red>Unknown ID '$id' at domain '$udom'</font>";
455: }
456: } else {
457: $uname=$ENV{'form.uname'};
458: }
459: unless ($udom) { $uname=''; }
460: $uhome='';
461: if ($uname) {
462: $uhome=&Apache::lonnet::homeserver($uname,$udom);
463: if ($uhome eq 'no_host') {
464: $message=
465: "<font color=red>Unknown user '$uname' at domain '$udom'</font>";
466: $uname='';
1.12 www 467: } else {
1.43 albertel 468: $csec=&Apache::lonnet::usection($udom,$uname,
469: $ENV{'request.course.id'});
470: if ($csec eq '-1') {
471: $message="<font color=red>".
1.45 matthew 472: "User '$uname' at domain '$udom' not ".
473: "in this course</font>";
1.43 albertel 474: $uname='';
475: $csec=$ENV{'form.csec'};
476: } else {
477: my %name=&Apache::lonnet::userenvironment($udom,$uname,
478: ('firstname','middlename','lastname','generation','id'));
479: $message="\n<p>\nFull Name: ".
480: $name{'firstname'}.' '.$name{'middlename'}.' '
481: .$name{'lastname'}.' '.$name{'generation'}.
482: "<br>\nID: ".$name{'id'}.'<p>';
483: }
1.12 www 484: }
1.43 albertel 485: }
1.2 www 486:
1.43 albertel 487: unless ($csec) { $csec=''; }
1.12 www 488:
1.44 albertel 489: my $fcat=$ENV{'form.fcat'};
1.43 albertel 490: unless ($fcat) { $fcat=''; }
1.2 www 491:
492: # ------------------------------------------------------------------- Tie hashs
1.44 albertel 493: if (!(tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db',
1.58 ! albertel 494: &GDBM_READER(),0640))) {
1.44 albertel 495: $r->print("Unable to access course data. (File $ENV{'request.course.fn'}.db not tieable)");
496: return ;
497: }
498: if (!(tie(%parmhash,'GDBM_File',
1.58 ! albertel 499: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640))) {
1.44 albertel 500: $r->print("Unable to access parameter data. (File $ENV{'request.course.fn'}_parms.db not tieable)");
501: return ;
502: }
1.14 www 503: # --------------------------------------------------------- Get all assessments
1.44 albertel 504: foreach (keys %bighash) {
505: if ($_=~/^src\_(\d+)\.(\d+)$/) {
506: my $mapid=$1;
507: my $resid=$2;
508: my $id=$mapid.'.'.$resid;
509: my $srcf=$bighash{$_};
510: if ($srcf=~/\.(problem|exam|quiz|assess|survey|form)$/) {
511: $ids[$#ids+1]=$id;
512: $typep{$id}=$1;
513: $keyp{$id}='';
1.57 albertel 514: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'keys'))) {
515: if ($_=~/^parameter\_(.*)/) {
516: my $key=$_;
517: my $allkey=$1;
518: $allkey=~s/\_/\./g;
519: my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
520: my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
521: my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
522: my $parmdis = $display;
523: $parmdis =~ s|(\[Part.*$)||g;
524: my $partkey = $part;
525: $partkey =~ tr|_|.|;
526: $allparms{$name} = $parmdis;
527: $allparts{$part} = "[Part $part]";
528: $allkeys{$allkey}=$display;
529: if ($allkey eq $fcat) {
530: $defp{$id}= &Apache::lonnet::metadata($srcf,$key);
531: }
532: if ($keyp{$id}) {
533: $keyp{$id}.=','.$key;
534: } else {
535: $keyp{$id}=$key;
1.43 albertel 536: }
1.57 albertel 537: }
1.44 albertel 538: }
539: $mapp{$id}=
540: &Apache::lonnet::declutter($bighash{'map_id_'.$mapid});
1.57 albertel 541: $mapp{$mapid}=$mapp{$id};
1.44 albertel 542: $allmaps{$mapid}=$mapp{$id};
543: $symbp{$id}=$mapp{$id}.
1.14 www 544: '___'.$resid.'___'.
1.16 www 545: &Apache::lonnet::declutter($srcf);
1.57 albertel 546: $symbp{$mapid}=$mapp{$id}.'___(all)';
1.44 albertel 547: }
548: }
549: }
1.57 albertel 550: $mapp{'0.0'} = '';
551: $symbp{'0.0'} = '';
1.14 www 552: # ---------------------------------------------------------- Anything to store?
1.44 albertel 553: if ($ENV{'form.pres_marker'}) {
554: my ($sresid,$spnam,$snum)=split(/\&/,$ENV{'form.pres_marker'});
555: $spnam=~s/\_([^\_]+)$/\.$1/;
1.15 www 556: # ---------------------------------------------------------- Construct prefixes
1.14 www 557:
1.44 albertel 558: my $symbparm=$symbp{$sresid}.'.'.$spnam;
559: my $mapparm=$mapp{$sresid}.'___(all).'.$spnam;
560:
561: my $seclevel=$ENV{'request.course.id'}.'.['.$csec.'].'.$spnam;
562: my $seclevelr=$ENV{'request.course.id'}.'.['.$csec.'].'.$symbparm;
563: my $seclevelm=$ENV{'request.course.id'}.'.['.$csec.'].'.$mapparm;
564:
565: my $courselevel=$ENV{'request.course.id'}.'.'.$spnam;
566: my $courselevelr=$ENV{'request.course.id'}.'.'.$symbparm;
567: my $courselevelm=$ENV{'request.course.id'}.'.'.$mapparm;
568:
569: my $storeunder='';
570: if (($snum==9) || ($snum==3)) { $storeunder=$courselevel; }
571: if (($snum==8) || ($snum==2)) { $storeunder=$courselevelm; }
572: if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
573: if ($snum==6) { $storeunder=$seclevel; }
574: if ($snum==5) { $storeunder=$seclevelm; }
575: if ($snum==4) { $storeunder=$seclevelr; }
576:
1.45 matthew 577: my %storecontent = ($storeunder => $ENV{'form.pres_value'},
578: $storeunder.'type' => $ENV{'form.pres_type'});
1.44 albertel 579: my $reply='';
580: if ($snum>3) {
1.14 www 581: # ---------------------------------------------------------------- Store Course
1.24 www 582: #
583: # Expire sheets
1.44 albertel 584: &Apache::lonnet::expirespread('','','studentcalc');
585: if (($snum==7) || ($snum==4)) {
586: &Apache::lonnet::expirespread('','','assesscalc',$symbp{$sresid});
587: } elsif (($snum==8) || ($snum==5)) {
588: &Apache::lonnet::expirespread('','','assesscalc',$mapp{$sresid});
589: } else {
590: &Apache::lonnet::expirespread('','','assesscalc');
591: }
1.24 www 592: # Store parameter
1.45 matthew 593: $reply=&Apache::lonnet::cput
594: ('resourcedata',\%storecontent,
595: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
596: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44 albertel 597: } else {
1.14 www 598: # ------------------------------------------------------------------ Store User
1.24 www 599: #
600: # Expire sheets
1.44 albertel 601: &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
602: if ($snum==1) {
603: &Apache::lonnet::expirespread
604: ($uname,$udom,'assesscalc',$symbp{$sresid});
605: } elsif ($snum==2) {
606: &Apache::lonnet::expirespread
607: ($uname,$udom,'assesscalc',$mapp{$sresid});
608: } else {
609: &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
610: }
1.24 www 611: # Store parameter
1.45 matthew 612: $reply=&Apache::lonnet::cput
613: ('resourcedata',\%storecontent,$udom,$uname);
1.44 albertel 614: }
1.15 www 615:
1.44 albertel 616: if ($reply=~/^error\:(.*)/) {
617: $message.="<font color=red>Write Error: $1</font>";
618: }
1.15 www 619: # ---------------------------------------------------------------- Done storing
1.44 albertel 620: }
1.2 www 621: # -------------------------------------------------------------- Get coursedata
1.45 matthew 622: %courseopt = &Apache::lonnet::dump
623: ('resourcedata',
624: $ENV{'course.'.$ENV{'request.course.id'}.'.domain'},
625: $ENV{'course.'.$ENV{'request.course.id'}.'.num'});
1.44 albertel 626: # --------------------------------------------------- Get userdata (if present)
627: if ($uname) {
1.45 matthew 628: %useropt=&Apache::lonnet::dump('resourcedata',$udom,$uname);
1.44 albertel 629: }
1.14 www 630:
1.2 www 631: # ------------------------------------------------------------------- Sort this
1.17 www 632:
1.44 albertel 633: @ids=sort {
634: if ($fcat eq '') {
635: $a<=>$b;
636: } else {
637: my ($result,@outpar)=&parmval($fcat,$a,$defp{$a});
638: my $aparm=$outpar[$result];
639: ($result,@outpar)=&parmval($fcat,$b,$defp{$b});
640: my $bparm=$outpar[$result];
641: 1*$aparm<=>1*$bparm;
642: }
643: } @ids;
1.57 albertel 644: #----------------------------------------------- if all selected, fill in array
645: if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
646: if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2 www 647: # ------------------------------------------------------------------ Start page
1.44 albertel 648: &startpage($r,$id,$udom,$csec,$uname);
649: # if ($ENV{'form.url'}) {
650: # $r->print('<input type="hidden" value="'.$ENV{'form.url'}.
651: # '" name="url"><input type="hidden" name="command" value="set">');
652: # }
1.57 albertel 653: $r->print('<input type="hidden" value="true" name="prevvisit">');
654:
1.44 albertel 655: foreach ('tolerance','date_default','date_start','date_end',
656: 'date_interval','int','float','string') {
657: $r->print('<input type="hidden" value="'.
658: $ENV{'form.recent_'.$_}.'" name="recent_'.$_.'">');
659: }
660:
1.57 albertel 661: $r->print('<h2>'.$message.'</h2><table>');
662:
663: $r->print('<tr><td><hr /></td></tr>');
664:
665: my $submitmessage;
666: if (($prevvisit) || ($pschp) || ($pssymb)) {
667: $submitmessage = "Update Display";
668: } else {
669: $submitmessage = "Display";
1.13 www 670: }
1.44 albertel 671: if (!$pssymb) {
1.57 albertel 672: $r->print('<tr><td>Select Parameter Level</td><td>');
673: $r->print('<select name="parmlev">');
674: foreach (reverse sort keys %alllevs) {
675: $r->print('<option value="'.$alllevs{$_}.'"');
676: if ($parmlev eq $alllevs{$_}) {
677: $r->print(' selected');
678: }
679: $r->print('>'.$_.'</option>');
680: }
681: $r->print("</select></td>\n");
682:
683: $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
684:
685: $r->print('</tr><tr><td><hr /></td>');
686:
687: $r->print('<tr><td>Select Enclosing Map</td>');
688: $r->print('<td colspan="2"><select name="pschp">');
689: $r->print('<option value="all">All Maps</option>');
690: foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
691: $r->print('<option value="'.$_.'"');
692: if (($pschp eq $_)) { $r->print(' selected'); }
693: $r->print('>/res/'.$allmaps{$_}.'</option>');
694: }
695: $r->print("</select></td></tr>\n");
1.44 albertel 696: } else {
1.57 albertel 697: my ($map,$id,$resource)=split(/___/,$pssymb);
698: $r->print("<tr><td>Specific Resource</td><td>$resource</td>");
699: $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
700: $r->print('</tr>');
701: $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
702: }
703:
704: $r->print('<tr><td colspan="3"><hr /><input type="checkbox"');
705: if ($showoptions eq 'show') {$r->print(" checked ");}
706: $r->print(' name="showoptions" value="show" onclick="form.submit();">Show More Options<hr /></td></tr>');
707: # $r->print("<tr><td>Show: $showoptions</td></tr>");
708: # $r->print("<tr><td>pscat: @pscat</td></tr>");
709: # $r->print("<tr><td>psprt: @psprt</td></tr>");
710: # $r->print("<tr><td>fcat: $fcat</td></tr>");
711:
712: if ($showoptions eq 'show') {
713: my $tempkey;
714:
715: $r->print('<tr><td colspan="3" align="center">Select Parameters to View</td></tr>');
716:
717: $r->print('<tr><td colspan="2"><table>');
718: $r->print('<tr><td><input type="checkbox" name="pscat" value="all"');
719: $r->print(' checked') unless (@pscat);
720: $r->print('>All Parameters</td>');
721:
722: my $cnt=0;
723:
724: foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
725: keys %allparms ) {
726: ++$cnt;
727: $r->print('</tr><tr>') unless ($cnt%2);
728: $r->print('<td><input type="checkbox" name="pscat" ');
729: $r->print('value="'.$tempkey.'"');
730: if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
731: $r->print(' checked');
732: }
733: $r->print('>'.$allparms{$tempkey}.'</td>');
734: }
735: $r->print('</tr></table>');
736:
737: # $r->print('<tr><td>Select Parts</td><td>');
738: $r->print('<td><select multiple name="psprt" size="5">');
739: $r->print('<option value="all"');
740: $r->print(' selected') unless (@psprt);
741: $r->print('>All Parts</option>');
742: foreach $tempkey (sort keys %allparts) {
743: unless ($tempkey =~ /\./) {
744: $r->print('<option value="'.$tempkey.'"');
745: if ($psprt[0] eq "all" || grep $_ == $tempkey, @psprt) {
746: $r->print(' selected');
747: }
748: $r->print('>'.$allparts{$tempkey}.'</option>');
749: }
750: }
751: $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
752:
753: $r->print('<tr><td>Sort list by</td><td>');
754: $r->print('<select name="fcat">');
755: $r->print('<option value="">Enclosing Map</option>');
756: foreach (sort keys %allkeys) {
757: $r->print('<option value="'.$_.'"');
758: if ($fcat eq $_) { $r->print(' selected'); }
759: $r->print('>'.$allkeys{$_}.'</option>');
760: }
761: $r->print('</select></td>');
762:
763: $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
764:
765: } else { # hide options - include any necessary extras here
766:
767: $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
768:
769: unless (@pscat) {
770: foreach (keys %allparms ) {
771: $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
772: }
773: } else {
774: foreach (@pscat) {
775: $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
776: }
777: }
778:
779: unless (@psprt) {
780: foreach (keys %allparts ) {
781: $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
782: }
783: } else {
784: foreach (@psprt) {
785: $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
786: }
787: }
788:
1.44 albertel 789: }
1.57 albertel 790: $r->print('</table>');
791:
792: my @temp_psprt;
793: map {
794: my $t = $_;
795: push(@temp_psprt,
796: grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
797: } @psprt;
798:
799: @psprt = @temp_psprt;
800:
801: my @temp_pscat;
802: map {
803: my $cat = $_;
804: push(@temp_pscat, map { $_.'.'.$cat } @psprt);
805: } @pscat;
806:
807: @pscat = @temp_pscat;
808:
809: if (($prevvisit) || ($pschp) || ($pssymb)) {
1.10 www 810: # ----------------------------------------------------------------- Start Table
1.57 albertel 811: my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
812: my $csuname=$ENV{'user.name'};
813: my $csudom=$ENV{'user.domain'};
814:
815:
816: if ($parmlev eq 'full' || $parmlev eq 'brief') {
817:
818: my $coursespan=$csec?8:5;
819: $r->print('<p><table border=2>');
820: $r->print('<tr><td colspan=5></td>');
821: $r->print('<th colspan='.($coursespan).'>Any User</th>');
822: if ($uname) {
823: $r->print("<th colspan=3 rowspan=2>");
824: $r->print("User $uname at Domain $udom</th>");
825: }
826: $r->print(<<ENDTABLETWO);
1.33 www 827: <th rowspan=3>Parameter in Effect</th>
828: <th rowspan=3>Current Session Value<br>($csuname at $csudom)</th>
1.57 albertel 829: </tr><tr><td colspan=5></td><th colspan=2>Resource Level</th>
1.10 www 830: <th colspan=3>in Course</th>
831: ENDTABLETWO
1.57 albertel 832: if ($csec) {
833: $r->print("<th colspan=3>in Section/Group $csec</th>");
834: }
835: $r->print(<<ENDTABLEHEADFOUR);
1.11 www 836: </tr><tr><th>Assessment URL and Title</th><th>Type</th>
1.10 www 837: <th>Enclosing Map</th><th>Part No.</th><th>Parameter Name</th>
1.11 www 838: <th>default</th><th>from Enclosing Map</th>
1.10 www 839: <th>general</th><th>for Enclosing Map</th><th>for Resource</th>
840: ENDTABLEHEADFOUR
1.57 albertel 841:
842: if ($csec) {
843: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
844: }
845:
846: if ($uname) {
847: $r->print('<th>general</th><th>for Enclosing Map</th><th>for Resource</th>');
848: }
849:
850: $r->print('</tr>');
851:
852: my $defbgone='';
853: my $defbgtwo='';
854:
855: foreach (@ids) {
856:
857: my $rid=$_;
858: my ($inmapid)=($rid=~/\.(\d+)$/);
859:
860: if (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid}) ||
861: ($pssymb eq $symbp{$rid})) {
1.4 www 862: # ------------------------------------------------------ Entry for one resource
1.57 albertel 863: if ($defbgone eq '"E0E099"') {
864: $defbgone='"E0E0DD"';
865: } else {
866: $defbgone='"E0E099"';
867: }
868: if ($defbgtwo eq '"FFFF99"') {
869: $defbgtwo='"FFFFDD"';
870: } else {
871: $defbgtwo='"FFFF99"';
872: }
873: my $thistitle='';
874: my %name= ();
875: undef %name;
876: my %part= ();
877: my %display=();
878: my %type= ();
879: my %default=();
880: my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
881:
882: foreach (split(/\,/,$keyp{$rid})) {
883: my $tempkeyp = $_;
884: if (grep $_ eq $tempkeyp, @catmarker) {
885: $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
886: $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
887: $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
888: unless ($display{$_}) { $display{$_}=''; }
889: $display{$_}.=' ('.$name{$_}.')';
890: $default{$_}=&Apache::lonnet::metadata($uri,$_);
891: $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
892: $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
893: }
894: }
895: my $totalparms=scalar keys %name;
896: if ($totalparms>0) {
897: my $firstrow=1;
898:
899: $r->print('<tr><td bgcolor='.$defbgone.
900: ' rowspan='.$totalparms.
901: '><tt><font size=-1>'.
902: join(' / ',split(/\//,$uri)).
903: '</font></tt><p><b>'.
904: "<a href=\"javascript:openWindow('/res/".$uri.
905: "', 'metadatafile', '450', '500', 'no', 'yes')\";".
906: " TARGET=_self>$bighash{'title_'.$rid}");
907:
908: if ($thistitle) {
909: $r->print(' ('.$thistitle.')');
910: }
911: $r->print('</a></b></td>');
912: $r->print('<td bgcolor='.$defbgtwo.
913: ' rowspan='.$totalparms.'>'.$typep{$rid}.
914: '</td>');
915:
916: $r->print('<td bgcolor='.$defbgone.
917: ' rowspan='.$totalparms.
918: '><tt><font size=-1>');
919:
920: $r->print(' / res / ');
921: $r->print(join(' / ', split(/\//,$mapp{$rid})));
922:
923: $r->print('</font></tt></td>');
924:
925: foreach (sort keys %name) {
926: unless ($firstrow) {
927: $r->print('<tr>');
928: } else {
929: undef $firstrow;
930: }
931:
932: &print_row($r,$_,\%part,\%name,$rid,\%default,
933: \%type,\%display,$defbgone,$defbgtwo,
934: $parmlev);
935: }
936: }
937: }
938: } # end foreach ids
1.43 albertel 939: # -------------------------------------------------- End entry for one resource
1.57 albertel 940: $r->print('</table>');
941: } # end of brief/full
942: #--------------------------------------------------- Entry for parm level map
943: if ($parmlev eq 'map') {
944: my $defbgone = '"E0E099"';
945: my $defbgtwo = '"FFFF99"';
946:
947: my %maplist;
948:
949: if ($pschp eq 'all') {
950: %maplist = %allmaps;
951: } else {
952: %maplist = ($pschp => $mapp{$pschp});
953: }
954:
955: #-------------------------------------------- for each map, gather information
956: my $mapid;
957: foreach $mapid (keys %maplist) {
958: my $maptitle = $allmaps{$mapid};
959:
960: #----------------------- loop through ids and get all parameter types for map
961: #----------------------------------------- and associated information
962: my %name = ();
963: my %part = ();
964: my %display = ();
965: my %type = ();
966: my %default = ();
967: my $map = 0;
968:
969: # $r->print("Catmarker: @catmarker<br />\n");
970:
971: foreach (@ids) {
972: ($map)=(/([\d]*?)\./);
973: my $rid = $_;
974:
975: # $r->print("$mapid:$map: $rid <br /> \n");
976:
977: if ($map eq $mapid) {
978: my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
979: # $r->print("Keys: $keyp{$rid} <br />\n");
980:
981: #--------------------------------------------------------------------
982: # @catmarker contains list of all possible parameters including part #s
983: # $fullkeyp contains the full part/id # for the extraction of proper parameters
984: # $tempkeyp contains part 0 only (no ids - ie, subparts)
985: # When storing information, store as part 0
986: # When requesting information, request from full part
987: #-------------------------------------------------------------------
988: foreach (split(/\,/,$keyp{$rid})) {
989: my $tempkeyp = $_;
990: my $fullkeyp = $tempkeyp;
991: $tempkeyp =~ s/_[\d_]+_/_0_/;
992:
993: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
994: $part{$tempkeyp}="0";
995: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
996: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
997: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
998: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
999: $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
1000: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1001: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1002: }
1003: } # end loop through keys
1004: }
1005: } # end loop through ids
1006:
1007: #---------------------------------------------------- print header information
1008: $r->print(<<ENDMAPONE);
1009: <center><h4>
1010: <font color="red">Set Defaults for All Resources in map
1011: <i>$maptitle</i><br />
1012: Specifically for
1013: ENDMAPONE
1014: if ($uname) {
1015: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1016: ('firstname','middlename','lastname','generation', 'id'));
1017: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1018: .$name{'lastname'}.' '.$name{'generation'};
1019: $r->print("User <i>$uname \($person\) </i> in \n");
1020: } else {
1021: $r->print("<i>all</i> users in \n");
1022: }
1023:
1024: if ($csec) {$r->print("Section <i>$csec</i> of \n")};
1025:
1026: $r->print("<i>$coursename</i><br />");
1027: $r->print("</font></h4>\n");
1028: #---------------------------------------------------------------- print table
1029: $r->print('<p><table border="2">');
1030: $r->print('<tr><th>Parameter Name</th>');
1031: $r->print('<th>Default Value</th>');
1032: $r->print('<th>Parameter in Effect</th></tr>');
1033:
1034: foreach (sort keys %name) {
1035: &print_row($r,$_,\%part,\%name,$mapid,\%default,
1036: \%type,\%display,$defbgone,$defbgtwo,
1037: $parmlev);
1038: # $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
1039: }
1040: $r->print("</table></center>");
1041: } # end each map
1042: } # end of $parmlev eq map
1043: #--------------------------------- Entry for parm level general (Course level)
1044: if ($parmlev eq 'general') {
1045: my $defbgone = '"E0E099"';
1046: my $defbgtwo = '"FFFF99"';
1047:
1048: #-------------------------------------------- for each map, gather information
1049: my $mapid="0.0";
1050: #----------------------- loop through ids and get all parameter types for map
1051: #----------------------------------------- and associated information
1052: my %name = ();
1053: my %part = ();
1054: my %display = ();
1055: my %type = ();
1056: my %default = ();
1057:
1058: foreach (@ids) {
1059: my $rid = $_;
1060:
1061: my $uri=&Apache::lonnet::declutter($bighash{'src_'.$rid});
1062:
1063: #--------------------------------------------------------------------
1064: # @catmarker contains list of all possible parameters including part #s
1065: # $fullkeyp contains the full part/id # for the extraction of proper parameters
1066: # $tempkeyp contains part 0 only (no ids - ie, subparts)
1067: # When storing information, store as part 0
1068: # When requesting information, request from full part
1069: #-------------------------------------------------------------------
1070: foreach (split(/\,/,$keyp{$rid})) {
1071: my $tempkeyp = $_;
1072: my $fullkeyp = $tempkeyp;
1073: $tempkeyp =~ s/_[\d_]+_/_0_/;
1074: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1075: $part{$tempkeyp}="0";
1076: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1077: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
1078: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
1079: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1080: $display{$tempkeyp} =~ s/_[\d_]+_/_0_/;
1081: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1082: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1083: }
1084: } # end loop through keys
1085: } # end loop through ids
1086:
1087: #---------------------------------------------------- print header information
1088: $r->print(<<ENDMAPONE);
1089: <center><h4>
1090: <font color="red">Set Defaults for All Resources in Course
1091: <i>$coursename</i><br />
1092: ENDMAPONE
1093: if ($uname) {
1094: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1095: ('firstname','middlename','lastname','generation', 'id'));
1096: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1097: .$name{'lastname'}.' '.$name{'generation'};
1098: $r->print(" User <i>$uname \($person\) </i> \n");
1099: } else {
1100: $r->print("<i>ALL</i> USERS \n");
1101: }
1102:
1103: if ($csec) {$r->print("Section <i>$csec</i>\n")};
1104: $r->print("</font></h4>\n");
1105: #---------------------------------------------------------------- print table
1106: $r->print('<p><table border="2">');
1107: $r->print('<tr><th>Parameter Name</th>');
1108: $r->print('<th>Default Value</th>');
1109: $r->print('<th>Parameter in Effect</th></tr>');
1110:
1111: foreach (sort keys %name) {
1112: &print_row($r,$_,\%part,\%name,$mapid,\%default,
1113: \%type,\%display,$defbgone,$defbgtwo,$parmlev);
1114: # $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
1115: }
1116: $r->print("</table></center>");
1117: } # end of $parmlev eq general
1.43 albertel 1118: }
1.44 albertel 1119: $r->print('</form></body></html>');
1120: untie(%bighash);
1121: untie(%parmhash);
1.57 albertel 1122: } # end sub assessparms
1.30 www 1123:
1.57 albertel 1124: # ------------------------------------------- Set course environment parameters
1.30 www 1125: sub crsenv {
1126: my $r=shift;
1127: my $setoutput='';
1.45 matthew 1128: my $dom = $ENV{'course.'.$ENV{'request.course.id'}.'.domain'};
1129: my $crs = $ENV{'course.'.$ENV{'request.course.id'}.'.num'};
1.30 www 1130: # -------------------------------------------------- Go through list of changes
1.38 harris41 1131: foreach (keys %ENV) {
1.30 www 1132: if ($_=~/^form\.(.+)\_setparmval$/) {
1133: my $name=$1;
1134: my $value=$ENV{'form.'.$name.'_value'};
1135: if ($name eq 'newp') {
1136: $name=$ENV{'form.newp_name'};
1137: }
1138: if ($name eq 'url') {
1139: $value=~s/^\/res\///;
1.45 matthew 1140: my @tmp = &Apache::lonnet::get
1141: ('environment',['url'],$dom,$crs);
1.30 www 1142: $setoutput.='Backing up previous URL: '.
1.45 matthew 1143: &Apache::lonnet::put
1144: ('environment',
1145: {'top level map backup ' => $tmp[1] },
1146: $dom,$crs).
1147: '<br>';
1.30 www 1148: }
1149: if ($name) {
1.45 matthew 1150: $setoutput.='Setting <tt>'.$name.'</tt> to <tt>'.
1151: $value.'</tt>: '.
1152: &Apache::lonnet::put
1153: ('environment',{$name=>$value},$dom,$crs).
1154: '<br>';
1.30 www 1155: }
1156: }
1.38 harris41 1157: }
1.30 www 1158: # -------------------------------------------------------- Get parameters again
1.45 matthew 1159:
1160: my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.30 www 1161: my $output='';
1.45 matthew 1162: if (! exists($values{'con_lost'})) {
1.30 www 1163: my %descriptions=
1.47 matthew 1164: ('url' => '<b>Top Level Map</b> '.
1.46 matthew 1165: '<a href="javascript:openbrowser'.
1.47 matthew 1166: "('envform','url','sequence')\">".
1.46 matthew 1167: 'Browse</a><br><font color=red> '.
1.45 matthew 1168: 'Modification may make assessment data '.
1169: 'inaccessible</font>',
1170: 'description' => '<b>Course Description</b>',
1171: 'courseid' => '<b>Course ID or number</b><br>'.
1172: '(internal, optional)',
1.52 www 1173: 'default_xml_style' => '<b>Default XML Style File</b> '.
1174: '<a href="javascript:openbrowser'.
1175: "('envform','default_xml_style'".
1176: ",'sty')\">Browse</a><br>",
1.45 matthew 1177: 'question.email' => '<b>Feedback Addresses for Content '.
1178: 'Questions</b><br>(<tt>user:domain,'.
1179: 'user:domain,...</tt>)',
1180: 'comment.email' => '<b>Feedback Addresses for Comments</b><br>'.
1181: '(<tt>user:domain,user:domain,...</tt>)',
1182: 'policy.email' => '<b>Feedback Addresses for Course Policy</b>'.
1183: '<br>(<tt>user:domain,user:domain,...</tt>)',
1184: 'hideemptyrows' => '<b>Hide Empty Rows in Spreadsheets</b><br>'.
1185: '("<tt>yes</tt>" for default hiding)',
1.54 www 1186: 'pageseparators' => '<b>Visibly Separate Items on Pages</b><br>'.
1187: '("<tt>yes</tt>" for visible separation)',
1.45 matthew 1188: 'pch.roles.denied'=> '<b>Disallow Resource Discussion for '.
1.57 albertel 1189: 'Roles</b> ' .
1190: Apache::loncommon::help_open_topic("Course_Disable_Discussion")
1191: ,
1.53 www 1192: 'pch.users.denied' =>
1193: '<b>Disallow Resource Discussion for Users</b><br>'.
1194: '(<tt>user:domain,user:domain,...</tt>)',
1.49 matthew 1195: 'spreadsheet_default_classcalc'
1.52 www 1196: => '<b>Default Course Spreadsheet</b> '.
1.50 matthew 1197: '<a href="javascript:openbrowser'.
1198: "('envform','spreadsheet_default_classcalc'".
1199: ",'spreadsheet')\">Browse</a><br>",
1.49 matthew 1200: 'spreadsheet_default_studentcalc'
1.52 www 1201: => '<b>Default Student Spreadsheet</b> '.
1.50 matthew 1202: '<a href="javascript:openbrowser'.
1203: "('envform','spreadsheet_default_calc'".
1204: ",'spreadsheet')\">Browse</a><br>",
1.49 matthew 1205: 'spreadsheet_default_assesscalc'
1.52 www 1206: => '<b>Default Assessment Spreadsheet</b> '.
1.50 matthew 1207: '<a href="javascript:openbrowser'.
1208: "('envform','spreadsheet_default_assesscalc'".
1209: ",'spreadsheet')\">Browse</a><br>",
1.45 matthew 1210: );
1211: foreach (keys(%values)) {
1212: unless ($descriptions{$_}) {
1213: $descriptions{$_}=$_;
1.43 albertel 1214: }
1215: }
1216: foreach (sort keys %descriptions) {
1.51 matthew 1217: # onchange is javascript to automatically check the 'Set' button.
1218: my $onchange = 'onchange="javascript:window.document.forms'.
1219: '[\'envform\'].elements[\''.$_.'_setparmval\']'.
1220: '.checked=true;"';
1221: $output.='<tr><td>'.$descriptions{$_}.'</td>'.
1222: '<td><input name="'.$_.'_value" size=40 '.
1223: 'value="'.$values{$_}.'" '.$onchange.' /></td>'.
1224: '<td><input type=checkbox name="'.$_.'_setparmval"></td>'.
1225: '</tr>'."\n";
1226: }
1227: my $onchange = 'onchange="javascript:window.document.forms'.
1228: '[\'envform\'].elements[\'newp_setparmval\']'.
1229: '.checked=true;"';
1230: $output.='<tr><td><i>Create New Environment Variable</i><br />'.
1231: '<input type="text" size=40 name="newp_name" '.
1232: $onchange.' /></td><td>'.
1233: '<input type="text" size=40 name="newp_value" '.
1234: $onchange.' /></td><td>'.
1235: '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43 albertel 1236: }
1.30 www 1237: $r->print(<<ENDENV);
1238: <html>
1.46 matthew 1239: <script type="text/javascript" language="Javascript" >
1240: var editbrowser;
1.47 matthew 1241: function openbrowser(formname,elementname,only,omit) {
1.46 matthew 1242: var url = '/res/?';
1243: if (editbrowser == null) {
1244: url += 'launch=1&';
1245: }
1246: url += 'catalogmode=interactive&';
1247: url += 'mode=parmset&';
1248: url += 'form=' + formname + '&';
1.47 matthew 1249: if (only != null) {
1250: url += 'only=' + only + '&';
1251: }
1252: if (omit != null) {
1253: url += 'omit=' + omit + '&';
1254: }
1.46 matthew 1255: url += 'element=' + elementname + '';
1256: var title = 'Browser';
1257: var options = 'scrollbars=1,resizable=1,menubar=0';
1258: options += ',width=700,height=600';
1259: editbrowser = open(url,title,options,'1');
1260: editbrowser.focus();
1261: }
1262: </script>
1.30 www 1263: <head>
1264: <title>LON-CAPA Course Environment</title>
1265: </head>
1266: <body bgcolor="#FFFFFF">
1267: <h1>Set Course Parameters</h1>
1268: <form method="post" action="/adm/parmset" name="envform">
1269: <h2>Course: $ENV{'course.'.$ENV{'request.course.id'}.'.description'}</h2>
1270: <h3>Course Environment</h3>
1271: $setoutput
1272: <p>
1273: <table border=2>
1274: <tr><th>Parameter</th><th>Value</th><th>Set?</th></tr>
1275: $output
1276: </table>
1277: <input type="submit" name="crsenv" value="Set Course Environment">
1278: </form>
1279: </body>
1280: </html>
1281: ENDENV
1282: }
1283:
1284: # ================================================================ Main Handler
1285:
1286: sub handler {
1.43 albertel 1287: my $r=shift;
1.30 www 1288:
1.43 albertel 1289: if ($r->header_only) {
1290: $r->content_type('text/html');
1291: $r->send_http_header;
1292: return OK;
1293: }
1294: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'});
1.30 www 1295: # ----------------------------------------------------- Needs to be in a course
1296:
1.43 albertel 1297: if (($ENV{'request.course.id'}) &&
1298: (&Apache::lonnet::allowed('opa',$ENV{'request.course.id'}))) {
1.57 albertel 1299:
1300: $coursename=$ENV{'course.'.$ENV{'request.course.id'}.'.description'};
1.30 www 1301:
1.43 albertel 1302: unless (($ENV{'form.crsenv'}) || (!$ENV{'request.course.fn'})) {
1.30 www 1303: # --------------------------------------------------------- Bring up assessment
1.43 albertel 1304: &assessparms($r);
1.30 www 1305: # ---------------------------------------------- This is for course environment
1.43 albertel 1306: } else {
1307: &crsenv($r);
1308: }
1309: } else {
1.1 www 1310: # ----------------------------- Not in a course, or not allowed to modify parms
1.43 albertel 1311: $ENV{'user.error.msg'}=
1312: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
1313: return HTTP_NOT_ACCEPTABLE;
1314: }
1315: return OK;
1.1 www 1316: }
1317:
1318: 1;
1319: __END__
1320:
1.38 harris41 1321:
1322: =head1 NAME
1323:
1324: Apache::lonparmset - Handler to set parameters for assessments
1325:
1326: =head1 SYNOPSIS
1327:
1328: Invoked by /etc/httpd/conf/srm.conf:
1329:
1330: <Location /adm/parmset>
1331: PerlAccessHandler Apache::lonacc
1332: SetHandler perl-script
1333: PerlHandler Apache::lonparmset
1334: ErrorDocument 403 /adm/login
1335: ErrorDocument 406 /adm/roles
1336: ErrorDocument 500 /adm/errorhandler
1337: </Location>
1338:
1339: =head1 INTRODUCTION
1340:
1341: This module sets assessment parameters.
1342:
1343: This is part of the LearningOnline Network with CAPA project
1344: described at http://www.lon-capa.org.
1345:
1346: =head1 HANDLER SUBROUTINE
1347:
1348: This routine is called by Apache and mod_perl.
1349:
1350: =over 4
1351:
1352: =item *
1353:
1354: need to be in course
1355:
1356: =item *
1357:
1358: bring up assessment screen or course environment
1359:
1360: =back
1361:
1362: =head1 OTHER SUBROUTINES
1363:
1364: =over 4
1365:
1366: =item *
1367:
1368: parmval() : figure out a cascading parameter
1369:
1370: =item *
1371:
1.44 albertel 1372: valout() : format a value for output
1.38 harris41 1373:
1374: =item *
1375:
1376: plink() : produces link anchor
1377:
1378: =item *
1379:
1380: assessparms() : show assess data and parameters
1381:
1382: =item *
1383:
1384: crsenv() : for the course environment
1385:
1386: =back
1387:
1388: =cut
1.1 www 1389:
1390:
1391:
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