Annotation of loncom/interface/lonparmset.pm, revision 1.570

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

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>