Annotation of loncom/interface/lonparmset.pm, revision 1.228
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
1.228 ! www 4: # $Id: lonparmset.pm,v 1.227 2005/06/17 20:56:06 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.88 matthew 59: use Apache::lonhtmlcommon();
1.36 albertel 60: use Apache::loncommon;
1.1 www 61: use GDBM_File;
1.57 albertel 62: use Apache::lonhomework;
63: use Apache::lonxml;
1.130 www 64: use Apache::lonlocal;
1.197 www 65: use Apache::lonnavmaps;
1.1 www 66:
1.198 www 67: # --- Caches local to lonparmset
1.2 www 68:
1.199 www 69: my $parmhashid;
70: my %parmhash;
1.201 www 71: my $symbsid;
72: my %symbs;
1.221 www 73: my $rulesid;
74: my %rules;
1.198 www 75:
76: # --- end local caches
77:
1.59 matthew 78: ##################################################
79: ##################################################
80:
81: =pod
82:
83: =item parmval
84:
85: Figure out a cascading parameter.
86:
1.71 albertel 87: Inputs: $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162 albertel 88: $id - a bighash Id number
1.71 albertel 89: $def - the resource's default value 'stupid emacs
90:
91: 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
92:
1.182 albertel 93: 11 - General Course
94: 10 - Map or Folder level in course
95: 9- resource default
96: 8- map default
1.71 albertel 97: 7 - resource level in course
98: 6 - General for section
1.82 www 99: 5 - Map or Folder level for section
1.71 albertel 100: 4 - resource level in section
101: 3 - General for specific student
1.82 www 102: 2 - Map or Folder level for specific student
1.71 albertel 103: 1 - resource level for specific student
1.2 www 104:
1.59 matthew 105: =cut
106:
107: ##################################################
1.2 www 108: sub parmval {
1.187 www 109: my ($what,$id,$def,$uname,$udom,$csec)=@_;
1.201 www 110: return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec);
111: }
112:
113: sub parmval_by_symb {
114: my ($what,$symb,$def,$uname,$udom,$csec)=@_;
1.198 www 115: # load caches
1.200 www 116:
1.198 www 117: &cacheparmhash();
1.200 www 118:
119: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
120: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
121: my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
122: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
123:
1.198 www 124:
1.8 www 125: my $result='';
1.44 albertel 126: my @outpar=();
1.2 www 127: # ----------------------------------------------------- Cascading lookup scheme
1.201 www 128: my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.10 www 129:
1.201 www 130: my $symbparm=$symb.'.'.$what;
131: my $mapparm=$map.'___(all).'.$what;
1.10 www 132:
1.190 albertel 133: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
134: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
135: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
136:
137: my $courselevel=$env{'request.course.id'}.'.'.$what;
138: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
139: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2 www 140:
1.11 www 141:
142:
1.182 albertel 143: # --------------------------------------------------------- first, check course
1.11 www 144:
1.200 www 145: if (defined($$courseopt{$courselevel})) {
146: $outpar[11]=$$courseopt{$courselevel};
1.182 albertel 147: $result=11;
1.43 albertel 148: }
1.11 www 149:
1.200 www 150: if (defined($$courseopt{$courselevelm})) {
151: $outpar[10]=$$courseopt{$courselevelm};
1.182 albertel 152: $result=10;
1.43 albertel 153: }
1.11 www 154:
1.182 albertel 155: # ------------------------------------------------------- second, check default
156:
157: if (defined($def)) { $outpar[9]=$def; $result=9; }
158:
159: # ------------------------------------------------------ third, check map parms
160:
161: my $thisparm=$parmhash{$symbparm};
162: if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
163:
1.200 www 164: if (defined($$courseopt{$courselevelr})) {
165: $outpar[7]=$$courseopt{$courselevelr};
1.43 albertel 166: $result=7;
167: }
1.11 www 168:
1.182 albertel 169: # ------------------------------------------------------ fourth, back to course
1.71 albertel 170: if (defined($csec)) {
1.200 www 171: if (defined($$courseopt{$seclevel})) {
172: $outpar[6]=$$courseopt{$seclevel};
1.43 albertel 173: $result=6;
174: }
1.200 www 175: if (defined($$courseopt{$seclevelm})) {
176: $outpar[5]=$$courseopt{$seclevelm};
1.43 albertel 177: $result=5;
178: }
179:
1.200 www 180: if (defined($$courseopt{$seclevelr})) {
1.201 www 181: $outpar[4]=$$courseopt{$seclevelr};
1.43 albertel 182: $result=4;
183: }
184: }
1.11 www 185:
1.182 albertel 186: # ---------------------------------------------------------- fifth, check user
1.11 www 187:
1.71 albertel 188: if (defined($uname)) {
1.200 www 189: if (defined($$useropt{$courselevel})) {
190: $outpar[3]=$$useropt{$courselevel};
1.43 albertel 191: $result=3;
192: }
1.10 www 193:
1.200 www 194: if (defined($$useropt{$courselevelm})) {
195: $outpar[2]=$$useropt{$courselevelm};
1.43 albertel 196: $result=2;
197: }
1.2 www 198:
1.200 www 199: if (defined($$useropt{$courselevelr})) {
200: $outpar[1]=$$useropt{$courselevelr};
1.43 albertel 201: $result=1;
202: }
203: }
1.44 albertel 204: return ($result,@outpar);
1.2 www 205: }
206:
1.198 www 207: sub resetparmhash {
208: $parmhashid='';
209: }
210:
211: sub cacheparmhash {
212: if ($parmhashid eq $env{'request.course.fn'}) { return; }
213: my %parmhashfile;
214: if (tie(%parmhashfile,'GDBM_File',
215: $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
216: %parmhash=%parmhashfile;
217: untie %parmhashfile;
218: $parmhashid=$env{'request.course.fn'};
219: }
220: }
221:
1.203 www 222: sub resetsymbcache {
223: $symbsid='';
224: }
225:
1.201 www 226: sub symbcache {
227: my $id=shift;
228: if ($symbsid ne $env{'request.course.id'}) {
229: %symbs=();
230: }
231: unless ($symbs{$id}) {
232: my $navmap = Apache::lonnavmaps::navmap->new();
233: if ($id=~/\./) {
234: my $resource=$navmap->getById($id);
235: $symbs{$id}=$resource->symb();
236: } else {
237: my $resource=$navmap->getByMapPc($id);
238: $symbs{$id}=&Apache::lonnet::declutter($resource->src());
239: }
240: $symbsid=$env{'request.course.id'};
241: }
242: return $symbs{$id};
243: }
244:
1.221 www 245: sub resetrulescache {
246: $rulesid='';
247: }
248:
249: sub rulescache {
250: my $id=shift;
251: if ($rulesid ne $env{'request.course.id'}) {
252: %rules=();
253: }
1.224 www 254: unless (defined($rules{$id})) {
1.221 www 255: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
256: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.224 www 257: %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
1.221 www 258: $rulesid=$env{'request.course.id'};
259: }
260: return $rules{$id};
261: }
262:
1.186 www 263: ##################################################
264: ##################################################
265: #
1.197 www 266: # Store a parameter by ID
1.186 www 267: #
268: # Takes
269: # - resource id
270: # - name of parameter
271: # - level
272: # - new value
273: # - new type
1.187 www 274: # - username
275: # - userdomain
276:
1.186 www 277: sub storeparm {
1.187 www 278: my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
1.201 www 279: &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
1.197 www 280: }
281:
282: #
283: # Store a parameter by symb
284: #
285: # Takes
286: # - symb
287: # - name of parameter
288: # - level
289: # - new value
290: # - new type
291: # - username
292: # - userdomain
293:
1.226 www 294: my %recstack;
1.197 www 295: sub storeparm_by_symb {
1.226 www 296: my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag)=@_;
297: unless ($recflag) {
298: # first time call
299: %recstack=();
300: $recflag=1;
301: }
302: # store parameter
303: &storeparm_by_symb_inner
304: ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
305: my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
306: # remember that this was set
307: $recstack{$parm}=1;
308: # what does this trigger?
309: foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
310: # don't backfire
311: unless ((!$triggered) || ($recstack{$triggered})) {
312: my $action=&rulescache($triggered.'_action');
313: my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
314: # set triggered parameter on same level
315: my $newspnam=$prefix.$triggered;
1.227 www 316: my $newvalue='';
1.228 ! www 317: my $active=1;
! 318: if ($action=~/^when\_setting/) {
! 319: # are there restrictions?
! 320: if (&rulescache($triggered.'_triggervalue')=~/\w/) {
! 321: $active=0;
! 322: foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
! 323: if (lc($possiblevalue) eq lc($nval)) { $active=1; }
! 324: }
! 325: }
! 326: $newvalue=&rulescache($triggered.'_value');
1.227 www 327: } else {
328: my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
1.228 ! www 329: if ($action=~/^later\_than/) {
! 330: $newvalue=$nval+$totalsecs;
! 331: } else {
! 332: $newvalue=$nval-$totalsecs;
! 333: }
! 334: }
! 335: if ($active) {
! 336: &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
! 337: $uname,$udom,$csec,$recflag);
1.227 www 338: }
1.226 www 339: }
340: }
341: return '';
342: }
343:
344: sub storeparm_by_symb_inner {
1.197 www 345: # ---------------------------------------------------------- Get symb, map, etc
346: my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
347: # ---------------------------------------------------------- Construct prefixes
1.186 www 348: $spnam=~s/\_([^\_]+)$/\.$1/;
1.197 www 349: my $map=(&Apache::lonnet::decode_symb($symb))[0];
350: my $symbparm=$symb.'.'.$spnam;
351: my $mapparm=$map.'___(all).'.$spnam;
352:
1.190 albertel 353: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
354: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
355: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.186 www 356:
1.190 albertel 357: my $courselevel=$env{'request.course.id'}.'.'.$spnam;
358: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
359: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.186 www 360:
361: my $storeunder='';
362: if (($snum==11) || ($snum==3)) { $storeunder=$courselevel; }
363: if (($snum==10) || ($snum==2)) { $storeunder=$courselevelm; }
364: if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
365: if ($snum==6) { $storeunder=$seclevel; }
366: if ($snum==5) { $storeunder=$seclevelm; }
367: if ($snum==4) { $storeunder=$seclevelr; }
368:
369: my $delete;
370: if ($nval eq '') { $delete=1;}
371: my %storecontent = ($storeunder => $nval,
372: $storeunder.'.type' => $ntype);
373: my $reply='';
374: if ($snum>3) {
375: # ---------------------------------------------------------------- Store Course
376: #
1.200 www 377: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
378: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186 www 379: # Expire sheets
380: &Apache::lonnet::expirespread('','','studentcalc');
381: if (($snum==7) || ($snum==4)) {
1.197 www 382: &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.186 www 383: } elsif (($snum==8) || ($snum==5)) {
1.197 www 384: &Apache::lonnet::expirespread('','','assesscalc',$map);
1.186 www 385: } else {
386: &Apache::lonnet::expirespread('','','assesscalc');
387: }
388: # Store parameter
389: if ($delete) {
390: $reply=&Apache::lonnet::del
1.200 www 391: ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.186 www 392: } else {
393: $reply=&Apache::lonnet::cput
1.200 www 394: ('resourcedata',\%storecontent,$cdom,$cnum);
1.186 www 395: }
1.200 www 396: &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186 www 397: } else {
398: # ------------------------------------------------------------------ Store User
399: #
400: # Expire sheets
401: &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
402: if ($snum==1) {
403: &Apache::lonnet::expirespread
1.197 www 404: ($uname,$udom,'assesscalc',$symb);
1.186 www 405: } elsif ($snum==2) {
406: &Apache::lonnet::expirespread
1.197 www 407: ($uname,$udom,'assesscalc',$map);
1.186 www 408: } else {
409: &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
410: }
411: # Store parameter
412: if ($delete) {
413: $reply=&Apache::lonnet::del
414: ('resourcedata',[keys(%storecontent)],$udom,$uname);
415: } else {
416: $reply=&Apache::lonnet::cput
417: ('resourcedata',\%storecontent,$udom,$uname);
418: }
1.191 albertel 419: &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186 www 420: }
421:
422: if ($reply=~/^error\:(.*)/) {
423: return "<font color=red>Write Error: $1</font>";
424: }
425: return '';
426: }
427:
1.59 matthew 428: ##################################################
429: ##################################################
430:
431: =pod
432:
433: =item valout
434:
435: Format a value for output.
436:
437: Inputs: $value, $type
438:
439: Returns: $value, formatted for output. If $type indicates it is a date,
440: localtime($value) is returned.
1.9 www 441:
1.59 matthew 442: =cut
443:
444: ##################################################
445: ##################################################
1.9 www 446: sub valout {
447: my ($value,$type)=@_;
1.59 matthew 448: my $result = '';
449: # Values of zero are valid.
450: if (! $value && $value ne '0') {
1.71 albertel 451: $result = ' ';
1.59 matthew 452: } else {
1.66 www 453: if ($type eq 'date_interval') {
454: my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
455: $year=$year-70;
456: $mday--;
457: if ($year) {
458: $result.=$year.' yrs ';
459: }
460: if ($mon) {
461: $result.=$mon.' mths ';
462: }
463: if ($mday) {
464: $result.=$mday.' days ';
465: }
466: if ($hour) {
467: $result.=$hour.' hrs ';
468: }
469: if ($min) {
470: $result.=$min.' mins ';
471: }
472: if ($sec) {
473: $result.=$sec.' secs ';
474: }
475: $result=~s/\s+$//;
1.213 www 476: } elsif (&isdateparm($type)) {
1.59 matthew 477: $result = localtime($value);
478: } else {
479: $result = $value;
480: }
481: }
482: return $result;
1.9 www 483: }
484:
1.59 matthew 485: ##################################################
486: ##################################################
487:
488: =pod
1.5 www 489:
1.59 matthew 490: =item plink
491:
492: Produces a link anchor.
493:
494: Inputs: $type,$dis,$value,$marker,$return,$call
495:
496: Returns: scalar with html code for a link which will envoke the
497: javascript function 'pjump'.
498:
499: =cut
500:
501: ##################################################
502: ##################################################
1.5 www 503: sub plink {
504: my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23 www 505: my $winvalue=$value;
506: unless ($winvalue) {
1.213 www 507: if (&isdateparm($type)) {
1.190 albertel 508: $winvalue=$env{'form.recent_'.$type};
1.23 www 509: } else {
1.190 albertel 510: $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23 www 511: }
512: }
1.209 www 513:
514:
1.23 www 515: return
1.43 albertel 516: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
517: .$marker."','".$return."','".$call."'".');">'.
518: &valout($value,$type).'</a><a name="'.$marker.'"></a>';
1.5 www 519: }
520:
1.44 albertel 521: sub startpage {
1.209 www 522: my $r=shift;
1.99 albertel 523:
1.120 www 524: my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
1.98 www 525: 'onUnload="pclose()"');
1.204 www 526: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table Mode Parameter Setting');
1.81 www 527: my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88 matthew 528: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.183 albertel 529: my $html=&Apache::lonxml::xmlbegin();
1.44 albertel 530: $r->print(<<ENDHEAD);
1.183 albertel 531: $html
1.44 albertel 532: <head>
533: <title>LON-CAPA Course Parameters</title>
534: <script>
535:
536: function pclose() {
537: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
538: "height=350,width=350,scrollbars=no,menubar=no");
539: parmwin.close();
540: }
541:
1.88 matthew 542: $pjump_def
1.44 albertel 543:
544: function psub() {
545: pclose();
546: if (document.parmform.pres_marker.value!='') {
547: document.parmform.action+='#'+document.parmform.pres_marker.value;
548: var typedef=new Array();
549: typedef=document.parmform.pres_type.value.split('_');
550: if (document.parmform.pres_type.value!='') {
551: if (typedef[0]=='date') {
552: eval('document.parmform.recent_'+
553: document.parmform.pres_type.value+
554: '.value=document.parmform.pres_value.value;');
555: } else {
556: eval('document.parmform.recent_'+typedef[0]+
557: '.value=document.parmform.pres_value.value;');
558: }
559: }
560: document.parmform.submit();
561: } else {
562: document.parmform.pres_value.value='';
563: document.parmform.pres_marker.value='';
564: }
565: }
566:
1.57 albertel 567: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
568: var options = "width=" + w + ",height=" + h + ",";
569: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
570: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
571: var newWin = window.open(url, wdwName, options);
572: newWin.focus();
573: }
1.44 albertel 574: </script>
1.81 www 575: $selscript
1.44 albertel 576: </head>
1.64 www 577: $bodytag
1.193 albertel 578: $breadcrumbs
579: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.44 albertel 580: <input type="hidden" value='' name="pres_value">
581: <input type="hidden" value='' name="pres_type">
582: <input type="hidden" value='' name="pres_marker">
1.209 www 583: <input type="hidden" value='1' name="prevvisit">
1.44 albertel 584: ENDHEAD
585: }
586:
1.209 www 587:
1.44 albertel 588: sub print_row {
1.201 www 589: my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.187 www 590: $defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
1.66 www 591: # get the values for the parameter in cascading order
592: # empty levels will remain empty
1.44 albertel 593: my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.187 www 594: $rid,$$default{$which},$uname,$udom,$csec);
1.66 www 595: # get the type for the parameters
596: # problem: these may not be set for all levels
597: my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
598: $$name{$which}.'.type',
1.187 www 599: $rid,$$defaulttype{$which},$uname,$udom,$csec);
1.66 www 600: # cascade down manually
1.182 albertel 601: my $cascadetype=$$defaulttype{$which};
602: for (my $i=11;$i>0;$i--) {
1.66 www 603: if ($typeoutpar[$i]) {
604: $cascadetype=$typeoutpar[$i];
605: } else {
606: $typeoutpar[$i]=$cascadetype;
607: }
608: }
1.57 albertel 609: my $parm=$$display{$which};
610:
1.203 www 611: if ($parmlev eq 'full') {
1.57 albertel 612: $r->print('<td bgcolor='.$defbgtwo.' align="center">'
613: .$$part{$which}.'</td>');
614: } else {
615: $parm=~s|\[.*\]\s||g;
616: }
617:
1.159 albertel 618: $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57 albertel 619:
1.44 albertel 620: my $thismarker=$which;
621: $thismarker=~s/^parameter\_//;
622: my $mprefix=$rid.'&'.$thismarker.'&';
623:
1.57 albertel 624: if ($parmlev eq 'general') {
625:
626: if ($uname) {
1.66 www 627: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 628: } elsif ($csec) {
1.66 www 629: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 630: } else {
1.182 albertel 631: &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 632: }
633: } elsif ($parmlev eq 'map') {
634:
635: if ($uname) {
1.66 www 636: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 637: } elsif ($csec) {
1.66 www 638: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 639: } else {
1.182 albertel 640: &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 641: }
642: } else {
643:
1.182 albertel 644: &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 645:
1.203 www 646: &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
647: &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
648: &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
649: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
650:
651: if ($csec) {
652: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
653: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
654: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
655: }
656: if ($uname) {
657: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
658: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
659: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
660: }
1.57 albertel 661:
662: } # end of $parmlev if/else
663:
1.136 albertel 664: $r->print('<td bgcolor=#CCCCFF align="center">'.
665: &valout($outpar[$result],$typeoutpar[$result]).'</td>');
666:
1.203 www 667: if ($parmlev eq 'full') {
1.136 albertel 668: my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201 www 669: '.'.$$name{$which},$$symbp{$rid});
1.136 albertel 670: my $sessionvaltype=$typeoutpar[$result];
671: if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
672: $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
1.66 www 673: &valout($sessionval,$sessionvaltype).' '.
1.57 albertel 674: '</font></td>');
1.136 albertel 675: }
1.44 albertel 676: $r->print('</tr>');
1.57 albertel 677: $r->print("\n");
1.44 albertel 678: }
1.59 matthew 679:
1.44 albertel 680: sub print_td {
1.66 www 681: my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57 albertel 682: $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114 www 683: ' align="center">');
1.182 albertel 684: if ($which<8 || $which > 9) {
1.114 www 685: $r->print(&plink($$typeoutpar[$which],
686: $$display{$value},$$outpar[$which],
687: $mprefix."$which",'parmform.pres','psub'));
688: } else {
689: $r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
690: }
691: $r->print('</td>'."\n");
1.57 albertel 692: }
693:
1.201 www 694:
1.63 bowersj2 695: =pod
696:
697: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
698:
699: Input: See list below:
700:
701: =over 4
702:
703: =item B<ids>: An array that will contain all of the ids in the course.
704:
705: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
706:
1.171 www 707: =item B<keyp>: hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.63 bowersj2 708:
709: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
710:
711: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
712:
713: =item B<allkeys>: hash, full key to part->display value (what's display value?)
714:
715: =item B<allmaps>: hash, ???
716:
717: =item B<fcat>: ???
718:
719: =item B<defp>: hash, ???
720:
721: =item B<mapp>: ??
722:
723: =item B<symbp>: hash, id->full sym?
724:
725: =back
726:
727: =cut
728:
729: sub extractResourceInformation {
730: my $ids = shift;
731: my $typep = shift;
732: my $keyp = shift;
733: my $allparms = shift;
734: my $allparts = shift;
735: my $allmaps = shift;
736: my $mapp = shift;
737: my $symbp = shift;
1.82 www 738: my $maptitles=shift;
1.196 www 739: my $uris=shift;
1.210 www 740: my $keyorder=shift;
1.211 www 741: my $defkeytype=shift;
1.196 www 742:
1.210 www 743: my $keyordercnt=100;
1.63 bowersj2 744:
1.196 www 745: my $navmap = Apache::lonnavmaps::navmap->new();
746: my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
747: foreach my $resource (@allres) {
748: my $id=$resource->id();
749: my ($mapid,$resid)=split(/\./,$id);
750: if ($mapid eq '0') { next; }
751: $$ids[$#$ids+1]=$id;
752: my $srcf=$resource->src();
753: $srcf=~/\.(\w+)$/;
754: $$typep{$id}=$1;
755: $$keyp{$id}='';
756: $$uris{$id}=$srcf;
757: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
758: if ($_=~/^parameter\_(.*)/) {
759: my $key=$_;
1.209 www 760: # Hidden parameters
761: if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm') {
762: next;
1.63 bowersj2 763: }
1.196 www 764: my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
765: my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
766: my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
1.209 www 767: #
768: # allparms is a hash of parameter names
769: #
1.196 www 770: my $parmdis = $display;
1.209 www 771: $parmdis =~ s/\[Part.*$//g;
772: $$allparms{$name}=$parmdis;
1.211 www 773: $$defkeytype{$name}=&Apache::lonnet::metadata($srcf,$key.'.type');
1.209 www 774: #
775: # allparts is a hash of all parts
776: #
777: $$allparts{$part} = "Part: $part";
778: #
779: # Remember all keys going with this resource
780: #
1.196 www 781: if ($$keyp{$id}) {
782: $$keyp{$id}.=','.$key;
1.175 albertel 783: } else {
1.196 www 784: $$keyp{$id}=$key;
1.175 albertel 785: }
1.210 www 786: #
787: # Put in order
788: #
789: unless ($$keyorder{$key}) {
790: $$keyorder{$key}=$keyordercnt;
791: $keyordercnt++;
792: }
793:
1.63 bowersj2 794: }
795: }
1.196 www 796: $$mapp{$id}=
797: &Apache::lonnet::declutter($resource->enclosing_map_src());
798: $$mapp{$mapid}=$$mapp{$id};
799: $$allmaps{$mapid}=$$mapp{$id};
800: if ($mapid eq '1') {
801: $$maptitles{$mapid}='Main Course Documents';
802: } else {
803: $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
804: }
805: $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
806: $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
807: $$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.63 bowersj2 808: }
809: }
810:
1.208 www 811:
812: ##################################################
813: ##################################################
814:
1.213 www 815: sub isdateparm {
816: my $type=shift;
817: return (($type=~/^date/) && (!($type eq 'date_interval')));
818: }
819:
1.208 www 820: sub parmmenu {
1.211 www 821: my ($r,$allparms,$pscat,$keyorder)=@_;
1.208 www 822: my $tempkey;
823: $r->print(<<ENDSCRIPT);
824: <script type="text/javascript">
825: function checkall(value, checkName) {
826: for (i=0; i<document.forms.parmform.elements.length; i++) {
827: ele = document.forms.parmform.elements[i];
828: if (ele.name == checkName) {
829: document.forms.parmform.elements[i].checked=value;
830: }
831: }
832: }
1.210 www 833:
834: function checkthis(thisvalue, checkName) {
835: for (i=0; i<document.forms.parmform.elements.length; i++) {
836: ele = document.forms.parmform.elements[i];
837: if (ele.name == checkName) {
838: if (ele.value == thisvalue) {
839: document.forms.parmform.elements[i].checked=true;
840: }
841: }
842: }
843: }
844:
845: function checkdates() {
846: checkthis('duedate','pscat');
847: checkthis('opendate','pscat');
848: checkthis('answerdate','pscat');
1.218 www 849: }
850:
851: function checkdisset() {
852: checkthis('discussend','pscat');
853: checkthis('discusshide','pscat');
854: }
855:
856: function checkcontdates() {
857: checkthis('contentopen','pscat');
858: checkthis('contentclose','pscat');
859: }
860:
1.210 www 861:
862: function checkvisi() {
863: checkthis('hiddenresource','pscat');
864: checkthis('encrypturl','pscat');
865: checkthis('problemstatus','pscat');
866: checkthis('contentopen','pscat');
867: checkthis('opendate','pscat');
868: }
869:
870: function checkparts() {
871: checkthis('hiddenparts','pscat');
872: checkthis('display','pscat');
873: checkthis('ordered','pscat');
874: }
875:
876: function checkstandard() {
877: checkall(false,'pscat');
878: checkdates();
879: checkthis('weight','pscat');
880: checkthis('maxtries','pscat');
881: }
882:
1.208 www 883: </script>
884: ENDSCRIPT
1.209 www 885: $r->print();
1.208 www 886: $r->print("\n<table><tr>");
887: my $cnt=0;
1.211 www 888: foreach $tempkey (&keysindisplayorder($allparms,$keyorder)) {
1.209 www 889: $r->print("\n<td><font size='-1'><input type='checkbox' name='pscat' ");
1.208 www 890: $r->print('value="'.$tempkey.'"');
891: if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
892: $r->print(' checked');
893: }
1.209 www 894: $r->print('>'.$$allparms{$tempkey}.'</font></td>');
895: $cnt++;
896: if ($cnt==3) {
897: $r->print("</tr>\n<tr>");
898: $cnt=0;
899: }
1.208 www 900: }
901: $r->print('
902: </tr><tr><td>
1.218 www 903: <a href="javascript:checkall(true, \'pscat\')">Select All</a><br />
904: <a href="javascript:checkstandard()">Select Common Only</a>
1.210 www 905: </td><td>
1.218 www 906: <a href="javascript:checkdates()">Add Problem Dates</a>
907: <a href="javascript:checkcontdates()">Add Content Dates</a><br />
908: <a href="javascript:checkdisset()">Add Discussion Settings</a>
909: <a href="javascript:checkvisi()">Add Visibilities</a><br />
910: <a href="javascript:checkparts()">Add Part Parameters</a>
1.210 www 911: </td><td>
912: <a href="javascript:checkall(false, \'pscat\')">Unselect All</a>
1.208 www 913: </td>
914: ');
915: $r->print('</tr></table>');
916: }
917:
1.209 www 918: sub partmenu {
919: my ($r,$allparts,$psprt)=@_;
1.211 www 920: $r->print('<select multiple name="psprt" size="8">');
1.208 www 921: $r->print('<option value="all"');
922: $r->print(' selected') unless (@{$psprt});
923: $r->print('>'.&mt('All Parts').'</option>');
924: my %temphash=();
925: foreach (@{$psprt}) { $temphash{$_}=1; }
1.209 www 926: foreach my $tempkey (sort keys %{$allparts}) {
1.208 www 927: unless ($tempkey =~ /\./) {
928: $r->print('<option value="'.$tempkey.'"');
929: if ($$psprt[0] eq "all" || $temphash{$tempkey}) {
930: $r->print(' selected');
931: }
932: $r->print('>'.$$allparts{$tempkey}.'</option>');
933: }
934: }
1.209 www 935: $r->print('</select>');
936: }
937:
938: sub usermenu {
939: my ($r,$uname,$id,$udom,$csec)=@_;
940: my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
941: &Apache::loncommon::selectstudent_link('parmform','uname','udom');
942: my $selscript=&Apache::loncommon::studentbrowser_javascript();
943: my %lt=&Apache::lonlocal::texthash(
944: 'sg' => "Section/Group",
945: 'fu' => "For User",
946: 'oi' => "or ID",
947: 'ad' => "at Domain"
948: );
949: my %sectionhash=();
950: my $sections='';
951: if (&Apache::loncommon::get_sections(
952: $env{'course.'.$env{'request.course.id'}.'.domain'},
953: $env{'course.'.$env{'request.course.id'}.'.num'},
954: \%sectionhash)) {
955: $sections=$lt{'sg'}.': <select name="csec">';
956: foreach ('',sort keys %sectionhash) {
957: $sections.='<option value="'.$_.'"'.
958: ($_ eq $csec?'selected="selected"':'').'>'.$_.'</option>';
959: }
960: $sections.='</select>';
961: }
962: $r->print(<<ENDMENU);
963: <b>
964: $sections
965: <br />
966: $lt{'fu'}
967: <input type="text" value="$uname" size="12" name="uname" />
968: $lt{'oi'}
969: <input type="text" value="$id" size="12" name="id" />
970: $lt{'ad'}
971: $chooseopt
972: </b>
973: ENDMENU
974: }
975:
976: sub displaymenu {
1.211 www 977: my ($r,$allparms,$allparts,$pscat,$psprt,$keyorder)=@_;
1.209 www 978: $r->print('<table border="1"><tr><th>'.&mt('Select Parameters to View').'</th><th>'.
979: &mt('Select Parts to View').'</th></tr><tr><td>');
1.211 www 980: &parmmenu($r,$allparms,$pscat,$keyorder);
1.209 www 981: $r->print('</td><td>');
982: &partmenu($r,$allparts,$psprt);
983: $r->print('</td></tr></table>');
984: }
985:
986: sub mapmenu {
987: my ($r,$allmaps,$pschp,$maptitles)=@_;
988: $r->print(&mt('Select Enclosing Map or Folder').' ');
989: $r->print('<select name="pschp">');
990: $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
991: foreach (sort {$$allmaps{$a} cmp $$allmaps{$b}} keys %{$allmaps}) {
1.208 www 992: $r->print('<option value="'.$_.'"');
1.209 www 993: if (($pschp eq $_)) { $r->print(' selected'); }
994: $r->print('>'.$$maptitles{$_}.($$allmaps{$_}!~/^uploaded/?' ['.$$allmaps{$_}.']':'').'</option>');
995: }
996: $r->print("</select>");
997: }
998:
999: sub levelmenu {
1000: my ($r,$alllevs,$parmlev)=@_;
1001: $r->print(&mt('Select Parameter Level').
1002: &Apache::loncommon::help_open_topic('Course_Parameter_Levels').' ');
1003: $r->print('<select name="parmlev">');
1004: foreach (reverse sort keys %{$alllevs}) {
1005: $r->print('<option value="'.$$alllevs{$_}.'"');
1006: if ($parmlev eq $$alllevs{$_}) {
1007: $r->print(' selected');
1008: }
1009: $r->print('>'.$_.'</option>');
1.208 www 1010: }
1.209 www 1011: $r->print("</select>");
1.208 www 1012: }
1013:
1.211 www 1014:
1015: sub sectionmenu {
1016: my ($r,$selectedsections)=@_;
1.212 www 1017: my %sectionhash=();
1.211 www 1018:
1.212 www 1019: if (&Apache::loncommon::get_sections(
1020: $env{'course.'.$env{'request.course.id'}.'.domain'},
1021: $env{'course.'.$env{'request.course.id'}.'.num'},
1022: \%sectionhash)) {
1023: $r->print('<select name="Section" multiple="true" size="8" >');
1024: foreach my $s ('all',sort keys %sectionhash) {
1025: $r->print(' <option value="'.$s.'"');
1026: foreach (@{$selectedsections}) {
1027: if ($s eq $_) {
1028: $r->print(' selected');
1029: last;
1030: }
1031: }
1032: $r->print('>'.$s."</option>\n");
1033: }
1034: $r->print("</select>\n");
1.211 www 1035: }
1036: }
1037:
1.210 www 1038: sub keysplit {
1039: my $keyp=shift;
1040: return (split(/\,/,$keyp));
1041: }
1042:
1043: sub keysinorder {
1044: my ($name,$keyorder)=@_;
1045: return sort {
1046: $$keyorder{$a} <=> $$keyorder{$b};
1047: } (keys %{$name});
1048: }
1049:
1.211 www 1050: sub keysindisplayorder {
1051: my ($name,$keyorder)=@_;
1052: return sort {
1053: $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1054: } (keys %{$name});
1055: }
1056:
1.214 www 1057: sub sortmenu {
1058: my ($r,$sortorder)=@_;
1059: $r->print('<br /><input type="radio" name="sortorder" value="realmstudent"');
1060: if ($sortorder eq 'realmstudent') {
1061: $r->print(' checked="on"');
1062: }
1063: $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1064: $r->print('<br /><input type="radio" name="sortorder" value="studentrealm"');
1065: if ($sortorder eq 'studentrealm') {
1066: $r->print(' checked="on"');
1067: }
1068: $r->print(' />'.&mt('Sort by student (group/section) first, then realm'));
1069: }
1070:
1.211 www 1071: sub standardkeyorder {
1072: return ('parameter_0_opendate' => 1,
1073: 'parameter_0_duedate' => 2,
1074: 'parameter_0_answerdate' => 3,
1075: 'parameter_0_interval' => 4,
1076: 'parameter_0_weight' => 5,
1077: 'parameter_0_maxtries' => 6,
1078: 'parameter_0_hinttries' => 7,
1079: 'parameter_0_contentopen' => 8,
1080: 'parameter_0_contentclose' => 9,
1081: 'parameter_0_type' => 10,
1082: 'parameter_0_problemstatus' => 11,
1083: 'parameter_0_hiddenresource' => 12,
1084: 'parameter_0_hiddenparts' => 13,
1085: 'parameter_0_display' => 14,
1086: 'parameter_0_ordered' => 15,
1087: 'parameter_0_tol' => 16,
1088: 'parameter_0_sig' => 17,
1.218 www 1089: 'parameter_0_turnoffunit' => 18,
1090: 'parameter_0_discussend' => 19,
1091: 'parameter_0_discusshide' => 20);
1.211 www 1092: }
1093:
1.59 matthew 1094: ##################################################
1095: ##################################################
1096:
1097: =pod
1098:
1099: =item assessparms
1100:
1101: Show assessment data and parameters. This is a large routine that should
1102: be simplified and shortened... someday.
1103:
1104: Inputs: $r
1105:
1106: Returns: nothing
1107:
1.63 bowersj2 1108: Variables used (guessed by Jeremy):
1109:
1110: =over 4
1111:
1112: =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.
1113:
1114: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
1115:
1116: =item B<allmaps>:
1117:
1118: =back
1119:
1.59 matthew 1120: =cut
1121:
1122: ##################################################
1123: ##################################################
1.30 www 1124: sub assessparms {
1.1 www 1125:
1.43 albertel 1126: my $r=shift;
1.201 www 1127:
1128: my @ids=();
1129: my %symbp=();
1130: my %mapp=();
1131: my %typep=();
1132: my %keyp=();
1133: my %uris=();
1134: my %maptitles=();
1135:
1.2 www 1136: # -------------------------------------------------------- Variable declaration
1.209 www 1137:
1.129 www 1138: my %allmaps=();
1139: my %alllevs=();
1.57 albertel 1140:
1.187 www 1141: my $uname;
1142: my $udom;
1143: my $uhome;
1144: my $csec;
1145:
1.190 albertel 1146: my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187 www 1147:
1.57 albertel 1148: $alllevs{'Resource Level'}='full';
1.215 www 1149: $alllevs{'Map/Folder Level'}='map';
1.57 albertel 1150: $alllevs{'Course Level'}='general';
1151:
1152: my %allparms;
1153: my %allparts;
1.210 www 1154: #
1155: # Order in which these parameters will be displayed
1156: #
1.211 www 1157: my %keyorder=&standardkeyorder();
1158:
1.43 albertel 1159: @ids=();
1160: %symbp=();
1161: %typep=();
1162:
1163: my $message='';
1164:
1.190 albertel 1165: $csec=$env{'form.csec'};
1.188 www 1166:
1.190 albertel 1167: if ($udom=$env{'form.udom'}) {
1168: } elsif ($udom=$env{'request.role.domain'}) {
1169: } elsif ($udom=$env{'user.domain'}) {
1.172 albertel 1170: } else {
1171: $udom=$r->dir_config('lonDefDomain');
1172: }
1.43 albertel 1173:
1.134 albertel 1174: my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190 albertel 1175: my $pschp=$env{'form.pschp'};
1.134 albertel 1176: my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76 www 1177: if (!@psprt) { $psprt[0]='0'; }
1.57 albertel 1178:
1.43 albertel 1179: my $pssymb='';
1.57 albertel 1180: my $parmlev='';
1181:
1.190 albertel 1182: unless ($env{'form.parmlev'}) {
1.57 albertel 1183: $parmlev = 'map';
1184: } else {
1.190 albertel 1185: $parmlev = $env{'form.parmlev'};
1.57 albertel 1186: }
1.26 www 1187:
1.29 www 1188: # ----------------------------------------------- Was this started from grades?
1189:
1.190 albertel 1190: if (($env{'form.command'} eq 'set') && ($env{'form.url'})
1191: && (!$env{'form.dis'})) {
1192: my $url=$env{'form.url'};
1.194 albertel 1193: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.43 albertel 1194: $pssymb=&Apache::lonnet::symbread($url);
1.92 albertel 1195: if (!@pscat) { @pscat=('all'); }
1.43 albertel 1196: $pschp='';
1.57 albertel 1197: $parmlev = 'full';
1.190 albertel 1198: } elsif ($env{'form.symb'}) {
1199: $pssymb=$env{'form.symb'};
1.92 albertel 1200: if (!@pscat) { @pscat=('all'); }
1.43 albertel 1201: $pschp='';
1.57 albertel 1202: $parmlev = 'full';
1.43 albertel 1203: } else {
1.190 albertel 1204: $env{'form.url'}='';
1.43 albertel 1205: }
1206:
1.190 albertel 1207: my $id=$env{'form.id'};
1.43 albertel 1208: if (($id) && ($udom)) {
1209: $uname=(&Apache::lonnet::idget($udom,$id))[1];
1210: if ($uname) {
1211: $id='';
1212: } else {
1213: $message=
1.133 www 1214: "<font color=red>".&mt("Unknown ID")." '$id' ".
1215: &mt('at domain')." '$udom'</font>";
1.43 albertel 1216: }
1217: } else {
1.190 albertel 1218: $uname=$env{'form.uname'};
1.43 albertel 1219: }
1220: unless ($udom) { $uname=''; }
1221: $uhome='';
1222: if ($uname) {
1223: $uhome=&Apache::lonnet::homeserver($uname,$udom);
1224: if ($uhome eq 'no_host') {
1225: $message=
1.133 www 1226: "<font color=red>".&mt("Unknown user")." '$uname' ".
1227: &mt("at domain")." '$udom'</font>";
1.43 albertel 1228: $uname='';
1.12 www 1229: } else {
1.103 albertel 1230: $csec=&Apache::lonnet::getsection($udom,$uname,
1.190 albertel 1231: $env{'request.course.id'});
1.43 albertel 1232: if ($csec eq '-1') {
1233: $message="<font color=red>".
1.133 www 1234: &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
1235: &mt("not in this course")."</font>";
1.43 albertel 1236: $uname='';
1.190 albertel 1237: $csec=$env{'form.csec'};
1.43 albertel 1238: } else {
1239: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1240: ('firstname','middlename','lastname','generation','id'));
1.133 www 1241: $message="\n<p>\n".&mt("Full Name").": ".
1.43 albertel 1242: $name{'firstname'}.' '.$name{'middlename'}.' '
1243: .$name{'lastname'}.' '.$name{'generation'}.
1.133 www 1244: "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43 albertel 1245: }
1.12 www 1246: }
1.43 albertel 1247: }
1.2 www 1248:
1.43 albertel 1249: unless ($csec) { $csec=''; }
1.12 www 1250:
1.14 www 1251: # --------------------------------------------------------- Get all assessments
1.210 www 1252: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1253: \%mapp, \%symbp,\%maptitles,\%uris,
1254: \%keyorder);
1.63 bowersj2 1255:
1.57 albertel 1256: $mapp{'0.0'} = '';
1257: $symbp{'0.0'} = '';
1.99 albertel 1258:
1.14 www 1259: # ---------------------------------------------------------- Anything to store?
1.190 albertel 1260: if ($env{'form.pres_marker'}) {
1.205 www 1261: my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
1262: my @values=split(/\&\&\&/,$env{'form.pres_value'});
1263: my @types=split(/\&\&\&/,$env{'form.pres_type'});
1264: for (my $i=0;$i<=$#markers;$i++) {
1265: $message.=&storeparm(split(/\&/,$markers[$i]),
1266: $values[$i],
1267: $types[$i],
1268: $uname,$udom,$csec);
1269: }
1.68 www 1270: # ---------------------------------------------------------------- Done storing
1.130 www 1271: $message.='<h3>'.&mt('Changes can take up to 10 minutes before being active for all students.').&Apache::loncommon::help_open_topic('Caching').'</h3>';
1.68 www 1272: }
1.57 albertel 1273: #----------------------------------------------- if all selected, fill in array
1.209 www 1274: if ($pscat[0] eq "all") {@pscat = (keys %allparms);}
1275: if (!@pscat) { @pscat=('duedate','opendate','answerdate','weight','maxtries') };
1.57 albertel 1276: if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2 www 1277: # ------------------------------------------------------------------ Start page
1.63 bowersj2 1278:
1.209 www 1279: &startpage($r);
1.57 albertel 1280:
1.44 albertel 1281: foreach ('tolerance','date_default','date_start','date_end',
1282: 'date_interval','int','float','string') {
1283: $r->print('<input type="hidden" value="'.
1.190 albertel 1284: $env{'form.recent_'.$_}.'" name="recent_'.$_.'">');
1.44 albertel 1285: }
1.57 albertel 1286:
1.44 albertel 1287: if (!$pssymb) {
1.209 www 1288: $r->print('<table border="1"><tr><td>');
1289: &levelmenu($r,\%alllevs,$parmlev);
1.128 albertel 1290: if ($parmlev ne 'general') {
1.209 www 1291: $r->print('<td>');
1292: &mapmenu($r,\%allmaps,$pschp,\%maptitles);
1293: $r->print('</td>');
1.128 albertel 1294: }
1.209 www 1295: $r->print('</td></tr></table>');
1.211 www 1296: &displaymenu($r,\%allparms,\%allparts,\@pscat,\@psprt,\%keyorder);
1.44 albertel 1297: } else {
1.125 www 1298: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.209 www 1299: $r->print(&mt('Specific Resource').": ".$resource.
1.212 www 1300: '<input type="hidden" value="'.$pssymb.'" name="symb"><br />');
1.57 albertel 1301: }
1.209 www 1302: &usermenu($r,$uname,$id,$udom,$csec);
1.57 albertel 1303:
1.210 www 1304: $r->print('<p>'.$message.'</p>');
1305:
1.209 www 1306: $r->print('<br /><input type="submit" name="dis" value="'.&mt("Update Parameter Display").'" />');
1.57 albertel 1307:
1308: my @temp_pscat;
1309: map {
1310: my $cat = $_;
1311: push(@temp_pscat, map { $_.'.'.$cat } @psprt);
1312: } @pscat;
1313:
1314: @pscat = @temp_pscat;
1315:
1.209 www 1316: if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10 www 1317: # ----------------------------------------------------------------- Start Table
1.57 albertel 1318: my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190 albertel 1319: my $csuname=$env{'user.name'};
1320: my $csudom=$env{'user.domain'};
1.57 albertel 1321:
1.203 www 1322: if ($parmlev eq 'full') {
1.57 albertel 1323: my $coursespan=$csec?8:5;
1324: $r->print('<p><table border=2>');
1325: $r->print('<tr><td colspan=5></td>');
1.130 www 1326: $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57 albertel 1327: if ($uname) {
1328: $r->print("<th colspan=3 rowspan=2>");
1.130 www 1329: $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57 albertel 1330: }
1.133 www 1331: my %lt=&Apache::lonlocal::texthash(
1332: 'pie' => "Parameter in Effect",
1333: 'csv' => "Current Session Value",
1334: 'at' => 'at',
1335: 'rl' => "Resource Level",
1336: 'ic' => 'in Course',
1337: 'aut' => "Assessment URL and Title",
1.143 albertel 1338: 'type' => 'Type',
1.133 www 1339: 'emof' => "Enclosing Map or Folder",
1.143 albertel 1340: 'part' => 'Part',
1.133 www 1341: 'pn' => 'Parameter Name',
1342: 'def' => 'default',
1343: 'femof' => 'from Enclosing Map or Folder',
1344: 'gen' => 'general',
1345: 'foremf' => 'for Enclosing Map or Folder',
1346: 'fr' => 'for Resource'
1347: );
1.57 albertel 1348: $r->print(<<ENDTABLETWO);
1.133 www 1349: <th rowspan=3>$lt{'pie'}</th>
1350: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182 albertel 1351: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
1352: <th colspan=1>$lt{'ic'}</th>
1353:
1.10 www 1354: ENDTABLETWO
1.57 albertel 1355: if ($csec) {
1.133 www 1356: $r->print("<th colspan=3>".
1357: &mt("in Section/Group")." $csec</th>");
1.57 albertel 1358: }
1359: $r->print(<<ENDTABLEHEADFOUR);
1.133 www 1360: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
1361: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192 albertel 1362: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1363: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10 www 1364: ENDTABLEHEADFOUR
1.57 albertel 1365:
1366: if ($csec) {
1.130 www 1367: $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57 albertel 1368: }
1369:
1370: if ($uname) {
1.130 www 1371: $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57 albertel 1372: }
1373:
1374: $r->print('</tr>');
1375:
1376: my $defbgone='';
1377: my $defbgtwo='';
1378:
1379: foreach (@ids) {
1380:
1381: my $rid=$_;
1382: my ($inmapid)=($rid=~/\.(\d+)$/);
1383:
1.152 albertel 1384: if ((!$pssymb &&
1385: (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
1386: ||
1387: ($pssymb && $pssymb eq $symbp{$rid})) {
1.4 www 1388: # ------------------------------------------------------ Entry for one resource
1.184 albertel 1389: if ($defbgone eq '"#E0E099"') {
1390: $defbgone='"#E0E0DD"';
1.57 albertel 1391: } else {
1.184 albertel 1392: $defbgone='"#E0E099"';
1.57 albertel 1393: }
1.184 albertel 1394: if ($defbgtwo eq '"#FFFF99"') {
1395: $defbgtwo='"#FFFFDD"';
1.57 albertel 1396: } else {
1.184 albertel 1397: $defbgtwo='"#FFFF99"';
1.57 albertel 1398: }
1399: my $thistitle='';
1400: my %name= ();
1401: undef %name;
1402: my %part= ();
1403: my %display=();
1404: my %type= ();
1405: my %default=();
1.196 www 1406: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1407:
1.210 www 1408: foreach (&keysplit($keyp{$rid})) {
1.57 albertel 1409: my $tempkeyp = $_;
1410: if (grep $_ eq $tempkeyp, @catmarker) {
1411: $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
1412: $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
1413: $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
1414: unless ($display{$_}) { $display{$_}=''; }
1415: $display{$_}.=' ('.$name{$_}.')';
1416: $default{$_}=&Apache::lonnet::metadata($uri,$_);
1417: $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
1418: $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
1419: }
1420: }
1421: my $totalparms=scalar keys %name;
1422: if ($totalparms>0) {
1423: my $firstrow=1;
1.180 albertel 1424: my $title=&Apache::lonnet::gettitle($uri);
1.57 albertel 1425: $r->print('<tr><td bgcolor='.$defbgone.
1426: ' rowspan='.$totalparms.
1427: '><tt><font size=-1>'.
1428: join(' / ',split(/\//,$uri)).
1429: '</font></tt><p><b>'.
1.154 albertel 1430: "<a href=\"javascript:openWindow('".
1431: &Apache::lonnet::clutter($uri).
1.57 albertel 1432: "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127 albertel 1433: " TARGET=_self>$title");
1.57 albertel 1434:
1435: if ($thistitle) {
1436: $r->print(' ('.$thistitle.')');
1437: }
1438: $r->print('</a></b></td>');
1439: $r->print('<td bgcolor='.$defbgtwo.
1440: ' rowspan='.$totalparms.'>'.$typep{$rid}.
1441: '</td>');
1442:
1443: $r->print('<td bgcolor='.$defbgone.
1444: ' rowspan='.$totalparms.
1445: '><tt><font size=-1>');
1446:
1447: $r->print(' / res / ');
1448: $r->print(join(' / ', split(/\//,$mapp{$rid})));
1449:
1450: $r->print('</font></tt></td>');
1451:
1.210 www 1452: foreach (&keysinorder(\%name,\%keyorder)) {
1.57 albertel 1453: unless ($firstrow) {
1454: $r->print('<tr>');
1455: } else {
1456: undef $firstrow;
1457: }
1458:
1.201 www 1459: &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57 albertel 1460: \%type,\%display,$defbgone,$defbgtwo,
1.187 www 1461: $parmlev,$uname,$udom,$csec);
1.57 albertel 1462: }
1463: }
1464: }
1465: } # end foreach ids
1.43 albertel 1466: # -------------------------------------------------- End entry for one resource
1.57 albertel 1467: $r->print('</table>');
1.203 www 1468: } # end of full
1.57 albertel 1469: #--------------------------------------------------- Entry for parm level map
1470: if ($parmlev eq 'map') {
1471: my $defbgone = '"E0E099"';
1472: my $defbgtwo = '"FFFF99"';
1473:
1474: my %maplist;
1475:
1476: if ($pschp eq 'all') {
1477: %maplist = %allmaps;
1478: } else {
1479: %maplist = ($pschp => $mapp{$pschp});
1480: }
1481:
1482: #-------------------------------------------- for each map, gather information
1483: my $mapid;
1.60 albertel 1484: foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
1485: my $maptitle = $maplist{$mapid};
1.57 albertel 1486:
1487: #----------------------- loop through ids and get all parameter types for map
1488: #----------------------------------------- and associated information
1489: my %name = ();
1490: my %part = ();
1491: my %display = ();
1492: my %type = ();
1493: my %default = ();
1494: my $map = 0;
1495:
1496: # $r->print("Catmarker: @catmarker<br />\n");
1497:
1498: foreach (@ids) {
1499: ($map)=(/([\d]*?)\./);
1500: my $rid = $_;
1501:
1502: # $r->print("$mapid:$map: $rid <br /> \n");
1503:
1504: if ($map eq $mapid) {
1.196 www 1505: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1506: # $r->print("Keys: $keyp{$rid} <br />\n");
1507:
1508: #--------------------------------------------------------------------
1509: # @catmarker contains list of all possible parameters including part #s
1510: # $fullkeyp contains the full part/id # for the extraction of proper parameters
1511: # $tempkeyp contains part 0 only (no ids - ie, subparts)
1512: # When storing information, store as part 0
1513: # When requesting information, request from full part
1514: #-------------------------------------------------------------------
1.210 www 1515: foreach (&keysplit($keyp{$rid})) {
1.57 albertel 1516: my $tempkeyp = $_;
1517: my $fullkeyp = $tempkeyp;
1.73 albertel 1518: $tempkeyp =~ s/_\w+_/_0_/;
1.57 albertel 1519:
1520: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1521: $part{$tempkeyp}="0";
1522: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1523: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
1524: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
1525: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73 albertel 1526: $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57 albertel 1527: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1528: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1529: }
1530: } # end loop through keys
1531: }
1532: } # end loop through ids
1533:
1534: #---------------------------------------------------- print header information
1.133 www 1535: my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82 www 1536: my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57 albertel 1537: $r->print(<<ENDMAPONE);
1538: <center><h4>
1.135 albertel 1539: Set Defaults for All Resources in $foldermap<br />
1540: <font color="red"><i>$showtitle</i></font><br />
1.57 albertel 1541: Specifically for
1542: ENDMAPONE
1543: if ($uname) {
1544: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1545: ('firstname','middlename','lastname','generation', 'id'));
1546: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1547: .$name{'lastname'}.' '.$name{'generation'};
1.135 albertel 1548: $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130 www 1549: &mt('in')." \n");
1.57 albertel 1550: } else {
1.135 albertel 1551: $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57 albertel 1552: }
1553:
1.135 albertel 1554: if ($csec) {$r->print(&mt("Section")." <font color=\"red\"><i>$csec</i></font> ".
1.130 www 1555: &mt('of')." \n")};
1.57 albertel 1556:
1.135 albertel 1557: $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
1558: $r->print("</h4>\n");
1.57 albertel 1559: #---------------------------------------------------------------- print table
1560: $r->print('<p><table border="2">');
1.130 www 1561: $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
1562: $r->print('<th>'.&mt('Default Value').'</th>');
1563: $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57 albertel 1564:
1.210 www 1565: foreach (&keysinorder(\%name,\%keyorder)) {
1.168 matthew 1566: $r->print('<tr>');
1.201 www 1567: &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.57 albertel 1568: \%type,\%display,$defbgone,$defbgtwo,
1.187 www 1569: $parmlev,$uname,$udom,$csec);
1.57 albertel 1570: }
1571: $r->print("</table></center>");
1572: } # end each map
1573: } # end of $parmlev eq map
1574: #--------------------------------- Entry for parm level general (Course level)
1575: if ($parmlev eq 'general') {
1576: my $defbgone = '"E0E099"';
1577: my $defbgtwo = '"FFFF99"';
1578:
1579: #-------------------------------------------- for each map, gather information
1580: my $mapid="0.0";
1581: #----------------------- loop through ids and get all parameter types for map
1582: #----------------------------------------- and associated information
1583: my %name = ();
1584: my %part = ();
1585: my %display = ();
1586: my %type = ();
1587: my %default = ();
1588:
1589: foreach (@ids) {
1590: my $rid = $_;
1591:
1.196 www 1592: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1593:
1594: #--------------------------------------------------------------------
1595: # @catmarker contains list of all possible parameters including part #s
1596: # $fullkeyp contains the full part/id # for the extraction of proper parameters
1597: # $tempkeyp contains part 0 only (no ids - ie, subparts)
1598: # When storing information, store as part 0
1599: # When requesting information, request from full part
1600: #-------------------------------------------------------------------
1.210 www 1601: foreach (&keysplit($keyp{$rid})) {
1.57 albertel 1602: my $tempkeyp = $_;
1603: my $fullkeyp = $tempkeyp;
1.73 albertel 1604: $tempkeyp =~ s/_\w+_/_0_/;
1.57 albertel 1605: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1606: $part{$tempkeyp}="0";
1607: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1608: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
1609: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
1610: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73 albertel 1611: $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57 albertel 1612: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1613: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1614: }
1615: } # end loop through keys
1616: } # end loop through ids
1617:
1618: #---------------------------------------------------- print header information
1.133 www 1619: my $setdef=&mt("Set Defaults for All Resources in Course");
1.57 albertel 1620: $r->print(<<ENDMAPONE);
1.133 www 1621: <center><h4>$setdef
1.135 albertel 1622: <font color="red"><i>$coursename</i></font><br />
1.57 albertel 1623: ENDMAPONE
1624: if ($uname) {
1625: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1626: ('firstname','middlename','lastname','generation', 'id'));
1627: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1628: .$name{'lastname'}.' '.$name{'generation'};
1.135 albertel 1629: $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57 albertel 1630: } else {
1.135 albertel 1631: $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57 albertel 1632: }
1633:
1.135 albertel 1634: if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1635: $r->print("</h4>\n");
1.57 albertel 1636: #---------------------------------------------------------------- print table
1637: $r->print('<p><table border="2">');
1.130 www 1638: $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
1639: $r->print('<th>'.&mt('Default Value').'</th>');
1640: $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57 albertel 1641:
1.210 www 1642: foreach (&keysinorder(\%name,\%keyorder)) {
1.168 matthew 1643: $r->print('<tr>');
1.201 www 1644: &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.187 www 1645: \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
1.57 albertel 1646: }
1647: $r->print("</table></center>");
1648: } # end of $parmlev eq general
1.43 albertel 1649: }
1.44 albertel 1650: $r->print('</form></body></html>');
1.57 albertel 1651: } # end sub assessparms
1.30 www 1652:
1.59 matthew 1653:
1654: ##################################################
1655: ##################################################
1656:
1657: =pod
1658:
1659: =item crsenv
1660:
1.105 matthew 1661: Show and set course data and parameters. This is a large routine that should
1.59 matthew 1662: be simplified and shortened... someday.
1663:
1664: Inputs: $r
1665:
1666: Returns: nothing
1667:
1668: =cut
1669:
1670: ##################################################
1671: ##################################################
1.30 www 1672: sub crsenv {
1673: my $r=shift;
1674: my $setoutput='';
1.64 www 1675: my $bodytag=&Apache::loncommon::bodytag(
1676: 'Set Course Environment Parameters');
1.194 albertel 1677: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,
1678: 'Edit Course Environment');
1.190 albertel 1679: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1680: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.105 matthew 1681:
1682: #
1683: # Go through list of changes
1.190 albertel 1684: foreach (keys %env) {
1.105 matthew 1685: next if ($_!~/^form\.(.+)\_setparmval$/);
1686: my $name = $1;
1.190 albertel 1687: my $value = $env{'form.'.$name.'_value'};
1.105 matthew 1688: if ($name eq 'newp') {
1.190 albertel 1689: $name = $env{'form.newp_name'};
1.105 matthew 1690: }
1691: if ($name eq 'url') {
1692: $value=~s/^\/res\///;
1693: my $bkuptime=time;
1694: my @tmp = &Apache::lonnet::get
1695: ('environment',['url'],$dom,$crs);
1.130 www 1696: $setoutput.=&mt('Backing up previous URL').': '.
1.105 matthew 1697: &Apache::lonnet::put
1698: ('environment',
1699: {'top level map backup '.$bkuptime => $tmp[1] },
1700: $dom,$crs).
1701: '<br>';
1702: }
1703: #
1704: # Deal with modified default spreadsheets
1705: if ($name =~ /^spreadsheet_default_(classcalc|
1706: studentcalc|
1707: assesscalc)$/x) {
1708: my $sheettype = $1;
1709: if ($sheettype eq 'classcalc') {
1710: # no need to do anything since viewing the sheet will
1711: # cause it to be updated.
1712: } elsif ($sheettype eq 'studentcalc') {
1713: # expire all the student spreadsheets
1714: &Apache::lonnet::expirespread('','','studentcalc');
1715: } else {
1716: # expire all the assessment spreadsheets
1717: # this includes non-default spreadsheets, but better to
1718: # be safe than sorry.
1719: &Apache::lonnet::expirespread('','','assesscalc');
1720: # expire all the student spreadsheets
1721: &Apache::lonnet::expirespread('','','studentcalc');
1.30 www 1722: }
1.105 matthew 1723: }
1724: #
1.107 matthew 1725: # Deal with the enrollment dates
1726: if ($name =~ /^default_enrollment_(start|end)_date$/) {
1727: $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
1728: }
1.178 raeburn 1729: # Get existing cloners
1730: my @oldcloner = ();
1731: if ($name eq 'cloners') {
1732: my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
1733: if ($clonenames{'cloners'} =~ /,/) {
1734: @oldcloner = split/,/,$clonenames{'cloners'};
1735: } else {
1736: $oldcloner[0] = $clonenames{'cloners'};
1737: }
1738: }
1.107 matthew 1739: #
1.105 matthew 1740: # Let the user know we made the changes
1.153 albertel 1741: if ($name && defined($value)) {
1.178 raeburn 1742: if ($name eq 'cloners') {
1743: $value =~ s/^,//;
1744: $value =~ s/,$//;
1745: }
1.105 matthew 1746: my $put_result = &Apache::lonnet::put('environment',
1747: {$name=>$value},$dom,$crs);
1748: if ($put_result eq 'ok') {
1.130 www 1749: $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178 raeburn 1750: if ($name eq 'cloners') {
1751: &change_clone($value,\@oldcloner);
1752: }
1.179 raeburn 1753: # Flush the course logs so course description is immediately updated
1754: if ($name eq 'description' && defined($value)) {
1755: &Apache::lonnet::flushcourselogs();
1756: }
1.105 matthew 1757: } else {
1.130 www 1758: $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
1759: ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30 www 1760: }
1761: }
1.38 harris41 1762: }
1.108 www 1763: # ------------------------- Re-init course environment entries for this session
1764:
1.190 albertel 1765: &Apache::lonnet::coursedescription($env{'request.course.id'});
1.105 matthew 1766:
1.30 www 1767: # -------------------------------------------------------- Get parameters again
1.45 matthew 1768:
1769: my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140 sakharuk 1770: my $SelectStyleFile=&mt('Select Style File');
1.141 sakharuk 1771: my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30 www 1772: my $output='';
1.45 matthew 1773: if (! exists($values{'con_lost'})) {
1.30 www 1774: my %descriptions=
1.140 sakharuk 1775: ('url' => '<b>'.&mt('Top Level Map').'</b> '.
1.46 matthew 1776: '<a href="javascript:openbrowser'.
1.47 matthew 1777: "('envform','url','sequence')\">".
1.140 sakharuk 1778: &mt('Select Map').'</a><br /><font color=red> '.
1779: &mt('Modification may make assessment data inaccessible').
1780: '</font>',
1781: 'description' => '<b>'.&mt('Course Description').'</b>',
1.158 sakharuk 1782: 'courseid' => '<b>'.&mt('Course ID or number').
1.140 sakharuk 1783: '</b><br />'.
1784: '('.&mt('internal').', '.&mt('optional').')',
1.177 raeburn 1785: 'cloners' => '<b>'.&mt('Users allowed to clone course').'</b><br /><tt>(user:domain,user:domain)</tt><br />'.&mt('Users with active Course Coordinator role in the course automatically have the right to clone it, and can be omitted from list.'),
1.150 www 1786: 'grading' => '<b>'.&mt('Grading').'</b><br />'.
1787: '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140 sakharuk 1788: 'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52 www 1789: '<a href="javascript:openbrowser'.
1790: "('envform','default_xml_style'".
1.140 sakharuk 1791: ",'sty')\">$SelectStyleFile</a><br>",
1.141 sakharuk 1792: 'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
1793: '</b><br />(<tt>user:domain,'.
1.74 www 1794: 'user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1795: 'comment.email' => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74 www 1796: '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1797: 'policy.email' => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75 albertel 1798: '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1799: 'hideemptyrows' => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158 sakharuk 1800: '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141 sakharuk 1801: 'pageseparators' => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158 sakharuk 1802: '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141 sakharuk 1803: &mt('changes will not show until next login').')',
1.169 matthew 1804: 'student_classlist_view' => '<b>'.&mt('Allow students to view classlist.').'</b>'.&mt('("all":students can view all sections,"section":students can only view their own section.blank or "disabled" prevents student view.'),
1.118 matthew 1805:
1.141 sakharuk 1806: 'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
1807: '</b><br />"<tt>st</tt>": '.
1.158 sakharuk 1808: &mt('student').', "<tt>ta</tt>": '.
1.118 matthew 1809: 'TA, "<tt>in</tt>": '.
1.158 sakharuk 1810: &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118 matthew 1811: Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1812: 'plc.users.denied' =>
1.141 sakharuk 1813: '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118 matthew 1814: '(<tt>user:domain,user:domain,...</tt>)',
1815:
1.141 sakharuk 1816: 'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
1817: '</b><br />"<tt>st</tt>": '.
1.61 albertel 1818: 'student, "<tt>ta</tt>": '.
1819: 'TA, "<tt>in</tt>": '.
1.75 albertel 1820: 'instructor;<br /><tt>role,role,...</tt>) '.
1.61 albertel 1821: Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53 www 1822: 'pch.users.denied' =>
1.141 sakharuk 1823: '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53 www 1824: '(<tt>user:domain,user:domain,...</tt>)',
1.49 matthew 1825: 'spreadsheet_default_classcalc'
1.141 sakharuk 1826: => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50 matthew 1827: '<a href="javascript:openbrowser'.
1828: "('envform','spreadsheet_default_classcalc'".
1.141 sakharuk 1829: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49 matthew 1830: 'spreadsheet_default_studentcalc'
1.141 sakharuk 1831: => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50 matthew 1832: '<a href="javascript:openbrowser'.
1833: "('envform','spreadsheet_default_calc'".
1.141 sakharuk 1834: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49 matthew 1835: 'spreadsheet_default_assesscalc'
1.141 sakharuk 1836: => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50 matthew 1837: '<a href="javascript:openbrowser'.
1838: "('envform','spreadsheet_default_assesscalc'".
1.141 sakharuk 1839: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75 albertel 1840: 'allow_limited_html_in_feedback'
1.141 sakharuk 1841: => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158 sakharuk 1842: '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170 raeburn 1843: 'allow_discussion_post_editing'
1844: => '<b>'.&mt('Allow users to edit/delete their own discussion posts').'</b><br />'.
1845: '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.89 albertel 1846: 'rndseed'
1.140 sakharuk 1847: => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
1848: '<font color="red">'.&mt('Modifying this will make problems').' '.
1849: &mt('have different numbers and answers').'</font>',
1.151 albertel 1850: 'receiptalg'
1851: => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
1852: &mt('This controls how receipt numbers are generated.'),
1.164 sakharuk 1853: 'suppress_tries'
1854: => '<b>'.&mt('Suppress number of tries in printing').'</b>('.
1855: &mt('yes if supress').')',
1.113 sakharuk 1856: 'problem_stream_switch'
1.141 sakharuk 1857: => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158 sakharuk 1858: ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161 sakharuk 1859: 'default_paper_size'
1860: => '<b>'.&mt('Default paper type').'</b><br />'.
1861: ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'.
1862: ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'.
1863: ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111 sakharuk 1864: 'anonymous_quiz'
1.150 www 1865: => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141 sakharuk 1866: ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
1.217 albertel 1867: 'default_enrollment_start_date' => '<b>'.&mt('Default beginning date for student access.').'</b>',
1868: 'default_enrollment_end_date' => '<b>'.&mt('Default ending date for student access.').'</b>',
1.150 www 1869: 'nothideprivileged' => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
1870: '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140 sakharuk 1871: 'languages' => '<b>'.&mt('Languages used').'</b>',
1.115 www 1872: 'disable_receipt_display'
1.141 sakharuk 1873: => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158 sakharuk 1874: ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163 albertel 1875: 'disablesigfigs'
1876: => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
1877: ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.149 albertel 1878: 'tthoptions'
1879: => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107 matthew 1880: );
1.177 raeburn 1881: my @Display_Order = ('url','description','courseid','cloners','grading',
1.107 matthew 1882: 'default_xml_style','pageseparators',
1883: 'question.email','comment.email','policy.email',
1.169 matthew 1884: 'student_classlist_view',
1.118 matthew 1885: 'plc.roles.denied','plc.users.denied',
1.107 matthew 1886: 'pch.roles.denied','pch.users.denied',
1887: 'allow_limited_html_in_feedback',
1.170 raeburn 1888: 'allow_discussion_post_editing',
1.108 www 1889: 'languages',
1.150 www 1890: 'nothideprivileged',
1.107 matthew 1891: 'rndseed',
1.151 albertel 1892: 'receiptalg',
1.107 matthew 1893: 'problem_stream_switch',
1.164 sakharuk 1894: 'suppress_tries',
1.161 sakharuk 1895: 'default_paper_size',
1.115 www 1896: 'disable_receipt_display',
1.107 matthew 1897: 'spreadsheet_default_classcalc',
1898: 'spreadsheet_default_studentcalc',
1899: 'spreadsheet_default_assesscalc',
1900: 'hideemptyrows',
1901: 'default_enrollment_start_date',
1902: 'default_enrollment_end_date',
1.163 albertel 1903: 'tthoptions',
1904: 'disablesigfigs'
1.107 matthew 1905: );
1906: foreach my $parameter (sort(keys(%values))) {
1.142 raeburn 1907: unless ($parameter =~ m/^internal\./) {
1908: if (! $descriptions{$parameter}) {
1909: $descriptions{$parameter}=$parameter;
1910: push(@Display_Order,$parameter);
1911: }
1912: }
1.43 albertel 1913: }
1.107 matthew 1914: foreach my $parameter (@Display_Order) {
1915: my $description = $descriptions{$parameter};
1.51 matthew 1916: # onchange is javascript to automatically check the 'Set' button.
1.69 www 1917: my $onchange = 'onFocus="javascript:window.document.forms'.
1.107 matthew 1918: "['envform'].elements['".$parameter."_setparmval']".
1.51 matthew 1919: '.checked=true;"';
1.107 matthew 1920: $output .= '<tr><td>'.$description.'</td>';
1921: if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
1922: $output .= '<td>'.
1923: &Apache::lonhtmlcommon::date_setter('envform',
1924: $parameter.'_value',
1925: $values{$parameter},
1926: $onchange).
1927: '</td>';
1928: } else {
1929: $output .= '<td>'.
1930: &Apache::lonhtmlcommon::textbox($parameter.'_value',
1931: $values{$parameter},
1932: 40,$onchange).'</td>';
1933: }
1934: $output .= '<td>'.
1935: &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
1936: '</td>';
1937: $output .= "</tr>\n";
1.51 matthew 1938: }
1.69 www 1939: my $onchange = 'onFocus="javascript:window.document.forms'.
1.51 matthew 1940: '[\'envform\'].elements[\'newp_setparmval\']'.
1941: '.checked=true;"';
1.130 www 1942: $output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51 matthew 1943: '<input type="text" size=40 name="newp_name" '.
1944: $onchange.' /></td><td>'.
1945: '<input type="text" size=40 name="newp_value" '.
1946: $onchange.' /></td><td>'.
1947: '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43 albertel 1948: }
1.157 sakharuk 1949: my %lt=&Apache::lonlocal::texthash(
1950: 'par' => 'Parameter',
1951: 'val' => 'Value',
1952: 'set' => 'Set',
1953: 'sce' => 'Set Course Environment'
1954: );
1955:
1.140 sakharuk 1956: my $Parameter=&mt('Parameter');
1957: my $Value=&mt('Value');
1.141 sakharuk 1958: my $Set=&mt('Set');
1.167 albertel 1959: my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset');
1.183 albertel 1960: my $html=&Apache::lonxml::xmlbegin();
1.190 albertel 1961: $r->print(<<ENDenv);
1.183 albertel 1962: $html
1963: <head>
1.46 matthew 1964: <script type="text/javascript" language="Javascript" >
1.155 albertel 1965: $browse_js
1.46 matthew 1966: </script>
1.30 www 1967: <title>LON-CAPA Course Environment</title>
1968: </head>
1.64 www 1969: $bodytag
1.193 albertel 1970: $breadcrumbs
1971: <form method="post" action="/adm/parmset?action=crsenv" name="envform">
1.30 www 1972: $setoutput
1973: <p>
1974: <table border=2>
1.157 sakharuk 1975: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30 www 1976: $output
1977: </table>
1.157 sakharuk 1978: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30 www 1979: </form>
1980: </body>
1981: </html>
1.190 albertel 1982: ENDenv
1.30 www 1983: }
1.120 www 1984: ##################################################
1.207 www 1985: # Overview mode
1986: ##################################################
1.124 www 1987: my $tableopen;
1988:
1989: sub tablestart {
1990: if ($tableopen) {
1991: return '';
1992: } else {
1993: $tableopen=1;
1.130 www 1994: return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
1995: &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124 www 1996: }
1997: }
1998:
1999: sub tableend {
2000: if ($tableopen) {
2001: $tableopen=0;
2002: return '</table>';
2003: } else {
2004: return'';
2005: }
2006: }
2007:
1.207 www 2008: sub readdata {
2009: my ($crs,$dom)=@_;
2010: # Read coursedata
2011: my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
2012: # Read userdata
2013:
2014: my $classlist=&Apache::loncoursedata::get_classlist();
2015: foreach (keys %$classlist) {
2016: # the following undefs are for 'domain', and 'username' respectively.
2017: if ($_=~/^(\w+)\:(\w+)$/) {
2018: my ($tuname,$tudom)=($1,$2);
2019: my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
2020: foreach my $userkey (keys %{$useropt}) {
2021: if ($userkey=~/^$env{'request.course.id'}/) {
2022: my $newkey=$userkey;
2023: $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
2024: $$resourcedata{$newkey}=$$useropt{$userkey};
2025: }
2026: }
2027: }
2028: }
2029: return $resourcedata;
2030: }
2031:
2032:
1.124 www 2033: # Setting
1.208 www 2034:
2035: sub storedata {
2036: my ($r,$crs,$dom)=@_;
1.207 www 2037: # Set userlevel immediately
2038: # Do an intermediate store of course level
2039: my $olddata=&readdata($crs,$dom);
1.124 www 2040: my %newdata=();
2041: undef %newdata;
2042: my @deldata=();
2043: undef @deldata;
1.190 albertel 2044: foreach (keys %env) {
1.124 www 2045: if ($_=~/^form\.([a-z]+)\_(.+)$/) {
2046: my $cmd=$1;
2047: my $thiskey=$2;
1.207 www 2048: my ($tuname,$tudom)=&extractuser($thiskey);
2049: my $tkey=$thiskey;
2050: if ($tuname) {
2051: $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
2052: }
1.124 www 2053: if ($cmd eq 'set') {
1.190 albertel 2054: my $data=$env{$_};
1.212 www 2055: my $typeof=$env{'form.typeof_'.$thiskey};
2056: if ($$olddata{$thiskey} ne $data) {
1.207 www 2057: if ($tuname) {
1.212 www 2058: if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
2059: $tkey.'.type' => $typeof},
2060: $tudom,$tuname) eq 'ok') {
1.207 www 2061: $r->print('<br />'.&mt('Stored modified parameter for').' '.
2062: &Apache::loncommon::plainname($tuname,$tudom));
2063: } else {
2064: $r->print('<h2><font color="red">'.
2065: &mt('Error storing parameters').'</font></h2>');
2066: }
2067: &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
2068: } else {
2069: $newdata{$thiskey}=$data;
1.212 www 2070: $newdata{$thiskey.'.type'}=$typeof;
2071: }
1.207 www 2072: }
1.124 www 2073: } elsif ($cmd eq 'del') {
1.207 www 2074: if ($tuname) {
2075: if (&Apache::lonnet::del('resourcedata',[$tkey],$tudom,$tuname) eq 'ok') {
2076: $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
2077: } else {
2078: $r->print('<h2><font color="red">'.
2079: &mt('Error deleting parameters').'</font></h2>');
2080: }
2081: &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
2082: } else {
2083: push (@deldata,$thiskey);
2084: }
1.124 www 2085: } elsif ($cmd eq 'datepointer') {
1.190 albertel 2086: my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
1.212 www 2087: my $typeof=$env{'form.typeof_'.$thiskey};
1.207 www 2088: if (defined($data) and $$olddata{$thiskey} ne $data) {
2089: if ($tuname) {
1.212 www 2090: if (&Apache::lonnet::put('resourcedata',{$tkey=>$data,
2091: $tkey.'.type' => $typeof},
2092: $tudom,$tuname) eq 'ok') {
1.207 www 2093: $r->print('<br />'.&mt('Stored modified date for').' '.&Apache::loncommon::plainname($tuname,$tudom));
2094: } else {
2095: $r->print('<h2><font color="red">'.
2096: &mt('Error storing parameters').'</font></h2>');
2097: }
2098: &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
2099: } else {
1.212 www 2100: $newdata{$thiskey}=$data;
2101: $newdata{$thiskey.'.type'}=$typeof;
1.207 www 2102: }
2103: }
1.124 www 2104: }
2105: }
2106: }
1.207 www 2107: # Store all course level
1.144 www 2108: my $delentries=$#deldata+1;
2109: my @newdatakeys=keys %newdata;
2110: my $putentries=$#newdatakeys+1;
2111: if ($delentries) {
2112: if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
2113: $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
2114: } else {
2115: $r->print('<h2><font color="red">'.
2116: &mt('Error deleting parameters').'</font></h2>');
2117: }
1.205 www 2118: &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144 www 2119: }
2120: if ($putentries) {
2121: if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1.212 www 2122: $r->print('<h3>'.&mt('Stored [_1] parameter(s)',$putentries/2).'</h3>');
1.144 www 2123: } else {
2124: $r->print('<h2><font color="red">'.
2125: &mt('Error storing parameters').'</font></h2>');
2126: }
1.205 www 2127: &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144 www 2128: }
1.208 www 2129: }
1.207 www 2130:
1.208 www 2131: sub extractuser {
2132: my $key=shift;
2133: return ($key=~/^$env{'request.course.id'}.\[useropt\:(\w+)\:(\w+)\]\./);
2134: }
1.206 www 2135:
1.208 www 2136: sub listdata {
1.214 www 2137: my ($r,$resourcedata,$listdata,$sortorder)=@_;
1.207 www 2138: # Start list output
1.206 www 2139:
1.122 www 2140: my $oldsection='';
2141: my $oldrealm='';
2142: my $oldpart='';
1.123 www 2143: my $pointer=0;
1.124 www 2144: $tableopen=0;
1.145 www 2145: my $foundkeys=0;
1.214 www 2146: foreach my $thiskey (sort {
2147: if ($sortorder eq 'realmstudent') {
2148: my ($astudent,$arealm)=($a=~/^$env{'request.course.id'}\.([^\.]+)\.(.+)\.[^\.]+$/);
2149: my ($bstudent,$brealm)=($b=~/^$env{'request.course.id'}\.([^\.]+)\.(.+)\.[^\.]+$/);
2150: ($arealm cmp $brealm) || ($astudent cmp $bstudent);
2151: } else {
2152: $a cmp $b;
2153: }
2154: } keys %{$listdata}) {
1.211 www 2155: if ($$listdata{$thiskey.'.type'}) {
2156: my $thistype=$$listdata{$thiskey.'.type'};
2157: if ($$resourcedata{$thiskey.'.type'}) {
2158: $thistype=$$resourcedata{$thiskey.'.type'};
2159: }
1.207 www 2160: my ($middle,$part,$name)=
2161: ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130 www 2162: my $section=&mt('All Students');
1.207 www 2163: if ($middle=~/^\[(.*)\]/) {
1.206 www 2164: my $issection=$1;
2165: if ($issection=~/^useropt\:(\w+)\:(\w+)/) {
2166: $section=&mt('User').": ".&Apache::loncommon::plainname($1,$2);
2167: } else {
2168: $section=&mt('Group/Section').': '.$issection;
2169: }
1.207 www 2170: $middle=~s/^\[(.*)\]//;
1.122 www 2171: }
1.207 www 2172: $middle=~s/\.+$//;
2173: $middle=~s/^\.+//;
1.130 www 2174: my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122 www 2175: if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174 albertel 2176: $realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122 www 2177: } elsif ($middle) {
1.174 albertel 2178: my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
2179: $realm='<font color="orange">'.&mt('Resource').': '.&Apache::lonnet::gettitle($middle).' <br /><font color="#aaaaaa" size="-2">('.$url.' in '.$map.' id: '.$id.')</font></font>';
1.122 www 2180: }
1.214 www 2181: if ($sortorder eq 'realmstudent') {
2182: if ($realm ne $oldrealm) {
2183: $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
2184: $oldrealm=$realm;
2185: $oldsection='';
2186: }
2187: if ($section ne $oldsection) {
2188: $r->print(&tableend()."\n<h2>$section</h2>");
2189: $oldsection=$section;
2190: $oldpart='';
2191: }
2192: } else {
2193: if ($section ne $oldsection) {
2194: $r->print(&tableend()."\n<hr /><h1>$section</h1>");
2195: $oldsection=$section;
2196: $oldrealm='';
2197: }
2198: if ($realm ne $oldrealm) {
2199: $r->print(&tableend()."\n<h2>$realm</h2>");
2200: $oldrealm=$realm;
2201: $oldpart='';
2202: }
1.122 www 2203: }
2204: if ($part ne $oldpart) {
1.124 www 2205: $r->print(&tableend().
1.214 www 2206: "\n<font color='blue'>".&mt('Part').": $part</font>");
1.122 www 2207: $oldpart=$part;
2208: }
1.123 www 2209: #
2210: # Ready to print
2211: #
1.124 www 2212: $r->print(&tablestart().'<tr><td><b>'.$name.
2213: ':</b></td><td><input type="checkbox" name="del_'.
2214: $thiskey.'" /></td><td>');
1.145 www 2215: $foundkeys++;
1.213 www 2216: if (&isdateparm($thistype)) {
1.123 www 2217: my $jskey='key_'.$pointer;
2218: $pointer++;
2219: $r->print(
2220: &Apache::lonhtmlcommon::date_setter('overviewform',
2221: $jskey,
1.219 www 2222: $$resourcedata{$thiskey},
2223: '',1).
1.123 www 2224: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
2225: );
1.219 www 2226: } elsif ($thistype eq 'string_yesno') {
2227: $r->print('<label><input type="radio" name="set_'.$thiskey.
2228: '" value="yes"');
2229: if ($$resourcedata{$thiskey} eq 'yes') {
2230: $r->print(' checked="checked"');
2231: }
2232: $r->print(' />'.&mt('Yes').'</label> ');
2233: $r->print('<label><input type="radio" name="set_'.$thiskey.
2234: '" value="no"');
2235: if ($$resourcedata{$thiskey} eq 'no') {
2236: $r->print(' checked="checked"');
2237: }
2238: $r->print(' />'.&mt('No').'</label>');
1.123 www 2239: } else {
1.211 www 2240: $r->print('<input type="text" name="set_'.$thiskey.'" value="'.
1.206 www 2241: $$resourcedata{$thiskey}.'">');
1.123 www 2242: }
1.211 www 2243: $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
2244: $thistype.'">');
1.124 www 2245: $r->print('</td></tr>');
1.122 www 2246: }
1.121 www 2247: }
1.208 www 2248: return $foundkeys;
2249: }
2250:
2251: sub newoverview {
2252: my $r=shift;
1.216 www 2253: my $bodytag=&Apache::loncommon::bodytag('Set Parameters');
1.208 www 2254: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2255: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
2256: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
2257: my $html=&Apache::lonxml::xmlbegin();
2258: $r->print(<<ENDOVER);
2259: $html
2260: <head>
2261: <title>LON-CAPA Parameters</title>
2262: </head>
2263: $bodytag
2264: $breadcrumbs
1.211 www 2265: <form method="post" action="/adm/parmset?action=newoverview" name="parmform">
1.208 www 2266: ENDOVER
1.211 www 2267: my @ids=();
2268: my %typep=();
2269: my %keyp=();
2270: my %allparms=();
2271: my %allparts=();
2272: my %allmaps=();
2273: my %mapp=();
2274: my %symbp=();
2275: my %maptitles=();
2276: my %uris=();
2277: my %keyorder=&standardkeyorder();
2278: my %defkeytype=();
2279:
2280: my %alllevs=();
2281: $alllevs{'Resource Level'}='full';
1.215 www 2282: $alllevs{'Map/Folder Level'}='map';
1.211 www 2283: $alllevs{'Course Level'}='general';
2284:
2285: my $csec=$env{'form.csec'};
2286:
2287: my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
2288: my $pschp=$env{'form.pschp'};
2289: my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
2290: if (!@psprt) { $psprt[0]='0'; }
2291:
2292: my @selected_sections =
2293: &Apache::loncommon::get_env_multiple('form.Section');
2294: @selected_sections = ('all') if (! @selected_sections);
2295: foreach (@selected_sections) {
2296: if ($_ eq 'all') {
2297: @selected_sections = ('all');
2298: }
2299: }
2300:
2301: my $pssymb='';
2302: my $parmlev='';
2303:
2304: unless ($env{'form.parmlev'}) {
2305: $parmlev = 'map';
2306: } else {
2307: $parmlev = $env{'form.parmlev'};
2308: }
2309:
2310: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
2311: \%mapp, \%symbp,\%maptitles,\%uris,
2312: \%keyorder,\%defkeytype);
2313:
2314: # Menu to select levels, etc
2315:
2316: $r->print('<table border="1"><tr><td>');
2317: &levelmenu($r,\%alllevs,$parmlev);
2318: if ($parmlev ne 'general') {
2319: $r->print('<td>');
2320: &mapmenu($r,\%allmaps,$pschp,\%maptitles);
2321: $r->print('</td>');
2322: }
2323: $r->print('</td></tr></table>');
2324:
2325: $r->print('<table border="1"><tr><td>');
2326: &parmmenu($r,\%allparms,\@pscat,\%keyorder);
2327: $r->print('</td><td>');
2328: &partmenu($r,\%allparts,\@psprt);
2329: $r->print('</td><td>');
2330: §ionmenu($r,\@selected_sections);
1.214 www 2331:
2332: $r->print('</td></tr></table>');
2333:
2334: my $sortorder=$env{'form.sortorder'};
2335: unless ($sortorder) { $sortorder='realmstudent'; }
2336: &sortmenu($r,$sortorder);
2337:
2338: $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.211 www 2339:
2340: # Build the list data hash from the specified parms
2341:
2342: my $listdata;
2343: %{$listdata}=();
2344:
2345: foreach my $cat (@pscat) {
2346: foreach my $section (@selected_sections) {
2347: foreach my $part (@psprt) {
1.212 www 2348: my $rootparmkey=$env{'request.course.id'};
1.211 www 2349: if (($section ne 'all') && ($section ne 'none') && ($section)) {
1.212 www 2350: $rootparmkey.='.['.$section.']';
1.211 www 2351: }
2352: if ($parmlev eq 'general') {
2353: # course-level parameter
1.212 www 2354: my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
2355: $$listdata{$newparmkey}=1;
2356: $$listdata{$newparmkey.'.type'}=$defkeytype{$cat};
1.211 www 2357: } elsif ($parmlev eq 'map') {
1.212 www 2358: # map-level parameter
2359: foreach my $mapid (keys %allmaps) {
2360: if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
2361: my $newparmkey=$rootparmkey.'.'.$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
1.211 www 2362: $$listdata{$newparmkey}=1;
2363: $$listdata{$newparmkey.'.type'}=$defkeytype{$cat};
2364: }
2365: } else {
2366: # resource-level parameter
1.212 www 2367: foreach my $rid (@ids) {
2368: my ($map,$resid,$url)=&Apache::lonnet::decode_symb($symbp{$rid});
2369: if (($pschp ne 'all') && ($allmaps{$pschp} ne $map)) { next; }
2370: my $newparmkey=$rootparmkey.'.'.$symbp{$rid}.'.'.$part.'.'.$cat;
2371: $$listdata{$newparmkey}=1;
2372: $$listdata{$newparmkey.'.type'}=$defkeytype{$cat};
2373: }
1.211 www 2374: }
2375: }
2376: }
2377: }
2378:
1.212 www 2379: if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211 www 2380:
1.212 www 2381: if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211 www 2382:
2383: # Read modified data
2384:
2385: my $resourcedata=&readdata($crs,$dom);
2386:
2387: # List data
2388:
1.214 www 2389: &listdata($r,$resourcedata,$listdata,$sortorder);
1.211 www 2390: }
2391: $r->print(&tableend().
1.212 www 2392: ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Store').'" /></p>':'').
2393: '</form></body></html>');
1.208 www 2394: }
2395:
2396: sub overview {
2397: my $r=shift;
1.216 www 2398: my $bodytag=&Apache::loncommon::bodytag('Modify Parameters');
1.208 www 2399: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2400: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
2401: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
2402: my $html=&Apache::lonxml::xmlbegin();
2403: $r->print(<<ENDOVER);
2404: $html
2405: <head>
2406: <title>LON-CAPA Parameters</title>
2407: </head>
2408: $bodytag
2409: $breadcrumbs
2410: <form method="post" action="/adm/parmset?action=setoverview" name="overviewform">
2411: ENDOVER
2412: # Store modified
2413:
2414: &storedata($r,$crs,$dom);
2415:
2416: # Read modified data
2417:
2418: my $resourcedata=&readdata($crs,$dom);
2419:
1.214 www 2420:
2421: my $sortorder=$env{'form.sortorder'};
2422: unless ($sortorder) { $sortorder='realmstudent'; }
2423: &sortmenu($r,$sortorder);
2424:
1.208 www 2425: # List data
2426:
1.214 www 2427: my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder);
1.208 www 2428:
1.145 www 2429: $r->print(&tableend().'<p>'.
1.208 www 2430: ($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no parameters.')).'</p></form></body></html>');
1.120 www 2431: }
1.121 www 2432:
1.59 matthew 2433: ##################################################
2434: ##################################################
1.178 raeburn 2435:
2436: =pod
2437:
2438: =item change clone
2439:
2440: Modifies the list of courses a user can clone (stored
2441: in the user's environemnt.db file), called when a
2442: change is made to the list of users allowed to clone
2443: a course.
2444:
2445: Inputs: $action,$cloner
2446: where $action is add or drop, and $cloner is identity of
2447: user for whom cloning ability is to be changed in course.
2448:
2449: Returns:
2450:
2451: =cut
2452:
2453: ##################################################
2454: ##################################################
2455:
2456:
2457: sub change_clone {
2458: my ($clonelist,$oldcloner) = @_;
2459: my ($uname,$udom);
1.190 albertel 2460: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2461: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178 raeburn 2462: my $clone_crs = $cnum.':'.$cdom;
2463:
2464: if ($cnum && $cdom) {
2465: my @allowclone = ();
2466: if ($clonelist =~ /,/) {
2467: @allowclone = split/,/,$clonelist;
2468: } else {
2469: $allowclone[0] = $clonelist;
2470: }
2471: foreach my $currclone (@allowclone) {
2472: if (!grep/^$currclone$/,@$oldcloner) {
2473: ($uname,$udom) = split/:/,$currclone;
2474: if ($uname && $udom) {
2475: unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
2476: my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
2477: if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
2478: if ($currclonecrs{'cloneable'} eq '') {
2479: $currclonecrs{'cloneable'} = $clone_crs;
2480: } else {
2481: $currclonecrs{'cloneable'} .= ','.$clone_crs;
2482: }
2483: &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
2484: }
2485: }
2486: }
2487: }
2488: }
2489: foreach my $oldclone (@$oldcloner) {
2490: if (!grep/^$oldclone$/,@allowclone) {
2491: ($uname,$udom) = split/:/,$oldclone;
2492: if ($uname && $udom) {
2493: unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
2494: my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
2495: my %newclonecrs = ();
2496: if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
2497: if ($currclonecrs{'cloneable'} =~ /,/) {
2498: my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
2499: foreach (@currclonecrs) {
2500: unless ($_ eq $clone_crs) {
2501: $newclonecrs{'cloneable'} .= $_.',';
2502: }
2503: }
2504: $newclonecrs{'cloneable'} =~ s/,$//;
2505: } else {
2506: $newclonecrs{'cloneable'} = '';
2507: }
2508: &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
2509: }
2510: }
2511: }
2512: }
2513: }
2514: }
2515: }
2516:
1.193 albertel 2517:
2518: ##################################################
2519: ##################################################
2520:
2521: =pod
2522:
2523: =item * header
2524:
2525: Output html header for page
2526:
2527: =cut
2528:
2529: ##################################################
2530: ##################################################
2531: sub header {
2532: my $html=&Apache::lonxml::xmlbegin();
2533: my $bodytag=&Apache::loncommon::bodytag('Parameter Manager');
2534: my $title = &mt('LON-CAPA Parameter Manager');
2535: return(<<ENDHEAD);
2536: $html
2537: <head>
2538: <title>$title</title>
2539: </head>
2540: $bodytag
2541: ENDHEAD
2542: }
2543: ##################################################
2544: ##################################################
2545: sub print_main_menu {
2546: my ($r,$parm_permission)=@_;
2547: #
2548: $r->print(<<ENDMAINFORMHEAD);
2549: <form method="post" enctype="multipart/form-data"
2550: action="/adm/parmset" name="studentform">
2551: ENDMAINFORMHEAD
2552: #
1.195 albertel 2553: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2554: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.193 albertel 2555: my @menu =
2556: (
2557: { text => 'Set Course Environment Parameters',
1.204 www 2558: action => 'crsenv',
1.193 albertel 2559: permission => $parm_permission,
2560: },
1.216 www 2561: { text => 'Set/Modify Resource Parameters - Helper Mode',
1.193 albertel 2562: url => '/adm/helper/parameter.helper',
2563: permission => $parm_permission,
2564: },
1.216 www 2565: { text => 'Modify Resource Parameters - Overview Mode',
1.193 albertel 2566: action => 'setoverview',
2567: permission => $parm_permission,
1.208 www 2568: },
1.216 www 2569: { text => 'Set Resource Parameters - Overview Mode',
1.208 www 2570: action => 'newoverview',
2571: permission => $parm_permission,
1.193 albertel 2572: },
1.216 www 2573: { text => 'Set/Modify Resource Parameters - Table Mode',
1.193 albertel 2574: action => 'settable',
2575: permission => $parm_permission,
1.204 www 2576: help => 'Cascading_Parameters',
1.193 albertel 2577: },
1.220 www 2578: { text => 'Set Parameter Setting Default Actions',
2579: action => 'setdefaults',
2580: permission => $parm_permission,
2581: },
1.193 albertel 2582: );
2583: my $menu_html = '';
2584: foreach my $menu_item (@menu) {
2585: next if (! $menu_item->{'permission'});
2586: $menu_html.='<p>';
2587: $menu_html.='<font size="+1">';
2588: if (exists($menu_item->{'url'})) {
2589: $menu_html.=qq{<a href="$menu_item->{'url'}">};
2590: } else {
2591: $menu_html.=
2592: qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
2593: }
2594: $menu_html.= &mt($menu_item->{'text'}).'</a></font>';
2595: if (exists($menu_item->{'help'})) {
2596: $menu_html.=
2597: &Apache::loncommon::help_open_topic($menu_item->{'help'});
2598: }
2599: $menu_html.='</p>'.$/;
2600: }
2601: $r->print($menu_html);
2602: return;
2603: }
2604:
2605:
1.220 www 2606: ##################################################
1.193 albertel 2607:
1.220 www 2608: sub defaultsetter {
2609: my $r=shift;
2610: my $bodytag=&Apache::loncommon::bodytag('Parameter Setting Default Actions');
2611: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2612: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
2613: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Defaults');
2614: my $html=&Apache::lonxml::xmlbegin();
2615: $r->print(<<ENDDEFHEAD);
2616: $html
2617: <head>
2618: <title>LON-CAPA Parameters</title>
2619: </head>
2620: $bodytag
2621: $breadcrumbs
2622: <form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">
2623: ENDDEFHEAD
1.221 www 2624: my @ids=();
2625: my %typep=();
2626: my %keyp=();
2627: my %allparms=();
2628: my %allparts=();
2629: my %allmaps=();
2630: my %mapp=();
2631: my %symbp=();
2632: my %maptitles=();
2633: my %uris=();
2634: my %keyorder=&standardkeyorder();
2635: my %defkeytype=();
2636:
2637: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
2638: \%mapp, \%symbp,\%maptitles,\%uris,
2639: \%keyorder,\%defkeytype);
1.224 www 2640: if ($env{'form.storerules'}) {
2641: my %newrules=();
2642: my @delrules=();
1.226 www 2643: my %triggers=();
1.225 albertel 2644: foreach my $key (keys(%env)) {
2645: if ($key=~/^form\.(\w+)\_action$/) {
1.224 www 2646: my $tempkey=$1;
1.226 www 2647: my $action=$env{$key};
2648: if ($action) {
2649: $newrules{$tempkey.'_action'}=$action;
2650: if ($action ne 'default') {
2651: my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
2652: $triggers{$whichparm}.=$tempkey.':';
2653: }
2654: $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
1.224 www 2655: if (&isdateparm($defkeytype{$tempkey})) {
1.227 www 2656: $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
1.224 www 2657: $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
2658: $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
2659: $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
2660: } else {
2661: $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
1.227 www 2662: $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
1.224 www 2663: }
2664: } else {
1.225 albertel 2665: push(@delrules,$tempkey.'_action');
1.226 www 2666: push(@delrules,$tempkey.'_type');
1.225 albertel 2667: push(@delrules,$tempkey.'_hours');
2668: push(@delrules,$tempkey.'_min');
2669: push(@delrules,$tempkey.'_sec');
2670: push(@delrules,$tempkey.'_value');
1.224 www 2671: }
2672: }
2673: }
1.226 www 2674: foreach my $key (keys %allparms) {
2675: $newrules{$key.'_triggers'}=$triggers{$key};
2676: }
1.224 www 2677: &Apache::lonnet::put('parmdefactions',\%newrules,$dom,$crs);
2678: &Apache::lonnet::del('parmdefactions',\@delrules,$dom,$crs);
2679: &resetrulescache();
2680: }
1.227 www 2681: my %lt=&Apache::lonlocal::texthash('days' => 'Days',
2682: 'hours' => 'Hours',
1.221 www 2683: 'min' => 'Minutes',
2684: 'sec' => 'Seconds',
2685: 'yes' => 'Yes',
2686: 'no' => 'No');
1.222 www 2687: my @standardoptions=('','default');
2688: my @standarddisplay=('',&mt('Default value when manually setting'));
2689: my @dateoptions=('','default');
2690: my @datedisplay=('',&mt('Default value when manually setting'));
2691: foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
2692: unless ($tempkey) { next; }
2693: push @standardoptions,'when_setting_'.$tempkey;
2694: push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
2695: if (&isdateparm($defkeytype{$tempkey})) {
2696: push @dateoptions,'later_than_'.$tempkey;
2697: push @datedisplay,&mt('Automatically set later than ').$tempkey;
2698: push @dateoptions,'earlier_than_'.$tempkey;
2699: push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
2700: }
2701: }
1.221 www 2702: $r->print("\n<table border='1'><tr><th>".&mt('Rule for parameter').'</th><th>'.
1.222 www 2703: &mt('Action').'</th><th>'.&mt('Value').'</th></tr>');
1.221 www 2704: foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.222 www 2705: unless ($tempkey) { next; }
1.221 www 2706: $r->print("\n<tr><td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
1.222 www 2707: my $action=&rulescache($tempkey.'_action');
2708: $r->print('<select name="'.$tempkey.'_action">');
2709: if (&isdateparm($defkeytype{$tempkey})) {
2710: for (my $i=0;$i<=$#dateoptions;$i++) {
2711: if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
2712: $r->print("\n<option value='$dateoptions[$i]'".
2713: ($dateoptions[$i] eq $action?' selected="selected"':'').
2714: ">$datedisplay[$i]</option>");
2715: }
2716: } else {
2717: for (my $i=0;$i<=$#standardoptions;$i++) {
2718: if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
2719: $r->print("\n<option value='$standardoptions[$i]'".
2720: ($standardoptions[$i] eq $action?' selected="selected"':'').
2721: ">$standarddisplay[$i]</option>");
2722: }
2723: }
2724: $r->print('</select>');
1.227 www 2725: unless (&isdateparm($defkeytype{$tempkey})) {
2726: $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
2727: '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
2728: }
1.222 www 2729: $r->print("\n</td><td>\n");
2730:
1.221 www 2731: if (&isdateparm($defkeytype{$tempkey})) {
1.227 www 2732: my $days=&rulescache($tempkey.'_days');
1.222 www 2733: my $hours=&rulescache($tempkey.'_hours');
2734: my $min=&rulescache($tempkey.'_min');
2735: my $sec=&rulescache($tempkey.'_sec');
1.221 www 2736: $r->print(<<ENDINPUTDATE);
1.227 www 2737: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
1.222 www 2738: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
2739: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
2740: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.221 www 2741: ENDINPUTDATE
2742: } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
1.222 www 2743: my $yeschecked='';
2744: my $nochecked='';
2745: if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked='checked="checked"'; }
2746: if (&rulescache($tempkey.'_value') eq 'no') { $nochecked='checked="checked"'; }
2747:
1.221 www 2748: $r->print(<<ENDYESNO);
1.224 www 2749: <label><input type="radio" name="$tempkey\_value" value="yes" $yeschecked /> $lt{'yes'}</label><br />
2750: <label><input type="radio" name="$tempkey\_value" value="no" $nochecked /> $lt{'no'}</label>
1.221 www 2751: ENDYESNO
2752: } else {
1.224 www 2753: $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
1.221 www 2754: }
2755: $r->print('</td></tr>');
2756: }
1.224 www 2757: $r->print("</table>\n<input type='submit' name='storerules' value='".
2758: &mt('Store Rules')."' /></form>\n</body>\n</html>");
1.220 www 2759: return;
2760: }
1.193 albertel 2761:
1.178 raeburn 2762: ##################################################
2763: ##################################################
1.30 www 2764:
1.59 matthew 2765: =pod
2766:
1.83 bowersj2 2767: =item * handler
1.59 matthew 2768:
2769: Main handler. Calls &assessparms and &crsenv subroutines.
2770:
2771: =cut
2772: ##################################################
2773: ##################################################
1.220 www 2774: # use Data::Dumper;
2775:
1.30 www 2776: sub handler {
1.43 albertel 2777: my $r=shift;
1.30 www 2778:
1.43 albertel 2779: if ($r->header_only) {
1.126 www 2780: &Apache::loncommon::content_type($r,'text/html');
1.43 albertel 2781: $r->send_http_header;
2782: return OK;
2783: }
1.193 albertel 2784: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.205 www 2785: ['action','state',
2786: 'pres_marker',
2787: 'pres_value',
1.206 www 2788: 'pres_type',
1.215 www 2789: 'udom','uname','symb']);
1.131 www 2790:
1.83 bowersj2 2791:
1.193 albertel 2792: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194 albertel 2793: &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
2794: text=>"Parameter Manager",
1.204 www 2795: faq=>10,
1.194 albertel 2796: bug=>'Instructor Interface'});
1.203 www 2797:
1.30 www 2798: # ----------------------------------------------------- Needs to be in a course
1.194 albertel 2799: my $parm_permission =
2800: (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190 albertel 2801: &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193 albertel 2802: $env{'request.course.sec'}));
1.194 albertel 2803: if ($env{'request.course.id'} && $parm_permission) {
1.193 albertel 2804:
2805: # Start Page
1.126 www 2806: &Apache::loncommon::content_type($r,'text/html');
1.106 www 2807: $r->send_http_header;
1.30 www 2808:
1.203 www 2809:
2810: # id numbers can change on re-ordering of folders
2811:
2812: &resetsymbcache();
2813:
1.193 albertel 2814: #
2815: # Main switch on form.action and form.state, as appropriate
2816: #
2817: # Check first if coming from someone else headed directly for
2818: # the table mode
2819: if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
2820: && (!$env{'form.dis'})) || ($env{'form.symb'})) {
2821: &assessparms($r);
2822:
2823: } elsif (! exists($env{'form.action'})) {
2824: $r->print(&header());
1.194 albertel 2825: $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
2826: 'Parameter Manager'));
1.193 albertel 2827: &print_main_menu($r,$parm_permission);
2828: } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) {
1.194 albertel 2829: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv',
2830: text=>"Course Environment"});
1.193 albertel 2831: &crsenv($r);
2832: } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194 albertel 2833: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
2834: text=>"Overview Mode"});
1.121 www 2835: &overview($r);
1.208 www 2836: } elsif ($env{'form.action'} eq 'newoverview' && $parm_permission) {
2837: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
2838: text=>"Overview Mode"});
2839: &newoverview($r);
1.220 www 2840: } elsif ($env{'form.action'} eq 'setdefaults' && $parm_permission) {
2841: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
2842: text=>"Set Defaults"});
2843: &defaultsetter($r);
2844: } elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194 albertel 2845: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.204 www 2846: text=>"Table Mode",
2847: help => 'Course_Setting_Parameters'});
1.121 www 2848: &assessparms($r);
1.193 albertel 2849: }
2850:
1.43 albertel 2851: } else {
1.1 www 2852: # ----------------------------- Not in a course, or not allowed to modify parms
1.190 albertel 2853: $env{'user.error.msg'}=
1.43 albertel 2854: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
2855: return HTTP_NOT_ACCEPTABLE;
2856: }
2857: return OK;
1.1 www 2858: }
2859:
2860: 1;
2861: __END__
2862:
1.59 matthew 2863: =pod
1.38 harris41 2864:
2865: =back
2866:
2867: =cut
1.1 www 2868:
2869:
2870:
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