Annotation of loncom/interface/lonparmset.pm, revision 1.202
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
1.202 ! www 4: # $Id: lonparmset.pm,v 1.201 2005/06/02 19:17:12 www Exp $
1.40 albertel 5: #
6: # Copyright Michigan State University Board of Trustees
7: #
8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
9: #
10: # LON-CAPA is free software; you can redistribute it and/or modify
11: # it under the terms of the GNU General Public License as published by
12: # the Free Software Foundation; either version 2 of the License, or
13: # (at your option) any later version.
14: #
15: # LON-CAPA is distributed in the hope that it will be useful,
16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18: # GNU General Public License for more details.
19: #
20: # You should have received a copy of the GNU General Public License
21: # along with LON-CAPA; if not, write to the Free Software
22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
23: #
24: # /home/httpd/html/adm/gpl.txt
25: #
26: # http://www.lon-capa.org/
27: #
1.59 matthew 28: ###################################################################
29: ###################################################################
30:
31: =pod
32:
33: =head1 NAME
34:
35: lonparmset - Handler to set parameters for assessments and course
36:
37: =head1 SYNOPSIS
38:
39: lonparmset provides an interface to setting course parameters.
40:
41: =head1 DESCRIPTION
42:
43: This module sets coursewide and assessment parameters.
44:
45: =head1 INTERNAL SUBROUTINES
46:
47: =over 4
48:
49: =cut
50:
51: ###################################################################
52: ###################################################################
1.1 www 53:
54: package Apache::lonparmset;
55:
56: use strict;
57: use Apache::lonnet;
58: use Apache::Constants qw(:common :http REDIRECT);
1.88 matthew 59: use Apache::lonhtmlcommon();
1.36 albertel 60: use Apache::loncommon;
1.1 www 61: use GDBM_File;
1.57 albertel 62: use Apache::lonhomework;
63: use Apache::lonxml;
1.130 www 64: use Apache::lonlocal;
1.197 www 65: use Apache::lonnavmaps;
1.1 www 66:
1.198 www 67: # --- Caches local to lonparmset
1.2 www 68:
1.199 www 69: my $parmhashid;
70: my %parmhash;
1.201 www 71: my $symbsid;
72: my %symbs;
1.198 www 73:
74: # --- end local caches
75:
1.59 matthew 76: ##################################################
77: ##################################################
78:
79: =pod
80:
81: =item parmval
82:
83: Figure out a cascading parameter.
84:
1.71 albertel 85: Inputs: $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162 albertel 86: $id - a bighash Id number
1.71 albertel 87: $def - the resource's default value 'stupid emacs
88:
89: 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
90:
1.182 albertel 91: 11 - General Course
92: 10 - Map or Folder level in course
93: 9- resource default
94: 8- map default
1.71 albertel 95: 7 - resource level in course
96: 6 - General for section
1.82 www 97: 5 - Map or Folder level for section
1.71 albertel 98: 4 - resource level in section
99: 3 - General for specific student
1.82 www 100: 2 - Map or Folder level for specific student
1.71 albertel 101: 1 - resource level for specific student
1.2 www 102:
1.59 matthew 103: =cut
104:
105: ##################################################
1.2 www 106: sub parmval {
1.187 www 107: my ($what,$id,$def,$uname,$udom,$csec)=@_;
1.201 www 108: return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec);
109: }
110:
111: sub parmval_by_symb {
112: my ($what,$symb,$def,$uname,$udom,$csec)=@_;
1.198 www 113: # load caches
1.200 www 114:
1.198 www 115: &cacheparmhash();
1.200 www 116:
117: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
118: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
119: my $useropt=&Apache::lonnet::get_userresdata($uname,$udom);
120: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
121:
1.198 www 122:
1.8 www 123: my $result='';
1.44 albertel 124: my @outpar=();
1.2 www 125: # ----------------------------------------------------- Cascading lookup scheme
1.201 www 126: my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.10 www 127:
1.201 www 128: my $symbparm=$symb.'.'.$what;
129: my $mapparm=$map.'___(all).'.$what;
1.10 www 130:
1.190 albertel 131: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
132: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
133: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
134:
135: my $courselevel=$env{'request.course.id'}.'.'.$what;
136: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
137: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2 www 138:
1.11 www 139:
140:
1.182 albertel 141: # --------------------------------------------------------- first, check course
1.11 www 142:
1.200 www 143: if (defined($$courseopt{$courselevel})) {
144: $outpar[11]=$$courseopt{$courselevel};
1.182 albertel 145: $result=11;
1.43 albertel 146: }
1.11 www 147:
1.200 www 148: if (defined($$courseopt{$courselevelm})) {
149: $outpar[10]=$$courseopt{$courselevelm};
1.182 albertel 150: $result=10;
1.43 albertel 151: }
1.11 www 152:
1.182 albertel 153: # ------------------------------------------------------- second, check default
154:
155: if (defined($def)) { $outpar[9]=$def; $result=9; }
156:
157: # ------------------------------------------------------ third, check map parms
158:
159: my $thisparm=$parmhash{$symbparm};
160: if (defined($thisparm)) { $outpar[8]=$thisparm; $result=8; }
161:
1.200 www 162: if (defined($$courseopt{$courselevelr})) {
163: $outpar[7]=$$courseopt{$courselevelr};
1.43 albertel 164: $result=7;
165: }
1.11 www 166:
1.182 albertel 167: # ------------------------------------------------------ fourth, back to course
1.71 albertel 168: if (defined($csec)) {
1.200 www 169: if (defined($$courseopt{$seclevel})) {
170: $outpar[6]=$$courseopt{$seclevel};
1.43 albertel 171: $result=6;
172: }
1.200 www 173: if (defined($$courseopt{$seclevelm})) {
174: $outpar[5]=$$courseopt{$seclevelm};
1.43 albertel 175: $result=5;
176: }
177:
1.200 www 178: if (defined($$courseopt{$seclevelr})) {
1.201 www 179: $outpar[4]=$$courseopt{$seclevelr};
1.43 albertel 180: $result=4;
181: }
182: }
1.11 www 183:
1.182 albertel 184: # ---------------------------------------------------------- fifth, check user
1.11 www 185:
1.71 albertel 186: if (defined($uname)) {
1.200 www 187: if (defined($$useropt{$courselevel})) {
188: $outpar[3]=$$useropt{$courselevel};
1.43 albertel 189: $result=3;
190: }
1.10 www 191:
1.200 www 192: if (defined($$useropt{$courselevelm})) {
193: $outpar[2]=$$useropt{$courselevelm};
1.43 albertel 194: $result=2;
195: }
1.2 www 196:
1.200 www 197: if (defined($$useropt{$courselevelr})) {
198: $outpar[1]=$$useropt{$courselevelr};
1.43 albertel 199: $result=1;
200: }
201: }
1.44 albertel 202: return ($result,@outpar);
1.2 www 203: }
204:
1.198 www 205: sub resetparmhash {
206: $parmhashid='';
207: }
208:
209: sub cacheparmhash {
210: if ($parmhashid eq $env{'request.course.fn'}) { return; }
211: my %parmhashfile;
212: if (tie(%parmhashfile,'GDBM_File',
213: $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
214: %parmhash=%parmhashfile;
215: untie %parmhashfile;
216: $parmhashid=$env{'request.course.fn'};
217: }
218: }
219:
1.201 www 220: sub symbcache {
221: my $id=shift;
222: if ($symbsid ne $env{'request.course.id'}) {
223: %symbs=();
224: }
225: unless ($symbs{$id}) {
226: my $navmap = Apache::lonnavmaps::navmap->new();
227: if ($id=~/\./) {
228: my $resource=$navmap->getById($id);
229: $symbs{$id}=$resource->symb();
230: } else {
231: my $resource=$navmap->getByMapPc($id);
232: $symbs{$id}=&Apache::lonnet::declutter($resource->src());
233: }
234: $symbsid=$env{'request.course.id'};
235: }
236: return $symbs{$id};
237: }
238:
1.186 www 239: ##################################################
240: ##################################################
241: #
1.197 www 242: # Store a parameter by ID
1.186 www 243: #
244: # Takes
245: # - resource id
246: # - name of parameter
247: # - level
248: # - new value
249: # - new type
1.187 www 250: # - username
251: # - userdomain
252:
1.186 www 253: sub storeparm {
1.187 www 254: my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
1.201 www 255: &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec);
1.197 www 256: }
257:
258: #
259: # Store a parameter by symb
260: #
261: # Takes
262: # - symb
263: # - name of parameter
264: # - level
265: # - new value
266: # - new type
267: # - username
268: # - userdomain
269:
270: sub storeparm_by_symb {
271: # ---------------------------------------------------------- Get symb, map, etc
272: my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec)=@_;
273: # ---------------------------------------------------------- Construct prefixes
1.186 www 274: $spnam=~s/\_([^\_]+)$/\.$1/;
1.197 www 275: my $map=(&Apache::lonnet::decode_symb($symb))[0];
276: my $symbparm=$symb.'.'.$spnam;
277: my $mapparm=$map.'___(all).'.$spnam;
278:
1.190 albertel 279: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
280: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
281: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.186 www 282:
1.190 albertel 283: my $courselevel=$env{'request.course.id'}.'.'.$spnam;
284: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
285: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.186 www 286:
287: my $storeunder='';
288: if (($snum==11) || ($snum==3)) { $storeunder=$courselevel; }
289: if (($snum==10) || ($snum==2)) { $storeunder=$courselevelm; }
290: if (($snum==7) || ($snum==1)) { $storeunder=$courselevelr; }
291: if ($snum==6) { $storeunder=$seclevel; }
292: if ($snum==5) { $storeunder=$seclevelm; }
293: if ($snum==4) { $storeunder=$seclevelr; }
294:
295: my $delete;
296: if ($nval eq '') { $delete=1;}
297: my %storecontent = ($storeunder => $nval,
298: $storeunder.'.type' => $ntype);
299: my $reply='';
300: if ($snum>3) {
301: # ---------------------------------------------------------------- Store Course
302: #
1.200 www 303: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
304: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.186 www 305: # Expire sheets
306: &Apache::lonnet::expirespread('','','studentcalc');
307: if (($snum==7) || ($snum==4)) {
1.197 www 308: &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.186 www 309: } elsif (($snum==8) || ($snum==5)) {
1.197 www 310: &Apache::lonnet::expirespread('','','assesscalc',$map);
1.186 www 311: } else {
312: &Apache::lonnet::expirespread('','','assesscalc');
313: }
314: # Store parameter
315: if ($delete) {
316: $reply=&Apache::lonnet::del
1.200 www 317: ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
1.186 www 318: } else {
319: $reply=&Apache::lonnet::cput
1.200 www 320: ('resourcedata',\%storecontent,$cdom,$cnum);
1.186 www 321: }
1.200 www 322: &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186 www 323: } else {
324: # ------------------------------------------------------------------ Store User
325: #
326: # Expire sheets
327: &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
328: if ($snum==1) {
329: &Apache::lonnet::expirespread
1.197 www 330: ($uname,$udom,'assesscalc',$symb);
1.186 www 331: } elsif ($snum==2) {
332: &Apache::lonnet::expirespread
1.197 www 333: ($uname,$udom,'assesscalc',$map);
1.186 www 334: } else {
335: &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
336: }
337: # Store parameter
338: if ($delete) {
339: $reply=&Apache::lonnet::del
340: ('resourcedata',[keys(%storecontent)],$udom,$uname);
341: } else {
342: $reply=&Apache::lonnet::cput
343: ('resourcedata',\%storecontent,$udom,$uname);
344: }
1.191 albertel 345: &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186 www 346: }
347:
348: if ($reply=~/^error\:(.*)/) {
349: return "<font color=red>Write Error: $1</font>";
350: }
351: return '';
352: }
353:
1.59 matthew 354: ##################################################
355: ##################################################
356:
357: =pod
358:
359: =item valout
360:
361: Format a value for output.
362:
363: Inputs: $value, $type
364:
365: Returns: $value, formatted for output. If $type indicates it is a date,
366: localtime($value) is returned.
1.9 www 367:
1.59 matthew 368: =cut
369:
370: ##################################################
371: ##################################################
1.9 www 372: sub valout {
373: my ($value,$type)=@_;
1.59 matthew 374: my $result = '';
375: # Values of zero are valid.
376: if (! $value && $value ne '0') {
1.71 albertel 377: $result = ' ';
1.59 matthew 378: } else {
1.66 www 379: if ($type eq 'date_interval') {
380: my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($value);
381: $year=$year-70;
382: $mday--;
383: if ($year) {
384: $result.=$year.' yrs ';
385: }
386: if ($mon) {
387: $result.=$mon.' mths ';
388: }
389: if ($mday) {
390: $result.=$mday.' days ';
391: }
392: if ($hour) {
393: $result.=$hour.' hrs ';
394: }
395: if ($min) {
396: $result.=$min.' mins ';
397: }
398: if ($sec) {
399: $result.=$sec.' secs ';
400: }
401: $result=~s/\s+$//;
402: } elsif ($type=~/^date/) {
1.59 matthew 403: $result = localtime($value);
404: } else {
405: $result = $value;
406: }
407: }
408: return $result;
1.9 www 409: }
410:
1.59 matthew 411: ##################################################
412: ##################################################
413:
414: =pod
1.5 www 415:
1.59 matthew 416: =item plink
417:
418: Produces a link anchor.
419:
420: Inputs: $type,$dis,$value,$marker,$return,$call
421:
422: Returns: scalar with html code for a link which will envoke the
423: javascript function 'pjump'.
424:
425: =cut
426:
427: ##################################################
428: ##################################################
1.5 www 429: sub plink {
430: my ($type,$dis,$value,$marker,$return,$call)=@_;
1.23 www 431: my $winvalue=$value;
432: unless ($winvalue) {
433: if ($type=~/^date/) {
1.190 albertel 434: $winvalue=$env{'form.recent_'.$type};
1.23 www 435: } else {
1.190 albertel 436: $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23 www 437: }
438: }
439: return
1.43 albertel 440: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
441: .$marker."','".$return."','".$call."'".');">'.
442: &valout($value,$type).'</a><a name="'.$marker.'"></a>';
1.5 www 443: }
444:
1.44 albertel 445: sub startpage {
1.202 ! www 446: my ($r,$id,$udom,$csec,$uname,$have_assessments)=@_;
1.99 albertel 447:
1.120 www 448: my $bodytag=&Apache::loncommon::bodytag('Set/Modify Course Parameters','',
1.98 www 449: 'onUnload="pclose()"');
1.194 albertel 450: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Table');
1.81 www 451: my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
452: &Apache::loncommon::selectstudent_link('parmform','uname','udom');
453: my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88 matthew 454: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.133 www 455: my %lt=&Apache::lonlocal::texthash(
456: 'captm' => "Course Assessments Parameters - Table Mode",
457: 'sg' => "Section/Group",
458: 'fu' => "For User",
459: 'oi' => "or ID",
460: 'ad' => "at Domain"
461: );
1.148 www 462: my $overallhelp=
1.166 albertel 463: &Apache::loncommon::help_open_menu('','Setting Parameters','Course_Setting_Parameters','',10,'Instructor Interface');
1.146 www 464: my $assessparmhelp=&Apache::loncommon::help_open_topic("Cascading_Parameters","Assessment Parameters");
1.183 albertel 465: my $html=&Apache::lonxml::xmlbegin();
1.44 albertel 466: $r->print(<<ENDHEAD);
1.183 albertel 467: $html
1.44 albertel 468: <head>
469: <title>LON-CAPA Course Parameters</title>
470: <script>
471:
472: function pclose() {
473: parmwin=window.open("/adm/rat/empty.html","LONCAPAparms",
474: "height=350,width=350,scrollbars=no,menubar=no");
475: parmwin.close();
476: }
477:
1.88 matthew 478: $pjump_def
1.44 albertel 479:
480: function psub() {
481: pclose();
482: if (document.parmform.pres_marker.value!='') {
483: document.parmform.action+='#'+document.parmform.pres_marker.value;
484: var typedef=new Array();
485: typedef=document.parmform.pres_type.value.split('_');
486: if (document.parmform.pres_type.value!='') {
487: if (typedef[0]=='date') {
488: eval('document.parmform.recent_'+
489: document.parmform.pres_type.value+
490: '.value=document.parmform.pres_value.value;');
491: } else {
492: eval('document.parmform.recent_'+typedef[0]+
493: '.value=document.parmform.pres_value.value;');
494: }
495: }
496: document.parmform.submit();
497: } else {
498: document.parmform.pres_value.value='';
499: document.parmform.pres_marker.value='';
500: }
501: }
502:
1.57 albertel 503: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
504: var options = "width=" + w + ",height=" + h + ",";
505: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
506: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
507: var newWin = window.open(url, wdwName, options);
508: newWin.focus();
509: }
1.44 albertel 510: </script>
1.81 www 511: $selscript
1.44 albertel 512: </head>
1.64 www 513: $bodytag
1.193 albertel 514: $breadcrumbs
1.166 albertel 515: $overallhelp
1.137 albertel 516: ENDHEAD
1.189 www 517: my %sectionhash=();
518: my $sections='';
519: if (&Apache::loncommon::get_sections(
1.190 albertel 520: $env{'course.'.$env{'request.course.id'}.'.domain'},
521: $env{'course.'.$env{'request.course.id'}.'.num'},
1.189 www 522: \%sectionhash)) {
523: $sections=$lt{'sg'}.': <select name="csec">';
524: foreach ('',sort keys %sectionhash) {
525: $sections.='<option value="'.$_.'"'.
526: ($_ eq $csec?'selected="selected"':'').'>'.$_.'</option>';
527: }
528: $sections.='</select>';
529: }
530: $r->print(<<ENDHEAD3);
1.193 albertel 531: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.133 www 532: <h4>$lt{'captm'}</h4>
1.137 albertel 533: ENDHEAD3
1.99 albertel 534:
1.202 ! www 535: if (!$have_assessments) {
! 536: $r->print('<font color="red">'.&mt('There are no assessment parameters in this course to set.').'</font><br />');
1.99 albertel 537: } else {
538: $r->print(<<ENDHEAD);
1.44 albertel 539: <b>
1.189 www 540: $sections
1.188 www 541: <br />
1.133 www 542: $lt{'fu'}
1.188 www 543: <input type="text" value="$uname" size="12" name="uname" />
1.133 www 544: $lt{'oi'}
1.188 www 545: <input type="text" value="$id" size="12" name="id" />
1.133 www 546: $lt{'ad'}
1.81 www 547: $chooseopt
1.44 albertel 548: </b>
549: <input type="hidden" value='' name="pres_value">
550: <input type="hidden" value='' name="pres_type">
551: <input type="hidden" value='' name="pres_marker">
552: ENDHEAD
1.99 albertel 553: }
1.44 albertel 554: }
555:
556: sub print_row {
1.201 www 557: my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.187 www 558: $defbgtwo,$parmlev,$uname,$udom,$csec)=@_;
1.66 www 559: # get the values for the parameter in cascading order
560: # empty levels will remain empty
1.44 albertel 561: my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.187 www 562: $rid,$$default{$which},$uname,$udom,$csec);
1.66 www 563: # get the type for the parameters
564: # problem: these may not be set for all levels
565: my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
566: $$name{$which}.'.type',
1.187 www 567: $rid,$$defaulttype{$which},$uname,$udom,$csec);
1.66 www 568: # cascade down manually
1.182 albertel 569: my $cascadetype=$$defaulttype{$which};
570: for (my $i=11;$i>0;$i--) {
1.66 www 571: if ($typeoutpar[$i]) {
572: $cascadetype=$typeoutpar[$i];
573: } else {
574: $typeoutpar[$i]=$cascadetype;
575: }
576: }
1.57 albertel 577: my $parm=$$display{$which};
578:
579: if ($parmlev eq 'full' || $parmlev eq 'brief') {
580: $r->print('<td bgcolor='.$defbgtwo.' align="center">'
581: .$$part{$which}.'</td>');
582: } else {
583: $parm=~s|\[.*\]\s||g;
584: }
585:
1.159 albertel 586: $r->print('<td bgcolor='.$defbgone.'>'.$parm.'</td>');
1.57 albertel 587:
1.44 albertel 588: my $thismarker=$which;
589: $thismarker=~s/^parameter\_//;
590: my $mprefix=$rid.'&'.$thismarker.'&';
591:
1.57 albertel 592: if ($parmlev eq 'general') {
593:
594: if ($uname) {
1.66 www 595: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 596: } elsif ($csec) {
1.66 www 597: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 598: } else {
1.182 albertel 599: &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 600: }
601: } elsif ($parmlev eq 'map') {
602:
603: if ($uname) {
1.66 www 604: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 605: } elsif ($csec) {
1.66 www 606: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 607: } else {
1.182 albertel 608: &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 609: }
610: } else {
611:
1.182 albertel 612: &print_td($r,11,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 613:
614: if ($parmlev eq 'brief') {
615:
1.66 www 616: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 617:
618: if ($csec) {
1.66 www 619: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 620: }
621: if ($uname) {
1.66 www 622: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 623: }
624: } else {
625:
1.182 albertel 626: &print_td($r,10,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
627: &print_td($r,9,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
628: &print_td($r,8,'#FFDDDD',$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.66 www 629: &print_td($r,7,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 630:
631: if ($csec) {
1.66 www 632: &print_td($r,6,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
633: &print_td($r,5,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
634: &print_td($r,4,$defbgtwo,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 635: }
636: if ($uname) {
1.66 www 637: &print_td($r,3,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
638: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
639: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$_,\@typeoutpar,$display);
1.57 albertel 640: }
641: } # end of $brief if/else
642: } # end of $parmlev if/else
643:
1.136 albertel 644: $r->print('<td bgcolor=#CCCCFF align="center">'.
645: &valout($outpar[$result],$typeoutpar[$result]).'</td>');
646:
1.57 albertel 647: if ($parmlev eq 'full' || $parmlev eq 'brief') {
1.136 albertel 648: my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201 www 649: '.'.$$name{$which},$$symbp{$rid});
1.136 albertel 650:
1.70 albertel 651: # this doesn't seem to work, and I don't think is correct
652: # my $sessionvaltype=&Apache::lonnet::EXT('resource.'.$$part{$which}.
653: # '.'.$$name{$which}.'.type',$symbp{$rid});
654: # this seems to work
1.136 albertel 655: my $sessionvaltype=$typeoutpar[$result];
656: if (!defined($sessionvaltype)) { $sessionvaltype=$$defaulttype{$which}; }
657: $r->print('<td bgcolor=#999999 align="center"><font color=#FFFFFF>'.
1.66 www 658: &valout($sessionval,$sessionvaltype).' '.
1.57 albertel 659: '</font></td>');
1.136 albertel 660: }
1.44 albertel 661: $r->print('</tr>');
1.57 albertel 662: $r->print("\n");
1.44 albertel 663: }
1.59 matthew 664:
1.44 albertel 665: sub print_td {
1.66 www 666: my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display)=@_;
1.57 albertel 667: $r->print('<td bgcolor='.(($result==$which)?'"#AAFFAA"':$defbg).
1.114 www 668: ' align="center">');
1.182 albertel 669: if ($which<8 || $which > 9) {
1.114 www 670: $r->print(&plink($$typeoutpar[$which],
671: $$display{$value},$$outpar[$which],
672: $mprefix."$which",'parmform.pres','psub'));
673: } else {
674: $r->print(&valout($$outpar[$which],$$typeoutpar[$which]));
675: }
676: $r->print('</td>'."\n");
1.57 albertel 677: }
678:
1.201 www 679:
1.63 bowersj2 680: =pod
681:
682: =item B<extractResourceInformation>: Given the course data hash, extractResourceInformation extracts lots of information about the course's resources into a variety of hashes.
683:
684: Input: See list below:
685:
686: =over 4
687:
688: =item B<ids>: An array that will contain all of the ids in the course.
689:
690: =item B<typep>: hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
691:
1.171 www 692: =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 693:
694: =item B<allparms>: hash, name of parameter->display value (what is the display value?)
695:
696: =item B<allparts>: hash, part identification->text representation of part, where the text representation is "[Part $part]"
697:
698: =item B<allkeys>: hash, full key to part->display value (what's display value?)
699:
700: =item B<allmaps>: hash, ???
701:
702: =item B<fcat>: ???
703:
704: =item B<defp>: hash, ???
705:
706: =item B<mapp>: ??
707:
708: =item B<symbp>: hash, id->full sym?
709:
710: =back
711:
712: =cut
713:
714: sub extractResourceInformation {
715: my $ids = shift;
716: my $typep = shift;
717: my $keyp = shift;
718: my $allparms = shift;
719: my $allparts = shift;
720: my $allkeys = shift;
721: my $allmaps = shift;
722: my $fcat = shift;
723: my $defp = shift;
724: my $mapp = shift;
725: my $symbp = shift;
1.82 www 726: my $maptitles=shift;
1.196 www 727: my $uris=shift;
728:
1.63 bowersj2 729:
1.196 www 730: my $navmap = Apache::lonnavmaps::navmap->new();
731: my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
732: foreach my $resource (@allres) {
733: my $id=$resource->id();
734: my ($mapid,$resid)=split(/\./,$id);
735: if ($mapid eq '0') { next; }
736: $$ids[$#$ids+1]=$id;
737: my $srcf=$resource->src();
738: $srcf=~/\.(\w+)$/;
739: $$typep{$id}=$1;
740: $$keyp{$id}='';
741: $$uris{$id}=$srcf;
742: foreach (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
743: if ($_=~/^parameter\_(.*)/) {
744: my $key=$_;
745: my $allkey=$1;
746: $allkey=~s/\_/\./g;
747: if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq
748: 'parm') {
749: next; #hide hidden things
1.63 bowersj2 750: }
1.196 www 751: my $display= &Apache::lonnet::metadata($srcf,$key.'.display');
752: my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
753: my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
754: my $parmdis = $display;
755: $parmdis =~ s|(\[Part.*)$||g;
756: my $partkey = $part;
757: $partkey =~ tr|_|.|;
758: $$allparms{$name} = $parmdis;
759: $$allparts{$part} = "[Part $part]";
760: $$allkeys{$allkey}=$display;
761: if ($allkey eq $fcat) {
762: $$defp{$id}= &Apache::lonnet::metadata($srcf,$key);
763: }
764: if ($$keyp{$id}) {
765: $$keyp{$id}.=','.$key;
1.175 albertel 766: } else {
1.196 www 767: $$keyp{$id}=$key;
1.175 albertel 768: }
1.63 bowersj2 769: }
770: }
1.196 www 771: $$mapp{$id}=
772: &Apache::lonnet::declutter($resource->enclosing_map_src());
773: $$mapp{$mapid}=$$mapp{$id};
774: $$allmaps{$mapid}=$$mapp{$id};
775: if ($mapid eq '1') {
776: $$maptitles{$mapid}='Main Course Documents';
777: } else {
778: $$maptitles{$mapid}=&Apache::lonnet::gettitle(&Apache::lonnet::clutter($$mapp{$id}));
779: }
780: $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
781: $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
782: $$symbp{$mapid}=$$mapp{$id}.'___(all)';
1.63 bowersj2 783: }
784: }
785:
1.59 matthew 786: ##################################################
787: ##################################################
788:
789: =pod
790:
791: =item assessparms
792:
793: Show assessment data and parameters. This is a large routine that should
794: be simplified and shortened... someday.
795:
796: Inputs: $r
797:
798: Returns: nothing
799:
1.63 bowersj2 800: Variables used (guessed by Jeremy):
801:
802: =over 4
803:
804: =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.
805:
806: =item B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
807:
808: =item B<allmaps>:
809:
810: =back
811:
1.59 matthew 812: =cut
813:
814: ##################################################
815: ##################################################
1.30 www 816: sub assessparms {
1.1 www 817:
1.43 albertel 818: my $r=shift;
1.201 www 819:
820: my @ids=();
821: my %symbp=();
822: my %mapp=();
823: my %typep=();
824: my %keyp=();
825: my %uris=();
826: my %maptitles=();
827:
1.2 www 828: # -------------------------------------------------------- Variable declaration
1.129 www 829: my %allkeys=();
830: my %allmaps=();
831: my %alllevs=();
1.57 albertel 832:
1.187 www 833: my $uname;
834: my $udom;
835: my $uhome;
836: my $csec;
837:
1.190 albertel 838: my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187 www 839:
1.57 albertel 840: $alllevs{'Resource Level'}='full';
841: $alllevs{'Map Level'}='map';
842: $alllevs{'Course Level'}='general';
843:
844: my %allparms;
845: my %allparts;
846:
1.43 albertel 847: my %defp;
848:
849: @ids=();
850: %symbp=();
851: %typep=();
852:
853: my $message='';
854:
1.190 albertel 855: $csec=$env{'form.csec'};
1.188 www 856:
1.190 albertel 857: if ($udom=$env{'form.udom'}) {
858: } elsif ($udom=$env{'request.role.domain'}) {
859: } elsif ($udom=$env{'user.domain'}) {
1.172 albertel 860: } else {
861: $udom=$r->dir_config('lonDefDomain');
862: }
1.43 albertel 863:
1.134 albertel 864: my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190 albertel 865: my $pschp=$env{'form.pschp'};
1.134 albertel 866: my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.76 www 867: if (!@psprt) { $psprt[0]='0'; }
1.190 albertel 868: my $showoptions=$env{'form.showoptions'};
1.57 albertel 869:
1.43 albertel 870: my $pssymb='';
1.57 albertel 871: my $parmlev='';
1.190 albertel 872: my $prevvisit=$env{'form.prevvisit'};
1.57 albertel 873:
1.190 albertel 874: unless ($env{'form.parmlev'}) {
1.57 albertel 875: $parmlev = 'map';
876: } else {
1.190 albertel 877: $parmlev = $env{'form.parmlev'};
1.57 albertel 878: }
1.26 www 879:
1.29 www 880: # ----------------------------------------------- Was this started from grades?
881:
1.190 albertel 882: if (($env{'form.command'} eq 'set') && ($env{'form.url'})
883: && (!$env{'form.dis'})) {
884: my $url=$env{'form.url'};
1.194 albertel 885: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
1.43 albertel 886: $pssymb=&Apache::lonnet::symbread($url);
1.92 albertel 887: if (!@pscat) { @pscat=('all'); }
1.43 albertel 888: $pschp='';
1.57 albertel 889: $parmlev = 'full';
1.190 albertel 890: } elsif ($env{'form.symb'}) {
891: $pssymb=$env{'form.symb'};
1.92 albertel 892: if (!@pscat) { @pscat=('all'); }
1.43 albertel 893: $pschp='';
1.57 albertel 894: $parmlev = 'full';
1.43 albertel 895: } else {
1.190 albertel 896: $env{'form.url'}='';
1.43 albertel 897: }
898:
1.190 albertel 899: my $id=$env{'form.id'};
1.43 albertel 900: if (($id) && ($udom)) {
901: $uname=(&Apache::lonnet::idget($udom,$id))[1];
902: if ($uname) {
903: $id='';
904: } else {
905: $message=
1.133 www 906: "<font color=red>".&mt("Unknown ID")." '$id' ".
907: &mt('at domain')." '$udom'</font>";
1.43 albertel 908: }
909: } else {
1.190 albertel 910: $uname=$env{'form.uname'};
1.43 albertel 911: }
912: unless ($udom) { $uname=''; }
913: $uhome='';
914: if ($uname) {
915: $uhome=&Apache::lonnet::homeserver($uname,$udom);
916: if ($uhome eq 'no_host') {
917: $message=
1.133 www 918: "<font color=red>".&mt("Unknown user")." '$uname' ".
919: &mt("at domain")." '$udom'</font>";
1.43 albertel 920: $uname='';
1.12 www 921: } else {
1.103 albertel 922: $csec=&Apache::lonnet::getsection($udom,$uname,
1.190 albertel 923: $env{'request.course.id'});
1.43 albertel 924: if ($csec eq '-1') {
925: $message="<font color=red>".
1.133 www 926: &mt("User")." '$uname' ".&mt("at domain")." '$udom' ".
927: &mt("not in this course")."</font>";
1.43 albertel 928: $uname='';
1.190 albertel 929: $csec=$env{'form.csec'};
1.43 albertel 930: } else {
931: my %name=&Apache::lonnet::userenvironment($udom,$uname,
932: ('firstname','middlename','lastname','generation','id'));
1.133 www 933: $message="\n<p>\n".&mt("Full Name").": ".
1.43 albertel 934: $name{'firstname'}.' '.$name{'middlename'}.' '
935: .$name{'lastname'}.' '.$name{'generation'}.
1.133 www 936: "<br>\n".&mt('ID').": ".$name{'id'}.'<p>';
1.43 albertel 937: }
1.12 www 938: }
1.43 albertel 939: }
1.2 www 940:
1.43 albertel 941: unless ($csec) { $csec=''; }
1.12 www 942:
1.190 albertel 943: my $fcat=$env{'form.fcat'};
1.43 albertel 944: unless ($fcat) { $fcat=''; }
1.2 www 945:
1.14 www 946: # --------------------------------------------------------- Get all assessments
1.196 www 947: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allkeys, \%allmaps, $fcat, \%defp, \%mapp, \%symbp,\%maptitles,\%uris);
1.63 bowersj2 948:
1.57 albertel 949: $mapp{'0.0'} = '';
950: $symbp{'0.0'} = '';
1.99 albertel 951:
1.14 www 952: # ---------------------------------------------------------- Anything to store?
1.190 albertel 953: if ($env{'form.pres_marker'}) {
954: $message.=&storeparm(split(/\&/,$env{'form.pres_marker'}),
955: $env{'form.pres_value'},
956: $env{'form.pres_type'},
1.187 www 957: $uname,$udom,$csec);
1.68 www 958: # ---------------------------------------------------------------- Done storing
1.130 www 959: $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 960: }
1.2 www 961: # ------------------------------------------------------------------- Sort this
1.17 www 962:
1.44 albertel 963: @ids=sort {
964: if ($fcat eq '') {
965: $a<=>$b;
966: } else {
1.187 www 967: my ($result,@outpar)=&parmval($fcat,$a,$defp{$a},$uname,$udom,$csec);
1.44 albertel 968: my $aparm=$outpar[$result];
1.187 www 969: ($result,@outpar)=&parmval($fcat,$b,$defp{$b},$uname,$udom,$csec);
1.44 albertel 970: my $bparm=$outpar[$result];
971: 1*$aparm<=>1*$bparm;
972: }
973: } @ids;
1.57 albertel 974: #----------------------------------------------- if all selected, fill in array
975: if ($pscat[0] eq "all" || !@pscat) {@pscat = (keys %allparms);}
976: if ($psprt[0] eq "all" || !@psprt) {@psprt = (keys %allparts);}
1.2 www 977: # ------------------------------------------------------------------ Start page
1.63 bowersj2 978:
1.202 ! www 979: &startpage($r,$id,$udom,$csec,$uname,scalar(keys(%allkeys)));
1.99 albertel 980:
1.190 albertel 981: # if ($env{'form.url'}) {
982: # $r->print('<input type="hidden" value="'.$env{'form.url'}.
1.44 albertel 983: # '" name="url"><input type="hidden" name="command" value="set">');
984: # }
1.57 albertel 985: $r->print('<input type="hidden" value="true" name="prevvisit">');
986:
1.44 albertel 987: foreach ('tolerance','date_default','date_start','date_end',
988: 'date_interval','int','float','string') {
989: $r->print('<input type="hidden" value="'.
1.190 albertel 990: $env{'form.recent_'.$_}.'" name="recent_'.$_.'">');
1.44 albertel 991: }
992:
1.57 albertel 993: $r->print('<h2>'.$message.'</h2><table>');
994:
1.130 www 995: my $submitmessage = &mt('Update Section or Specific User');
1.44 albertel 996: if (!$pssymb) {
1.160 www 997: $r->print('<tr><td>'.&mt('Select Parameter Level').
998: &Apache::loncommon::help_open_topic('Course_Parameter_Levels').
999: '</td><td colspan="2">');
1.57 albertel 1000: $r->print('<select name="parmlev">');
1001: foreach (reverse sort keys %alllevs) {
1002: $r->print('<option value="'.$alllevs{$_}.'"');
1003: if ($parmlev eq $alllevs{$_}) {
1004: $r->print(' selected');
1005: }
1006: $r->print('>'.$_.'</option>');
1007: }
1008: $r->print("</select></td>\n");
1009:
1.101 www 1010: $r->print('</tr>');
1.128 albertel 1011: if ($parmlev ne 'general') {
1.130 www 1012: $r->print('<tr><td>'.&mt('Select Enclosing Map or Folder').'</td>');
1.128 albertel 1013: $r->print('<td colspan="2"><select name="pschp">');
1.130 www 1014: $r->print('<option value="all">'.&mt('All Maps or Folders').'</option>');
1.128 albertel 1015: foreach (sort {$allmaps{$a} cmp $allmaps{$b}} keys %allmaps) {
1016: $r->print('<option value="'.$_.'"');
1017: if (($pschp eq $_)) { $r->print(' selected'); }
1018: $r->print('>'.$maptitles{$_}.($allmaps{$_}!~/^uploaded/?' ['.$allmaps{$_}.']':'').'</option>');
1019: }
1020: $r->print("</select></td></tr>\n");
1021: }
1.44 albertel 1022: } else {
1.125 www 1023: my ($map,$id,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.130 www 1024: $r->print("<tr><td>".&mt('Specific Resource')."</td><td>$resource</td>");
1.57 albertel 1025: $r->print('<td><input type="submit" name="dis" value="'.$submitmessage.'"></td>');
1026: $r->print('</tr>');
1027: $r->print('<input type="hidden" value="'.$pssymb.'" name="symb">');
1028: }
1029:
1.185 albertel 1030: $r->print('<tr><td colspan="3"><hr /><label><input type="checkbox"');
1.57 albertel 1031: if ($showoptions eq 'show') {$r->print(" checked ");}
1.185 albertel 1032: $r->print(' name="showoptions" value="show" />'.&mt('Show More Options').'</label><hr /></td></tr>');
1.57 albertel 1033: # $r->print("<tr><td>Show: $showoptions</td></tr>");
1034: # $r->print("<tr><td>pscat: @pscat</td></tr>");
1035: # $r->print("<tr><td>psprt: @psprt</td></tr>");
1036: # $r->print("<tr><td>fcat: $fcat</td></tr>");
1037:
1038: if ($showoptions eq 'show') {
1039: my $tempkey;
1040:
1.130 www 1041: $r->print('<tr><td colspan="3" align="center">'.&mt('Select Parameters to View').'</td></tr>');
1.57 albertel 1042:
1.176 albertel 1043: $r->print('<tr><td colspan="2"><table><tr>');
1.57 albertel 1044: my $cnt=0;
1045: foreach $tempkey (sort { $allparms{$a} cmp $allparms{$b} }
1046: keys %allparms ) {
1047: ++$cnt;
1.176 albertel 1048: $r->print('</tr><tr>') if ($cnt%2);
1.57 albertel 1049: $r->print('<td><input type="checkbox" name="pscat" ');
1050: $r->print('value="'.$tempkey.'"');
1051: if ($pscat[0] eq "all" || grep $_ eq $tempkey, @pscat) {
1052: $r->print(' checked');
1053: }
1.176 albertel 1054: $r->print('>'.$allparms{$tempkey}.'</td>');
1055: }
1056: $r->print('
1057: </tr><tr><td>
1058: <script type="text/javascript">
1059: function checkall(value, checkName) {
1060: for (i=0; i<document.forms.parmform.elements.length; i++) {
1061: ele = document.forms.parmform.elements[i];
1062: if (ele.name == checkName) {
1063: document.forms.parmform.elements[i].checked=value;
1064: }
1.57 albertel 1065: }
1.176 albertel 1066: }
1067: </script>
1068: <input type="button" onclick="checkall(true, \'pscat\')" value="Select All" />
1069: </td><td>
1070: <input type="button" onclick="checkall(false, \'pscat\')" value="Unselect All" />
1071: </td>
1072: ');
1.57 albertel 1073: $r->print('</tr></table>');
1074:
1075: # $r->print('<tr><td>Select Parts</td><td>');
1076: $r->print('<td><select multiple name="psprt" size="5">');
1077: $r->print('<option value="all"');
1078: $r->print(' selected') unless (@psprt);
1.130 www 1079: $r->print('>'.&mt('All Parts').'</option>');
1.76 www 1080: my %temphash=();
1081: foreach (@psprt) { $temphash{$_}=1; }
1.57 albertel 1082: foreach $tempkey (sort keys %allparts) {
1083: unless ($tempkey =~ /\./) {
1084: $r->print('<option value="'.$tempkey.'"');
1.76 www 1085: if ($psprt[0] eq "all" || $temphash{$tempkey}) {
1.57 albertel 1086: $r->print(' selected');
1087: }
1088: $r->print('>'.$allparts{$tempkey}.'</option>');
1089: }
1090: }
1091: $r->print('</select></td></tr><tr><td colspan="3"><hr /></td></tr>');
1092:
1.130 www 1093: $r->print('<tr><td>'.&mt('Sort list by').'</td><td>');
1.57 albertel 1094: $r->print('<select name="fcat">');
1.130 www 1095: $r->print('<option value="">'.&mt('Enclosing Map or Folder').'</option>');
1.57 albertel 1096: foreach (sort keys %allkeys) {
1097: $r->print('<option value="'.$_.'"');
1098: if ($fcat eq $_) { $r->print(' selected'); }
1099: $r->print('>'.$allkeys{$_}.'</option>');
1100: }
1101: $r->print('</select></td>');
1102:
1103: $r->print('</tr><tr><td colspan="3"><hr /></td></tr>');
1104:
1105: } else { # hide options - include any necessary extras here
1106:
1107: $r->print('<input type="hidden" name="fcat" value="'.$fcat.'">'."\n");
1108:
1109: unless (@pscat) {
1110: foreach (keys %allparms ) {
1111: $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
1112: }
1113: } else {
1114: foreach (@pscat) {
1115: $r->print('<input type="hidden" name="pscat" value="'.$_.'">'."\n");
1116: }
1117: }
1118:
1119: unless (@psprt) {
1120: foreach (keys %allparts ) {
1121: $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
1122: }
1123: } else {
1124: foreach (@psprt) {
1125: $r->print('<input type="hidden" name="psprt" value="'.$_.'">'."\n");
1126: }
1127: }
1128:
1.44 albertel 1129: }
1.101 www 1130: $r->print('</table><br />');
1131: if (($prevvisit) || ($pschp) || ($pssymb)) {
1.130 www 1132: $submitmessage = &mt("Update Course Assessment Parameter Display");
1.101 www 1133: } else {
1.130 www 1134: $submitmessage = &mt("Set/Modify Course Assessment Parameters");
1.101 www 1135: }
1136: $r->print('<input type="submit" name="dis" value="'.$submitmessage.'">');
1.57 albertel 1137:
1.76 www 1138: # my @temp_psprt;
1139: # foreach my $t (@psprt) {
1140: # push(@temp_psprt, grep {eval (/^$t\./ || ($_ == $t))} (keys %allparts));
1141: # }
1.57 albertel 1142:
1.76 www 1143: # @psprt = @temp_psprt;
1.57 albertel 1144:
1145: my @temp_pscat;
1146: map {
1147: my $cat = $_;
1148: push(@temp_pscat, map { $_.'.'.$cat } @psprt);
1149: } @pscat;
1150:
1151: @pscat = @temp_pscat;
1152:
1153: if (($prevvisit) || ($pschp) || ($pssymb)) {
1.10 www 1154: # ----------------------------------------------------------------- Start Table
1.57 albertel 1155: my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190 albertel 1156: my $csuname=$env{'user.name'};
1157: my $csudom=$env{'user.domain'};
1.57 albertel 1158:
1159: if ($parmlev eq 'full' || $parmlev eq 'brief') {
1160: my $coursespan=$csec?8:5;
1161: $r->print('<p><table border=2>');
1162: $r->print('<tr><td colspan=5></td>');
1.130 www 1163: $r->print('<th colspan='.($coursespan).'>'.&mt('Any User').'</th>');
1.57 albertel 1164: if ($uname) {
1165: $r->print("<th colspan=3 rowspan=2>");
1.130 www 1166: $r->print(&mt("User")." $uname ".&mt('at Domain')." $udom</th>");
1.57 albertel 1167: }
1.133 www 1168: my %lt=&Apache::lonlocal::texthash(
1169: 'pie' => "Parameter in Effect",
1170: 'csv' => "Current Session Value",
1171: 'at' => 'at',
1172: 'rl' => "Resource Level",
1173: 'ic' => 'in Course',
1174: 'aut' => "Assessment URL and Title",
1.143 albertel 1175: 'type' => 'Type',
1.133 www 1176: 'emof' => "Enclosing Map or Folder",
1.143 albertel 1177: 'part' => 'Part',
1.133 www 1178: 'pn' => 'Parameter Name',
1179: 'def' => 'default',
1180: 'femof' => 'from Enclosing Map or Folder',
1181: 'gen' => 'general',
1182: 'foremf' => 'for Enclosing Map or Folder',
1183: 'fr' => 'for Resource'
1184: );
1.57 albertel 1185: $r->print(<<ENDTABLETWO);
1.133 www 1186: <th rowspan=3>$lt{'pie'}</th>
1187: <th rowspan=3>$lt{'csv'}<br>($csuname $lt{'at'} $csudom)</th>
1.182 albertel 1188: </tr><tr><td colspan=5></td><th colspan=2>$lt{'ic'}</th><th colspan=2>$lt{'rl'}</th>
1189: <th colspan=1>$lt{'ic'}</th>
1190:
1.10 www 1191: ENDTABLETWO
1.57 albertel 1192: if ($csec) {
1.133 www 1193: $r->print("<th colspan=3>".
1194: &mt("in Section/Group")." $csec</th>");
1.57 albertel 1195: }
1196: $r->print(<<ENDTABLEHEADFOUR);
1.133 www 1197: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
1198: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.192 albertel 1199: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1200: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10 www 1201: ENDTABLEHEADFOUR
1.57 albertel 1202:
1203: if ($csec) {
1.130 www 1204: $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57 albertel 1205: }
1206:
1207: if ($uname) {
1.130 www 1208: $r->print('<th>'.&mt('general').'</th><th>'.&mt('for Enclosing Map or Folder').'</th><th>'.&mt('for Resource').'</th>');
1.57 albertel 1209: }
1210:
1211: $r->print('</tr>');
1212:
1213: my $defbgone='';
1214: my $defbgtwo='';
1215:
1216: foreach (@ids) {
1217:
1218: my $rid=$_;
1219: my ($inmapid)=($rid=~/\.(\d+)$/);
1220:
1.152 albertel 1221: if ((!$pssymb &&
1222: (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
1223: ||
1224: ($pssymb && $pssymb eq $symbp{$rid})) {
1.4 www 1225: # ------------------------------------------------------ Entry for one resource
1.184 albertel 1226: if ($defbgone eq '"#E0E099"') {
1227: $defbgone='"#E0E0DD"';
1.57 albertel 1228: } else {
1.184 albertel 1229: $defbgone='"#E0E099"';
1.57 albertel 1230: }
1.184 albertel 1231: if ($defbgtwo eq '"#FFFF99"') {
1232: $defbgtwo='"#FFFFDD"';
1.57 albertel 1233: } else {
1.184 albertel 1234: $defbgtwo='"#FFFF99"';
1.57 albertel 1235: }
1236: my $thistitle='';
1237: my %name= ();
1238: undef %name;
1239: my %part= ();
1240: my %display=();
1241: my %type= ();
1242: my %default=();
1.196 www 1243: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1244:
1245: foreach (split(/\,/,$keyp{$rid})) {
1246: my $tempkeyp = $_;
1247: if (grep $_ eq $tempkeyp, @catmarker) {
1248: $part{$_}=&Apache::lonnet::metadata($uri,$_.'.part');
1249: $name{$_}=&Apache::lonnet::metadata($uri,$_.'.name');
1250: $display{$_}=&Apache::lonnet::metadata($uri,$_.'.display');
1251: unless ($display{$_}) { $display{$_}=''; }
1252: $display{$_}.=' ('.$name{$_}.')';
1253: $default{$_}=&Apache::lonnet::metadata($uri,$_);
1254: $type{$_}=&Apache::lonnet::metadata($uri,$_.'.type');
1255: $thistitle=&Apache::lonnet::metadata($uri,$_.'.title');
1256: }
1257: }
1258: my $totalparms=scalar keys %name;
1259: if ($totalparms>0) {
1260: my $firstrow=1;
1.180 albertel 1261: my $title=&Apache::lonnet::gettitle($uri);
1.57 albertel 1262: $r->print('<tr><td bgcolor='.$defbgone.
1263: ' rowspan='.$totalparms.
1264: '><tt><font size=-1>'.
1265: join(' / ',split(/\//,$uri)).
1266: '</font></tt><p><b>'.
1.154 albertel 1267: "<a href=\"javascript:openWindow('".
1268: &Apache::lonnet::clutter($uri).
1.57 albertel 1269: "', 'metadatafile', '450', '500', 'no', 'yes')\";".
1.127 albertel 1270: " TARGET=_self>$title");
1.57 albertel 1271:
1272: if ($thistitle) {
1273: $r->print(' ('.$thistitle.')');
1274: }
1275: $r->print('</a></b></td>');
1276: $r->print('<td bgcolor='.$defbgtwo.
1277: ' rowspan='.$totalparms.'>'.$typep{$rid}.
1278: '</td>');
1279:
1280: $r->print('<td bgcolor='.$defbgone.
1281: ' rowspan='.$totalparms.
1282: '><tt><font size=-1>');
1283:
1284: $r->print(' / res / ');
1285: $r->print(join(' / ', split(/\//,$mapp{$rid})));
1286:
1287: $r->print('</font></tt></td>');
1288:
1289: foreach (sort keys %name) {
1290: unless ($firstrow) {
1291: $r->print('<tr>');
1292: } else {
1293: undef $firstrow;
1294: }
1295:
1.201 www 1296: &print_row($r,$_,\%part,\%name,\%symbp,$rid,\%default,
1.57 albertel 1297: \%type,\%display,$defbgone,$defbgtwo,
1.187 www 1298: $parmlev,$uname,$udom,$csec);
1.57 albertel 1299: }
1300: }
1301: }
1302: } # end foreach ids
1.43 albertel 1303: # -------------------------------------------------- End entry for one resource
1.57 albertel 1304: $r->print('</table>');
1305: } # end of brief/full
1306: #--------------------------------------------------- Entry for parm level map
1307: if ($parmlev eq 'map') {
1308: my $defbgone = '"E0E099"';
1309: my $defbgtwo = '"FFFF99"';
1310:
1311: my %maplist;
1312:
1313: if ($pschp eq 'all') {
1314: %maplist = %allmaps;
1315: } else {
1316: %maplist = ($pschp => $mapp{$pschp});
1317: }
1318:
1319: #-------------------------------------------- for each map, gather information
1320: my $mapid;
1.60 albertel 1321: foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys %maplist) {
1322: my $maptitle = $maplist{$mapid};
1.57 albertel 1323:
1324: #----------------------- loop through ids and get all parameter types for map
1325: #----------------------------------------- and associated information
1326: my %name = ();
1327: my %part = ();
1328: my %display = ();
1329: my %type = ();
1330: my %default = ();
1331: my $map = 0;
1332:
1333: # $r->print("Catmarker: @catmarker<br />\n");
1334:
1335: foreach (@ids) {
1336: ($map)=(/([\d]*?)\./);
1337: my $rid = $_;
1338:
1339: # $r->print("$mapid:$map: $rid <br /> \n");
1340:
1341: if ($map eq $mapid) {
1.196 www 1342: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1343: # $r->print("Keys: $keyp{$rid} <br />\n");
1344:
1345: #--------------------------------------------------------------------
1346: # @catmarker contains list of all possible parameters including part #s
1347: # $fullkeyp contains the full part/id # for the extraction of proper parameters
1348: # $tempkeyp contains part 0 only (no ids - ie, subparts)
1349: # When storing information, store as part 0
1350: # When requesting information, request from full part
1351: #-------------------------------------------------------------------
1352: foreach (split(/\,/,$keyp{$rid})) {
1353: my $tempkeyp = $_;
1354: my $fullkeyp = $tempkeyp;
1.73 albertel 1355: $tempkeyp =~ s/_\w+_/_0_/;
1.57 albertel 1356:
1357: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1358: $part{$tempkeyp}="0";
1359: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1360: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
1361: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
1362: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73 albertel 1363: $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57 albertel 1364: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1365: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1366: }
1367: } # end loop through keys
1368: }
1369: } # end loop through ids
1370:
1371: #---------------------------------------------------- print header information
1.133 www 1372: my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82 www 1373: my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.57 albertel 1374: $r->print(<<ENDMAPONE);
1375: <center><h4>
1.135 albertel 1376: Set Defaults for All Resources in $foldermap<br />
1377: <font color="red"><i>$showtitle</i></font><br />
1.57 albertel 1378: Specifically for
1379: ENDMAPONE
1380: if ($uname) {
1381: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1382: ('firstname','middlename','lastname','generation', 'id'));
1383: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1384: .$name{'lastname'}.' '.$name{'generation'};
1.135 albertel 1385: $r->print(&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
1.130 www 1386: &mt('in')." \n");
1.57 albertel 1387: } else {
1.135 albertel 1388: $r->print("<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n");
1.57 albertel 1389: }
1390:
1.135 albertel 1391: if ($csec) {$r->print(&mt("Section")." <font color=\"red\"><i>$csec</i></font> ".
1.130 www 1392: &mt('of')." \n")};
1.57 albertel 1393:
1.135 albertel 1394: $r->print("<font color=\"red\"><i>$coursename</i></font><br />");
1395: $r->print("</h4>\n");
1.57 albertel 1396: #---------------------------------------------------------------- print table
1397: $r->print('<p><table border="2">');
1.130 www 1398: $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
1399: $r->print('<th>'.&mt('Default Value').'</th>');
1400: $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57 albertel 1401:
1402: foreach (sort keys %name) {
1.168 matthew 1403: $r->print('<tr>');
1.201 www 1404: &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.57 albertel 1405: \%type,\%display,$defbgone,$defbgtwo,
1.187 www 1406: $parmlev,$uname,$udom,$csec);
1.57 albertel 1407: # $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
1408: }
1409: $r->print("</table></center>");
1410: } # end each map
1411: } # end of $parmlev eq map
1412: #--------------------------------- Entry for parm level general (Course level)
1413: if ($parmlev eq 'general') {
1414: my $defbgone = '"E0E099"';
1415: my $defbgtwo = '"FFFF99"';
1416:
1417: #-------------------------------------------- for each map, gather information
1418: my $mapid="0.0";
1419: #----------------------- loop through ids and get all parameter types for map
1420: #----------------------------------------- and associated information
1421: my %name = ();
1422: my %part = ();
1423: my %display = ();
1424: my %type = ();
1425: my %default = ();
1426:
1427: foreach (@ids) {
1428: my $rid = $_;
1429:
1.196 www 1430: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 1431:
1432: #--------------------------------------------------------------------
1433: # @catmarker contains list of all possible parameters including part #s
1434: # $fullkeyp contains the full part/id # for the extraction of proper parameters
1435: # $tempkeyp contains part 0 only (no ids - ie, subparts)
1436: # When storing information, store as part 0
1437: # When requesting information, request from full part
1438: #-------------------------------------------------------------------
1439: foreach (split(/\,/,$keyp{$rid})) {
1440: my $tempkeyp = $_;
1441: my $fullkeyp = $tempkeyp;
1.73 albertel 1442: $tempkeyp =~ s/_\w+_/_0_/;
1.57 albertel 1443: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1444: $part{$tempkeyp}="0";
1445: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
1446: $display{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
1447: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
1448: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
1.73 albertel 1449: $display{$tempkeyp} =~ s/_\w+_/_0_/;
1.57 albertel 1450: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
1451: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1452: }
1453: } # end loop through keys
1454: } # end loop through ids
1455:
1456: #---------------------------------------------------- print header information
1.133 www 1457: my $setdef=&mt("Set Defaults for All Resources in Course");
1.57 albertel 1458: $r->print(<<ENDMAPONE);
1.133 www 1459: <center><h4>$setdef
1.135 albertel 1460: <font color="red"><i>$coursename</i></font><br />
1.57 albertel 1461: ENDMAPONE
1462: if ($uname) {
1463: my %name=&Apache::lonnet::userenvironment($udom,$uname,
1464: ('firstname','middlename','lastname','generation', 'id'));
1465: my $person=$name{'firstname'}.' '.$name{'middlename'}.' '
1466: .$name{'lastname'}.' '.$name{'generation'};
1.135 albertel 1467: $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57 albertel 1468: } else {
1.135 albertel 1469: $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57 albertel 1470: }
1471:
1.135 albertel 1472: if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1473: $r->print("</h4>\n");
1.57 albertel 1474: #---------------------------------------------------------------- print table
1475: $r->print('<p><table border="2">');
1.130 www 1476: $r->print('<tr><th>'.&mt('Parameter Name').'</th>');
1477: $r->print('<th>'.&mt('Default Value').'</th>');
1478: $r->print('<th>'.&mt('Parameter in Effect').'</th></tr>');
1.57 albertel 1479:
1480: foreach (sort keys %name) {
1.168 matthew 1481: $r->print('<tr>');
1.201 www 1482: &print_row($r,$_,\%part,\%name,\%symbp,$mapid,\%default,
1.187 www 1483: \%type,\%display,$defbgone,$defbgtwo,$parmlev,$uname,$udom,$csec);
1.57 albertel 1484: # $r->print("<tr><td>resource.$part{$_}.$name{$_},$symbp{$mapid}</td></tr>\n");
1485: }
1486: $r->print("</table></center>");
1487: } # end of $parmlev eq general
1.43 albertel 1488: }
1.44 albertel 1489: $r->print('</form></body></html>');
1.57 albertel 1490: } # end sub assessparms
1.30 www 1491:
1.59 matthew 1492:
1493: ##################################################
1494: ##################################################
1495:
1496: =pod
1497:
1498: =item crsenv
1499:
1.105 matthew 1500: Show and set course data and parameters. This is a large routine that should
1.59 matthew 1501: be simplified and shortened... someday.
1502:
1503: Inputs: $r
1504:
1505: Returns: nothing
1506:
1507: =cut
1508:
1509: ##################################################
1510: ##################################################
1.30 www 1511: sub crsenv {
1512: my $r=shift;
1513: my $setoutput='';
1.64 www 1514: my $bodytag=&Apache::loncommon::bodytag(
1515: 'Set Course Environment Parameters');
1.194 albertel 1516: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,
1517: 'Edit Course Environment');
1.190 albertel 1518: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1519: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.105 matthew 1520:
1521: #
1522: # Go through list of changes
1.190 albertel 1523: foreach (keys %env) {
1.105 matthew 1524: next if ($_!~/^form\.(.+)\_setparmval$/);
1525: my $name = $1;
1.190 albertel 1526: my $value = $env{'form.'.$name.'_value'};
1.105 matthew 1527: if ($name eq 'newp') {
1.190 albertel 1528: $name = $env{'form.newp_name'};
1.105 matthew 1529: }
1530: if ($name eq 'url') {
1531: $value=~s/^\/res\///;
1532: my $bkuptime=time;
1533: my @tmp = &Apache::lonnet::get
1534: ('environment',['url'],$dom,$crs);
1.130 www 1535: $setoutput.=&mt('Backing up previous URL').': '.
1.105 matthew 1536: &Apache::lonnet::put
1537: ('environment',
1538: {'top level map backup '.$bkuptime => $tmp[1] },
1539: $dom,$crs).
1540: '<br>';
1541: }
1542: #
1543: # Deal with modified default spreadsheets
1544: if ($name =~ /^spreadsheet_default_(classcalc|
1545: studentcalc|
1546: assesscalc)$/x) {
1547: my $sheettype = $1;
1548: if ($sheettype eq 'classcalc') {
1549: # no need to do anything since viewing the sheet will
1550: # cause it to be updated.
1551: } elsif ($sheettype eq 'studentcalc') {
1552: # expire all the student spreadsheets
1553: &Apache::lonnet::expirespread('','','studentcalc');
1554: } else {
1555: # expire all the assessment spreadsheets
1556: # this includes non-default spreadsheets, but better to
1557: # be safe than sorry.
1558: &Apache::lonnet::expirespread('','','assesscalc');
1559: # expire all the student spreadsheets
1560: &Apache::lonnet::expirespread('','','studentcalc');
1.30 www 1561: }
1.105 matthew 1562: }
1563: #
1.107 matthew 1564: # Deal with the enrollment dates
1565: if ($name =~ /^default_enrollment_(start|end)_date$/) {
1566: $value=&Apache::lonhtmlcommon::get_date_from_form($name.'_value');
1567: }
1.178 raeburn 1568: # Get existing cloners
1569: my @oldcloner = ();
1570: if ($name eq 'cloners') {
1571: my %clonenames=&Apache::lonnet::dump('environment',$dom,$crs,'cloners');
1572: if ($clonenames{'cloners'} =~ /,/) {
1573: @oldcloner = split/,/,$clonenames{'cloners'};
1574: } else {
1575: $oldcloner[0] = $clonenames{'cloners'};
1576: }
1577: }
1.107 matthew 1578: #
1.105 matthew 1579: # Let the user know we made the changes
1.153 albertel 1580: if ($name && defined($value)) {
1.178 raeburn 1581: if ($name eq 'cloners') {
1582: $value =~ s/^,//;
1583: $value =~ s/,$//;
1584: }
1.105 matthew 1585: my $put_result = &Apache::lonnet::put('environment',
1586: {$name=>$value},$dom,$crs);
1587: if ($put_result eq 'ok') {
1.130 www 1588: $setoutput.=&mt('Set').' <b>'.$name.'</b> '.&mt('to').' <b>'.$value.'</b>.<br />';
1.178 raeburn 1589: if ($name eq 'cloners') {
1590: &change_clone($value,\@oldcloner);
1591: }
1.179 raeburn 1592: # Flush the course logs so course description is immediately updated
1593: if ($name eq 'description' && defined($value)) {
1594: &Apache::lonnet::flushcourselogs();
1595: }
1.105 matthew 1596: } else {
1.130 www 1597: $setoutput.=&mt('Unable to set').' <b>'.$name.'</b> '.&mt('to').
1598: ' <b>'.$value.'</b> '.&mt('due to').' '.$put_result.'.<br />';
1.30 www 1599: }
1600: }
1.38 harris41 1601: }
1.108 www 1602: # ------------------------- Re-init course environment entries for this session
1603:
1.190 albertel 1604: &Apache::lonnet::coursedescription($env{'request.course.id'});
1.105 matthew 1605:
1.30 www 1606: # -------------------------------------------------------- Get parameters again
1.45 matthew 1607:
1608: my %values=&Apache::lonnet::dump('environment',$dom,$crs);
1.140 sakharuk 1609: my $SelectStyleFile=&mt('Select Style File');
1.141 sakharuk 1610: my $SelectSpreadsheetFile=&mt('Select Spreadsheet File');
1.30 www 1611: my $output='';
1.45 matthew 1612: if (! exists($values{'con_lost'})) {
1.30 www 1613: my %descriptions=
1.140 sakharuk 1614: ('url' => '<b>'.&mt('Top Level Map').'</b> '.
1.46 matthew 1615: '<a href="javascript:openbrowser'.
1.47 matthew 1616: "('envform','url','sequence')\">".
1.140 sakharuk 1617: &mt('Select Map').'</a><br /><font color=red> '.
1618: &mt('Modification may make assessment data inaccessible').
1619: '</font>',
1620: 'description' => '<b>'.&mt('Course Description').'</b>',
1.158 sakharuk 1621: 'courseid' => '<b>'.&mt('Course ID or number').
1.140 sakharuk 1622: '</b><br />'.
1623: '('.&mt('internal').', '.&mt('optional').')',
1.177 raeburn 1624: '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 1625: 'grading' => '<b>'.&mt('Grading').'</b><br />'.
1626: '<tt>"standard", "external", or "spreadsheet"</tt> '.&Apache::loncommon::help_open_topic('GradingOptions'),
1.140 sakharuk 1627: 'default_xml_style' => '<b>'.&mt('Default XML Style File').'</b> '.
1.52 www 1628: '<a href="javascript:openbrowser'.
1629: "('envform','default_xml_style'".
1.140 sakharuk 1630: ",'sty')\">$SelectStyleFile</a><br>",
1.141 sakharuk 1631: 'question.email' => '<b>'.&mt('Feedback Addresses for Resource Content Question').
1632: '</b><br />(<tt>user:domain,'.
1.74 www 1633: 'user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1634: 'comment.email' => '<b>'.&mt('Feedback Addresses for Course Content Comments').'</b><br />'.
1.74 www 1635: '(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1636: 'policy.email' => '<b>'.&mt('Feedback Addresses for Course Policy').'</b>'.
1.75 albertel 1637: '<br />(<tt>user:domain,user:domain(section;section;...;*;...),...</tt>)',
1.141 sakharuk 1638: 'hideemptyrows' => '<b>'.&mt('Hide Empty Rows in Spreadsheets').'</b><br />'.
1.158 sakharuk 1639: '('.&mt('"[_1]" for default hiding','<tt>yes</tt>').')',
1.141 sakharuk 1640: 'pageseparators' => '<b>'.&mt('Visibly Separate Items on Pages').'</b><br />'.
1.158 sakharuk 1641: '('.&mt('"[_1]" for visible separation','<tt>yes</tt>').', '.
1.141 sakharuk 1642: &mt('changes will not show until next login').')',
1.169 matthew 1643: '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 1644:
1.141 sakharuk 1645: 'plc.roles.denied'=> '<b>'.&mt('Disallow live chatroom use for Roles').
1646: '</b><br />"<tt>st</tt>": '.
1.158 sakharuk 1647: &mt('student').', "<tt>ta</tt>": '.
1.118 matthew 1648: 'TA, "<tt>in</tt>": '.
1.158 sakharuk 1649: &mt('instructor').';<br /><tt>'.&mt('role,role,...').'</tt>) '.
1.118 matthew 1650: Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1651: 'plc.users.denied' =>
1.141 sakharuk 1652: '<b>'.&mt('Disallow live chatroom use for Users').'</b><br />'.
1.118 matthew 1653: '(<tt>user:domain,user:domain,...</tt>)',
1654:
1.141 sakharuk 1655: 'pch.roles.denied'=> '<b>'.&mt('Disallow Resource Discussion for Roles').
1656: '</b><br />"<tt>st</tt>": '.
1.61 albertel 1657: 'student, "<tt>ta</tt>": '.
1658: 'TA, "<tt>in</tt>": '.
1.75 albertel 1659: 'instructor;<br /><tt>role,role,...</tt>) '.
1.61 albertel 1660: Apache::loncommon::help_open_topic("Course_Disable_Discussion"),
1.53 www 1661: 'pch.users.denied' =>
1.141 sakharuk 1662: '<b>'.&mt('Disallow Resource Discussion for Users').'</b><br />'.
1.53 www 1663: '(<tt>user:domain,user:domain,...</tt>)',
1.49 matthew 1664: 'spreadsheet_default_classcalc'
1.141 sakharuk 1665: => '<b>'.&mt('Default Course Spreadsheet').'</b> '.
1.50 matthew 1666: '<a href="javascript:openbrowser'.
1667: "('envform','spreadsheet_default_classcalc'".
1.141 sakharuk 1668: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49 matthew 1669: 'spreadsheet_default_studentcalc'
1.141 sakharuk 1670: => '<b>'.&mt('Default Student Spreadsheet').'</b> '.
1.50 matthew 1671: '<a href="javascript:openbrowser'.
1672: "('envform','spreadsheet_default_calc'".
1.141 sakharuk 1673: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.49 matthew 1674: 'spreadsheet_default_assesscalc'
1.141 sakharuk 1675: => '<b>'.&mt('Default Assessment Spreadsheet').'</b> '.
1.50 matthew 1676: '<a href="javascript:openbrowser'.
1677: "('envform','spreadsheet_default_assesscalc'".
1.141 sakharuk 1678: ",'spreadsheet')\">$SelectSpreadsheetFile</a><br />",
1.75 albertel 1679: 'allow_limited_html_in_feedback'
1.141 sakharuk 1680: => '<b>'.&mt('Allow limited HTML in discussion posts').'</b><br />'.
1.158 sakharuk 1681: '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.170 raeburn 1682: 'allow_discussion_post_editing'
1683: => '<b>'.&mt('Allow users to edit/delete their own discussion posts').'</b><br />'.
1684: '('.&mt('Set value to "[_1]" to allow',"<tt>yes</tt>").')',
1.89 albertel 1685: 'rndseed'
1.140 sakharuk 1686: => '<b>'.&mt('Randomization algorithm used').'</b> <br />'.
1687: '<font color="red">'.&mt('Modifying this will make problems').' '.
1688: &mt('have different numbers and answers').'</font>',
1.151 albertel 1689: 'receiptalg'
1690: => '<b>'.&mt('Receipt algorithm used').'</b> <br />'.
1691: &mt('This controls how receipt numbers are generated.'),
1.164 sakharuk 1692: 'suppress_tries'
1693: => '<b>'.&mt('Suppress number of tries in printing').'</b>('.
1694: &mt('yes if supress').')',
1.113 sakharuk 1695: 'problem_stream_switch'
1.141 sakharuk 1696: => '<b>'.&mt('Allow problems to be split over pages').'</b><br />'.
1.158 sakharuk 1697: ' ('.&mt('"[_1]" if allowed, anything else if not','<tt>yes</tt>').')',
1.161 sakharuk 1698: 'default_paper_size'
1699: => '<b>'.&mt('Default paper type').'</b><br />'.
1700: ' ('.&mt('supported types').': Letter [8 1/2x11 in], Legal [8 1/2x14 in],'.
1701: ' Tabloid [11x17 in], Executive [7 1/2x10 in], A2 [420x594 mm],'.
1702: ' A3 [297x420 mm], A4 [210x297 mm], A5 [148x210 mm], A6 [105x148 mm])',
1.111 sakharuk 1703: 'anonymous_quiz'
1.150 www 1704: => '<b>'.&mt('Anonymous quiz/exam').'</b><br />'.
1.141 sakharuk 1705: ' (<tt><b>'.&mt('yes').'</b> '.&mt('to avoid print students names').' </tt>)',
1706: 'default_enrollment_start_date' => '<b>'.&mt('Default beginning date when enrolling students').'</b>',
1707: 'default_enrollment_end_date' => '<b>'.&mt('Default ending date when enrolling students').'</b>',
1.150 www 1708: 'nothideprivileged' => '<b>'.&mt('Privileged users that should not be hidden on staff listings').'</b>'.
1709: '<br />(<tt>user:domain,user:domain,...</tt>)',
1.140 sakharuk 1710: 'languages' => '<b>'.&mt('Languages used').'</b>',
1.115 www 1711: 'disable_receipt_display'
1.141 sakharuk 1712: => '<b>'.&mt('Disable display of problem receipts').'</b><br />'.
1.158 sakharuk 1713: ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.163 albertel 1714: 'disablesigfigs'
1715: => '<b>'.&mt('Disable checking of Significant Figures').'</b><br />'.
1716: ' ('.&mt('"[_1]" to disable, anything else if not','<tt>yes</tt>').')',
1.149 albertel 1717: 'tthoptions'
1718: => '<b>'.&mt('Default set of options to pass to tth/m when converting tex').'</b>'
1.107 matthew 1719: );
1.177 raeburn 1720: my @Display_Order = ('url','description','courseid','cloners','grading',
1.107 matthew 1721: 'default_xml_style','pageseparators',
1722: 'question.email','comment.email','policy.email',
1.169 matthew 1723: 'student_classlist_view',
1.118 matthew 1724: 'plc.roles.denied','plc.users.denied',
1.107 matthew 1725: 'pch.roles.denied','pch.users.denied',
1726: 'allow_limited_html_in_feedback',
1.170 raeburn 1727: 'allow_discussion_post_editing',
1.108 www 1728: 'languages',
1.150 www 1729: 'nothideprivileged',
1.107 matthew 1730: 'rndseed',
1.151 albertel 1731: 'receiptalg',
1.107 matthew 1732: 'problem_stream_switch',
1.164 sakharuk 1733: 'suppress_tries',
1.161 sakharuk 1734: 'default_paper_size',
1.115 www 1735: 'disable_receipt_display',
1.107 matthew 1736: 'spreadsheet_default_classcalc',
1737: 'spreadsheet_default_studentcalc',
1738: 'spreadsheet_default_assesscalc',
1739: 'hideemptyrows',
1740: 'default_enrollment_start_date',
1741: 'default_enrollment_end_date',
1.163 albertel 1742: 'tthoptions',
1743: 'disablesigfigs'
1.107 matthew 1744: );
1745: foreach my $parameter (sort(keys(%values))) {
1.142 raeburn 1746: unless ($parameter =~ m/^internal\./) {
1747: if (! $descriptions{$parameter}) {
1748: $descriptions{$parameter}=$parameter;
1749: push(@Display_Order,$parameter);
1750: }
1751: }
1.43 albertel 1752: }
1.107 matthew 1753: foreach my $parameter (@Display_Order) {
1754: my $description = $descriptions{$parameter};
1.51 matthew 1755: # onchange is javascript to automatically check the 'Set' button.
1.69 www 1756: my $onchange = 'onFocus="javascript:window.document.forms'.
1.107 matthew 1757: "['envform'].elements['".$parameter."_setparmval']".
1.51 matthew 1758: '.checked=true;"';
1.107 matthew 1759: $output .= '<tr><td>'.$description.'</td>';
1760: if ($parameter =~ /^default_enrollment_(start|end)_date$/) {
1761: $output .= '<td>'.
1762: &Apache::lonhtmlcommon::date_setter('envform',
1763: $parameter.'_value',
1764: $values{$parameter},
1765: $onchange).
1766: '</td>';
1767: } else {
1768: $output .= '<td>'.
1769: &Apache::lonhtmlcommon::textbox($parameter.'_value',
1770: $values{$parameter},
1771: 40,$onchange).'</td>';
1772: }
1773: $output .= '<td>'.
1774: &Apache::lonhtmlcommon::checkbox($parameter.'_setparmval').
1775: '</td>';
1776: $output .= "</tr>\n";
1.51 matthew 1777: }
1.69 www 1778: my $onchange = 'onFocus="javascript:window.document.forms'.
1.51 matthew 1779: '[\'envform\'].elements[\'newp_setparmval\']'.
1780: '.checked=true;"';
1.130 www 1781: $output.='<tr><td><i>'.&mt('Create New Environment Variable').'</i><br />'.
1.51 matthew 1782: '<input type="text" size=40 name="newp_name" '.
1783: $onchange.' /></td><td>'.
1784: '<input type="text" size=40 name="newp_value" '.
1785: $onchange.' /></td><td>'.
1786: '<input type="checkbox" name="newp_setparmval" /></td></tr>';
1.43 albertel 1787: }
1.157 sakharuk 1788: my %lt=&Apache::lonlocal::texthash(
1789: 'par' => 'Parameter',
1790: 'val' => 'Value',
1791: 'set' => 'Set',
1792: 'sce' => 'Set Course Environment'
1793: );
1794:
1.140 sakharuk 1795: my $Parameter=&mt('Parameter');
1796: my $Value=&mt('Value');
1.141 sakharuk 1797: my $Set=&mt('Set');
1.167 albertel 1798: my $browse_js=&Apache::loncommon::browser_and_searcher_javascript('parmset');
1.183 albertel 1799: my $html=&Apache::lonxml::xmlbegin();
1.190 albertel 1800: $r->print(<<ENDenv);
1.183 albertel 1801: $html
1802: <head>
1.46 matthew 1803: <script type="text/javascript" language="Javascript" >
1.155 albertel 1804: $browse_js
1.46 matthew 1805: </script>
1.30 www 1806: <title>LON-CAPA Course Environment</title>
1807: </head>
1.64 www 1808: $bodytag
1.193 albertel 1809: $breadcrumbs
1810: <form method="post" action="/adm/parmset?action=crsenv" name="envform">
1.30 www 1811: $setoutput
1812: <p>
1813: <table border=2>
1.157 sakharuk 1814: <tr><th>$lt{'par'}</th><th>$lt{'val'}</th><th>$lt{'set'}?</th></tr>
1.30 www 1815: $output
1816: </table>
1.157 sakharuk 1817: <input type="submit" name="crsenv" value="$lt{'sce'}">
1.30 www 1818: </form>
1819: </body>
1820: </html>
1.190 albertel 1821: ENDenv
1.30 www 1822: }
1.120 www 1823: ##################################################
1.30 www 1824:
1.124 www 1825: my $tableopen;
1826:
1827: sub tablestart {
1828: if ($tableopen) {
1829: return '';
1830: } else {
1831: $tableopen=1;
1.130 www 1832: return '<table border="2"><tr><th>'.&mt('Parameter').'</th><th>'.
1833: &mt('Delete').'</th><th>'.&mt('Set to ...').'</th></tr>';
1.124 www 1834: }
1835: }
1836:
1837: sub tableend {
1838: if ($tableopen) {
1839: $tableopen=0;
1840: return '</table>';
1841: } else {
1842: return'';
1843: }
1844: }
1845:
1.120 www 1846: sub overview {
1847: my $r=shift;
1848: my $bodytag=&Apache::loncommon::bodytag(
1849: 'Set/Modify Course Assessment Parameters');
1.190 albertel 1850: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1851: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.194 albertel 1852: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs(undef,'Overview');
1.183 albertel 1853: my $html=&Apache::lonxml::xmlbegin();
1.120 www 1854: $r->print(<<ENDOVER);
1.183 albertel 1855: $html
1.120 www 1856: <head>
1857: <title>LON-CAPA Course Environment</title>
1858: </head>
1859: $bodytag
1.193 albertel 1860: $breadcrumbs
1861: <form method="post" action="/adm/parmset?action=setoverview" name="overviewform">
1.120 www 1862: <input type="hidden" name="overview" value="1" />
1863: ENDOVER
1.124 www 1864: # Setting
1865: my %olddata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
1866: my %newdata=();
1867: undef %newdata;
1868: my @deldata=();
1869: undef @deldata;
1.190 albertel 1870: foreach (keys %env) {
1.124 www 1871: if ($_=~/^form\.([a-z]+)\_(.+)$/) {
1872: my $cmd=$1;
1873: my $thiskey=$2;
1874: if ($cmd eq 'set') {
1.190 albertel 1875: my $data=$env{$_};
1.124 www 1876: if ($olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
1877: } elsif ($cmd eq 'del') {
1878: push (@deldata,$thiskey);
1879: } elsif ($cmd eq 'datepointer') {
1.190 albertel 1880: my $data=&Apache::lonhtmlcommon::get_date_from_form($env{$_});
1.153 albertel 1881: if (defined($data) and $olddata{$thiskey} ne $data) { $newdata{$thiskey}=$data; }
1.124 www 1882: }
1883: }
1884: }
1885: # Store
1.144 www 1886: my $delentries=$#deldata+1;
1887: my @newdatakeys=keys %newdata;
1888: my $putentries=$#newdatakeys+1;
1889: if ($delentries) {
1890: if (&Apache::lonnet::del('resourcedata',\@deldata,$dom,$crs) eq 'ok') {
1891: $r->print('<h2>'.&mt('Deleted [_1] parameter(s)</h2>',$delentries));
1892: } else {
1893: $r->print('<h2><font color="red">'.
1894: &mt('Error deleting parameters').'</font></h2>');
1895: }
1896: }
1897: if ($putentries) {
1898: if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
1899: $r->print('<h2>'.&mt('Stored [_1] parameter(s)</h2>',$putentries));
1900: } else {
1901: $r->print('<h2><font color="red">'.
1902: &mt('Error storing parameters').'</font></h2>');
1903: }
1904: }
1.122 www 1905: # Read and display
1906: my %resourcedata=&Apache::lonnet::dump('resourcedata',$dom,$crs);
1907: my $oldsection='';
1908: my $oldrealm='';
1909: my $oldpart='';
1.123 www 1910: my $pointer=0;
1.124 www 1911: $tableopen=0;
1.145 www 1912: my $foundkeys=0;
1.122 www 1913: foreach my $thiskey (sort keys %resourcedata) {
1.123 www 1914: if ($resourcedata{$thiskey.'.type'}) {
1915: my ($course,$middle,$part,$name)=
1916: ($thiskey=~/^(\w+)\.(?:(.+)\.)*([\w\s]+)\.(\w+)$/);
1.130 www 1917: my $section=&mt('All Students');
1.122 www 1918: if ($middle=~/^\[(.*)\]\./) {
1.130 www 1919: $section=&mt('Group/Section').': '.$1;
1.122 www 1920: $middle=~s/^\[(.*)\]\.//;
1921: }
1.123 www 1922: $middle=~s/\.$//;
1.130 www 1923: my $realm='<font color="red">'.&mt('All Resources').'</font>';
1.122 www 1924: if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.174 albertel 1925: $realm='<font color="green">'.&mt('Folder/Map').': '.&Apache::lonnet::gettitle($1).' <br /><font color="#aaaaaa" size="-2">('.$1.')</font></font>';
1.122 www 1926: } elsif ($middle) {
1.174 albertel 1927: my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
1928: $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 1929: }
1930: if ($section ne $oldsection) {
1.124 www 1931: $r->print(&tableend()."\n<hr /><h1>$section</h1>");
1.122 www 1932: $oldsection=$section;
1933: $oldrealm='';
1934: }
1935: if ($realm ne $oldrealm) {
1.124 www 1936: $r->print(&tableend()."\n<h2>$realm</h2>");
1.122 www 1937: $oldrealm=$realm;
1938: $oldpart='';
1939: }
1940: if ($part ne $oldpart) {
1.124 www 1941: $r->print(&tableend().
1.130 www 1942: "\n<h3><font color='blue'>".&mt('Part').": $part</font></h3>");
1.122 www 1943: $oldpart=$part;
1944: }
1.123 www 1945: #
1946: # Ready to print
1947: #
1.124 www 1948: $r->print(&tablestart().'<tr><td><b>'.$name.
1949: ':</b></td><td><input type="checkbox" name="del_'.
1950: $thiskey.'" /></td><td>');
1.145 www 1951: $foundkeys++;
1.123 www 1952: if ($resourcedata{$thiskey.'.type'}=~/^date/) {
1953: my $jskey='key_'.$pointer;
1954: $pointer++;
1955: $r->print(
1956: &Apache::lonhtmlcommon::date_setter('overviewform',
1957: $jskey,
1958: $resourcedata{$thiskey}).
1959: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'
1960: );
1961: } else {
1962: $r->print(
1963: '<input type="text" name="set_'.$thiskey.'" value="'.
1964: $resourcedata{$thiskey}.'">');
1965: }
1.124 www 1966: $r->print('</td></tr>');
1.122 www 1967: }
1.121 www 1968: }
1.124 www 1969:
1.145 www 1970: $r->print(&tableend().'<p>'.
1971: ($foundkeys?'<input type="submit" value="'.&mt('Modify Parameters').'" />':&mt('There are no course or section parameters.')).'</p></form></body></html>');
1.120 www 1972: }
1.121 www 1973:
1.59 matthew 1974: ##################################################
1975: ##################################################
1.178 raeburn 1976:
1977: =pod
1978:
1979: =item change clone
1980:
1981: Modifies the list of courses a user can clone (stored
1982: in the user's environemnt.db file), called when a
1983: change is made to the list of users allowed to clone
1984: a course.
1985:
1986: Inputs: $action,$cloner
1987: where $action is add or drop, and $cloner is identity of
1988: user for whom cloning ability is to be changed in course.
1989:
1990: Returns:
1991:
1992: =cut
1993:
1994: ##################################################
1995: ##################################################
1996:
1997:
1998: sub change_clone {
1999: my ($clonelist,$oldcloner) = @_;
2000: my ($uname,$udom);
1.190 albertel 2001: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2002: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.178 raeburn 2003: my $clone_crs = $cnum.':'.$cdom;
2004:
2005: if ($cnum && $cdom) {
2006: my @allowclone = ();
2007: if ($clonelist =~ /,/) {
2008: @allowclone = split/,/,$clonelist;
2009: } else {
2010: $allowclone[0] = $clonelist;
2011: }
2012: foreach my $currclone (@allowclone) {
2013: if (!grep/^$currclone$/,@$oldcloner) {
2014: ($uname,$udom) = split/:/,$currclone;
2015: if ($uname && $udom) {
2016: unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
2017: my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
2018: if ($currclonecrs{'cloneable'} !~ /\Q$clone_crs\E/) {
2019: if ($currclonecrs{'cloneable'} eq '') {
2020: $currclonecrs{'cloneable'} = $clone_crs;
2021: } else {
2022: $currclonecrs{'cloneable'} .= ','.$clone_crs;
2023: }
2024: &Apache::lonnet::put('environment',\%currclonecrs,$udom,$uname);
2025: }
2026: }
2027: }
2028: }
2029: }
2030: foreach my $oldclone (@$oldcloner) {
2031: if (!grep/^$oldclone$/,@allowclone) {
2032: ($uname,$udom) = split/:/,$oldclone;
2033: if ($uname && $udom) {
2034: unless (&Apache::lonnet::homeserver($uname,$udom) eq 'no_host') {
2035: my %currclonecrs = &Apache::lonnet::dump('environment',$udom,$uname,'cloneable');
2036: my %newclonecrs = ();
2037: if ($currclonecrs{'cloneable'} =~ /\Q$clone_crs\E/) {
2038: if ($currclonecrs{'cloneable'} =~ /,/) {
2039: my @currclonecrs = split/,/,$currclonecrs{'cloneable'};
2040: foreach (@currclonecrs) {
2041: unless ($_ eq $clone_crs) {
2042: $newclonecrs{'cloneable'} .= $_.',';
2043: }
2044: }
2045: $newclonecrs{'cloneable'} =~ s/,$//;
2046: } else {
2047: $newclonecrs{'cloneable'} = '';
2048: }
2049: &Apache::lonnet::put('environment',\%newclonecrs,$udom,$uname);
2050: }
2051: }
2052: }
2053: }
2054: }
2055: }
2056: }
2057:
1.193 albertel 2058:
2059: ##################################################
2060: ##################################################
2061:
2062: =pod
2063:
2064: =item * header
2065:
2066: Output html header for page
2067:
2068: =cut
2069:
2070: ##################################################
2071: ##################################################
2072: sub header {
2073: my $html=&Apache::lonxml::xmlbegin();
2074: my $bodytag=&Apache::loncommon::bodytag('Parameter Manager');
2075: my $title = &mt('LON-CAPA Parameter Manager');
2076: return(<<ENDHEAD);
2077: $html
2078: <head>
2079: <title>$title</title>
2080: </head>
2081: $bodytag
2082: ENDHEAD
2083: }
2084: ##################################################
2085: ##################################################
2086: sub print_main_menu {
2087: my ($r,$parm_permission)=@_;
2088: #
2089: $r->print(<<ENDMAINFORMHEAD);
2090: <form method="post" enctype="multipart/form-data"
2091: action="/adm/parmset" name="studentform">
2092: ENDMAINFORMHEAD
2093: #
1.195 albertel 2094: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
2095: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.193 albertel 2096: my @menu =
2097: (
2098: { text => 'Set Course Environment Parameters',
2099: help => 'Course_Setting_Parameters',
2100: action => 'crsenv',
2101: permission => $parm_permission,
2102: },
2103: { text => 'Set/Modify Course Assessment Parameters - Helper Mode',
2104: url => '/adm/helper/parameter.helper',
2105: permission => $parm_permission,
2106: },
2107: { text => 'Modify Course Assessment Parameters - Overview Mode',
2108: action => 'setoverview',
2109: permission => $parm_permission,
2110: },
2111: { text => 'Set/Modify Course Assessment Parameters - Table Mode',
2112: action => 'settable',
2113: permission => $parm_permission,
2114: },
2115: # { text => 'Set Parameter Default Preferences',
2116: # help => 'Course_View_Class_List',
2117: # action => 'setdefaults',
2118: # permission => $parm_permission,
2119: # },
2120: );
2121: my $menu_html = '';
2122: foreach my $menu_item (@menu) {
2123: next if (! $menu_item->{'permission'});
2124: $menu_html.='<p>';
2125: $menu_html.='<font size="+1">';
2126: if (exists($menu_item->{'url'})) {
2127: $menu_html.=qq{<a href="$menu_item->{'url'}">};
2128: } else {
2129: $menu_html.=
2130: qq{<a href="/adm/parmset?action=$menu_item->{'action'}">};
2131: }
2132: $menu_html.= &mt($menu_item->{'text'}).'</a></font>';
2133: if (exists($menu_item->{'help'})) {
2134: $menu_html.=
2135: &Apache::loncommon::help_open_topic($menu_item->{'help'});
2136: }
2137: $menu_html.='</p>'.$/;
2138: }
2139: $r->print($menu_html);
2140: return;
2141: }
2142:
2143:
2144:
2145:
1.178 raeburn 2146: ##################################################
2147: ##################################################
1.30 www 2148:
1.59 matthew 2149: =pod
2150:
1.83 bowersj2 2151: =item * handler
1.59 matthew 2152:
2153: Main handler. Calls &assessparms and &crsenv subroutines.
2154:
2155: =cut
2156: ##################################################
2157: ##################################################
1.85 bowersj2 2158: use Data::Dumper;
1.30 www 2159: sub handler {
1.43 albertel 2160: my $r=shift;
1.30 www 2161:
1.43 albertel 2162: if ($r->header_only) {
1.126 www 2163: &Apache::loncommon::content_type($r,'text/html');
1.43 albertel 2164: $r->send_http_header;
2165: return OK;
2166: }
1.193 albertel 2167: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.194 albertel 2168: ['action','state']);
1.131 www 2169:
1.83 bowersj2 2170:
1.193 albertel 2171: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194 albertel 2172: &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
2173: text=>"Parameter Manager",
2174: faq=>9,
2175: bug=>'Instructor Interface'});
1.30 www 2176: # ----------------------------------------------------- Needs to be in a course
1.194 albertel 2177: my $parm_permission =
2178: (&Apache::lonnet::allowed('opa',$env{'request.course.id'}) ||
1.190 albertel 2179: &Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
1.193 albertel 2180: $env{'request.course.sec'}));
1.194 albertel 2181: if ($env{'request.course.id'} && $parm_permission) {
1.193 albertel 2182:
2183: # Start Page
1.126 www 2184: &Apache::loncommon::content_type($r,'text/html');
1.106 www 2185: $r->send_http_header;
1.30 www 2186:
1.193 albertel 2187: #
2188: # Main switch on form.action and form.state, as appropriate
2189: #
2190: # Check first if coming from someone else headed directly for
2191: # the table mode
2192: if ((($env{'form.command'} eq 'set') && ($env{'form.url'})
2193: && (!$env{'form.dis'})) || ($env{'form.symb'})) {
2194: &assessparms($r);
2195:
2196: } elsif (! exists($env{'form.action'})) {
2197: $r->print(&header());
1.194 albertel 2198: $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
2199: 'Parameter Manager'));
1.193 albertel 2200: &print_main_menu($r,$parm_permission);
2201: } elsif ($env{'form.action'} eq 'crsenv' && $parm_permission) {
1.194 albertel 2202: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=crsenv',
2203: text=>"Course Environment"});
2204: $r->print(&Apache::lonhtmlcommon::breadcrumbs(undef,
2205: 'Edit Course Environment'));
1.193 albertel 2206: &crsenv($r);
2207: } elsif ($env{'form.action'} eq 'setoverview' && $parm_permission) {
1.194 albertel 2208: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
2209: text=>"Overview Mode"});
1.121 www 2210: &overview($r);
1.193 albertel 2211: } elsif ($env{'form.action'} eq 'settable' && $parm_permission) {
1.194 albertel 2212: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
2213: text=>"Table Mode"});
1.121 www 2214: &assessparms($r);
1.193 albertel 2215: }
2216:
1.43 albertel 2217: } else {
1.1 www 2218: # ----------------------------- Not in a course, or not allowed to modify parms
1.190 albertel 2219: $env{'user.error.msg'}=
1.43 albertel 2220: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
2221: return HTTP_NOT_ACCEPTABLE;
2222: }
2223: return OK;
1.1 www 2224: }
2225:
2226: 1;
2227: __END__
2228:
1.59 matthew 2229: =pod
1.38 harris41 2230:
2231: =back
2232:
2233: =cut
1.1 www 2234:
2235:
2236:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>