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