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