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