Annotation of loncom/interface/lonparmset.pm, revision 1.578
1.1 www 1: # The LearningOnline Network with CAPA
2: # Handler to set parameters for assessments
3: #
1.578 ! raeburn 4: # $Id: lonparmset.pm,v 1.577 2017/07/13 13:57:48 raeburn 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:
1.560 damieng 39: lonparmset provides an interface to setting course parameters.
40:
41: It contains all the code for the "Content and Problem Settings" UI, except
42: for the helpers parameter.helper and resettimes.helper, and lonhelper.pm,
43: and lonblockingmenu.pm.
1.59 matthew 44:
45: =head1 DESCRIPTION
46:
47: This module sets coursewide and assessment parameters.
48:
49: =head1 INTERNAL SUBROUTINES
50:
1.416 jms 51: =over
1.59 matthew 52:
1.416 jms 53: =item parmval()
1.59 matthew 54:
55: Figure out a cascading parameter.
56:
1.71 albertel 57: Inputs: $what - a parameter spec (incluse part info and name I.E. 0.weight)
1.162 albertel 58: $id - a bighash Id number
1.71 albertel 59: $def - the resource's default value 'stupid emacs
60:
1.556 raeburn 61: Returns: A list, the first item is the index into the remaining list of items of parm values that is the active one, the list consists of parm values at the 18 possible levels
1.71 albertel 62:
1.556 raeburn 63: 18 - General Course
64: 17 - Map or Folder level in course (recursive)
65: 16 - Map or Folder level in course (non-recursive)
66: 15 - resource default
67: 14 - map default
68: 13 - resource level in course
69: 12 - General for section
70: 11 - Map or Folder level for section (recursive)
71: 10 - Map or Folder level for section (non-recursive)
72: 9 - resource level in section
73: 8 - General for group
74: 7 - Map or Folder level for group (recursive)
75: 6 - Map or Folder level for group (non-recursive)
76: 5 - resource level in group
77: 4 - General for specific student
78: 3 - Map or Folder level for specific student (recursive)
79: 2 - Map or Folder level for specific student (non-recursive)
1.71 albertel 80: 1 - resource level for specific student
1.2 www 81:
1.416 jms 82: =item parmval_by_symb()
83:
84: =item reset_caches()
85:
86: =item cacheparmhash()
87:
88: =item parmhash()
89:
90: =item symbcache()
91:
92: =item preset_defaults()
93:
94: =item date_sanity_info()
95:
96: =item storeparm()
97:
98: Store a parameter by symb
99:
100: Takes
101: - symb
102: - name of parameter
103: - level
104: - new value
105: - new type
106: - username
107: - userdomain
108:
109: =item log_parmset()
110:
111: =item storeparm_by_symb_inner()
112:
113: =item valout()
114:
115: Format a value for output.
116:
117: Inputs: $value, $type, $editable
118:
119: Returns: $value, formatted for output. If $type indicates it is a date,
120: localtime($value) is returned.
121: $editable will return an icon to click on
122:
123: =item plink()
124:
125: Produces a link anchor.
126:
127: Inputs: $type,$dis,$value,$marker,$return,$call
128:
129: Returns: scalar with html code for a link which will envoke the
130: javascript function 'pjump'.
131:
132: =item page_js()
133:
134: =item startpage()
135:
136: =item print_row()
137:
138: =item print_td()
139:
140: =item print_usergroups()
141:
142: =item parm_control_group()
143:
144: =item extractResourceInformation() :
145:
1.512 foxr 146: extractResourceInformation extracts lots of information about all of the the course's resources into a variety of hashes.
1.416 jms 147:
1.542 raeburn 148: Input: See list below
149:
150: =over 4
1.416 jms 151:
1.512 foxr 152: =item * B<env{'user.name'}> : Current username
1.416 jms 153:
1.512 foxr 154: =item * B<env{'user.domain'}> : Domain of current user.
1.416 jms 155:
1.542 raeburn 156: =item * B<env{"request.course.fn"}> : Course
157:
158: =back
1.416 jms 159:
1.512 foxr 160: Outputs: See list below:
1.416 jms 161:
1.542 raeburn 162: =over 4
163:
1.512 foxr 164: =item * B<ids> (out) : An array that will contain all of the ids in the course.
1.416 jms 165:
1.512 foxr 166: =item * B<typep>(out) : hash, id->type, where "type" contains the extension of the file, thus, I<problem exam quiz assess survey form>.
1.416 jms 167:
1.512 foxr 168: =item * B<keyp> (out) : hash, id->key list, will contain a comma separated list of the meta-data keys available for the given id
1.416 jms 169:
1.512 foxr 170: =item * B<allparms> (out) : hash, name of parameter->display value (what is the display value?)
1.416 jms 171:
1.512 foxr 172: =item * B<allparts> (out) : hash, part identification->text representation of part, where the text representation is "[Part $part]"
173:
174: =item * B<allmaps> (out) : hash, ???
1.416 jms 175:
176: =item * B<mapp> : ??
177:
178: =item * B<symbp> : hash, id->full sym?
179:
1.512 foxr 180: =item * B<maptitles>
181:
182: =item * B<uris>
1.416 jms 183:
1.512 foxr 184: =item * B<keyorder>
185:
186: =item * B<defkeytype>
1.416 jms 187:
1.542 raeburn 188: =back
189:
1.416 jms 190: =item isdateparm()
191:
192: =item parmmenu()
193:
194: =item partmenu()
195:
196: =item usermenu()
197:
198: =item displaymenu()
199:
200: =item mapmenu()
201:
202: =item levelmenu()
203:
204: =item sectionmenu()
205:
206: =item keysplit()
207:
208: =item keysinorder()
209:
210: =item keysinorder_bytype()
211:
212: =item keysindisplayorder()
213:
214: =item standardkeyorder()
215:
216: =item assessparms() :
217:
218: Show assessment data and parameters. This is a large routine that should
219: be simplified and shortened... someday.
220:
1.513 foxr 221: Inputs: $r - the Apache request object.
222:
1.416 jms 223: Returns: nothing
224:
225: Variables used (guessed by Jeremy):
226:
1.542 raeburn 227: =over
228:
1.416 jms 229: =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.
230:
231: =item * B<psprt>: ParameterS PaRTs? a list of the parts of a problem that we are displaying? Used to display only selected parts?
232:
233: =item * B<@catmarker> contains list of all possible parameters including part #s
234:
235: =item * B<$fullkeyp> contains the full part/id # for the extraction of proper parameters
236:
237: =item * B<$tempkeyp> contains part 0 only (no ids - ie, subparts)
238: When storing information, store as part 0
239: When requesting information, request from full part
240:
1.542 raeburn 241: =back
242:
1.416 jms 243: =item tablestart()
244:
245: =item tableend()
246:
247: =item extractuser()
248:
249: =item parse_listdata_key()
250:
251: =item listdata()
252:
253: =item date_interval_selector()
254:
255: =item get_date_interval_from_form()
256:
257: =item default_selector()
258:
259: =item string_selector()
260:
261: =item dateshift()
262:
263: =item newoverview()
264:
265: =item secgroup_lister()
266:
267: =item overview()
268:
269: =item clean_parameters()
270:
271: =item date_shift_one()
272:
273: =item date_shift_two()
274:
275: =item parse_key()
276:
277: =item header()
278:
279: Output html header for page
280:
281: =item print_main_menu()
282:
283: =item output_row()
284:
285: Set portfolio metadata
286:
287: =item order_meta_fields()
288:
289: =item addmetafield()
290:
291: =item setrestrictmeta()
292:
293: =item get_added_meta_fieldnames()
294:
295: =item get_deleted_meta_fieldnames()
296:
297: =item defaultsetter()
298:
299: =item components()
300:
301: =item load_parameter_names()
302:
303: =item parm_change_log()
304:
305: =item handler() :
306:
1.450 raeburn 307: Main handler. Calls &assessparms subroutine.
1.416 jms 308:
309: =back
310:
1.59 matthew 311: =cut
312:
1.416 jms 313: ###################################################################
314: ###################################################################
315:
316: package Apache::lonparmset;
317:
318: use strict;
319: use Apache::lonnet;
320: use Apache::Constants qw(:common :http REDIRECT);
321: use Apache::lonhtmlcommon();
322: use Apache::loncommon;
323: use GDBM_File;
324: use Apache::lonhomework;
325: use Apache::lonxml;
326: use Apache::lonlocal;
327: use Apache::lonnavmaps;
328: use Apache::longroup;
329: use Apache::lonrss;
1.506 www 330: use HTML::Entities;
1.416 jms 331: use LONCAPA qw(:DEFAULT :match);
332:
333:
1.560 damieng 334: ##################################################
335: # CONTENT AND PROBLEM SETTINGS HTML PAGE HEADER/FOOTER
336: ##################################################
337:
338: # Page header
1.561 damieng 339: #
340: # @param {Apache2::RequestRec} $r - Apache request object
341: # @param {string} $mode - selected tab, 'parmset' for course and problem settings, or 'coursepref' for course settings
342: # @param {string} $crstype - course type ('Community' for community settings)
1.507 www 343: sub startSettingsScreen {
1.531 raeburn 344: my ($r,$mode,$crstype)=@_;
1.507 www 345:
1.531 raeburn 346: my $tabtext = &mt('Course Settings');
347: if ($crstype eq 'Community') {
348: $tabtext = &mt('Community Settings');
349: }
1.507 www 350: $r->print("\n".'<ul class="LC_TabContentBigger" id="main">');
351: $r->print("\n".'<li'.($mode eq 'coursepref'?' class="active"':'').'><a href="/adm/courseprefs"><b> '.
1.531 raeburn 352: $tabtext.
1.507 www 353: ' </b></a></li>');
354:
1.523 raeburn 355: $r->print("\n".'<li'.($mode eq 'parmset'?' class="active"':'').' id="tabbededitor"><a href="/adm/parmset"><b>'.
1.507 www 356: &mt('Content and Problem Settings').'</b></a></li>');
357: $r->print("\n".'</ul>'."\n");
1.523 raeburn 358: $r->print('<div class="LC_Box" style="clear:both;margin:0;" id="parameditor"><div id="maincoursedoc" style="margin:0 0;padding:0 0;"><div class="LC_ContentBox" id="mainCourseDocuments" style="display: block;">');
1.507 www 359: }
360:
1.560 damieng 361: # Page footer
1.507 www 362: sub endSettingsScreen {
363: my ($r)=@_;
364: $r->print('</div></div></div>');
365: }
366:
367:
368:
1.560 damieng 369: ##################################################
1.563 damieng 370: # (mostly) TABLE MODE
1.560 damieng 371: # (parmval is also used for the log of parameter changes)
372: ##################################################
373:
1.566 damieng 374: # Calls parmval_by_symb, getting the symb from $id with &symbcache.
1.561 damieng 375: #
376: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566 damieng 377: # @param {string} $id - resource id or map pc
1.561 damieng 378: # @param {string} $def - the resource's default value for this parameter
379: # @param {string} $uname - user name
380: # @param {string} $udom - user domain
381: # @param {string} $csec - section name
382: # @param {string} $cgroup - group name
383: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
384: # @returns {Array}
1.2 www 385: sub parmval {
1.275 raeburn 386: my ($what,$id,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
387: return &parmval_by_symb($what,&symbcache($id),$def,$uname,$udom,$csec,
388: $cgroup,$courseopt);
1.201 www 389: }
390:
1.561 damieng 391: # Returns an array containing
392: # - the most specific level that is defined for that parameter (integer)
393: # - an array with the level as index and the parameter value as value (when defined)
394: # (level 1 is the most specific and will have precedence)
395: #
396: # @param {string} $what - part info and parameter name separated by a dot, e.g. '0.weight'
1.566 damieng 397: # @param {string} $symb - resource symb or map src
1.561 damieng 398: # @param {string} $def - the resource's default value for this parameter
399: # @param {string} $uname - user name
400: # @param {string} $udom - user domain
401: # @param {string} $csec - section name
402: # @param {string} $cgroup - group name
403: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
404: # @returns {Array}
1.201 www 405: sub parmval_by_symb {
1.275 raeburn 406: my ($what,$symb,$def,$uname,$udom,$csec,$cgroup,$courseopt)=@_;
1.200 www 407:
1.352 albertel 408: my $useropt;
409: if ($uname ne '' && $udom ne '') {
1.561 damieng 410: $useropt = &Apache::lonnet::get_userresdata($uname,$udom);
1.352 albertel 411: }
1.200 www 412:
1.8 www 413: my $result='';
1.44 albertel 414: my @outpar=();
1.2 www 415: # ----------------------------------------------------- Cascading lookup scheme
1.446 bisitz 416: my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305 albertel 417: $map = &Apache::lonnet::deversion($map);
1.561 damieng 418:
419: # NOTE: some of that code looks redondant with code in lonnavmaps::parmval_real,
420: # any change should be reflected there.
421:
1.201 www 422: my $symbparm=$symb.'.'.$what;
1.556 raeburn 423: my $recurseparm=$map.'___(rec).'.$what;
1.201 www 424: my $mapparm=$map.'___(all).'.$what;
1.10 www 425:
1.269 raeburn 426: my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$what;
427: my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556 raeburn 428: my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269 raeburn 429: my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
430:
1.190 albertel 431: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$what;
432: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556 raeburn 433: my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190 albertel 434: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
435:
436: my $courselevel=$env{'request.course.id'}.'.'.$what;
437: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556 raeburn 438: my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190 albertel 439: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.2 www 440:
1.11 www 441:
1.182 albertel 442: # --------------------------------------------------------- first, check course
1.11 www 443:
1.561 damieng 444: # 18 - General Course
1.200 www 445: if (defined($$courseopt{$courselevel})) {
1.556 raeburn 446: $outpar[18]=$$courseopt{$courselevel};
447: $result=18;
448: }
449:
1.561 damieng 450: # 17 - Map or Folder level in course (recursive)
1.556 raeburn 451: if (defined($$courseopt{$courseleveli})) {
452: $outpar[17]=$$courseopt{$courseleveli};
453: $result=17;
1.43 albertel 454: }
1.11 www 455:
1.561 damieng 456: # 16 - Map or Folder level in course (non-recursive)
1.200 www 457: if (defined($$courseopt{$courselevelm})) {
1.556 raeburn 458: $outpar[16]=$$courseopt{$courselevelm};
459: $result=16;
1.43 albertel 460: }
1.11 www 461:
1.182 albertel 462: # ------------------------------------------------------- second, check default
463:
1.561 damieng 464: # 15 - resource default
1.556 raeburn 465: if (defined($def)) { $outpar[15]=$def; $result=15; }
1.182 albertel 466:
467: # ------------------------------------------------------ third, check map parms
468:
1.556 raeburn 469:
1.561 damieng 470: # 14 - map default
1.376 albertel 471: my $thisparm=&parmhash($symbparm);
1.556 raeburn 472: if (defined($thisparm)) { $outpar[14]=$thisparm; $result=14; }
1.182 albertel 473:
1.561 damieng 474: # 13 - resource level in course
1.200 www 475: if (defined($$courseopt{$courselevelr})) {
1.556 raeburn 476: $outpar[13]=$$courseopt{$courselevelr};
477: $result=13;
1.43 albertel 478: }
1.11 www 479:
1.182 albertel 480: # ------------------------------------------------------ fourth, back to course
1.352 albertel 481: if ($csec ne '') {
1.561 damieng 482: # 12 - General for section
1.200 www 483: if (defined($$courseopt{$seclevel})) {
1.556 raeburn 484: $outpar[12]=$$courseopt{$seclevel};
485: $result=12;
486: }
1.561 damieng 487: # 11 - Map or Folder level for section (recursive)
1.556 raeburn 488: if (defined($$courseopt{$secleveli})) {
489: $outpar[11]=$$courseopt{$secleveli};
490: $result=11;
491: }
1.561 damieng 492: # 10 - Map or Folder level for section (non-recursive)
1.200 www 493: if (defined($$courseopt{$seclevelm})) {
1.556 raeburn 494: $outpar[10]=$$courseopt{$seclevelm};
495: $result=10;
496: }
1.561 damieng 497: # 9 - resource level in section
1.200 www 498: if (defined($$courseopt{$seclevelr})) {
1.556 raeburn 499: $outpar[9]=$$courseopt{$seclevelr};
500: $result=9;
501: }
1.43 albertel 502: }
1.275 raeburn 503: # ------------------------------------------------------ fifth, check course group
1.352 albertel 504: if ($cgroup ne '') {
1.561 damieng 505: # 8 - General for group
1.269 raeburn 506: if (defined($$courseopt{$grplevel})) {
1.556 raeburn 507: $outpar[8]=$$courseopt{$grplevel};
508: $result=8;
509: }
1.561 damieng 510: # 7 - Map or Folder level for group (recursive)
1.556 raeburn 511: if (defined($$courseopt{$grpleveli})) {
512: $outpar[7]=$$courseopt{$grpleveli};
513: $result=7;
1.269 raeburn 514: }
1.561 damieng 515: # 6 - Map or Folder level for group (non-recursive)
1.269 raeburn 516: if (defined($$courseopt{$grplevelm})) {
1.556 raeburn 517: $outpar[6]=$$courseopt{$grplevelm};
518: $result=6;
1.269 raeburn 519: }
1.561 damieng 520: # 5 - resource level in group
1.269 raeburn 521: if (defined($$courseopt{$grplevelr})) {
1.556 raeburn 522: $outpar[5]=$$courseopt{$grplevelr};
523: $result=5;
1.269 raeburn 524: }
525: }
1.11 www 526:
1.556 raeburn 527: # ---------------------------------------------------------- sixth, check user
1.11 www 528:
1.352 albertel 529: if ($uname ne '') {
1.561 damieng 530: # 4 - General for specific student
531: if (defined($$useropt{$courselevel})) {
532: $outpar[4]=$$useropt{$courselevel};
533: $result=4;
534: }
1.556 raeburn 535:
1.561 damieng 536: # 3 - Map or Folder level for specific student (recursive)
537: if (defined($$useropt{$courseleveli})) {
538: $outpar[3]=$$useropt{$courseleveli};
539: $result=3;
540: }
1.473 amueller 541:
1.561 damieng 542: # 2 - Map or Folder level for specific student (non-recursive)
543: if (defined($$useropt{$courselevelm})) {
544: $outpar[2]=$$useropt{$courselevelm};
545: $result=2;
546: }
1.473 amueller 547:
1.561 damieng 548: # 1 - resource level for specific student
549: if (defined($$useropt{$courselevelr})) {
550: $outpar[1]=$$useropt{$courselevelr};
551: $result=1;
552: }
1.43 albertel 553: }
1.44 albertel 554: return ($result,@outpar);
1.2 www 555: }
556:
1.198 www 557:
558:
1.376 albertel 559: # --- Caches local to lonparmset
560:
1.446 bisitz 561:
1.561 damieng 562: # Reset lonparmset caches (called at the beginning and end of the handler).
1.376 albertel 563: sub reset_caches {
564: &resetparmhash();
565: &resetsymbcache();
566: &resetrulescache();
1.203 www 567: }
568:
1.561 damieng 569: # cache for map parameters, stored temporarily in $env{'request.course.fn'}_parms.db
570: # (these parameters come from param elements in .sequence files created with the advanced RAT)
1.376 albertel 571: {
1.561 damieng 572: my $parmhashid; # course identifier, to initialize the cache only once for a course
573: my %parmhash; # the parameter cache
574: # reset map parameter hash
1.376 albertel 575: sub resetparmhash {
1.560 damieng 576: undef($parmhashid);
577: undef(%parmhash);
1.376 albertel 578: }
1.446 bisitz 579:
1.561 damieng 580: # dump the _parms.db database into %parmhash
1.376 albertel 581: sub cacheparmhash {
1.560 damieng 582: if ($parmhashid eq $env{'request.course.fn'}) { return; }
583: my %parmhashfile;
584: if (tie(%parmhashfile,'GDBM_File',
585: $env{'request.course.fn'}.'_parms.db',&GDBM_READER(),0640)) {
586: %parmhash=%parmhashfile;
587: untie(%parmhashfile);
588: $parmhashid=$env{'request.course.fn'};
589: }
1.201 www 590: }
1.446 bisitz 591:
1.561 damieng 592: # returns a parameter value for an identifier symb.parts.parameter, using the map parameter cache
1.376 albertel 593: sub parmhash {
1.560 damieng 594: my ($id) = @_;
595: &cacheparmhash();
596: return $parmhash{$id};
1.376 albertel 597: }
1.560 damieng 598: }
1.376 albertel 599:
1.566 damieng 600: # cache resource id or map pc -> resource symb or map src, using lonnavmaps to find association
1.446 bisitz 601: {
1.561 damieng 602: my $symbsid; # course identifier, to initialize the cache only once for a course
603: my %symbs; # hash id->symb
604: # reset the id->symb cache
1.376 albertel 605: sub resetsymbcache {
1.560 damieng 606: undef($symbsid);
607: undef(%symbs);
1.376 albertel 608: }
1.446 bisitz 609:
1.566 damieng 610: # returns the resource symb or map src corresponding to a resource id or map pc
611: # (using lonnavmaps and a cache)
1.376 albertel 612: sub symbcache {
1.560 damieng 613: my $id=shift;
614: if ($symbsid ne $env{'request.course.id'}) {
615: undef(%symbs);
616: }
617: if (!$symbs{$id}) {
618: my $navmap = Apache::lonnavmaps::navmap->new();
619: if ($id=~/\./) {
620: my $resource=$navmap->getById($id);
621: $symbs{$id}=$resource->symb();
622: } else {
623: my $resource=$navmap->getByMapPc($id);
624: $symbs{$id}=&Apache::lonnet::declutter($resource->src());
625: }
626: $symbsid=$env{'request.course.id'};
1.473 amueller 627: }
1.560 damieng 628: return $symbs{$id};
1.473 amueller 629: }
1.560 damieng 630: }
1.201 www 631:
1.561 damieng 632: # cache for parameter default actions (stored in parmdefactions.db)
1.446 bisitz 633: {
1.561 damieng 634: my $rulesid; # course identifier, to initialize the cache only once for a course
635: my %rules; # parameter default actions hash
1.376 albertel 636: sub resetrulescache {
1.560 damieng 637: undef($rulesid);
638: undef(%rules);
1.376 albertel 639: }
1.446 bisitz 640:
1.561 damieng 641: # returns the value for a given key in the parameter default action hash
1.376 albertel 642: sub rulescache {
1.560 damieng 643: my $id=shift;
644: if ($rulesid ne $env{'request.course.id'}
645: && !defined($rules{$id})) {
646: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
647: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
648: %rules=&Apache::lonnet::dump('parmdefactions',$dom,$crs);
649: $rulesid=$env{'request.course.id'};
650: }
651: return $rules{$id};
1.221 www 652: }
653: }
654:
1.416 jms 655:
1.561 damieng 656: # Returns the values of the parameter type default action
657: # "default value when manually setting".
658: # If none is defined, ('','','','','') is returned.
659: #
660: # @param {string} $type - parameter type
661: # @returns {Array<string>} - (hours, min, sec, value)
1.229 www 662: sub preset_defaults {
663: my $type=shift;
664: if (&rulescache($type.'_action') eq 'default') {
1.560 damieng 665: # yes, there is something
666: return (&rulescache($type.'_hours'),
667: &rulescache($type.'_min'),
668: &rulescache($type.'_sec'),
669: &rulescache($type.'_value'));
1.229 www 670: } else {
1.560 damieng 671: # nothing there or something else
672: return ('','','','','');
1.229 www 673: }
674: }
675:
1.416 jms 676:
1.561 damieng 677: # Checks that a date is after enrollment start date and before
678: # enrollment end date.
679: # Returns HTML with a warning if it is not, or the empty string otherwise.
680: # This is used by both overview and table modes.
681: #
682: # @param {integer} $checkdate - the date to check.
683: # @returns {string} - HTML possibly containing a localized warning message.
1.277 www 684: sub date_sanity_info {
685: my $checkdate=shift;
686: unless ($checkdate) { return ''; }
687: my $result='';
688: my $crsprefix='course.'.$env{'request.course.id'}.'.';
689: if ($env{$crsprefix.'default_enrollment_end_date'}) {
690: if ($checkdate>$env{$crsprefix.'default_enrollment_end_date'}) {
1.413 bisitz 691: $result.='<div class="LC_warning">'
692: .&mt('After course enrollment end!')
693: .'</div>';
1.277 www 694: }
695: }
696: if ($env{$crsprefix.'default_enrollment_start_date'}) {
697: if ($checkdate<$env{$crsprefix.'default_enrollment_start_date'}) {
1.413 bisitz 698: $result.='<div class="LC_warning">'
699: .&mt('Before course enrollment start!')
700: .'</div>';
1.277 www 701: }
702: }
1.413 bisitz 703: # Preparation for additional warnings about dates in the past/future.
704: # An improved, more context sensitive version is recommended,
705: # e.g. warn for due and answer dates which are defined before the corresponding open date, etc.
706: # if ($checkdate<time) {
707: # $result.='<div class="LC_info">'
708: # .'('.&mt('in the past').')'
709: # .'</div>';
710: # }
711: # if ($checkdate>time) {
712: # $result.='<div class="LC_info">'
713: # .'('.&mt('in the future').')'
714: # .'</div>';
715: # }
1.277 www 716: return $result;
717: }
1.561 damieng 718:
719:
720: # Store a parameter value and type by ID, also triggering more parameter changes based on parameter default actions.
1.186 www 721: #
1.566 damieng 722: # @param {string} $sresid - resource id or map pc
1.565 damieng 723: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561 damieng 724: # @param {integer} $snum - level
725: # @param {string} $nval - new value
726: # @param {string} $ntype - new type
727: # @param {string} $uname - username
728: # @param {string} $udom - userdomain
729: # @param {string} $csec - section name
730: # @param {string} $cgroup - group name
1.186 www 731: sub storeparm {
1.269 raeburn 732: my ($sresid,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.275 raeburn 733: &storeparm_by_symb(&symbcache($sresid),$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,'',$cgroup);
1.197 www 734: }
735:
1.561 damieng 736: my %recstack; # hash parameter name -> 1 when a parameter was used before in a recursive call to storeparm_by_symb
737:
738: # Store a parameter value and type by symb, also triggering more parameter changes based on parameter default actions.
739: # Uses storeparm_by_symb_inner to actually store the parameter, ignoring any returned error.
740: #
1.566 damieng 741: # @param {string} $symb - resource symb or map src
1.565 damieng 742: # @param {string} $spnam - part info and parameter name separated by a dot or underscore, e.g. '0.weight'
1.561 damieng 743: # @param {integer} $snum - level
744: # @param {string} $nval - new value
745: # @param {string} $ntype - new type
746: # @param {string} $uname - username
747: # @param {string} $udom - userdomain
748: # @param {string} $csec - section name
749: # @param {boolean} $recflag - should be true for recursive calls to storeparm_by_symb, false otherwise
750: # @param {string} $cgroup - group name
1.197 www 751: sub storeparm_by_symb {
1.275 raeburn 752: my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$recflag,$cgroup)=@_;
1.226 www 753: unless ($recflag) {
1.560 damieng 754: # first time call
755: %recstack=();
756: $recflag=1;
1.226 www 757: }
1.560 damieng 758: # store parameter
1.226 www 759: &storeparm_by_symb_inner
1.473 amueller 760: ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup);
1.560 damieng 761: # don't do anything if parameter was reset
1.266 www 762: unless ($nval) { return; }
1.226 www 763: my ($prefix,$parm)=($spnam=~/^(.*[\_\.])([^\_\.]+)$/);
1.560 damieng 764: # remember that this was set
1.226 www 765: $recstack{$parm}=1;
1.560 damieng 766: # what does this trigger?
1.226 www 767: foreach my $triggered (split(/\:/,&rulescache($parm.'_triggers'))) {
1.560 damieng 768: # don't backfire
769: unless ((!$triggered) || ($recstack{$triggered})) {
770: my $action=&rulescache($triggered.'_action');
771: my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
772: # set triggered parameter on same level
773: my $newspnam=$prefix.$triggered;
774: my $newvalue='';
775: my $active=1;
776: if ($action=~/^when\_setting/) {
777: # are there restrictions?
778: if (&rulescache($triggered.'_triggervalue')=~/\w/) {
779: $active=0;
1.565 damieng 780: foreach my $possiblevalue (split(/\s*\,\s*/,&rulescache($triggered.'_triggervalue'))) {
1.560 damieng 781: if (lc($possiblevalue) eq lc($nval)) { $active=1; }
782: }
783: }
784: $newvalue=&rulescache($triggered.'_value');
785: } else {
786: my $totalsecs=((&rulescache($triggered.'_days')*24+&rulescache($triggered.'_hours'))*60+&rulescache($triggered.'_min'))*60+&rulescache($triggered.'_sec');
787: if ($action=~/^later\_than/) {
788: $newvalue=$nval+$totalsecs;
789: } else {
790: $newvalue=$nval-$totalsecs;
791: }
792: }
793: if ($active) {
794: &storeparm_by_symb($symb,$newspnam,$snum,$newvalue,&rulescache($triggered.'_type'),
795: $uname,$udom,$csec,$recflag,$cgroup);
796: }
797: }
1.226 www 798: }
799: return '';
800: }
801:
1.561 damieng 802: # Adds all given arguments to the course parameter log.
803: # @returns {string} - the answer to the lonnet query.
1.293 www 804: sub log_parmset {
1.525 raeburn 805: return &Apache::lonnet::write_log('course','parameterlog',@_);
1.284 www 806: }
807:
1.561 damieng 808: # Store a parameter value and type by symb, without using the parameter default actions.
809: # Expire related sheets.
810: #
1.566 damieng 811: # @param {string} $symb - resource symb or map src
1.561 damieng 812: # @param {string} $spnam - part info and parameter name separated by a dot, e.g. '0.weight'
813: # @param {integer} $snum - level
814: # @param {string} $nval - new value
815: # @param {string} $ntype - new type
816: # @param {string} $uname - username
817: # @param {string} $udom - userdomain
818: # @param {string} $csec - section name
819: # @param {string} $cgroup - group name
820: # @returns {string} - HTML code with an error message if the parameter could not be stored.
1.226 www 821: sub storeparm_by_symb_inner {
1.197 www 822: # ---------------------------------------------------------- Get symb, map, etc
1.269 raeburn 823: my ($symb,$spnam,$snum,$nval,$ntype,$uname,$udom,$csec,$cgroup)=@_;
1.197 www 824: # ---------------------------------------------------------- Construct prefixes
1.186 www 825: $spnam=~s/\_([^\_]+)$/\.$1/;
1.446 bisitz 826: my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.305 albertel 827: $map = &Apache::lonnet::deversion($map);
828:
1.197 www 829: my $symbparm=$symb.'.'.$spnam;
1.556 raeburn 830: my $recurseparm=$map.'___(rec).'.$spnam;
1.197 www 831: my $mapparm=$map.'___(all).'.$spnam;
832:
1.269 raeburn 833: my $grplevel=$env{'request.course.id'}.'.['.$cgroup.'].'.$spnam;
834: my $grplevelr=$env{'request.course.id'}.'.['.$cgroup.'].'.$symbparm;
1.556 raeburn 835: my $grpleveli=$env{'request.course.id'}.'.['.$cgroup.'].'.$recurseparm;
1.269 raeburn 836: my $grplevelm=$env{'request.course.id'}.'.['.$cgroup.'].'.$mapparm;
837:
1.190 albertel 838: my $seclevel=$env{'request.course.id'}.'.['.$csec.'].'.$spnam;
839: my $seclevelr=$env{'request.course.id'}.'.['.$csec.'].'.$symbparm;
1.556 raeburn 840: my $secleveli=$env{'request.course.id'}.'.['.$csec.'].'.$recurseparm;
1.190 albertel 841: my $seclevelm=$env{'request.course.id'}.'.['.$csec.'].'.$mapparm;
1.446 bisitz 842:
1.190 albertel 843: my $courselevel=$env{'request.course.id'}.'.'.$spnam;
844: my $courselevelr=$env{'request.course.id'}.'.'.$symbparm;
1.556 raeburn 845: my $courseleveli=$env{'request.course.id'}.'.'.$recurseparm;
1.190 albertel 846: my $courselevelm=$env{'request.course.id'}.'.'.$mapparm;
1.446 bisitz 847:
1.186 www 848: my $storeunder='';
1.578 ! raeburn 849: my $possreplace='';
1.556 raeburn 850: if (($snum==18) || ($snum==4)) { $storeunder=$courselevel; }
1.578 ! raeburn 851: if (($snum==17) || ($snum==3)) {
! 852: $storeunder=$courseleveli;
! 853: $possreplace=$courselevelm;
! 854: }
! 855: if (($snum==16) || ($snum==2)) {
! 856: $storeunder=$courselevelm;
! 857: $possreplace=$courseleveli;
! 858: }
1.556 raeburn 859: if (($snum==13) || ($snum==1)) { $storeunder=$courselevelr; }
860: if ($snum==12) { $storeunder=$seclevel; }
1.578 ! raeburn 861: if ($snum==11) {
! 862: $storeunder=$secleveli;
! 863: $possreplace=$seclevelm;
! 864: }
! 865: if ($snum==10) {
! 866: $storeunder=$seclevelm;
! 867: $possreplace=$secleveli;
! 868: }
1.556 raeburn 869: if ($snum==9) { $storeunder=$seclevelr; }
870: if ($snum==8) { $storeunder=$grplevel; }
1.578 ! raeburn 871: if ($snum==7) {
! 872: $storeunder=$grpleveli;
! 873: $possreplace=$grplevelm;
! 874: }
! 875: if ($snum==6) {
! 876: $storeunder=$grplevelm;
! 877: $possreplace=$grpleveli;
! 878: }
1.556 raeburn 879: if ($snum==5) { $storeunder=$grplevelr; }
1.269 raeburn 880:
1.446 bisitz 881:
1.186 www 882: my $delete;
883: if ($nval eq '') { $delete=1;}
884: my %storecontent = ($storeunder => $nval,
1.473 amueller 885: $storeunder.'.type' => $ntype);
1.186 www 886: my $reply='';
1.560 damieng 887:
1.556 raeburn 888: if ($snum>4) {
1.186 www 889: # ---------------------------------------------------------------- Store Course
890: #
1.560 damieng 891: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
892: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
893: # Expire sheets
894: &Apache::lonnet::expirespread('','','studentcalc');
895: if (($snum==13) || ($snum==9) || ($snum==5)) {
896: &Apache::lonnet::expirespread('','','assesscalc',$symb);
1.578 ! raeburn 897: } elsif (($snum==17) || ($snum==16) || ($snum==11) || ($snum==10) || ($snum==7) || ($snum==6)) {
1.560 damieng 898: &Apache::lonnet::expirespread('','','assesscalc',$map);
899: } else {
900: &Apache::lonnet::expirespread('','','assesscalc');
901: }
902: # Store parameter
903: if ($delete) {
904: $reply=&Apache::lonnet::del
905: ('resourcedata',[keys(%storecontent)],$cdom,$cnum);
906: &log_parmset(\%storecontent,1);
907: } else {
908: $reply=&Apache::lonnet::cput
909: ('resourcedata',\%storecontent,$cdom,$cnum);
910: &log_parmset(\%storecontent);
1.578 ! raeburn 911: if ($possreplace) {
! 912: my $resdata = &Apache::lonnet::get_courseresdata($cnum,$cdom);
! 913: if (ref($resdata) eq 'HASH') {
! 914: if (exists($resdata->{$possreplace})) {
! 915: if (&Apache::lonnet::del
! 916: ('resourcedata',[$possreplace,$possreplace.'.type'],$cdom,$cnum) eq 'ok') {
! 917: &log_parmset({$possreplace => '', $possreplace.'.type' => $ntype},1);
! 918: }
! 919: }
! 920: }
! 921: }
1.560 damieng 922: }
923: &Apache::lonnet::devalidatecourseresdata($cnum,$cdom);
1.186 www 924: } else {
925: # ------------------------------------------------------------------ Store User
926: #
1.560 damieng 927: # Expire sheets
928: &Apache::lonnet::expirespread($uname,$udom,'studentcalc');
929: if ($snum==1) {
930: &Apache::lonnet::expirespread
931: ($uname,$udom,'assesscalc',$symb);
1.578 ! raeburn 932: } elsif (($snum==2) || ($snum==3)) {
1.560 damieng 933: &Apache::lonnet::expirespread
934: ($uname,$udom,'assesscalc',$map);
935: } else {
936: &Apache::lonnet::expirespread($uname,$udom,'assesscalc');
937: }
938: # Store parameter
939: if ($delete) {
940: $reply=&Apache::lonnet::del
941: ('resourcedata',[keys(%storecontent)],$udom,$uname);
942: &log_parmset(\%storecontent,1,$uname,$udom);
943: } else {
944: $reply=&Apache::lonnet::cput
945: ('resourcedata',\%storecontent,$udom,$uname);
946: &log_parmset(\%storecontent,0,$uname,$udom);
1.578 ! raeburn 947: if ($possreplace) {
! 948: my $resdata = &Apache::lonnet::get_userresdata($uname,$udom);
! 949: if (ref($resdata) eq 'HASH') {
! 950: if (exists($resdata->{$possreplace})) {
! 951: if (&Apache::lonnet::del
! 952: ('resourcedata',[$possreplace,$possreplace.'.type'],$udom,$uname) eq 'ok') {
! 953: &log_parmset({$possreplace => '',$possreplace.'.type' => $ntype},1,
! 954: $uname,$udom);
! 955: }
! 956: }
! 957: }
! 958: }
1.560 damieng 959: }
960: &Apache::lonnet::devalidateuserresdata($uname,$udom);
1.186 www 961: }
1.446 bisitz 962:
1.186 www 963: if ($reply=~/^error\:(.*)/) {
1.560 damieng 964: return "<span class=\"LC_error\">Write Error: $1</span>";
1.186 www 965: }
966: return '';
967: }
968:
1.9 www 969:
1.561 damieng 970: # Returns HTML with the value of the given parameter,
971: # using a readable format for dates, and
972: # a warning if there is a problem with a date.
973: # Used by table mode.
974: # Returns HTML for the editmap.png image if no value is defined and $editable is true.
975: #
976: # @param {string} $value - the parameter value
977: # @param {string} $type - the parameter type
978: # @param {string} $name - the parameter name (unused)
979: # @param {boolean} $editable - Set to true to get an icon when no value is defined.
1.9 www 980: sub valout {
1.554 raeburn 981: my ($value,$type,$name,$editable)=@_;
1.59 matthew 982: my $result = '';
983: # Values of zero are valid.
984: if (! $value && $value ne '0') {
1.528 bisitz 985: if ($editable) {
986: $result =
987: '<img src="/res/adm/pages/editmap.png"'
988: .' alt="'.&mt('Change').'"'
1.539 raeburn 989: .' title="'.&mt('Change').'" style="border:0;" />';
1.528 bisitz 990: } else {
991: $result=' ';
992: }
1.59 matthew 993: } else {
1.66 www 994: if ($type eq 'date_interval') {
1.559 raeburn 995: my ($totalsecs,$donesuffix) = split(/_/,$value,2);
996: my ($usesdone,$donebuttontext,$proctor,$secretkey);
997: if ($donesuffix =~ /^done\:([^\:]+)\:(.*)$/) {
998: $donebuttontext = $1;
999: (undef,$proctor,$secretkey) = split(/_/,$2);
1000: $usesdone = 'done';
1001: } elsif ($donesuffix =~ /^done(|_.+)$/) {
1002: $donebuttontext = &mt('Done');
1003: ($usesdone,$proctor,$secretkey) = split(/_/,$donesuffix);
1004: }
1.554 raeburn 1005: my ($sec,$min,$hour,$mday,$mon,$year)=gmtime($totalsecs);
1.413 bisitz 1006: my @timer;
1.66 www 1007: $year=$year-70;
1008: $mday--;
1009: if ($year) {
1.413 bisitz 1010: # $result.=&mt('[quant,_1,yr]',$year).' ';
1011: push(@timer,&mt('[quant,_1,yr]',$year));
1.66 www 1012: }
1013: if ($mon) {
1.413 bisitz 1014: # $result.=&mt('[quant,_1,mth]',$mon).' ';
1015: push(@timer,&mt('[quant,_1,mth]',$mon));
1.66 www 1016: }
1017: if ($mday) {
1.413 bisitz 1018: # $result.=&mt('[quant,_1,day]',$mday).' ';
1019: push(@timer,&mt('[quant,_1,day]',$mday));
1.66 www 1020: }
1021: if ($hour) {
1.413 bisitz 1022: # $result.=&mt('[quant,_1,hr]',$hour).' ';
1023: push(@timer,&mt('[quant,_1,hr]',$hour));
1.66 www 1024: }
1025: if ($min) {
1.413 bisitz 1026: # $result.=&mt('[quant,_1,min]',$min).' ';
1027: push(@timer,&mt('[quant,_1,min]',$min));
1.66 www 1028: }
1029: if ($sec) {
1.413 bisitz 1030: # $result.=&mt('[quant,_1,sec]',$sec).' ';
1031: push(@timer,&mt('[quant,_1,sec]',$sec));
1.66 www 1032: }
1.413 bisitz 1033: # $result=~s/\s+$//;
1034: if (!@timer) { # Special case: all entries 0 -> display "0 secs" intead of empty field to keep this field editable
1035: push(@timer,&mt('[quant,_1,sec]',0));
1036: }
1037: $result.=join(", ",@timer);
1.559 raeburn 1038: if ($usesdone eq 'done') {
1.558 raeburn 1039: if ($secretkey) {
1.559 raeburn 1040: $result .= ' '.&mt('+ "[_1]" with proctor key: [_2]',$donebuttontext,$secretkey);
1.558 raeburn 1041: } else {
1.559 raeburn 1042: $result .= ' + "'.$donebuttontext.'"';
1043: }
1.554 raeburn 1044: }
1.213 www 1045: } elsif (&isdateparm($type)) {
1.361 albertel 1046: $result = &Apache::lonlocal::locallocaltime($value).
1.560 damieng 1047: &date_sanity_info($value);
1.59 matthew 1048: } else {
1049: $result = $value;
1.517 www 1050: $result=~s/\,/\, /gs;
1.560 damieng 1051: $result = &HTML::Entities::encode($result,'"<>&');
1.59 matthew 1052: }
1053: }
1054: return $result;
1.9 www 1055: }
1056:
1.59 matthew 1057:
1.561 damieng 1058: # Returns HTML containing a link on a parameter value, for table mode.
1059: # The link uses the javascript function 'pjump'.
1060: #
1061: # @param {string} $type - parameter type
1062: # @param {string} $dis - dialog title for editing the parameter value and type
1063: # @param {string} $value - parameter value
1064: # @param {string} $marker - identifier for the parameter, "resource id&part_parameter name&level", will be passed as pres_marker when the user submits a change.
1065: # @param {string} $return - prefix for the name of the form and field names that will be used to submit the form ('parmform.pres')
1066: # @param {string} $call - javascript function to call to submit the form ('psub')
1.578 ! raeburn 1067: # @param {boolean} $recursive - true if link is for a map/folder where parameter is currently set to be recursive.
1.5 www 1068: sub plink {
1.578 ! raeburn 1069: my ($type,$dis,$value,$marker,$return,$call,$recursive)=@_;
1.23 www 1070: my $winvalue=$value;
1071: unless ($winvalue) {
1.560 damieng 1072: if (&isdateparm($type)) {
1.190 albertel 1073: $winvalue=$env{'form.recent_'.$type};
1.23 www 1074: } else {
1.190 albertel 1075: $winvalue=$env{'form.recent_'.(split(/\_/,$type))[0]};
1.23 www 1076: }
1077: }
1.229 www 1078: my ($parmname)=((split(/\&/,$marker))[1]=~/\_([^\_]+)$/);
1079: my ($hour,$min,$sec,$val)=&preset_defaults($parmname);
1080: unless (defined($winvalue)) { $winvalue=$val; }
1.554 raeburn 1081: my $valout = &valout($value,$type,$parmname,1);
1.429 raeburn 1082: my $unencmarker = $marker;
1.378 albertel 1083: foreach my $item (\$type, \$dis, \$winvalue, \$marker, \$return, \$call,
1.473 amueller 1084: \$hour, \$min, \$sec) {
1.560 damieng 1085: $$item = &HTML::Entities::encode($$item,'"<>&');
1086: $$item =~ s/\'/\\\'/g;
1.378 albertel 1087: }
1.429 raeburn 1088: return '<table width="100%"><tr valign="top" align="right"><td><a name="'.$unencmarker.'" /></td></tr><tr><td align="center">'.
1.473 amueller 1089: '<a href="javascript:pjump('."'".$type."','".$dis."','".$winvalue."','"
1090: .$marker."','".$return."','".$call."','".$hour."','".$min."','".$sec."'".');">'.
1.578 ! raeburn 1091: $valout.'</a></td></tr>'.($recursive?'<tr><td align="center" class="LC_parm_recursive">'.
! 1092: &mt('recursive').'</td></tr>' : '').'</table>';
! 1093:
1.5 www 1094: }
1095:
1.561 damieng 1096: # Javascript for table mode.
1.280 albertel 1097: sub page_js {
1098:
1.81 www 1099: my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.88 matthew 1100: my $pjump_def = &Apache::lonhtmlcommon::pjump_javascript_definition();
1.280 albertel 1101:
1102: return(<<ENDJS);
1103: <script type="text/javascript">
1.454 bisitz 1104: // <![CDATA[
1.44 albertel 1105:
1.88 matthew 1106: $pjump_def
1.44 albertel 1107:
1108: function psub() {
1109: if (document.parmform.pres_marker.value!='') {
1110: document.parmform.action+='#'+document.parmform.pres_marker.value;
1111: var typedef=new Array();
1112: typedef=document.parmform.pres_type.value.split('_');
1.562 damieng 1113: if (document.parmform.pres_type.value!='') {
1114: if (typedef[0]=='date') {
1115: eval('document.parmform.recent_'+
1116: document.parmform.pres_type.value+
1117: '.value=document.parmform.pres_value.value;');
1118: } else {
1119: eval('document.parmform.recent_'+typedef[0]+
1120: '.value=document.parmform.pres_value.value;');
1121: }
1.44 albertel 1122: }
1123: document.parmform.submit();
1124: } else {
1125: document.parmform.pres_value.value='';
1126: document.parmform.pres_marker.value='';
1127: }
1128: }
1129:
1.57 albertel 1130: function openWindow(url, wdwName, w, h, toolbar,scrollbar) {
1131: var options = "width=" + w + ",height=" + h + ",";
1132: options += "resizable=yes,scrollbars="+scrollbar+",status=no,";
1133: options += "menubar=no,toolbar="+toolbar+",location=no,directories=no";
1134: var newWin = window.open(url, wdwName, options);
1135: newWin.focus();
1136: }
1.523 raeburn 1137:
1.454 bisitz 1138: // ]]>
1.523 raeburn 1139:
1.44 albertel 1140: </script>
1.81 www 1141: $selscript
1.280 albertel 1142: ENDJS
1143:
1144: }
1.507 www 1145:
1.561 damieng 1146: # Javascript to show or hide the map selection (function showHide_courseContent),
1147: # for table and overview modes.
1.523 raeburn 1148: sub showhide_js {
1149: return <<"COURSECONTENTSCRIPT";
1150:
1151: function showHide_courseContent() {
1152: var parmlevValue=document.getElementById("parmlev").value;
1153: if (parmlevValue == 'general') {
1154: document.getElementById('mapmenu').style.display="none";
1155: } else {
1156: if ((parmlevValue == "full") || (parmlevValue == "map")) {
1157: document.getElementById('mapmenu').style.display ="";
1158: } else {
1159: document.getElementById('mapmenu').style.display="none";
1160: }
1161: }
1162: return;
1163: }
1164:
1165: COURSECONTENTSCRIPT
1166: }
1167:
1.561 damieng 1168: # Javascript functions showHideLenient and toggleParmTextbox, for overview mode
1.549 raeburn 1169: sub toggleparmtextbox_js {
1170: return <<"ENDSCRIPT";
1171:
1172: if (!document.getElementsByClassName) {
1173: function getElementsByClassName(node, classname) {
1174: var a = [];
1175: var re = new RegExp('(^| )'+classname+'( |$)');
1176: var els = node.getElementsByTagName("*");
1177: for(var i=0,j=els.length; i<j; i++)
1178: if(re.test(els[i].className))a.push(els[i]);
1179: return a;
1180: }
1181: }
1182:
1183: function showHideLenient() {
1184: var lenients;
1185: var setRegExp = /^set_/;
1186: if (document.getElementsByClassName) {
1187: lenients = document.getElementsByClassName('LC_lenient_radio');
1188: } else {
1189: lenients = getElementsByClassName(document.body,'LC_lenient_radio');
1190: }
1191: if (lenients != 'undefined') {
1192: for (var i=0; i<lenients.length; i++) {
1193: if (lenients[i].checked) {
1194: if (lenients[i].value == 'weighted') {
1195: if (setRegExp.test(lenients[i].name)) {
1196: var identifier = lenients[i].name.replace(setRegExp,'');
1197: toggleParmTextbox(document.parmform,identifier);
1198: }
1199: }
1200: }
1201: }
1202: }
1203: return;
1204: }
1205:
1206: function toggleParmTextbox(form,key) {
1207: var divfortext = document.getElementById('LC_parmtext_'+key);
1208: if (divfortext) {
1209: var caller = form.elements['set_'+key];
1210: if (caller.length) {
1211: for (i=0; i<caller.length; i++) {
1212: if (caller[i].checked) {
1213: if (caller[i].value == 'weighted') {
1214: divfortext.style.display = 'inline';
1215: } else {
1216: divfortext.style.display = 'none';
1217: }
1218: }
1219: }
1220: }
1221: }
1222: return;
1223: }
1224:
1225: ENDSCRIPT
1226: }
1227:
1.561 damieng 1228: # Javascript function validateParms, for overview mode
1.549 raeburn 1229: sub validateparms_js {
1230: return <<'ENDSCRIPT';
1231:
1232: function validateParms() {
1233: var textRegExp = /^settext_/;
1234: var tailLenient = /\.lenient$/;
1235: var patternRelWeight = /^\-?[\d.]+$/;
1236: var patternLenientStd = /^(yes|no|default)$/;
1237: var ipallowRegExp = /^setipallow_/;
1238: var ipdenyRegExp = /^setipdeny_/;
1239: var patternIP = /[\[\]\*\.a-zA-Z\d\-]+/;
1240: if ((document.parmform.elements.length != 'undefined') && (document.parmform.elements.length) != 'null') {
1241: if (document.parmform.elements.length) {
1242: for (i=0; i<document.parmform.elements.length; i++) {
1243: var name=document.parmform.elements[i].name;
1244: if (textRegExp.test(name)) {
1245: var identifier = name.replace(textRegExp,'');
1246: if (tailLenient.test(identifier)) {
1247: if (document.parmform.elements['set_'+identifier].length) {
1248: for (var j=0; j<document.parmform.elements['set_'+identifier].length; j++) {
1249: if (document.parmform.elements['set_'+identifier][j].checked) {
1250: if (!(patternLenientStd.test(document.parmform.elements['set_'+identifier][j].value))) {
1251: var relweight = document.parmform.elements[i].value;
1252: relweight = relweight.replace(/^\s+|\s+$/g,'');
1253: if (!patternRelWeight.test(relweight)) {
1254: relweight = '0.0';
1255: }
1256: if (document.parmform.elements['set_'+identifier][j].value == 'weighted') {
1257: document.parmform.elements['set_'+identifier][j].value = relweight;
1258: } else {
1259: document.parmform.elements['set_'+identifier][j].value += ','+relweight;
1260: }
1261: }
1262: break;
1263: }
1264: }
1265: }
1266: }
1267: } else {
1268: if (ipallowRegExp.test(name)) {
1269: var identifier = name.replace(ipallowRegExp,'');
1270: var possallow = document.parmform.elements[i].value;
1271: possallow = possallow.replace(/^\s+|\s+$/g,'');
1272: if (patternIP.test(possallow)) {
1273: if (document.parmform.elements['set_'+identifier].value) {
1274: possallow = ','+possallow;
1275: }
1276: document.parmform.elements['set_'+identifier].value += possallow;
1277: }
1278: } else {
1279: if (ipdenyRegExp.test(name)) {
1280: var identifier = name.replace(ipdenyRegExp,'');
1281: var possdeny = document.parmform.elements[i].value;
1282: possdeny = possdeny.replace(/^\s+|\s+$/g,'');
1283: if (patternIP.test(possdeny)) {
1284: possdeny = '!'+possdeny;
1285: if (document.parmform.elements['set_'+identifier].value) {
1286: possdeny = ','+possdeny;
1287: }
1288: document.parmform.elements['set_'+identifier].value += possdeny;
1289: }
1290: }
1291: }
1292: }
1293: }
1294: }
1295: }
1296: return true;
1297: }
1298:
1299: ENDSCRIPT
1300: }
1301:
1.561 damieng 1302: # Javascript initialization, for overview mode
1.549 raeburn 1303: sub ipacc_boxes_js {
1304: my $remove = &mt('Remove');
1305: return <<"END";
1306: \$(document).ready(function() {
1307: var wrapper = \$(".LC_string_ipacc_wrap");
1308: var add_button = \$(".LC_add_ipacc_button");
1309: var ipaccRegExp = /^LC_string_ipacc_/;
1310:
1311: \$(add_button).click(function(e){
1312: e.preventDefault();
1313: var identifier = \$(this).closest("div").attr("id");
1314: identifier = identifier.replace(ipaccRegExp,'');
1.551 raeburn 1315: \$(this).closest('div').find('.LC_string_ipacc_inner').append('<div><input type="text" name="setip'+identifier+'" /><a href="#" class="LC_remove_ipacc">$remove</a></div>');
1.549 raeburn 1316: });
1317:
1318: \$(wrapper).delegate(".LC_remove_ipacc","click", function(e){
1319: e.preventDefault(); \$(this).closest("div").remove();
1320: })
1321: });
1322:
1323:
1324: END
1325: }
1326:
1.561 damieng 1327: # Javascript function toggleSecret, for overview mode.
1.558 raeburn 1328: sub done_proctor_js {
1329: return <<"END";
1330: function toggleSecret(form,radio,key) {
1331: var radios = form[radio+key];
1332: if (radios.length) {
1333: for (var i=0; i<radios.length; i++) {
1334: if (radios[i].checked) {
1335: if (radios[i].value == '_done_proctor') {
1336: if (document.getElementById('done_'+key+'_proctorkey')) {
1337: document.getElementById('done_'+key+'_proctorkey').type='text';
1338: }
1339: } else {
1340: if (document.getElementById('done_'+key+'_proctorkey')) {
1341: document.getElementById('done_'+key+'_proctorkey').type='hidden';
1342: document.getElementById('done_'+key+'_proctorkey').value='';
1343: }
1344: }
1345: }
1346: }
1347: }
1348: }
1349: END
1350:
1351: }
1352:
1.561 damieng 1353: # Prints HTML page start for table mode.
1354: # @param {Apache2::RequestRec} $r - the Apache request
1355: # @param {string} $psymb - resource symb
1356: # @param {string} $crstype - course type (Community / Course / Placement Test)
1.280 albertel 1357: sub startpage {
1.531 raeburn 1358: my ($r,$psymb,$crstype) = @_;
1.281 albertel 1359:
1.515 raeburn 1360: my %loaditems = (
1361: 'onload' => "group_or_section('cgroup')",
1362: );
1363: if (!$psymb) {
1.523 raeburn 1364: $loaditems{'onload'} = "showHide_courseContent(); group_or_section('cgroup'); resize_scrollbox('mapmenuscroll','1','1');";
1.515 raeburn 1365: }
1.280 albertel 1366:
1.560 damieng 1367: if ((($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
1368: (!$env{'form.dis'})) || ($env{'form.symb'})) {
1369: &Apache::lonhtmlcommon::add_breadcrumb({help=>'Problem_Parameters',
1370: text=>"Problem Parameters"});
1.414 droeschl 1371: } else {
1.560 damieng 1372: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1373: text=>"Table Mode",
1374: help => 'Course_Setting_Parameters'});
1.414 droeschl 1375: }
1.523 raeburn 1376: my $js = &page_js().'
1377: <script type="text/javascript">
1378: // <![CDATA[
1379: '.
1380: &Apache::lonhtmlcommon::resize_scrollbox_js('params').'
1381: // ]]>
1382: </script>
1383: ';
1.446 bisitz 1384: my $start_page =
1.523 raeburn 1385: &Apache::loncommon::start_page('Set/Modify Course Parameters',$js,
1386: {'add_entries' => \%loaditems,});
1.446 bisitz 1387: my $breadcrumbs =
1.473 amueller 1388: &Apache::lonhtmlcommon::breadcrumbs('Table Mode Parameter Setting','Table_Mode');
1.506 www 1389: my $escfilter=&Apache::lonhtmlcommon::entity_encode($env{'form.filter'});
1390: my $escpart=&Apache::lonhtmlcommon::entity_encode($env{'form.part'});
1.507 www 1391: $r->print($start_page.$breadcrumbs);
1.531 raeburn 1392: &startSettingsScreen($r,'parmset',$crstype);
1.280 albertel 1393: $r->print(<<ENDHEAD);
1.193 albertel 1394: <form method="post" action="/adm/parmset?action=settable" name="parmform">
1.419 bisitz 1395: <input type="hidden" value="" name="pres_value" />
1396: <input type="hidden" value="" name="pres_type" />
1397: <input type="hidden" value="" name="pres_marker" />
1398: <input type="hidden" value="1" name="prevvisit" />
1.506 www 1399: <input type="hidden" value="$escfilter" name="filter" />
1400: <input type="hidden" value="$escpart" name="part" />
1.44 albertel 1401: ENDHEAD
1402: }
1403:
1.209 www 1404:
1.561 damieng 1405: # Prints a row for table mode (except for the tr start).
1406: # Every time a hash reference is passed, a single entry is used, so print_row
1407: # could just use these values, but why make it simple when it can be complicated ?
1408: #
1409: # @param {Apache2::RequestRec} $r - the Apache request
1410: # @param {string} $which - parameter key ('parameter_'.part.'_'.name)
1411: # @param {hash reference} $part - parameter key -> parameter part (can be problem part.'_'.response id for response parameters)
1412: # @param {hash reference} $name - parameter key -> parameter name
1.566 damieng 1413: # @param {hash reference} $symbp - map pc or resource/map id -> map src.'___(all)' or resource symb
1.561 damieng 1414: # @param {string} $rid - resource id
1415: # @param {hash reference} $default - parameter key -> resource parameter default value
1416: # @param {hash reference} $defaulttype - parameter key -> resource parameter default type
1417: # @param {hash reference} $display - parameter key -> full title for the parameter
1418: # @param {string} $defbgone - user level and other levels background color
1419: # @param {string} $defbgtwo - section level background color, also used for part number
1420: # @param {string} $defbgthree - group level background color
1421: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
1422: # @param {string} $uname - user name
1423: # @param {string} $udom - user domain
1424: # @param {string} $csec - section name
1425: # @param {string} $cgroup - group name
1426: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
1427: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568 raeburn 1428: # @param {boolean} $readonly - true if no editing allowed.
1.44 albertel 1429: sub print_row {
1.201 www 1430: my ($r,$which,$part,$name,$symbp,$rid,$default,$defaulttype,$display,$defbgone,
1.568 raeburn 1431: $defbgtwo,$defbgthree,$parmlev,$uname,$udom,$csec,$cgroup,$usersgroups,$noeditgrp,
1432: $readonly)=@_;
1.275 raeburn 1433: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1434: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1435: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.553 raeburn 1436:
1.560 damieng 1437: # get the values for the parameter in cascading order
1438: # empty levels will remain empty
1.44 albertel 1439: my ($result,@outpar)=&parmval($$part{$which}.'.'.$$name{$which},
1.473 amueller 1440: $rid,$$default{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560 damieng 1441: # get the type for the parameters
1442: # problem: these may not be set for all levels
1.66 www 1443: my ($typeresult,@typeoutpar)=&parmval($$part{$which}.'.'.
1.275 raeburn 1444: $$name{$which}.'.type',$rid,
1.473 amueller 1445: $$defaulttype{$which},$uname,$udom,$csec,$cgroup,$courseopt);
1.560 damieng 1446: # cascade down manually
1.182 albertel 1447: my $cascadetype=$$defaulttype{$which};
1.556 raeburn 1448: for (my $i=18;$i>0;$i--) {
1.560 damieng 1449: if ($typeoutpar[$i]) {
1.66 www 1450: $cascadetype=$typeoutpar[$i];
1.560 damieng 1451: } else {
1.66 www 1452: $typeoutpar[$i]=$cascadetype;
1453: }
1454: }
1.57 albertel 1455: my $parm=$$display{$which};
1456:
1.203 www 1457: if ($parmlev eq 'full') {
1.419 bisitz 1458: $r->print('<td style="background-color:'.$defbgtwo.';" align="center">'
1.506 www 1459: .($$part{$which} eq '0'?'0 ('.&mt('default').')':$$part{$which}).'</td>');
1.433 raeburn 1460: } else {
1.57 albertel 1461: $parm=~s|\[.*\]\s||g;
1462: }
1.231 www 1463: my $automatic=&rulescache(($which=~/\_([^\_]+)$/)[0].'_triggers');
1464: if ($automatic) {
1.560 damieng 1465: $parm.='<span class="LC_warning"><br />'.&mt('Automatically sets').' '.join(', ',split(/\:/,$automatic)).'</span>';
1.231 www 1466: }
1.427 bisitz 1467: $r->print('<td>'.$parm.'</td>');
1.446 bisitz 1468:
1.44 albertel 1469: my $thismarker=$which;
1470: $thismarker=~s/^parameter\_//;
1471: my $mprefix=$rid.'&'.$thismarker.'&';
1.554 raeburn 1472: my $effective_parm = &valout($outpar[$result],$typeoutpar[$result],$thismarker);
1.578 ! raeburn 1473: my ($othergrp,$grp_parm,$controlgrp,$effparm_rec);
! 1474: if ($result == 17 || $result == 11 || $result == 7 || $result == 3) {
! 1475: $effparm_rec = 1;
! 1476: }
1.57 albertel 1477: if ($parmlev eq 'general') {
1478: if ($uname) {
1.568 raeburn 1479: &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.269 raeburn 1480: } elsif ($cgroup) {
1.568 raeburn 1481: &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
1.57 albertel 1482: } elsif ($csec) {
1.568 raeburn 1483: &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.57 albertel 1484: } else {
1.568 raeburn 1485: &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.57 albertel 1486: }
1487: } elsif ($parmlev eq 'map') {
1488: if ($uname) {
1.578 ! raeburn 1489: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.269 raeburn 1490: } elsif ($cgroup) {
1.578 ! raeburn 1491: &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1);
1.57 albertel 1492: } elsif ($csec) {
1.578 ! raeburn 1493: &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.57 albertel 1494: } else {
1.578 ! raeburn 1495: &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.57 albertel 1496: }
1497: } else {
1.275 raeburn 1498: if ($uname) {
1499: if (@{$usersgroups} > 1) {
1500: my ($coursereply,$grp_parm,$controlgrp);
1501: ($coursereply,$othergrp,$grp_parm,$controlgrp) =
1502: &print_usergroups($r,$$part{$which}.'.'.$$name{$which},
1503: $rid,$cgroup,$defbgone,$usersgroups,$result,$courseopt);
1.556 raeburn 1504: if ($coursereply && $result > 4) {
1.275 raeburn 1505: if (defined($controlgrp)) {
1506: if ($cgroup ne $controlgrp) {
1507: $effective_parm = $grp_parm;
1508: $result = 0;
1509: }
1510: }
1511: }
1512: }
1513: }
1.57 albertel 1514:
1.568 raeburn 1515: &print_td($r,18,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578 ! raeburn 1516: &print_td($r,16,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568 raeburn 1517: &print_td($r,15,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1518: &print_td($r,14,'#FFDDDD',$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1519: &print_td($r,13,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548 raeburn 1520:
1521: if ($csec) {
1.568 raeburn 1522: &print_td($r,12,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578 ! raeburn 1523: &print_td($r,10,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568 raeburn 1524: &print_td($r,9,$defbgtwo,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548 raeburn 1525: }
1.269 raeburn 1526:
1527: if ($cgroup) {
1.569 raeburn 1528: &print_td($r,8,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly);
1.578 ! raeburn 1529: &print_td($r,6,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp,$readonly,1);
1.569 raeburn 1530: &print_td($r,5,$defbgthree,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,$noeditgrp.$readonly);
1.269 raeburn 1531: }
1.446 bisitz 1532:
1.548 raeburn 1533: if ($uname) {
1.275 raeburn 1534: if ($othergrp) {
1535: $r->print($othergrp);
1536: }
1.568 raeburn 1537: &print_td($r,4,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.578 ! raeburn 1538: &print_td($r,2,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly,1);
1.568 raeburn 1539: &print_td($r,1,$defbgone,$result,\@outpar,$mprefix,$which,\@typeoutpar,$display,'',$readonly);
1.548 raeburn 1540: }
1.57 albertel 1541:
1542: } # end of $parmlev if/else
1.578 ! raeburn 1543: $r->print('<td style="background-color:#CCCCFF;" align="center">'.$effective_parm.
! 1544: ($effparm_rec?'<br /><span class="LC_parm_recursive">'.&mt('recursive').
! 1545: '</span>':'').'</td>');
1.136 albertel 1546:
1.203 www 1547: if ($parmlev eq 'full') {
1.136 albertel 1548: my $sessionval=&Apache::lonnet::EXT('resource.'.$$part{$which}.
1.201 www 1549: '.'.$$name{$which},$$symbp{$rid});
1.136 albertel 1550: my $sessionvaltype=$typeoutpar[$result];
1.560 damieng 1551: if (!defined($sessionvaltype)) {
1552: $sessionvaltype=$$defaulttype{$which};
1553: }
1.419 bisitz 1554: $r->print('<td style="background-color:#999999;" align="center"><font color="#FFFFFF">'.
1.554 raeburn 1555: &valout($sessionval,$sessionvaltype,$$name{$which}).' '.
1.57 albertel 1556: '</font></td>');
1.136 albertel 1557: }
1.44 albertel 1558: $r->print('</tr>');
1.57 albertel 1559: $r->print("\n");
1.44 albertel 1560: }
1.59 matthew 1561:
1.561 damieng 1562: # Prints a cell for table mode.
1563: #
1564: # FIXME: some of these parameter names are uninspired ($which and $value)
1565: # Also, it would make more sense to pass the display for this cell rather
1566: # than the full display hash and the key to use.
1567: #
1568: # @param {Apache2::RequestRec} $r - the Apache request
1569: # @param {integer} $which - level
1570: # @param {string} $defbg - cell background color
1571: # @param {integer} $result - the most specific level that is defined for that parameter
1572: # @param {array reference} $outpar - array level -> parameter value (when defined)
1573: # @param {string} $mprefix - resource id.'&'.part.'_'.parameter name.'&'
1574: # @param {string} $value - parameter key ('parameter_'.part.'_'.name)
1575: # @param {array reference} $typeoutpar - array level -> parameter type (when defined)
1576: # @param {hash reference} $display - parameter key -> full title for the parameter
1577: # @param {boolean} $noeditgrp - true if no edit is allowed for group level parameters
1.568 raeburn 1578: # @param {boolean} $readonly -true if editing not allowed.
1.578 ! raeburn 1579: # @param {boolean} $ismaplevel - true if level is for a map.
1.44 albertel 1580: sub print_td {
1.578 ! raeburn 1581: my ($r,$which,$defbg,$result,$outpar,$mprefix,$value,$typeoutpar,$display,
! 1582: $noeditgrp,$readonly,$ismaplevel)=@_;
! 1583: my ($ineffect,$recursive,$currval,$currtype,$currlevel);
! 1584: $ineffect = 0;
! 1585: $currval = $$outpar[$which];
! 1586: $currtype = $$typeoutpar[$which];
! 1587: $currlevel = $which;
! 1588: if (($result) && ($result == $which)) {
! 1589: $ineffect = 1;
! 1590: }
! 1591: if ($ismaplevel) {
! 1592: if ($mprefix =~ /(hiddenresource|encrypturl)\&/) {
! 1593: if (($result) && ($result == $which)) {
! 1594: $recursive = 1;
! 1595: }
! 1596: } elsif ($$outpar[$which+1] ne '') {
! 1597: $recursive = 1;
! 1598: $currlevel = $which+1;
! 1599: $currval = $$outpar[$currlevel];
! 1600: $currtype = $$typeoutpar[$currlevel];
! 1601: if (($result) && ($result == $currlevel)) {
! 1602: $ineffect = 1;
! 1603: }
! 1604: }
! 1605: }
! 1606: $r->print('<td style="background-color:'.($ineffect?'#AAFFAA':$defbg).
1.419 bisitz 1607: ';" align="center">');
1.437 raeburn 1608: my $nolink = 0;
1.568 raeburn 1609: if ($readonly) {
1.552 raeburn 1610: $nolink = 1;
1.568 raeburn 1611: } else {
1.578 ! raeburn 1612: if ($which == 14 || $which == 15 || $mprefix =~ /mapalias\&$/) {
1.553 raeburn 1613: $nolink = 1;
1.568 raeburn 1614: } elsif (($env{'request.course.sec'} ne '') && ($which > 12)) {
1.533 raeburn 1615: $nolink = 1;
1.568 raeburn 1616: } elsif ($which == 5 || $which == 6 || $which == 7 || $which == 8) {
1617: if ($noeditgrp) {
1618: $nolink = 1;
1619: }
1620: } elsif ($mprefix =~ /availablestudent\&$/) {
1621: if ($which > 4) {
1622: $nolink = 1;
1623: }
1624: } elsif ($mprefix =~ /examcode\&$/) {
1625: unless ($which == 2) {
1626: $nolink = 1;
1627: }
1.533 raeburn 1628: }
1.437 raeburn 1629: }
1630: if ($nolink) {
1.577 raeburn 1631: my ($parmname)=((split(/\&/,$mprefix))[1]=~/\_([^\_]+)$/);
1.578 ! raeburn 1632: $r->print(&valout($currval,$currtype,$parmname));
1.114 www 1633: } else {
1.578 ! raeburn 1634: $r->print(&plink($currtype,
! 1635: $$display{$value},$currval,
! 1636: $mprefix.$currlevel,'parmform.pres','psub',$recursive));
1.114 www 1637: }
1638: $r->print('</td>'."\n");
1.57 albertel 1639: }
1640:
1.561 damieng 1641: # FIXME: Despite the name, this does not print anything, the $r parameter is unused.
1642: # Returns HTML and other info for the cell added when a user is selected
1643: # and that user is in several groups. This is the cell with the title "Control by other group".
1644: #
1645: # @param {Apache2::RequestRec} $r - the Apache request (unused)
1646: # @param {string} $what - parameter part.'.'.parameter name
1647: # @param {string} $rid - resource id
1648: # @param {string} $cgroup - group name
1649: # @param {string} $defbg - cell background color
1650: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
1651: # @param {integer} $result - level
1652: # @param {hash reference} $courseopt - course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db)
1653: # @returns {Array} - array (parameter value for the other group, HTML for the cell, HTML with the value, name of the other group)
1.275 raeburn 1654: sub print_usergroups {
1655: my ($r,$what,$rid,$cgroup,$defbg,$usersgroups,$result,$courseopt) = @_;
1656: my $courseid = $env{'request.course.id'};
1657: my $output;
1658: my $symb = &symbcache($rid);
1659: my $symbparm=$symb.'.'.$what;
1660: my $map=(&Apache::lonnet::decode_symb($symb))[0];
1.556 raeburn 1661: my $recurseparm=$map.'___(rec).'.$what;
1.275 raeburn 1662: my $mapparm=$map.'___(all).'.$what;
1663: my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype) =
1.556 raeburn 1664: &parm_control_group($courseid,$usersgroups,$symbparm,$mapparm,
1665: $recurseparm,$what,$courseopt);
1.275 raeburn 1666: my $bgcolor = $defbg;
1667: my $grp_parm;
1.446 bisitz 1668: if (($coursereply) && ($cgroup ne $resultgroup)) {
1.275 raeburn 1669: if ($result > 3) {
1.419 bisitz 1670: $bgcolor = '#AAFFAA';
1.554 raeburn 1671: $grp_parm = &valout($coursereply,$resulttype,$what);
1.275 raeburn 1672: }
1.554 raeburn 1673: $grp_parm = &valout($coursereply,$resulttype,$what);
1.419 bisitz 1674: $output = '<td style="background-color:'.$bgcolor.';" align="center">';
1.275 raeburn 1675: if ($resultgroup && $resultlevel) {
1676: $output .= '<small><b>'.$resultgroup.'</b> ('.$resultlevel.'): </small>'.$grp_parm;
1677: } else {
1678: $output .= ' ';
1679: }
1680: $output .= '</td>';
1681: } else {
1.419 bisitz 1682: $output .= '<td style="background-color:'.$bgcolor.';"> </td>';
1.275 raeburn 1683: }
1684: return ($coursereply,$output,$grp_parm,$resultgroup);
1685: }
1686:
1.561 damieng 1687: # Looks for a group with a defined parameter for given user and parameter.
1688: # Used by print_usergroups.
1689: #
1690: # @param {string} $courseid - the course id
1691: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
1692: # @param {string} $symbparm - end of the course parameter hash key for the group resource level
1693: # @param {string} $mapparm - end of the course parameter hash key for the group map/folder level
1694: # @param {string} $recurseparm - end of the course parameter hash key for the group recursive level
1695: # @param {string} $what - parameter part.'.'.parameter name
1696: # @param {hash reference} $courseopt - course parameters hash
1697: # @returns {Array} - (parameter value for the group, course parameter hash key for the parameter, name of the group, level name, parameter type)
1.275 raeburn 1698: sub parm_control_group {
1.556 raeburn 1699: my ($courseid,$usersgroups,$symbparm,$mapparm,$recurseparm,$what,$courseopt) = @_;
1.275 raeburn 1700: my ($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
1701: my $grpfound = 0;
1.556 raeburn 1702: my @levels = ($symbparm,$mapparm,$recurseparm,$what);
1703: my @levelnames = ('resource','map/folder','recursive','general');
1.275 raeburn 1704: foreach my $group (@{$usersgroups}) {
1705: if ($grpfound) { last; }
1706: for (my $i=0; $i<@levels; $i++) {
1707: my $item = $courseid.'.['.$group.'].'.$levels[$i];
1708: if (defined($$courseopt{$item})) {
1709: $coursereply = $$courseopt{$item};
1710: $resultitem = $item;
1711: $resultgroup = $group;
1712: $resultlevel = $levelnames[$i];
1713: $resulttype = $$courseopt{$item.'.type'};
1714: $grpfound = 1;
1715: last;
1716: }
1717: }
1718: }
1719: return($coursereply,$resultitem,$resultgroup,$resultlevel,$resulttype);
1720: }
1.201 www 1721:
1.63 bowersj2 1722:
1723:
1.562 damieng 1724: # Extracts lots of information about all of the the course's resources into a variety of hashes, using lonnavmaps and lonnet::metadata.
1725: # All the parameters are references and are filled by the sub.
1726: #
1.566 damieng 1727: # @param {array reference} $ids - resource and map ids
1728: # @param {hash reference} $typep - hash resource/map id -> resource type (file extension)
1729: # @param {hash reference} $keyp - hash resource/map id -> comma-separated list of parameter keys from lonnet::metadata
1.562 damieng 1730: # @param {hash reference} $allparms - hash parameter name -> parameter title
1731: # @param {hash reference} $allparts - hash parameter part -> part title (a parameter part can be problem part.'_'.response id for response parameters)
1.566 damieng 1732: # @param {hash reference} $allmaps - hash map pc -> map src
1733: # @param {hash reference} $mapp - hash map pc or resource/map id -> enclosing map src
1734: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' for a map or resource symb for a resource
1735: # @param {hash reference} $maptitles - hash map pc or src -> map title (this should really be two separate hashes)
1736: # @param {hash reference} $uris - hash resource/map id -> resource src
1.562 damieng 1737: # @param {hash reference} $keyorder - hash parameter key -> appearance rank for this parameter when looking through every resource and every parameter, starting at 100 (integer)
1738: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.63 bowersj2 1739: sub extractResourceInformation {
1740: my $ids = shift;
1741: my $typep = shift;
1742: my $keyp = shift;
1743: my $allparms = shift;
1744: my $allparts = shift;
1745: my $allmaps = shift;
1746: my $mapp = shift;
1747: my $symbp = shift;
1.82 www 1748: my $maptitles=shift;
1.196 www 1749: my $uris=shift;
1.210 www 1750: my $keyorder=shift;
1.211 www 1751: my $defkeytype=shift;
1.196 www 1752:
1.210 www 1753: my $keyordercnt=100;
1.63 bowersj2 1754:
1.196 www 1755: my $navmap = Apache::lonnavmaps::navmap->new();
1756: my @allres=$navmap->retrieveResources(undef,undef,1,undef,1);
1757: foreach my $resource (@allres) {
1.480 amueller 1758: my $id=$resource->id();
1.196 www 1759: my ($mapid,$resid)=split(/\./,$id);
1.480 amueller 1760: if ($mapid eq '0') { next; }
1761: $$ids[$#$ids+1]=$id;
1762: my $srcf=$resource->src();
1763: $srcf=~/\.(\w+)$/;
1764: $$typep{$id}=$1;
1765: $$keyp{$id}='';
1.196 www 1766: $$uris{$id}=$srcf;
1.512 foxr 1767:
1.480 amueller 1768: foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
1769: next if ($key!~/^parameter_/);
1.363 albertel 1770:
1.209 www 1771: # Hidden parameters
1.480 amueller 1772: next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209 www 1773: #
1774: # allparms is a hash of parameter names
1775: #
1.480 amueller 1776: my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
1777: if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
1778: my ($display,$parmdis);
1779: $display = &standard_parameter_names($name);
1780: if ($display eq '') {
1781: $display= &Apache::lonnet::metadata($srcf,$key.'.display');
1782: $parmdis = $display;
1783: $parmdis =~ s/\s*\[Part.*$//g;
1784: } else {
1785: $parmdis = &mt($display);
1786: }
1787: $$allparms{$name}=$parmdis;
1788: if (ref($defkeytype)) {
1789: $$defkeytype{$name}=
1790: &Apache::lonnet::metadata($srcf,$key.'.type');
1791: }
1792: }
1.363 albertel 1793:
1.209 www 1794: #
1795: # allparts is a hash of all parts
1796: #
1.480 amueller 1797: my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
1798: $$allparts{$part} = &mt('Part: [_1]',$part);
1.209 www 1799: #
1800: # Remember all keys going with this resource
1801: #
1.480 amueller 1802: if ($$keyp{$id}) {
1803: $$keyp{$id}.=','.$key;
1804: } else {
1805: $$keyp{$id}=$key;
1806: }
1.210 www 1807: #
1808: # Put in order
1.446 bisitz 1809: #
1.480 amueller 1810: unless ($$keyorder{$key}) {
1811: $$keyorder{$key}=$keyordercnt;
1812: $keyordercnt++;
1813: }
1.473 amueller 1814: }
1815:
1816:
1.480 amueller 1817: if (!exists($$mapp{$mapid})) {
1818: $$mapp{$id}=
1819: &Apache::lonnet::declutter($resource->enclosing_map_src());
1820: $$mapp{$mapid}=$$mapp{$id};
1821: $$allmaps{$mapid}=$$mapp{$id};
1822: if ($mapid eq '1') {
1.532 raeburn 1823: $$maptitles{$mapid}=&mt('Main Content');
1.480 amueller 1824: } else {
1825: $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
1826: }
1827: $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556 raeburn 1828: $$symbp{$mapid}=$$mapp{$id}.'___(all)'; # Added in rev. 1.57, but seems not to be used.
1829: # Lines 1038 and 1114 which use $symbp{$mapid}
1830: # are commented out in rev. 1.57
1.473 amueller 1831: } else {
1.480 amueller 1832: $$mapp{$id} = $$mapp{$mapid};
1.473 amueller 1833: }
1.480 amueller 1834: $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63 bowersj2 1835: }
1836: }
1837:
1.208 www 1838:
1.562 damieng 1839: # Tells if a parameter type is a date.
1840: #
1841: # @param {string} type - parameter type
1842: # @returns{boolean} - true if it is a date
1.213 www 1843: sub isdateparm {
1844: my $type=shift;
1845: return (($type=~/^date/) && (!($type eq 'date_interval')));
1846: }
1847:
1.562 damieng 1848: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1849: # FIXME: remove unused parameters
1.468 amueller 1850: #
1.562 damieng 1851: # @param {Apache2::RequestRec} $r - the Apache request (unused)
1852: # @param {hash reference} $allparms - hash parameter name -> parameter title
1853: # @param {array reference} $pscat - list of selected parameter names (unused)
1854: # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
1.208 www 1855: sub parmmenu {
1.211 www 1856: my ($r,$allparms,$pscat,$keyorder)=@_;
1.208 www 1857: my $tempkey;
1858: $r->print(<<ENDSCRIPT);
1859: <script type="text/javascript">
1.454 bisitz 1860: // <![CDATA[
1.208 www 1861: function checkall(value, checkName) {
1.453 schualex 1862:
1863: var li = "_li";
1864: var displayOverview = "";
1865:
1866: if (value == false) {
1867: displayOverview = "none"
1868: }
1869:
1.562 damieng 1870: for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208 www 1871: ele = document.forms.parmform.elements[i];
1872: if (ele.name == checkName) {
1873: document.forms.parmform.elements[i].checked=value;
1874: }
1875: }
1876: }
1.210 www 1877:
1878: function checkthis(thisvalue, checkName) {
1.562 damieng 1879: for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210 www 1880: ele = document.forms.parmform.elements[i];
1881: if (ele.name == checkName) {
1.562 damieng 1882: if (ele.value == thisvalue) {
1883: document.forms.parmform.elements[i].checked=true;
1884: }
1.210 www 1885: }
1886: }
1887: }
1888:
1889: function checkdates() {
1.562 damieng 1890: checkthis('duedate','pscat');
1891: checkthis('opendate','pscat');
1892: checkthis('answerdate','pscat');
1.218 www 1893: }
1894:
1895: function checkdisset() {
1.562 damieng 1896: checkthis('discussend','pscat');
1897: checkthis('discusshide','pscat');
1898: checkthis('discussvote','pscat');
1.218 www 1899: }
1900:
1901: function checkcontdates() {
1.562 damieng 1902: checkthis('contentopen','pscat');
1903: checkthis('contentclose','pscat');
1.218 www 1904: }
1.446 bisitz 1905:
1.210 www 1906: function checkvisi() {
1.562 damieng 1907: checkthis('hiddenresource','pscat');
1908: checkthis('encrypturl','pscat');
1909: checkthis('problemstatus','pscat');
1910: checkthis('contentopen','pscat');
1911: checkthis('opendate','pscat');
1.210 www 1912: }
1913:
1914: function checkparts() {
1.562 damieng 1915: checkthis('hiddenparts','pscat');
1916: checkthis('display','pscat');
1917: checkthis('ordered','pscat');
1.210 www 1918: }
1919:
1920: function checkstandard() {
1921: checkall(false,'pscat');
1.562 damieng 1922: checkdates();
1923: checkthis('weight','pscat');
1924: checkthis('maxtries','pscat');
1925: checkthis('type','pscat');
1926: checkthis('problemstatus','pscat');
1.210 www 1927: }
1928:
1.454 bisitz 1929: // ]]>
1.208 www 1930: </script>
1931: ENDSCRIPT
1.453 schualex 1932:
1.491 bisitz 1933: $r->print('<hr />');
1.453 schualex 1934: &shortCuts($r,$allparms,$pscat,$keyorder);
1.491 bisitz 1935: $r->print('<hr />');
1.453 schualex 1936: }
1.562 damieng 1937:
1938: # Returns parameter categories.
1939: #
1940: # @returns {hash} - category name -> title in English
1.465 amueller 1941: sub categories {
1942: return ('time_settings' => 'Time Settings',
1943: 'grading' => 'Grading',
1944: 'tries' => 'Tries',
1945: 'problem_appearance' => 'Problem Appearance',
1946: 'behaviour_of_input_fields' => 'Behaviour of Input Fields',
1947: 'hiding' => 'Hiding',
1948: 'high_level_randomization' => 'High Level Randomization',
1949: 'slots' => 'Slots',
1950: 'file_submission' => 'File Submission',
1951: 'misc' => 'Miscellaneous' );
1952: }
1953:
1.562 damieng 1954: # Returns the category for each parameter.
1955: #
1956: # @returns {hash} - parameter name -> category name
1.465 amueller 1957: sub lookUpTableParameter {
1958:
1959: return (
1960: 'opendate' => 'time_settings',
1961: 'duedate' => 'time_settings',
1962: 'answerdate' => 'time_settings',
1963: 'interval' => 'time_settings',
1964: 'contentopen' => 'time_settings',
1965: 'contentclose' => 'time_settings',
1966: 'discussend' => 'time_settings',
1.560 damieng 1967: 'printstartdate' => 'time_settings',
1968: 'printenddate' => 'time_settings',
1.465 amueller 1969: 'weight' => 'grading',
1970: 'handgrade' => 'grading',
1971: 'maxtries' => 'tries',
1972: 'hinttries' => 'tries',
1.503 raeburn 1973: 'randomizeontries' => 'tries',
1.465 amueller 1974: 'type' => 'problem_appearance',
1975: 'problemstatus' => 'problem_appearance',
1976: 'display' => 'problem_appearance',
1977: 'ordered' => 'problem_appearance',
1978: 'numbubbles' => 'problem_appearance',
1979: 'tol' => 'behaviour_of_input_fields',
1980: 'sig' => 'behaviour_of_input_fields',
1981: 'turnoffunit' => 'behaviour_of_input_fields',
1982: 'hiddenresource' => 'hiding',
1983: 'hiddenparts' => 'hiding',
1984: 'discusshide' => 'hiding',
1985: 'buttonshide' => 'hiding',
1986: 'turnoffeditor' => 'hiding',
1987: 'encrypturl' => 'hiding',
1988: 'randomorder' => 'high_level_randomization',
1989: 'randompick' => 'high_level_randomization',
1990: 'available' => 'slots',
1991: 'useslots' => 'slots',
1992: 'availablestudent' => 'slots',
1993: 'uploadedfiletypes' => 'file_submission',
1994: 'maxfilesize' => 'file_submission',
1995: 'cssfile' => 'misc',
1996: 'mapalias' => 'misc',
1997: 'acc' => 'misc',
1998: 'maxcollaborators' => 'misc',
1999: 'scoreformat' => 'misc',
1.514 raeburn 2000: 'lenient' => 'grading',
1.519 raeburn 2001: 'retrypartial' => 'tries',
1.521 raeburn 2002: 'discussvote' => 'misc',
1.533 raeburn 2003: 'examcode' => 'high_level_randomization',
1.575 raeburn 2004: );
1.465 amueller 2005: }
2006:
1.562 damieng 2007: # Adds the given parameter name to an array of arrays listing all parameters for each category.
2008: #
2009: # @param {string} $name - parameter name
2010: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465 amueller 2011: sub whatIsMyCategory {
2012: my $name = shift;
2013: my $catList = shift;
2014: my @list;
2015: my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
2016: my $cat = $lookUpList{$name};
2017: if (defined($cat)) {
2018: if (!defined($$catList{$cat})){
2019: push @list, ($name);
2020: $$catList{$cat} = \@list;
2021: } else {
2022: push @{${$catList}{$cat}}, ($name);
2023: }
2024: } else {
2025: if (!defined($$catList{'misc'})){
2026: push @list, ($name);
2027: $$catList{'misc'} = \@list;
2028: } else {
2029: push @{${$catList}{'misc'}}, ($name);
2030: }
2031: }
2032: }
2033:
1.562 damieng 2034: # Sorts parameter names based on appearance order.
2035: #
2036: # @param {array reference} name - array reference of parameter names
2037: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
2038: # @returns {Array} - array of parameter names
1.465 amueller 2039: sub keysindisplayorderCategory {
2040: my ($name,$keyorder)=@_;
2041: return sort {
1.473 amueller 2042: $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.465 amueller 2043: } ( @{$name});
2044: }
2045:
1.562 damieng 2046: # Returns a hash category name -> order, starting at 1 (integer)
2047: #
2048: # @returns {hash}
1.467 amueller 2049: sub category_order {
2050: return (
2051: 'time_settings' => 1,
2052: 'grading' => 2,
2053: 'tries' => 3,
2054: 'problem_appearance' => 4,
2055: 'hiding' => 5,
2056: 'behaviour_of_input_fields' => 6,
2057: 'high_level_randomization' => 7,
2058: 'slots' => 8,
2059: 'file_submission' => 9,
2060: 'misc' => 10
2061: );
2062:
2063: }
1.453 schualex 2064:
1.562 damieng 2065: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
2066: #
2067: # @param {Apache2::RequestRec} $r - the Apache request
2068: # @param {hash reference} $allparms - hash parameter name -> parameter title
2069: # @param {array reference} $pscat - list of selected parameter names
2070: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453 schualex 2071: sub parmboxes {
2072: my ($r,$allparms,$pscat,$keyorder)=@_;
1.548 raeburn 2073: my %categories = &categories();
1.467 amueller 2074: my %category_order = &category_order();
1.465 amueller 2075: my %categoryList = (
2076: 'time_settings' => [],
2077: 'grading' => [],
2078: 'tries' => [],
2079: 'problem_appearance' => [],
2080: 'behaviour_of_input_fields' => [],
2081: 'hiding' => [],
2082: 'high_level_randomization' => [],
2083: 'slots' => [],
2084: 'file_submission' => [],
2085: 'misc' => [],
1.489 bisitz 2086: );
1.510 www 2087:
1.548 raeburn 2088: foreach my $tempparameter (keys(%$allparms)) {
1.465 amueller 2089: &whatIsMyCategory($tempparameter, \%categoryList);
2090: }
1.453 schualex 2091: #part to print the parm-list
1.536 raeburn 2092: foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
2093: next if (@{$categoryList{$key}} == 0);
2094: next if ($key eq '');
2095: $r->print('<div class="LC_Box LC_400Box">'
2096: .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
2097: foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575 raeburn 2098: next if ($tempkey eq '');
1.536 raeburn 2099: $r->print('<span class="LC_nobreak">'
2100: .'<label><input type="checkbox" name="pscat" '
2101: .'value="'.$tempkey.'" ');
2102: if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
2103: $r->print( ' checked="checked"');
2104: }
2105: $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465 amueller 2106: : $tempkey)
1.536 raeburn 2107: .'</label></span><br />'."\n");
1.465 amueller 2108: }
1.536 raeburn 2109: $r->print('</div>');
1.465 amueller 2110: }
1.536 raeburn 2111: $r->print("\n");
1.453 schualex 2112: }
1.562 damieng 2113:
2114: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
2115: # FIXME: remove unused parameters
1.468 amueller 2116: #
1.562 damieng 2117: # @param {Apache2::RequestRec} $r - the Apache request
2118: # @param {hash reference} $allparms - hash parameter name -> parameter title (unused)
2119: # @param {array reference} $pscat - list of selected parameter names (unused)
2120: # @param {hash reference} $keyorder - hash parameter key -> appearance rank (unused)
1.453 schualex 2121: sub shortCuts {
2122: my ($r,$allparms,$pscat,$keyorder)=@_;
2123:
1.491 bisitz 2124: # Parameter Selection
2125: $r->print(
2126: &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
2127: .&Apache::lonhtmlcommon::add_item_funclist(
2128: '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
2129: .&Apache::lonhtmlcommon::add_item_funclist(
2130: '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
2131: .&Apache::lonhtmlcommon::add_item_funclist(
2132: '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
2133: .&Apache::lonhtmlcommon::end_funclist()
2134: );
2135:
2136: # Add Selection for...
2137: $r->print(
2138: &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
2139: .&Apache::lonhtmlcommon::add_item_funclist(
2140: '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
2141: .&Apache::lonhtmlcommon::add_item_funclist(
2142: '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
2143: .&Apache::lonhtmlcommon::add_item_funclist(
2144: '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
2145: .&Apache::lonhtmlcommon::add_item_funclist(
2146: '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
2147: .&Apache::lonhtmlcommon::add_item_funclist(
2148: '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
2149: .&Apache::lonhtmlcommon::end_funclist()
2150: );
1.208 www 2151: }
2152:
1.562 damieng 2153: # Prints HTML to select parts to view (except for the title).
2154: # Used by table and overview modes.
2155: #
2156: # @param {Apache2::RequestRec} $r - the Apache request
2157: # @param {hash reference} $allparts - hash parameter part -> part title
2158: # @param {array reference} $psprt - list of selected parameter parts
1.209 www 2159: sub partmenu {
1.446 bisitz 2160: my ($r,$allparts,$psprt)=@_;
1.523 raeburn 2161: my $selsize = 1+scalar(keys(%{$allparts}));
2162: if ($selsize > 8) {
2163: $selsize = 8;
2164: }
1.446 bisitz 2165:
1.523 raeburn 2166: $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208 www 2167: $r->print('<option value="all"');
1.562 damieng 2168: $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208 www 2169: $r->print('>'.&mt('All Parts').'</option>');
2170: my %temphash=();
2171: foreach (@{$psprt}) { $temphash{$_}=1; }
1.234 albertel 2172: foreach my $tempkey (sort {
1.560 damieng 2173: if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
2174: } keys(%{$allparts})) {
2175: unless ($tempkey =~ /\./) {
2176: $r->print('<option value="'.$tempkey.'"');
2177: if ($$psprt[0] eq "all" || $temphash{$tempkey}) {
2178: $r->print(' selected="selected"');
2179: }
2180: $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473 amueller 2181: }
1.208 www 2182: }
1.446 bisitz 2183: $r->print('</select>');
1.209 www 2184: }
2185:
1.562 damieng 2186: # Prints HTML to select a user and/or a group.
2187: # Used by table mode.
2188: #
2189: # @param {Apache2::RequestRec} $r - the Apache request
2190: # @param {string} $uname - selected user name
2191: # @param {string} $id - selected Student/Employee ID
2192: # @param {string} $udom - selected user domain
2193: # @param {string} $csec - selected section name
2194: # @param {string} $cgroup - selected group name
2195: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
2196: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
2197: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209 www 2198: sub usermenu {
1.553 raeburn 2199: my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209 www 2200: my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
2201: &Apache::loncommon::selectstudent_link('parmform','uname','udom');
2202: my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412 bisitz 2203:
1.209 www 2204: my $sections='';
1.300 albertel 2205: my %sectionhash = &Apache::loncommon::get_sections();
2206:
1.269 raeburn 2207: my $groups;
1.553 raeburn 2208: my %grouphash;
2209: if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
2210: %grouphash = &Apache::longroup::coursegroups();
2211: } elsif ($env{'request.course.groups'} ne '') {
2212: map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
2213: }
1.299 albertel 2214:
1.412 bisitz 2215: my $g_s_header='';
2216: my $g_s_footer='';
1.446 bisitz 2217:
1.552 raeburn 2218: my $currsec = $env{'request.course.sec'};
2219: if ($currsec) {
2220: $sections=&mt('Section:').' '.$currsec;
2221: if (%grouphash) {
2222: $sections .= ';'.(' ' x2);
2223: }
2224: } elsif (%sectionhash && $currsec eq '') {
1.412 bisitz 2225: $sections=&mt('Section:').' <select name="csec"';
1.299 albertel 2226: if (%grouphash && $parmlev ne 'full') {
1.269 raeburn 2227: $sections .= qq| onchange="group_or_section('csec')" |;
2228: }
2229: $sections .= '>';
1.548 raeburn 2230: foreach my $section ('',sort(keys(%sectionhash))) {
1.473 amueller 2231: $sections.='<option value="'.$section.'" '.
2232: ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275 raeburn 2233: '</option>';
1.209 www 2234: }
2235: $sections.='</select>';
1.269 raeburn 2236: }
1.412 bisitz 2237:
1.552 raeburn 2238: if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412 bisitz 2239: $sections .= ' '.&mt('or').' ';
1.269 raeburn 2240: $sections .= qq|
2241: <script type="text/javascript">
1.454 bisitz 2242: // <![CDATA[
1.269 raeburn 2243: function group_or_section(caller) {
2244: if (caller == "cgroup") {
2245: if (document.parmform.cgroup.selectedIndex != 0) {
2246: document.parmform.csec.selectedIndex = 0;
2247: }
2248: } else {
2249: if (document.parmform.csec.selectedIndex != 0) {
2250: document.parmform.cgroup.selectedIndex = 0;
2251: }
2252: }
2253: }
1.454 bisitz 2254: // ]]>
1.269 raeburn 2255: </script>
2256: |;
1.554 raeburn 2257: } else {
1.269 raeburn 2258: $sections .= qq|
2259: <script type="text/javascript">
1.454 bisitz 2260: // <![CDATA[
1.269 raeburn 2261: function group_or_section(caller) {
2262: return;
2263: }
1.454 bisitz 2264: // ]]>
1.269 raeburn 2265: </script>
2266: |;
1.446 bisitz 2267: }
1.299 albertel 2268:
2269: if (%grouphash) {
1.412 bisitz 2270: $groups=&mt('Group:').' <select name="cgroup"';
1.552 raeburn 2271: if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269 raeburn 2272: $groups .= qq| onchange="group_or_section('cgroup')" |;
2273: }
2274: $groups .= '>';
1.548 raeburn 2275: foreach my $grp ('',sort(keys(%grouphash))) {
1.275 raeburn 2276: $groups.='<option value="'.$grp.'" ';
2277: if ($grp eq $cgroup) {
2278: unless ((defined($uname)) && ($grp eq '')) {
2279: $groups .= 'selected="selected" ';
2280: }
2281: } elsif (!defined($cgroup)) {
2282: if (@{$usersgroups} == 1) {
2283: if ($grp eq $$usersgroups[0]) {
2284: $groups .= 'selected="selected" ';
2285: }
2286: }
2287: }
2288: $groups .= '>'.$grp.'</option>';
1.269 raeburn 2289: }
2290: $groups.='</select>';
2291: }
1.412 bisitz 2292:
1.445 neumanie 2293: if (%sectionhash || %grouphash) {
1.446 bisitz 2294: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
2295: $r->print($sections.$groups);
1.448 bisitz 2296: $r->print(&Apache::lonhtmlcommon::row_closure());
1.554 raeburn 2297: } else {
2298: $r->print($sections);
1.445 neumanie 2299: }
1.446 bisitz 2300:
2301: $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443 neumanie 2302: $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412 bisitz 2303: ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
2304: ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446 bisitz 2305: ,$chooseopt));
1.209 www 2306: }
2307:
1.562 damieng 2308: # Prints HTML to select parameters from a list of all parameters.
2309: # Uses parmmenu and parmboxes.
2310: # Used by table and overview modes.
1.468 amueller 2311: #
1.562 damieng 2312: # @param {Apache2::RequestRec} $r - the Apache request
2313: # @param {hash reference} $allparms - hash parameter name -> parameter title
2314: # @param {array reference} $pscat - list of selected parameter names
2315: # @param {array reference} $psprt - list of selected parameter parts (unused)
2316: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
2317: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209 www 2318: sub displaymenu {
1.536 raeburn 2319: my ($r,$allparms,$pscat,$psprt,$keyorder,$divid)=@_;
1.510 www 2320:
1.445 neumanie 2321: $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510 www 2322: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
2323:
1.562 damieng 2324: &parmmenu($r,$allparms,$pscat,$keyorder); # only $allparms is used by parmmenu
1.536 raeburn 2325: $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510 www 2326: &parmboxes($r,$allparms,$pscat,$keyorder);
2327: $r->print(&Apache::loncommon::end_scrollbox());
2328:
2329: $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453 schualex 2330: $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510 www 2331:
1.209 www 2332: }
2333:
1.562 damieng 2334: # Prints HTML to select a map.
2335: # Used by table mode and overview mode.
2336: #
2337: # @param {Apache2::RequestRec} $r - the Apache request
1.566 damieng 2338: # @param {hash reference} $allmaps - hash map pc -> map src
2339: # @param {string} $pschp - selected map pc, or 'all'
1.562 damieng 2340: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566 damieng 2341: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445 neumanie 2342: sub mapmenu {
1.499 raeburn 2343: my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468 amueller 2344: my %allmaps_inverted = reverse %$allmaps;
1.461 neumanie 2345: my $navmap = Apache::lonnavmaps::navmap->new();
2346: my $tree=[];
2347: my $treeinfo={};
2348: if (defined($navmap)) {
1.499 raeburn 2349: my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461 neumanie 2350: my $curRes;
2351: my $depth = 0;
1.468 amueller 2352: my %parent = ();
2353: my $startcount = 5;
2354: my $lastcontainer = $startcount;
2355: # preparing what is to show ...
1.461 neumanie 2356: while ($curRes = $it->next()) {
2357: if ($curRes == $it->BEGIN_MAP()) {
2358: $depth++;
1.468 amueller 2359: $parent{$depth}= $lastcontainer;
1.461 neumanie 2360: }
2361: if ($curRes == $it->END_MAP()) {
2362: $depth--;
1.468 amueller 2363: $lastcontainer = $parent{$depth};
1.461 neumanie 2364: }
2365: if (ref($curRes)) {
1.468 amueller 2366: my $symb = $curRes->symb();
2367: my $ressymb = $symb;
1.461 neumanie 2368: if (($curRes->is_sequence()) || ($curRes->is_page())) {
2369: my $type = 'sequence';
2370: if ($curRes->is_page()) {
2371: $type = 'page';
2372: }
2373: my $id= $curRes->id();
1.468 amueller 2374: my $srcf = $curRes->src();
2375: my $resource_name = &Apache::lonnet::gettitle($srcf);
2376: if(!exists($treeinfo->{$id})) {
2377: push(@$tree,$id);
1.473 amueller 2378: my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());
1.468 amueller 2379: $treeinfo->{$id} = {
1.461 neumanie 2380: depth => $depth,
2381: type => $type,
1.468 amueller 2382: name => $resource_name,
2383: enclosing_map_folder => $enclosing_map_folder,
1.461 neumanie 2384: };
1.462 neumanie 2385: }
1.461 neumanie 2386: }
2387: }
2388: }
1.462 neumanie 2389: }
1.473 amueller 2390: # Show it ...
1.484 amueller 2391: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461 neumanie 2392: if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
2393: my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497 bisitz 2394: my $whitespace =
2395: '<img src="'
2396: .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
2397: .'" alt="" />';
2398:
1.498 bisitz 2399: # Info about selectable folders/maps
2400: $r->print(
2401: '<div class="LC_info">'
1.508 www 2402: .&mt('You can only select maps and folders which have modifiable settings.')
2403: .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder')
1.498 bisitz 2404: .'</div>'
2405: );
2406:
1.536 raeburn 2407: $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523 raeburn 2408: $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497 bisitz 2409:
1.498 bisitz 2410: # Display row: "All Maps or Folders"
2411: $r->print(
1.523 raeburn 2412: &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498 bisitz 2413: .'<td>'
2414: .'<label>'
2415: .'<input type="radio" name="pschp"'
1.497 bisitz 2416: );
2417: $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498 bisitz 2418: $r->print(
2419: ' value="all" /> '.$icon.' '
2420: .&mt('All Maps or Folders')
2421: .'</label>'
2422: .'<hr /></td>'
2423: .&Apache::loncommon::end_data_table_row()
1.463 bisitz 2424: );
1.497 bisitz 2425:
1.532 raeburn 2426: # Display row: "Main Content"
1.468 amueller 2427: if (exists($$allmaps{1})) {
1.498 bisitz 2428: $r->print(
2429: &Apache::loncommon::start_data_table_row()
2430: .'<td>'
2431: .'<label>'
2432: .'<input type="radio" name="pschp" value="1"'
1.468 amueller 2433: );
1.497 bisitz 2434: $r->print(' checked="checked"') if ($pschp eq '1');
1.498 bisitz 2435: $r->print(
2436: '/> '.$icon.' '
2437: .$$maptitles{1}
2438: .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
2439: .'</label>'
2440: .'</td>'
2441: .&Apache::loncommon::end_data_table_row()
1.468 amueller 2442: );
2443: }
1.497 bisitz 2444:
2445: # Display rows for all course maps and folders
1.468 amueller 2446: foreach my $id (@{$tree}) {
2447: my ($mapid,$resid)=split(/\./,$id);
1.464 bisitz 2448: # Indentation
1.468 amueller 2449: my $depth = $treeinfo->{$id}->{'depth'};
1.464 bisitz 2450: my $indent;
2451: for (my $i = 0; $i < $depth; $i++) {
2452: $indent.= $whitespace;
2453: }
1.461 neumanie 2454: $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468 amueller 2455: if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461 neumanie 2456: $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
2457: }
1.468 amueller 2458: my $symb_name = $$symbp{$id};
2459: my ($front, $tail) = split (/___${resid}___/, $symb_name);
2460: $symb_name = $tail;
1.498 bisitz 2461: $r->print(
2462: &Apache::loncommon::start_data_table_row()
2463: .'<td>'
2464: .'<label>'
1.463 bisitz 2465: );
1.498 bisitz 2466: # Only offer radio button for folders/maps which can be parameterized
2467: if ($allmaps_inverted{$symb_name}) {
2468: $r->print(
2469: '<input type ="radio" name="pschp"'
2470: .' value="'.$allmaps_inverted{$symb_name}.'"'
2471: );
2472: $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
2473: $r->print('/>');
2474: } else {
2475: $r->print($whitespace);
1.461 neumanie 2476: }
1.498 bisitz 2477: $r->print(
2478: $indent.$icon.' '
2479: .$treeinfo->{$id}->{name}
2480: .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
2481: .'</label>'
2482: .'</td>'
2483: .&Apache::loncommon::end_data_table_row()
1.463 bisitz 2484: );
1.461 neumanie 2485: }
1.497 bisitz 2486:
1.523 raeburn 2487: $r->print(&Apache::loncommon::end_data_table().
2488: '<br style="line-height:2px;" />'.
2489: &Apache::loncommon::end_scrollbox());
1.209 www 2490: }
2491: }
2492:
1.563 damieng 2493: # Prints HTML to select the parameter level (resource, map/folder or course).
2494: # Used by table and overview modes.
2495: #
2496: # @param {Apache2::RequestRec} $r - the Apache request
2497: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
2498: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209 www 2499: sub levelmenu {
1.446 bisitz 2500: my ($r,$alllevs,$parmlev)=@_;
2501:
1.548 raeburn 2502: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
2503: &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474 amueller 2504: $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548 raeburn 2505: foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
2506: $r->print('<option value="'.$$alllevs{$lev}.'"');
2507: if ($parmlev eq $$alllevs{$lev}) {
2508: $r->print(' selected="selected"');
2509: }
2510: $r->print('>'.&mt($lev).'</option>');
1.208 www 2511: }
1.446 bisitz 2512: $r->print("</select>");
1.208 www 2513: }
2514:
1.211 www 2515:
1.563 damieng 2516: # Returns HTML to select a section (with a select HTML element).
2517: # Used by overview mode.
2518: #
2519: # @param {array reference} $selectedsections - list of selected section ids
2520: # @returns {string}
1.211 www 2521: sub sectionmenu {
1.553 raeburn 2522: my ($selectedsections)=@_;
1.300 albertel 2523: my %sectionhash = &Apache::loncommon::get_sections();
1.553 raeburn 2524: return '' if (!%sectionhash);
1.300 albertel 2525:
1.552 raeburn 2526: my (@possibles,$disabled);
2527: if ($env{'request.course.sec'} ne '') {
2528: @possibles = ($env{'request.course.sec'});
2529: $selectedsections = [$env{'request.course.sec'}];
2530: $disabled = ' disabled="disabled"';
2531: } else {
2532: @possibles = ('all',sort(keys(%sectionhash)));
2533: }
1.553 raeburn 2534: my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552 raeburn 2535: foreach my $s (@possibles) {
1.553 raeburn 2536: $output .= ' <option value="'.$s.'"';
2537: if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {
2538: $output .= ' selected="selected"';
1.473 amueller 2539: }
1.553 raeburn 2540: $output .= '>'."$s</option>\n";
1.300 albertel 2541: }
1.553 raeburn 2542: $output .= "</select>\n";
2543: return $output;
1.269 raeburn 2544: }
2545:
1.563 damieng 2546: # Returns HTML to select a group (with a select HTML element).
2547: # Used by overview mode.
2548: #
2549: # @param {array reference} $selectedgroups - list of selected group names
2550: # @returns {string}
1.269 raeburn 2551: sub groupmenu {
1.553 raeburn 2552: my ($selectedgroups)=@_;
2553: my %grouphash;
2554: if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
2555: %grouphash = &Apache::longroup::coursegroups();
2556: } elsif ($env{'request.course.groups'} ne '') {
2557: map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
2558: }
2559: return '' if (!%grouphash);
1.299 albertel 2560:
1.553 raeburn 2561: my $output = '<select name="Group" multiple="multiple" size="8">';
1.299 albertel 2562: foreach my $group (sort(keys(%grouphash))) {
1.553 raeburn 2563: $output .= ' <option value="'.$group.'"';
2564: if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
2565: $output .= ' selected="selected"';
1.473 amueller 2566: }
1.553 raeburn 2567: $output .= '>'."$group</option>\n";
1.211 www 2568: }
1.553 raeburn 2569: $output .= "</select>\n";
2570: return $output;
1.211 www 2571: }
2572:
1.563 damieng 2573: # Returns an array with the given parameter split by comma.
2574: # Used by assessparms (table mode).
2575: #
2576: # @param {string} $keyp - the string to split
2577: # @returns {Array<string>}
1.210 www 2578: sub keysplit {
2579: my $keyp=shift;
2580: return (split(/\,/,$keyp));
2581: }
2582:
1.563 damieng 2583: # Returns the keys in $name, sorted using $keyorder.
2584: # Parameters are sorted by key, which means they are sorted by part first, then by name.
2585: # Used by assessparms (table mode) for resource level.
2586: #
2587: # @param {hash reference} $name - parameter key -> parameter name
2588: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
2589: # @returns {Array<string>}
1.210 www 2590: sub keysinorder {
2591: my ($name,$keyorder)=@_;
2592: return sort {
1.560 damieng 2593: $$keyorder{$a} <=> $$keyorder{$b};
1.548 raeburn 2594: } (keys(%{$name}));
1.210 www 2595: }
2596:
1.563 damieng 2597: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
2598: # Used by assessparms (table mode) for map and general levels.
2599: #
2600: # @param {hash reference} $name - parameter key -> parameter name
2601: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
2602: # @returns {Array<string>}
1.236 albertel 2603: sub keysinorder_bytype {
2604: my ($name,$keyorder)=@_;
2605: return sort {
1.563 damieng 2606: my $ta=(split('_',$a))[-1]; # parameter name
1.560 damieng 2607: my $tb=(split('_',$b))[-1];
2608: if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
2609: return ($a cmp $b);
2610: }
2611: $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548 raeburn 2612: } (keys(%{$name}));
1.236 albertel 2613: }
2614:
1.563 damieng 2615: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
2616: # Used by defaultsetter (parameter settings default actions).
2617: #
2618: # @param {hash reference} $name - hash parameter name -> parameter title
2619: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
2620: # @returns {Array<string>}
1.211 www 2621: sub keysindisplayorder {
2622: my ($name,$keyorder)=@_;
2623: return sort {
1.560 damieng 2624: $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548 raeburn 2625: } (keys(%{$name}));
1.211 www 2626: }
2627:
1.563 damieng 2628: # Prints HTML with a choice to sort results by realm or student first.
2629: # Used by overview mode.
2630: #
2631: # @param {Apache2::RequestRec} $r - the Apache request
2632: # @param {string} $sortorder - realmstudent|studentrealm
1.214 www 2633: sub sortmenu {
2634: my ($r,$sortorder)=@_;
1.236 albertel 2635: $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214 www 2636: if ($sortorder eq 'realmstudent') {
1.422 bisitz 2637: $r->print(' checked="checked"');
1.214 www 2638: }
2639: $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236 albertel 2640: $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214 www 2641: if ($sortorder eq 'studentrealm') {
1.422 bisitz 2642: $r->print(' checked="checked"');
1.214 www 2643: }
1.236 albertel 2644: $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473 amueller 2645: '</label>');
1.214 www 2646: }
2647:
1.563 damieng 2648: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
2649: #
2650: # @returns {hash}
1.211 www 2651: sub standardkeyorder {
2652: return ('parameter_0_opendate' => 1,
1.473 amueller 2653: 'parameter_0_duedate' => 2,
2654: 'parameter_0_answerdate' => 3,
2655: 'parameter_0_interval' => 4,
2656: 'parameter_0_weight' => 5,
2657: 'parameter_0_maxtries' => 6,
2658: 'parameter_0_hinttries' => 7,
2659: 'parameter_0_contentopen' => 8,
2660: 'parameter_0_contentclose' => 9,
2661: 'parameter_0_type' => 10,
2662: 'parameter_0_problemstatus' => 11,
2663: 'parameter_0_hiddenresource' => 12,
2664: 'parameter_0_hiddenparts' => 13,
2665: 'parameter_0_display' => 14,
2666: 'parameter_0_ordered' => 15,
2667: 'parameter_0_tol' => 16,
2668: 'parameter_0_sig' => 17,
2669: 'parameter_0_turnoffunit' => 18,
1.521 raeburn 2670: 'parameter_0_discussend' => 19,
2671: 'parameter_0_discusshide' => 20,
2672: 'parameter_0_discussvote' => 21,
1.560 damieng 2673: 'parameter_0_printstartdate' => 22,
2674: 'parameter_0_printenddate' => 23);
1.211 www 2675: }
2676:
1.59 matthew 2677:
1.560 damieng 2678: # Table mode UI.
1.563 damieng 2679: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
2680: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
2681: #
2682: # Parameters used from the request:
2683: # action - handler action (see handler), usermenu is checking for value 'settable'
2684: # cgroup - selected group
2685: # command - 'set': direct access to table mode for a resource
2686: # csec - selected section
2687: # dis - set when the "Update Display" button was used, used only to discard command 'set'
2688: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
2689: # id - student/employee ID
2690: # parmlev - selected level (full|map|general)
2691: # part - selected part (unused ?)
2692: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
2693: # pres_type - &&&-separated parameter types
2694: # pres_value - &&&-separated parameter values
2695: # prevvisit - '1' if the user has submitted the form before
2696: # pscat (multiple values) - selected parameter names
1.566 damieng 2697: # pschp - selected map pc, or 'all'
1.563 damieng 2698: # psprt (multiple values) - list of selected parameter parts
2699: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
2700: # recent_* (* = parameter type) - recent values entered by the user for parameter types
2701: # symb - resource symb (when a single resource is selected)
2702: # udom - selected user domain
2703: # uname - selected user name
2704: # url - used only with command 'set', the resource url
2705: #
2706: # @param {Apache2::RequestRec} $r - the Apache request
1.568 raeburn 2707: # @param $parm_permission - ref to hash of permissions
2708: # if $parm_permission->{'edit'} is true, editing is allowed.
1.30 www 2709: sub assessparms {
1.1 www 2710:
1.568 raeburn 2711: my ($r,$parm_permission) = @_;
1.201 www 2712:
1.512 foxr 2713:
2714: # -------------------------------------------------------- Variable declaration
1.566 damieng 2715: my @ids=(); # resource and map ids
2716: my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
2717: my %mapp=(); # hash map pc or resource/map id -> enclosing map src
2718: my %typep=(); # hash resource/map id -> resource type (file extension)
2719: my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
2720: my %uris=(); # hash resource/map id -> resource src
2721: my %maptitles=(); # hash map pc or src -> map title
2722: my %allmaps=(); # hash map pc -> map src
1.563 damieng 2723: my %alllevs=(); # hash English level title -> value
2724:
2725: my $uname; # selected user name
2726: my $udom; # selected user domain
2727: my $uhome; # server with the user's files, or 'no_host'
2728: my $csec; # selected section name
2729: my $cgroup; # selected group name
2730: my @usersgroups = (); # list of the user groups
1.446 bisitz 2731:
1.190 albertel 2732: my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187 www 2733:
1.57 albertel 2734: $alllevs{'Resource Level'}='full';
1.215 www 2735: $alllevs{'Map/Folder Level'}='map';
1.57 albertel 2736: $alllevs{'Course Level'}='general';
2737:
1.563 damieng 2738: my %allparms; # hash parameter name -> parameter title
2739: my %allparts; # hash parameter part -> part title
1.512 foxr 2740: # ------------------------------------------------------------------------------
2741:
1.210 www 2742: #
2743: # Order in which these parameters will be displayed
2744: #
1.211 www 2745: my %keyorder=&standardkeyorder();
2746:
1.512 foxr 2747: # @ids=();
2748: # %symbp=(); # These seem defined above already.
2749: # %typep=();
1.43 albertel 2750:
2751: my $message='';
2752:
1.190 albertel 2753: $csec=$env{'form.csec'};
1.552 raeburn 2754: if ($env{'request.course.sec'} ne '') {
2755: $csec = $env{'request.course.sec'};
2756: }
2757:
1.553 raeburn 2758: # Check group privs.
1.269 raeburn 2759: $cgroup=$env{'form.cgroup'};
1.553 raeburn 2760: my $noeditgrp;
2761: if ($cgroup ne '') {
2762: unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
2763: if (($env{'request.course.groups'} eq '') ||
2764: (!grep(/^\Q$cgroup\E$/,split(/,/,$env{'request.course.groups'})))) {
2765: $noeditgrp = 1;
2766: }
2767: }
2768: }
1.188 www 2769:
1.190 albertel 2770: if ($udom=$env{'form.udom'}) {
2771: } elsif ($udom=$env{'request.role.domain'}) {
2772: } elsif ($udom=$env{'user.domain'}) {
1.172 albertel 2773: } else {
1.473 amueller 2774: $udom=$r->dir_config('lonDefDomain');
1.172 albertel 2775: }
1.468 amueller 2776:
1.43 albertel 2777:
1.134 albertel 2778: my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190 albertel 2779: my $pschp=$env{'form.pschp'};
1.506 www 2780:
2781:
1.134 albertel 2782: my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516 www 2783: if (!@psprt) { $psprt[0]='all'; }
1.506 www 2784: if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57 albertel 2785:
1.43 albertel 2786: my $pssymb='';
1.57 albertel 2787: my $parmlev='';
1.446 bisitz 2788:
1.190 albertel 2789: unless ($env{'form.parmlev'}) {
1.57 albertel 2790: $parmlev = 'map';
2791: } else {
1.190 albertel 2792: $parmlev = $env{'form.parmlev'};
1.57 albertel 2793: }
1.26 www 2794:
1.29 www 2795: # ----------------------------------------------- Was this started from grades?
2796:
1.560 damieng 2797: if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
2798: (!$env{'form.dis'})) {
1.473 amueller 2799: my $url=$env{'form.url'};
2800: $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
2801: $pssymb=&Apache::lonnet::symbread($url);
2802: if (!@pscat) { @pscat=('all'); }
2803: $pschp='';
1.57 albertel 2804: $parmlev = 'full';
1.190 albertel 2805: } elsif ($env{'form.symb'}) {
1.473 amueller 2806: $pssymb=$env{'form.symb'};
2807: if (!@pscat) { @pscat=('all'); }
2808: $pschp='';
1.57 albertel 2809: $parmlev = 'full';
1.43 albertel 2810: } else {
1.473 amueller 2811: $env{'form.url'}='';
1.43 albertel 2812: }
2813:
1.190 albertel 2814: my $id=$env{'form.id'};
1.43 albertel 2815: if (($id) && ($udom)) {
1.555 raeburn 2816: $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473 amueller 2817: if ($uname) {
2818: $id='';
2819: } else {
2820: $message=
1.540 bisitz 2821: '<p class="LC_warning">'.
2822: &mt('Unknown ID [_1] at domain [_2]',
2823: "'".$id."'","'".$udom."'").
2824: '</p>';
1.473 amueller 2825: }
1.43 albertel 2826: } else {
1.473 amueller 2827: $uname=$env{'form.uname'};
1.43 albertel 2828: }
2829: unless ($udom) { $uname=''; }
2830: $uhome='';
2831: if ($uname) {
1.473 amueller 2832: $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43 albertel 2833: if ($uhome eq 'no_host') {
1.473 amueller 2834: $message=
1.540 bisitz 2835: '<p class="LC_warning">'.
2836: &mt('Unknown user [_1] at domain [_2]',
2837: "'".$uname."'","'".$udom."'").
2838: '</p>';
1.473 amueller 2839: $uname='';
1.12 www 2840: } else {
1.473 amueller 2841: $csec=&Apache::lonnet::getsection($udom,$uname,
2842: $env{'request.course.id'});
2843: if ($csec eq '-1') {
1.540 bisitz 2844: $message=
2845: '<p class="LC_warning">'.
2846: &mt('User [_1] at domain [_2] not in this course',
2847: "'".$uname."'","'".$udom."'").
2848: '</p>';
1.473 amueller 2849: $uname='';
2850: $csec=$env{'form.csec'};
1.269 raeburn 2851: $cgroup=$env{'form.cgroup'};
1.473 amueller 2852: } else {
2853: my %name=&Apache::lonnet::userenvironment($udom,$uname,
2854: ('firstname','middlename','lastname','generation','id'));
2855: $message="\n<p>\n".&mt("Full Name").": ".
2856: $name{'firstname'}.' '.$name{'middlename'}.' '
2857: .$name{'lastname'}.' '.$name{'generation'}.
1.501 bisitz 2858: "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473 amueller 2859: }
1.297 raeburn 2860: @usersgroups = &Apache::lonnet::get_users_groups(
1.275 raeburn 2861: $udom,$uname,$env{'request.course.id'});
1.297 raeburn 2862: if (@usersgroups > 0) {
1.306 albertel 2863: unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275 raeburn 2864: $cgroup = $usersgroups[0];
1.297 raeburn 2865: }
1.269 raeburn 2866: }
1.12 www 2867: }
1.43 albertel 2868: }
1.2 www 2869:
1.43 albertel 2870: unless ($csec) { $csec=''; }
1.269 raeburn 2871: unless ($cgroup) { $cgroup=''; }
1.12 www 2872:
1.14 www 2873: # --------------------------------------------------------- Get all assessments
1.446 bisitz 2874: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473 amueller 2875: \%mapp, \%symbp,\%maptitles,\%uris,
2876: \%keyorder);
1.63 bowersj2 2877:
1.57 albertel 2878: $mapp{'0.0'} = '';
2879: $symbp{'0.0'} = '';
1.99 albertel 2880:
1.14 www 2881: # ---------------------------------------------------------- Anything to store?
1.568 raeburn 2882: if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205 www 2883: my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
2884: my @values=split(/\&\&\&/,$env{'form.pres_value'});
2885: my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500 raeburn 2886: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
2887: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504 raeburn 2888: my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
2889: my ($got_chostname,$chostname,$cmajor,$cminor);
2890: my $totalstored = 0;
1.546 raeburn 2891: my $now = time;
1.473 amueller 2892: for (my $i=0;$i<=$#markers;$i++) {
1.557 raeburn 2893: my ($needsrelease,$needsnewer,$name,$namematch);
1.556 raeburn 2894: if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552 raeburn 2895: next if ($csec ne $env{'request.course.sec'});
2896: }
1.556 raeburn 2897: if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553 raeburn 2898: next if ($noeditgrp);
1.557 raeburn 2899: }
2900: if ($markers[$i] =~ /\&(17|11|7|3)$/) {
2901: $namematch = 'maplevelrecurse';
2902: }
1.556 raeburn 2903: if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437 raeburn 2904: my (@ok_slots,@fail_slots,@del_slots);
2905: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
2906: my ($level,@all) =
2907: &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
2908: $csec,$cgroup,$courseopt);
2909: foreach my $slot_name (split(/:/,$values[$i])) {
2910: next if ($slot_name eq '');
2911: if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
2912: push(@ok_slots,$slot_name);
2913:
2914: } else {
2915: push(@fail_slots,$slot_name);
2916: }
2917: }
2918: if (@ok_slots) {
2919: $values[$i] = join(':',@ok_slots);
2920: } else {
2921: $values[$i] = '';
2922: }
2923: if ($all[$level] ne '') {
2924: my @existing = split(/:/,$all[$level]);
2925: foreach my $slot_name (@existing) {
2926: if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
2927: if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
2928: push(@del_slots,$slot_name);
2929: }
2930: }
2931: }
2932: }
1.554 raeburn 2933: } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514 raeburn 2934: $name = $1;
1.533 raeburn 2935: my $val = $values[$i];
1.549 raeburn 2936: my $valmatch = '';
1.533 raeburn 2937: if ($name eq 'examcode') {
1.544 raeburn 2938: if (&Apache::lonnet::validCODE($values[$i])) {
2939: $val = 'valid';
2940: }
1.546 raeburn 2941: } elsif ($name eq 'printstartdate') {
2942: if ($val =~ /^\d+$/) {
2943: if ($val > $now) {
2944: $val = 'future';
2945: }
2946: }
2947: } elsif ($name eq 'printenddate') {
2948: if ($val =~ /^\d+$/) {
2949: if ($val < $now) {
2950: $val = 'past';
2951: }
2952: }
1.549 raeburn 2953: } elsif (($name eq 'lenient') || ($name eq 'acc')) {
2954: my $stringtype = &get_stringtype($name);
2955: my $stringmatch = &standard_string_matches($stringtype);
2956: if (ref($stringmatch) eq 'ARRAY') {
2957: foreach my $item (@{$stringmatch}) {
2958: if (ref($item) eq 'ARRAY') {
2959: my ($regexpname,$pattern) = @{$item};
2960: if ($pattern ne '') {
2961: if ($val =~ /$pattern/) {
2962: $valmatch = $regexpname;
2963: $val = '';
2964: last;
2965: }
2966: }
2967: }
2968: }
2969: }
1.554 raeburn 2970: } elsif ($name eq 'interval') {
2971: my $intervaltype = &get_intervaltype($name);
2972: my $intervalmatch = &standard_interval_matches($intervaltype);
2973: if (ref($intervalmatch) eq 'ARRAY') {
2974: foreach my $item (@{$intervalmatch}) {
2975: if (ref($item) eq 'ARRAY') {
2976: my ($regexpname,$pattern) = @{$item};
2977: if ($pattern ne '') {
2978: if ($val =~ /$pattern/) {
2979: $valmatch = $regexpname;
2980: $val = '';
2981: last;
2982: }
2983: }
2984: }
2985: }
2986: }
1.533 raeburn 2987: }
1.504 raeburn 2988: $needsrelease =
1.557 raeburn 2989: $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504 raeburn 2990: if ($needsrelease) {
1.505 raeburn 2991: unless ($got_chostname) {
1.514 raeburn 2992: ($chostname,$cmajor,$cminor) = ¶meter_release_vars();
1.504 raeburn 2993: $got_chostname = 1;
1.546 raeburn 2994: }
1.557 raeburn 2995: $needsnewer = ¶meter_releasecheck($name,$val,$valmatch,undef,
1.514 raeburn 2996: $needsrelease,
2997: $cmajor,$cminor);
1.500 raeburn 2998: }
1.437 raeburn 2999: }
1.504 raeburn 3000: if ($needsnewer) {
1.557 raeburn 3001: undef($namematch);
3002: } else {
3003: my $currneeded;
3004: if ($needsrelease) {
3005: $currneeded = $needsrelease;
3006: }
3007: if ($namematch) {
3008: $needsrelease =
3009: $Apache::lonnet::needsrelease{"parameter::::$namematch"};
3010: if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
3011: unless ($got_chostname) {
3012: ($chostname,$cmajor,$cminor) = ¶meter_release_vars();
3013: $got_chostname = 1;
3014: }
3015: $needsnewer = ¶meter_releasecheck(undef,undef,undef,$namematch,
3016: $needsrelease,
3017: $cmajor,$cminor);
3018: } else {
3019: undef($namematch);
3020: }
3021: }
3022: }
3023: if ($needsnewer) {
3024: $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504 raeburn 3025: $cminor,$needsrelease);
3026: } else {
3027: $message.=&storeparm(split(/\&/,$markers[$i]),
3028: $values[$i],
3029: $types[$i],
3030: $uname,$udom,$csec,$cgroup);
3031: $totalstored ++;
3032: }
1.473 amueller 3033: }
1.68 www 3034: # ---------------------------------------------------------------- Done storing
1.504 raeburn 3035: if ($totalstored) {
3036: $message.='<p class="LC_warning">'
3037: .&mt('Changes can take up to 10 minutes before being active for all students.')
3038: .&Apache::loncommon::help_open_topic('Caching')
3039: .'</p>';
3040: }
1.68 www 3041: }
1.57 albertel 3042: #----------------------------------------------- if all selected, fill in array
1.563 damieng 3043: if ($pscat[0] eq "all") {
3044: @pscat = (keys(%allparms));
3045: }
3046: if (!@pscat) {
3047: @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
3048: };
3049: if ($psprt[0] eq "all" || !@psprt) {
3050: @psprt = (keys(%allparts));
3051: }
1.2 www 3052: # ------------------------------------------------------------------ Start page
1.63 bowersj2 3053:
1.531 raeburn 3054: my $crstype = &Apache::loncommon::course_type();
3055: &startpage($r,$pssymb,$crstype);
1.57 albertel 3056:
1.548 raeburn 3057: foreach my $item ('tolerance','date_default','date_start','date_end',
1.563 damieng 3058: 'date_interval','int','float','string') {
1.473 amueller 3059: $r->print('<input type="hidden" value="'.
1.563 damieng 3060: &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
3061: '" name="recent_'.$item.'" />');
1.44 albertel 3062: }
1.446 bisitz 3063:
1.459 bisitz 3064: # ----- Start Parameter Selection
3065:
3066: # Hide parm selection?
3067: $r->print(<<ENDPARMSELSCRIPT);
3068: <script type="text/javascript">
3069: // <![CDATA[
3070: function parmsel_show() {
1.562 damieng 3071: document.getElementById('parmsel').style.display = "";
3072: document.getElementById('parmsellink').style.display = "none";
1.459 bisitz 3073: }
3074: // ]]>
3075: </script>
3076: ENDPARMSELSCRIPT
1.474 amueller 3077:
1.445 neumanie 3078: if (!$pssymb) {
1.563 damieng 3079: # No single resource selected, print forms to select things (hidden after first selection)
1.486 www 3080: my $parmselhiddenstyle=' style="display:none"';
3081: if($env{'form.hideparmsel'} eq 'hidden') {
3082: $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
3083: } else {
3084: $r->print('<div id="parmsel">');
3085: }
3086:
1.491 bisitz 3087: # Step 1
1.523 raeburn 3088: $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
3089: $r->print('
1.474 amueller 3090: <script type="text/javascript">
1.523 raeburn 3091: // <![CDATA['.
3092: &showhide_js().'
1.474 amueller 3093: // ]]>
3094: </script>
1.523 raeburn 3095: ');
3096: $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209 www 3097: &levelmenu($r,\%alllevs,$parmlev);
1.491 bisitz 3098: $r->print(&Apache::lonhtmlcommon::row_closure());
1.474 amueller 3099: &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491 bisitz 3100: $r->print(&Apache::lonhtmlcommon::row_closure());
3101: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
3102: &partmenu($r,\%allparts,\@psprt);
1.474 amueller 3103: $r->print(&Apache::lonhtmlcommon::row_closure(1));
3104: $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491 bisitz 3105:
3106: # Step 2
1.523 raeburn 3107: $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.536 raeburn 3108: &displaymenu($r,\%allparms,\@pscat,\@psprt,\%keyorder,'parmmenuscroll');
1.491 bisitz 3109:
3110: # Step 3
1.523 raeburn 3111: $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486 www 3112: $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553 raeburn 3113: &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486 www 3114: $r->print(&Apache::lonhtmlcommon::row_closure(1));
3115: $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491 bisitz 3116:
3117: # Update Display Button
1.486 www 3118: $r->print('<p>'
3119: .'<input type="submit" name="dis"'
1.511 www 3120: .' value="'.&mt('Update Display').'" />'
1.486 www 3121: .'<input type="hidden" name="hideparmsel" value="hidden" />'
3122: .'</p>');
3123: $r->print('</div>');
1.491 bisitz 3124:
1.486 www 3125: # Offer link to display parameter selection again
3126: $r->print('<p id="parmsellink"');
3127: if ($env{'form.hideparmsel'} ne 'hidden') {
3128: $r->print($parmselhiddenstyle);
3129: }
3130: $r->print('>'
3131: .'<a href="javascript:parmsel_show()">'
3132: .&mt('Change Parameter Selection')
3133: .'</a>'
3134: .'</p>');
1.44 albertel 3135: } else {
1.478 amueller 3136: # parameter screen for a single resource.
1.486 www 3137: my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473 amueller 3138: my $title = &Apache::lonnet::gettitle($pssymb);
1.501 bisitz 3139: $r->print(&mt('Specific Resource: [_1] ([_2])',
3140: $title,'<span class="LC_filename">'.$resource.'</span>').
1.472 amueller 3141: '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486 www 3142: '<br />');
3143: $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
3144: $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553 raeburn 3145: &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486 www 3146: $r->print(&Apache::lonhtmlcommon::row_closure(1));
3147: $r->print(&Apache::lonhtmlcommon::end_pick_box());
3148: $r->print('<p>'
1.459 bisitz 3149: .'<input type="submit" name="dis"'
1.511 www 3150: .' value="'.&mt('Update Display').'" />'
1.459 bisitz 3151: .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486 www 3152: .'</p>');
1.459 bisitz 3153: }
1.478 amueller 3154:
1.486 www 3155: # ----- End Parameter Selection
1.57 albertel 3156:
1.459 bisitz 3157: # Display Messages
3158: $r->print('<div>'.$message.'</div>');
1.210 www 3159:
1.57 albertel 3160:
3161: my @temp_pscat;
3162: map {
3163: my $cat = $_;
3164: push(@temp_pscat, map { $_.'.'.$cat } @psprt);
3165: } @pscat;
3166:
3167: @pscat = @temp_pscat;
3168:
1.548 raeburn 3169:
1.209 www 3170: if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10 www 3171: # ----------------------------------------------------------------- Start Table
1.57 albertel 3172: my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190 albertel 3173: my $csuname=$env{'user.name'};
3174: my $csudom=$env{'user.domain'};
1.568 raeburn 3175: my $readonly = 1;
3176: if ($parm_permission->{'edit'}) {
3177: undef($readonly);
3178: }
1.57 albertel 3179:
1.203 www 3180: if ($parmlev eq 'full') {
1.506 www 3181: #
3182: # This produces the cascading table output of parameters
3183: #
1.578 ! raeburn 3184: my $coursespan=$csec?8:5;
! 3185: my $userspan=3;
1.560 damieng 3186: if ($cgroup ne '') {
1.578 ! raeburn 3187: $coursespan += 3;
1.560 damieng 3188: }
1.473 amueller 3189:
1.560 damieng 3190: $r->print(&Apache::loncommon::start_data_table());
3191: #
3192: # This produces the headers
3193: #
3194: $r->print('<tr><td colspan="5"></td>');
3195: $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
3196: if ($uname) {
1.473 amueller 3197: if (@usersgroups > 1) {
1.560 damieng 3198: $userspan ++;
3199: }
3200: $r->print('<th colspan="'.$userspan.'" rowspan="2">');
3201: $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
3202: }
3203: my %lt=&Apache::lonlocal::texthash(
1.473 amueller 3204: 'pie' => "Parameter in Effect",
3205: 'csv' => "Current Session Value",
1.472 amueller 3206: 'rl' => "Resource Level",
1.473 amueller 3207: 'ic' => 'in Course',
3208: 'aut' => "Assessment URL and Title",
3209: 'type' => 'Type',
3210: 'emof' => "Enclosing Map or Folder",
3211: 'part' => 'Part',
1.472 amueller 3212: 'pn' => 'Parameter Name',
1.473 amueller 3213: 'def' => 'default',
3214: 'femof' => 'from Enclosing Map or Folder',
3215: 'gen' => 'general',
3216: 'foremf' => 'for Enclosing Map or Folder',
3217: 'fr' => 'for Resource'
3218: );
1.560 damieng 3219: $r->print(<<ENDTABLETWO);
1.419 bisitz 3220: <th rowspan="3">$lt{'pie'}</th>
1.501 bisitz 3221: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578 ! raeburn 3222: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419 bisitz 3223: <th colspan="1">$lt{'ic'}</th>
1.182 albertel 3224:
1.10 www 3225: ENDTABLETWO
1.560 damieng 3226: if ($csec) {
1.578 ! raeburn 3227: $r->print('<th colspan="3">'.
1.560 damieng 3228: &mt("in Section")." $csec</th>");
3229: }
3230: if ($cgroup) {
1.578 ! raeburn 3231: $r->print('<th colspan="3">'.
1.472 amueller 3232: &mt("in Group")." $cgroup</th>");
1.560 damieng 3233: }
3234: $r->print(<<ENDTABLEHEADFOUR);
1.133 www 3235: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
3236: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578 ! raeburn 3237: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192 albertel 3238: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10 www 3239: ENDTABLEHEADFOUR
1.57 albertel 3240:
1.560 damieng 3241: if ($csec) {
1.578 ! raeburn 3242: $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560 damieng 3243: }
1.473 amueller 3244:
1.560 damieng 3245: if ($cgroup) {
1.578 ! raeburn 3246: $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560 damieng 3247: }
3248:
3249: if ($uname) {
3250: if (@usersgroups > 1) {
3251: $r->print('<th>'.&mt('Control by other group?').'</th>');
3252: }
1.578 ! raeburn 3253: $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560 damieng 3254: }
3255:
3256: $r->print('</tr>');
1.506 www 3257: #
3258: # Done with the headers
3259: #
1.560 damieng 3260: my $defbgone='';
3261: my $defbgtwo='';
3262: my $defbgthree = '';
1.57 albertel 3263:
1.560 damieng 3264: foreach my $rid (@ids) {
1.57 albertel 3265:
3266: my ($inmapid)=($rid=~/\.(\d+)$/);
3267:
1.446 bisitz 3268: if ((!$pssymb &&
1.560 damieng 3269: (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
3270: ||
3271: ($pssymb && $pssymb eq $symbp{$rid})) {
1.4 www 3272: # ------------------------------------------------------ Entry for one resource
1.473 amueller 3273: if ($defbgone eq '#E0E099') {
3274: $defbgone='#E0E0DD';
1.57 albertel 3275: } else {
1.419 bisitz 3276: $defbgone='#E0E099';
1.57 albertel 3277: }
1.419 bisitz 3278: if ($defbgtwo eq '#FFFF99') {
1.473 amueller 3279: $defbgtwo='#FFFFDD';
1.57 albertel 3280: } else {
1.473 amueller 3281: $defbgtwo='#FFFF99';
1.57 albertel 3282: }
1.419 bisitz 3283: if ($defbgthree eq '#FFBB99') {
3284: $defbgthree='#FFBBDD';
1.269 raeburn 3285: } else {
1.419 bisitz 3286: $defbgthree='#FFBB99';
1.269 raeburn 3287: }
3288:
1.57 albertel 3289: my $thistitle='';
3290: my %name= ();
3291: undef %name;
3292: my %part= ();
3293: my %display=();
3294: my %type= ();
3295: my %default=();
1.196 www 3296: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 3297:
1.506 www 3298: my $filter=$env{'form.filter'};
1.548 raeburn 3299: foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57 albertel 3300: if (grep $_ eq $tempkeyp, @catmarker) {
1.560 damieng 3301: my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name');
3302: # We may only want certain parameters listed
3303: if ($filter) {
3304: unless ($filter=~/\Q$parmname\E/) { next; }
3305: }
3306: $name{$tempkeyp}=$parmname;
3307: $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part');
3308:
3309: my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display');
3310: if ($allparms{$name{$tempkeyp}} ne '') {
3311: my $identifier;
3312: if ($parmdis =~ /(\s*\[Part.*)$/) {
3313: $identifier = $1;
3314: }
3315: $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
3316: } else {
3317: $display{$tempkeyp} = $parmdis;
3318: }
3319: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
3320: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
3321: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp);
3322: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type');
3323: $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title');
1.57 albertel 3324: }
3325: }
1.548 raeburn 3326: my $totalparms=scalar(keys(%name));
1.57 albertel 3327: if ($totalparms>0) {
1.560 damieng 3328: my $firstrow=1;
1.473 amueller 3329: my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.419 bisitz 3330: $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57 albertel 3331: ' rowspan='.$totalparms.
1.419 bisitz 3332: '><tt><font size="-1">'.
1.57 albertel 3333: join(' / ',split(/\//,$uri)).
3334: '</font></tt><p><b>'.
1.154 albertel 3335: "<a href=\"javascript:openWindow('".
1.473 amueller 3336: &Apache::lonnet::clutter($uri).'?symb='.
3337: &escape($symbp{$rid}).
1.336 albertel 3338: "', 'metadatafile', '450', '500', 'no', 'yes');\"".
3339: " target=\"_self\">$title");
1.57 albertel 3340:
3341: if ($thistitle) {
1.473 amueller 3342: $r->print(' ('.$thistitle.')');
1.57 albertel 3343: }
3344: $r->print('</a></b></td>');
1.419 bisitz 3345: $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57 albertel 3346: ' rowspan='.$totalparms.'>'.$typep{$rid}.
3347: '</td>');
3348:
1.419 bisitz 3349: $r->print('<td style="background-color:'.$defbgone.';"'.
1.57 albertel 3350: ' rowspan='.$totalparms.
1.238 www 3351: '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548 raeburn 3352: foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57 albertel 3353: unless ($firstrow) {
3354: $r->print('<tr>');
3355: } else {
3356: undef $firstrow;
3357: }
1.548 raeburn 3358: &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57 albertel 3359: \%type,\%display,$defbgone,$defbgtwo,
1.269 raeburn 3360: $defbgthree,$parmlev,$uname,$udom,$csec,
1.568 raeburn 3361: $cgroup,\@usersgroups,$noeditgrp,$readonly);
1.57 albertel 3362: }
3363: }
3364: }
3365: } # end foreach ids
1.43 albertel 3366: # -------------------------------------------------- End entry for one resource
1.517 www 3367: $r->print(&Apache::loncommon::end_data_table);
1.203 www 3368: } # end of full
1.57 albertel 3369: #--------------------------------------------------- Entry for parm level map
3370: if ($parmlev eq 'map') {
1.419 bisitz 3371: my $defbgone = '#E0E099';
3372: my $defbgtwo = '#FFFF99';
3373: my $defbgthree = '#FFBB99';
1.57 albertel 3374:
3375: my %maplist;
3376:
3377: if ($pschp eq 'all') {
1.446 bisitz 3378: %maplist = %allmaps;
1.57 albertel 3379: } else {
3380: %maplist = ($pschp => $mapp{$pschp});
3381: }
3382:
3383: #-------------------------------------------- for each map, gather information
3384: my $mapid;
1.560 damieng 3385: foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60 albertel 3386: my $maptitle = $maplist{$mapid};
1.57 albertel 3387:
3388: #----------------------- loop through ids and get all parameter types for map
3389: #----------------------------------------- and associated information
3390: my %name = ();
3391: my %part = ();
3392: my %display = ();
3393: my %type = ();
3394: my %default = ();
3395: my $map = 0;
3396:
1.473 amueller 3397: # $r->print("Catmarker: @catmarker<br />\n");
1.446 bisitz 3398:
1.548 raeburn 3399: foreach my $id (@ids) {
3400: ($map)=($id =~ /([\d]*?)\./);
3401: my $rid = $id;
1.446 bisitz 3402:
1.57 albertel 3403: # $r->print("$mapid:$map: $rid <br /> \n");
3404:
1.560 damieng 3405: if ($map eq $mapid) {
1.473 amueller 3406: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 3407: # $r->print("Keys: $keyp{$rid} <br />\n");
3408:
3409: #--------------------------------------------------------------------
3410: # @catmarker contains list of all possible parameters including part #s
3411: # $fullkeyp contains the full part/id # for the extraction of proper parameters
3412: # $tempkeyp contains part 0 only (no ids - ie, subparts)
3413: # When storing information, store as part 0
3414: # When requesting information, request from full part
3415: #-------------------------------------------------------------------
1.548 raeburn 3416: foreach my $fullkeyp (&keysplit($keyp{$rid})) {
3417: my $tempkeyp = $fullkeyp;
3418: $tempkeyp =~ s/_\w+_/_0_/;
1.473 amueller 3419:
1.548 raeburn 3420: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473 amueller 3421: $part{$tempkeyp}="0";
3422: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
3423: my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
3424: if ($allparms{$name{$tempkeyp}} ne '') {
3425: my $identifier;
3426: if ($parmdis =~ /(\s*\[Part.*)$/) {
3427: $identifier = $1;
3428: }
3429: $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
3430: } else {
3431: $display{$tempkeyp} = $parmdis;
3432: }
3433: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
3434: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
3435: $display{$tempkeyp} =~ s/_\w+_/_0_/;
3436: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
3437: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
3438: }
3439: } # end loop through keys
1.560 damieng 3440: }
1.57 albertel 3441: } # end loop through ids
1.446 bisitz 3442:
1.57 albertel 3443: #---------------------------------------------------- print header information
1.133 www 3444: my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82 www 3445: my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401 bisitz 3446: my $tmp="";
1.57 albertel 3447: if ($uname) {
1.473 amueller 3448: my $person=&Apache::loncommon::plainname($uname,$udom);
1.401 bisitz 3449: $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
3450: &mt('in')." \n";
1.57 albertel 3451: } else {
1.401 bisitz 3452: $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57 albertel 3453: }
1.269 raeburn 3454: if ($cgroup) {
1.401 bisitz 3455: $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
3456: "</i></font> ".&mt('of')." \n";
1.269 raeburn 3457: $csec = '';
3458: } elsif ($csec) {
1.401 bisitz 3459: $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
3460: "</i></font> ".&mt('of')." \n";
1.269 raeburn 3461: }
1.401 bisitz 3462: $r->print('<div align="center"><h4>'
3463: .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404 bisitz 3464: ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401 bisitz 3465: ,$tmp
3466: ,'<font color="red"><i>'.$coursename.'</i></font>'
3467: )
3468: ."<br /></h4>\n"
1.422 bisitz 3469: );
1.57 albertel 3470: #---------------------------------------------------------------- print table
1.419 bisitz 3471: $r->print('<p>'.&Apache::loncommon::start_data_table()
3472: .&Apache::loncommon::start_data_table_header_row()
3473: .'<th>'.&mt('Parameter Name').'</th>'
1.578 ! raeburn 3474: .'<th>'.&mt('Value').'</th>'
1.419 bisitz 3475: .'<th>'.&mt('Parameter in Effect').'</th>'
3476: .&Apache::loncommon::end_data_table_header_row()
3477: );
1.57 albertel 3478:
1.548 raeburn 3479: foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473 amueller 3480: $r->print(&Apache::loncommon::start_data_table_row());
1.548 raeburn 3481: &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269 raeburn 3482: \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568 raeburn 3483: $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
3484: $readonly);
1.57 albertel 3485: }
1.422 bisitz 3486: $r->print(&Apache::loncommon::end_data_table().'</p>'
3487: .'</div>'
3488: );
1.57 albertel 3489: } # end each map
3490: } # end of $parmlev eq map
3491: #--------------------------------- Entry for parm level general (Course level)
3492: if ($parmlev eq 'general') {
1.473 amueller 3493: my $defbgone = '#E0E099';
1.419 bisitz 3494: my $defbgtwo = '#FFFF99';
3495: my $defbgthree = '#FFBB99';
1.57 albertel 3496:
3497: #-------------------------------------------- for each map, gather information
3498: my $mapid="0.0";
3499: #----------------------- loop through ids and get all parameter types for map
3500: #----------------------------------------- and associated information
3501: my %name = ();
3502: my %part = ();
3503: my %display = ();
3504: my %type = ();
3505: my %default = ();
1.446 bisitz 3506:
1.548 raeburn 3507: foreach $id (@ids) {
3508: my $rid = $id;
1.446 bisitz 3509:
1.196 www 3510: my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57 albertel 3511:
3512: #--------------------------------------------------------------------
3513: # @catmarker contains list of all possible parameters including part #s
3514: # $fullkeyp contains the full part/id # for the extraction of proper parameters
3515: # $tempkeyp contains part 0 only (no ids - ie, subparts)
3516: # When storing information, store as part 0
3517: # When requesting information, request from full part
3518: #-------------------------------------------------------------------
1.548 raeburn 3519: foreach my $fullkeyp (&keysplit($keyp{$rid})) {
3520: my $tempkeyp = $fullkeyp;
3521: $tempkeyp =~ s/_\w+_/_0_/;
3522: if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473 amueller 3523: $part{$tempkeyp}="0";
3524: $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
3525: my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
3526: if ($allparms{$name{$tempkeyp}} ne '') {
3527: my $identifier;
3528: if ($parmdis =~ /(\s*\[Part.*)$/) {
3529: $identifier = $1;
3530: }
3531: $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
3532: } else {
3533: $display{$tempkeyp} = $parmdis;
3534: }
3535: unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
3536: $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
3537: $display{$tempkeyp} =~ s/_\w+_/_0_/;
3538: $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
3539: $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1.560 damieng 3540: }
1.57 albertel 3541: } # end loop through keys
3542: } # end loop through ids
1.446 bisitz 3543:
1.57 albertel 3544: #---------------------------------------------------- print header information
1.473 amueller 3545: my $setdef=&mt("Set Defaults for All Resources in Course");
1.57 albertel 3546: $r->print(<<ENDMAPONE);
1.419 bisitz 3547: <center>
3548: <h4>$setdef
1.135 albertel 3549: <font color="red"><i>$coursename</i></font><br />
1.57 albertel 3550: ENDMAPONE
3551: if ($uname) {
1.473 amueller 3552: my $person=&Apache::loncommon::plainname($uname,$udom);
1.135 albertel 3553: $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57 albertel 3554: } else {
1.135 albertel 3555: $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57 albertel 3556: }
1.446 bisitz 3557:
1.135 albertel 3558: if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306 albertel 3559: if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135 albertel 3560: $r->print("</h4>\n");
1.57 albertel 3561: #---------------------------------------------------------------- print table
1.419 bisitz 3562: $r->print('<p>'.&Apache::loncommon::start_data_table()
3563: .&Apache::loncommon::start_data_table_header_row()
3564: .'<th>'.&mt('Parameter Name').'</th>'
3565: .'<th>'.&mt('Default Value').'</th>'
3566: .'<th>'.&mt('Parameter in Effect').'</th>'
3567: .&Apache::loncommon::end_data_table_header_row()
3568: );
1.57 albertel 3569:
1.548 raeburn 3570: foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419 bisitz 3571: $r->print(&Apache::loncommon::start_data_table_row());
1.548 raeburn 3572: &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568 raeburn 3573: \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
3574: $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
3575: $readonly);
1.57 albertel 3576: }
1.419 bisitz 3577: $r->print(&Apache::loncommon::end_data_table()
3578: .'</p>'
3579: .'</center>'
3580: );
1.57 albertel 3581: } # end of $parmlev eq general
1.43 albertel 3582: }
1.507 www 3583: $r->print('</form>');
3584: &endSettingsScreen($r);
3585: $r->print(&Apache::loncommon::end_page());
1.57 albertel 3586: } # end sub assessparms
1.30 www 3587:
1.560 damieng 3588:
3589:
1.120 www 3590: ##################################################
1.560 damieng 3591: # OVERVIEW MODE
1.207 www 3592: ##################################################
1.124 www 3593:
1.563 damieng 3594: my $tableopen; # boolean, true if HTML table is already opened
3595:
3596: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
3597: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
3598: # @returns {string}
1.124 www 3599: sub tablestart {
1.576 raeburn 3600: my ($readonly,$is_map) = @_;
1.124 www 3601: if ($tableopen) {
1.552 raeburn 3602: return '';
1.124 www 3603: } else {
1.552 raeburn 3604: $tableopen=1;
3605: my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
3606: if ($readonly) {
3607: $output .= '<th>'.&mt('Current value').'</th>';
3608: } else {
1.576 raeburn 3609: $output .= '<th>'.&mt('Delete').'</th>'.
3610: '<th>'.&mt('Set to ...').'</th>';
3611: if ($is_map) {
3612: $output .= '<th>'.&mt('Recursive?').'</th>';
3613: }
1.552 raeburn 3614: }
3615: $output .= '</tr>';
3616: return $output;
1.124 www 3617: }
3618: }
3619:
1.563 damieng 3620: # Returns HTML with the HTML table end tag, unless the table is not opened.
3621: # @returns {string}
1.124 www 3622: sub tableend {
3623: if ($tableopen) {
1.560 damieng 3624: $tableopen=0;
3625: return &Apache::loncommon::end_data_table();
1.124 www 3626: } else {
1.560 damieng 3627: return'';
1.124 www 3628: }
3629: }
3630:
1.563 damieng 3631: # Reads course and user information.
3632: # If the context is looking for a scalar, returns the course parameters hash (result of lonnet::get_courseresdata, dump of course's resourcedata.db) with added student data from lonnet::get_userresdata (which reads the user's resourcedata.db).
3633: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
3634: # If the context is looking for a list, returns a list with the scalar data and the class list.
3635: # @param {string} $crs - course number
3636: # @param {string} $dom - course domain
3637: # @returns {hash reference|Array}
1.207 www 3638: sub readdata {
3639: my ($crs,$dom)=@_;
3640: # Read coursedata
3641: my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
3642: # Read userdata
3643:
3644: my $classlist=&Apache::loncoursedata::get_classlist();
1.548 raeburn 3645: foreach my $user (keys(%$classlist)) {
3646: if ($user=~/^($match_username)\:($match_domain)$/) {
3647: my ($tuname,$tudom)=($1,$2);
3648: my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
3649: foreach my $userkey (keys(%{$useropt})) {
3650: if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207 www 3651: my $newkey=$userkey;
1.548 raeburn 3652: $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
3653: $$resourcedata{$newkey}=$$useropt{$userkey};
3654: }
3655: }
1.473 amueller 3656: }
3657: }
1.552 raeburn 3658: if (wantarray) {
3659: return ($resourcedata,$classlist);
3660: } else {
3661: return $resourcedata;
3662: }
1.207 www 3663: }
3664:
3665:
1.563 damieng 3666: # Stores parameter data, using form parameters directly.
3667: #
3668: # Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data).
3669: # set_* (except settext, setipallow, setipdeny) - set a parameter value
3670: # del_* - remove a parameter
3671: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
3672: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
3673: # key_* - date values
3674: # days_* - for date intervals
3675: # hours_* - for date intervals
3676: # minutes_* - for date intervals
3677: # seconds_* - for date intervals
3678: # done_* - for date intervals
3679: # typeof_* - parameter type
3680: #
3681: # @param {Apache2::RequestRec} $r - the Apache request
3682: # @param {string} $crs - course number
3683: # @param {string} $dom - course domain
1.208 www 3684: sub storedata {
3685: my ($r,$crs,$dom)=@_;
1.207 www 3686: # Set userlevel immediately
3687: # Do an intermediate store of course level
3688: my $olddata=&readdata($crs,$dom);
1.124 www 3689: my %newdata=();
3690: undef %newdata;
3691: my @deldata=();
1.576 raeburn 3692: my @delrec=();
3693: my @delnonrec=();
1.124 www 3694: undef @deldata;
1.504 raeburn 3695: my ($got_chostname,$chostname,$cmajor,$cminor);
1.546 raeburn 3696: my $now = time;
1.560 damieng 3697: foreach my $key (keys(%env)) {
3698: if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
3699: my $cmd=$1;
3700: my $thiskey=$2;
1.576 raeburn 3701: my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
3702: next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');
3703: if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) &&
3704: ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
3705: unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
3706: $altkey = $thiskey;
3707: $altkey =~ s/\Q___(all)\E/___(rec)/;
3708: if ($env{'form.rec_'.$thiskey}) {
3709: $recursive = 1;
3710: }
3711: }
3712: }
1.560 damieng 3713: my ($tuname,$tudom)=&extractuser($thiskey);
1.473 amueller 3714: if ($tuname) {
1.576 raeburn 3715: $tkey=$thiskey;
1.560 damieng 3716: $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576 raeburn 3717: if ($altkey) {
3718: $tkeynonrec = $tkey;
3719: $tkeyrec = $altkey;
3720: $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
3721: }
1.560 damieng 3722: }
3723: if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563 damieng 3724: my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
3725: if ($cmd eq 'set') {
3726: $data=$env{$key};
3727: $valmatch = '';
3728: $valchk = $data;
3729: $typeof=$env{'form.typeof_'.$thiskey};
3730: $text = &mt('Saved modified parameter for');
3731: if ($typeof eq 'string_questiontype') {
3732: $name = 'type';
3733: } elsif ($typeof eq 'string_lenient') {
3734: $name = 'lenient';
3735: my $stringmatch = &standard_string_matches($typeof);
3736: if (ref($stringmatch) eq 'ARRAY') {
3737: foreach my $item (@{$stringmatch}) {
3738: if (ref($item) eq 'ARRAY') {
3739: my ($regexpname,$pattern) = @{$item};
3740: if ($pattern ne '') {
3741: if ($data =~ /$pattern/) {
3742: $valmatch = $regexpname;
3743: $valchk = '';
3744: last;
3745: }
1.560 damieng 3746: }
1.549 raeburn 3747: }
3748: }
3749: }
1.563 damieng 3750: } elsif ($typeof eq 'string_discussvote') {
3751: $name = 'discussvote';
3752: } elsif ($typeof eq 'string_examcode') {
3753: $name = 'examcode';
3754: if (&Apache::lonnet::validCODE($data)) {
3755: $valchk = 'valid';
3756: }
3757: } elsif ($typeof eq 'string_yesno') {
3758: if ($thiskey =~ /\.retrypartial$/) {
3759: $name = 'retrypartial';
3760: }
1.549 raeburn 3761: }
1.563 damieng 3762: } elsif ($cmd eq 'datepointer') {
3763: $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
3764: $typeof=$env{'form.typeof_'.$thiskey};
3765: $text = &mt('Saved modified date for');
3766: if ($typeof eq 'date_start') {
3767: if ($thiskey =~ /\.printstartdate$/) {
3768: $name = 'printstartdate';
3769: if (($data) && ($data > $now)) {
3770: $valchk = 'future';
3771: }
1.560 damieng 3772: }
1.563 damieng 3773: } elsif ($typeof eq 'date_end') {
3774: if ($thiskey =~ /\.printenddate$/) {
3775: $name = 'printenddate';
3776: if (($data) && ($data < $now)) {
3777: $valchk = 'past';
3778: }
1.560 damieng 3779: }
1.504 raeburn 3780: }
1.563 damieng 3781: } elsif ($cmd eq 'dateinterval') {
3782: $data=&get_date_interval_from_form($thiskey);
3783: if ($thiskey =~ /\.interval$/) {
3784: $name = 'interval';
3785: my $intervaltype = &get_intervaltype($name);
3786: my $intervalmatch = &standard_interval_matches($intervaltype);
3787: if (ref($intervalmatch) eq 'ARRAY') {
3788: foreach my $item (@{$intervalmatch}) {
3789: if (ref($item) eq 'ARRAY') {
3790: my ($regexpname,$pattern) = @{$item};
3791: if ($pattern ne '') {
3792: if ($data =~ /$pattern/) {
3793: $valmatch = $regexpname;
3794: $valchk = '';
3795: last;
3796: }
1.560 damieng 3797: }
1.554 raeburn 3798: }
3799: }
3800: }
3801: }
1.563 damieng 3802: $typeof=$env{'form.typeof_'.$thiskey};
3803: $text = &mt('Saved modified date for');
1.554 raeburn 3804: }
1.576 raeburn 3805: if ($recursive) {
1.563 damieng 3806: $namematch = 'maplevelrecurse';
1.560 damieng 3807: }
1.563 damieng 3808: if (($name ne '') || ($namematch ne '')) {
3809: my ($needsrelease,$needsnewer);
3810: if ($name ne '') {
3811: $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560 damieng 3812: if ($needsrelease) {
3813: unless ($got_chostname) {
1.563 damieng 3814: ($chostname,$cmajor,$cminor)=¶meter_release_vars();
1.560 damieng 3815: $got_chostname = 1;
3816: }
1.563 damieng 3817: $needsnewer = ¶meter_releasecheck($name,$valchk,$valmatch,undef,
3818: $needsrelease,
3819: $cmajor,$cminor);
3820: }
3821: }
3822: if ($namematch ne '') {
3823: if ($needsnewer) {
3824: undef($namematch);
1.560 damieng 3825: } else {
1.563 damieng 3826: my $currneeded;
3827: if ($needsrelease) {
3828: $currneeded = $needsrelease;
3829: }
3830: $needsrelease =
3831: $Apache::lonnet::needsrelease{"parameter::::$namematch"};
3832: if (($needsrelease) &&
3833: (($currneeded eq '') || ($needsrelease < $currneeded))) {
3834: unless ($got_chostname) {
3835: ($chostname,$cmajor,$cminor) = ¶meter_release_vars();
3836: $got_chostname = 1;
3837: }
3838: $needsnewer = ¶meter_releasecheck(undef,$valchk,$valmatch,
3839: $namematch, $needsrelease,$cmajor,$cminor);
3840: } else {
3841: undef($namematch);
3842: }
1.560 damieng 3843: }
1.557 raeburn 3844: }
1.563 damieng 3845: if ($needsnewer) {
3846: $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
3847: $chostname,$cmajor,
3848: $cminor,$needsrelease));
3849: next;
3850: }
1.504 raeburn 3851: }
1.576 raeburn 3852: my ($reconlychg,$haschange,$storekey);
3853: if ($tuname) {
3854: my $ustorekey;
3855: if ($altkey) {
3856: if ($recursive) {
3857: if (exists($$olddata{$thiskey})) {
3858: if ($$olddata{$thiskey} eq $data) {
3859: $reconlychg = 1;
3860: }
3861: &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
3862: }
3863: if (exists($$olddata{$altkey})) {
3864: if (defined($data) && $$olddata{$altkey} ne $data) {
3865: $haschange = 1;
3866: }
3867: } elsif ((!$reconlychg) && ($data ne '')) {
3868: $haschange = 1;
3869: }
3870: $ustorekey = $tkeyrec;
3871: } else {
3872: if (exists($$olddata{$altkey})) {
3873: if ($$olddata{$altkey} eq $data) {
3874: $reconlychg = 1;
3875: }
3876: &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
3877: }
3878: if (exists($$olddata{$thiskey})) {
3879: if (defined($data) && $$olddata{$thiskey} ne $data) {
3880: $haschange = 1;
3881: }
3882: } elsif ((!$reconlychg) && ($data ne '')) {
3883: $haschange = 1;
3884: }
3885: $ustorekey = $tkeynonrec;
3886: }
3887: } else {
3888: if (exists($$olddata{$tkey})) {
3889: if (defined($data) && $$olddata{$tkey} ne $data) {
3890: $haschange = 1;
3891: }
3892: $ustorekey = $tkey;
3893: }
3894: }
3895: if ($haschange || $reconlychg) {
3896: unless ($env{'form.del_'.$thiskey}) {
3897: if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
3898: $ustorekey.'.type' => $typeof},
3899: $tudom,$tuname) eq 'ok') {
3900: &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
3901: $r->print('<br />'.$text.' '.
3902: &Apache::loncommon::plainname($tuname,$tudom));
3903: } else {
3904: $r->print('<div class="LC_error">'.
3905: &mt('Error saving parameters').'</div>');
3906: }
3907: &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
3908: }
3909: }
3910: } else {
3911: if ($altkey) {
3912: if ($recursive) {
3913: if (exists($$olddata{$thiskey})) {
3914: if ($$olddata{$thiskey} eq $data) {
3915: $reconlychg = 1;
3916: }
3917: push(@delnonrec,($thiskey,$thiskey.'.type'));
3918: }
3919: if (exists($$olddata{$altkey})) {
3920: if (defined($data) && $$olddata{$altkey} ne $data) {
3921: $haschange = 1;
3922: }
3923: } elsif (($data ne '') && (!$reconlychg)) {
3924: $haschange = 1;
3925: }
3926: $storekey = $altkey;
1.563 damieng 3927: } else {
1.576 raeburn 3928: if (exists($$olddata{$altkey})) {
3929: if ($$olddata{$altkey} eq $data) {
3930: $reconlychg = 1;
3931: }
3932: push(@delrec,($altkey,$altkey.'.type'));
3933: }
3934: if (exists($$olddata{$thiskey})) {
3935: if (defined($data) && $$olddata{$thiskey} ne $data) {
3936: $haschange = 1;
3937: }
3938: } elsif (($data ne '') && (!$reconlychg)) {
3939: $haschange = 1;
3940: }
3941: $storekey = $thiskey;
1.563 damieng 3942: }
1.560 damieng 3943: } else {
1.576 raeburn 3944: if (defined($data) && $$olddata{$thiskey} ne $data) {
3945: $haschange = 1;
3946: $storekey = $thiskey;
3947: }
3948: }
3949: }
3950: if ($reconlychg || $haschange) {
3951: unless ($env{'form.del_'.$thiskey}) {
3952: $newdata{$storekey}=$data;
3953: $newdata{$storekey.'.type'}=$typeof;
1.560 damieng 3954: }
3955: }
3956: } elsif ($cmd eq 'del') {
3957: if ($tuname) {
1.576 raeburn 3958: my $error;
3959: if ($altkey) {
3960: if (exists($$olddata{$altkey})) {
3961: if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
3962: &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
3963: if ($recursive) {
3964: $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
3965: }
3966: } elsif ($recursive) {
3967: $error = 1;
3968: }
3969: }
3970: if (exists($$olddata{$thiskey})) {
3971: if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
3972: &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
3973: unless ($recursive) {
3974: $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
3975: }
3976: } elsif (!$recursive) {
3977: $error = 1;
3978: }
3979: }
1.560 damieng 3980: } else {
1.576 raeburn 3981: if (exists($$olddata{$thiskey})) {
3982: if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
3983: &log_parmset({$tkey=>''},1,$tuname,$tudom);
3984: $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
3985: } else {
3986: $error = 1;
3987: }
3988: }
3989: }
3990: if ($error) {
1.560 damieng 3991: $r->print('<div class="LC_error">'.
3992: &mt('Error deleting parameters').'</div>');
3993: }
3994: &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
3995: } else {
1.576 raeburn 3996: if ($altkey) {
3997: if (exists($$olddata{$altkey})) {
3998: unless (grep(/^\Q$altkey\E$/,@delrec)) {
3999: push(@deldata,($altkey,$altkey.'.type'));
4000: }
4001: }
4002: if (exists($$olddata{$thiskey})) {
4003: unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
4004: push(@deldata,($thiskey,$thiskey.'.type'));
4005: }
4006: }
4007: } elsif (exists($$olddata{$thiskey})) {
4008: push(@deldata,($thiskey,$thiskey.'.type'));
4009: }
1.560 damieng 4010: }
1.473 amueller 4011: }
4012: }
4013: }
1.207 www 4014: # Store all course level
1.144 www 4015: my $delentries=$#deldata+1;
1.576 raeburn 4016: my @alldels;
4017: if (@delrec) {
4018: push(@alldels,@delrec);
4019: }
4020: if (@delnonrec) {
4021: push(@alldels,@delnonrec);
4022: }
4023: if (@deldata) {
4024: push(@alldels,@deldata);
4025: }
1.548 raeburn 4026: my @newdatakeys=keys(%newdata);
1.144 www 4027: my $putentries=$#newdatakeys+1;
1.576 raeburn 4028: my ($delresult,$devalidate);
4029: if (@alldels) {
4030: if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
4031: my %loghash=map { $_ => '' } @alldels;
1.560 damieng 4032: &log_parmset(\%loghash,1);
1.576 raeburn 4033: if ($delentries) {
4034: $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
4035: }
4036: } elsif ($delentries) {
1.560 damieng 4037: $r->print('<div class="LC_error">'.
4038: &mt('Error deleting parameters').'</div>');
4039: }
1.576 raeburn 4040: $devalidate = 1;
1.144 www 4041: }
4042: if ($putentries) {
1.560 damieng 4043: if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
4044: &log_parmset(\%newdata,0);
4045: $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
4046: } else {
4047: $r->print('<div class="LC_error">'.
4048: &mt('Error saving parameters').'</div>');
4049: }
1.576 raeburn 4050: $devalidate = 1;
4051: }
4052: if ($devalidate) {
1.560 damieng 4053: &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144 www 4054: }
1.208 www 4055: }
1.207 www 4056:
1.563 damieng 4057: # Returns the username and domain from a key created in readdata from a resourcedata key.
4058: #
4059: # @param {string} $key - the key
4060: # @returns {Array}
1.208 www 4061: sub extractuser {
4062: my $key=shift;
1.350 albertel 4063: return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208 www 4064: }
1.206 www 4065:
1.563 damieng 4066: # Parses a parameter key and returns the components.
4067: #
4068: # @param {string} $key -
4069: # @param {hash reference} $listdata -
4070: # @return {Array} - (student, resource, part, parameter)
1.381 albertel 4071: sub parse_listdata_key {
4072: my ($key,$listdata) = @_;
4073: # split into student/section affected, and
4074: # the realm (folder/resource part and parameter
1.446 bisitz 4075: my ($student,$realm) =
1.473 amueller 4076: ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381 albertel 4077: # if course wide student would be undefined
4078: if (!defined($student)) {
1.560 damieng 4079: ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381 albertel 4080: }
4081: # strip off the .type if it's not the Question type parameter
4082: if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560 damieng 4083: $realm=~s/\.type//;
1.381 albertel 4084: }
4085: # split into resource+part and parameter name
1.388 albertel 4086: my ($res, $parm) = ($realm=~/^(.*)\.(.*)$/);
4087: ($res, my $part) = ($res =~/^(.*)\.(.*)$/);
1.381 albertel 4088: return ($student,$res,$part,$parm);
4089: }
4090:
1.563 damieng 4091: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
4092: #
4093: # @param {Apache2::RequestRec} $r - the Apache request
4094: # @param {hash reference} $resourcedata - parameter data returned by readdata
4095: # @param {hash reference} $listdata - data created in secgroup_lister, course id.[section id].part.name -> 1 or course id.[section id].part.name.type -> parameter type
4096: # @param {string} $sortorder - realmstudent|studentrealm
4097: # @param {string} $caller - name of the calling sub (overview|newoverview)
4098: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568 raeburn 4099: # @param {boolean} $readonly - true if editing not allowed
1.563 damieng 4100: # @returns{integer} - number of $listdata parameters processed
1.208 www 4101: sub listdata {
1.568 raeburn 4102: my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552 raeburn 4103:
1.207 www 4104: # Start list output
1.206 www 4105:
1.122 www 4106: my $oldsection='';
4107: my $oldrealm='';
4108: my $oldpart='';
1.123 www 4109: my $pointer=0;
1.124 www 4110: $tableopen=0;
1.145 www 4111: my $foundkeys=0;
1.248 albertel 4112: my %keyorder=&standardkeyorder();
1.381 albertel 4113:
1.552 raeburn 4114: my ($secidx,%grouphash);
4115: if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
4116: $secidx = &Apache::loncoursedata::CL_SECTION();
1.553 raeburn 4117: if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
4118: %grouphash = &Apache::longroup::coursegroups();
4119: } elsif ($env{'request.course.groups'} ne '') {
4120: map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
4121: }
1.552 raeburn 4122: }
4123:
1.576 raeburn 4124: foreach my $key (sort {
1.560 damieng 4125: my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
4126: my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381 albertel 4127:
1.560 damieng 4128: # get the numerical order for the param
4129: $aparm=$keyorder{'parameter_0_'.$aparm};
4130: $bparm=$keyorder{'parameter_0_'.$bparm};
1.381 albertel 4131:
1.560 damieng 4132: my $result=0;
1.381 albertel 4133:
1.560 damieng 4134: if ($sortorder eq 'realmstudent') {
1.381 albertel 4135: if ($ares ne $bres ) {
1.560 damieng 4136: $result = ($ares cmp $bres);
1.446 bisitz 4137: } elsif ($astudent ne $bstudent) {
1.560 damieng 4138: $result = ($astudent cmp $bstudent);
4139: } elsif ($apart ne $bpart ) {
4140: $result = ($apart cmp $bpart);
4141: }
4142: } else {
4143: if ($astudent ne $bstudent) {
4144: $result = ($astudent cmp $bstudent);
4145: } elsif ($ares ne $bres ) {
4146: $result = ($ares cmp $bres);
4147: } elsif ($apart ne $bpart ) {
4148: $result = ($apart cmp $bpart);
4149: }
1.473 amueller 4150: }
1.446 bisitz 4151:
1.560 damieng 4152: if (!$result) {
1.381 albertel 4153: if (defined($aparm) && defined($bparm)) {
1.560 damieng 4154: $result = ($aparm <=> $bparm);
1.381 albertel 4155: } elsif (defined($aparm)) {
1.560 damieng 4156: $result = -1;
1.381 albertel 4157: } elsif (defined($bparm)) {
1.560 damieng 4158: $result = 1;
4159: }
1.473 amueller 4160: }
1.381 albertel 4161:
1.560 damieng 4162: $result;
4163:
1.576 raeburn 4164: } keys(%{$listdata})) { # foreach my $key
4165: my $thiskey = $key;
1.560 damieng 4166: if ($$listdata{$thiskey.'.type'}) {
4167: my $thistype=$$listdata{$thiskey.'.type'};
4168: if ($$resourcedata{$thiskey.'.type'}) {
4169: $thistype=$$resourcedata{$thiskey.'.type'};
4170: }
4171: my ($middle,$part,$name)=
1.572 damieng 4172: ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560 damieng 4173: my $section=&mt('All Students');
1.576 raeburn 4174: my $showval = $$resourcedata{$thiskey};
1.560 damieng 4175: if ($middle=~/^\[(.*)\]/) {
4176: my $issection=$1;
4177: if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
4178: my ($stuname,$studom) = ($1,$2);
4179: if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
4180: if (ref($classlist) eq 'HASH') {
4181: if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
4182: next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'});
4183: }
4184: }
4185: }
4186: $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
4187: } else {
4188: if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
4189: if (exists($grouphash{$issection})) {
4190: $section=&mt('Group').': '.$issection;
4191: } elsif ($issection eq $env{'request.course.sec'}) {
4192: $section = &mt('Section').': '.$issection;
4193: } else {
4194: next;
1.552 raeburn 4195: }
1.560 damieng 4196: } else {
4197: $section=&mt('Group/Section').': '.$issection;
1.552 raeburn 4198: }
4199: }
1.560 damieng 4200: $middle=~s/^\[(.*)\]//;
4201: } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
4202: $readonly = 1;
4203: }
4204: $middle=~s/\.+$//;
4205: $middle=~s/^\.+//;
4206: my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576 raeburn 4207: my ($is_map,$is_recursive,$mapurl,$maplevel);
4208: if ($caller eq 'overview') {
4209: if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
4210: $mapurl = $1;
4211: $maplevel = $2;
4212: $is_map = 1;
4213: }
4214: } elsif ($caller eq 'newoverview') {
4215: if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
4216: $mapurl = $1;
4217: $maplevel = $2;
4218: $is_map = 1;
4219: }
4220: }
4221: if ($is_map) {
1.560 damieng 4222: my $leveltitle = &mt('Folder/Map');
1.576 raeburn 4223: unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {
4224: if ($caller eq 'newoverview') {
4225: my $altkey = $thiskey;
4226: $altkey =~ s/\Q___(all)\E/___(rec)/;
4227: if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
4228: $is_recursive = 1;
4229: if ($$resourcedata{$altkey.'.type'}) {
4230: $thistype=$$resourcedata{$altkey.'.type'};
4231: }
4232: $showval = $$resourcedata{$altkey};
4233: }
4234: } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
4235: $thiskey =~ s/\Q___(rec)\E/___(all)/;
4236: $is_recursive = 1;
4237: }
1.560 damieng 4238: }
4239: $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
4240: } elsif ($middle) {
4241: my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
4242: $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
4243: ': '.&Apache::lonnet::gettitle($middle).
4244: ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
4245: $id.')</span></span>';
4246: }
4247: if ($sortorder eq 'realmstudent') {
4248: if ($realm ne $oldrealm) {
4249: $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
4250: $oldrealm=$realm;
4251: $oldsection='';
4252: }
4253: if ($section ne $oldsection) {
4254: $r->print(&tableend()."\n<h2>$section</h2>");
4255: $oldsection=$section;
4256: $oldpart='';
4257: }
1.552 raeburn 4258: } else {
1.560 damieng 4259: if ($section ne $oldsection) {
4260: $r->print(&tableend()."\n<hr /><h1>$section</h1>");
4261: $oldsection=$section;
4262: $oldrealm='';
4263: }
4264: if ($realm ne $oldrealm) {
4265: $r->print(&tableend()."\n<h2>$realm</h2>");
4266: $oldrealm=$realm;
4267: $oldpart='';
1.552 raeburn 4268: }
4269: }
1.560 damieng 4270: if ($part ne $oldpart) {
4271: $r->print(&tableend().
4272: "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
4273: $oldpart=$part;
1.556 raeburn 4274: }
1.560 damieng 4275: #
4276: # Ready to print
4277: #
1.470 raeburn 4278: my $parmitem = &standard_parameter_names($name);
1.576 raeburn 4279: $r->print(&tablestart($readonly,$is_map).
1.560 damieng 4280: &Apache::loncommon::start_data_table_row().
4281: '<td><b>'.&mt($parmitem).
4282: '</b></td>');
4283: unless ($readonly) {
4284: $r->print('<td><input type="checkbox" name="del_'.
4285: $thiskey.'" /></td>');
4286: }
4287: $r->print('<td>');
4288: $foundkeys++;
4289: if (&isdateparm($thistype)) {
4290: my $jskey='key_'.$pointer;
4291: my $state;
4292: $pointer++;
4293: if ($readonly) {
4294: $state = 'disabled';
4295: }
4296: $r->print(
4297: &Apache::lonhtmlcommon::date_setter('parmform',
4298: $jskey,
1.576 raeburn 4299: $showval,
1.560 damieng 4300: '',1,$state));
4301: unless ($readonly) {
4302: $r->print(
4303: '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576 raeburn 4304: (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560 damieng 4305: &mt('Shift all dates based on this date').'</a></span>':'').
1.576 raeburn 4306: &date_sanity_info($showval)
1.560 damieng 4307: );
4308: }
4309: } elsif ($thistype eq 'date_interval') {
4310: $r->print(&date_interval_selector($thiskey,$name,
1.576 raeburn 4311: $showval,$readonly));
1.560 damieng 4312: } elsif ($thistype =~ m/^string/) {
4313: $r->print(&string_selector($thistype,$thiskey,
1.576 raeburn 4314: $showval,$name,$readonly));
1.560 damieng 4315: } else {
1.576 raeburn 4316: $r->print(&default_selector($thiskey,$showval,$readonly));
1.552 raeburn 4317: }
1.560 damieng 4318: unless ($readonly) {
4319: $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
4320: $thistype.'" />');
1.552 raeburn 4321: }
1.576 raeburn 4322: $r->print('</td>');
4323: if ($is_map) {
4324: if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
4325: $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
4326: } else {
4327: my ($disabled,$recon,$recoff);
4328: if ($readonly) {
4329: $disabled = ' disabled="disabled"';
4330: }
4331: if ($is_recursive) {
4332: $recon = ' checked="checked"';
4333: } else {
4334: $recoff = ' checked="checked"';
4335: }
4336: $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
4337: '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
4338: }
4339: }
4340: $r->print(&Apache::loncommon::end_data_table_row());
1.473 amueller 4341: }
1.121 www 4342: }
1.208 www 4343: return $foundkeys;
4344: }
4345:
1.563 damieng 4346: # Returns a string representing the interval, directly using form data matching the given key.
4347: # The returned string may also include information related to proctored exams.
4348: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
4349: #
4350: # @param {string} $key - suffix for form fields related to the interval
4351: # @returns {string}
1.385 albertel 4352: sub get_date_interval_from_form {
4353: my ($key) = @_;
4354: my $seconds = 0;
4355: foreach my $which (['days', 86400],
1.473 amueller 4356: ['hours', 3600],
4357: ['minutes', 60],
4358: ['seconds', 1]) {
1.560 damieng 4359: my ($name, $factor) = @{ $which };
4360: if (defined($env{'form.'.$name.'_'.$key})) {
4361: $seconds += $env{'form.'.$name.'_'.$key} * $factor;
4362: }
1.473 amueller 4363: }
1.560 damieng 4364: if (($key =~ /\.interval$/) &&
4365: (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559 raeburn 4366: if ($env{'form.done_'.$key.'_buttontext'}) {
4367: $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
4368: $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
4369: if ($env{'form.done_'.$key} eq '_done_proctor') {
4370: $seconds .= '_proctor';
4371: }
4372: } else {
4373: $seconds .= $env{'form.done_'.$key};
4374: }
4375: if (($env{'form.done_'.$key} eq '_done_proctor') &&
1.560 damieng 4376: ($env{'form.done_'.$key.'_proctorkey'})) {
1.558 raeburn 4377: $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
4378: }
1.554 raeburn 4379: }
1.385 albertel 4380: return $seconds;
4381: }
4382:
4383:
1.563 damieng 4384: # Returns HTML to enter a text value for a parameter.
4385: #
4386: # @param {string} $thiskey - parameter key
4387: # @param {string} $showval - the current value
4388: # @param {boolean} $readonly - true if the field should not be made editable
4389: # @returns {string}
1.383 albertel 4390: sub default_selector {
1.552 raeburn 4391: my ($thiskey, $showval, $readonly) = @_;
4392: my $disabled;
4393: if ($readonly) {
4394: $disabled = ' disabled="disabled"';
4395: }
4396: return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383 albertel 4397: }
4398:
1.563 damieng 4399: # Returns HTML to enter allow/deny rules related to IP addresses.
4400: #
4401: # @param {string} $thiskey - parameter key
4402: # @param {string} $showval - the current value
4403: # @param {boolean} $readonly - true if the fields should not be made editable
4404: # @returns {string}
1.549 raeburn 4405: sub string_ip_selector {
1.552 raeburn 4406: my ($thiskey, $showval, $readonly) = @_;
1.549 raeburn 4407: my %access = (
4408: allow => [],
4409: deny => [],
4410: );
4411: if ($showval ne '') {
4412: my @current;
4413: if ($showval =~ /,/) {
4414: @current = split(/,/,$showval);
4415: } else {
4416: @current = ($showval);
4417: }
4418: foreach my $item (@current) {
4419: if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
4420: push(@{$access{'deny'}},$1);
4421: } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
4422: push(@{$access{'allow'}},$item);
4423: }
4424: }
4425: }
4426: if (!@{$access{'allow'}}) {
4427: @{$access{'allow'}} = ('');
4428: }
4429: if (!@{$access{'deny'}}) {
4430: @{$access{'deny'}} = ('');
4431: }
1.552 raeburn 4432: my ($disabled,$addmore);
1.567 raeburn 4433: if ($readonly) {
1.552 raeburn 4434: $disabled=' disabled="disabled"';
4435: } else {
4436: $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
4437: }
1.549 raeburn 4438: my $output = '<input type="hidden" name="set_'.$thiskey.'" />
4439: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
4440: foreach my $acctype ('allow','deny') {
4441: $output .= '
4442: <td valign="top">
4443: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
4444: <div class="LC_string_ipacc_inner">'."\n";
4445: my $num = 0;
4446: foreach my $curr (@{$access{$acctype}}) {
1.552 raeburn 4447: $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549 raeburn 4448: if ($num > 0) {
4449: $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>';
4450: }
4451: $output .= '</div>'."\n";
4452: $num ++;
4453: }
4454: $output .= '
1.552 raeburn 4455: </div>'.$addmore.'
1.549 raeburn 4456: </div>
4457: </td>';
4458: }
4459: $output .= '
4460: </tr>
4461: </table>'."\n";
4462: return $output;
4463: }
4464:
1.560 damieng 4465:
4466: { # block using some constants related to parameter types (overview mode)
4467:
1.446 bisitz 4468: my %strings =
1.383 albertel 4469: (
4470: 'string_yesno'
4471: => [[ 'yes', 'Yes' ],
1.560 damieng 4472: [ 'no', 'No' ]],
1.383 albertel 4473: 'string_problemstatus'
4474: => [[ 'yes', 'Yes' ],
1.473 amueller 4475: [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
4476: [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
4477: [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504 raeburn 4478: 'string_questiontype'
4479: => [[ 'problem', 'Standard Problem'],
4480: [ 'survey', 'Survey'],
4481: [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530 bisitz 4482: [ 'exam', 'Bubblesheet Exam'],
1.504 raeburn 4483: [ 'anonsurvey', 'Anonymous Survey'],
4484: [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
4485: [ 'practice', 'Practice'],
4486: [ 'surveycred', 'Survey (credit for submission)']],
1.514 raeburn 4487: 'string_lenient'
4488: => [['yes', 'Yes' ],
4489: [ 'no', 'No' ],
1.549 raeburn 4490: [ 'default', 'Default - only bubblesheet grading is lenient' ],
4491: [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521 raeburn 4492: 'string_discussvote'
4493: => [['yes','Yes'],
4494: ['notended','Yes, unless discussion ended'],
4495: ['no','No']],
1.549 raeburn 4496: 'string_ip'
4497: => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
4498: ['_denyfrom_',], 'Hostname(s) or IP(s) from which access is disallowed'],
1.383 albertel 4499: );
4500:
1.549 raeburn 4501: my %stringmatches = (
4502: 'string_lenient'
4503: => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
4504: 'string_ip'
4505: => [['_allowfrom_','[^\!]+'],
4506: ['_denyfrom_','\!']],
4507: );
4508:
4509: my %stringtypes = (
4510: type => 'string_questiontype',
4511: lenient => 'string_lenient',
4512: retrypartial => 'string_yesno',
4513: discussvote => 'string_discussvote',
4514: examcode => 'string_examcode',
4515: acc => 'string_ip',
4516: );
4517:
1.563 damieng 4518: # Returns the possible values and titles for a given string type, or undef if there are none.
4519: # Used by courseprefs.
4520: #
4521: # @param {string} $string_type - a parameter type for strings
4522: # @returns {array reference} - 2D array, containing values and English titles
1.505 raeburn 4523: sub standard_string_options {
4524: my ($string_type) = @_;
4525: if (ref($strings{$string_type}) eq 'ARRAY') {
4526: return $strings{$string_type};
4527: }
4528: return;
4529: }
1.383 albertel 4530:
1.563 damieng 4531: # Returns regular expressions to match kinds of string types, or undef if there are none.
4532: #
4533: # @param {string} $string_type - a parameter type for strings
4534: # @returns {array reference} - 2D array, containing regular expression names and regular expressions
1.549 raeburn 4535: sub standard_string_matches {
4536: my ($string_type) = @_;
4537: if (ref($stringmatches{$string_type}) eq 'ARRAY') {
4538: return $stringmatches{$string_type};
4539: }
4540: return;
4541: }
4542:
1.563 damieng 4543: # Returns a parameter type for a given parameter with a string type, or undef if not known.
4544: #
4545: # @param {string} $name - parameter name
4546: # @returns {string}
1.549 raeburn 4547: sub get_stringtype {
4548: my ($name) = @_;
4549: if (exists($stringtypes{$name})) {
4550: return $stringtypes{$name};
4551: }
4552: return;
4553: }
4554:
1.563 damieng 4555: # Returns HTML to edit a string parameter.
4556: #
4557: # @param {string} $thistype - parameter type
4558: # @param {string} $thiskey - parameter key
4559: # @param {string} $showval - parameter current value
4560: # @param {string} $name - parameter name
4561: # @param {boolean} $readonly - true if the values should not be made editable
4562: # @returns {string}
1.383 albertel 4563: sub string_selector {
1.552 raeburn 4564: my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446 bisitz 4565:
1.383 albertel 4566: if (!exists($strings{$thistype})) {
1.552 raeburn 4567: return &default_selector($thiskey,$showval,$readonly);
1.383 albertel 4568: }
4569:
1.504 raeburn 4570: my %skiptype;
1.514 raeburn 4571: if (($thistype eq 'string_questiontype') ||
1.560 damieng 4572: ($thistype eq 'string_lenient') ||
4573: ($thistype eq 'string_discussvote') ||
4574: ($thistype eq 'string_ip') ||
4575: ($name eq 'retrypartial')) {
1.504 raeburn 4576: my ($got_chostname,$chostname,$cmajor,$cminor);
4577: foreach my $possibilities (@{ $strings{$thistype} }) {
4578: next unless (ref($possibilities) eq 'ARRAY');
1.514 raeburn 4579: my ($parmval, $description) = @{ $possibilities };
1.549 raeburn 4580: my $parmmatch;
4581: if (ref($stringmatches{$thistype}) eq 'ARRAY') {
4582: foreach my $item (@{$stringmatches{$thistype}}) {
4583: if (ref($item) eq 'ARRAY') {
4584: if ($parmval eq $item->[0]) {
4585: $parmmatch = $parmval;
4586: $parmval = '';
4587: last;
4588: }
4589: }
4590: }
4591: }
4592: my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
1.504 raeburn 4593: if ($needsrelease) {
4594: unless ($got_chostname) {
1.514 raeburn 4595: ($chostname,$cmajor,$cminor)=¶meter_release_vars();
1.504 raeburn 4596: $got_chostname = 1;
4597: }
1.557 raeburn 4598: my $needsnewer=¶meter_releasecheck($name,$parmval,$parmmatch,undef,
1.549 raeburn 4599: $needsrelease,$cmajor,$cminor);
1.504 raeburn 4600: if ($needsnewer) {
1.549 raeburn 4601: if ($parmmatch ne '') {
4602: $skiptype{$parmmatch} = 1;
4603: } elsif ($parmval ne '') {
4604: $skiptype{$parmval} = 1;
4605: }
1.504 raeburn 4606: }
4607: }
4608: }
4609: }
1.549 raeburn 4610:
4611: if ($thistype eq 'string_ip') {
1.552 raeburn 4612: return &string_ip_selector($thiskey,$showval,$readonly);
1.549 raeburn 4613: }
1.504 raeburn 4614:
1.552 raeburn 4615: my ($result,$disabled);
4616:
4617: if ($readonly) {
4618: $disabled = ' disabled="disabled"';
4619: }
1.504 raeburn 4620: my $numinrow = 3;
4621: if ($thistype eq 'string_problemstatus') {
4622: $numinrow = 2;
4623: } elsif ($thistype eq 'string_questiontype') {
4624: if (keys(%skiptype) > 0) {
4625: $numinrow = 4;
4626: }
4627: }
4628: my $rem;
4629: if (ref($strings{$thistype}) eq 'ARRAY') {
4630: my $i=0;
4631: foreach my $possibilities (@{ $strings{$thistype} }) {
4632: next unless (ref($possibilities) eq 'ARRAY');
4633: my ($name, $description) = @{ $possibilities };
1.549 raeburn 4634: next if ($skiptype{$name});
1.504 raeburn 4635: $rem = $i%($numinrow);
4636: if ($rem == 0) {
4637: if ($i > 0) {
4638: $result .= '</tr>';
4639: }
4640: $result .= '<tr>';
4641: }
1.549 raeburn 4642: my $colspan;
4643: if ($i == @{ $strings{$thistype} }-1) {
4644: $rem = @{ $strings{$thistype} }%($numinrow);
4645: if ($rem) {
4646: my $colsleft = $numinrow - $rem;
4647: if ($colsleft) {
4648: $colspan = $colsleft+1;
4649: $colspan = ' colspan="'.$colspan.'"';
4650: }
4651: }
4652: }
4653: my ($add,$onchange,$css_class);
4654: if ($thistype eq 'string_lenient') {
4655: if ($name eq 'weighted') {
4656: my $display;
4657: my %relatives = &Apache::lonlocal::texthash(
4658: corrchkd => 'Correct (checked)',
4659: corrunchkd => 'Correct (unchecked)',
4660: incorrchkd => 'Incorrect (checked)',
4661: incorrunchkd => 'Incorrect (unchecked)',
4662: );
4663: my %textval = (
4664: corrchkd => '1.0',
4665: corrunchkd => '1.0',
4666: incorrchkd => '0.0',
4667: incorrunchkd => '0.0',
4668: );
4669: if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
4670: $textval{'corrchkd'} = $1;
4671: $textval{'corrunchkd'} = $2;
4672: $textval{'incorrchkd'} = $3;
4673: $textval{'incorrunchkd'} = $4;
4674: $display = 'inline';
4675: $showval = $name;
4676: } else {
4677: $display = 'none';
4678: }
4679: $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
4680: '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';
4681: foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
4682: $add .= '<tr><td> </td><td>'.$relatives{$reltype}.'</td>'."\n".
4683: '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552 raeburn 4684: ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549 raeburn 4685: '</td></tr>';
4686: }
4687: $add .= '</table></div>'."\n";
4688: }
4689: $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
4690: $css_class = ' class="LC_lenient_radio"';
4691: }
4692: $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504 raeburn 4693: '<span class="LC_nobreak"><label>'.
4694: '<input type="radio" name="set_'.$thiskey.
1.552 raeburn 4695: '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504 raeburn 4696: if ($showval eq $name) {
4697: $result .= ' checked="checked"';
4698: }
1.549 raeburn 4699: $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504 raeburn 4700: $i++;
4701: }
4702: $result .= '</tr>';
1.473 amueller 4703: }
1.504 raeburn 4704: if ($result) {
4705: $result = '<table border="0">'.$result.'</table>';
1.383 albertel 4706: }
4707: return $result;
4708: }
4709:
1.554 raeburn 4710: my %intervals =
4711: (
4712: 'date_interval'
4713: => [[ 'done', 'Yes' ],
1.558 raeburn 4714: [ 'done_proctor', 'Yes, with proctor key'],
1.554 raeburn 4715: [ '', 'No' ]],
4716: );
4717:
4718: my %intervalmatches = (
4719: 'date_interval'
1.559 raeburn 4720: => [['done','\d+_done(|\:[^\:]+\:)$'],
4721: ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554 raeburn 4722: );
4723:
4724: my %intervaltypes = (
4725: interval => 'date_interval',
4726: );
4727:
1.563 damieng 4728: # Returns regular expressions to match kinds of interval type, or undef if there are none.
4729: #
4730: # @param {string} $interval_type - a parameter type for intervals
4731: # @returns {array reference} - 2D array, containing regular expression names and regular expressions
1.554 raeburn 4732: sub standard_interval_matches {
4733: my ($interval_type) = @_;
4734: if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
4735: return $intervalmatches{$interval_type};
4736: }
4737: return;
4738: }
4739:
1.563 damieng 4740: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
4741: #
4742: # @param {string} $name - parameter name
4743: # @returns {string}
1.554 raeburn 4744: sub get_intervaltype {
4745: my ($name) = @_;
4746: if (exists($intervaltypes{$name})) {
4747: return $intervaltypes{$name};
4748: }
4749: return;
4750: }
4751:
1.563 damieng 4752: # Returns the possible values and titles for a given interval type, or undef if there are none.
4753: # Used by courseprefs.
4754: #
4755: # @param {string} $interval_type - a parameter type for intervals
4756: # @returns {array reference} - 2D array, containing values and English titles
1.554 raeburn 4757: sub standard_interval_options {
4758: my ($interval_type) = @_;
4759: if (ref($intervals{$interval_type}) eq 'ARRAY') {
4760: return $intervals{$interval_type};
4761: }
4762: return;
4763: }
4764:
1.563 damieng 4765: # Returns HTML to edit a date interval parameter.
4766: #
4767: # @param {string} $thiskey - parameter key
4768: # @param {string} $name - parameter name
4769: # @param {string} $showval - parameter current value
4770: # @param {boolean} $readonly - true if the values should not be made editable
4771: # @returns {string}
1.554 raeburn 4772: sub date_interval_selector {
4773: my ($thiskey, $name, $showval, $readonly) = @_;
4774: my ($result,%skipval);
4775: if ($name eq 'interval') {
4776: my $intervaltype = &get_intervaltype($name);
4777: my ($got_chostname,$chostname,$cmajor,$cminor);
4778: foreach my $possibilities (@{ $intervals{$intervaltype} }) {
4779: next unless (ref($possibilities) eq 'ARRAY');
4780: my ($parmval, $description) = @{ $possibilities };
4781: my $parmmatch;
4782: if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
4783: foreach my $item (@{$intervalmatches{$intervaltype}}) {
4784: if (ref($item) eq 'ARRAY') {
4785: if ($parmval eq $item->[0]) {
4786: $parmmatch = $parmval;
4787: $parmval = '';
4788: last;
4789: }
4790: }
4791: }
4792: }
4793: my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
4794: if ($needsrelease) {
4795: unless ($got_chostname) {
4796: ($chostname,$cmajor,$cminor)=¶meter_release_vars();
4797: $got_chostname = 1;
4798: }
1.557 raeburn 4799: my $needsnewer=¶meter_releasecheck($name,$parmval,$parmmatch,undef,
1.554 raeburn 4800: $needsrelease,$cmajor,$cminor);
4801: if ($needsnewer) {
4802: if ($parmmatch ne '') {
4803: $skipval{$parmmatch} = 1;
4804: } elsif ($parmval ne '') {
4805: $skipval{$parmval} = 1;
4806: }
4807: }
4808: }
4809: }
4810: }
4811:
4812: my $currval = $showval;
4813: foreach my $which (['days', 86400, 31],
4814: ['hours', 3600, 23],
4815: ['minutes', 60, 59],
4816: ['seconds', 1, 59]) {
1.560 damieng 4817: my ($name, $factor, $max) = @{ $which };
4818: my $amount = int($showval/$factor);
4819: $showval %= $factor;
4820: my %select = ((map {$_ => $_} (0..$max)),
4821: 'select_form_order' => [0..$max]);
4822: $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
4823: \%select,'',$readonly);
4824: $result .= ' '.&mt($name);
1.554 raeburn 4825: }
4826: if ($name eq 'interval') {
4827: unless ($skipval{'done'}) {
4828: my $checkedon = '';
1.558 raeburn 4829: my $checkedproc = '';
4830: my $currproctorkey = '';
4831: my $currprocdisplay = 'hidden';
1.559 raeburn 4832: my $currdonetext = &mt('Done');
1.554 raeburn 4833: my $checkedoff = ' checked="checked"';
1.559 raeburn 4834: if ($currval =~ /^(?:\d+)_done$/) {
4835: $checkedon = ' checked="checked"';
4836: $checkedoff = '';
4837: } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
4838: $currdonetext = $1;
1.554 raeburn 4839: $checkedon = ' checked="checked"';
4840: $checkedoff = '';
1.558 raeburn 4841: } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
4842: $currproctorkey = $1;
4843: $checkedproc = ' checked="checked"';
4844: $checkedoff = '';
4845: $currprocdisplay = 'text';
1.559 raeburn 4846: } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
4847: $currdonetext = $1;
4848: $currproctorkey = $2;
4849: $checkedproc = ' checked="checked"';
4850: $checkedoff = '';
4851: $currprocdisplay = 'text';
1.554 raeburn 4852: }
1.558 raeburn 4853: my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567 raeburn 4854: my $disabled;
4855: if ($readonly) {
4856: $disabled = ' disabled="disabled"';
4857: }
1.558 raeburn 4858: $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567 raeburn 4859: '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558 raeburn 4860: &mt('No').'</label>'.(' 'x2).
1.567 raeburn 4861: '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558 raeburn 4862: &mt('Yes').'</label>'.(' 'x2).
1.567 raeburn 4863: '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558 raeburn 4864: &mt('Yes, with proctor key').'</label>'.
4865: '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567 raeburn 4866: 'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559 raeburn 4867: '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567 raeburn 4868: '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554 raeburn 4869: }
4870: }
4871: unless ($readonly) {
4872: $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
4873: }
4874: return $result;
4875: }
4876:
1.563 damieng 4877: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
4878: #
4879: # @param {string} $name - parameter name
4880: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
4881: # @param {string} $value - parameter value
4882: # @param {string} $chostname - course server name
4883: # @param {integer} $cmajor - major version number
4884: # @param {integer} $cminor - minor version number
4885: # @param {string} $needsrelease - release version needed (major.minor)
4886: # @returns {string}
1.549 raeburn 4887: sub oldversion_warning {
1.557 raeburn 4888: my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
4889: my $standard_name = &standard_parameter_names($name);
4890: if ($namematch) {
4891: my $level = &standard_parameter_levels($namematch);
4892: my $msg = '';
4893: if ($level) {
4894: $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
4895: $standard_name,'<b>','</b>','"'.$level.'"');
4896: } else {
4897: $msg = &mt('[_1] was [_2]not[_3] set.',
4898: $standard_name,'<b>','</b>');
4899: }
4900: return '<p class="LC_warning">'.$msg.'<br />'.
4901: &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
4902: $cmajor.'.'.$cminor,$chostname,
4903: $needsrelease).
4904: '</p>';
4905: }
1.549 raeburn 4906: my $desc;
4907: my $stringtype = &get_stringtype($name);
4908: if ($stringtype ne '') {
4909: if ($name eq 'examcode') {
4910: $desc = $value;
4911: } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
4912: foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
4913: next unless (ref($possibilities) eq 'ARRAY');
4914: my ($parmval, $description) = @{ $possibilities };
4915: my $parmmatch;
4916: if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
4917: foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
4918: if (ref($item) eq 'ARRAY') {
4919: my ($regexpname,$pattern) = @{$item};
4920: if ($parmval eq $regexpname) {
4921: if ($value =~ /$pattern/) {
4922: $desc = $description;
4923: $parmmatch = 1;
4924: last;
4925: }
4926: }
4927: }
4928: }
4929: last if ($parmmatch);
4930: } elsif ($parmval eq $value) {
4931: $desc = $description;
4932: last;
4933: }
4934: }
4935: }
4936: } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
4937: my $now = time;
4938: if ($value =~ /^\d+$/) {
4939: if ($name eq 'printstartdate') {
4940: if ($value > $now) {
4941: $desc = &Apache::lonlocal::locallocaltime($value);
4942: }
4943: } elsif ($name eq 'printenddate') {
4944: if ($value < $now) {
4945: $desc = &Apache::lonlocal::locallocaltime($value);
4946: }
4947: }
4948: }
4949: }
4950: return '<p class="LC_warning">'.
1.557 raeburn 4951: &mt('[_1] was [_2]not[_3] set to [_4].',
4952: $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
4953: &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
4954: $cmajor.'.'.$cminor,$chostname,
4955: $needsrelease).
4956: '</p>';
1.549 raeburn 4957: }
4958:
1.560 damieng 4959: } # end of block using some constants related to parameter types
4960:
1.549 raeburn 4961:
1.563 damieng 4962:
4963: # Shifts all start and end dates in the current course by $shift.
1.389 www 4964: #
1.563 damieng 4965: # @param {integer} $shift - time to shift, in seconds
4966: # @returns {string} - error name or 'ok'
1.389 www 4967: sub dateshift {
4968: my ($shift)=@_;
4969: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
4970: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
4971: my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
4972: # ugly retro fix for broken version of types
1.548 raeburn 4973: foreach my $key (keys(%data)) {
1.389 www 4974: if ($key=~/\wtype$/) {
4975: my $newkey=$key;
4976: $newkey=~s/type$/\.type/;
4977: $data{$newkey}=$data{$key};
4978: delete $data{$key};
4979: }
4980: }
1.391 www 4981: my %storecontent=();
1.389 www 4982: # go through all parameters and look for dates
1.548 raeburn 4983: foreach my $key (keys(%data)) {
1.389 www 4984: if ($data{$key.'.type'}=~/^date_(start|end)$/) {
4985: my $newdate=$data{$key}+$shift;
1.391 www 4986: $storecontent{$key}=$newdate;
1.389 www 4987: }
4988: }
1.391 www 4989: my $reply=&Apache::lonnet::cput
4990: ('resourcedata',\%storecontent,$dom,$crs);
4991: if ($reply eq 'ok') {
4992: &log_parmset(\%storecontent);
4993: }
4994: &Apache::lonnet::devalidatecourseresdata($crs,$dom);
4995: return $reply;
1.389 www 4996: }
4997:
1.563 damieng 4998: # Overview mode UI to edit course parameters.
4999: #
5000: # @param {Apache2::RequestRec} $r - the Apache request
1.208 www 5001: sub newoverview {
1.568 raeburn 5002: my ($r,$parm_permission) = @_;
1.280 albertel 5003:
1.208 www 5004: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5005: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5006: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568 raeburn 5007: my $readonly = 1;
5008: if ($parm_permission->{'edit'}) {
5009: undef($readonly);
5010: }
1.414 droeschl 5011: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473 amueller 5012: text=>"Overview Mode"});
1.523 raeburn 5013:
5014: my %loaditems = (
1.549 raeburn 5015: 'onload' => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523 raeburn 5016: );
5017: my $js = '
5018: <script type="text/javascript">
5019: // <![CDATA[
5020: '.
5021: &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
5022: &showhide_js()."\n".
1.549 raeburn 5023: &toggleparmtextbox_js()."\n".
5024: &validateparms_js()."\n".
5025: &ipacc_boxes_js()."\n".
1.558 raeburn 5026: &done_proctor_js()."\n".
1.523 raeburn 5027: '// ]]>
5028: </script>
5029: ';
1.549 raeburn 5030:
1.523 raeburn 5031: my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
5032: {'add_entries' => \%loaditems,});
1.298 albertel 5033: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507 www 5034: $r->print($start_page.$breadcrumbs);
1.531 raeburn 5035: &startSettingsScreen($r,'parmset',$crstype);
1.208 www 5036: $r->print(<<ENDOVER);
1.549 raeburn 5037: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208 www 5038: ENDOVER
1.211 www 5039: my @ids=();
5040: my %typep=();
5041: my %keyp=();
5042: my %allparms=();
5043: my %allparts=();
5044: my %allmaps=();
5045: my %mapp=();
5046: my %symbp=();
5047: my %maptitles=();
5048: my %uris=();
5049: my %keyorder=&standardkeyorder();
5050: my %defkeytype=();
5051:
5052: my %alllevs=();
5053: $alllevs{'Resource Level'}='full';
1.215 www 5054: $alllevs{'Map/Folder Level'}='map';
1.211 www 5055: $alllevs{'Course Level'}='general';
5056:
5057: my $csec=$env{'form.csec'};
1.269 raeburn 5058: my $cgroup=$env{'form.cgroup'};
1.211 www 5059:
5060: my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
5061: my $pschp=$env{'form.pschp'};
1.506 www 5062:
1.211 www 5063: my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516 www 5064: if (!@psprt) { $psprt[0]='all'; }
1.211 www 5065:
1.446 bisitz 5066: my @selected_sections =
1.473 amueller 5067: &Apache::loncommon::get_env_multiple('form.Section');
1.211 www 5068: @selected_sections = ('all') if (! @selected_sections);
1.374 albertel 5069: foreach my $sec (@selected_sections) {
5070: if ($sec eq 'all') {
1.211 www 5071: @selected_sections = ('all');
5072: }
5073: }
1.552 raeburn 5074: if ($env{'request.course.sec'} ne '') {
5075: @selected_sections = ($env{'request.course.sec'});
5076: }
1.269 raeburn 5077: my @selected_groups =
5078: &Apache::loncommon::get_env_multiple('form.Group');
1.211 www 5079:
5080: my $pssymb='';
5081: my $parmlev='';
1.446 bisitz 5082:
1.211 www 5083: unless ($env{'form.parmlev'}) {
5084: $parmlev = 'map';
5085: } else {
5086: $parmlev = $env{'form.parmlev'};
5087: }
5088:
1.446 bisitz 5089: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473 amueller 5090: \%mapp, \%symbp,\%maptitles,\%uris,
5091: \%keyorder,\%defkeytype);
1.211 www 5092:
1.374 albertel 5093: if (grep {$_ eq 'all'} (@psprt)) {
1.481 amueller 5094: @psprt = keys(%allparts);
1.374 albertel 5095: }
1.211 www 5096: # Menu to select levels, etc
5097:
1.456 bisitz 5098: $r->print('<div class="LC_Box">');
1.445 neumanie 5099: #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452 bisitz 5100: $r->print('<div>');
1.523 raeburn 5101: $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211 www 5102: &levelmenu($r,\%alllevs,$parmlev);
5103: if ($parmlev ne 'general') {
1.447 bisitz 5104: $r->print(&Apache::lonhtmlcommon::row_closure());
1.483 amueller 5105: &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211 www 5106: }
1.447 bisitz 5107: $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445 neumanie 5108: $r->print(&Apache::lonhtmlcommon::end_pick_box());
5109: $r->print('</div></div>');
1.446 bisitz 5110:
1.456 bisitz 5111: $r->print('<div class="LC_Box">');
1.452 bisitz 5112: $r->print('<div>');
1.562 damieng 5113: &displaymenu($r,\%allparms,\@pscat,\%keyorder); # FIXME: wrong parameters, could make keysindisplayorderCategory crash because $keyorder is undefined
1.453 schualex 5114: $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446 bisitz 5115: $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553 raeburn 5116: my $sectionselector = §ionmenu(\@selected_sections);
5117: my $groupselector = &groupmenu(\@selected_groups);
1.481 amueller 5118: $r->print('<table>'.
1.553 raeburn 5119: '<tr><th>'.&mt('Parts').'</th>');
5120: if ($sectionselector) {
5121: $r->print('<th>'.&mt('Section(s)').'</th>');
5122: }
5123: if ($groupselector) {
5124: $r->print('<th>'.&mt('Group(s)').'</th>');
5125: }
5126: $r->print('</tr><tr><td>');
1.211 www 5127: &partmenu($r,\%allparts,\@psprt);
1.553 raeburn 5128: $r->print('</td>');
5129: if ($sectionselector) {
5130: $r->print('<td>'.$sectionselector.'</td>');
5131: }
5132: if ($groupselector) {
5133: $r->print('<td>'.$groupselector.'</td>');
5134: }
5135: $r->print('</tr></table>');
1.447 bisitz 5136: $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445 neumanie 5137: $r->print(&Apache::lonhtmlcommon::end_pick_box());
5138: $r->print('</div></div>');
5139:
1.456 bisitz 5140: $r->print('<div class="LC_Box">');
1.452 bisitz 5141: $r->print('<div>');
1.214 www 5142: my $sortorder=$env{'form.sortorder'};
5143: unless ($sortorder) { $sortorder='realmstudent'; }
5144: &sortmenu($r,$sortorder);
1.445 neumanie 5145: $r->print('</div></div>');
1.446 bisitz 5146:
1.214 www 5147: $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446 bisitz 5148:
1.211 www 5149: # Build the list data hash from the specified parms
5150:
5151: my $listdata;
5152: %{$listdata}=();
5153:
5154: foreach my $cat (@pscat) {
1.269 raeburn 5155: &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
5156: &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211 www 5157: }
5158:
1.212 www 5159: if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211 www 5160:
1.481 amueller 5161: if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211 www 5162:
5163: # Read modified data
5164:
1.481 amueller 5165: my $resourcedata=&readdata($crs,$dom);
1.211 www 5166:
5167: # List data
5168:
1.568 raeburn 5169: &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
5170: }
5171: $r->print(&tableend());
5172: unless ($readonly) {
5173: $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211 www 5174: }
1.568 raeburn 5175: $r->print('</form>');
1.507 www 5176: &endSettingsScreen($r);
5177: $r->print(&Apache::loncommon::end_page());
1.208 www 5178: }
5179:
1.563 damieng 5180: # Fills $listdata with parameter information.
5181: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
5182: # The non-type value is always 1.
5183: #
5184: # @param {string} $cat - parameter name
1.566 damieng 5185: # @param {string} $pschp - selected map pc, or 'all'
1.563 damieng 5186: # @param {string} $parmlev - selected level value (full|map|general), or ''
5187: # @param {hash reference} $listdata - the parameter data that will be modified
5188: # @param {array reference} $psprt - selected parts
5189: # @param {array reference} $selections - selected sections
5190: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566 damieng 5191: # @param {hash reference} $allmaps - hash map pc -> map src
5192: # @param {array reference} $ids - resource and map ids
5193: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269 raeburn 5194: sub secgroup_lister {
5195: my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
5196: foreach my $item (@{$selections}) {
5197: foreach my $part (@{$psprt}) {
5198: my $rootparmkey=$env{'request.course.id'};
5199: if (($item ne 'all') && ($item ne 'none') && ($item)) {
5200: $rootparmkey.='.['.$item.']';
5201: }
5202: if ($parmlev eq 'general') {
5203: # course-level parameter
5204: my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
5205: $$listdata{$newparmkey}=1;
5206: $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
5207: } elsif ($parmlev eq 'map') {
5208: # map-level parameter
1.548 raeburn 5209: foreach my $mapid (keys(%{$allmaps})) {
1.269 raeburn 5210: if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
5211: my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
5212: $$listdata{$newparmkey}=1;
5213: $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
5214: }
5215: } else {
5216: # resource-level parameter
5217: foreach my $rid (@{$ids}) {
5218: my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
5219: if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
5220: my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
5221: $$listdata{$newparmkey}=1;
5222: $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
5223: }
5224: }
5225: }
5226: }
5227: }
5228:
1.563 damieng 5229: # UI to edit parameter settings starting with a list of all existing parameters.
5230: # (called by setoverview action)
5231: #
5232: # @param {Apache2::RequestRec} $r - the Apache request
1.208 www 5233: sub overview {
1.568 raeburn 5234: my ($r,$parm_permission) = @_;
1.208 www 5235: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5236: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5237: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568 raeburn 5238: my $readonly = 1;
5239: if ($parm_permission->{'edit'}) {
5240: undef($readonly);
5241: }
1.549 raeburn 5242: my $js = '<script type="text/javascript">'."\n".
5243: '// <![CDATA['."\n".
5244: &toggleparmtextbox_js()."\n".
5245: &validateparms_js()."\n".
5246: &ipacc_boxes_js()."\n".
1.558 raeburn 5247: &done_proctor_js()."\n".
1.549 raeburn 5248: '// ]]>'."\n".
5249: '</script>'."\n";
1.414 droeschl 5250: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473 amueller 5251: text=>"Overview Mode"});
1.549 raeburn 5252: my %loaditems = (
5253: 'onload' => "showHideLenient();",
5254: );
5255:
5256: my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298 albertel 5257: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507 www 5258: $r->print($start_page.$breadcrumbs);
1.531 raeburn 5259: &startSettingsScreen($r,'parmset',$crstype);
1.549 raeburn 5260: $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507 www 5261:
1.208 www 5262: # Store modified
5263:
1.568 raeburn 5264: unless ($readonly) {
5265: &storedata($r,$crs,$dom);
5266: }
1.208 www 5267:
5268: # Read modified data
5269:
1.552 raeburn 5270: my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208 www 5271:
1.214 www 5272:
5273: my $sortorder=$env{'form.sortorder'};
5274: unless ($sortorder) { $sortorder='realmstudent'; }
5275: &sortmenu($r,$sortorder);
5276:
1.568 raeburn 5277: my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
5278:
5279: if ($readonly) {
5280: $r->print('<p>'.$submitbutton.'</p>');
5281: }
5282:
1.208 www 5283: # List data
5284:
1.568 raeburn 5285: my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
5286: $r->print(&tableend().'<p>');
5287: if ($foundkeys) {
5288: unless ($readonly) {
5289: $r->print('<p>'.$submitbutton.'</p>');
5290: }
5291: } else {
5292: $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
5293: }
5294: $r->print('</form>'.&Apache::loncommon::end_page());
1.120 www 5295: }
1.121 www 5296:
1.560 damieng 5297: # Unused sub.
1.563 damieng 5298: #
5299: # @param {Apache2::RequestRec} $r - the Apache request
1.333 albertel 5300: sub clean_parameters {
5301: my ($r) = @_;
5302: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5303: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
5304:
1.414 droeschl 5305: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473 amueller 5306: text=>"Clean Parameters"});
1.333 albertel 5307: my $start_page=&Apache::loncommon::start_page('Clean Parameters');
5308: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
5309: $r->print(<<ENDOVER);
5310: $start_page
5311: $breadcrumbs
5312: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
5313: ENDOVER
5314: # Store modified
5315:
5316: &storedata($r,$crs,$dom);
5317:
5318: # Read modified data
5319:
5320: my $resourcedata=&readdata($crs,$dom);
5321:
5322: # List data
5323:
5324: $r->print('<h3>'.
1.473 amueller 5325: &mt('These parameters refer to resources that do not exist.').
5326: '</h3>'.
5327: '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
5328: '<br />');
1.333 albertel 5329: $r->print(&Apache::loncommon::start_data_table().
1.473 amueller 5330: '<tr>'.
5331: '<th>'.&mt('Delete').'</th>'.
5332: '<th>'.&mt('Parameter').'</th>'.
5333: '</tr>');
1.333 albertel 5334: foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560 damieng 5335: next if (!exists($resourcedata->{$thiskey.'.type'})
5336: && $thiskey=~/\.type$/);
5337: my %data = &parse_key($thiskey);
5338: if (1) { #exists($data{'realm_exists'})
5339: #&& !$data{'realm_exists'}) {
5340: $r->print(&Apache::loncommon::start_data_table_row().
5341: '<tr>'.
5342: '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>' );
5343:
5344: $r->print('<td>');
5345: my $display_value = $resourcedata->{$thiskey};
5346: if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
5347: $display_value =
5348: &Apache::lonlocal::locallocaltime($display_value);
5349: }
1.470 raeburn 5350: my $parmitem = &standard_parameter_names($data{'parameter_name'});
5351: $parmitem = &mt($parmitem);
1.560 damieng 5352: $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
5353: $parmitem,$resourcedata->{$thiskey}));
5354: $r->print('<br />');
5355: if ($data{'scope_type'} eq 'all') {
5356: $r->print(&mt('All users'));
5357: } elsif ($data{'scope_type'} eq 'user') {
5358: $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
5359: } elsif ($data{'scope_type'} eq 'section') {
5360: $r->print(&mt('Section: [_1]',$data{'scope'}));
5361: } elsif ($data{'scope_type'} eq 'group') {
5362: $r->print(&mt('Group: [_1]',$data{'scope'}));
5363: }
5364: $r->print('<br />');
5365: if ($data{'realm_type'} eq 'all') {
5366: $r->print(&mt('All Resources'));
5367: } elsif ($data{'realm_type'} eq 'folder') {
5368: $r->print(&mt('Folder: [_1]'),$data{'realm'});
5369: } elsif ($data{'realm_type'} eq 'symb') {
5370: my ($map,$resid,$url) =
5371: &Apache::lonnet::decode_symb($data{'realm'});
5372: $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
5373: $url.' <br /> ',
5374: $resid.' <br /> ',$map));
5375: }
5376: $r->print(' <br /> '.&mt('Part: [_1]',$data{'parameter_part'}));
5377: $r->print('</td></tr>');
5378:
1.473 amueller 5379: }
1.333 albertel 5380: }
5381: $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473 amueller 5382: '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507 www 5383: '</p></form>');
5384: &endSettingsScreen($r);
5385: $r->print(&Apache::loncommon::end_page());
1.333 albertel 5386: }
5387:
1.563 damieng 5388: # UI to shift all dates (called by dateshift1 action).
5389: # Used by overview mode.
5390: #
5391: # @param {Apache2::RequestRec} $r - the Apache request
1.390 www 5392: sub date_shift_one {
5393: my ($r) = @_;
5394: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5395: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5396: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390 www 5397:
1.414 droeschl 5398: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473 amueller 5399: text=>"Shifting Dates"});
1.390 www 5400: my $start_page=&Apache::loncommon::start_page('Shift Dates');
5401: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507 www 5402: $r->print($start_page.$breadcrumbs);
1.531 raeburn 5403: &startSettingsScreen($r,'parmset',$crstype);
1.538 bisitz 5404: $r->print('<form name="shiftform" method="post" action="">'.
1.390 www 5405: '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
5406: &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
5407: '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541 bisitz 5408: &Apache::lonhtmlcommon::date_setter('shiftform',
1.390 www 5409: 'timeshifted',
5410: $env{'form.timebase'},,
5411: '').
5412: '</td></tr></table>'.
5413: '<input type="hidden" name="action" value="dateshift2" />'.
5414: '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
5415: '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507 www 5416: &endSettingsScreen($r);
1.390 www 5417: $r->print(&Apache::loncommon::end_page());
5418: }
5419:
1.563 damieng 5420: # UI to shift all dates (second form).
5421: #
5422: # @param {Apache2::RequestRec} $r - the Apache request
1.390 www 5423: sub date_shift_two {
5424: my ($r) = @_;
5425: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5426: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5427: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414 droeschl 5428: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473 amueller 5429: text=>"Shifting Dates"});
1.390 www 5430: my $start_page=&Apache::loncommon::start_page('Shift Dates');
5431: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507 www 5432: $r->print($start_page.$breadcrumbs);
1.531 raeburn 5433: &startSettingsScreen($r,'parmset',$crstype);
1.390 www 5434: my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543 bisitz 5435: $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
5436: '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390 www 5437: &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543 bisitz 5438: &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390 www 5439: my $delta=$timeshifted-$env{'form.timebase'};
5440: &dateshift($delta);
1.543 bisitz 5441: $r->print(
5442: &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
5443: '<br /><br />'.
5444: &Apache::lonhtmlcommon::actionbox(
5445: ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507 www 5446: &endSettingsScreen($r);
1.390 www 5447: $r->print(&Apache::loncommon::end_page());
5448: }
5449:
1.563 damieng 5450: # Returns the different components of a resourcedata key.
5451: # Keys: scope_type, scope, realm_type, realm, realm_title,
5452: # realm_exists, parameter_part, parameter_name.
5453: # Was used by clean_parameters (which is unused).
5454: #
5455: # @param {string} $key - the parameter key
5456: # @returns {hash}
1.333 albertel 5457: sub parse_key {
5458: my ($key) = @_;
5459: my %data;
5460: my ($middle,$part,$name)=
1.572 damieng 5461: ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333 albertel 5462: $data{'scope_type'} = 'all';
5463: if ($middle=~/^\[(.*)\]/) {
1.560 damieng 5464: $data{'scope'} = $1;
5465: if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
5466: $data{'scope_type'} = 'user';
5467: $data{'scope'} = [$1,$2];
5468: } else {
5469: #FIXME check for group scope
5470: $data{'scope_type'} = 'section';
5471: }
5472: $middle=~s/^\[(.*)\]//;
1.333 albertel 5473: }
5474: $middle=~s/\.+$//;
5475: $middle=~s/^\.+//;
5476: $data{'realm_type'}='all';
5477: if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560 damieng 5478: $data{'realm'} = $1;
5479: $data{'realm_type'} = 'folder';
5480: $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
5481: ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333 albertel 5482: } elsif ($middle) {
1.560 damieng 5483: $data{'realm'} = $middle;
5484: $data{'realm_type'} = 'symb';
5485: $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
5486: my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
5487: $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333 albertel 5488: }
1.446 bisitz 5489:
1.333 albertel 5490: $data{'parameter_part'} = $part;
5491: $data{'parameter_name'} = $name;
5492:
5493: return %data;
5494: }
5495:
1.239 raeburn 5496:
1.563 damieng 5497: # Calls loncommon::start_page with the "Settings" title.
1.416 jms 5498: sub header {
1.507 www 5499: return &Apache::loncommon::start_page('Settings');
1.416 jms 5500: }
1.193 albertel 5501:
5502:
5503:
1.560 damieng 5504: ##################################################
5505: # MAIN MENU
5506: ##################################################
5507:
1.563 damieng 5508: # Content and problem settings main menu.
5509: #
5510: # @param {Apache2::RequestRec} $r - the Apache request
5511: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193 albertel 5512: sub print_main_menu {
5513: my ($r,$parm_permission)=@_;
5514: #
1.414 droeschl 5515: $r->print(&header());
1.507 www 5516: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531 raeburn 5517: my $crstype = &Apache::loncommon::course_type();
5518: my $lc_crstype = lc($crstype);
5519:
5520: &startSettingsScreen($r,'parmset',$crstype);
1.193 albertel 5521: $r->print(<<ENDMAINFORMHEAD);
5522: <form method="post" enctype="multipart/form-data"
5523: action="/adm/parmset" name="studentform">
5524: ENDMAINFORMHEAD
5525: #
1.195 albertel 5526: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
5527: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268 albertel 5528: my $vgr = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366 albertel 5529: my $mgr = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520 raeburn 5530: my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568 raeburn 5531: my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
5532: my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520 raeburn 5533: if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
5534: $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
5535: '/'.$env{'request.course.sec'});
5536: }
1.568 raeburn 5537: if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
5538: $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
5539: '/'.$env{'request.course.sec'});
5540: }
5541: my (%linktext,%linktitle,%url);
5542: if ($parm_permission->{'edit'}) {
5543: %linktext = (
5544: newoverview => 'Edit Resource Parameters - Overview Mode',
5545: settable => 'Edit Resource Parameters - Table Mode',
5546: setoverview => 'Modify Resource Parameters - Overview Mode',
5547: );
5548: %linktitle = (
5549: newoverview => 'Set/Modify resource parameters in overview mode.',
5550: settable => 'Set/Modify resource parameters in table mode.',
5551: setoverview => 'Set/Modify existing resource parameters in overview mode.',
5552: );
5553: } else {
5554: %linktext = (
5555: newoverview => 'View Resource Parameters - Overview Mode',
5556: settable => 'View Resource Parameters - Table Mode',
5557: setoverview => 'View Resource Parameters - Overview Mode',
5558: );
5559: %linktitle = (
5560: newoverview => 'Display resource parameters in overview mode.',
5561: settable => 'Display resource parameters in table mode.',
5562: setoverview => 'Display existing resource parameters in overview mode.',
5563: );
5564: }
5565: if ($mgr) {
5566: $linktext{'resettimes'} = 'Reset Student Access Times';
5567: $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
5568: $url{'resettimes'} = '/adm/helper/resettimes.helper';
5569: } elsif ($vgr) {
5570: $linktext{'resettimes'} = 'Display Student Access Times',
5571: $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
5572: $url{'resettimes'} = '/adm/accesstimes';
5573: }
1.193 albertel 5574: my @menu =
1.507 www 5575: ( { categorytitle=>"Content Settings for this $crstype",
1.473 amueller 5576: items => [
5577: { linktext => 'Portfolio Metadata',
5578: url => '/adm/parmset?action=setrestrictmeta',
1.568 raeburn 5579: permission => $parm_permission->{'setrestrictmeta'},
1.477 raeburn 5580: linktitle => "Restrict metadata for this $lc_crstype." ,
1.473 amueller 5581: icon =>'contact-new.png' ,
5582: },
1.568 raeburn 5583: { linktext => $linktext{'resettimes'},
5584: url => $url{'resettimes'},
5585: permission => ($vgr || $mgr),
5586: linktitle => $linktitle{'resettimes'},
5587: icon => 'start-here.png',
1.473 amueller 5588: },
1.520 raeburn 5589: { linktext => 'Blocking Communication/Resource Access',
5590: url => '/adm/setblock',
1.568 raeburn 5591: permission => ($vcb || $dcm),
1.520 raeburn 5592: linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
5593: icon => 'comblock.png',
5594: },
1.473 amueller 5595: { linktext => 'Set Parameter Setting Default Actions',
5596: url => '/adm/parmset?action=setdefaults',
1.568 raeburn 5597: permission => $parm_permission->{'setdefaults'},
1.473 amueller 5598: linktitle =>'Set default actions for parameters.' ,
5599: icon => 'folder-new.png' ,
5600: }]},
5601: { categorytitle => 'New and Existing Parameter Settings for Resources',
5602: items => [
5603: { linktext => 'Edit Resource Parameters - Helper Mode',
5604: url => '/adm/helper/parameter.helper',
1.568 raeburn 5605: permission => $parm_permission->{'helper'},
1.473 amueller 5606: linktitle =>'Set/Modify resource parameters in helper mode.' ,
5607: icon => 'dialog-information.png' ,
5608: #help => 'Parameter_Helper',
5609: },
1.568 raeburn 5610: { linktext => $linktext{'newoverview'},
1.473 amueller 5611: url => '/adm/parmset?action=newoverview',
1.568 raeburn 5612: permission => $parm_permission->{'newoverview'},
5613: linktitle => $linktitle{'newoverview'},
5614: icon => 'edit-find.png',
1.473 amueller 5615: #help => 'Parameter_Overview',
5616: },
1.568 raeburn 5617: { linktext => $linktext{'settable'},
1.473 amueller 5618: url => '/adm/parmset?action=settable',
1.568 raeburn 5619: permission => $parm_permission->{'settable'},
5620: linktitle => $linktitle{'settable'},
5621: icon => 'edit-copy.png',
1.473 amueller 5622: #help => 'Table_Mode',
5623: }]},
1.417 droeschl 5624: { categorytitle => 'Existing Parameter Settings for Resources',
1.473 amueller 5625: items => [
1.570 raeburn 5626: { linktext => $linktext{'setoverview'},
1.473 amueller 5627: url => '/adm/parmset?action=setoverview',
1.568 raeburn 5628: permission => $parm_permission->{'setoverview'},
5629: linktitle => $linktitle{'setoverview'},
5630: icon => 'preferences-desktop-wallpaper.png',
1.473 amueller 5631: #help => 'Parameter_Overview',
5632: },
5633: { linktext => 'Change Log',
5634: url => '/adm/parmset?action=parameterchangelog',
1.568 raeburn 5635: permission => $parm_permission->{'parameterchangelog'},
1.477 raeburn 5636: linktitle =>"View parameter and $lc_crstype blog posting/user notification change log." ,
1.487 wenzelju 5637: icon => 'document-properties.png',
1.473 amueller 5638: }]}
1.193 albertel 5639: );
1.414 droeschl 5640: $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539 raeburn 5641: $r->print('</form>');
1.507 www 5642: &endSettingsScreen($r);
1.539 raeburn 5643: $r->print(&Apache::loncommon::end_page());
1.193 albertel 5644: return;
5645: }
1.414 droeschl 5646:
1.416 jms 5647:
5648:
1.560 damieng 5649: ##################################################
5650: # PORTFOLIO METADATA
5651: ##################################################
5652:
1.563 damieng 5653: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
5654: # It looks like field titles are not localized.
5655: #
5656: # @param {Apache2::RequestRec} $r - the Apache request
5657: # @param {string} $field_name - metadata field name
5658: # @param {string} $field_text - metadata field title, in English unless manually added
5659: # @param {boolean} $added_flag - true if the field was manually added
1.252 banghart 5660: sub output_row {
1.347 banghart 5661: my ($r, $field_name, $field_text, $added_flag) = @_;
1.252 banghart 5662: my $output;
1.263 banghart 5663: my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
5664: my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337 banghart 5665: if (!defined($options)) {
1.254 banghart 5666: $options = 'active,stuadd';
1.261 banghart 5667: $values = '';
1.252 banghart 5668: }
1.337 banghart 5669: if (!($options =~ /deleted/)) {
5670: my @options= ( ['active', 'Show to student'],
1.418 schafran 5671: ['stuadd', 'Provide text area for students to type metadata'],
1.351 banghart 5672: ['choices','Provide choices for students to select from']);
1.473 amueller 5673: # ['onlyone','Student may select only one choice']);
1.337 banghart 5674: if ($added_flag) {
5675: push @options,['deleted', 'Delete Metadata Field'];
5676: }
1.351 banghart 5677: $output = &Apache::loncommon::start_data_table_row();
1.451 bisitz 5678: $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351 banghart 5679: $output .= &Apache::loncommon::end_data_table_row();
1.337 banghart 5680: foreach my $opt (@options) {
1.560 damieng 5681: my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
5682: $output .= &Apache::loncommon::continue_data_table_row();
5683: $output .= '<td>'.(' ' x 5).'<label>
5684: <input type="checkbox" name="'.
5685: $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
5686: &mt($opt->[1]).'</label></td>';
5687: $output .= &Apache::loncommon::end_data_table_row();
5688: }
1.351 banghart 5689: $output .= &Apache::loncommon::continue_data_table_row();
1.451 bisitz 5690: $output .= '<td>'.(' ' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351 banghart 5691: $output .= &Apache::loncommon::end_data_table_row();
5692: my $multiple_checked;
5693: my $single_checked;
5694: if ($options =~ m/onlyone/) {
1.422 bisitz 5695: $multiple_checked = '';
1.423 bisitz 5696: $single_checked = ' checked="checked"';
1.351 banghart 5697: } else {
1.423 bisitz 5698: $multiple_checked = ' checked="checked"';
1.422 bisitz 5699: $single_checked = '';
1.351 banghart 5700: }
1.560 damieng 5701: $output .= &Apache::loncommon::continue_data_table_row();
5702: $output .= '<td>'.(' ' x 10).'
5703: <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
5704: '.&mt('Student may select multiple choices from list').'</td>';
5705: $output .= &Apache::loncommon::end_data_table_row();
5706: $output .= &Apache::loncommon::continue_data_table_row();
5707: $output .= '<td>'.(' ' x 10).'
5708: <input type="radio" name="'.$field_name.'_onlyone" value="single"'.$single_checked.' />
5709: '.&mt('Student may select only one choice from list').'</td>';
5710: $output .= &Apache::loncommon::end_data_table_row();
1.252 banghart 5711: }
5712: return ($output);
5713: }
1.416 jms 5714:
5715:
1.560 damieng 5716: # UI to order portfolio metadata fields.
1.563 damieng 5717: # Currently useless because addmetafield does not work.
5718: #
5719: # @param {Apache2::RequestRec} $r - the Apache request
1.340 banghart 5720: sub order_meta_fields {
5721: my ($r)=@_;
5722: my $idx = 1;
5723: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5724: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5725: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341 banghart 5726: $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560 damieng 5727: &Apache::lonhtmlcommon::add_breadcrumb(
5728: {href=>'/adm/parmset?action=addmetadata',
1.473 amueller 5729: text=>"Add Metadata Field"});
1.560 damieng 5730: &Apache::lonhtmlcommon::add_breadcrumb(
5731: {href=>"/adm/parmset?action=setrestrictmeta",
5732: text=>"Restrict Metadata"},
5733: {text=>"Order Metadata"});
1.345 banghart 5734: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531 raeburn 5735: &startSettingsScreen($r,'parmset',$crstype);
1.340 banghart 5736: if ($env{'form.storeorder'}) {
5737: my $newpos = $env{'form.newpos'} - 1;
5738: my $currentpos = $env{'form.currentpos'} - 1;
5739: my @neworder = ();
1.548 raeburn 5740: my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340 banghart 5741: my $i;
1.341 banghart 5742: if ($newpos > $currentpos) {
1.340 banghart 5743: # moving stuff up
5744: for ($i=0;$i<$currentpos;$i++) {
1.560 damieng 5745: $neworder[$i]=$oldorder[$i];
1.340 banghart 5746: }
5747: for ($i=$currentpos;$i<$newpos;$i++) {
1.560 damieng 5748: $neworder[$i]=$oldorder[$i+1];
1.340 banghart 5749: }
5750: $neworder[$newpos]=$oldorder[$currentpos];
5751: for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560 damieng 5752: $neworder[$i]=$oldorder[$i];
1.340 banghart 5753: }
5754: } else {
5755: # moving stuff down
1.473 amueller 5756: for ($i=0;$i<$newpos;$i++) {
5757: $neworder[$i]=$oldorder[$i];
5758: }
5759: $neworder[$newpos]=$oldorder[$currentpos];
5760: for ($i=$newpos+1;$i<$currentpos+1;$i++) {
5761: $neworder[$i]=$oldorder[$i-1];
5762: }
5763: for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
5764: $neworder[$i]=$oldorder[$i];
5765: }
1.340 banghart 5766: }
1.560 damieng 5767: my $ordered_fields = join ",", @neworder;
1.343 banghart 5768: my $put_result = &Apache::lonnet::put('environment',
1.560 damieng 5769: {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
5770: &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340 banghart 5771: }
1.357 raeburn 5772: my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341 banghart 5773: my $ordered_fields;
1.548 raeburn 5774: my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340 banghart 5775: if (!@fields_in_order) {
5776: # no order found, pick sorted order then create metadata.addedorder key.
1.548 raeburn 5777: foreach my $key (sort(keys(%$fields))) {
1.340 banghart 5778: push @fields_in_order, $key;
1.341 banghart 5779: $ordered_fields = join ",", @fields_in_order;
1.340 banghart 5780: }
1.341 banghart 5781: my $put_result = &Apache::lonnet::put('environment',
1.446 bisitz 5782: {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
5783: }
1.340 banghart 5784: $r->print('<table>');
5785: my $num_fields = scalar(@fields_in_order);
5786: foreach my $key (@fields_in_order) {
5787: $r->print('<tr><td>');
5788: $r->print('<form method="post" action="">');
1.537 bisitz 5789: $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340 banghart 5790: for (my $i = 1;$i le $num_fields;$i ++) {
5791: if ($i eq $idx) {
5792: $r->print('<option value="'.$i.'" SELECTED>('.$i.')</option>');
5793: } else {
5794: $r->print('<option value="'.$i.'">'.$i.'</option>');
5795: }
5796: }
5797: $r->print('</select></td><td>');
5798: $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
5799: $r->print('<input type="hidden" name="storeorder" value="true" />');
5800: $r->print('</form>');
5801: $r->print($$fields{$key}.'</td></tr>');
5802: $idx ++;
5803: }
5804: $r->print('</table>');
1.507 www 5805: &endSettingsScreen($r);
1.340 banghart 5806: return 'ok';
5807: }
1.416 jms 5808:
5809:
1.563 damieng 5810: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
5811: # @returns {string}
1.359 banghart 5812: sub continue {
5813: my $output;
5814: $output .= '<form action="" method="post">';
5815: $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
5816: $output .= '<input type="submit" value="Continue" />';
5817: return ($output);
5818: }
1.416 jms 5819:
5820:
1.563 damieng 5821: # UI to add a metadata field.
5822: # Currenly does not work because of an HTML error (the field is not visible).
5823: #
5824: # @param {Apache2::RequestRec} $r - the Apache request
1.334 banghart 5825: sub addmetafield {
5826: my ($r)=@_;
1.414 droeschl 5827: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473 amueller 5828: text=>"Add Metadata Field"});
1.334 banghart 5829: $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
5830: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335 banghart 5831: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5832: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5833: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5834: &startSettingsScreen($r,'parmset',$crstype);
1.339 banghart 5835: if (exists($env{'form.undelete'})) {
1.358 banghart 5836: my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339 banghart 5837: foreach my $meta_field(@meta_fields) {
5838: my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
5839: $options =~ s/deleted//;
5840: $options =~ s/,,/,/;
5841: my $put_result = &Apache::lonnet::put('environment',
5842: {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446 bisitz 5843:
1.339 banghart 5844: $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
5845: }
1.359 banghart 5846: $r->print(&continue());
1.339 banghart 5847: } elsif (exists($env{'form.fieldname'})) {
1.335 banghart 5848: my $meta_field = $env{'form.fieldname'};
5849: my $display_field = $env{'form.fieldname'};
5850: $meta_field =~ s/\W/_/g;
1.338 banghart 5851: $meta_field =~ tr/A-Z/a-z/;
1.335 banghart 5852: my $put_result = &Apache::lonnet::put('environment',
5853: {'metadata.'.$meta_field.'.values'=>"",
5854: 'metadata.'.$meta_field.'.added'=>"$display_field",
5855: 'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359 banghart 5856: $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
5857: $r->print(&continue());
1.335 banghart 5858: } else {
1.357 raeburn 5859: my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339 banghart 5860: if ($fields) {
5861: $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
5862: $r->print('<form method="post" action="">');
5863: foreach my $key(keys(%$fields)) {
1.358 banghart 5864: $r->print('<input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'<br /');
1.339 banghart 5865: }
5866: $r->print('<input type="submit" name="undelete" value="Undelete" />');
5867: $r->print('</form>');
5868: }
1.571 damieng 5869: $r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.<form method="post" action="/adm/parmset?action=addmetadata">');
1.335 banghart 5870: $r->print('<input type="text" name="fieldname" /><br />');
5871: $r->print('<input type="submit" value="Add Metadata Field" />');
1.334 banghart 5872: }
1.361 albertel 5873: $r->print('</form>');
1.507 www 5874: &endSettingsScreen($r);
1.334 banghart 5875: }
1.416 jms 5876:
5877:
5878:
1.560 damieng 5879: # Display or save portfolio metadata.
1.563 damieng 5880: #
5881: # @param {Apache2::RequestRec} $r - the Apache request
1.259 banghart 5882: sub setrestrictmeta {
1.240 banghart 5883: my ($r)=@_;
1.242 banghart 5884: my $next_meta;
1.244 banghart 5885: my $output;
1.245 banghart 5886: my $item_num;
1.246 banghart 5887: my $put_result;
1.414 droeschl 5888: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473 amueller 5889: text=>"Restrict Metadata"});
1.280 albertel 5890: $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298 albertel 5891: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240 banghart 5892: my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
5893: my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531 raeburn 5894: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
5895: &startSettingsScreen($r,'parmset',$crstype);
1.259 banghart 5896: my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252 banghart 5897: my $save_field = '';
1.259 banghart 5898: if ($env{'form.restrictmeta'}) {
1.254 banghart 5899: foreach my $field (sort(keys(%env))) {
1.252 banghart 5900: if ($field=~m/^form.(.+)_(.+)$/) {
1.254 banghart 5901: my $options;
1.252 banghart 5902: my $meta_field = $1;
5903: my $meta_key = $2;
1.253 banghart 5904: if ($save_field ne $meta_field) {
1.252 banghart 5905: $save_field = $meta_field;
1.473 amueller 5906: if ($env{'form.'.$meta_field.'_stuadd'}) {
5907: $options.='stuadd,';
5908: }
5909: if ($env{'form.'.$meta_field.'_choices'}) {
5910: $options.='choices,';
5911: }
5912: if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
5913: $options.='onlyone,';
5914: }
5915: if ($env{'form.'.$meta_field.'_active'}) {
5916: $options.='active,';
5917: }
5918: if ($env{'form.'.$meta_field.'_deleted'}) {
5919: $options.='deleted,';
5920: }
1.259 banghart 5921: my $name = $save_field;
1.560 damieng 5922: $put_result = &Apache::lonnet::put('environment',
5923: {'metadata.'.$meta_field.'.options'=>$options,
5924: 'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
5925: },$dom,$crs);
1.252 banghart 5926: }
5927: }
5928: }
5929: }
1.296 albertel 5930: &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473 amueller 5931: {'freshen_cache' => 1});
1.335 banghart 5932: # Get the default metadata fields
1.258 albertel 5933: my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335 banghart 5934: # Now get possible added metadata fields
1.357 raeburn 5935: my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346 banghart 5936: my $row_alt = 1;
1.347 banghart 5937: $output .= &Apache::loncommon::start_data_table();
1.258 albertel 5938: foreach my $field (sort(keys(%metadata_fields))) {
1.265 banghart 5939: if ($field ne 'courserestricted') {
1.346 banghart 5940: $row_alt = $row_alt ? 0 : 1;
1.560 damieng 5941: $output.= &output_row($r, $field, $metadata_fields{$field});
5942: }
1.255 banghart 5943: }
1.351 banghart 5944: my $buttons = (<<ENDButtons);
5945: <input type="submit" name="restrictmeta" value="Save" />
5946: </form><br />
5947: <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
5948: <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
5949: </form>
5950: <br />
5951: <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
5952: <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
5953: ENDButtons
1.337 banghart 5954: my $added_flag = 1;
1.335 banghart 5955: foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346 banghart 5956: $row_alt = $row_alt ? 0 : 1;
1.563 damieng 5957: $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters
1.335 banghart 5958: }
1.347 banghart 5959: $output .= &Apache::loncommon::end_data_table();
1.446 bisitz 5960: $r->print(<<ENDenv);
1.259 banghart 5961: <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244 banghart 5962: $output
1.351 banghart 5963: $buttons
1.340 banghart 5964: </form>
1.244 banghart 5965: ENDenv
1.507 www 5966: &endSettingsScreen($r);
1.280 albertel 5967: $r->print(&Apache::loncommon::end_page());
1.240 banghart 5968: return 'ok';
5969: }
1.416 jms 5970:
5971:
1.563 damieng 5972: # Returns metadata fields that have been manually added.
5973: #
5974: # @param {string} $cid - course id
5975: # @returns {hash reference} - hash field name -> field title (not localized)
1.335 banghart 5976: sub get_added_meta_fieldnames {
1.357 raeburn 5977: my ($cid) = @_;
1.335 banghart 5978: my %fields;
5979: foreach my $key(%env) {
1.357 raeburn 5980: if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335 banghart 5981: my $field_name = $1;
5982: my ($display_field_name) = $env{$key};
5983: $fields{$field_name} = $display_field_name;
5984: }
5985: }
5986: return \%fields;
5987: }
1.416 jms 5988:
5989:
1.563 damieng 5990: # Returns metadata fields that have been manually added and deleted.
5991: #
5992: # @param {string} $cid - course id
5993: # @returns {hash reference} - hash field name -> field title (not localized)
1.339 banghart 5994: sub get_deleted_meta_fieldnames {
1.357 raeburn 5995: my ($cid) = @_;
1.339 banghart 5996: my %fields;
5997: foreach my $key(%env) {
1.357 raeburn 5998: if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339 banghart 5999: my $field_name = $1;
6000: if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
6001: my ($display_field_name) = $env{$key};
6002: $fields{$field_name} = $display_field_name;
6003: }
6004: }
6005: }
6006: return \%fields;
6007: }
1.560 damieng 6008:
6009:
6010: ##################################################
6011: # PARAMETER SETTINGS DEFAULT ACTIONS
6012: ##################################################
6013:
6014: # UI to change parameter setting default actions
1.563 damieng 6015: #
6016: # @param {Apache2::RequestRec} $r - the Apache request
1.220 www 6017: sub defaultsetter {
1.280 albertel 6018: my ($r) = @_;
6019:
1.414 droeschl 6020: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473 amueller 6021: text=>"Set Defaults"});
1.531 raeburn 6022: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
6023: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
6024: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446 bisitz 6025: my $start_page =
1.531 raeburn 6026: &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298 albertel 6027: my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507 www 6028: $r->print($start_page.$breadcrumbs);
1.531 raeburn 6029: &startSettingsScreen($r,'parmset',$crstype);
1.507 www 6030: $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280 albertel 6031:
1.221 www 6032: my @ids=();
6033: my %typep=();
6034: my %keyp=();
6035: my %allparms=();
6036: my %allparts=();
6037: my %allmaps=();
6038: my %mapp=();
6039: my %symbp=();
6040: my %maptitles=();
6041: my %uris=();
6042: my %keyorder=&standardkeyorder();
6043: my %defkeytype=();
6044:
1.446 bisitz 6045: &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473 amueller 6046: \%mapp, \%symbp,\%maptitles,\%uris,
6047: \%keyorder,\%defkeytype);
1.224 www 6048: if ($env{'form.storerules'}) {
1.560 damieng 6049: my %newrules=();
6050: my @delrules=();
6051: my %triggers=();
6052: foreach my $key (keys(%env)) {
1.225 albertel 6053: if ($key=~/^form\.(\w+)\_action$/) {
1.560 damieng 6054: my $tempkey=$1;
6055: my $action=$env{$key};
1.226 www 6056: if ($action) {
1.560 damieng 6057: $newrules{$tempkey.'_action'}=$action;
6058: if ($action ne 'default') {
6059: my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
6060: $triggers{$whichparm}.=$tempkey.':';
6061: }
6062: $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
6063: if (&isdateparm($defkeytype{$tempkey})) {
6064: $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
6065: $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
6066: $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
6067: $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
6068: } else {
6069: $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
6070: $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
6071: }
6072: } else {
6073: push(@delrules,$tempkey.'_action');
6074: push(@delrules,$tempkey.'_type');
6075: push(@delrules,$tempkey.'_hours');
6076: push(@delrules,$tempkey.'_min');
6077: push(@delrules,$tempkey.'_sec');
6078: push(@delrules,$tempkey.'_value');
6079: }
1.473 amueller 6080: }
6081: }
1.560 damieng 6082: foreach my $key (keys(%allparms)) {
6083: $newrules{$key.'_triggers'}=$triggers{$key};
1.473 amueller 6084: }
1.560 damieng 6085: &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
6086: &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
6087: &resetrulescache();
1.224 www 6088: }
1.227 www 6089: my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473 amueller 6090: 'hours' => 'Hours',
6091: 'min' => 'Minutes',
6092: 'sec' => 'Seconds',
6093: 'yes' => 'Yes',
6094: 'no' => 'No');
1.222 www 6095: my @standardoptions=('','default');
6096: my @standarddisplay=('',&mt('Default value when manually setting'));
6097: my @dateoptions=('','default');
6098: my @datedisplay=('',&mt('Default value when manually setting'));
6099: foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560 damieng 6100: unless ($tempkey) { next; }
6101: push @standardoptions,'when_setting_'.$tempkey;
6102: push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
6103: if (&isdateparm($defkeytype{$tempkey})) {
6104: push @dateoptions,'later_than_'.$tempkey;
6105: push @datedisplay,&mt('Automatically set later than ').$tempkey;
6106: push @dateoptions,'earlier_than_'.$tempkey;
6107: push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
6108: }
1.222 www 6109: }
1.563 damieng 6110: $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
6111: &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318 albertel 6112: $r->print("\n".&Apache::loncommon::start_data_table().
1.473 amueller 6113: &Apache::loncommon::start_data_table_header_row().
6114: "<th>".&mt('Rule for parameter').'</th><th>'.
6115: &mt('Action').'</th><th>'.&mt('Value').'</th>'.
6116: &Apache::loncommon::end_data_table_header_row());
1.221 www 6117: foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560 damieng 6118: unless ($tempkey) { next; }
6119: $r->print("\n".&Apache::loncommon::start_data_table_row().
6120: "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
6121: my $action=&rulescache($tempkey.'_action');
6122: $r->print('<select name="'.$tempkey.'_action">');
6123: if (&isdateparm($defkeytype{$tempkey})) {
6124: for (my $i=0;$i<=$#dateoptions;$i++) {
6125: if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
6126: $r->print("\n<option value='$dateoptions[$i]'".
6127: ($dateoptions[$i] eq $action?' selected="selected"':'').
6128: ">$datedisplay[$i]</option>");
6129: }
6130: } else {
6131: for (my $i=0;$i<=$#standardoptions;$i++) {
6132: if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
6133: $r->print("\n<option value='$standardoptions[$i]'".
6134: ($standardoptions[$i] eq $action?' selected="selected"':'').
6135: ">$standarddisplay[$i]</option>");
6136: }
1.473 amueller 6137: }
1.560 damieng 6138: $r->print('</select>');
6139: unless (&isdateparm($defkeytype{$tempkey})) {
6140: $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
6141: '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473 amueller 6142: }
1.560 damieng 6143: $r->print("\n</td><td>\n");
1.222 www 6144:
1.221 www 6145: if (&isdateparm($defkeytype{$tempkey})) {
1.560 damieng 6146: my $days=&rulescache($tempkey.'_days');
6147: my $hours=&rulescache($tempkey.'_hours');
6148: my $min=&rulescache($tempkey.'_min');
6149: my $sec=&rulescache($tempkey.'_sec');
6150: $r->print(<<ENDINPUTDATE);
6151: <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
6152: <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
6153: <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
6154: <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564 raeburn 6155: ENDINPUTDATE
1.560 damieng 6156: } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
6157: my $yeschecked='';
6158: my $nochecked='';
6159: if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
6160: if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
6161:
6162: $r->print(<<ENDYESNO);
6163: <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
6164: <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564 raeburn 6165: ENDYESNO
1.221 www 6166: } else {
1.560 damieng 6167: $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
6168: }
1.318 albertel 6169: $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221 www 6170: }
1.318 albertel 6171: $r->print(&Apache::loncommon::end_data_table().
1.473 amueller 6172: "\n".'<input type="submit" name="storerules" value="'.
1.507 www 6173: &mt('Save').'" /></form>'."\n");
6174: &endSettingsScreen($r);
6175: $r->print(&Apache::loncommon::end_page());
1.220 www 6176: return;
6177: }
1.193 albertel 6178:
1.560 damieng 6179: ##################################################
6180: # PARAMETER CHANGES LOG
6181: ##################################################
6182:
1.563 damieng 6183: # Returns some info for a parameter log entry.
6184: # Returned entries:
6185: # $realm - HTML title for the parameter level and resource
6186: # $section - parameter section
6187: # $name - parameter name
6188: # $part - parameter part
6189: # $what - $part.'.'.$name
6190: # $middle - resource symb ?
6191: # $uname - user name (same as given)
6192: # $udom - user domain (same as given)
6193: # $issection - section or group name
6194: # $realmdescription - title for the parameter level and resource (without using HTML)
6195: #
6196: # FIXME: remove unused fields.
6197: #
6198: # @param {string} $key - parameter log key
6199: # @param {string} $uname - user name
6200: # @param {string} $udom - user domain
6201: # @param {string} $exeuser - unused
6202: # @param {string} $exedomain - unused
6203: # @param {boolean} $typeflag - .type log entry
6204: # @returns {Array}
1.290 www 6205: sub components {
1.330 albertel 6206: my ($key,$uname,$udom,$exeuser,$exedomain,$typeflag)=@_;
6207:
6208: if ($typeflag) {
1.560 damieng 6209: $key=~s/\.type$//;
1.290 www 6210: }
1.330 albertel 6211:
6212: my ($middle,$part,$name)=
1.572 damieng 6213: ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291 www 6214: my $issection;
1.330 albertel 6215:
1.290 www 6216: my $section=&mt('All Students');
6217: if ($middle=~/^\[(.*)\]/) {
1.560 damieng 6218: $issection=$1;
6219: $section=&mt('Group/Section').': '.$issection;
6220: $middle=~s/^\[(.*)\]//;
1.290 www 6221: }
6222: $middle=~s/\.+$//;
6223: $middle=~s/^\.+//;
1.291 www 6224: if ($uname) {
1.560 damieng 6225: $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
6226: $issection='';
1.291 www 6227: }
1.316 albertel 6228: my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446 bisitz 6229: my $realmdescription=&mt('all resources');
1.556 raeburn 6230: if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
6231: my $mapurl = $1;
6232: my $maplevel = $2;
6233: my $leveltitle = &mt('Folder/Map');
6234: if ($maplevel eq 'rec') {
6235: $leveltitle = &mt('Recursive');
6236: }
1.560 damieng 6237: $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
6238: ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
6239: $mapurl.')</span></span>';
6240: $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
6241: } elsif ($middle) {
6242: my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
6243: $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
6244: ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
6245: ' in '.$map.' id: '.$id.')</span></span>';
6246: $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290 www 6247: }
1.291 www 6248: my $what=$part.'.'.$name;
1.330 albertel 6249: return ($realm,$section,$name,$part,
1.473 amueller 6250: $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290 www 6251: }
1.293 www 6252:
1.563 damieng 6253: my %standard_parms; # hash parameter name -> parameter title (not localized)
6254: my %standard_parms_types; # hash parameter name -> parameter type
1.416 jms 6255:
1.563 damieng 6256: # Reads parameter info from packages.tab into %standard_parms.
1.328 albertel 6257: sub load_parameter_names {
6258: open(my $config,"<$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
6259: while (my $configline=<$config>) {
1.560 damieng 6260: if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
6261: chomp($configline);
6262: my ($short,$plain)=split(/:/,$configline);
6263: my (undef,$name,$type)=split(/\&/,$short,3);
6264: if ($type eq 'display') {
6265: $standard_parms{$name} = $plain;
1.469 raeburn 6266: } elsif ($type eq 'type') {
1.560 damieng 6267: $standard_parms_types{$name} = $plain;
1.469 raeburn 6268: }
1.328 albertel 6269: }
6270: close($config);
6271: $standard_parms{'int_pos'} = 'Positive Integer';
6272: $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575 raeburn 6273: $standard_parms{'scoreformat'} = 'Format for display of score';
1.328 albertel 6274: }
6275:
1.563 damieng 6276: # Returns a parameter title for standard parameters, the name for others.
6277: #
6278: # @param {string} $name - parameter name
6279: # @returns {string}
1.292 www 6280: sub standard_parameter_names {
6281: my ($name)=@_;
1.328 albertel 6282: if (!%standard_parms) {
1.560 damieng 6283: &load_parameter_names();
1.328 albertel 6284: }
1.292 www 6285: if ($standard_parms{$name}) {
1.560 damieng 6286: return $standard_parms{$name};
1.446 bisitz 6287: } else {
1.560 damieng 6288: return $name;
1.292 www 6289: }
6290: }
1.290 www 6291:
1.563 damieng 6292: # Returns a parameter type for standard parameters, undef for others.
6293: #
6294: # @param {string} $name - parameter name
6295: # @returns {string}
1.469 raeburn 6296: sub standard_parameter_types {
6297: my ($name)=@_;
6298: if (!%standard_parms_types) {
6299: &load_parameter_names();
6300: }
6301: if ($standard_parms_types{$name}) {
6302: return $standard_parms_types{$name};
6303: }
6304: return;
6305: }
1.309 www 6306:
1.563 damieng 6307: # Returns a parameter level title (not localized) from the parameter level name.
6308: #
6309: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
6310: # @returns {string}
1.557 raeburn 6311: sub standard_parameter_levels {
6312: my ($name)=@_;
6313: my %levels = (
6314: 'resourcelevel' => 'a single resource',
6315: 'maplevel' => 'the enclosing map/folder',
6316: 'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
6317: 'courselevel' => 'the general (course) level',
6318: );
6319: if ($levels{$name}) {
6320: return $levels{$name};
6321: }
6322: return;
6323: }
6324:
1.560 damieng 6325: # Display log for parameter changes, blog postings, user notification changes.
1.563 damieng 6326: #
6327: # @param {Apache2::RequestRec} $r - the Apache request
1.285 albertel 6328: sub parm_change_log {
1.568 raeburn 6329: my ($r,$parm_permission)=@_;
1.531 raeburn 6330: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
6331: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569 raeburn 6332: my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414 droeschl 6333: &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473 amueller 6334: text=>"Parameter Change Log"});
1.522 raeburn 6335: my $js = '<script type="text/javascript">'."\n".
6336: '// <![CDATA['."\n".
6337: &Apache::loncommon::display_filter_js('parmslog')."\n".
6338: '// ]]>'."\n".
6339: '</script>'."\n";
6340: $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327 albertel 6341: $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531 raeburn 6342: &startSettingsScreen($r,'parmset',$crstype);
6343: my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311 albertel 6344:
1.301 www 6345: if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311 albertel 6346:
1.522 raeburn 6347: $r->print('<div class="LC_left_float">'.
6348: '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
6349: '<form action="/adm/parmset?action=parameterchangelog"
1.327 albertel 6350: method="post" name="parameterlog">');
1.446 bisitz 6351:
1.311 albertel 6352: my %saveable_parameters = ('show' => 'scalar',);
6353: &Apache::loncommon::store_course_settings('parameter_log',
6354: \%saveable_parameters);
6355: &Apache::loncommon::restore_course_settings('parameter_log',
6356: \%saveable_parameters);
1.522 raeburn 6357: $r->print(&Apache::loncommon::display_filter('parmslog').' '."\n".
6358: '<input type="submit" value="'.&mt('Display').'" />'.
6359: '</form></fieldset></div><br clear="all" />');
1.301 www 6360:
1.568 raeburn 6361: my $readonly = 1;
6362: if ($parm_permission->{'edit'}) {
6363: undef($readonly);
6364: }
1.531 raeburn 6365: my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301 www 6366: $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473 amueller 6367: '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568 raeburn 6368: &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
6369: unless ($readonly) {
6370: $r->print('<th>'.&mt('Announce').'</th>');
6371: }
6372: $r->print(&Apache::loncommon::end_data_table_header_row());
1.309 www 6373: my $shown=0;
1.349 www 6374: my $folder='';
6375: if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560 damieng 6376: my $last='';
6377: if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
6378: &GDBM_READER(),0640)) {
6379: $last=$hash{'last_known'};
6380: untie(%hash);
6381: }
6382: if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
6383: }
6384: foreach my $id (sort {
6385: if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
6386: return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
6387: }
6388: my $aid = (split('00000',$a))[-1];
6389: my $bid = (split('00000',$b))[-1];
6390: return $bid<=>$aid;
1.473 amueller 6391: } (keys(%parmlog))) {
1.294 www 6392: my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560 damieng 6393: my $count = 0;
6394: my $time =
6395: &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
6396: my $plainname =
6397: &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
6398: $parmlog{$id}{'exe_udom'});
6399: my $about_me_link =
6400: &Apache::loncommon::aboutmewrapper($plainname,
6401: $parmlog{$id}{'exe_uname'},
6402: $parmlog{$id}{'exe_udom'});
6403: my $send_msg_link='';
1.568 raeburn 6404: if ((!$readonly) &&
6405: (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560 damieng 6406: || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
6407: $send_msg_link ='<br />'.
6408: &Apache::loncommon::messagewrapper(&mt('Send message'),
6409: $parmlog{$id}{'exe_uname'},
6410: $parmlog{$id}{'exe_udom'});
6411: }
6412: my $row_start=&Apache::loncommon::start_data_table_row();
6413: my $makenewrow=0;
6414: my %istype=();
6415: my $output;
6416: foreach my $changed (reverse(sort(@changes))) {
6417: my $value=$parmlog{$id}{'logentry'}{$changed};
6418: my $typeflag = ($changed =~/\.type$/ &&
6419: !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330 albertel 6420: my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.560 damieng 6421: &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},undef,undef,$typeflag);
6422: if ($env{'request.course.sec'} ne '') {
6423: next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
6424: if ($uname ne '') {
6425: my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
6426: next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'}));
6427: }
6428: }
6429: if ($env{'form.displayfilter'} eq 'currentfolder') {
6430: if ($folder) {
6431: if ($middle!~/^\Q$folder\E/) { next; }
6432: }
6433: }
6434: if ($typeflag) {
6435: $istype{$parmname}=$value;
6436: if (!$env{'form.includetypes'}) { next; }
6437: }
6438: $count++;
6439: if ($makenewrow) {
6440: $output .= $row_start;
6441: } else {
6442: $makenewrow=1;
6443: }
1.470 raeburn 6444: my $parmitem = &standard_parameter_names($parmname);
1.560 damieng 6445: $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
6446: &mt($parmitem).'</td><td>'.
6447: ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
6448: my $stillactive=0;
6449: if ($parmlog{$id}{'delflag'}) {
6450: $output .= &mt('Deleted');
6451: } else {
6452: if ($typeflag) {
1.470 raeburn 6453: my $parmitem = &standard_parameter_names($value);
6454: $parmitem = &mt($parmitem);
1.560 damieng 6455: $output .= &mt('Type: [_1]',$parmitem);
6456: } else {
6457: my ($level,@all)=&parmval_by_symb($what,$middle,
6458: &Apache::lonnet::metadata($middle,$what),
6459: $uname,$udom,$issection,$issection,$courseopt);
1.469 raeburn 6460: my $showvalue = $value;
6461: if ($istype{$parmname} eq '') {
6462: my $type = &standard_parameter_types($parmname);
6463: if ($type ne '') {
6464: if (&isdateparm($type)) {
6465: $showvalue =
6466: &Apache::lonlocal::locallocaltime($value);
6467: }
6468: }
6469: } else {
1.560 damieng 6470: if (&isdateparm($istype{$parmname})) {
6471: $showvalue = &Apache::lonlocal::locallocaltime($value);
6472: }
1.469 raeburn 6473: }
6474: $output .= $showvalue;
1.560 damieng 6475: if ($value ne $all[$level]) {
6476: $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
6477: } else {
6478: $stillactive=1;
6479: }
6480: }
1.473 amueller 6481: }
1.568 raeburn 6482: $output .= '</td>';
6483:
6484: unless ($readonly) {
6485: $output .= '<td>';
6486: if ($stillactive) {
6487: my $parmitem = &standard_parameter_names($parmname);
6488: $parmitem = &mt($parmitem);
6489: my $title=&mt('Changed [_1]',$parmitem);
6490: my $description=&mt('Changed [_1] for [_2] to [_3]',
6491: $parmitem,$realmdescription,
6492: (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
6493: if (($uname) && ($udom)) {
6494: $output .=
6495: &Apache::loncommon::messagewrapper('Notify User',
6496: $uname,$udom,$title,
6497: $description);
6498: } else {
6499: $output .=
6500: &Apache::lonrss::course_blog_link($id,$title,
6501: $description);
6502: }
1.560 damieng 6503: }
1.568 raeburn 6504: $output .= '</td>';
1.560 damieng 6505: }
1.568 raeburn 6506: $output .= &Apache::loncommon::end_data_table_row();
1.473 amueller 6507: }
1.560 damieng 6508: if ($env{'form.displayfilter'} eq 'containing') {
6509: my $wholeentry=$about_me_link.':'.
6510: $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
6511: $output;
6512: if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473 amueller 6513: }
1.349 www 6514: if ($count) {
1.560 damieng 6515: $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
6516: <td rowspan="'.$count.'">'.$about_me_link.
6517: '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
6518: ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
6519: $send_msg_link.'</td>'.$output);
6520: $shown++;
6521: }
6522: if (!($env{'form.show'} eq &mt('all')
6523: || $shown<=$env{'form.show'})) { last; }
1.286 www 6524: }
1.301 www 6525: $r->print(&Apache::loncommon::end_data_table());
1.507 www 6526: &endSettingsScreen($r);
1.284 www 6527: $r->print(&Apache::loncommon::end_page());
6528: }
6529:
1.560 damieng 6530: ##################################################
6531: # MISC !
6532: ##################################################
6533:
1.563 damieng 6534: # Stores slot information.
1.560 damieng 6535: # Used by table UI
1.563 damieng 6536: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
6537: #
6538: # @param {string} $slot_name - slot name
6539: # @param {string} $cdom - course domain
6540: # @param {string} $cnum - course number
6541: # @param {string} $symb - resource symb
6542: # @param {string} $uname - user name
6543: # @param {string} $udom - user domain
6544: # @returns {string} - 'ok' or error name
1.437 raeburn 6545: sub update_slots {
6546: my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
6547: my %slot=&Apache::lonnet::get_slot($slot_name);
6548: if (!keys(%slot)) {
6549: return 'error: slot does not exist';
6550: }
6551: my $max=$slot{'maxspace'};
6552: if (!defined($max)) { $max=99999; }
6553:
6554: my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
6555: "^$slot_name\0");
6556: my ($tmp)=%consumed;
6557: if ($tmp=~/^error: 2 / ) {
6558: return 'error: unable to determine current slot status';
6559: }
6560: my $last=0;
6561: foreach my $key (keys(%consumed)) {
6562: my $num=(split('\0',$key))[1];
6563: if ($num > $last) { $last=$num; }
6564: if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
6565: return 'ok';
6566: }
6567: }
6568:
6569: if (scalar(keys(%consumed)) >= $max) {
6570: return 'error: no space left in slot';
6571: }
6572: my $wanted=$last+1;
6573:
6574: my %reservation=('name' => $uname.':'.$udom,
6575: 'timestamp' => time,
6576: 'symb' => $symb);
6577:
6578: my $success=&Apache::lonnet::newput('slot_reservations',
6579: {"$slot_name\0$wanted" =>
6580: \%reservation},
6581: $cdom, $cnum);
1.438 raeburn 6582: if ($success eq 'ok') {
6583: my %storehash = (
6584: symb => $symb,
6585: slot => $slot_name,
6586: action => 'reserve',
6587: context => 'parameter',
6588: );
1.526 raeburn 6589: &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524 raeburn 6590: '',$uname,$udom,$cnum,$cdom);
1.438 raeburn 6591:
1.526 raeburn 6592: &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524 raeburn 6593: '',$uname,$udom,$uname,$udom);
1.438 raeburn 6594: }
1.437 raeburn 6595: return $success;
6596: }
6597:
1.563 damieng 6598: # Deletes a slot reservation.
1.560 damieng 6599: # Used by table UI
1.563 damieng 6600: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
6601: #
6602: # @param {string} $slot_name - slot name
6603: # @param {string} $cdom - course domain
6604: # @param {string} $cnum - course number
6605: # @param {string} $uname - user name
6606: # @param {string} $udom - user domain
6607: # @param {string} $symb - resource symb
6608: # @returns {string} - 'ok' or error name
1.437 raeburn 6609: sub delete_slots {
6610: my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
6611: my $delresult;
6612: my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
6613: $cnum, "^$slot_name\0");
6614: if (&Apache::lonnet::error(%consumed)) {
6615: return 'error: unable to determine current slot status';
6616: }
6617: my ($tmp)=%consumed;
6618: if ($tmp=~/^error: 2 /) {
6619: return 'error: unable to determine current slot status';
6620: }
6621: foreach my $key (keys(%consumed)) {
6622: if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
6623: my $num=(split('\0',$key))[1];
6624: my $entry = $slot_name.'\0'.$num;
6625: $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
6626: $cdom,$cnum);
6627: if ($delresult eq 'ok') {
6628: my %storehash = (
6629: symb => $symb,
6630: slot => $slot_name,
6631: action => 'release',
6632: context => 'parameter',
6633: );
1.526 raeburn 6634: &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524 raeburn 6635: 1,$uname,$udom,$cnum,$cdom);
1.526 raeburn 6636: &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524 raeburn 6637: 1,$uname,$udom,$uname,$udom);
1.437 raeburn 6638: }
6639: }
6640: }
6641: return $delresult;
6642: }
6643:
1.563 damieng 6644: # Returns true if there is a current course.
1.560 damieng 6645: # Used by handler
1.563 damieng 6646: #
6647: # @returns {boolean}
1.355 albertel 6648: sub check_for_course_info {
6649: my $navmap = Apache::lonnavmaps::navmap->new();
6650: return 1 if ($navmap);
6651: return 0;
6652: }
6653:
1.563 damieng 6654: # Returns the current course host and host LON-CAPA version.
6655: #
6656: # @returns {Array} - (course hostname, major version number, minor version number)
1.514 raeburn 6657: sub parameter_release_vars {
1.504 raeburn 6658: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
6659: my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
6660: my $chostname = &Apache::lonnet::hostname($chome);
6661: my ($cmajor,$cminor) =
6662: split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
6663: return ($chostname,$cmajor,$cminor);
6664: }
6665:
1.563 damieng 6666: # Checks if the course host version can handle a parameter required version,
6667: # and if it does, stores the release needed for the course.
6668: #
6669: # @param {string} $name - parameter name
6670: # @param {string} $value - parameter value
6671: # @param {string} $valmatch - name of the test used for checking the value
6672: # @param {string} $namematch - name of the test used for checking the name
6673: # @param {string} $needsrelease - version needed by the parameter, major.minor
6674: # @param {integer} $cmajor - course major version number
6675: # @param {integer} $cminor - course minor version number
6676: # @returns {boolean} - true if a newer version is needed
1.514 raeburn 6677: sub parameter_releasecheck {
1.557 raeburn 6678: my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504 raeburn 6679: my $needsnewer;
6680: my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
6681: if (($cmajor < $needsmajor) ||
6682: ($cmajor == $needsmajor && $cminor < $needsminor)) {
6683: $needsnewer = 1;
1.557 raeburn 6684: } elsif ($name) {
6685: if ($valmatch) {
6686: &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
6687: } elsif ($value) {
6688: &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
6689: }
6690: } elsif ($namematch) {
6691: &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504 raeburn 6692: }
6693: return $needsnewer;
6694: }
6695:
1.568 raeburn 6696: sub get_permission {
6697: my %permission;
6698: my $allowed = 0;
6699: return (\%permission,$allowed) unless ($env{'request.course.id'});
6700: if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
6701: (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
6702: $env{'request.course.sec'}))) {
6703: %permission= (
6704: 'edit' => 1,
6705: 'set' => 1,
6706: 'setoverview' => 1,
6707: 'addmetadata' => 1,
6708: 'ordermetadata' => 1,
6709: 'setrestrictmeta' => 1,
6710: 'newoverview' => 1,
6711: 'setdefaults' => 1,
6712: 'settable' => 1,
6713: 'parameterchangelog' => 1,
6714: 'cleanparameters' => 1,
6715: 'dateshift1' => 1,
6716: 'dateshift2' => 1,
6717: 'helper' => 1,
6718: );
6719: } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
6720: (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
6721: $env{'request.course.sec'}))) {
6722: %permission = (
6723: 'set' => 1,
6724: 'settable' => 1,
6725: 'newoverview' => 1,
6726: 'setoverview' => 1,
6727: 'parameterchangelog' => 1,
6728: );
6729: }
6730: foreach my $perm (values(%permission)) {
6731: if ($perm) { $allowed=1; last; }
6732: }
6733: return (\%permission,$allowed);
6734: }
6735:
1.560 damieng 6736: ##################################################
6737: # HANDLER
6738: ##################################################
6739:
6740: # Main handler for lonparmset.
6741: # Sub called based on request parameters action and command:
6742: # no command or action: print_main_menu
6743: # command 'set': assessparms (direct access to table mode for a resource)
6744: # (this can also be accessed simply with the symb parameter)
6745: # action 'setoverview': overview (display all existing parameter settings)
6746: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
6747: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
6748: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
6749: # action 'newoverview': newoverview (overview mode)
6750: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
6751: # action 'settable': assessparms (table mode)
6752: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
6753: # blog postings, user notification changes)
6754: # action 'cleanparameters': clean_parameters (unused)
6755: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
6756: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30 www 6757: sub handler {
1.43 albertel 6758: my $r=shift;
1.30 www 6759:
1.376 albertel 6760: &reset_caches();
6761:
1.414 droeschl 6762: &Apache::loncommon::content_type($r,'text/html');
6763: $r->send_http_header;
6764: return OK if $r->header_only;
6765:
1.193 albertel 6766: &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473 amueller 6767: ['action','state',
1.205 www 6768: 'pres_marker',
6769: 'pres_value',
1.206 www 6770: 'pres_type',
1.506 www 6771: 'filter','part',
1.390 www 6772: 'udom','uname','symb','serial','timebase']);
1.131 www 6773:
1.83 bowersj2 6774:
1.193 albertel 6775: &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194 albertel 6776: &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507 www 6777: text=>"Content and Problem Settings",
1.473 amueller 6778: faq=>10,
6779: bug=>'Instructor Interface',
1.442 droeschl 6780: help =>
6781: 'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203 www 6782:
1.30 www 6783: # ----------------------------------------------------- Needs to be in a course
1.568 raeburn 6784: my ($parm_permission,$allowed) = &get_permission();
1.355 albertel 6785: my $exists = &check_for_course_info();
6786:
1.568 raeburn 6787: if ($env{'request.course.id'} && $allowed && $exists) {
1.193 albertel 6788: #
6789: # Main switch on form.action and form.state, as appropriate
6790: #
6791: # Check first if coming from someone else headed directly for
6792: # the table mode
1.568 raeburn 6793: if (($parm_permission->{'set'}) &&
6794: ((($env{'form.command'} eq 'set') && ($env{'form.url'})
6795: && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
6796: &assessparms($r,$parm_permission);
1.193 albertel 6797: } elsif (! exists($env{'form.action'})) {
6798: &print_main_menu($r,$parm_permission);
1.568 raeburn 6799: } elsif (!$parm_permission->{$env{'form.action'}}) {
6800: &print_main_menu($r,$parm_permission);
1.414 droeschl 6801: } elsif ($env{'form.action'} eq 'setoverview') {
1.568 raeburn 6802: &overview($r,$parm_permission);
1.560 damieng 6803: } elsif ($env{'form.action'} eq 'addmetadata') {
6804: &addmetafield($r);
6805: } elsif ($env{'form.action'} eq 'ordermetadata') {
6806: &order_meta_fields($r);
1.414 droeschl 6807: } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560 damieng 6808: &setrestrictmeta($r);
1.414 droeschl 6809: } elsif ($env{'form.action'} eq 'newoverview') {
1.568 raeburn 6810: &newoverview($r,$parm_permission);
1.414 droeschl 6811: } elsif ($env{'form.action'} eq 'setdefaults') {
1.560 damieng 6812: &defaultsetter($r);
6813: } elsif ($env{'form.action'} eq 'settable') {
1.568 raeburn 6814: &assessparms($r,$parm_permission);
1.414 droeschl 6815: } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568 raeburn 6816: &parm_change_log($r,$parm_permission);
1.414 droeschl 6817: } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560 damieng 6818: &clean_parameters($r);
1.414 droeschl 6819: } elsif ($env{'form.action'} eq 'dateshift1') {
1.390 www 6820: &date_shift_one($r);
1.414 droeschl 6821: } elsif ($env{'form.action'} eq 'dateshift2') {
1.390 www 6822: &date_shift_two($r);
1.446 bisitz 6823: }
1.43 albertel 6824: } else {
1.1 www 6825: # ----------------------------- Not in a course, or not allowed to modify parms
1.560 damieng 6826: if ($exists) {
6827: $env{'user.error.msg'}=
6828: "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
6829: } else {
6830: $env{'user.error.msg'}=
6831: "/adm/parmset::0:1:Course environment gone, reinitialize the course";
6832: }
6833: return HTTP_NOT_ACCEPTABLE;
1.43 albertel 6834: }
1.376 albertel 6835: &reset_caches();
6836:
1.43 albertel 6837: return OK;
1.1 www 6838: }
6839:
6840: 1;
6841: __END__
6842:
6843:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>