Annotation of loncom/interface/lonparmset.pm, revision 1.57
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
1.56 www 4: # $Id: lonparmset.pm,v 1.55 2002/07/22 14:23:29 bowersj2 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',
494: &GDBM_READER,0640))) {
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',
499: $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640))) {
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>