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