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