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