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

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

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