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