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