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

1.1       www         1: # The LearningOnline Network with CAPA
                      2: # Handler to set parameters for assessments
                      3: #
1.583   ! raeburn     4: # $Id: lonparmset.pm,v 1.582 2017/07/15 15:43:38 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;
                   1859:         $$keyp{$id}='';
1.196     www      1860:         $$uris{$id}=$srcf;
1.512     foxr     1861: 
1.480     amueller 1862:         foreach my $key (split(/\,/,&Apache::lonnet::metadata($srcf,'allpossiblekeys'))) {
                   1863:             next if ($key!~/^parameter_/);
1.363     albertel 1864: 
1.209     www      1865: # Hidden parameters
1.480     amueller 1866:             next if (&Apache::lonnet::metadata($srcf,$key.'.hidden') eq 'parm');
1.209     www      1867: #
                   1868: # allparms is a hash of parameter names
                   1869: #
1.480     amueller 1870:             my $name=&Apache::lonnet::metadata($srcf,$key.'.name');
                   1871:             if (!exists($$allparms{$name}) || $$allparms{$name} =~ m/^\s*$/ ) {
                   1872:                 my ($display,$parmdis);
                   1873:                 $display = &standard_parameter_names($name);
                   1874:                 if ($display eq '') {
                   1875:                     $display= &Apache::lonnet::metadata($srcf,$key.'.display');
                   1876:                     $parmdis = $display;
                   1877:                     $parmdis =~ s/\s*\[Part.*$//g;
                   1878:                 } else {
                   1879:                     $parmdis = &mt($display);
                   1880:                 }
                   1881:                 $$allparms{$name}=$parmdis;
                   1882:                 if (ref($defkeytype)) {
                   1883:                     $$defkeytype{$name}=
                   1884:                     &Apache::lonnet::metadata($srcf,$key.'.type');
                   1885:                 }
                   1886:             }
1.363     albertel 1887: 
1.209     www      1888: #
                   1889: # allparts is a hash of all parts
                   1890: #
1.480     amueller 1891:             my $part= &Apache::lonnet::metadata($srcf,$key.'.part');
                   1892:             $$allparts{$part} = &mt('Part: [_1]',$part);
1.209     www      1893: #
                   1894: # Remember all keys going with this resource
                   1895: #
1.480     amueller 1896:             if ($$keyp{$id}) {
                   1897:                 $$keyp{$id}.=','.$key;
                   1898:             } else {
                   1899:                 $$keyp{$id}=$key;
                   1900:             }   
1.210     www      1901: #
                   1902: # Put in order
1.446     bisitz   1903: #
1.480     amueller 1904:             unless ($$keyorder{$key}) {
                   1905:                 $$keyorder{$key}=$keyordercnt;
                   1906:                 $keyordercnt++;
                   1907:             }
1.473     amueller 1908:         }
                   1909: 
                   1910: 
1.480     amueller 1911:         if (!exists($$mapp{$mapid})) {
                   1912:             $$mapp{$id}=
                   1913:             &Apache::lonnet::declutter($resource->enclosing_map_src());
                   1914:             $$mapp{$mapid}=$$mapp{$id};
                   1915:             $$allmaps{$mapid}=$$mapp{$id};
                   1916:             if ($mapid eq '1') {
1.532     raeburn  1917:                 $$maptitles{$mapid}=&mt('Main Content');
1.480     amueller 1918:             } else {
                   1919:                 $$maptitles{$mapid}=&Apache::lonnet::gettitle($$mapp{$id});
                   1920:             }
                   1921:             $$maptitles{$$mapp{$id}}=$$maptitles{$mapid};
1.556     raeburn  1922:             $$symbp{$mapid}=$$mapp{$id}.'___(all)';  # Added in rev. 1.57, but seems not to be used.
                   1923:                                                      # Lines 1038 and 1114 which use $symbp{$mapid}
                   1924:                                                      # are commented out in rev. 1.57
1.473     amueller 1925:         } else {
1.480     amueller 1926:             $$mapp{$id} = $$mapp{$mapid};
1.473     amueller 1927:         }
1.480     amueller 1928:         $$symbp{$id}=&Apache::lonnet::encode_symb($$mapp{$id},$resid,$srcf);
1.63      bowersj2 1929:     }
                   1930: }
                   1931: 
1.582     raeburn  1932: sub get_recursive {
                   1933:     my ($recurseup,$resdata,$what,$prefix) = @_; 
                   1934:     if ((ref($resdata) eq 'HASH') && (ref($recurseup) eq 'ARRAY')) {
                   1935:         foreach my $item (@{$recurseup}) {
                   1936:             my $norecursechk=$prefix.'.'.$item.'___(all).'.$what;
                   1937:             if (defined($resdata->{$norecursechk})) {
                   1938:                 if ($what =~ /\.(encrypturl|hiddenresource)$/) {
                   1939:                     my $type = $resdata->{$norecursechk.'.type'};
                   1940:                     return [$resdata->{$norecursechk},$type,$item];
                   1941:                 } else {
                   1942:                     last;
                   1943:                 }
                   1944:             }
                   1945:             my $recursechk=$prefix.'.'.$item.'___(rec).'.$what;
                   1946:             if (defined($resdata->{$recursechk})) {
                   1947:                 my $type = $resdata->{$recursechk.'.type'};
                   1948:                 return [$resdata->{$recursechk},$type,$item];
                   1949:             }
                   1950:         }
                   1951:     }
                   1952:     return;
                   1953: }
                   1954: 
1.208     www      1955: 
1.562     damieng  1956: # Tells if a parameter type is a date.
                   1957: #
                   1958: # @param {string} type - parameter type
                   1959: # @returns{boolean} - true if it is a date
1.213     www      1960: sub isdateparm {
                   1961:     my $type=shift;
                   1962:     return (($type=~/^date/) && (!($type eq 'date_interval')));
                   1963: }
                   1964: 
1.562     damieng  1965: # Prints the HTML and Javascript to select parameters, with various shortcuts.
1.468     amueller 1966: #
1.581     raeburn  1967: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      1968: sub parmmenu {
1.581     raeburn  1969:     my ($r)=@_;
1.208     www      1970:     $r->print(<<ENDSCRIPT);
                   1971: <script type="text/javascript">
1.454     bisitz   1972: // <![CDATA[
1.208     www      1973:     function checkall(value, checkName) {
1.453     schualex 1974: 
                   1975:         var li = "_li";
                   1976:         var displayOverview = "";
                   1977:         
                   1978:         if (value == false) {
                   1979:             displayOverview = "none"
                   1980:         }
                   1981: 
1.562     damieng  1982:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.208     www      1983:             ele = document.forms.parmform.elements[i];
                   1984:             if (ele.name == checkName) {
                   1985:                 document.forms.parmform.elements[i].checked=value;
                   1986:             }
                   1987:         }
                   1988:     }
1.210     www      1989: 
                   1990:     function checkthis(thisvalue, checkName) {
1.562     damieng  1991:         for (i=0; i<document.forms.parmform.elements.length; i++) {
1.210     www      1992:             ele = document.forms.parmform.elements[i];
                   1993:             if (ele.name == checkName) {
1.562     damieng  1994:                 if (ele.value == thisvalue) {
                   1995:                     document.forms.parmform.elements[i].checked=true;
                   1996:                 }
1.210     www      1997:             }
                   1998:         }
                   1999:     }
                   2000: 
                   2001:     function checkdates() {
1.562     damieng  2002:         checkthis('duedate','pscat');
                   2003:         checkthis('opendate','pscat');
                   2004:         checkthis('answerdate','pscat');
1.218     www      2005:     }
                   2006: 
                   2007:     function checkdisset() {
1.562     damieng  2008:         checkthis('discussend','pscat');
                   2009:         checkthis('discusshide','pscat');
                   2010:         checkthis('discussvote','pscat');
1.218     www      2011:     }
                   2012: 
                   2013:     function checkcontdates() {
1.562     damieng  2014:         checkthis('contentopen','pscat');
                   2015:         checkthis('contentclose','pscat');
1.218     www      2016:     }
1.446     bisitz   2017: 
1.210     www      2018:     function checkvisi() {
1.562     damieng  2019:         checkthis('hiddenresource','pscat');
                   2020:         checkthis('encrypturl','pscat');
                   2021:         checkthis('problemstatus','pscat');
                   2022:         checkthis('contentopen','pscat');
                   2023:         checkthis('opendate','pscat');
1.210     www      2024:     }
                   2025: 
                   2026:     function checkparts() {
1.562     damieng  2027:         checkthis('hiddenparts','pscat');
                   2028:         checkthis('display','pscat');
                   2029:         checkthis('ordered','pscat');
1.210     www      2030:     }
                   2031: 
                   2032:     function checkstandard() {
                   2033:         checkall(false,'pscat');
1.562     damieng  2034:         checkdates();
                   2035:         checkthis('weight','pscat');
                   2036:         checkthis('maxtries','pscat');
                   2037:         checkthis('type','pscat');
                   2038:         checkthis('problemstatus','pscat');
1.210     www      2039:     }
                   2040: 
1.454     bisitz   2041: // ]]>
1.208     www      2042: </script>
                   2043: ENDSCRIPT
1.453     schualex 2044: 
1.491     bisitz   2045:     $r->print('<hr />');
1.581     raeburn  2046:     &shortCuts($r);
1.491     bisitz   2047:     $r->print('<hr />');
1.453     schualex 2048: }
1.562     damieng  2049: 
                   2050: # Returns parameter categories.
                   2051: #
                   2052: # @returns {hash} - category name -> title in English
1.465     amueller 2053: sub categories {
                   2054:     return ('time_settings' => 'Time Settings',
                   2055:     'grading' => 'Grading',
                   2056:     'tries' => 'Tries',
                   2057:     'problem_appearance' => 'Problem Appearance',
                   2058:     'behaviour_of_input_fields' => 'Behaviour of Input Fields',
                   2059:     'hiding' => 'Hiding',
                   2060:     'high_level_randomization' => 'High Level Randomization',
                   2061:     'slots' => 'Slots',
                   2062:     'file_submission' => 'File Submission',
                   2063:     'misc' => 'Miscellaneous' ); 
                   2064: }
                   2065: 
1.562     damieng  2066: # Returns the category for each parameter.
                   2067: #
                   2068: # @returns {hash} - parameter name -> category name
1.465     amueller 2069: sub lookUpTableParameter {
                   2070:  
                   2071:     return ( 
                   2072:         'opendate' => 'time_settings',
                   2073:         'duedate' => 'time_settings',
                   2074:         'answerdate' => 'time_settings',
                   2075:         'interval' => 'time_settings',
                   2076:         'contentopen' => 'time_settings',
                   2077:         'contentclose' => 'time_settings',
                   2078:         'discussend' => 'time_settings',
1.560     damieng  2079:         'printstartdate' => 'time_settings',
                   2080:         'printenddate' => 'time_settings',
1.465     amueller 2081:         'weight' => 'grading',
                   2082:         'handgrade' => 'grading',
                   2083:         'maxtries' => 'tries',
                   2084:         'hinttries' => 'tries',
1.503     raeburn  2085:         'randomizeontries' => 'tries',
1.465     amueller 2086:         'type' => 'problem_appearance',
                   2087:         'problemstatus' => 'problem_appearance',
                   2088:         'display' => 'problem_appearance',
                   2089:         'ordered' => 'problem_appearance',
                   2090:         'numbubbles' => 'problem_appearance',
                   2091:         'tol' => 'behaviour_of_input_fields',
                   2092:         'sig' => 'behaviour_of_input_fields',
                   2093:         'turnoffunit' => 'behaviour_of_input_fields',
                   2094:         'hiddenresource' => 'hiding',
                   2095:         'hiddenparts' => 'hiding',
                   2096:         'discusshide' => 'hiding',
                   2097:         'buttonshide' => 'hiding',
                   2098:         'turnoffeditor' => 'hiding',
                   2099:         'encrypturl' => 'hiding',
                   2100:         'randomorder' => 'high_level_randomization',
                   2101:         'randompick' => 'high_level_randomization',
                   2102:         'available' => 'slots',
                   2103:         'useslots' => 'slots',
                   2104:         'availablestudent' => 'slots',
                   2105:         'uploadedfiletypes' => 'file_submission',
                   2106:         'maxfilesize' => 'file_submission',
                   2107:         'cssfile' => 'misc',
                   2108:         'mapalias' => 'misc',
                   2109:         'acc' => 'misc',
                   2110:         'maxcollaborators' => 'misc',
                   2111:         'scoreformat' => 'misc',
1.514     raeburn  2112:         'lenient' => 'grading',
1.519     raeburn  2113:         'retrypartial' => 'tries',
1.521     raeburn  2114:         'discussvote'  => 'misc',
1.533     raeburn  2115:         'examcode' => 'high_level_randomization', 
1.575     raeburn  2116:     );
1.465     amueller 2117: }
                   2118: 
1.562     damieng  2119: # Adds the given parameter name to an array of arrays listing all parameters for each category.
                   2120: #
                   2121: # @param {string} $name - parameter name
                   2122: # @param {array reference} $catList - array reference category name -> array reference of parameter names
1.465     amueller 2123: sub whatIsMyCategory {
                   2124:     my $name = shift;
                   2125:     my $catList = shift;
                   2126:     my @list;
                   2127:     my %lookUpList = &lookUpTableParameter; #Initilize the lookupList
                   2128:     my $cat = $lookUpList{$name};
                   2129:     if (defined($cat)) {
                   2130:         if (!defined($$catList{$cat})){
                   2131:             push @list, ($name);
                   2132:             $$catList{$cat} = \@list;
                   2133:         } else {
                   2134:             push @{${$catList}{$cat}}, ($name);     
                   2135:         }
                   2136:     } else {
                   2137:         if (!defined($$catList{'misc'})){
                   2138:             push @list, ($name);
                   2139:             $$catList{'misc'} = \@list;
                   2140:         } else {
                   2141:             push @{${$catList}{'misc'}}, ($name);     
                   2142:         }
                   2143:     }        
                   2144: }
                   2145: 
1.562     damieng  2146: # Sorts parameter names based on appearance order.
                   2147: #
                   2148: # @param {array reference} name - array reference of parameter names
                   2149: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2150: # @returns {Array} - array of parameter names
1.465     amueller 2151: sub keysindisplayorderCategory {
                   2152:     my ($name,$keyorder)=@_;
                   2153:     return sort {
1.473     amueller 2154:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b}; 
1.465     amueller 2155:     } ( @{$name});
                   2156: }
                   2157: 
1.562     damieng  2158: # Returns a hash category name -> order, starting at 1 (integer)
                   2159: #
                   2160: # @returns {hash}
1.467     amueller 2161: sub category_order {
                   2162:     return (
                   2163:         'time_settings' => 1,
                   2164:         'grading' => 2,
                   2165:         'tries' => 3,
                   2166:         'problem_appearance' => 4,
                   2167:         'hiding' => 5,
                   2168:         'behaviour_of_input_fields' => 6,
                   2169:         'high_level_randomization'  => 7,
                   2170:         'slots' => 8,
                   2171:         'file_submission' => 9,
                   2172:         'misc' => 10
                   2173:     );
                   2174: 
                   2175: }
1.453     schualex 2176: 
1.562     damieng  2177: # Prints HTML to let the user select parameters, from a list of all parameters organized by category.
                   2178: #
                   2179: # @param {Apache2::RequestRec} $r - the Apache request
                   2180: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2181: # @param {array reference} $pscat - list of selected parameter names
                   2182: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
1.453     schualex 2183: sub parmboxes {
                   2184:     my ($r,$allparms,$pscat,$keyorder)=@_;
1.548     raeburn  2185:     my %categories = &categories();
1.467     amueller 2186:     my %category_order = &category_order();
1.465     amueller 2187:     my %categoryList = (
                   2188:         'time_settings' => [],
                   2189:         'grading' => [],
                   2190:         'tries' => [],
                   2191:         'problem_appearance' => [],
                   2192:         'behaviour_of_input_fields' => [],
                   2193:         'hiding' => [],
                   2194:         'high_level_randomization' => [],
                   2195:         'slots' => [],
                   2196:         'file_submission' => [],
                   2197:         'misc' => [],
1.489     bisitz   2198:     );
1.510     www      2199: 
1.548     raeburn  2200:     foreach my $tempparameter (keys(%$allparms)) {
1.465     amueller 2201:         &whatIsMyCategory($tempparameter, \%categoryList);
                   2202:     }
1.453     schualex 2203:     #part to print the parm-list
1.536     raeburn  2204:     foreach my $key (sort { $category_order{$a} <=> $category_order{$b} } keys(%categoryList)) {
                   2205:         next if (@{$categoryList{$key}} == 0);
                   2206:         next if ($key eq '');
                   2207:         $r->print('<div class="LC_Box LC_400Box">'
                   2208:                  .'<h4 class="LC_hcell">'.&mt($categories{$key}).'</h4>'."\n");
                   2209:         foreach my $tempkey (&keysindisplayorderCategory($categoryList{$key},$keyorder)) {
1.575     raeburn  2210:             next if ($tempkey eq '');
1.536     raeburn  2211:             $r->print('<span class="LC_nobreak">'
                   2212:                      .'<label><input type="checkbox" name="pscat" '
                   2213:                      .'value="'.$tempkey.'" ');
                   2214:             if ($$pscat[0] eq "all" || grep $_ eq $tempkey, @{$pscat}) {
                   2215:                 $r->print( ' checked="checked"');
                   2216:             }
                   2217:             $r->print(' />'.($$allparms{$tempkey}=~/\S/ ? $$allparms{$tempkey}
1.465     amueller 2218:                                                       : $tempkey)
1.536     raeburn  2219:                      .'</label></span><br />'."\n");
1.465     amueller 2220:         }
1.536     raeburn  2221:         $r->print('</div>');
1.465     amueller 2222:     }
1.536     raeburn  2223:     $r->print("\n");
1.453     schualex 2224: }
1.562     damieng  2225: 
                   2226: # Prints HTML with shortcuts to select groups of parameters in one click, or deselect all.
1.468     amueller 2227: #
1.562     damieng  2228: # @param {Apache2::RequestRec} $r - the Apache request
1.453     schualex 2229: sub shortCuts {
1.581     raeburn  2230:     my ($r)=@_;
1.453     schualex 2231: 
1.491     bisitz   2232:     # Parameter Selection
                   2233:     $r->print(
                   2234:         &Apache::lonhtmlcommon::start_funclist(&mt('Parameter Selection'))
                   2235:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2236:             '<a href="javascript:checkall(true, \'pscat\')">'.&mt('Select All').'</a>')
                   2237:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2238:             '<a href="javascript:checkstandard()">'.&mt('Select Common Only').'</a>')
                   2239:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2240:             '<a href="javascript:checkall(false, \'pscat\')">'.&mt('Unselect All').'</a>')
                   2241:        .&Apache::lonhtmlcommon::end_funclist()
                   2242:     );
                   2243: 
                   2244:     # Add Selection for...
                   2245:     $r->print(
                   2246:         &Apache::lonhtmlcommon::start_funclist(&mt('Add Selection for...'))
                   2247:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2248:             '<a href="javascript:checkdates()">'.&mt('Problem Dates').'</a>')
                   2249:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2250:             '<a href="javascript:checkcontdates()">'.&mt('Content Dates').'</a>')
                   2251:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2252:             '<a href="javascript:checkdisset()">'.&mt('Discussion Settings').'</a>')
                   2253:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2254:             '<a href="javascript:checkvisi()">'.&mt('Visibilities').'</a>')
                   2255:        .&Apache::lonhtmlcommon::add_item_funclist(
                   2256:             '<a href="javascript:checkparts()">'.&mt('Part Parameters').'</a>')
                   2257:        .&Apache::lonhtmlcommon::end_funclist()
                   2258:     );
1.208     www      2259: }
                   2260: 
1.562     damieng  2261: # Prints HTML to select parts to view (except for the title).
                   2262: # Used by table and overview modes.
                   2263: #
                   2264: # @param {Apache2::RequestRec} $r - the Apache request
                   2265: # @param {hash reference} $allparts - hash parameter part -> part title
                   2266: # @param {array reference} $psprt - list of selected parameter parts
1.209     www      2267: sub partmenu {
1.446     bisitz   2268:     my ($r,$allparts,$psprt)=@_;
1.523     raeburn  2269:     my $selsize = 1+scalar(keys(%{$allparts}));
                   2270:     if ($selsize > 8) {
                   2271:         $selsize = 8;
                   2272:     }
1.446     bisitz   2273: 
1.523     raeburn  2274:     $r->print('<select multiple="multiple" name="psprt" size="'.$selsize.'">');
1.208     www      2275:     $r->print('<option value="all"');
1.562     damieng  2276:     $r->print(' selected="selected"') unless (@{$psprt}); # useless, the array is never empty
1.208     www      2277:     $r->print('>'.&mt('All Parts').'</option>');
                   2278:     my %temphash=();
                   2279:     foreach (@{$psprt}) { $temphash{$_}=1; }
1.234     albertel 2280:     foreach my $tempkey (sort {
1.560     damieng  2281:                 if ($a==$b) { return ($a cmp $b) } else { return ($a <=> $b); }
                   2282:             } keys(%{$allparts})) {
                   2283:         unless ($tempkey =~ /\./) {
                   2284:             $r->print('<option value="'.$tempkey.'"');
                   2285:             if ($$psprt[0] eq "all" ||  $temphash{$tempkey}) {
                   2286:                 $r->print(' selected="selected"');
                   2287:             }
                   2288:             $r->print('>'.$$allparts{$tempkey}.'</option>');
1.473     amueller 2289:         }
1.208     www      2290:     }
1.446     bisitz   2291:     $r->print('</select>');
1.209     www      2292: }
                   2293: 
1.562     damieng  2294: # Prints HTML to select a user and/or a group.
                   2295: # Used by table mode.
                   2296: #
                   2297: # @param {Apache2::RequestRec} $r - the Apache request
                   2298: # @param {string} $uname - selected user name
                   2299: # @param {string} $id - selected Student/Employee ID
                   2300: # @param {string} $udom - selected user domain
                   2301: # @param {string} $csec - selected section name
                   2302: # @param {string} $cgroup - selected group name
                   2303: # @param {string} $parmlev - parameter level (Resource:'full', Map:'map', Course:'general')
                   2304: # @param {array reference} $usersgroups - list of groups the user belongs to, if any
                   2305: # @param {string} $pssymb - resource symb (when a single resource is selected)
1.209     www      2306: sub usermenu {
1.553     raeburn  2307:     my ($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,$usersgroups,$pssymb)=@_;
1.209     www      2308:     my $chooseopt=&Apache::loncommon::select_dom_form($udom,'udom').' '.
                   2309:         &Apache::loncommon::selectstudent_link('parmform','uname','udom');
                   2310:     my $selscript=&Apache::loncommon::studentbrowser_javascript();
1.412     bisitz   2311: 
1.209     www      2312:     my $sections='';
1.300     albertel 2313:     my %sectionhash = &Apache::loncommon::get_sections();
                   2314: 
1.269     raeburn  2315:     my $groups;
1.553     raeburn  2316:     my %grouphash;
                   2317:     if (($pssymb) || &Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2318:         %grouphash = &Apache::longroup::coursegroups();
                   2319:     } elsif ($env{'request.course.groups'} ne '') {
                   2320:         map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2321:     }
1.299     albertel 2322: 
1.412     bisitz   2323:     my $g_s_header='';
                   2324:     my $g_s_footer='';
1.446     bisitz   2325: 
1.552     raeburn  2326:     my $currsec = $env{'request.course.sec'};
                   2327:     if ($currsec) {
                   2328:         $sections=&mt('Section:').' '.$currsec;
                   2329:         if (%grouphash) {
                   2330:             $sections .= ';'.('&nbsp;' x2);
                   2331:         }
                   2332:     } elsif (%sectionhash && $currsec eq '') {
1.412     bisitz   2333:         $sections=&mt('Section:').' <select name="csec"';
1.299     albertel 2334:         if (%grouphash && $parmlev ne 'full') {
1.269     raeburn  2335:             $sections .= qq| onchange="group_or_section('csec')" |;
                   2336:         }
                   2337:         $sections .= '>';
1.548     raeburn  2338:     foreach my $section ('',sort(keys(%sectionhash))) {
1.473     amueller 2339:         $sections.='<option value="'.$section.'" '.
                   2340:         ($section eq $csec?'selected="selected"':'').'>'.$section.
1.275     raeburn  2341:                                                               '</option>';
1.209     www      2342:         }
                   2343:         $sections.='</select>';
1.269     raeburn  2344:     }
1.412     bisitz   2345: 
1.552     raeburn  2346:     if (%sectionhash && %grouphash && $parmlev ne 'full' && $currsec eq '') {
1.412     bisitz   2347:         $sections .= '&nbsp;'.&mt('or').'&nbsp;';
1.269     raeburn  2348:         $sections .= qq|
                   2349: <script type="text/javascript">
1.454     bisitz   2350: // <![CDATA[
1.269     raeburn  2351: function group_or_section(caller) {
                   2352:    if (caller == "cgroup") {
                   2353:        if (document.parmform.cgroup.selectedIndex != 0) {
                   2354:            document.parmform.csec.selectedIndex = 0;
                   2355:        }
                   2356:    } else {
                   2357:        if (document.parmform.csec.selectedIndex != 0) {
                   2358:            document.parmform.cgroup.selectedIndex = 0;
                   2359:        }
                   2360:    }
                   2361: }
1.454     bisitz   2362: // ]]>
1.269     raeburn  2363: </script>
                   2364: |;
1.554     raeburn  2365:     } else {
1.269     raeburn  2366:         $sections .= qq|
                   2367: <script type="text/javascript">
1.454     bisitz   2368: // <![CDATA[
1.269     raeburn  2369: function group_or_section(caller) {
                   2370:     return;
                   2371: }
1.454     bisitz   2372: // ]]>
1.269     raeburn  2373: </script>
                   2374: |;
1.446     bisitz   2375:     }
1.299     albertel 2376: 
                   2377:     if (%grouphash) {
1.412     bisitz   2378:         $groups=&mt('Group:').' <select name="cgroup"';
1.552     raeburn  2379:         if (%sectionhash && $env{'form.action'} eq 'settable' && $currsec eq '') {
1.269     raeburn  2380:             $groups .= qq| onchange="group_or_section('cgroup')" |;
                   2381:         }
                   2382:         $groups .= '>';
1.548     raeburn  2383:         foreach my $grp ('',sort(keys(%grouphash))) {
1.275     raeburn  2384:             $groups.='<option value="'.$grp.'" ';
                   2385:             if ($grp eq $cgroup) {
                   2386:                 unless ((defined($uname)) && ($grp eq '')) {
                   2387:                     $groups .=  'selected="selected" ';
                   2388:                 }
                   2389:             } elsif (!defined($cgroup)) {
                   2390:                 if (@{$usersgroups} == 1) {
                   2391:                     if ($grp eq $$usersgroups[0]) {
                   2392:                         $groups .=  'selected="selected" ';
                   2393:                     }
                   2394:                 }
                   2395:             }
                   2396:             $groups .= '>'.$grp.'</option>';
1.269     raeburn  2397:         }
                   2398:         $groups.='</select>';
                   2399:     }
1.412     bisitz   2400: 
1.445     neumanie 2401:     if (%sectionhash || %grouphash) {
1.446     bisitz   2402:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Group/Section')));
                   2403:         $r->print($sections.$groups);
1.448     bisitz   2404:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.554     raeburn  2405:     } else {
                   2406:         $r->print($sections); 
1.445     neumanie 2407:     }
1.446     bisitz   2408: 
                   2409:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('User')));
1.443     neumanie 2410:     $r->print(&mt('For User [_1] or Student/Employee ID [_2] at Domain [_3]'
1.412     bisitz   2411:                  ,'<input type="text" value="'.$uname.'" size="12" name="uname" />'
                   2412:                  ,'<input type="text" value="'.$id.'" size="12" name="id" /> '
1.446     bisitz   2413:                  ,$chooseopt));
1.209     www      2414: }
                   2415: 
1.562     damieng  2416: # Prints HTML to select parameters from a list of all parameters.
                   2417: # Uses parmmenu and parmboxes.
                   2418: # Used by table and overview modes.
1.468     amueller 2419: #
1.562     damieng  2420: # @param {Apache2::RequestRec} $r - the Apache request
                   2421: # @param {hash reference} $allparms - hash parameter name -> parameter title
                   2422: # @param {array reference} $pscat - list of selected parameter names
                   2423: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2424: # @param {string} [$divid] - name used to give an id to the HTML element for the scroll box
1.209     www      2425: sub displaymenu {
1.581     raeburn  2426:     my ($r,$allparms,$pscat,$keyorder,$divid)=@_;
1.510     www      2427: 
1.445     neumanie 2428:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.510     www      2429:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameters to View')));
                   2430: 
1.581     raeburn  2431:     &parmmenu($r);
1.536     raeburn  2432:     $r->print(&Apache::loncommon::start_scrollbox('480px','440px','200px',$divid));
1.510     www      2433:     &parmboxes($r,$allparms,$pscat,$keyorder);
                   2434:     $r->print(&Apache::loncommon::end_scrollbox());
                   2435: 
                   2436:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.453     schualex 2437:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.510     www      2438:  
1.209     www      2439: }
                   2440: 
1.562     damieng  2441: # Prints HTML to select a map.
                   2442: # Used by table mode and overview mode.
                   2443: #
                   2444: # @param {Apache2::RequestRec} $r - the Apache request
1.566     damieng  2445: # @param {hash reference} $allmaps - hash map pc -> map src
                   2446: # @param {string} $pschp - selected map pc, or 'all'
1.562     damieng  2447: # @param {hash reference} $maptitles - hash map id or src -> map title
1.566     damieng  2448: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.445     neumanie 2449: sub mapmenu {
1.499     raeburn  2450:     my ($r,$allmaps,$pschp,$maptitles,$symbp)=@_;
1.468     amueller 2451:     my %allmaps_inverted = reverse %$allmaps;
1.461     neumanie 2452:     my $navmap = Apache::lonnavmaps::navmap->new();
                   2453:     my $tree=[];
                   2454:     my $treeinfo={};
                   2455:     if (defined($navmap)) {
1.499     raeburn  2456:         my $it=$navmap->getIterator(undef,undef,undef,1,1,undef);
1.461     neumanie 2457:         my $curRes;
                   2458:         my $depth = 0;
1.468     amueller 2459:         my %parent = ();
                   2460:         my $startcount = 5;
                   2461:         my $lastcontainer = $startcount;
                   2462: # preparing what is to show ...
1.461     neumanie 2463:         while ($curRes = $it->next()) {
                   2464:             if ($curRes == $it->BEGIN_MAP()) {
                   2465:                 $depth++;
1.468     amueller 2466:                 $parent{$depth}= $lastcontainer;
1.461     neumanie 2467:             }
                   2468:             if ($curRes == $it->END_MAP()) {
                   2469:                 $depth--;
1.468     amueller 2470:                 $lastcontainer = $parent{$depth};
1.461     neumanie 2471:             }
                   2472:             if (ref($curRes)) {
1.468     amueller 2473:                 my $symb = $curRes->symb();
                   2474:                 my $ressymb = $symb;
1.461     neumanie 2475:                 if (($curRes->is_sequence()) || ($curRes->is_page())) {
                   2476:                     my $type = 'sequence';
                   2477:                     if ($curRes->is_page()) {
                   2478:                         $type = 'page';
                   2479:                     }
                   2480:                     my $id= $curRes->id();
1.468     amueller 2481:                     my $srcf = $curRes->src();
                   2482:                     my $resource_name = &Apache::lonnet::gettitle($srcf);
                   2483:                     if(!exists($treeinfo->{$id})) {
                   2484:                         push(@$tree,$id);
1.473     amueller 2485:                         my $enclosing_map_folder = &Apache::lonnet::declutter($curRes->enclosing_map_src());        
1.468     amueller 2486:                         $treeinfo->{$id} = {
1.461     neumanie 2487:                                     depth => $depth,
                   2488:                                     type  => $type,
1.468     amueller 2489:                                     name  => $resource_name,
                   2490:                                     enclosing_map_folder => $enclosing_map_folder,
1.461     neumanie 2491:                                     };
1.462     neumanie 2492:                     }
1.461     neumanie 2493:                 }
                   2494:             }
                   2495:         }
1.462     neumanie 2496:     }
1.473     amueller 2497: # Show it ...    
1.484     amueller 2498:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Enclosing Map or Folder'),'','',' id="mapmenu"'));
1.461     neumanie 2499:     if ((ref($tree) eq 'ARRAY') && (ref($treeinfo) eq 'HASH')) {
                   2500:         my $icon = '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.497     bisitz   2501:         my $whitespace =
                   2502:             '<img src="'
                   2503:            .&Apache::loncommon::lonhttpdurl('/adm/lonIcons/whitespace_21.gif')
                   2504:            .'" alt="" />';
                   2505: 
1.498     bisitz   2506:         # Info about selectable folders/maps
                   2507:         $r->print(
                   2508:             '<div class="LC_info">'
1.508     www      2509:            .&mt('You can only select maps and folders which have modifiable settings.')
                   2510:            .' '.&Apache::loncommon::help_open_topic('Parameter_Set_Folder') 
1.498     bisitz   2511:            .'</div>'
                   2512:         );
                   2513: 
1.536     raeburn  2514:         $r->print(&Apache::loncommon::start_scrollbox('700px','680px','400px','mapmenuscroll'));
1.523     raeburn  2515:         $r->print(&Apache::loncommon::start_data_table(undef,'mapmenuinner'));
1.497     bisitz   2516: 
1.498     bisitz   2517:         # Display row: "All Maps or Folders"
                   2518:         $r->print(
1.523     raeburn  2519:             &Apache::loncommon::start_data_table_row(undef,'picklevel')
1.498     bisitz   2520:            .'<td>'
                   2521:            .'<label>'
                   2522:            .'<input type="radio" name="pschp"'
1.497     bisitz   2523:         );
                   2524:         $r->print(' checked="checked"') if ($pschp eq 'all' || !$pschp);
1.498     bisitz   2525:         $r->print(
                   2526:             ' value="all" />&nbsp;'.$icon.'&nbsp;'
                   2527:            .&mt('All Maps or Folders')
                   2528:            .'</label>'
                   2529:            .'<hr /></td>'
                   2530:            .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2531:         );
1.497     bisitz   2532: 
1.532     raeburn  2533:         # Display row: "Main Content"
1.468     amueller 2534:         if (exists($$allmaps{1})) {
1.498     bisitz   2535:             $r->print(
                   2536:                 &Apache::loncommon::start_data_table_row()
                   2537:                .'<td>'
                   2538:                .'<label>'
                   2539:                .'<input type="radio" name="pschp" value="1"'
1.468     amueller 2540:             );
1.497     bisitz   2541:             $r->print(' checked="checked"') if ($pschp eq '1');
1.498     bisitz   2542:             $r->print(
                   2543:                 '/>&nbsp;'.$icon.'&nbsp;'
                   2544:                .$$maptitles{1}
                   2545:                .($$allmaps{1} !~/^uploaded/?' ['.$$allmaps{1}.']':'')
                   2546:                .'</label>'
                   2547:                .'</td>'
                   2548:                .&Apache::loncommon::end_data_table_row()
1.468     amueller 2549:             );
                   2550:         }
1.497     bisitz   2551: 
                   2552:         # Display rows for all course maps and folders
1.468     amueller 2553:         foreach my $id (@{$tree}) {
                   2554:             my ($mapid,$resid)=split(/\./,$id);
1.464     bisitz   2555:             # Indentation
1.468     amueller 2556:             my $depth = $treeinfo->{$id}->{'depth'};
1.464     bisitz   2557:             my $indent;
                   2558:             for (my $i = 0; $i < $depth; $i++) {
                   2559:                 $indent.= $whitespace;
                   2560:             }
1.461     neumanie 2561:             $icon =  '<img src="/adm/lonIcons/navmap.folder.open.gif" alt="" />';
1.468     amueller 2562:             if ($treeinfo->{$id}->{'type'} eq 'page') {
1.461     neumanie 2563:                 $icon = '<img src="/adm/lonIcons/navmap.page.open.gif" alt="" />';
                   2564:             }
1.468     amueller 2565:             my $symb_name = $$symbp{$id};
                   2566:             my ($front, $tail) = split (/___${resid}___/, $symb_name);
                   2567:             $symb_name = $tail;
1.498     bisitz   2568:             $r->print(
                   2569:                 &Apache::loncommon::start_data_table_row()
                   2570:                .'<td>'
                   2571:                .'<label>'
1.463     bisitz   2572:             );
1.498     bisitz   2573:             # Only offer radio button for folders/maps which can be parameterized
                   2574:             if ($allmaps_inverted{$symb_name}) {
                   2575:                 $r->print(
                   2576:                     '<input type ="radio" name="pschp"'
                   2577:                    .' value="'.$allmaps_inverted{$symb_name}.'"'
                   2578:                 );
                   2579:                 $r->print(' checked="checked"') if ($allmaps_inverted{$symb_name} eq $pschp);
                   2580:                 $r->print('/>');
                   2581:             } else {
                   2582:                 $r->print($whitespace);
1.461     neumanie 2583:             }
1.498     bisitz   2584:             $r->print(
                   2585:                 $indent.$icon.'&nbsp;'
                   2586:                .$treeinfo->{$id}->{name}
                   2587:                .($$allmaps{$mapid}!~/^uploaded/?' ['.$$allmaps{$mapid}.']':'')
                   2588:                .'</label>'
                   2589:                .'</td>'
                   2590:                .&Apache::loncommon::end_data_table_row()
1.463     bisitz   2591:             );
1.461     neumanie 2592:         }
1.497     bisitz   2593: 
1.523     raeburn  2594:         $r->print(&Apache::loncommon::end_data_table().
                   2595:                   '<br style="line-height:2px;" />'.
                   2596:                   &Apache::loncommon::end_scrollbox());
1.209     www      2597:     }
                   2598: }
                   2599: 
1.563     damieng  2600: # Prints HTML to select the parameter level (resource, map/folder or course).
                   2601: # Used by table and overview modes.
                   2602: #
                   2603: # @param {Apache2::RequestRec} $r - the Apache request
                   2604: # @param {hash reference} $alllevs - all parameter levels, hash English title -> value
                   2605: # @param {string} $parmlev - selected level value (full|map|general), or ''
1.209     www      2606: sub levelmenu {
1.446     bisitz   2607:     my ($r,$alllevs,$parmlev)=@_;
                   2608: 
1.548     raeburn  2609:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parameter Level').
                   2610:                                                 &Apache::loncommon::help_open_topic('Course_Parameter_Levels')));
1.474     amueller 2611:     $r->print('<select id="parmlev" name="parmlev" onchange="showHide_courseContent()">');
1.548     raeburn  2612:     foreach my $lev (reverse(sort(keys(%{$alllevs})))) {
                   2613:         $r->print('<option value="'.$$alllevs{$lev}.'"');
                   2614:         if ($parmlev eq $$alllevs{$lev}) {
                   2615:             $r->print(' selected="selected"');
                   2616:         }
                   2617:         $r->print('>'.&mt($lev).'</option>');
1.208     www      2618:     }
1.446     bisitz   2619:     $r->print("</select>");
1.208     www      2620: }
                   2621: 
1.211     www      2622: 
1.563     damieng  2623: # Returns HTML to select a section (with a select HTML element).
                   2624: # Used by overview mode.
                   2625: #
                   2626: # @param {array reference} $selectedsections - list of selected section ids
                   2627: # @returns {string}
1.211     www      2628: sub sectionmenu {
1.553     raeburn  2629:     my ($selectedsections)=@_;
1.300     albertel 2630:     my %sectionhash = &Apache::loncommon::get_sections();
1.553     raeburn  2631:     return '' if (!%sectionhash);
1.300     albertel 2632: 
1.552     raeburn  2633:     my (@possibles,$disabled);
                   2634:     if ($env{'request.course.sec'} ne '') {
                   2635:         @possibles = ($env{'request.course.sec'});
                   2636:         $selectedsections = [$env{'request.course.sec'}];
                   2637:         $disabled = ' disabled="disabled"';
                   2638:     } else {
                   2639:         @possibles = ('all',sort(keys(%sectionhash)));
                   2640:     }
1.553     raeburn  2641:     my $output = '<select name="Section" multiple="multiple" size="8"'.$disabled.'>';
1.552     raeburn  2642:     foreach my $s (@possibles) {
1.553     raeburn  2643:         $output .= '    <option value="'.$s.'"';
                   2644:         if ((@{$selectedsections}) && (grep(/^\Q$s\E$/,@{$selectedsections}))) {  
                   2645:             $output .= ' selected="selected"';
1.473     amueller 2646:         }
1.553     raeburn  2647:         $output .= '>'."$s</option>\n";
1.300     albertel 2648:     }
1.553     raeburn  2649:     $output .= "</select>\n";
                   2650:     return $output;
1.269     raeburn  2651: }
                   2652: 
1.563     damieng  2653: # Returns HTML to select a group (with a select HTML element).
                   2654: # Used by overview mode.
                   2655: #
                   2656: # @param {array reference} $selectedgroups - list of selected group names
                   2657: # @returns {string}
1.269     raeburn  2658: sub groupmenu {
1.553     raeburn  2659:     my ($selectedgroups)=@_;
                   2660:     my %grouphash;
                   2661:     if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2662:         %grouphash = &Apache::longroup::coursegroups();
                   2663:     } elsif ($env{'request.course.groups'} ne '') {
                   2664:          map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   2665:     }
                   2666:     return '' if (!%grouphash);
1.299     albertel 2667: 
1.553     raeburn  2668:     my $output = '<select name="Group" multiple="multiple" size="8">';
1.299     albertel 2669:     foreach my $group (sort(keys(%grouphash))) {
1.553     raeburn  2670:         $output .= '    <option value="'.$group.'"';
                   2671:         if ((@{$selectedgroups}) && (grep(/^\Q$group\E$/,\@{$selectedgroups}))) {
                   2672:             $output .=  ' selected="selected"';
1.473     amueller 2673:         }
1.553     raeburn  2674:         $output .= '>'."$group</option>\n";
1.211     www      2675:     }
1.553     raeburn  2676:     $output .= "</select>\n";
                   2677:     return $output;
1.211     www      2678: }
                   2679: 
1.563     damieng  2680: # Returns an array with the given parameter split by comma.
                   2681: # Used by assessparms (table mode).
                   2682: #
                   2683: # @param {string} $keyp - the string to split
                   2684: # @returns {Array<string>}
1.210     www      2685: sub keysplit {
                   2686:     my $keyp=shift;
                   2687:     return (split(/\,/,$keyp));
                   2688: }
                   2689: 
1.563     damieng  2690: # Returns the keys in $name, sorted using $keyorder.
                   2691: # Parameters are sorted by key, which means they are sorted by part first, then by name.
                   2692: # Used by assessparms (table mode) for resource level.
                   2693: #
                   2694: # @param {hash reference} $name - parameter key -> parameter name
                   2695: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2696: # @returns {Array<string>}
1.210     www      2697: sub keysinorder {
                   2698:     my ($name,$keyorder)=@_;
                   2699:     return sort {
1.560     damieng  2700:         $$keyorder{$a} <=> $$keyorder{$b};
1.548     raeburn  2701:     } (keys(%{$name}));
1.210     www      2702: }
                   2703: 
1.563     damieng  2704: # Returns the keys in $name, sorted using $keyorder to sort parameters by name first, then by part.
                   2705: # Used by assessparms (table mode) for map and general levels.
                   2706: #
                   2707: # @param {hash reference} $name - parameter key -> parameter name
                   2708: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2709: # @returns {Array<string>}
1.236     albertel 2710: sub keysinorder_bytype {
                   2711:     my ($name,$keyorder)=@_;
                   2712:     return sort {
1.563     damieng  2713:         my $ta=(split('_',$a))[-1]; # parameter name
1.560     damieng  2714:         my $tb=(split('_',$b))[-1];
                   2715:         if ($$keyorder{'parameter_0_'.$ta} == $$keyorder{'parameter_0_'.$tb}) {
                   2716:             return ($a cmp $b);
                   2717:         }
                   2718:         $$keyorder{'parameter_0_'.$ta} <=> $$keyorder{'parameter_0_'.$tb};
1.548     raeburn  2719:     } (keys(%{$name}));
1.236     albertel 2720: }
                   2721: 
1.563     damieng  2722: # Returns the keys in $name, sorted using $keyorder to sort parameters by name.
                   2723: # Used by defaultsetter (parameter settings default actions).
                   2724: #
                   2725: # @param {hash reference} $name - hash parameter name -> parameter title
                   2726: # @param {hash reference} $keyorder - hash parameter key -> appearance rank
                   2727: # @returns {Array<string>}
1.211     www      2728: sub keysindisplayorder {
                   2729:     my ($name,$keyorder)=@_;
                   2730:     return sort {
1.560     damieng  2731:         $$keyorder{'parameter_0_'.$a} <=> $$keyorder{'parameter_0_'.$b};
1.548     raeburn  2732:     } (keys(%{$name}));
1.211     www      2733: }
                   2734: 
1.563     damieng  2735: # Prints HTML with a choice to sort results by realm or student first.
                   2736: # Used by overview mode.
                   2737: #
                   2738: # @param {Apache2::RequestRec} $r - the Apache request
                   2739: # @param {string} $sortorder - realmstudent|studentrealm
1.214     www      2740: sub sortmenu {
                   2741:     my ($r,$sortorder)=@_;
1.236     albertel 2742:     $r->print('<br /><label><input type="radio" name="sortorder" value="realmstudent"');
1.214     www      2743:     if ($sortorder eq 'realmstudent') {
1.422     bisitz   2744:        $r->print(' checked="checked"');
1.214     www      2745:     }
                   2746:     $r->print(' />'.&mt('Sort by realm first, then student (group/section)'));
1.236     albertel 2747:     $r->print('</label><br /><label><input type="radio" name="sortorder" value="studentrealm"');
1.214     www      2748:     if ($sortorder eq 'studentrealm') {
1.422     bisitz   2749:        $r->print(' checked="checked"');
1.214     www      2750:     }
1.236     albertel 2751:     $r->print(' />'.&mt('Sort by student (group/section) first, then realm').
1.473     amueller 2752:           '</label>');
1.214     www      2753: }
                   2754: 
1.563     damieng  2755: # Returns a hash parameter key -> order (integer) giving the order for some parameters.
                   2756: #
                   2757: # @returns {hash}
1.211     www      2758: sub standardkeyorder {
                   2759:     return ('parameter_0_opendate' => 1,
1.473     amueller 2760:         'parameter_0_duedate' => 2,
                   2761:         'parameter_0_answerdate' => 3,
                   2762:         'parameter_0_interval' => 4,
                   2763:         'parameter_0_weight' => 5,
                   2764:         'parameter_0_maxtries' => 6,
                   2765:         'parameter_0_hinttries' => 7,
                   2766:         'parameter_0_contentopen' => 8,
                   2767:         'parameter_0_contentclose' => 9,
                   2768:         'parameter_0_type' => 10,
                   2769:         'parameter_0_problemstatus' => 11,
                   2770:         'parameter_0_hiddenresource' => 12,
                   2771:         'parameter_0_hiddenparts' => 13,
                   2772:         'parameter_0_display' => 14,
                   2773:         'parameter_0_ordered' => 15,
                   2774:         'parameter_0_tol' => 16,
                   2775:         'parameter_0_sig' => 17,
                   2776:         'parameter_0_turnoffunit' => 18,
1.521     raeburn  2777:         'parameter_0_discussend' => 19,
                   2778:         'parameter_0_discusshide' => 20,
                   2779:         'parameter_0_discussvote' => 21,
1.560     damieng  2780:         'parameter_0_printstartdate'  =>  22,
                   2781:         'parameter_0_printenddate' =>  23);
1.211     www      2782: }
                   2783: 
1.59      matthew  2784: 
1.560     damieng  2785: # Table mode UI.
1.563     damieng  2786: # If nothing is selected, prints HTML forms to select resources, parts, parameters, user, group and section.
                   2787: # Otherwise, prints the parameter table, with a link to change the selection unless a single resource is selected.
                   2788: #
                   2789: # Parameters used from the request:
                   2790: # action - handler action (see handler), usermenu is checking for value 'settable'
                   2791: # cgroup - selected group
                   2792: # command - 'set': direct access to table mode for a resource
                   2793: # csec - selected section
                   2794: # dis - set when the "Update Display" button was used, used only to discard command 'set'
                   2795: # hideparmsel - can be 'hidden' to hide the parameter selection div initially and display the "Change Parameter Selection" link instead (which displays the div)
                   2796: # id - student/employee ID
                   2797: # parmlev - selected level (full|map|general)
                   2798: # part - selected part (unused ?)
                   2799: # pres_marker - &&&-separated parameter identifiers, "resource id&part_parameter name&level"
                   2800: # pres_type - &&&-separated parameter types
                   2801: # pres_value - &&&-separated parameter values
                   2802: # prevvisit - '1' if the user has submitted the form before
                   2803: # pscat (multiple values) - selected parameter names
1.566     damieng  2804: # pschp - selected map pc, or 'all'
1.563     damieng  2805: # psprt (multiple values) - list of selected parameter parts
                   2806: # filter - part of or whole parameter name, to be filtered out when parameters are displayed (unused ?)
                   2807: # recent_* (* = parameter type) - recent values entered by the user for parameter types
                   2808: # symb - resource symb (when a single resource is selected)
                   2809: # udom - selected user domain
                   2810: # uname - selected user name
                   2811: # url - used only with command 'set', the resource url
                   2812: #
                   2813: # @param {Apache2::RequestRec} $r - the Apache request
1.568     raeburn  2814: # @param $parm_permission - ref to hash of permissions
                   2815: #                           if $parm_permission->{'edit'} is true, editing is allowed.
1.30      www      2816: sub assessparms {
1.1       www      2817: 
1.568     raeburn  2818:     my ($r,$parm_permission) = @_;
1.201     www      2819: 
1.512     foxr     2820: 
                   2821: # -------------------------------------------------------- Variable declaration
1.566     damieng  2822:     my @ids=(); # resource and map ids
                   2823:     my %symbp=(); # hash map pc or resource/map id -> map src.'___(all)' or resource symb
                   2824:     my %mapp=(); # hash map pc or resource/map id -> enclosing map src
                   2825:     my %typep=(); # hash resource/map id -> resource type (file extension)
                   2826:     my %keyp=(); # hash resource/map id -> comma-separated list of parameter keys
                   2827:     my %uris=(); # hash resource/map id -> resource src
                   2828:     my %maptitles=(); # hash map pc or src -> map title
                   2829:     my %allmaps=(); # hash map pc -> map src
1.582     raeburn  2830:     my %allmaps_inverted=(); # hash map src -> map pc
1.563     damieng  2831:     my %alllevs=(); # hash English level title -> value
                   2832: 
                   2833:     my $uname; # selected user name
                   2834:     my $udom; # selected user domain
                   2835:     my $uhome; # server with the user's files, or 'no_host'
                   2836:     my $csec; # selected section name
                   2837:     my $cgroup; # selected group name
                   2838:     my @usersgroups = (); # list of the user groups
1.582     raeburn  2839:     my $numreclinks = 0;
1.446     bisitz   2840: 
1.190     albertel 2841:     my $coursename=$env{'course.'.$env{'request.course.id'}.'.description'};
1.187     www      2842: 
1.57      albertel 2843:     $alllevs{'Resource Level'}='full';
1.215     www      2844:     $alllevs{'Map/Folder Level'}='map';
1.57      albertel 2845:     $alllevs{'Course Level'}='general';
                   2846: 
1.563     damieng  2847:     my %allparms; # hash parameter name -> parameter title
                   2848:     my %allparts; # hash parameter part -> part title
1.512     foxr     2849: # ------------------------------------------------------------------------------
                   2850: 
1.210     www      2851: #
                   2852: # Order in which these parameters will be displayed
                   2853: #
1.211     www      2854:     my %keyorder=&standardkeyorder();
                   2855: 
1.512     foxr     2856: #    @ids=();
                   2857: #    %symbp=();       # These seem defined above already.
                   2858: #    %typep=();
1.43      albertel 2859: 
                   2860:     my $message='';
                   2861: 
1.190     albertel 2862:     $csec=$env{'form.csec'};
1.552     raeburn  2863:     if ($env{'request.course.sec'} ne '') {
                   2864:         $csec = $env{'request.course.sec'};    
                   2865:     }
                   2866: 
1.553     raeburn  2867: # Check group privs.
1.269     raeburn  2868:     $cgroup=$env{'form.cgroup'};
1.553     raeburn  2869:     my $noeditgrp; 
                   2870:     if ($cgroup ne '') {
                   2871:         unless (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   2872:             if (($env{'request.course.groups'} eq '') || 
                   2873:                 (!grep(/^\Q$cgroup\E$/,split(/,/,$env{'request.course.groups'})))) {
                   2874:                 $noeditgrp = 1;
                   2875:             }
                   2876:         }
                   2877:     }
1.188     www      2878: 
1.190     albertel 2879:     if      ($udom=$env{'form.udom'}) {
                   2880:     } elsif ($udom=$env{'request.role.domain'}) {
                   2881:     } elsif ($udom=$env{'user.domain'}) {
1.172     albertel 2882:     } else {
1.473     amueller 2883:         $udom=$r->dir_config('lonDefDomain');
1.172     albertel 2884:     }
1.468     amueller 2885:     
1.43      albertel 2886: 
1.134     albertel 2887:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
1.190     albertel 2888:     my $pschp=$env{'form.pschp'};
1.506     www      2889: 
                   2890: 
1.134     albertel 2891:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      2892:     if (!@psprt) { $psprt[0]='all'; }
1.506     www      2893:     if (($env{'form.part'}) && ($psprt[0] ne 'all')) { $psprt[0]=$env{'form.part'}; }
1.57      albertel 2894: 
1.43      albertel 2895:     my $pssymb='';
1.57      albertel 2896:     my $parmlev='';
1.446     bisitz   2897: 
1.190     albertel 2898:     unless ($env{'form.parmlev'}) {
1.57      albertel 2899:         $parmlev = 'map';
                   2900:     } else {
1.190     albertel 2901:         $parmlev = $env{'form.parmlev'};
1.57      albertel 2902:     }
1.26      www      2903: 
1.29      www      2904: # ----------------------------------------------- Was this started from grades?
                   2905: 
1.560     damieng  2906:     if (($env{'form.command'} eq 'set') && ($env{'form.url'}) &&
                   2907:             (!$env{'form.dis'})) {
1.473     amueller 2908:         my $url=$env{'form.url'};
                   2909:         $url=~s-^http://($ENV{'SERVER_NAME'}|$ENV{'HTTP_HOST'})--;
                   2910:         $pssymb=&Apache::lonnet::symbread($url);
                   2911:         if (!@pscat) { @pscat=('all'); }
                   2912:         $pschp='';
1.57      albertel 2913:         $parmlev = 'full';
1.190     albertel 2914:     } elsif ($env{'form.symb'}) {
1.473     amueller 2915:         $pssymb=$env{'form.symb'};
                   2916:         if (!@pscat) { @pscat=('all'); }
                   2917:         $pschp='';
1.57      albertel 2918:         $parmlev = 'full';
1.43      albertel 2919:     } else {
1.473     amueller 2920:         $env{'form.url'}='';
1.43      albertel 2921:     }
                   2922: 
1.190     albertel 2923:     my $id=$env{'form.id'};
1.43      albertel 2924:     if (($id) && ($udom)) {
1.555     raeburn  2925:         $uname=(&Apache::lonnet::idget($udom,[$id],'ids'))[1];
1.473     amueller 2926:         if ($uname) {
                   2927:             $id='';
                   2928:         } else {
                   2929:             $message=
1.540     bisitz   2930:                 '<p class="LC_warning">'.
                   2931:                 &mt('Unknown ID [_1] at domain [_2]',
                   2932:                     "'".$id."'","'".$udom."'").
                   2933:                 '</p>';
1.473     amueller 2934:         }
1.43      albertel 2935:     } else {
1.473     amueller 2936:         $uname=$env{'form.uname'};
1.43      albertel 2937:     }
                   2938:     unless ($udom) { $uname=''; }
                   2939:     $uhome='';
                   2940:     if ($uname) {
1.473     amueller 2941:         $uhome=&Apache::lonnet::homeserver($uname,$udom);
1.43      albertel 2942:         if ($uhome eq 'no_host') {
1.473     amueller 2943:             $message=
1.540     bisitz   2944:                 '<p class="LC_warning">'.
                   2945:                 &mt('Unknown user [_1] at domain [_2]',
                   2946:                     "'".$uname."'","'".$udom."'").
                   2947:                 '</p>';
1.473     amueller 2948:             $uname='';
1.12      www      2949:         } else {
1.473     amueller 2950:             $csec=&Apache::lonnet::getsection($udom,$uname,
                   2951:                           $env{'request.course.id'});
                   2952:             if ($csec eq '-1') {
1.540     bisitz   2953:                 $message=
                   2954:                     '<p class="LC_warning">'.
                   2955:                     &mt('User [_1] at domain [_2] not in this course',
                   2956:                         "'".$uname."'","'".$udom."'").
                   2957:                     '</p>';
1.473     amueller 2958:                 $uname='';
                   2959:                 $csec=$env{'form.csec'};
1.269     raeburn  2960:                 $cgroup=$env{'form.cgroup'};
1.473     amueller 2961:             } else {
                   2962:                 my %name=&Apache::lonnet::userenvironment($udom,$uname,
                   2963:                   ('firstname','middlename','lastname','generation','id'));
                   2964:                 $message="\n<p>\n".&mt("Full Name").": ".
                   2965:                 $name{'firstname'}.' '.$name{'middlename'}.' '
                   2966:                 .$name{'lastname'}.' '.$name{'generation'}.
1.501     bisitz   2967:                 "<br />\n".&mt('Student/Employee ID').": ".$name{'id'}.'<p>';
1.473     amueller 2968:             }
1.297     raeburn  2969:             @usersgroups = &Apache::lonnet::get_users_groups(
1.275     raeburn  2970:                                        $udom,$uname,$env{'request.course.id'});
1.297     raeburn  2971:             if (@usersgroups > 0) {
1.306     albertel 2972:                 unless (grep(/^\Q$cgroup\E$/,@usersgroups)) {
1.275     raeburn  2973:                     $cgroup = $usersgroups[0];
1.297     raeburn  2974:                 }
1.269     raeburn  2975:             }
1.12      www      2976:         }
1.43      albertel 2977:     }
1.2       www      2978: 
1.43      albertel 2979:     unless ($csec) { $csec=''; }
1.269     raeburn  2980:     unless ($cgroup) { $cgroup=''; }
1.12      www      2981: 
1.14      www      2982: # --------------------------------------------------------- Get all assessments
1.446     bisitz   2983:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 2984:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   2985:                 \%keyorder);
1.63      bowersj2 2986: 
1.582     raeburn  2987:     %allmaps_inverted = reverse(%allmaps);
                   2988: 
1.57      albertel 2989:     $mapp{'0.0'} = '';
                   2990:     $symbp{'0.0'} = '';
1.99      albertel 2991: 
1.14      www      2992: # ---------------------------------------------------------- Anything to store?
1.568     raeburn  2993:     if ($env{'form.pres_marker'} && $parm_permission->{'edit'}) {
1.205     www      2994:         my @markers=split(/\&\&\&/,$env{'form.pres_marker'});
                   2995:         my @values=split(/\&\&\&/,$env{'form.pres_value'});
                   2996:         my @types=split(/\&\&\&/,$env{'form.pres_type'});
1.500     raeburn  2997:         my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   2998:         my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.504     raeburn  2999:         my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   3000:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   3001:         my $totalstored = 0;
1.546     raeburn  3002:         my $now = time;
1.473     amueller 3003:         for (my $i=0;$i<=$#markers;$i++) {
1.557     raeburn  3004:             my ($needsrelease,$needsnewer,$name,$namematch);
1.556     raeburn  3005:             if (($env{'request.course.sec'} ne '') && ($markers[$i] =~ /\&(9|10|11|12)$/)) {
1.552     raeburn  3006:                 next if ($csec ne $env{'request.course.sec'});
                   3007:             }
1.556     raeburn  3008:             if ($markers[$i] =~ /\&(8|7|6|5)$/) {
1.553     raeburn  3009:                 next if ($noeditgrp);
1.557     raeburn  3010:             }
                   3011:             if ($markers[$i] =~ /\&(17|11|7|3)$/) {
                   3012:                 $namematch = 'maplevelrecurse';
                   3013:             }
1.556     raeburn  3014:             if ($markers[$i] =~ /^[\d.]+\&0_availablestudent\&(1|2|3|4)$/) {
1.437     raeburn  3015:                 my (@ok_slots,@fail_slots,@del_slots);
                   3016:                 my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
                   3017:                 my ($level,@all) =
                   3018:                     &parmval_by_symb('0.availablestudent',$pssymb,'',$uname,$udom,
                   3019:                                      $csec,$cgroup,$courseopt);
                   3020:                 foreach my $slot_name (split(/:/,$values[$i])) {
                   3021:                     next if ($slot_name eq '');
                   3022:                     if (&update_slots($slot_name,$cdom,$cnum,$pssymb,$uname,$udom) eq 'ok') {
                   3023:                         push(@ok_slots,$slot_name);
                   3024: 
                   3025:                     } else {
                   3026:                         push(@fail_slots,$slot_name);
                   3027:                     }
                   3028:                 }
                   3029:                 if (@ok_slots) {
                   3030:                     $values[$i] = join(':',@ok_slots);
                   3031:                 } else {
                   3032:                     $values[$i] = '';
                   3033:                 }
                   3034:                 if ($all[$level] ne '') {
                   3035:                     my @existing = split(/:/,$all[$level]);
                   3036:                     foreach my $slot_name (@existing) {
                   3037:                         if (!grep(/^\Q$slot_name\E$/,split(/:/,$values[$i]))) {
                   3038:                             if (&delete_slots($slot_name,$cdom,$cnum,$uname,$udom,$pssymb) eq 'ok') {
                   3039:                                 push(@del_slots,$slot_name);
                   3040:                             }
                   3041:                         }
                   3042:                     }
                   3043:                 }
1.554     raeburn  3044:             } elsif ($markers[$i] =~ /_(type|lenient|retrypartial|discussvote|examcode|printstartdate|printenddate|acc|interval)\&\d+$/) {
1.514     raeburn  3045:                 $name = $1;
1.533     raeburn  3046:                 my $val = $values[$i];
1.549     raeburn  3047:                 my $valmatch = '';
1.533     raeburn  3048:                 if ($name eq 'examcode') {
1.544     raeburn  3049:                     if (&Apache::lonnet::validCODE($values[$i])) {
                   3050:                         $val = 'valid';
                   3051:                     }
1.546     raeburn  3052:                 } elsif ($name eq 'printstartdate') {
                   3053:                     if ($val =~ /^\d+$/) {
                   3054:                         if ($val > $now) {
                   3055:                             $val = 'future';
                   3056:                         }
                   3057:                     } 
                   3058:                 } elsif ($name eq 'printenddate') {
                   3059:                     if ($val =~ /^\d+$/) {
                   3060:                         if ($val < $now) {
                   3061:                             $val = 'past';
                   3062:                         }
                   3063:                     }
1.549     raeburn  3064:                 } elsif (($name eq 'lenient') || ($name eq 'acc')) {
                   3065:                     my $stringtype = &get_stringtype($name);
                   3066:                     my $stringmatch = &standard_string_matches($stringtype);
                   3067:                     if (ref($stringmatch) eq 'ARRAY') {
                   3068:                         foreach my $item (@{$stringmatch}) {
                   3069:                             if (ref($item) eq 'ARRAY') {
                   3070:                                 my ($regexpname,$pattern) = @{$item};
                   3071:                                 if ($pattern ne '') {
                   3072:                                     if ($val =~ /$pattern/) {
                   3073:                                         $valmatch = $regexpname;
                   3074:                                         $val = '';
                   3075:                                         last;
                   3076:                                     }
                   3077:                                 }
                   3078:                             }
                   3079:                         }
                   3080:                     }
1.554     raeburn  3081:                 } elsif ($name eq 'interval') {
                   3082:                     my $intervaltype = &get_intervaltype($name);
                   3083:                     my $intervalmatch = &standard_interval_matches($intervaltype);
                   3084:                     if (ref($intervalmatch) eq 'ARRAY') {
                   3085:                         foreach my $item (@{$intervalmatch}) {
                   3086:                             if (ref($item) eq 'ARRAY') {
                   3087:                                 my ($regexpname,$pattern) = @{$item};
                   3088:                                 if ($pattern ne '') {
                   3089:                                     if ($val =~ /$pattern/) {
                   3090:                                         $valmatch = $regexpname;
                   3091:                                         $val = '';
                   3092:                                         last;
                   3093:                                     }
                   3094:                                 }
                   3095:                             }
                   3096:                         }
                   3097:                     }
1.533     raeburn  3098:                 }
1.504     raeburn  3099:                 $needsrelease =
1.557     raeburn  3100:                     $Apache::lonnet::needsrelease{"parameter:$name:$val:$valmatch:"};
1.504     raeburn  3101:                 if ($needsrelease) {
1.505     raeburn  3102:                     unless ($got_chostname) {
1.514     raeburn  3103:                         ($chostname,$cmajor,$cminor) = &parameter_release_vars();
1.504     raeburn  3104:                         $got_chostname = 1;
1.546     raeburn  3105:                     } 
1.557     raeburn  3106:                     $needsnewer = &parameter_releasecheck($name,$val,$valmatch,undef,
1.514     raeburn  3107:                                                           $needsrelease,
                   3108:                                                           $cmajor,$cminor);
1.500     raeburn  3109:                 }
1.437     raeburn  3110:             }
1.504     raeburn  3111:             if ($needsnewer) {
1.557     raeburn  3112:                 undef($namematch);
                   3113:             } else {
                   3114:                 my $currneeded;
                   3115:                 if ($needsrelease) {
                   3116:                     $currneeded = $needsrelease;
                   3117:                 }
                   3118:                 if ($namematch) {
                   3119:                     $needsrelease =
                   3120:                         $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3121:                     if (($needsrelease) && (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3122:                         unless ($got_chostname) {
                   3123:                             ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3124:                             $got_chostname = 1;
                   3125:                         }
                   3126:                         $needsnewer = &parameter_releasecheck(undef,undef,undef,$namematch,
                   3127:                                                               $needsrelease,
                   3128:                                                               $cmajor,$cminor);
                   3129:                     } else {
                   3130:                         undef($namematch);
                   3131:                     }
                   3132:                 }
                   3133:             }
                   3134:             if ($needsnewer) {
                   3135:                 $message .= &oldversion_warning($name,$namematch,$values[$i],$chostname,$cmajor,
1.504     raeburn  3136:                                                 $cminor,$needsrelease);
                   3137:             } else {
                   3138:                 $message.=&storeparm(split(/\&/,$markers[$i]),
                   3139:                                      $values[$i],
                   3140:                                      $types[$i],
                   3141:                                      $uname,$udom,$csec,$cgroup);
                   3142:                 $totalstored ++;
                   3143:             }
1.473     amueller 3144:         }
1.68      www      3145: # ---------------------------------------------------------------- Done storing
1.504     raeburn  3146:         if ($totalstored) {
                   3147:             $message.='<p class="LC_warning">'
                   3148:                      .&mt('Changes can take up to 10 minutes before being active for all students.')
                   3149:                      .&Apache::loncommon::help_open_topic('Caching')
                   3150:                      .'</p>';
                   3151:         }
1.68      www      3152:     }
1.57      albertel 3153: #----------------------------------------------- if all selected, fill in array
1.563     damieng  3154:     if ($pscat[0] eq "all") {
                   3155:         @pscat = (keys(%allparms));
                   3156:     }
                   3157:     if (!@pscat) {
                   3158:         @pscat=('duedate','opendate','answerdate','weight','maxtries','type','problemstatus')
                   3159:     };
                   3160:     if ($psprt[0] eq "all" || !@psprt) {
                   3161:         @psprt = (keys(%allparts));
                   3162:     }
1.2       www      3163: # ------------------------------------------------------------------ Start page
1.63      bowersj2 3164: 
1.531     raeburn  3165:     my $crstype = &Apache::loncommon::course_type();
                   3166:     &startpage($r,$pssymb,$crstype);
1.57      albertel 3167: 
1.548     raeburn  3168:     foreach my $item ('tolerance','date_default','date_start','date_end',
1.563     damieng  3169:             'date_interval','int','float','string') {
1.473     amueller 3170:         $r->print('<input type="hidden" value="'.
1.563     damieng  3171:             &HTML::Entities::encode($env{'form.recent_'.$item},'"&<>').
                   3172:             '" name="recent_'.$item.'" />');
1.44      albertel 3173:     }
1.446     bisitz   3174: 
1.459     bisitz   3175:     # ----- Start Parameter Selection
                   3176: 
                   3177:     # Hide parm selection?
                   3178:     $r->print(<<ENDPARMSELSCRIPT);
                   3179: <script type="text/javascript">
                   3180: // <![CDATA[
                   3181: function parmsel_show() {
1.562     damieng  3182:     document.getElementById('parmsel').style.display = "";
                   3183:     document.getElementById('parmsellink').style.display = "none";
1.459     bisitz   3184: }
                   3185: // ]]>
                   3186: </script>
                   3187: ENDPARMSELSCRIPT
1.474     amueller 3188:     
1.445     neumanie 3189:     if (!$pssymb) {
1.563     damieng  3190:         # No single resource selected, print forms to select things (hidden after first selection)
1.486     www      3191:         my $parmselhiddenstyle=' style="display:none"';
                   3192:         if($env{'form.hideparmsel'} eq 'hidden') {
                   3193:            $r->print('<div id="parmsel"'.$parmselhiddenstyle.'>');
                   3194:         } else  {
                   3195:            $r->print('<div id="parmsel">');
                   3196:         }
                   3197: 
1.491     bisitz   3198:         # Step 1
1.523     raeburn  3199:         $r->print(&Apache::lonhtmlcommon::topic_bar(1,&mt('Resource Specification'),'parmstep1'));
                   3200:         $r->print('
1.474     amueller 3201: <script type="text/javascript">
1.523     raeburn  3202: // <![CDATA['.
                   3203:                  &showhide_js().'
1.474     amueller 3204: // ]]>
                   3205: </script>
1.523     raeburn  3206: ');
                   3207:         $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.209     www      3208:         &levelmenu($r,\%alllevs,$parmlev);
1.491     bisitz   3209:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.474     amueller 3210:         &mapmenu($r,\%allmaps,$pschp,\%maptitles, \%symbp);
1.491     bisitz   3211:         $r->print(&Apache::lonhtmlcommon::row_closure());
                   3212:         $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
                   3213:         &partmenu($r,\%allparts,\@psprt);
1.474     amueller 3214:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3215:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3216: 
                   3217:         # Step 2
1.523     raeburn  3218:         $r->print(&Apache::lonhtmlcommon::topic_bar(2,&mt('Parameter Specification'),'parmstep2'));
1.581     raeburn  3219:         &displaymenu($r,\%allparms,\@pscat,\%keyorder,'parmmenuscroll');
1.491     bisitz   3220: 
                   3221:         # Step 3
1.523     raeburn  3222:         $r->print(&Apache::lonhtmlcommon::topic_bar(3,&mt('User Specification (optional)'),'parmstep3'));
1.486     www      3223:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3224:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3225:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3226:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
1.491     bisitz   3227: 
                   3228:         # Update Display Button
1.486     www      3229:         $r->print('<p>'
                   3230:              .'<input type="submit" name="dis"'
1.511     www      3231:              .' value="'.&mt('Update Display').'" />'
1.486     www      3232:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
                   3233:              .'</p>');
                   3234:         $r->print('</div>');
1.491     bisitz   3235: 
1.486     www      3236:         # Offer link to display parameter selection again
                   3237:         $r->print('<p id="parmsellink"');
                   3238:         if ($env{'form.hideparmsel'} ne 'hidden') {
                   3239:            $r->print($parmselhiddenstyle);
                   3240:         }
                   3241:         $r->print('>'
                   3242:              .'<a href="javascript:parmsel_show()">'
                   3243:              .&mt('Change Parameter Selection')
                   3244:              .'</a>'
                   3245:              .'</p>');
1.44      albertel 3246:     } else {
1.478     amueller 3247:         # parameter screen for a single resource. 
1.486     www      3248:         my ($map,$iid,$resource)=&Apache::lonnet::decode_symb($pssymb);
1.473     amueller 3249:         my $title = &Apache::lonnet::gettitle($pssymb);
1.501     bisitz   3250:         $r->print(&mt('Specific Resource: [_1] ([_2])',
                   3251:                          $title,'<span class="LC_filename">'.$resource.'</span>').
1.472     amueller 3252:                 '<input type="hidden" value="'.$pssymb.'" name="symb" />'.
1.486     www      3253:                   '<br />');
                   3254:         $r->print(&Apache::lonhtmlcommon::topic_bar('',&mt('Additional Display Specification (optional)')));
                   3255:         $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.553     raeburn  3256:         &usermenu($r,$uname,$id,$udom,$csec,$cgroup,$parmlev,\@usersgroups,$pssymb);
1.486     www      3257:         $r->print(&Apache::lonhtmlcommon::row_closure(1));
                   3258:         $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   3259:         $r->print('<p>'
1.459     bisitz   3260:              .'<input type="submit" name="dis"'
1.511     www      3261:              .' value="'.&mt('Update Display').'" />'
1.459     bisitz   3262:              .'<input type="hidden" name="hideparmsel" value="hidden" />'
1.486     www      3263:              .'</p>');
1.459     bisitz   3264:     }
1.478     amueller 3265:     
1.486     www      3266:     # ----- End Parameter Selection
1.57      albertel 3267: 
1.459     bisitz   3268:     # Display Messages
                   3269:     $r->print('<div>'.$message.'</div>');
1.210     www      3270: 
1.57      albertel 3271: 
                   3272:     my @temp_pscat;
                   3273:     map {
                   3274:         my $cat = $_;
                   3275:         push(@temp_pscat, map { $_.'.'.$cat } @psprt);
                   3276:     } @pscat;
                   3277: 
                   3278:     @pscat = @temp_pscat;
                   3279: 
1.548     raeburn  3280: 
1.209     www      3281:     if (($env{'form.prevvisit'}) || ($pschp) || ($pssymb)) {
1.10      www      3282: # ----------------------------------------------------------------- Start Table
1.57      albertel 3283:         my @catmarker=map { tr|.|_|; 'parameter_'.$_; } @pscat;
1.190     albertel 3284:         my $csuname=$env{'user.name'};
                   3285:         my $csudom=$env{'user.domain'};
1.568     raeburn  3286:         my $readonly = 1;
                   3287:         if ($parm_permission->{'edit'}) {
                   3288:             undef($readonly); 
                   3289:         }
1.57      albertel 3290: 
1.203     www      3291:         if ($parmlev eq 'full') {
1.506     www      3292: #
                   3293: # This produces the cascading table output of parameters
                   3294: #
1.578     raeburn  3295:             my $coursespan=$csec?8:5;
                   3296:             my $userspan=3;
1.560     damieng  3297:             if ($cgroup ne '') {
1.578     raeburn  3298:                 $coursespan += 3;
1.560     damieng  3299:             }
1.473     amueller 3300: 
1.560     damieng  3301:             $r->print(&Apache::loncommon::start_data_table());
                   3302:             #
                   3303:             # This produces the headers
                   3304:             #
                   3305:             $r->print('<tr><td colspan="5"></td>');
                   3306:             $r->print('<th colspan="'.($coursespan).'">'.&mt('Any User').'</th>');
                   3307:             if ($uname) {
1.473     amueller 3308:                 if (@usersgroups > 1) {
1.560     damieng  3309:                     $userspan ++;
                   3310:                 }
                   3311:                 $r->print('<th colspan="'.$userspan.'" rowspan="2">');
                   3312:                 $r->print(&mt('User [_1] at Domain [_2]',"'".$uname."'","'".$udom."'").'</th>');
                   3313:             }
                   3314:             my %lt=&Apache::lonlocal::texthash(
1.473     amueller 3315:                 'pie'    => "Parameter in Effect",
                   3316:                 'csv'    => "Current Session Value",
1.472     amueller 3317:                 'rl'     => "Resource Level",
1.473     amueller 3318:                 'ic'     => 'in Course',
                   3319:                 'aut'    => "Assessment URL and Title",
                   3320:                 'type'   => 'Type',
                   3321:                 'emof'   => "Enclosing Map or Folder",
                   3322:                 'part'   => 'Part',
1.472     amueller 3323:                 'pn'     => 'Parameter Name',
1.473     amueller 3324:                 'def'    => 'default',
                   3325:                 'femof'  => 'from Enclosing Map or Folder',
                   3326:                 'gen'    => 'general',
                   3327:                 'foremf' => 'for Enclosing Map or Folder',
                   3328:                 'fr'     => 'for Resource'
                   3329:             );
1.560     damieng  3330:             $r->print(<<ENDTABLETWO);
1.419     bisitz   3331: <th rowspan="3">$lt{'pie'}</th>
1.501     bisitz   3332: <th rowspan="3">$lt{'csv'}<br />($csuname:$csudom)</th>
1.578     raeburn  3333: </tr><tr><td colspan="5"></td><th colspan="2">$lt{'ic'}</th><th colspan="2">$lt{'rl'}</th>
1.419     bisitz   3334: <th colspan="1">$lt{'ic'}</th>
1.182     albertel 3335: 
1.10      www      3336: ENDTABLETWO
1.560     damieng  3337:             if ($csec) {
1.578     raeburn  3338:                 $r->print('<th colspan="3">'.
1.560     damieng  3339:                 &mt("in Section")." $csec</th>");
                   3340:             }
                   3341:             if ($cgroup) {
1.578     raeburn  3342:                 $r->print('<th colspan="3">'.
1.472     amueller 3343:                 &mt("in Group")." $cgroup</th>");
1.560     damieng  3344:             }
                   3345:             $r->print(<<ENDTABLEHEADFOUR);
1.133     www      3346: </tr><tr><th>$lt{'aut'}</th><th>$lt{'type'}</th>
                   3347: <th>$lt{'emof'}</th><th>$lt{'part'}</th><th>$lt{'pn'}</th>
1.578     raeburn  3348: <th>$lt{'gen'}</th><th>$lt{'foremf'}</th>
1.192     albertel 3349: <th>$lt{'def'}</th><th>$lt{'femof'}</th><th>$lt{'fr'}</th>
1.10      www      3350: ENDTABLEHEADFOUR
1.57      albertel 3351: 
1.560     damieng  3352:             if ($csec) {
1.578     raeburn  3353:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3354:             }
1.473     amueller 3355: 
1.560     damieng  3356:             if ($cgroup) {
1.578     raeburn  3357:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3358:             }
                   3359: 
                   3360:             if ($uname) {
                   3361:                 if (@usersgroups > 1) {
                   3362:                     $r->print('<th>'.&mt('Control by other group?').'</th>');
                   3363:                 }
1.578     raeburn  3364:                 $r->print('<th>'.$lt{'gen'}.'</th><th>'.$lt{'foremf'}.'</th><th>'.$lt{'fr'}.'</th>');
1.560     damieng  3365:             }
                   3366: 
                   3367:             $r->print('</tr>');
1.506     www      3368: #
                   3369: # Done with the headers
                   3370: # 
1.560     damieng  3371:             my $defbgone='';
                   3372:             my $defbgtwo='';
                   3373:             my $defbgthree = '';
1.57      albertel 3374: 
1.560     damieng  3375:             foreach my $rid (@ids) {
1.57      albertel 3376: 
                   3377:                 my ($inmapid)=($rid=~/\.(\d+)$/);
1.446     bisitz   3378:                 if ((!$pssymb &&
1.560     damieng  3379:                         (($pschp eq 'all') || ($allmaps{$pschp} eq $mapp{$rid})))
                   3380:                         ||
                   3381:                         ($pssymb && $pssymb eq $symbp{$rid})) {
1.4       www      3382: # ------------------------------------------------------ Entry for one resource
1.473     amueller 3383:                     if ($defbgone eq '#E0E099') {
                   3384:                         $defbgone='#E0E0DD';
1.57      albertel 3385:                     } else {
1.419     bisitz   3386:                         $defbgone='#E0E099';
1.57      albertel 3387:                     }
1.419     bisitz   3388:                     if ($defbgtwo eq '#FFFF99') {
1.473     amueller 3389:                         $defbgtwo='#FFFFDD';
1.57      albertel 3390:                     } else {
1.473     amueller 3391:                         $defbgtwo='#FFFF99';
1.57      albertel 3392:                     }
1.419     bisitz   3393:                     if ($defbgthree eq '#FFBB99') {
                   3394:                         $defbgthree='#FFBBDD';
1.269     raeburn  3395:                     } else {
1.419     bisitz   3396:                         $defbgthree='#FFBB99';
1.269     raeburn  3397:                     }
                   3398: 
1.57      albertel 3399:                     my $thistitle='';
                   3400:                     my %name=   ();
                   3401:                     undef %name;
                   3402:                     my %part=   ();
                   3403:                     my %display=();
                   3404:                     my %type=   ();
                   3405:                     my %default=();
1.196     www      3406:                     my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3407: 
1.506     www      3408:                     my $filter=$env{'form.filter'};
1.548     raeburn  3409:                     foreach my $tempkeyp (&keysplit($keyp{$rid})) {
1.57      albertel 3410:                         if (grep $_ eq $tempkeyp, @catmarker) {
1.560     damieng  3411:                             my $parmname=&Apache::lonnet::metadata($uri,$tempkeyp.'.name');
                   3412:     # We may only want certain parameters listed
                   3413:                             if ($filter) {
                   3414:                                 unless ($filter=~/\Q$parmname\E/) { next; }
                   3415:                             }
                   3416:                             $name{$tempkeyp}=$parmname;
                   3417:                             $part{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.part');
                   3418: 
                   3419:                             my $parmdis=&Apache::lonnet::metadata($uri,$tempkeyp.'.display');
                   3420:                             if ($allparms{$name{$tempkeyp}} ne '') {
                   3421:                                 my $identifier;
                   3422:                                 if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3423:                                     $identifier = $1;
                   3424:                                 }
                   3425:                                 $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3426:                             } else {
                   3427:                                 $display{$tempkeyp} = $parmdis;
                   3428:                             }
                   3429:                             unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3430:                             $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3431:                             $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp);
                   3432:                             $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$tempkeyp.'.type');
                   3433:                             $thistitle=&Apache::lonnet::metadata($uri,$tempkeyp.'.title');
1.57      albertel 3434:                         }
                   3435:                     }
1.548     raeburn  3436:                     my $totalparms=scalar(keys(%name));
1.57      albertel 3437:                     if ($totalparms>0) {
1.560     damieng  3438:                         my $firstrow=1;
1.473     amueller 3439:                         my $title=&Apache::lonnet::gettitle($symbp{$rid});
1.582     raeburn  3440:                         my $navmap = Apache::lonnavmaps::navmap->new();
                   3441:                         my @recurseup;
                   3442:                         if (ref($navmap) && $mapp{$rid}) {
                   3443:                             @recurseup = $navmap->recurseup_maps($mapp{$rid});
                   3444:                         }
1.419     bisitz   3445:                         $r->print('<tr><td style="background-color:'.$defbgone.';"'.
1.57      albertel 3446:                              ' rowspan='.$totalparms.
1.419     bisitz   3447:                              '><tt><font size="-1">'.
1.57      albertel 3448:                              join(' / ',split(/\//,$uri)).
                   3449:                              '</font></tt><p><b>'.
1.154     albertel 3450:                              "<a href=\"javascript:openWindow('".
1.473     amueller 3451:                           &Apache::lonnet::clutter($uri).'?symb='.
                   3452:                           &escape($symbp{$rid}).
1.336     albertel 3453:                              "', 'metadatafile', '450', '500', 'no', 'yes');\"".
                   3454:                              " target=\"_self\">$title");
1.57      albertel 3455: 
                   3456:                         if ($thistitle) {
1.473     amueller 3457:                             $r->print(' ('.$thistitle.')');
1.57      albertel 3458:                         }
                   3459:                         $r->print('</a></b></td>');
1.419     bisitz   3460:                         $r->print('<td style="background-color:'.$defbgtwo.';"'.
1.57      albertel 3461:                                       ' rowspan='.$totalparms.'>'.$typep{$rid}.
                   3462:                                       '</td>');
                   3463: 
1.419     bisitz   3464:                         $r->print('<td style="background-color:'.$defbgone.';"'.
1.57      albertel 3465:                                       ' rowspan='.$totalparms.
1.238     www      3466:                                       '>'.$maptitles{$mapp{$rid}}.'</td>');
1.548     raeburn  3467:                         foreach my $item (&keysinorder_bytype(\%name,\%keyorder)) {
1.57      albertel 3468:                             unless ($firstrow) {
                   3469:                                 $r->print('<tr>');
                   3470:                             } else {
                   3471:                                 undef $firstrow;
                   3472:                             }
1.548     raeburn  3473:                             &print_row($r,$item,\%part,\%name,\%symbp,$rid,\%default,
1.57      albertel 3474:                                        \%type,\%display,$defbgone,$defbgtwo,
1.269     raeburn  3475:                                        $defbgthree,$parmlev,$uname,$udom,$csec,
1.582     raeburn  3476:                                        $cgroup,\@usersgroups,$noeditgrp,$readonly,
                   3477:                                        \@recurseup,\%maptitles,\%allmaps_inverted,
                   3478:                                        \$numreclinks);
1.57      albertel 3479:                         }
                   3480:                     }
                   3481:                 }
                   3482:             } # end foreach ids
1.43      albertel 3483: # -------------------------------------------------- End entry for one resource
1.517     www      3484:             $r->print(&Apache::loncommon::end_data_table);
1.203     www      3485:         } # end of  full
1.57      albertel 3486: #--------------------------------------------------- Entry for parm level map
                   3487:         if ($parmlev eq 'map') {
1.419     bisitz   3488:             my $defbgone = '#E0E099';
                   3489:             my $defbgtwo = '#FFFF99';
                   3490:             my $defbgthree = '#FFBB99';
1.57      albertel 3491: 
                   3492:             my %maplist;
                   3493: 
                   3494:             if ($pschp eq 'all') {
1.446     bisitz   3495:                 %maplist = %allmaps;
1.57      albertel 3496:             } else {
                   3497:                 %maplist = ($pschp => $mapp{$pschp});
                   3498:             }
                   3499: 
                   3500: #-------------------------------------------- for each map, gather information
                   3501:             my $mapid;
1.560     damieng  3502:             foreach $mapid (sort {$maplist{$a} cmp $maplist{$b}} keys(%maplist)) {
1.60      albertel 3503:                 my $maptitle = $maplist{$mapid};
1.57      albertel 3504: 
                   3505: #-----------------------  loop through ids and get all parameter types for map
                   3506: #-----------------------------------------          and associated information
                   3507:                 my %name = ();
                   3508:                 my %part = ();
                   3509:                 my %display = ();
                   3510:                 my %type = ();
                   3511:                 my %default = ();
                   3512:                 my $map = 0;
                   3513: 
1.473     amueller 3514: #        $r->print("Catmarker: @catmarker<br />\n");
1.446     bisitz   3515: 
1.548     raeburn  3516:                 foreach my $id (@ids) {
                   3517:                     ($map)=($id =~ /([\d]*?)\./);
                   3518:                     my $rid = $id;
1.446     bisitz   3519: 
1.57      albertel 3520: #                  $r->print("$mapid:$map:   $rid <br /> \n");
                   3521: 
1.560     damieng  3522:                     if ($map eq $mapid) {
1.473     amueller 3523:                         my $uri=&Apache::lonnet::declutter($uris{$rid});
1.582     raeburn  3524: 
1.57      albertel 3525: #                    $r->print("Keys: $keyp{$rid} <br />\n");
                   3526: 
                   3527: #--------------------------------------------------------------------
                   3528: # @catmarker contains list of all possible parameters including part #s
                   3529: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3530: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3531: # When storing information, store as part 0
                   3532: # When requesting information, request from full part
                   3533: #-------------------------------------------------------------------
1.548     raeburn  3534:                         foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3535:                             my $tempkeyp = $fullkeyp;
                   3536:                             $tempkeyp =~ s/_\w+_/_0_/;
1.473     amueller 3537: 
1.548     raeburn  3538:                             if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3539:                                 $part{$tempkeyp}="0";
                   3540:                                 $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3541:                                 my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3542:                                 if ($allparms{$name{$tempkeyp}} ne '') {
                   3543:                                     my $identifier;
                   3544:                                     if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3545:                                         $identifier = $1;
                   3546:                                     }
                   3547:                                     $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3548:                                 } else {
                   3549:                                     $display{$tempkeyp} = $parmdis;
                   3550:                                 }
                   3551:                                 unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3552:                                 $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3553:                                 $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3554:                                 $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3555:                                 $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
                   3556:                               }
                   3557:                         } # end loop through keys
1.560     damieng  3558:                     }
1.57      albertel 3559:                 } # end loop through ids
1.446     bisitz   3560: 
1.57      albertel 3561: #---------------------------------------------------- print header information
1.133     www      3562:                 my $foldermap=&mt($maptitle=~/^uploaded/?'Folder':'Map');
1.82      www      3563:                 my $showtitle=$maptitles{$maptitle}.($maptitle!~/^uploaded/?' ['.$maptitle.']':'');
1.401     bisitz   3564:                 my $tmp="";
1.57      albertel 3565:                 if ($uname) {
1.473     amueller 3566:                     my $person=&Apache::loncommon::plainname($uname,$udom);
1.401     bisitz   3567:                     $tmp.=&mt("User")." <font color=\"red\"><i>$uname \($person\) </i></font> ".
                   3568:                         &mt('in')." \n";
1.57      albertel 3569:                 } else {
1.401     bisitz   3570:                     $tmp.="<font color=\"red\"><i>".&mt('all').'</i></font> '.&mt('users in')." \n";
1.57      albertel 3571:                 }
1.269     raeburn  3572:                 if ($cgroup) {
1.401     bisitz   3573:                     $tmp.=&mt("Group")." <font color=\"red\"><i>$cgroup".
                   3574:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3575:                     $csec = '';
                   3576:                 } elsif ($csec) {
1.401     bisitz   3577:                     $tmp.=&mt("Section")." <font color=\"red\"><i>$csec".
                   3578:                               "</i></font> ".&mt('of')." \n";
1.269     raeburn  3579:                 }
1.401     bisitz   3580:                 $r->print('<div align="center"><h4>'
                   3581:                          .&mt('Set Defaults for All Resources in [_1]Specifically for [_2][_3]'
1.404     bisitz   3582:                              ,$foldermap.'<br /><font color="red"><i>'.$showtitle.'</i></font><br />'
1.401     bisitz   3583:                              ,$tmp
                   3584:                              ,'<font color="red"><i>'.$coursename.'</i></font>'
                   3585:                              )
                   3586:                          ."<br /></h4>\n"
1.422     bisitz   3587:                 );
1.57      albertel 3588: #---------------------------------------------------------------- print table
1.419     bisitz   3589:                 $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3590:                          .&Apache::loncommon::start_data_table_header_row()
                   3591:                          .'<th>'.&mt('Parameter Name').'</th>'
1.578     raeburn  3592:                          .'<th>'.&mt('Value').'</th>'
1.419     bisitz   3593:                          .'<th>'.&mt('Parameter in Effect').'</th>'
                   3594:                          .&Apache::loncommon::end_data_table_header_row()
                   3595:                 );
1.57      albertel 3596: 
1.582     raeburn  3597:                 my $navmap = Apache::lonnavmaps::navmap->new();
                   3598:                 my @recurseup;
                   3599:                 if (ref($navmap)) {
                   3600:                      my $mapres = $navmap->getByMapPc($mapid);
                   3601:                      if (ref($mapres)) {
                   3602:                          @recurseup = $navmap->recurseup_maps($mapres->src());
                   3603:                      }
                   3604:                 }
                   3605: 
                   3606: 
1.548     raeburn  3607:                 foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.473     amueller 3608:                     $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3609:                     &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.269     raeburn  3610:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
1.568     raeburn  3611:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
1.582     raeburn  3612:                            $readonly,\@recurseup,\%maptitles,\%allmaps_inverted,
                   3613:                            \$numreclinks);
1.57      albertel 3614:                 }
1.422     bisitz   3615:                 $r->print(&Apache::loncommon::end_data_table().'</p>'
                   3616:                          .'</div>'
                   3617:                 );
1.57      albertel 3618:             } # end each map
                   3619:         } # end of $parmlev eq map
                   3620: #--------------------------------- Entry for parm level general (Course level)
                   3621:         if ($parmlev eq 'general') {
1.473     amueller 3622:             my $defbgone = '#E0E099';
1.419     bisitz   3623:             my $defbgtwo = '#FFFF99';
                   3624:             my $defbgthree = '#FFBB99';
1.57      albertel 3625: 
                   3626: #-------------------------------------------- for each map, gather information
                   3627:             my $mapid="0.0";
                   3628: #-----------------------  loop through ids and get all parameter types for map
                   3629: #-----------------------------------------          and associated information
                   3630:             my %name = ();
                   3631:             my %part = ();
                   3632:             my %display = ();
                   3633:             my %type = ();
                   3634:             my %default = ();
1.446     bisitz   3635: 
1.548     raeburn  3636:             foreach $id (@ids) {
                   3637:                 my $rid = $id;
1.446     bisitz   3638: 
1.196     www      3639:                 my $uri=&Apache::lonnet::declutter($uris{$rid});
1.57      albertel 3640: 
                   3641: #--------------------------------------------------------------------
                   3642: # @catmarker contains list of all possible parameters including part #s
                   3643: # $fullkeyp contains the full part/id # for the extraction of proper parameters
                   3644: # $tempkeyp contains part 0 only (no ids - ie, subparts)
                   3645: # When storing information, store as part 0
                   3646: # When requesting information, request from full part
                   3647: #-------------------------------------------------------------------
1.548     raeburn  3648:                 foreach my $fullkeyp (&keysplit($keyp{$rid})) {
                   3649:                     my $tempkeyp = $fullkeyp;
                   3650:                     $tempkeyp =~ s/_\w+_/_0_/;
                   3651:                     if ((grep $_ eq $fullkeyp, @catmarker) &&(!$name{$tempkeyp})) {
1.473     amueller 3652:                         $part{$tempkeyp}="0";
                   3653:                         $name{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.name');
                   3654:                         my $parmdis=&Apache::lonnet::metadata($uri,$fullkeyp.'.display');
                   3655:                         if ($allparms{$name{$tempkeyp}} ne '') {
                   3656:                             my $identifier;
                   3657:                             if ($parmdis =~ /(\s*\[Part.*)$/) {
                   3658:                                 $identifier = $1;
                   3659:                             }
                   3660:                             $display{$tempkeyp} = $allparms{$name{$tempkeyp}}.$identifier;
                   3661:                         } else {
                   3662:                             $display{$tempkeyp} = $parmdis;
                   3663:                         }
                   3664:                         unless ($display{$tempkeyp}) { $display{$tempkeyp}=''; }
                   3665:                         $display{$tempkeyp}.=' ('.$name{$tempkeyp}.')';
                   3666:                         $display{$tempkeyp} =~ s/_\w+_/_0_/;
                   3667:                         $default{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp);
                   3668:                         $type{$tempkeyp}=&Apache::lonnet::metadata($uri,$fullkeyp.'.type');
1.560     damieng  3669:                     }
1.57      albertel 3670:                 } # end loop through keys
                   3671:             } # end loop through ids
1.446     bisitz   3672: 
1.57      albertel 3673: #---------------------------------------------------- print header information
1.473     amueller 3674:             my $setdef=&mt("Set Defaults for All Resources in Course");
1.57      albertel 3675:             $r->print(<<ENDMAPONE);
1.419     bisitz   3676: <center>
                   3677: <h4>$setdef
1.135     albertel 3678: <font color="red"><i>$coursename</i></font><br />
1.57      albertel 3679: ENDMAPONE
                   3680:             if ($uname) {
1.473     amueller 3681:                 my $person=&Apache::loncommon::plainname($uname,$udom);
1.135     albertel 3682:                 $r->print(" ".&mt("User")."<font color=\"red\"> <i>$uname \($person\) </i></font> \n");
1.57      albertel 3683:             } else {
1.135     albertel 3684:                 $r->print("<i><font color=\"red\"> ".&mt("ALL")."</i> ".&mt("USERS")."</font> \n");
1.57      albertel 3685:             }
1.446     bisitz   3686: 
1.135     albertel 3687:             if ($csec) {$r->print(&mt("Section")."<font color=\"red\"> <i>$csec</i></font>\n")};
1.306     albertel 3688:             if ($cgroup) {$r->print(&mt("Group")."<font color=\"red\"> <i>$cgroup</i></font>\n")};
1.135     albertel 3689:             $r->print("</h4>\n");
1.57      albertel 3690: #---------------------------------------------------------------- print table
1.419     bisitz   3691:             $r->print('<p>'.&Apache::loncommon::start_data_table()
                   3692:                      .&Apache::loncommon::start_data_table_header_row()
                   3693:                      .'<th>'.&mt('Parameter Name').'</th>'
                   3694:                      .'<th>'.&mt('Default Value').'</th>'
                   3695:                      .'<th>'.&mt('Parameter in Effect').'</th>'
                   3696:                      .&Apache::loncommon::end_data_table_header_row()
                   3697:             );
1.57      albertel 3698: 
1.548     raeburn  3699:             foreach my $item (&keysinorder(\%name,\%keyorder)) {
1.419     bisitz   3700:                 $r->print(&Apache::loncommon::start_data_table_row());
1.548     raeburn  3701:                 &print_row($r,$item,\%part,\%name,\%symbp,$mapid,\%default,
1.568     raeburn  3702:                            \%type,\%display,$defbgone,$defbgtwo,$defbgthree,
                   3703:                            $parmlev,$uname,$udom,$csec,$cgroup,'',$noeditgrp,
                   3704:                            $readonly);
1.57      albertel 3705:             }
1.419     bisitz   3706:             $r->print(&Apache::loncommon::end_data_table()
                   3707:                      .'</p>'
                   3708:                      .'</center>'
                   3709:             );
1.57      albertel 3710:         } # end of $parmlev eq general
1.43      albertel 3711:     }
1.507     www      3712:     $r->print('</form>');
1.582     raeburn  3713:     if ($numreclinks) {
                   3714:         $r->print(<<"END");
                   3715: <form name="recurseform" action="/adm/parmset?action=settable" method="post">
                   3716: <input type="hidden" name="pschp" />
                   3717: <input type="hidden" name="pscat" />
                   3718: <input type="hidden" name="psprt" />
                   3719: <input type="hidden" name="hideparmsel" value="hidden" />
                   3720: </form>
                   3721: <script type="text/javascript">
                   3722: function pjumprec(rid,name,part) {
                   3723:     document.forms.recurseform.pschp.value = rid;
                   3724:     document.forms.recurseform.pscat.value = name;
                   3725:     document.forms.recurseform.psprt.value = part;
                   3726:     document.forms.recurseform.submit();
                   3727:     return false;
                   3728: }
                   3729: </script>
                   3730: END
                   3731:     }
1.507     www      3732:     &endSettingsScreen($r);
                   3733:     $r->print(&Apache::loncommon::end_page());
1.57      albertel 3734: } # end sub assessparms
1.30      www      3735: 
1.560     damieng  3736: 
                   3737: 
1.120     www      3738: ##################################################
1.560     damieng  3739: # OVERVIEW MODE
1.207     www      3740: ##################################################
1.124     www      3741: 
1.563     damieng  3742: my $tableopen; # boolean, true if HTML table is already opened
                   3743: 
                   3744: # Returns HTML with the HTML table start tag and header, unless the table is already opened.
                   3745: # @param {boolean} $readonly - true if values cannot be edited (otherwise more columns are added)
                   3746: # @returns {string}
1.124     www      3747: sub tablestart {
1.576     raeburn  3748:     my ($readonly,$is_map) = @_;
1.124     www      3749:     if ($tableopen) {
1.552     raeburn  3750:         return '';
1.124     www      3751:     } else {
1.552     raeburn  3752:         $tableopen=1;
                   3753:         my $output = &Apache::loncommon::start_data_table().'<tr><th>'.&mt('Parameter').'</th>';
                   3754:         if ($readonly) {
                   3755:             $output .= '<th>'.&mt('Current value').'</th>';
                   3756:         } else {
1.576     raeburn  3757:             $output .= '<th>'.&mt('Delete').'</th>'.
                   3758:                        '<th>'.&mt('Set to ...').'</th>';
                   3759:             if ($is_map) {
                   3760:                 $output .= '<th>'.&mt('Recursive?').'</th>';
                   3761:             }
1.552     raeburn  3762:         }
                   3763:         $output .= '</tr>';
                   3764:         return $output;
1.124     www      3765:     }
                   3766: }
                   3767: 
1.563     damieng  3768: # Returns HTML with the HTML table end tag, unless the table is not opened.
                   3769: # @returns {string}
1.124     www      3770: sub tableend {
                   3771:     if ($tableopen) {
1.560     damieng  3772:         $tableopen=0;
                   3773:         return &Apache::loncommon::end_data_table();
1.124     www      3774:     } else {
1.560     damieng  3775:         return'';
1.124     www      3776:     }
                   3777: }
                   3778: 
1.563     damieng  3779: # Reads course and user information.
                   3780: # 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).
                   3781: # The key for student data is modified with '[useropt:'.username.':'.userdomain.'].'.
                   3782: # If the context is looking for a list, returns a list with the scalar data and the class list.
                   3783: # @param {string} $crs - course number
                   3784: # @param {string} $dom - course domain
                   3785: # @returns {hash reference|Array}
1.207     www      3786: sub readdata {
                   3787:     my ($crs,$dom)=@_;
                   3788: # Read coursedata
                   3789:     my $resourcedata=&Apache::lonnet::get_courseresdata($crs,$dom);
                   3790: # Read userdata
                   3791: 
                   3792:     my $classlist=&Apache::loncoursedata::get_classlist();
1.548     raeburn  3793:     foreach my $user (keys(%$classlist)) {
                   3794:         if ($user=~/^($match_username)\:($match_domain)$/) {
                   3795:             my ($tuname,$tudom)=($1,$2);
                   3796:             my $useropt=&Apache::lonnet::get_userresdata($tuname,$tudom);
                   3797:             foreach my $userkey (keys(%{$useropt})) {
                   3798:                 if ($userkey=~/^\Q$env{'request.course.id'}\E/) {
1.207     www      3799:                     my $newkey=$userkey;
1.548     raeburn  3800:                     $newkey=~s/^($env{'request.course.id'}\.)/$1\[useropt\:$tuname\:$tudom\]\./;
                   3801:                     $$resourcedata{$newkey}=$$useropt{$userkey};
                   3802:                 }
                   3803:             }
1.473     amueller 3804:         }
                   3805:     }
1.552     raeburn  3806:     if (wantarray) {
                   3807:         return ($resourcedata,$classlist);
                   3808:     } else {
                   3809:         return $resourcedata;
                   3810:     }
1.207     www      3811: }
                   3812: 
                   3813: 
1.563     damieng  3814: # Stores parameter data, using form parameters directly.
                   3815: #
                   3816: # Uses the following form parameters. The variable part in the names is a resourcedata key (except for a modification for user data).
                   3817: # set_* (except settext, setipallow, setipdeny) - set a parameter value
                   3818: # del_* - remove a parameter
                   3819: # datepointer_* - set a date parameter (value is key_* refering to a set of other form parameters)
                   3820: # dateinterval_* - set a date interval parameter (value refers to more form parameters)
                   3821: # key_* - date values
                   3822: # days_* - for date intervals
                   3823: # hours_* - for date intervals
                   3824: # minutes_* - for date intervals
                   3825: # seconds_* - for date intervals
                   3826: # done_* - for date intervals
                   3827: # typeof_* - parameter type
                   3828: # 
                   3829: # @param {Apache2::RequestRec} $r - the Apache request
                   3830: # @param {string} $crs - course number
                   3831: # @param {string} $dom - course domain
1.208     www      3832: sub storedata {
                   3833:     my ($r,$crs,$dom)=@_;
1.207     www      3834: # Set userlevel immediately
                   3835: # Do an intermediate store of course level
                   3836:     my $olddata=&readdata($crs,$dom);
1.124     www      3837:     my %newdata=();
                   3838:     undef %newdata;
                   3839:     my @deldata=();
1.576     raeburn  3840:     my @delrec=();
                   3841:     my @delnonrec=();
1.124     www      3842:     undef @deldata;
1.504     raeburn  3843:     my ($got_chostname,$chostname,$cmajor,$cminor);
1.546     raeburn  3844:     my $now = time;
1.560     damieng  3845:     foreach my $key (keys(%env)) {
                   3846:         if ($key =~ /^form\.([a-z]+)\_(.+)$/) {
                   3847:             my $cmd=$1;
                   3848:             my $thiskey=$2;
1.576     raeburn  3849:             my ($altkey,$recursive,$tkey,$tkeyrec,$tkeynonrec);
                   3850:             next if ($cmd eq 'rec' || $cmd eq 'settext' || $cmd eq 'setipallow' || $cmd eq 'setipdeny');
                   3851:             if ((($cmd eq 'set') || ($cmd eq 'datepointer') || ($cmd eq 'dateinterval') || ($cmd eq 'del')) && 
                   3852:                  ($thiskey =~ /(?:sequence|page)\Q___(all)\E/)) {
                   3853:                 unless ($thiskey =~ /(encrypturl|hiddenresource)$/) {
                   3854:                     $altkey = $thiskey;
                   3855:                     $altkey =~ s/\Q___(all)\E/___(rec)/;
                   3856:                     if ($env{'form.rec_'.$thiskey}) {
                   3857:                         $recursive = 1;
                   3858:                     }
                   3859:                 }
                   3860:             }
1.560     damieng  3861:             my ($tuname,$tudom)=&extractuser($thiskey);
1.473     amueller 3862:             if ($tuname) {
1.576     raeburn  3863:                 $tkey=$thiskey;
1.560     damieng  3864:                 $tkey=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
1.576     raeburn  3865:                 if ($altkey) {
                   3866:                     $tkeynonrec = $tkey; 
                   3867:                     $tkeyrec = $altkey;
                   3868:                     $tkeyrec=~s/\.\[useropt\:$tuname\:$tudom\]\./\./;
                   3869:                 }
1.560     damieng  3870:             }
                   3871:             if ($cmd eq 'set' || $cmd eq 'datepointer' || $cmd eq 'dateinterval') {
1.563     damieng  3872:                 my ($data, $typeof, $text, $name, $valchk, $valmatch, $namematch);
                   3873:                 if ($cmd eq 'set') {
                   3874:                     $data=$env{$key};
                   3875:                     $valmatch = '';
                   3876:                     $valchk = $data;
                   3877:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3878:                     $text = &mt('Saved modified parameter for');
                   3879:                     if ($typeof eq 'string_questiontype') {
                   3880:                         $name = 'type';
                   3881:                     } elsif ($typeof eq 'string_lenient') {
                   3882:                         $name = 'lenient';
                   3883:                         my $stringmatch = &standard_string_matches($typeof);
                   3884:                         if (ref($stringmatch) eq 'ARRAY') {
                   3885:                             foreach my $item (@{$stringmatch}) {
                   3886:                                 if (ref($item) eq 'ARRAY') {
                   3887:                                     my ($regexpname,$pattern) = @{$item};
                   3888:                                     if ($pattern ne '') {
                   3889:                                         if ($data =~ /$pattern/) {
                   3890:                                             $valmatch = $regexpname;
                   3891:                                             $valchk = '';
                   3892:                                             last;
                   3893:                                         }
1.560     damieng  3894:                                     }
1.549     raeburn  3895:                                 }
                   3896:                             }
                   3897:                         }
1.563     damieng  3898:                     } elsif ($typeof eq 'string_discussvote') {
                   3899:                         $name = 'discussvote';
                   3900:                     } elsif ($typeof eq 'string_examcode') {
                   3901:                         $name = 'examcode';
                   3902:                         if (&Apache::lonnet::validCODE($data)) {
                   3903:                             $valchk = 'valid';
                   3904:                         }
                   3905:                     } elsif ($typeof eq 'string_yesno') {
                   3906:                         if ($thiskey =~ /\.retrypartial$/) {
                   3907:                             $name = 'retrypartial';
                   3908:                         }
1.549     raeburn  3909:                     }
1.563     damieng  3910:                 } elsif ($cmd eq 'datepointer') {
                   3911:                     $data=&Apache::lonhtmlcommon::get_date_from_form($env{$key});
                   3912:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3913:                     $text = &mt('Saved modified date for');
                   3914:                     if ($typeof eq 'date_start') {
                   3915:                         if ($thiskey =~ /\.printstartdate$/) {
                   3916:                             $name = 'printstartdate';
                   3917:                             if (($data) && ($data > $now)) {
                   3918:                                 $valchk = 'future';
                   3919:                             }
1.560     damieng  3920:                         }
1.563     damieng  3921:                     } elsif ($typeof eq 'date_end') {
                   3922:                         if ($thiskey =~ /\.printenddate$/) {
                   3923:                             $name = 'printenddate';
                   3924:                             if (($data) && ($data < $now)) {
                   3925:                                 $valchk = 'past';
                   3926:                             }
1.560     damieng  3927:                         }
1.504     raeburn  3928:                     }
1.563     damieng  3929:                 } elsif ($cmd eq 'dateinterval') {
                   3930:                     $data=&get_date_interval_from_form($thiskey);
                   3931:                     if ($thiskey =~ /\.interval$/) {
                   3932:                         $name = 'interval';
                   3933:                         my $intervaltype = &get_intervaltype($name);
                   3934:                         my $intervalmatch = &standard_interval_matches($intervaltype);
                   3935:                         if (ref($intervalmatch) eq 'ARRAY') {
                   3936:                             foreach my $item (@{$intervalmatch}) {
                   3937:                                 if (ref($item) eq 'ARRAY') {
                   3938:                                     my ($regexpname,$pattern) = @{$item};
                   3939:                                     if ($pattern ne '') {
                   3940:                                         if ($data =~ /$pattern/) {
                   3941:                                             $valmatch = $regexpname;
                   3942:                                             $valchk = '';
                   3943:                                             last;
                   3944:                                         }
1.560     damieng  3945:                                     }
1.554     raeburn  3946:                                 }
                   3947:                             }
                   3948:                         }
                   3949:                     }
1.563     damieng  3950:                     $typeof=$env{'form.typeof_'.$thiskey};
                   3951:                     $text = &mt('Saved modified date for');
1.554     raeburn  3952:                 }
1.576     raeburn  3953:                 if ($recursive) {
1.563     damieng  3954:                     $namematch = 'maplevelrecurse';
1.560     damieng  3955:                 }
1.563     damieng  3956:                 if (($name ne '') || ($namematch ne '')) {
                   3957:                     my ($needsrelease,$needsnewer);
                   3958:                     if ($name ne '') {
                   3959:                         $needsrelease = $Apache::lonnet::needsrelease{"parameter:$name:$valchk:$valmatch:"};
1.560     damieng  3960:                         if ($needsrelease) {
                   3961:                             unless ($got_chostname) {
1.563     damieng  3962:                                 ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.560     damieng  3963:                                 $got_chostname = 1;
                   3964:                             }
1.563     damieng  3965:                             $needsnewer = &parameter_releasecheck($name,$valchk,$valmatch,undef,
                   3966:                                                                 $needsrelease,
                   3967:                                                                 $cmajor,$cminor);
                   3968:                         }
                   3969:                     }
                   3970:                     if ($namematch ne '') {
                   3971:                         if ($needsnewer) {
                   3972:                             undef($namematch);
1.560     damieng  3973:                         } else {
1.563     damieng  3974:                             my $currneeded;
                   3975:                             if ($needsrelease) {
                   3976:                                 $currneeded = $needsrelease;
                   3977:                             }
                   3978:                             $needsrelease =
                   3979:                                 $Apache::lonnet::needsrelease{"parameter::::$namematch"};
                   3980:                             if (($needsrelease) &&
                   3981:                                     (($currneeded eq '') || ($needsrelease < $currneeded))) {
                   3982:                                 unless ($got_chostname) {
                   3983:                                     ($chostname,$cmajor,$cminor) = &parameter_release_vars();
                   3984:                                     $got_chostname = 1;
                   3985:                                 }
                   3986:                                 $needsnewer = &parameter_releasecheck(undef,$valchk,$valmatch,
                   3987:                                     $namematch, $needsrelease,$cmajor,$cminor);
                   3988:                             } else {
                   3989:                                 undef($namematch);
                   3990:                             }
1.560     damieng  3991:                         }
1.557     raeburn  3992:                     }
1.563     damieng  3993:                     if ($needsnewer) {
                   3994:                         $r->print('<br />'.&oldversion_warning($name,$namematch,$data,
                   3995:                                                             $chostname,$cmajor,
                   3996:                                                             $cminor,$needsrelease));
                   3997:                         next;
                   3998:                     }
1.504     raeburn  3999:                 }
1.576     raeburn  4000:                 my ($reconlychg,$haschange,$storekey);
                   4001:                 if ($tuname) {
                   4002:                     my $ustorekey;
                   4003:                     if ($altkey) {
                   4004:                         if ($recursive) {
                   4005:                             if (exists($$olddata{$thiskey})) {
                   4006:                                 if ($$olddata{$thiskey} eq $data) {
                   4007:                                     $reconlychg = 1;
                   4008:                                 }
                   4009:                                 &Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname);
                   4010:                             }
                   4011:                             if (exists($$olddata{$altkey})) {
                   4012:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4013:                                     $haschange = 1;
                   4014:                                 }
                   4015:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4016:                                 $haschange = 1;
                   4017:                             }
                   4018:                             $ustorekey = $tkeyrec;
                   4019:                         } else {
                   4020:                             if (exists($$olddata{$altkey})) {
                   4021:                                 if ($$olddata{$altkey} eq $data) {
                   4022:                                     $reconlychg = 1;
                   4023:                                 }
                   4024:                                 &Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname);
                   4025:                             }
                   4026:                             if (exists($$olddata{$thiskey})) {
                   4027:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4028:                                     $haschange = 1;
                   4029:                                 }
                   4030:                             } elsif ((!$reconlychg) && ($data ne '')) {
                   4031:                                 $haschange = 1;
                   4032:                             }
                   4033:                             $ustorekey = $tkeynonrec;
                   4034:                         }
                   4035:                     } else {
                   4036:                         if (exists($$olddata{$tkey})) {
                   4037:                             if (defined($data) && $$olddata{$tkey} ne $data) {
                   4038:                                 $haschange = 1;
                   4039:                             }
                   4040:                             $ustorekey = $tkey;
                   4041:                         }
                   4042:                     }
                   4043:                     if ($haschange || $reconlychg)  {
                   4044:                         unless ($env{'form.del_'.$thiskey}) {
                   4045:                             if (&Apache::lonnet::put('resourcedata',{$ustorekey=>$data,
                   4046:                                                                      $ustorekey.'.type' => $typeof},
                   4047:                                                                      $tudom,$tuname) eq 'ok') {
                   4048:                                 &log_parmset({$ustorekey=>$data,$ustorekey.'.type' => $typeof},0,$tuname,$tudom);
                   4049:                                 $r->print('<br />'.$text.' '.
                   4050:                                           &Apache::loncommon::plainname($tuname,$tudom));
                   4051:                             } else {
                   4052:                                 $r->print('<div class="LC_error">'.
                   4053:                                           &mt('Error saving parameters').'</div>');
                   4054:                             }
                   4055:                             &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4056:                         }
                   4057:                     }
                   4058:                 } else {
                   4059:                     if ($altkey) {
                   4060:                         if ($recursive) {
                   4061:                             if (exists($$olddata{$thiskey})) {
                   4062:                                 if ($$olddata{$thiskey} eq $data) {
                   4063:                                     $reconlychg = 1;
                   4064:                                 }
                   4065:                                 push(@delnonrec,($thiskey,$thiskey.'.type'));
                   4066:                             }
                   4067:                             if (exists($$olddata{$altkey})) {
                   4068:                                 if (defined($data) && $$olddata{$altkey} ne $data) {
                   4069:                                     $haschange = 1;
                   4070:                                 }
                   4071:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4072:                                 $haschange = 1;
                   4073:                             }
                   4074:                             $storekey = $altkey;
1.563     damieng  4075:                         } else {
1.576     raeburn  4076:                             if (exists($$olddata{$altkey})) {
                   4077:                                 if ($$olddata{$altkey} eq $data) {
                   4078:                                     $reconlychg = 1;
                   4079:                                 }
                   4080:                                 push(@delrec,($altkey,$altkey.'.type'));
                   4081:                             } 
                   4082:                             if (exists($$olddata{$thiskey})) {
                   4083:                                 if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4084:                                     $haschange = 1;
                   4085:                                 }
                   4086:                             } elsif (($data ne '') && (!$reconlychg)) {
                   4087:                                 $haschange = 1;
                   4088:                             }
                   4089:                             $storekey = $thiskey;
1.563     damieng  4090:                         }
1.560     damieng  4091:                     } else {
1.576     raeburn  4092:                         if (defined($data) && $$olddata{$thiskey} ne $data) {
                   4093:                             $haschange = 1;
                   4094:                             $storekey = $thiskey;
                   4095:                         }
                   4096:                     }
                   4097:                 }
                   4098:                 if ($reconlychg || $haschange) {
                   4099:                     unless ($env{'form.del_'.$thiskey}) {
                   4100:                         $newdata{$storekey}=$data;
                   4101:                         $newdata{$storekey.'.type'}=$typeof;
1.560     damieng  4102:                     }
                   4103:                 }
                   4104:             } elsif ($cmd eq 'del') {
                   4105:                 if ($tuname) {
1.576     raeburn  4106:                     my $error;
                   4107:                     if ($altkey) {  
                   4108:                         if (exists($$olddata{$altkey})) {
                   4109:                             if (&Apache::lonnet::del('resourcedata',[$tkeyrec,$tkeyrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4110:                                 &log_parmset({$tkeyrec=>''},1,$tuname,$tudom);
                   4111:                                 if ($recursive) {
                   4112:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4113:                                 }
                   4114:                             } elsif ($recursive) {
                   4115:                                 $error = 1;
                   4116:                             }
                   4117:                         }
                   4118:                         if (exists($$olddata{$thiskey})) {
                   4119:                             if (&Apache::lonnet::del('resourcedata',[$tkeynonrec,$tkeynonrec.'.type'],$tudom,$tuname) eq 'ok') {
                   4120:                                 &log_parmset({$tkeynonrec=>''},1,$tuname,$tudom);
                   4121:                                 unless ($recursive) {
                   4122:                                     $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4123:                                 }
                   4124:                             } elsif (!$recursive) {
                   4125:                                 $error = 1;
                   4126:                             }
                   4127:                         }
1.560     damieng  4128:                     } else {
1.576     raeburn  4129:                         if (exists($$olddata{$thiskey})) {
                   4130:                             if (&Apache::lonnet::del('resourcedata',[$tkey,$tkey.'.type'],$tudom,$tuname) eq 'ok') {
                   4131:                                 &log_parmset({$tkey=>''},1,$tuname,$tudom);
                   4132:                                 $r->print('<br />'.&mt('Deleted parameter for').' '.&Apache::loncommon::plainname($tuname,$tudom));
                   4133:                             } else {
                   4134:                                 $error = 1;
                   4135:                             }
                   4136:                         }
                   4137:                     }
                   4138:                     if ($error) { 
1.560     damieng  4139:                         $r->print('<div class="LC_error">'.
                   4140:                             &mt('Error deleting parameters').'</div>');
                   4141:                     }
                   4142:                     &Apache::lonnet::devalidateuserresdata($tuname,$tudom);
                   4143:                 } else {
1.576     raeburn  4144:                     if ($altkey) {
                   4145:                         if (exists($$olddata{$altkey})) {
                   4146:                             unless (grep(/^\Q$altkey\E$/,@delrec)) {
                   4147:                                 push(@deldata,($altkey,$altkey.'.type'));
                   4148:                             }
                   4149:                         }
                   4150:                         if (exists($$olddata{$thiskey})) {
                   4151:                             unless (grep(/^\Q$thiskey\E$/,@delnonrec)) {
                   4152:                                 push(@deldata,($thiskey,$thiskey.'.type'));
                   4153:                             }
                   4154:                         }
                   4155:                     } elsif (exists($$olddata{$thiskey})) {
                   4156:                         push(@deldata,($thiskey,$thiskey.'.type'));
                   4157:                     }
1.560     damieng  4158:                 }
1.473     amueller 4159:             }
                   4160:         }
                   4161:     }
1.207     www      4162: # Store all course level
1.144     www      4163:     my $delentries=$#deldata+1;
1.576     raeburn  4164:     my @alldels;
                   4165:     if (@delrec) {
                   4166:         push(@alldels,@delrec);
                   4167:     }
                   4168:     if (@delnonrec) {
                   4169:         push(@alldels,@delnonrec);
                   4170:     }
                   4171:     if (@deldata) {
                   4172:         push(@alldels,@deldata);
                   4173:     }
1.548     raeburn  4174:     my @newdatakeys=keys(%newdata);
1.144     www      4175:     my $putentries=$#newdatakeys+1;
1.576     raeburn  4176:     my ($delresult,$devalidate);
                   4177:     if (@alldels) {
                   4178:         if (&Apache::lonnet::del('resourcedata',\@alldels,$dom,$crs) eq 'ok') {
                   4179:             my %loghash=map { $_ => '' } @alldels;
1.560     damieng  4180:             &log_parmset(\%loghash,1);
1.576     raeburn  4181:             if ($delentries) {
                   4182:                 $r->print('<h2>'.&mt('Deleted [quant,_1,parameter]',$delentries/2).'</h2>');
                   4183:             }
                   4184:         } elsif ($delentries) {
1.560     damieng  4185:             $r->print('<div class="LC_error">'.
                   4186:                 &mt('Error deleting parameters').'</div>');
                   4187:         }
1.576     raeburn  4188:         $devalidate = 1; 
1.144     www      4189:     }
                   4190:     if ($putentries) {
1.560     damieng  4191:         if (&Apache::lonnet::put('resourcedata',\%newdata,$dom,$crs) eq 'ok') {
                   4192:                     &log_parmset(\%newdata,0);
                   4193:             $r->print('<h3>'.&mt('Saved [quant,_1,parameter]',$putentries/2).'</h3>');
                   4194:         } else {
                   4195:             $r->print('<div class="LC_error">'.
                   4196:                 &mt('Error saving parameters').'</div>');
                   4197:         }
1.576     raeburn  4198:         $devalidate = 1; 
                   4199:     }
                   4200:     if ($devalidate) {
1.560     damieng  4201:         &Apache::lonnet::devalidatecourseresdata($crs,$dom);
1.144     www      4202:     }
1.208     www      4203: }
1.207     www      4204: 
1.563     damieng  4205: # Returns the username and domain from a key created in readdata from a resourcedata key.
                   4206: #
                   4207: # @param {string} $key - the key
                   4208: # @returns {Array}
1.208     www      4209: sub extractuser {
                   4210:     my $key=shift;
1.350     albertel 4211:     return ($key=~/^$env{'request.course.id'}.\[useropt\:($match_username)\:($match_domain)\]\./);
1.208     www      4212: }
1.206     www      4213: 
1.563     damieng  4214: # Parses a parameter key and returns the components.
                   4215: #
                   4216: # @param {string} $key - 
                   4217: # @param {hash reference} $listdata - 
                   4218: # @return {Array} - (student, resource, part, parameter)
1.381     albertel 4219: sub parse_listdata_key {
                   4220:     my ($key,$listdata) = @_;
                   4221:     # split into student/section affected, and
                   4222:     # the realm (folder/resource part and parameter
1.446     bisitz   4223:     my ($student,$realm) =
1.473     amueller 4224:     ($key=~/^\Q$env{'request.course.id'}\E\.\[([^\.]+)\]\.(.+)$/);
1.381     albertel 4225:     # if course wide student would be undefined
                   4226:     if (!defined($student)) {
1.560     damieng  4227:         ($realm)=($key=~/^\Q$env{'request.course.id'}\E\.(.+)$/);
1.381     albertel 4228:     }
                   4229:     # strip off the .type if it's not the Question type parameter
                   4230:     if ($realm=~/\.type$/ && !exists($listdata->{$key.'.type'})) {
1.560     damieng  4231:         $realm=~s/\.type//;
1.381     albertel 4232:     }
                   4233:     # split into resource+part and parameter name
1.388     albertel 4234:     my ($res,    $parm) = ($realm=~/^(.*)\.(.*)$/);
                   4235:        ($res, my $part) = ($res  =~/^(.*)\.(.*)$/);
1.381     albertel 4236:     return ($student,$res,$part,$parm);
                   4237: }
                   4238: 
1.563     damieng  4239: # Prints HTML with forms for the given parameter data in overview mode (newoverview or overview).
                   4240: #
                   4241: # @param {Apache2::RequestRec} $r - the Apache request
                   4242: # @param {hash reference} $resourcedata - parameter data returned by readdata
                   4243: # @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
                   4244: # @param {string} $sortorder - realmstudent|studentrealm
                   4245: # @param {string} $caller - name of the calling sub (overview|newoverview)
                   4246: # @param {hash reference} $classlist - from loncoursedata::get_classlist
1.568     raeburn  4247: # @param {boolean} $readonly - true if editing not allowed
1.563     damieng  4248: # @returns{integer} - number of $listdata parameters processed
1.208     www      4249: sub listdata {
1.568     raeburn  4250:     my ($r,$resourcedata,$listdata,$sortorder,$caller,$classlist,$readonly)=@_;
1.552     raeburn  4251:     
1.207     www      4252: # Start list output
1.206     www      4253: 
1.122     www      4254:     my $oldsection='';
                   4255:     my $oldrealm='';
                   4256:     my $oldpart='';
1.123     www      4257:     my $pointer=0;
1.124     www      4258:     $tableopen=0;
1.145     www      4259:     my $foundkeys=0;
1.248     albertel 4260:     my %keyorder=&standardkeyorder();
1.381     albertel 4261: 
1.552     raeburn  4262:     my ($secidx,%grouphash);
                   4263:     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4264:         $secidx = &Apache::loncoursedata::CL_SECTION();
1.553     raeburn  4265:         if (&Apache::lonnet::allowed('mdg',$env{'request.course.id'})) {
                   4266:             %grouphash = &Apache::longroup::coursegroups();
                   4267:         } elsif ($env{'request.course.groups'} ne '') {
                   4268:             map { $grouphash{$_} = 1; } split(/,/,$env{'request.course.groups'});
                   4269:         }
1.552     raeburn  4270:     }
                   4271: 
1.576     raeburn  4272:     foreach my $key (sort {
1.560     damieng  4273:         my ($astudent,$ares,$apart,$aparm) = &parse_listdata_key($a,$listdata);
                   4274:         my ($bstudent,$bres,$bpart,$bparm) = &parse_listdata_key($b,$listdata);
1.381     albertel 4275: 
1.560     damieng  4276:         # get the numerical order for the param
                   4277:         $aparm=$keyorder{'parameter_0_'.$aparm};
                   4278:         $bparm=$keyorder{'parameter_0_'.$bparm};
1.381     albertel 4279: 
1.560     damieng  4280:         my $result=0;
1.381     albertel 4281: 
1.560     damieng  4282:         if ($sortorder eq 'realmstudent') {
1.381     albertel 4283:             if ($ares     ne $bres    ) {
1.560     damieng  4284:                 $result = ($ares     cmp $bres);
1.446     bisitz   4285:             } elsif ($astudent ne $bstudent) {
1.560     damieng  4286:                 $result = ($astudent cmp $bstudent);
                   4287:             } elsif ($apart    ne $bpart   ) {
                   4288:                 $result = ($apart    cmp $bpart);
                   4289:             }
                   4290:         } else {
                   4291:             if      ($astudent ne $bstudent) {
                   4292:                 $result = ($astudent cmp $bstudent);
                   4293:             } elsif ($ares     ne $bres    ) {
                   4294:                 $result = ($ares     cmp $bres);
                   4295:             } elsif ($apart    ne $bpart   ) {
                   4296:                 $result = ($apart    cmp $bpart);
                   4297:             }
1.473     amueller 4298:         }
1.446     bisitz   4299: 
1.560     damieng  4300:         if (!$result) {
1.381     albertel 4301:             if (defined($aparm) && defined($bparm)) {
1.560     damieng  4302:                 $result = ($aparm <=> $bparm);
1.381     albertel 4303:             } elsif (defined($aparm)) {
1.560     damieng  4304:                 $result = -1;
1.381     albertel 4305:             } elsif (defined($bparm)) {
1.560     damieng  4306:                 $result = 1;
                   4307:             }
1.473     amueller 4308:         }
1.381     albertel 4309: 
1.560     damieng  4310:         $result;
                   4311:         
1.576     raeburn  4312:     } keys(%{$listdata})) { # foreach my $key
                   4313:         my $thiskey = $key;
1.560     damieng  4314:         if ($$listdata{$thiskey.'.type'}) {
                   4315:             my $thistype=$$listdata{$thiskey.'.type'};
                   4316:             if ($$resourcedata{$thiskey.'.type'}) {
                   4317:                 $thistype=$$resourcedata{$thiskey.'.type'};
                   4318:             }
                   4319:             my ($middle,$part,$name)=
1.572     damieng  4320:                 ($thiskey=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.560     damieng  4321:             my $section=&mt('All Students');
1.576     raeburn  4322:             my $showval = $$resourcedata{$thiskey}; 
1.560     damieng  4323:             if ($middle=~/^\[(.*)\]/) {
                   4324:                 my $issection=$1;
                   4325:                 if ($issection=~/^useropt\:($match_username)\:($match_domain)/) {
                   4326:                     my ($stuname,$studom) = ($1,$2);
                   4327:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4328:                         if (ref($classlist) eq 'HASH') {
                   4329:                             if (ref($classlist->{$stuname.':'.$studom}) eq 'ARRAY') {
                   4330:                                 next unless ($classlist->{$stuname.':'.$studom}->[$secidx] eq $env{'request.course.sec'}); 
                   4331:                             }
                   4332:                         }
                   4333:                     }
                   4334:                     $section=&mt('User').": ".&Apache::loncommon::plainname($stuname,$studom);
                   4335:                 } else {
                   4336:                     if (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4337:                         if (exists($grouphash{$issection})) {
                   4338:                             $section=&mt('Group').': '.$issection;
                   4339:                         } elsif ($issection eq $env{'request.course.sec'}) {
                   4340:                             $section = &mt('Section').': '.$issection;
                   4341:                         } else {
                   4342:                             next; 
1.552     raeburn  4343:                         }
1.560     damieng  4344:                     } else {
                   4345:                         $section=&mt('Group/Section').': '.$issection;
1.552     raeburn  4346:                     }
                   4347:                 }
1.560     damieng  4348:                 $middle=~s/^\[(.*)\]//;
                   4349:             } elsif (($env{'request.course.sec'} ne '') && ($caller eq 'overview')) {
                   4350:                 $readonly = 1;
                   4351:             }
                   4352:             $middle=~s/\.+$//;
                   4353:             $middle=~s/^\.+//;
                   4354:             my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.576     raeburn  4355:             my ($is_map,$is_recursive,$mapurl,$maplevel);
                   4356:             if ($caller eq 'overview') {
                   4357:                 if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   4358:                     $mapurl = $1;
                   4359:                     $maplevel = $2;
                   4360:                     $is_map = 1;
                   4361:                 }
                   4362:             } elsif ($caller eq 'newoverview') {
                   4363:                 if ($middle=~/^(.+)\_\_\_\((all)\)$/) {
                   4364:                     $mapurl = $1;
                   4365:                     $maplevel = $2;
                   4366:                     $is_map = 1;
                   4367:                 }
                   4368:             }
                   4369:             if ($is_map) {
1.560     damieng  4370:                 my $leveltitle = &mt('Folder/Map');
1.576     raeburn  4371:                 unless (($name eq 'hiddenresource') || ($name eq 'encrypturl')) {   
                   4372:                     if ($caller eq 'newoverview') {
                   4373:                         my $altkey = $thiskey;
                   4374:                         $altkey =~ s/\Q___(all)\E/___(rec)/;
                   4375:                         if ((exists($$resourcedata{$altkey})) & (!exists($$resourcedata{$thiskey}))) {
                   4376:                             $is_recursive = 1;
                   4377:                             if ($$resourcedata{$altkey.'.type'}) {
                   4378:                                 $thistype=$$resourcedata{$altkey.'.type'};
                   4379:                             }
                   4380:                             $showval = $$resourcedata{$altkey};
                   4381:                         }
                   4382:                     } elsif (($caller eq 'overview') && ($maplevel eq 'rec')) {
                   4383:                         $thiskey =~ s/\Q___(rec)\E/___(all)/;
                   4384:                         $is_recursive = 1;
                   4385:                     }
1.560     damieng  4386:                 }
                   4387:                 $realm='<span class="LC_parm_scope_folder">'.$leveltitle.': '.&Apache::lonnet::gettitle($mapurl).' <br /><span class="LC_parm_folder">('.$mapurl.')</span></span>';
                   4388:             } elsif ($middle) {
                   4389:                 my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   4390:                 $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   4391:                     ': '.&Apache::lonnet::gettitle($middle).
                   4392:                     ' <br /><span class="LC_parm_symb">('.$url.' in '.$map.' id: '.
                   4393:                     $id.')</span></span>';
                   4394:             }
                   4395:             if ($sortorder eq 'realmstudent') {
                   4396:                 if ($realm ne $oldrealm) {
                   4397:                     $r->print(&tableend()."\n<hr /><h1>$realm</h1>");
                   4398:                     $oldrealm=$realm;
                   4399:                     $oldsection='';
                   4400:                 }
                   4401:                 if ($section ne $oldsection) {
                   4402:                     $r->print(&tableend()."\n<h2>$section</h2>");
                   4403:                     $oldsection=$section;
                   4404:                     $oldpart='';
                   4405:                 }
1.552     raeburn  4406:             } else {
1.560     damieng  4407:                 if ($section ne $oldsection) {
                   4408:                     $r->print(&tableend()."\n<hr /><h1>$section</h1>");
                   4409:                     $oldsection=$section;
                   4410:                     $oldrealm='';
                   4411:                 }
                   4412:                 if ($realm ne $oldrealm) {
                   4413:                     $r->print(&tableend()."\n<h2>$realm</h2>");
                   4414:                     $oldrealm=$realm;
                   4415:                     $oldpart='';
1.552     raeburn  4416:                 }
                   4417:             }
1.560     damieng  4418:             if ($part ne $oldpart) {
                   4419:                 $r->print(&tableend().
                   4420:                     "\n".'<span class="LC_parm_part">'.&mt('Part').": $part</span>");
                   4421:                 $oldpart=$part;
1.556     raeburn  4422:             }
1.560     damieng  4423:     #
                   4424:     # Ready to print
                   4425:     #
1.470     raeburn  4426:             my $parmitem = &standard_parameter_names($name);
1.576     raeburn  4427:             $r->print(&tablestart($readonly,$is_map).
1.560     damieng  4428:                 &Apache::loncommon::start_data_table_row().
                   4429:                 '<td><b>'.&mt($parmitem).
                   4430:                 '</b></td>');
                   4431:             unless ($readonly) {
                   4432:                 $r->print('<td><input type="checkbox" name="del_'.
                   4433:                         $thiskey.'" /></td>');
                   4434:             }
                   4435:             $r->print('<td>');
                   4436:             $foundkeys++;
                   4437:             if (&isdateparm($thistype)) {
                   4438:                 my $jskey='key_'.$pointer;
                   4439:                 my $state;
                   4440:                 $pointer++;
                   4441:                 if ($readonly) {
                   4442:                     $state = 'disabled';
                   4443:                 }
                   4444:                 $r->print(
                   4445:                     &Apache::lonhtmlcommon::date_setter('parmform',
                   4446:                                                         $jskey,
1.576     raeburn  4447:                                                         $showval,
1.560     damieng  4448:                                                         '',1,$state));
                   4449:                 unless  ($readonly) {
                   4450:                     $r->print(
                   4451:     '<input type="hidden" name="datepointer_'.$thiskey.'" value="'.$jskey.'" />'.
1.576     raeburn  4452:     (($showval!=0)?'<span class="LC_nobreak"><a href="/adm/parmset?&action=dateshift1&timebase='.$showval.'">'.
1.560     damieng  4453:     &mt('Shift all dates based on this date').'</a></span>':'').
1.576     raeburn  4454:     &date_sanity_info($showval)
1.560     damieng  4455:                     );
                   4456:                 }
                   4457:             } elsif ($thistype eq 'date_interval') {
                   4458:                 $r->print(&date_interval_selector($thiskey,$name,
1.576     raeburn  4459:                           $showval,$readonly));
1.560     damieng  4460:             } elsif ($thistype =~ m/^string/) {
                   4461:                 $r->print(&string_selector($thistype,$thiskey,
1.576     raeburn  4462:                           $showval,$name,$readonly));
1.560     damieng  4463:             } else {
1.576     raeburn  4464:                 $r->print(&default_selector($thiskey,$showval,$readonly));
1.552     raeburn  4465:             }
1.560     damieng  4466:             unless ($readonly) {
                   4467:                 $r->print('<input type="hidden" name="typeof_'.$thiskey.'" value="'.
                   4468:                         $thistype.'" />');
1.552     raeburn  4469:             }
1.576     raeburn  4470:             $r->print('</td>');
                   4471:             if ($is_map) {
                   4472:                 if (($name eq 'encrypturl') || ($name eq 'hiddenresource')) {
                   4473:                     $r->print('<td><table><tr><td>'.&mt('Yes').'</td></tr></table></td>');
                   4474:                 } else {
                   4475:                     my ($disabled,$recon,$recoff);
                   4476:                     if ($readonly) {
                   4477:                         $disabled = ' disabled="disabled"';
                   4478:                     }
                   4479:                     if ($is_recursive) {
                   4480:                         $recon = ' checked="checked"';
                   4481:                     } else {
                   4482:                         $recoff = ' checked="checked"';
                   4483:                     }
                   4484:                     $r->print('<td><table><tr><td><label><input type="radio" name="rec_'.$thiskey.'" value="1"'.$recon.$disabled.' />'.&mt('Yes').'</label>'.
                   4485:                               '</td><td><label><input type="radio" name="rec_'.$thiskey.'" value="0"'.$recoff.$disabled.' />'.&mt('No').'</label></td></tr></table></td>');
                   4486:                 }
                   4487:             }
                   4488:             $r->print(&Apache::loncommon::end_data_table_row());
1.473     amueller 4489:         }
1.121     www      4490:     }
1.208     www      4491:     return $foundkeys;
                   4492: }
                   4493: 
1.563     damieng  4494: # Returns a string representing the interval, directly using form data matching the given key.
                   4495: # The returned string may also include information related to proctored exams.
                   4496: # Format: seconds['_done'[':'done button title':']['_proctor'['_'proctor key]]]
                   4497: #
                   4498: # @param {string} $key - suffix for form fields related to the interval
                   4499: # @returns {string}
1.385     albertel 4500: sub get_date_interval_from_form {
                   4501:     my ($key) = @_;
                   4502:     my $seconds = 0;
                   4503:     foreach my $which (['days', 86400],
1.473     amueller 4504:                ['hours', 3600],
                   4505:                ['minutes', 60],
                   4506:                ['seconds',  1]) {
1.560     damieng  4507:         my ($name, $factor) = @{ $which };
                   4508:         if (defined($env{'form.'.$name.'_'.$key})) {
                   4509:             $seconds += $env{'form.'.$name.'_'.$key} * $factor;
                   4510:         }
1.473     amueller 4511:     }
1.560     damieng  4512:     if (($key =~ /\.interval$/) &&
                   4513:             (($env{'form.done_'.$key} eq '_done') || ($env{'form.done_'.$key} eq '_done_proctor'))) {
1.559     raeburn  4514:         if ($env{'form.done_'.$key.'_buttontext'}) {
                   4515:             $env{'form.done_'.$key.'_buttontext'} =~ s/\://g;
                   4516:             $seconds .= '_done:'.$env{'form.done_'.$key.'_buttontext'}.':';
                   4517:             if ($env{'form.done_'.$key} eq '_done_proctor') {
                   4518:                 $seconds .= '_proctor';
                   4519:             }
                   4520:         } else {
                   4521:             $seconds .= $env{'form.done_'.$key}; 
                   4522:         }
                   4523:         if (($env{'form.done_'.$key} eq '_done_proctor') && 
1.560     damieng  4524:                 ($env{'form.done_'.$key.'_proctorkey'})) {
1.558     raeburn  4525:             $seconds .= '_'.$env{'form.done_'.$key.'_proctorkey'};
                   4526:         }
1.554     raeburn  4527:     }
1.385     albertel 4528:     return $seconds;
                   4529: }
                   4530: 
                   4531: 
1.563     damieng  4532: # Returns HTML to enter a text value for a parameter.
                   4533: #
                   4534: # @param {string} $thiskey - parameter key
                   4535: # @param {string} $showval - the current value
                   4536: # @param {boolean} $readonly - true if the field should not be made editable
                   4537: # @returns {string}
1.383     albertel 4538: sub default_selector {
1.552     raeburn  4539:     my ($thiskey, $showval, $readonly) = @_;
                   4540:     my $disabled;
                   4541:     if ($readonly) {
                   4542:         $disabled = ' disabled="disabled"';
                   4543:     }
                   4544:     return '<input type="text" name="set_'.$thiskey.'" value="'.$showval.'"'.$disabled.' />';
1.383     albertel 4545: }
                   4546: 
1.563     damieng  4547: # Returns HTML to enter allow/deny rules related to IP addresses.
                   4548: #
                   4549: # @param {string} $thiskey - parameter key
                   4550: # @param {string} $showval - the current value
                   4551: # @param {boolean} $readonly - true if the fields should not be made editable
                   4552: # @returns {string}
1.549     raeburn  4553: sub string_ip_selector {
1.552     raeburn  4554:     my ($thiskey, $showval, $readonly) = @_;
1.549     raeburn  4555:     my %access = (
                   4556:                    allow => [],
                   4557:                    deny  => [],
                   4558:                  );
                   4559:     if ($showval ne '') {
                   4560:         my @current;
                   4561:         if ($showval =~ /,/) {
                   4562:             @current = split(/,/,$showval);
                   4563:         } else {
                   4564:             @current = ($showval);
                   4565:         }
                   4566:         foreach my $item (@current) {
                   4567:             if ($item =~ /^\!([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4568:                 push(@{$access{'deny'}},$1);
                   4569:             } elsif ($item =~ /^([\[\]a-zA-Z\.\d\*\-]+)$/) {
                   4570:                 push(@{$access{'allow'}},$item);
                   4571:             }
                   4572:         }
                   4573:     }
                   4574:     if (!@{$access{'allow'}}) {
                   4575:         @{$access{'allow'}} = ('');
                   4576:     }
                   4577:     if (!@{$access{'deny'}}) {
                   4578:         @{$access{'deny'}} = ('');
                   4579:     }
1.552     raeburn  4580:     my ($disabled,$addmore);
1.567     raeburn  4581:     if ($readonly) {
1.552     raeburn  4582:         $disabled=' disabled="disabled"';
                   4583:     } else {
                   4584:         $addmore = "\n".'<button class="LC_add_ipacc_button">'.&mt('Add more').'</button>';
                   4585:     }
1.549     raeburn  4586:     my $output = '<input type="hidden" name="set_'.$thiskey.'" />
                   4587: <table><tr><th>'.&mt('Allow from').'</th><th>'.&mt('Deny from').'</th></tr><tr>';
                   4588:     foreach my $acctype ('allow','deny') {
                   4589:         $output .= '
                   4590: <td valign="top">
                   4591: <div class="LC_string_ipacc_wrap" id="LC_string_ipacc_'.$acctype.'_'.$thiskey.'">
                   4592:   <div class="LC_string_ipacc_inner">'."\n";
                   4593:         my $num = 0;
                   4594:         foreach my $curr (@{$access{$acctype}}) {
1.552     raeburn  4595:             $output .= '<div><input type="text" name="setip'.$acctype.'_'.$thiskey.'" value="'.$curr.'"'.$disabled.' />';
1.549     raeburn  4596:             if ($num > 0) {
                   4597:                 $output .= '<a href="#" class="LC_remove_ipacc">'.&mt('Remove').'</a>'; 
                   4598:             }
                   4599:             $output .= '</div>'."\n";
                   4600:             $num ++;
                   4601:         }
                   4602:         $output .= '
1.552     raeburn  4603:   </div>'.$addmore.'
1.549     raeburn  4604: </div>
                   4605: </td>';
                   4606:    }
                   4607:    $output .= '
                   4608: </tr>
                   4609: </table>'."\n";
                   4610:     return $output;
                   4611: }
                   4612: 
1.560     damieng  4613: 
                   4614: { # block using some constants related to parameter types (overview mode)
                   4615: 
1.446     bisitz   4616: my %strings =
1.383     albertel 4617:     (
                   4618:      'string_yesno'
                   4619:              => [[ 'yes', 'Yes' ],
1.560     damieng  4620:                  [ 'no', 'No' ]],
1.383     albertel 4621:      'string_problemstatus'
                   4622:              => [[ 'yes', 'Yes' ],
1.473     amueller 4623:          [ 'answer', 'Yes, and show correct answer if they exceed the maximum number of tries.' ],
                   4624:          [ 'no', 'No, don\'t show correct/incorrect feedback.' ],
                   4625:          [ 'no_feedback_ever', 'No, show no feedback at all.' ]],
1.504     raeburn  4626:      'string_questiontype'
                   4627:              => [[ 'problem', 'Standard Problem'],
                   4628:                  [ 'survey', 'Survey'],
                   4629:                  [ 'anonsurveycred', 'Anonymous Survey (credit for submission)'],
1.530     bisitz   4630:                  [ 'exam', 'Bubblesheet Exam'],
1.504     raeburn  4631:                  [ 'anonsurvey', 'Anonymous Survey'],
                   4632:                  [ 'randomizetry', 'New Randomization Each N Tries (default N=1)'],
                   4633:                  [ 'practice', 'Practice'],
                   4634:                  [ 'surveycred', 'Survey (credit for submission)']],
1.514     raeburn  4635:      'string_lenient'
                   4636:              => [['yes', 'Yes' ],
                   4637:                  [ 'no', 'No' ],
1.549     raeburn  4638:                  [ 'default', 'Default - only bubblesheet grading is lenient' ],
                   4639:                  [ 'weighted', 'Yes, weighted (optionresponse in checkbox mode)' ]],
1.521     raeburn  4640:      'string_discussvote'
                   4641:              => [['yes','Yes'],
                   4642:                  ['notended','Yes, unless discussion ended'],
                   4643:                  ['no','No']],
1.549     raeburn  4644:      'string_ip'
                   4645:              => [['_allowfrom_','Hostname(s), or IP(s) from which access is allowed'],
                   4646:                  ['_denyfrom_',], 'Hostname(s) or IP(s) from which access is disallowed'], 
1.383     albertel 4647:      );
                   4648: 
1.549     raeburn  4649: my %stringmatches = (
                   4650:          'string_lenient'
                   4651:               => [['weighted','^\-?[.\d]+,\-?[.\d]+,\-?[.\d]+,\-?[.\d]+$'],],
                   4652:          'string_ip'
                   4653:               => [['_allowfrom_','[^\!]+'],
                   4654:                   ['_denyfrom_','\!']],
                   4655:     );
                   4656: 
                   4657: my %stringtypes = (
                   4658:                     type         => 'string_questiontype',
                   4659:                     lenient      => 'string_lenient',
                   4660:                     retrypartial => 'string_yesno',
                   4661:                     discussvote  => 'string_discussvote',
                   4662:                     examcode     => 'string_examcode',
                   4663:                     acc          => 'string_ip',
                   4664:                   );
                   4665: 
1.563     damieng  4666: # Returns the possible values and titles for a given string type, or undef if there are none.
                   4667: # Used by courseprefs.
                   4668: #
                   4669: # @param {string} $string_type - a parameter type for strings
                   4670: # @returns {array reference} - 2D array, containing values and English titles
1.505     raeburn  4671: sub standard_string_options {
                   4672:     my ($string_type) = @_;
                   4673:     if (ref($strings{$string_type}) eq 'ARRAY') {
                   4674:         return $strings{$string_type};
                   4675:     }
                   4676:     return;
                   4677: }
1.383     albertel 4678: 
1.563     damieng  4679: # Returns regular expressions to match kinds of string types, or undef if there are none.
                   4680: #
                   4681: # @param {string} $string_type - a parameter type for strings
                   4682: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.549     raeburn  4683: sub standard_string_matches {
                   4684:     my ($string_type) = @_;
                   4685:     if (ref($stringmatches{$string_type}) eq 'ARRAY') {
                   4686:         return $stringmatches{$string_type};
                   4687:     }
                   4688:     return;
                   4689: }
                   4690: 
1.563     damieng  4691: # Returns a parameter type for a given parameter with a string type, or undef if not known.
                   4692: #
                   4693: # @param {string} $name - parameter name
                   4694: # @returns {string}
1.549     raeburn  4695: sub get_stringtype {
                   4696:     my ($name) = @_;
                   4697:     if (exists($stringtypes{$name})) {
                   4698:         return $stringtypes{$name};
                   4699:     }
                   4700:     return;
                   4701: }
                   4702: 
1.563     damieng  4703: # Returns HTML to edit a string parameter.
                   4704: #
                   4705: # @param {string} $thistype - parameter type
                   4706: # @param {string} $thiskey - parameter key
                   4707: # @param {string} $showval - parameter current value
                   4708: # @param {string} $name - parameter name
                   4709: # @param {boolean} $readonly - true if the values should not be made editable
                   4710: # @returns {string}
1.383     albertel 4711: sub string_selector {
1.552     raeburn  4712:     my ($thistype, $thiskey, $showval, $name, $readonly) = @_;
1.446     bisitz   4713: 
1.383     albertel 4714:     if (!exists($strings{$thistype})) {
1.552     raeburn  4715:         return &default_selector($thiskey,$showval,$readonly);
1.383     albertel 4716:     }
                   4717: 
1.504     raeburn  4718:     my %skiptype;
1.514     raeburn  4719:     if (($thistype eq 'string_questiontype') || 
1.560     damieng  4720:             ($thistype eq 'string_lenient') ||
                   4721:             ($thistype eq 'string_discussvote') ||
                   4722:             ($thistype eq 'string_ip') ||
                   4723:             ($name eq 'retrypartial')) {
1.504     raeburn  4724:         my ($got_chostname,$chostname,$cmajor,$cminor); 
                   4725:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4726:             next unless (ref($possibilities) eq 'ARRAY');
1.514     raeburn  4727:             my ($parmval, $description) = @{ $possibilities };
1.549     raeburn  4728:             my $parmmatch;
                   4729:             if (ref($stringmatches{$thistype}) eq 'ARRAY') {
                   4730:                 foreach my $item (@{$stringmatches{$thistype}}) {
                   4731:                     if (ref($item) eq 'ARRAY') {
                   4732:                         if ($parmval eq $item->[0]) {
                   4733:                             $parmmatch = $parmval;
                   4734:                             $parmval = '';
                   4735:                             last;
                   4736:                         }
                   4737:                     }
                   4738:                 }
                   4739:             }
                   4740:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"}; 
1.504     raeburn  4741:             if ($needsrelease) {
                   4742:                 unless ($got_chostname) {
1.514     raeburn  4743:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
1.504     raeburn  4744:                     $got_chostname = 1;
                   4745:                 }
1.557     raeburn  4746:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.549     raeburn  4747:                                                        $needsrelease,$cmajor,$cminor);
1.504     raeburn  4748:                 if ($needsnewer) {
1.549     raeburn  4749:                     if ($parmmatch ne '') {
                   4750:                         $skiptype{$parmmatch} = 1;
                   4751:                     } elsif ($parmval ne '') {
                   4752:                         $skiptype{$parmval} = 1;
                   4753:                     }
1.504     raeburn  4754:                 }
                   4755:             }
                   4756:         }
                   4757:     }
1.549     raeburn  4758: 
                   4759:     if ($thistype eq 'string_ip') {
1.552     raeburn  4760:         return &string_ip_selector($thiskey,$showval,$readonly); 
1.549     raeburn  4761:     }
1.504     raeburn  4762: 
1.552     raeburn  4763:     my ($result,$disabled);
                   4764: 
                   4765:     if ($readonly) {
                   4766:         $disabled = ' disabled="disabled"';
                   4767:     }
1.504     raeburn  4768:     my $numinrow = 3;
                   4769:     if ($thistype eq 'string_problemstatus') {
                   4770:         $numinrow = 2;
                   4771:     } elsif ($thistype eq 'string_questiontype') {
                   4772:         if (keys(%skiptype) > 0) {
                   4773:              $numinrow = 4;
                   4774:         }
                   4775:     }
                   4776:     my $rem;
                   4777:     if (ref($strings{$thistype}) eq 'ARRAY') {
                   4778:         my $i=0;
                   4779:         foreach my $possibilities (@{ $strings{$thistype} }) {
                   4780:             next unless (ref($possibilities) eq 'ARRAY');
                   4781:             my ($name, $description) = @{ $possibilities };
1.549     raeburn  4782:             next if ($skiptype{$name});
1.504     raeburn  4783:             $rem = $i%($numinrow);
                   4784:             if ($rem == 0) {
                   4785:                 if ($i > 0) {
                   4786:                     $result .= '</tr>';
                   4787:                 }
                   4788:                 $result .= '<tr>';
                   4789:             }
1.549     raeburn  4790:             my $colspan;
                   4791:             if ($i == @{ $strings{$thistype} }-1) {
                   4792:                 $rem = @{ $strings{$thistype} }%($numinrow);
                   4793:                 if ($rem) {
                   4794:                     my $colsleft = $numinrow - $rem;
                   4795:                     if ($colsleft) {
                   4796:                         $colspan = $colsleft+1;
                   4797:                         $colspan = ' colspan="'.$colspan.'"';
                   4798:                     }
                   4799:                 }
                   4800:             }
                   4801:             my ($add,$onchange,$css_class);
                   4802:             if ($thistype eq 'string_lenient') {
                   4803:                 if ($name eq 'weighted') {
                   4804:                     my $display;
                   4805:                     my %relatives = &Apache::lonlocal::texthash(
                   4806:                                         corrchkd     => 'Correct (checked)',
                   4807:                                         corrunchkd   => 'Correct (unchecked)',
                   4808:                                         incorrchkd   => 'Incorrect (checked)',
                   4809:                                         incorrunchkd => 'Incorrect (unchecked)',
                   4810:                     );
                   4811:                     my %textval = (
                   4812:                                     corrchkd     => '1.0',
                   4813:                                     corrunchkd   => '1.0',
                   4814:                                     incorrchkd   => '0.0',
                   4815:                                     incorrunchkd => '0.0',
                   4816:                     );
                   4817:                     if ($showval =~ /^([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)\,([\-\d\.]+)$/) {
                   4818:                         $textval{'corrchkd'} = $1;
                   4819:                         $textval{'corrunchkd'} = $2;
                   4820:                         $textval{'incorrchkd'} = $3;
                   4821:                         $textval{'incorrunchkd'} = $4;
                   4822:                         $display = 'inline';
                   4823:                         $showval = $name;
                   4824:                     } else {
                   4825:                         $display = 'none';
                   4826:                     }
                   4827:                     $add = ' <div id="LC_parmtext_'.$thiskey.'" style="display:'.$display.'"><table>'.
                   4828:                            '<tr><th colspan="2">'.&mt("Foil's submission status").'</th><th>'.&mt('Points').'</th></tr>';  
                   4829:                     foreach my $reltype ('corrchkd','corrunchkd','incorrchkd','incorrunchkd') {
                   4830:                         $add .= '<tr><td>&nbsp;</td><td>'.$relatives{$reltype}.'</td>'."\n".
                   4831:                                 '<td><input type="text" name="settext_'.$thiskey.'"'.
1.552     raeburn  4832:                                 ' value="'.$textval{$reltype}.'" size="3"'.$disabled.' />'.
1.549     raeburn  4833:                                 '</td></tr>';
                   4834:                     }
                   4835:                     $add .= '</table></div>'."\n";
                   4836:                 }
                   4837:                 $onchange = ' onclick="javascript:toggleParmTextbox(this.form,'."'$thiskey'".');"';
                   4838:                 $css_class = ' class="LC_lenient_radio"';
                   4839:             }
                   4840:             $result .= '<td class="LC_left_item"'.$colspan.'>'.
1.504     raeburn  4841:                        '<span class="LC_nobreak"><label>'.
                   4842:                        '<input type="radio" name="set_'.$thiskey.
1.552     raeburn  4843:                        '" value="'.$name.'"'.$onchange.$css_class.$disabled;
1.504     raeburn  4844:             if ($showval eq $name) {
                   4845:                 $result .= ' checked="checked"';
                   4846:             }
1.549     raeburn  4847:             $result .= ' />'.&mt($description).'</label>'.$add.'</span></td>';
1.504     raeburn  4848:             $i++;
                   4849:         }
                   4850:         $result .= '</tr>';
1.473     amueller 4851:     }
1.504     raeburn  4852:     if ($result) {
                   4853:         $result = '<table border="0">'.$result.'</table>';
1.383     albertel 4854:     }
                   4855:     return $result;
                   4856: }
                   4857: 
1.554     raeburn  4858: my %intervals =
                   4859:     (
                   4860:      'date_interval'
                   4861:              => [[ 'done', 'Yes' ],
1.558     raeburn  4862:                  [ 'done_proctor', 'Yes, with proctor key'],                  
1.554     raeburn  4863:                  [ '', 'No' ]],
                   4864:     );
                   4865: 
                   4866: my %intervalmatches = (
                   4867:          'date_interval'
1.559     raeburn  4868:               => [['done','\d+_done(|\:[^\:]+\:)$'],
                   4869:                   ['done_proctor','\d+_done(|\:[^\:]+\:)_proctor_']],
1.554     raeburn  4870:     );
                   4871: 
                   4872: my %intervaltypes = (
                   4873:                       interval => 'date_interval',
                   4874:     );
                   4875: 
1.563     damieng  4876: # Returns regular expressions to match kinds of interval type, or undef if there are none.
                   4877: #
                   4878: # @param {string} $interval_type - a parameter type for intervals
                   4879: # @returns {array reference}  - 2D array, containing regular expression names and regular expressions
1.554     raeburn  4880: sub standard_interval_matches {
                   4881:     my ($interval_type) = @_;
                   4882:     if (ref($intervalmatches{$interval_type}) eq 'ARRAY') {
                   4883:         return $intervalmatches{$interval_type};
                   4884:     }
                   4885:     return;
                   4886: }
                   4887: 
1.563     damieng  4888: # Returns a parameter type for a given parameter with an interval type, or undef if not known.
                   4889: #
                   4890: # @param {string} $name - parameter name
                   4891: # @returns {string}
1.554     raeburn  4892: sub get_intervaltype {
                   4893:     my ($name) = @_;
                   4894:     if (exists($intervaltypes{$name})) {
                   4895:         return $intervaltypes{$name};
                   4896:     }
                   4897:     return;
                   4898: }
                   4899: 
1.563     damieng  4900: # Returns the possible values and titles for a given interval type, or undef if there are none.
                   4901: # Used by courseprefs.
                   4902: #
                   4903: # @param {string} $interval_type - a parameter type for intervals
                   4904: # @returns {array reference} - 2D array, containing values and English titles
1.554     raeburn  4905: sub standard_interval_options {
                   4906:     my ($interval_type) = @_;
                   4907:     if (ref($intervals{$interval_type}) eq 'ARRAY') {
                   4908:         return $intervals{$interval_type};
                   4909:     }
                   4910:     return;
                   4911: }
                   4912: 
1.563     damieng  4913: # Returns HTML to edit a date interval parameter.
                   4914: #
                   4915: # @param {string} $thiskey - parameter key
                   4916: # @param {string} $name - parameter name
                   4917: # @param {string} $showval - parameter current value
                   4918: # @param {boolean} $readonly - true if the values should not be made editable
                   4919: # @returns {string}
1.554     raeburn  4920: sub date_interval_selector {
                   4921:     my ($thiskey, $name, $showval, $readonly) = @_;
                   4922:     my ($result,%skipval);
                   4923:     if ($name eq 'interval') {
                   4924:         my $intervaltype = &get_intervaltype($name);
                   4925:         my ($got_chostname,$chostname,$cmajor,$cminor);
                   4926:         foreach my $possibilities (@{ $intervals{$intervaltype} }) {
                   4927:             next unless (ref($possibilities) eq 'ARRAY');
                   4928:             my ($parmval, $description) = @{ $possibilities };
                   4929:             my $parmmatch;
                   4930:             if (ref($intervalmatches{$intervaltype}) eq 'ARRAY') {
                   4931:                 foreach my $item (@{$intervalmatches{$intervaltype}}) {
                   4932:                     if (ref($item) eq 'ARRAY') {
                   4933:                         if ($parmval eq $item->[0]) {
                   4934:                             $parmmatch = $parmval;
                   4935:                             $parmval = '';
                   4936:                             last;
                   4937:                         }
                   4938:                     }
                   4939:                 }
                   4940:             }
                   4941:             my $needsrelease=$Apache::lonnet::needsrelease{"parameter:$name:$parmval:$parmmatch"};
                   4942:             if ($needsrelease) {
                   4943:                 unless ($got_chostname) {
                   4944:                     ($chostname,$cmajor,$cminor)=&parameter_release_vars();
                   4945:                     $got_chostname = 1;
                   4946:                 }
1.557     raeburn  4947:                 my $needsnewer=&parameter_releasecheck($name,$parmval,$parmmatch,undef,
1.554     raeburn  4948:                                                        $needsrelease,$cmajor,$cminor);
                   4949:                 if ($needsnewer) {
                   4950:                     if ($parmmatch ne '') {
                   4951:                         $skipval{$parmmatch} = 1;
                   4952:                     } elsif ($parmval ne '') {
                   4953:                         $skipval{$parmval} = 1;
                   4954:                     }
                   4955:                 }
                   4956:             }
                   4957:         }
                   4958:     }
                   4959: 
                   4960:     my $currval = $showval;
                   4961:     foreach my $which (['days', 86400, 31],
                   4962:                ['hours', 3600, 23],
                   4963:                ['minutes', 60, 59],
                   4964:                ['seconds',  1, 59]) {
1.560     damieng  4965:         my ($name, $factor, $max) = @{ $which };
                   4966:         my $amount = int($showval/$factor);
                   4967:         $showval  %= $factor;
                   4968:         my %select = ((map {$_ => $_} (0..$max)),
                   4969:                 'select_form_order' => [0..$max]);
                   4970:         $result .= &Apache::loncommon::select_form($amount,$name.'_'.$thiskey,
                   4971:                             \%select,'',$readonly);
                   4972:         $result .= ' '.&mt($name);
1.554     raeburn  4973:     }
                   4974:     if ($name eq 'interval') {
                   4975:         unless ($skipval{'done'}) {
                   4976:             my $checkedon = '';
1.558     raeburn  4977:             my $checkedproc = '';
                   4978:             my $currproctorkey = '';
                   4979:             my $currprocdisplay = 'hidden';
1.559     raeburn  4980:             my $currdonetext = &mt('Done');
1.554     raeburn  4981:             my $checkedoff = ' checked="checked"';
1.559     raeburn  4982:             if ($currval =~ /^(?:\d+)_done$/) {
                   4983:                 $checkedon = ' checked="checked"';
                   4984:                 $checkedoff = '';
                   4985:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:$/) {
                   4986:                 $currdonetext = $1;
1.554     raeburn  4987:                 $checkedon = ' checked="checked"';
                   4988:                 $checkedoff = '';
1.558     raeburn  4989:             } elsif ($currval =~ /^(?:\d+)_done_proctor_(.+)$/) {
                   4990:                 $currproctorkey = $1;
                   4991:                 $checkedproc = ' checked="checked"';
                   4992:                 $checkedoff = '';
                   4993:                 $currprocdisplay = 'text';
1.559     raeburn  4994:             } elsif ($currval =~ /^(?:\d+)_done\:([^\:]+)\:_proctor_(.+)$/) {
                   4995:                 $currdonetext = $1;
                   4996:                 $currproctorkey = $2;
                   4997:                 $checkedproc = ' checked="checked"';
                   4998:                 $checkedoff = '';
                   4999:                 $currprocdisplay = 'text';
1.554     raeburn  5000:             }
1.558     raeburn  5001:             my $onclick = ' onclick="toggleSecret(this.form,'."'done_','$thiskey'".');"';
1.567     raeburn  5002:             my $disabled;
                   5003:             if ($readonly) {
                   5004:                 $disabled = ' disabled="disabled"';
                   5005:             }
1.558     raeburn  5006:             $result .= '<br /><span class="LC_nobreak">'.&mt('Include "done" button').
1.567     raeburn  5007:                        '<label><input type="radio" value="" name="done_'.$thiskey.'"'.$checkedoff.$onclick.$disabled.' />'.
1.558     raeburn  5008:                        &mt('No').'</label>'.('&nbsp;'x2).
1.567     raeburn  5009:                        '<label><input type="radio" value="_done" name="done_'.$thiskey.'"'.$checkedon.$onclick.$disabled.' />'.
1.558     raeburn  5010:                        &mt('Yes').'</label>'.('&nbsp;'x2).
1.567     raeburn  5011:                        '<label><input type="radio" value="_done_proctor" name="done_'.$thiskey.'"'.$checkedproc.$onclick.$disabled.' />'.
1.558     raeburn  5012:                        &mt('Yes, with proctor key').'</label>'.
                   5013:                        '<input type="'.$currprocdisplay.'" id="done_'.$thiskey.'_proctorkey" '.
1.567     raeburn  5014:                        'name="done_'.$thiskey.'_proctorkey" value="'.&HTML::Entities::encode($currproctorkey,'"<>&').'"'.$disabled.' /></span><br />'.
1.559     raeburn  5015:                        '<span class="LC_nobreak">'.&mt('Button text').': '.
1.567     raeburn  5016:                        '<input type="text" name="done_'.$thiskey.'_buttontext" value="'.&HTML::Entities::encode($currdonetext,'"<>&').'"'.$disabled.' /></span>';
1.554     raeburn  5017:         }
                   5018:     }
                   5019:     unless ($readonly) {
                   5020:         $result .= '<input type="hidden" name="dateinterval_'.$thiskey.'" />';
                   5021:     }
                   5022:     return $result;
                   5023: }
                   5024: 
1.563     damieng  5025: # Returns HTML with a warning if a parameter requires a more recent version of LON-CAPA.
                   5026: #
                   5027: # @param {string} $name - parameter name
                   5028: # @param {string} $namematch - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   5029: # @param {string} $value - parameter value
                   5030: # @param {string} $chostname - course server name
                   5031: # @param {integer} $cmajor - major version number
                   5032: # @param {integer} $cminor - minor version number
                   5033: # @param {string} $needsrelease - release version needed (major.minor)
                   5034: # @returns {string}
1.549     raeburn  5035: sub oldversion_warning {
1.557     raeburn  5036:     my ($name,$namematch,$value,$chostname,$cmajor,$cminor,$needsrelease) = @_;
                   5037:     my $standard_name = &standard_parameter_names($name);
                   5038:     if ($namematch) {
                   5039:         my $level = &standard_parameter_levels($namematch);
                   5040:         my $msg = '';
                   5041:         if ($level) {
                   5042:             $msg = &mt('[_1] was [_2]not[_3] set at the level of: [_4].',
                   5043:                        $standard_name,'<b>','</b>','"'.$level.'"');
                   5044:         } else {
                   5045:             $msg = &mt('[_1] was [_2]not[_3] set.',
                   5046:                       $standard_name,'<b>','</b>');
                   5047:         }
                   5048:         return '<p class="LC_warning">'.$msg.'<br />'.
                   5049:                &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5050:                    $cmajor.'.'.$cminor,$chostname,
                   5051:                    $needsrelease).
                   5052:                    '</p>';
                   5053:     }
1.549     raeburn  5054:     my $desc;
                   5055:     my $stringtype = &get_stringtype($name);
                   5056:     if ($stringtype ne '') {
                   5057:         if ($name eq 'examcode') {
                   5058:             $desc = $value;
                   5059:         } elsif (ref($strings{$stringtypes{$name}}) eq 'ARRAY') {
                   5060:             foreach my $possibilities (@{ $strings{$stringtypes{$name}} }) {
                   5061:                 next unless (ref($possibilities) eq 'ARRAY');
                   5062:                 my ($parmval, $description) = @{ $possibilities };
                   5063:                 my $parmmatch;
                   5064:                 if (ref($stringmatches{$stringtypes{$name}}) eq 'ARRAY') {
                   5065:                     foreach my $item (@{$stringmatches{$stringtypes{$name}}}) {
                   5066:                         if (ref($item) eq 'ARRAY') {
                   5067:                             my ($regexpname,$pattern) = @{$item};
                   5068:                             if ($parmval eq $regexpname) {
                   5069:                                 if ($value =~ /$pattern/) {
                   5070:                                     $desc = $description; 
                   5071:                                     $parmmatch = 1;
                   5072:                                     last;
                   5073:                                 }
                   5074:                             }
                   5075:                         }
                   5076:                     }
                   5077:                     last if ($parmmatch);
                   5078:                 } elsif ($parmval eq $value) {
                   5079:                     $desc = $description;
                   5080:                     last;
                   5081:                 }
                   5082:             }
                   5083:         }
                   5084:     } elsif (($name eq 'printstartdate') || ($name eq 'printenddate')) {
                   5085:         my $now = time;
                   5086:         if ($value =~ /^\d+$/) {
                   5087:             if ($name eq 'printstartdate') {
                   5088:                 if ($value > $now) {
                   5089:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5090:                 }
                   5091:             } elsif ($name eq 'printenddate') {
                   5092:                 if ($value < $now) {
                   5093:                     $desc = &Apache::lonlocal::locallocaltime($value);
                   5094:                 }
                   5095:             }
                   5096:         }
                   5097:     }
                   5098:     return '<p class="LC_warning">'.
1.557     raeburn  5099:        &mt('[_1] was [_2]not[_3] set to [_4].',
                   5100:            $standard_name,'<b>','</b>','"'.$desc.'"').'<br />'.
                   5101:        &mt('LON-CAPA version ([_1]) installed on home server ([_2]) does not meet version requirements ([_3] or newer).',
                   5102:        $cmajor.'.'.$cminor,$chostname,
                   5103:        $needsrelease).
                   5104:        '</p>';
1.549     raeburn  5105: }
                   5106: 
1.560     damieng  5107: } # end of block using some constants related to parameter types
                   5108: 
1.549     raeburn  5109: 
1.563     damieng  5110: 
                   5111: # Shifts all start and end dates in the current course by $shift.
1.389     www      5112: #
1.563     damieng  5113: # @param {integer} $shift - time to shift, in seconds
                   5114: # @returns {string} - error name or 'ok'
1.389     www      5115: sub dateshift {
                   5116:     my ($shift)=@_;
                   5117:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5118:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5119:     my %data=&Apache::lonnet::dump('resourcedata',$dom,$crs);
                   5120: # ugly retro fix for broken version of types
1.548     raeburn  5121:     foreach my $key (keys(%data)) {
1.389     www      5122:         if ($key=~/\wtype$/) {
                   5123:             my $newkey=$key;
                   5124:             $newkey=~s/type$/\.type/;
                   5125:             $data{$newkey}=$data{$key};
                   5126:             delete $data{$key};
                   5127:         }
                   5128:     }
1.391     www      5129:     my %storecontent=();
1.389     www      5130: # go through all parameters and look for dates
1.548     raeburn  5131:     foreach my $key (keys(%data)) {
1.389     www      5132:        if ($data{$key.'.type'}=~/^date_(start|end)$/) {
                   5133:           my $newdate=$data{$key}+$shift;
1.391     www      5134:           $storecontent{$key}=$newdate;
1.389     www      5135:        }
                   5136:     }
1.391     www      5137:     my $reply=&Apache::lonnet::cput
                   5138:                 ('resourcedata',\%storecontent,$dom,$crs);
                   5139:     if ($reply eq 'ok') {
                   5140:        &log_parmset(\%storecontent);
                   5141:     }
                   5142:     &Apache::lonnet::devalidatecourseresdata($crs,$dom);
                   5143:     return $reply;
1.389     www      5144: }
                   5145: 
1.563     damieng  5146: # Overview mode UI to edit course parameters.
                   5147: #
                   5148: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5149: sub newoverview {
1.568     raeburn  5150:     my ($r,$parm_permission) = @_;
1.280     albertel 5151: 
1.208     www      5152:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5153:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5154:     my $crstype =  $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5155:     my $readonly = 1;
                   5156:     if ($parm_permission->{'edit'}) {
                   5157:         undef($readonly);
                   5158:     }
1.414     droeschl 5159:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5160:         text=>"Overview Mode"});
1.523     raeburn  5161: 
                   5162:     my %loaditems = (
1.549     raeburn  5163:                       'onload'   => "showHide_courseContent(); resize_scrollbox('mapmenuscroll','1','1'); showHideLenient();",
1.523     raeburn  5164:                     );
                   5165:     my $js = '
                   5166: <script type="text/javascript">
                   5167: // <![CDATA[
                   5168: '.
                   5169:             &Apache::lonhtmlcommon::resize_scrollbox_js('params')."\n".
                   5170:             &showhide_js()."\n".
1.549     raeburn  5171:             &toggleparmtextbox_js()."\n".
                   5172:             &validateparms_js()."\n".
                   5173:             &ipacc_boxes_js()."\n".
1.558     raeburn  5174:             &done_proctor_js()."\n".
1.523     raeburn  5175: '// ]]>
                   5176: </script>
                   5177: ';
1.549     raeburn  5178: 
1.523     raeburn  5179:     my $start_page = &Apache::loncommon::start_page('Set Parameters',$js,
                   5180:                                                     {'add_entries' => \%loaditems,});
1.298     albertel 5181:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5182:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5183:     &startSettingsScreen($r,'parmset',$crstype);
1.208     www      5184:     $r->print(<<ENDOVER);
1.549     raeburn  5185: <form method="post" action="/adm/parmset?action=newoverview" name="parmform" onsubmit="return validateParms();">
1.208     www      5186: ENDOVER
1.211     www      5187:     my @ids=();
                   5188:     my %typep=();
                   5189:     my %keyp=();
                   5190:     my %allparms=();
                   5191:     my %allparts=();
                   5192:     my %allmaps=();
                   5193:     my %mapp=();
                   5194:     my %symbp=();
                   5195:     my %maptitles=();
                   5196:     my %uris=();
                   5197:     my %keyorder=&standardkeyorder();
                   5198:     my %defkeytype=();
                   5199: 
                   5200:     my %alllevs=();
                   5201:     $alllevs{'Resource Level'}='full';
1.215     www      5202:     $alllevs{'Map/Folder Level'}='map';
1.211     www      5203:     $alllevs{'Course Level'}='general';
                   5204: 
                   5205:     my $csec=$env{'form.csec'};
1.269     raeburn  5206:     my $cgroup=$env{'form.cgroup'};
1.211     www      5207: 
                   5208:     my @pscat=&Apache::loncommon::get_env_multiple('form.pscat');
                   5209:     my $pschp=$env{'form.pschp'};
1.506     www      5210: 
1.211     www      5211:     my @psprt=&Apache::loncommon::get_env_multiple('form.psprt');
1.516     www      5212:     if (!@psprt) { $psprt[0]='all'; }
1.211     www      5213: 
1.446     bisitz   5214:     my @selected_sections =
1.473     amueller 5215:     &Apache::loncommon::get_env_multiple('form.Section');
1.211     www      5216:     @selected_sections = ('all') if (! @selected_sections);
1.374     albertel 5217:     foreach my $sec (@selected_sections) {
                   5218:         if ($sec eq 'all') {
1.211     www      5219:             @selected_sections = ('all');
                   5220:         }
                   5221:     }
1.552     raeburn  5222:     if ($env{'request.course.sec'} ne '') {
                   5223:         @selected_sections = ($env{'request.course.sec'});
                   5224:     }
1.269     raeburn  5225:     my @selected_groups =
                   5226:         &Apache::loncommon::get_env_multiple('form.Group');
1.211     www      5227: 
                   5228:     my $pssymb='';
                   5229:     my $parmlev='';
1.446     bisitz   5230: 
1.211     www      5231:     unless ($env{'form.parmlev'}) {
                   5232:         $parmlev = 'map';
                   5233:     } else {
                   5234:         $parmlev = $env{'form.parmlev'};
                   5235:     }
                   5236: 
1.446     bisitz   5237:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 5238:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   5239:                 \%keyorder,\%defkeytype);
1.211     www      5240: 
1.374     albertel 5241:     if (grep {$_ eq 'all'} (@psprt)) {
1.481     amueller 5242:         @psprt = keys(%allparts);
1.374     albertel 5243:     }
1.211     www      5244: # Menu to select levels, etc
                   5245: 
1.456     bisitz   5246:     $r->print('<div class="LC_Box">');
1.445     neumanie 5247:     #$r->print('<h2 class="LC_hcell">Step 1</h2>');
1.452     bisitz   5248:     $r->print('<div>');
1.523     raeburn  5249:     $r->print(&Apache::lonhtmlcommon::start_pick_box(undef,'parmlevel'));
1.211     www      5250:     &levelmenu($r,\%alllevs,$parmlev);
                   5251:     if ($parmlev ne 'general') {
1.447     bisitz   5252:         $r->print(&Apache::lonhtmlcommon::row_closure());
1.483     amueller 5253:         &mapmenu($r,\%allmaps,$pschp,\%maptitles,\%symbp);
1.211     www      5254:     }
1.447     bisitz   5255:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5256:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5257:     $r->print('</div></div>');
1.446     bisitz   5258: 
1.456     bisitz   5259:     $r->print('<div class="LC_Box">');
1.452     bisitz   5260:     $r->print('<div>');
1.581     raeburn  5261:     &displaymenu($r,\%allparms,\@pscat,\%keyorder);
1.453     schualex 5262:     $r->print(&Apache::lonhtmlcommon::start_pick_box());
1.446     bisitz   5263:     $r->print(&Apache::lonhtmlcommon::row_title(&mt('Select Parts to View')));
1.553     raeburn  5264:     my $sectionselector = &sectionmenu(\@selected_sections);
                   5265:     my $groupselector = &groupmenu(\@selected_groups);
1.481     amueller 5266:     $r->print('<table>'.
1.553     raeburn  5267:               '<tr><th>'.&mt('Parts').'</th>');
                   5268:     if ($sectionselector) {
                   5269:         $r->print('<th>'.&mt('Section(s)').'</th>');
                   5270:     }
                   5271:     if ($groupselector) {
                   5272:         $r->print('<th>'.&mt('Group(s)').'</th>');
                   5273:     }
                   5274:     $r->print('</tr><tr><td>');
1.211     www      5275:     &partmenu($r,\%allparts,\@psprt);
1.553     raeburn  5276:     $r->print('</td>');
                   5277:     if ($sectionselector) { 
                   5278:         $r->print('<td>'.$sectionselector.'</td>');
                   5279:     }
                   5280:     if ($groupselector) {
                   5281:         $r->print('<td>'.$groupselector.'</td>');
                   5282:     }
                   5283:     $r->print('</tr></table>');
1.447     bisitz   5284:     $r->print(&Apache::lonhtmlcommon::row_closure(1));
1.445     neumanie 5285:     $r->print(&Apache::lonhtmlcommon::end_pick_box());
                   5286:     $r->print('</div></div>');
                   5287: 
1.456     bisitz   5288:     $r->print('<div class="LC_Box">');
1.452     bisitz   5289:     $r->print('<div>');
1.214     www      5290:     my $sortorder=$env{'form.sortorder'};
                   5291:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5292:     &sortmenu($r,$sortorder);
1.445     neumanie 5293:     $r->print('</div></div>');
1.446     bisitz   5294: 
1.214     www      5295:     $r->print('<p><input type="submit" name="dis" value="'.&mt('Display').'" /></p>');
1.446     bisitz   5296: 
1.211     www      5297: # Build the list data hash from the specified parms
                   5298: 
                   5299:     my $listdata;
                   5300:     %{$listdata}=();
                   5301: 
                   5302:     foreach my $cat (@pscat) {
1.269     raeburn  5303:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_sections,\%defkeytype,\%allmaps,\@ids,\%symbp);
                   5304:         &secgroup_lister($cat,$pschp,$parmlev,$listdata,\@psprt,\@selected_groups,\%defkeytype,\%allmaps,\@ids,\%symbp);
1.211     www      5305:     }
                   5306: 
1.212     www      5307:     if (($env{'form.store'}) || ($env{'form.dis'})) {
1.211     www      5308: 
1.481     amueller 5309:         if ($env{'form.store'}) { &storedata($r,$crs,$dom); }
1.211     www      5310: 
                   5311: # Read modified data
                   5312: 
1.481     amueller 5313:         my $resourcedata=&readdata($crs,$dom);
1.211     www      5314: 
                   5315: # List data
                   5316: 
1.568     raeburn  5317:         &listdata($r,$resourcedata,$listdata,$sortorder,'newoverview',undef,$readonly);
                   5318:     }
                   5319:     $r->print(&tableend());
                   5320:     unless ($readonly) {
                   5321:         $r->print( ((($env{'form.store'}) || ($env{'form.dis'}))?'<p><input type="submit" name="store" value="'.&mt('Save').'" /></p>':'') );
1.211     www      5322:     }
1.568     raeburn  5323:     $r->print('</form>');
1.507     www      5324:     &endSettingsScreen($r);
                   5325:     $r->print(&Apache::loncommon::end_page());
1.208     www      5326: }
                   5327: 
1.563     damieng  5328: # Fills $listdata with parameter information.
                   5329: # Keys use the format course id.[section id].part.name and course id.[section id].part.name.type.
                   5330: # The non-type value is always 1.
                   5331: #
                   5332: # @param {string} $cat - parameter name
1.566     damieng  5333: # @param {string} $pschp - selected map pc, or 'all'
1.563     damieng  5334: # @param {string} $parmlev - selected level value (full|map|general), or ''
                   5335: # @param {hash reference} $listdata - the parameter data that will be modified
                   5336: # @param {array reference} $psprt - selected parts
                   5337: # @param {array reference} $selections - selected sections
                   5338: # @param {hash reference} $defkeytype - hash parameter name -> parameter type
1.566     damieng  5339: # @param {hash reference} $allmaps - hash map pc -> map src
                   5340: # @param {array reference} $ids - resource and map ids
                   5341: # @param {hash reference} $symbp - hash map pc or resource/map id -> map src.'___(all)' or resource symb
1.269     raeburn  5342: sub secgroup_lister {
                   5343:     my ($cat,$pschp,$parmlev,$listdata,$psprt,$selections,$defkeytype,$allmaps,$ids,$symbp) = @_;
                   5344:     foreach my $item (@{$selections}) {
                   5345:         foreach my $part (@{$psprt}) {
                   5346:             my $rootparmkey=$env{'request.course.id'};
                   5347:             if (($item ne 'all') && ($item ne 'none') && ($item)) {
                   5348:                 $rootparmkey.='.['.$item.']';
                   5349:             }
                   5350:             if ($parmlev eq 'general') {
                   5351: # course-level parameter
                   5352:                 my $newparmkey=$rootparmkey.'.'.$part.'.'.$cat;
                   5353:                 $$listdata{$newparmkey}=1;
                   5354:                 $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5355:             } elsif ($parmlev eq 'map') {
                   5356: # map-level parameter
1.548     raeburn  5357:                 foreach my $mapid (keys(%{$allmaps})) {
1.269     raeburn  5358:                     if (($pschp ne 'all') && ($pschp ne $mapid)) { next; }
                   5359:                     my $newparmkey=$rootparmkey.'.'.$$allmaps{$mapid}.'___(all).'.$part.'.'.$cat;
                   5360:                     $$listdata{$newparmkey}=1;
                   5361:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5362:                 }
                   5363:             } else {
                   5364: # resource-level parameter
                   5365:                 foreach my $rid (@{$ids}) {
                   5366:                     my ($map,$resid,$url)=&Apache::lonnet::decode_symb($$symbp{$rid});
                   5367:                     if (($pschp ne 'all') && ($$allmaps{$pschp} ne $map)) { next; }
                   5368:                     my $newparmkey=$rootparmkey.'.'.$$symbp{$rid}.'.'.$part.'.'.$cat;
                   5369:                     $$listdata{$newparmkey}=1;
                   5370:                     $$listdata{$newparmkey.'.type'}=$$defkeytype{$cat};
                   5371:                 }
                   5372:             }
                   5373:         }
                   5374:     }
                   5375: }
                   5376: 
1.563     damieng  5377: # UI to edit parameter settings starting with a list of all existing parameters.
                   5378: # (called by setoverview action)
                   5379: #
                   5380: # @param {Apache2::RequestRec} $r - the Apache request
1.208     www      5381: sub overview {
1.568     raeburn  5382:     my ($r,$parm_permission) = @_;
1.208     www      5383:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5384:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5385:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.568     raeburn  5386:     my $readonly = 1;
                   5387:     if ($parm_permission->{'edit'}) {
                   5388:         undef($readonly);
                   5389:     }
1.549     raeburn  5390:     my $js = '<script type="text/javascript">'."\n".
                   5391:              '// <![CDATA['."\n".
                   5392:              &toggleparmtextbox_js()."\n".
                   5393:              &validateparms_js()."\n".
                   5394:              &ipacc_boxes_js()."\n".
1.558     raeburn  5395:              &done_proctor_js()."\n".
1.549     raeburn  5396:              '// ]]>'."\n".
                   5397:              '</script>'."\n";
1.414     droeschl 5398:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setoverview',
1.473     amueller 5399:     text=>"Overview Mode"});
1.549     raeburn  5400:     my %loaditems = (
                   5401:                       'onload'   => "showHideLenient();",
                   5402:                     );
                   5403: 
                   5404:     my $start_page=&Apache::loncommon::start_page('Modify Parameters',$js,{'add_entries' => \%loaditems,});
1.298     albertel 5405:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Overview');
1.507     www      5406:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5407:     &startSettingsScreen($r,'parmset',$crstype);
1.549     raeburn  5408:     $r->print('<form method="post" action="/adm/parmset?action=setoverview" name="parmform" onsubmit="return validateParms();">');
1.507     www      5409: 
1.208     www      5410: # Store modified
                   5411: 
1.568     raeburn  5412:     unless ($readonly) {
                   5413:         &storedata($r,$crs,$dom);
                   5414:     }
1.208     www      5415: 
                   5416: # Read modified data
                   5417: 
1.552     raeburn  5418:     my ($resourcedata,$classlist)=&readdata($crs,$dom);
1.208     www      5419: 
1.214     www      5420: 
                   5421:     my $sortorder=$env{'form.sortorder'};
                   5422:     unless ($sortorder) { $sortorder='realmstudent'; }
                   5423:     &sortmenu($r,$sortorder);
                   5424: 
1.568     raeburn  5425:     my $submitbutton = '<input type="submit" value="'.&mt('Save').'" />';
                   5426: 
                   5427:     if ($readonly) {
                   5428:         $r->print('<p>'.$submitbutton.'</p>');
                   5429:     }
                   5430: 
1.208     www      5431: # List data
                   5432: 
1.568     raeburn  5433:     my $foundkeys=&listdata($r,$resourcedata,$resourcedata,$sortorder,'overview',$classlist,$readonly);
                   5434:     $r->print(&tableend().'<p>');
                   5435:     if ($foundkeys) {
                   5436:         unless ($readonly) {
                   5437:             $r->print('<p>'.$submitbutton.'</p>');
                   5438:         }
                   5439:     } else {
                   5440:         $r->print('<p class="LC_info">'.&mt('There are no parameters.').'</p>');
                   5441:     }
                   5442:     $r->print('</form>'.&Apache::loncommon::end_page());
1.120     www      5443: }
1.121     www      5444: 
1.560     damieng  5445: # Unused sub.
1.563     damieng  5446: #
                   5447: # @param {Apache2::RequestRec} $r - the Apache request
1.333     albertel 5448: sub clean_parameters {
                   5449:     my ($r) = @_;
                   5450:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5451:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5452: 
1.414     droeschl 5453:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=cleanparameters',
1.473     amueller 5454:         text=>"Clean Parameters"});
1.333     albertel 5455:     my $start_page=&Apache::loncommon::start_page('Clean Parameters');
                   5456:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Clean');
                   5457:     $r->print(<<ENDOVER);
                   5458: $start_page
                   5459: $breadcrumbs
                   5460: <form method="post" action="/adm/parmset?action=cleanparameters" name="parmform">
                   5461: ENDOVER
                   5462: # Store modified
                   5463: 
                   5464:     &storedata($r,$crs,$dom);
                   5465: 
                   5466: # Read modified data
                   5467: 
                   5468:     my $resourcedata=&readdata($crs,$dom);
                   5469: 
                   5470: # List data
                   5471: 
                   5472:     $r->print('<h3>'.
1.473     amueller 5473:           &mt('These parameters refer to resources that do not exist.').
                   5474:           '</h3>'.
                   5475:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.'<br />'.
                   5476:           '<br />');
1.333     albertel 5477:     $r->print(&Apache::loncommon::start_data_table().
1.473     amueller 5478:           '<tr>'.
                   5479:           '<th>'.&mt('Delete').'</th>'.
                   5480:           '<th>'.&mt('Parameter').'</th>'.
                   5481:           '</tr>');
1.333     albertel 5482:     foreach my $thiskey (sort(keys(%{$resourcedata}))) {
1.560     damieng  5483:         next if (!exists($resourcedata->{$thiskey.'.type'})
                   5484:             && $thiskey=~/\.type$/);
                   5485:         my %data = &parse_key($thiskey);
                   5486:         if (1) { #exists($data{'realm_exists'})
                   5487:             #&& !$data{'realm_exists'}) {
                   5488:             $r->print(&Apache::loncommon::start_data_table_row().
                   5489:                 '<tr>'.
                   5490:                 '<td><input type="checkbox" name="del_'.$thiskey.'" /></td>'              );
                   5491: 
                   5492:             $r->print('<td>');
                   5493:             my $display_value = $resourcedata->{$thiskey};
                   5494:             if (&isdateparm($resourcedata->{$thiskey.'.type'})) {
                   5495:             $display_value =
                   5496:                 &Apache::lonlocal::locallocaltime($display_value);
                   5497:             }
1.470     raeburn  5498:             my $parmitem = &standard_parameter_names($data{'parameter_name'});
                   5499:             $parmitem = &mt($parmitem);
1.560     damieng  5500:             $r->print(&mt('Parameter: "[_1]" with value: "[_2]"',
                   5501:                 $parmitem,$resourcedata->{$thiskey}));
                   5502:             $r->print('<br />');
                   5503:             if ($data{'scope_type'} eq 'all') {
                   5504:                 $r->print(&mt('All users'));
                   5505:             } elsif ($data{'scope_type'} eq 'user') {
                   5506:                 $r->print(&mt('User: [_1]',join(':',@{$data{'scope'}})));
1.581     raeburn  5507:             } elsif ($data{'scope_type'} eq 'secgroup') {
                   5508:                 $r->print(&mt('Group/Section: [_1]',$data{'scope'}));
1.560     damieng  5509:             }
                   5510:             $r->print('<br />');
                   5511:             if ($data{'realm_type'} eq 'all') {
                   5512:                 $r->print(&mt('All Resources'));
                   5513:             } elsif ($data{'realm_type'} eq 'folder') {
                   5514:                 $r->print(&mt('Folder: [_1]'),$data{'realm'});
                   5515:             } elsif ($data{'realm_type'} eq 'symb') {
                   5516:             my ($map,$resid,$url) =
                   5517:                 &Apache::lonnet::decode_symb($data{'realm'});
                   5518:             $r->print(&mt('Resource: [_1]with ID: [_2]in folder [_3]',
                   5519:                         $url.' <br />&nbsp;&nbsp;&nbsp;',
                   5520:                         $resid.' <br />&nbsp;&nbsp;&nbsp;',$map));
                   5521:             }
                   5522:             $r->print(' <br />&nbsp;&nbsp;&nbsp;'.&mt('Part: [_1]',$data{'parameter_part'}));
                   5523:             $r->print('</td></tr>');
                   5524: 
1.473     amueller 5525:         }
1.333     albertel 5526:     }
                   5527:     $r->print(&Apache::loncommon::end_data_table().'<p>'.
1.473     amueller 5528:           '<input type="submit" value="'.&mt('Delete Selected').'" />'.
1.507     www      5529:           '</p></form>');
                   5530:     &endSettingsScreen($r);
                   5531:     $r->print(&Apache::loncommon::end_page());
1.333     albertel 5532: }
                   5533: 
1.563     damieng  5534: # UI to shift all dates (called by dateshift1 action).
                   5535: # Used by overview mode.
                   5536: #
                   5537: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5538: sub date_shift_one {
                   5539:     my ($r) = @_;
                   5540:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5541:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5542:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.390     www      5543: 
1.414     droeschl 5544:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5545:         text=>"Shifting Dates"});
1.390     www      5546:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5547:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5548:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5549:     &startSettingsScreen($r,'parmset',$crstype);
1.538     bisitz   5550:     $r->print('<form name="shiftform" method="post" action="">'.
1.390     www      5551:               '<table><tr><td>'.&mt('Currently set date:').'</td><td>'.
                   5552:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}).'</td></tr>'.
                   5553:               '<tr><td>'.&mt('Shifted date:').'</td><td>'.
1.541     bisitz   5554:                     &Apache::lonhtmlcommon::date_setter('shiftform',
1.390     www      5555:                                                         'timeshifted',
                   5556:                                                         $env{'form.timebase'},,
                   5557:                                                         '').
                   5558:               '</td></tr></table>'.
                   5559:               '<input type="hidden" name="action" value="dateshift2" />'.
                   5560:               '<input type="hidden" name="timebase" value="'.$env{'form.timebase'}.'" />'.
                   5561:               '<input type="submit" value="'.&mt('Shift all dates accordingly').'" /></form>');
1.507     www      5562:     &endSettingsScreen($r);
1.390     www      5563:     $r->print(&Apache::loncommon::end_page());
                   5564: }
                   5565: 
1.563     damieng  5566: # UI to shift all dates (second form).
                   5567: #
                   5568: # @param {Apache2::RequestRec} $r - the Apache request
1.390     www      5569: sub date_shift_two {
                   5570:     my ($r) = @_;
                   5571:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5572:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5573:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 5574:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=dateshift1&timebase='.$env{'form.timebase'},
1.473     amueller 5575:         text=>"Shifting Dates"});
1.390     www      5576:     my $start_page=&Apache::loncommon::start_page('Shift Dates');
                   5577:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Shift');
1.507     www      5578:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  5579:     &startSettingsScreen($r,'parmset',$crstype);
1.390     www      5580:     my $timeshifted=&Apache::lonhtmlcommon::get_date_from_form('timeshifted');
1.543     bisitz   5581:     $r->print('<h2>'.&mt('Shift Dates').'</h2>'.
                   5582:               '<p>'.&mt('Shifting all dates such that [_1] becomes [_2]',
1.390     www      5583:               &Apache::lonlocal::locallocaltime($env{'form.timebase'}),
1.543     bisitz   5584:               &Apache::lonlocal::locallocaltime($timeshifted)).'</p>');
1.390     www      5585:     my $delta=$timeshifted-$env{'form.timebase'};
                   5586:     &dateshift($delta);
1.543     bisitz   5587:     $r->print(
                   5588:         &Apache::lonhtmlcommon::confirm_success(&mt('Done')).
                   5589:         '<br /><br />'.
                   5590:         &Apache::lonhtmlcommon::actionbox(
                   5591:             ['<a href="/adm/parmset">'.&mt('Content and Problem Settings').'</a>']));
1.507     www      5592:     &endSettingsScreen($r);
1.390     www      5593:     $r->print(&Apache::loncommon::end_page());
                   5594: }
                   5595: 
1.563     damieng  5596: # Returns the different components of a resourcedata key.
                   5597: # Keys: scope_type, scope, realm_type, realm, realm_title,
                   5598: #       realm_exists, parameter_part, parameter_name.
                   5599: # Was used by clean_parameters (which is unused).
                   5600: #
                   5601: # @param {string} $key - the parameter key
                   5602: # @returns {hash}
1.333     albertel 5603: sub parse_key {
                   5604:     my ($key) = @_;
                   5605:     my %data;
                   5606:     my ($middle,$part,$name)=
1.572     damieng  5607:     ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.333     albertel 5608:     $data{'scope_type'} = 'all';
                   5609:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  5610:         $data{'scope'} = $1;
                   5611:         if ($data{'scope'}=~/^useropt\:($match_username)\:($match_domain)/) {
                   5612:             $data{'scope_type'} = 'user';
                   5613:             $data{'scope'} = [$1,$2];
                   5614:         } else {
1.581     raeburn  5615:             $data{'scope_type'} = 'secgroup';
1.560     damieng  5616:         }
                   5617:         $middle=~s/^\[(.*)\]//;
1.333     albertel 5618:     }
                   5619:     $middle=~s/\.+$//;
                   5620:     $middle=~s/^\.+//;
                   5621:     $data{'realm_type'}='all';
                   5622:     if ($middle=~/^(.+)\_\_\_\(all\)$/) {
1.560     damieng  5623:         $data{'realm'} = $1;
                   5624:         $data{'realm_type'} = 'folder';
                   5625:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5626:         ($data{'realm_exists'}) = &Apache::lonnet::is_on_map($data{'realm'});
1.333     albertel 5627:     } elsif ($middle) {
1.560     damieng  5628:         $data{'realm'} = $middle;
                   5629:         $data{'realm_type'} = 'symb';
                   5630:         $data{'realm_title'} = &Apache::lonnet::gettitle($data{'realm'});
                   5631:         my ($map,$resid,$url) = &Apache::lonnet::decode_symb($data{'realm'});
                   5632:         $data{'realm_exists'} = &Apache::lonnet::symbverify($data{'realm'},$url);
1.333     albertel 5633:     }
1.446     bisitz   5634: 
1.333     albertel 5635:     $data{'parameter_part'} = $part;
                   5636:     $data{'parameter_name'} = $name;
                   5637: 
                   5638:     return %data;
                   5639: }
                   5640: 
1.239     raeburn  5641: 
1.563     damieng  5642: # Calls loncommon::start_page with the "Settings" title.
1.416     jms      5643: sub header {
1.507     www      5644:     return &Apache::loncommon::start_page('Settings');
1.416     jms      5645: }
1.193     albertel 5646: 
                   5647: 
                   5648: 
1.560     damieng  5649: ##################################################
                   5650: # MAIN MENU
                   5651: ##################################################
                   5652: 
1.563     damieng  5653: # Content and problem settings main menu.
                   5654: #
                   5655: # @param {Apache2::RequestRec} $r - the Apache request
                   5656: # @param {boolean} $parm_permission - true if the user has permission to edit the current course or section
1.193     albertel 5657: sub print_main_menu {
                   5658:     my ($r,$parm_permission)=@_;
                   5659:     #
1.414     droeschl 5660:     $r->print(&header());
1.507     www      5661:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Content and Problem Settings'));
1.531     raeburn  5662:     my $crstype = &Apache::loncommon::course_type();
                   5663:     my $lc_crstype = lc($crstype);
                   5664: 
                   5665:     &startSettingsScreen($r,'parmset',$crstype);
1.193     albertel 5666:     $r->print(<<ENDMAINFORMHEAD);
                   5667: <form method="post" enctype="multipart/form-data"
                   5668:       action="/adm/parmset" name="studentform">
                   5669: ENDMAINFORMHEAD
                   5670: #
1.195     albertel 5671:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   5672:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
1.268     albertel 5673:     my $vgr  = &Apache::lonnet::allowed('vgr',$env{'request.course.id'});
1.366     albertel 5674:     my $mgr  = &Apache::lonnet::allowed('mgr',$env{'request.course.id'});
1.520     raeburn  5675:     my $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'});
1.568     raeburn  5676:     my $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'});
                   5677:     my $vpa = &Apache::lonnet::allowed('vpa',$env{'request.course.id'});
1.520     raeburn  5678:     if ((!$dcm) && ($env{'request.course.sec'} ne '')) {
                   5679:         $dcm = &Apache::lonnet::allowed('dcm',$env{'request.course.id'}.
                   5680:                                         '/'.$env{'request.course.sec'});
                   5681:     }
1.568     raeburn  5682:     if ((!$vcb) && ($env{'request.course.sec'} ne '')) {
                   5683:         $vcb = &Apache::lonnet::allowed('vcb',$env{'request.course.id'}.
                   5684:                                         '/'.$env{'request.course.sec'});
                   5685:     }
                   5686:     my (%linktext,%linktitle,%url);
                   5687:     if ($parm_permission->{'edit'}) {
                   5688:         %linktext = (
                   5689:                      newoverview     => 'Edit Resource Parameters - Overview Mode',
                   5690:                      settable        => 'Edit Resource Parameters - Table Mode',
                   5691:                      setoverview     => 'Modify Resource Parameters - Overview Mode',
                   5692:                     );
                   5693:         %linktitle = (
                   5694:                      newoverview     => 'Set/Modify resource parameters in overview mode.',
                   5695:                      settable        => 'Set/Modify resource parameters in table mode.',
                   5696:                      setoverview     => 'Set/Modify existing resource parameters in overview mode.',
                   5697:                      );
                   5698:     } else {
                   5699:         %linktext = (
                   5700:                      newoverview     => 'View Resource Parameters - Overview Mode',
                   5701:                      settable        => 'View Resource Parameters - Table Mode',
                   5702:                      setoverview     => 'View Resource Parameters - Overview Mode',
                   5703:                    );
                   5704:         %linktitle = (
                   5705:                      newoverview     => 'Display resource parameters in overview mode.',
                   5706:                      settable        => 'Display resource parameters in table mode.',
                   5707:                      setoverview     => 'Display existing resource parameters in overview mode.',
                   5708:                      );
                   5709:     }
                   5710:     if ($mgr) {
                   5711:         $linktext{'resettimes'} = 'Reset Student Access Times';
                   5712:         $linktitle{'resettimes'} = "Reset access times for folders/maps, resources or the $lc_crstype.";
                   5713:         $url{'resettimes'} = '/adm/helper/resettimes.helper';
                   5714:     } elsif ($vgr) {
                   5715:         $linktext{'resettimes'} = 'Display Student Access Times',
                   5716:         $linktitle{'resettimes'} = "Display access times for folders/maps, resources or the $lc_crstype.",
                   5717:         $url{'resettimes'} = '/adm/accesstimes';
                   5718:     }
1.193     albertel 5719:     my @menu =
1.507     www      5720:         ( { categorytitle=>"Content Settings for this $crstype",
1.473     amueller 5721:         items => [
                   5722:           { linktext => 'Portfolio Metadata',
                   5723:             url => '/adm/parmset?action=setrestrictmeta',
1.568     raeburn  5724:             permission => $parm_permission->{'setrestrictmeta'},
1.477     raeburn  5725:             linktitle => "Restrict metadata for this $lc_crstype." ,
1.473     amueller 5726:             icon =>'contact-new.png'   ,
                   5727:             },
1.568     raeburn  5728:           { linktext => $linktext{'resettimes'},
                   5729:             url => $url{'resettimes'},
                   5730:             permission => ($vgr || $mgr),
                   5731:             linktitle => $linktitle{'resettimes'},
                   5732:             icon => 'start-here.png',
1.473     amueller 5733:             },
1.520     raeburn  5734:           { linktext => 'Blocking Communication/Resource Access',
                   5735:             url => '/adm/setblock',
1.568     raeburn  5736:             permission => ($vcb || $dcm),
1.520     raeburn  5737:             linktitle => 'Configure blocking of communication/collaboration and access to resources during an exam',
                   5738:             icon => 'comblock.png',
                   5739:             },
1.473     amueller 5740:           { linktext => 'Set Parameter Setting Default Actions',
                   5741:             url => '/adm/parmset?action=setdefaults',
1.568     raeburn  5742:             permission => $parm_permission->{'setdefaults'},
1.473     amueller 5743:             linktitle =>'Set default actions for parameters.'  ,
                   5744:             icon => 'folder-new.png'  ,
                   5745:             }]},
                   5746:       { categorytitle => 'New and Existing Parameter Settings for Resources',
                   5747:         items => [
                   5748:           { linktext => 'Edit Resource Parameters - Helper Mode',
                   5749:             url => '/adm/helper/parameter.helper',
1.568     raeburn  5750:             permission => $parm_permission->{'helper'},
1.473     amueller 5751:             linktitle =>'Set/Modify resource parameters in helper mode.'  ,
                   5752:             icon => 'dialog-information.png'  ,
                   5753:             #help => 'Parameter_Helper',
                   5754:             },
1.568     raeburn  5755:           { linktext => $linktext{'newoverview'},
1.473     amueller 5756:             url => '/adm/parmset?action=newoverview',
1.568     raeburn  5757:             permission => $parm_permission->{'newoverview'},
                   5758:             linktitle => $linktitle{'newoverview'},
                   5759:             icon => 'edit-find.png',
1.473     amueller 5760:             #help => 'Parameter_Overview',
                   5761:             },
1.568     raeburn  5762:           { linktext => $linktext{'settable'},
1.473     amueller 5763:             url => '/adm/parmset?action=settable',
1.568     raeburn  5764:             permission => $parm_permission->{'settable'},
                   5765:             linktitle => $linktitle{'settable'},
                   5766:             icon => 'edit-copy.png',
1.473     amueller 5767:             #help => 'Table_Mode',
                   5768:             }]},
1.417     droeschl 5769:            { categorytitle => 'Existing Parameter Settings for Resources',
1.473     amueller 5770:          items => [
1.570     raeburn  5771:           { linktext => $linktext{'setoverview'},
1.473     amueller 5772:             url => '/adm/parmset?action=setoverview',
1.568     raeburn  5773:             permission => $parm_permission->{'setoverview'},
                   5774:             linktitle => $linktitle{'setoverview'},
                   5775:             icon => 'preferences-desktop-wallpaper.png',
1.473     amueller 5776:             #help => 'Parameter_Overview',
                   5777:             },
                   5778:           { linktext => 'Change Log',
                   5779:             url => '/adm/parmset?action=parameterchangelog',
1.568     raeburn  5780:             permission => $parm_permission->{'parameterchangelog'},
1.477     raeburn  5781:             linktitle =>"View parameter and $lc_crstype blog posting/user notification change log."  ,
1.487     wenzelju 5782:             icon => 'document-properties.png',
1.473     amueller 5783:             }]}
1.193     albertel 5784:           );
1.414     droeschl 5785:     $r->print(&Apache::lonhtmlcommon::generate_menu(@menu));
1.539     raeburn  5786:     $r->print('</form>');
1.507     www      5787:     &endSettingsScreen($r);
1.539     raeburn  5788:     $r->print(&Apache::loncommon::end_page());
1.193     albertel 5789:     return;
                   5790: }
1.414     droeschl 5791: 
1.416     jms      5792: 
                   5793: 
1.560     damieng  5794: ##################################################
                   5795: # PORTFOLIO METADATA
                   5796: ##################################################
                   5797: 
1.563     damieng  5798: # Prints HTML to edit an item of portfolio metadata. The HTML contains several td elements (no tr).
                   5799: # It looks like field titles are not localized.
                   5800: #
                   5801: # @param {Apache2::RequestRec} $r - the Apache request
                   5802: # @param {string} $field_name - metadata field name
                   5803: # @param {string} $field_text - metadata field title, in English unless manually added
                   5804: # @param {boolean} $added_flag - true if the field was manually added
1.252     banghart 5805: sub output_row {
1.347     banghart 5806:     my ($r, $field_name, $field_text, $added_flag) = @_;
1.252     banghart 5807:     my $output;
1.263     banghart 5808:     my $options=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'};
                   5809:     my $values=$env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.values'};
1.337     banghart 5810:     if (!defined($options)) {
1.254     banghart 5811:         $options = 'active,stuadd';
1.261     banghart 5812:         $values = '';
1.252     banghart 5813:     }
1.337     banghart 5814:     if (!($options =~ /deleted/)) {
                   5815:         my @options= ( ['active', 'Show to student'],
1.418     schafran 5816:                     ['stuadd', 'Provide text area for students to type metadata'],
1.351     banghart 5817:                     ['choices','Provide choices for students to select from']);
1.473     amueller 5818: #           ['onlyone','Student may select only one choice']);
1.337     banghart 5819:         if ($added_flag) {
                   5820:             push @options,['deleted', 'Delete Metadata Field'];
                   5821:         }
1.351     banghart 5822:        $output = &Apache::loncommon::start_data_table_row();
1.451     bisitz   5823:         $output .= '<td><strong>'.$field_text.':</strong></td>';
1.351     banghart 5824:         $output .= &Apache::loncommon::end_data_table_row();
1.337     banghart 5825:         foreach my $opt (@options) {
1.560     damieng  5826:             my $checked = ($options =~ m/$opt->[0]/) ? ' checked="checked" ' : '' ;
                   5827:             $output .= &Apache::loncommon::continue_data_table_row();
                   5828:             $output .= '<td>'.('&nbsp;' x 5).'<label>
                   5829:                     <input type="checkbox" name="'.
                   5830:                     $field_name.'_'.$opt->[0].'" value="yes"'.$checked.' />'.
                   5831:                     &mt($opt->[1]).'</label></td>';
                   5832:             $output .= &Apache::loncommon::end_data_table_row();
                   5833:         }
1.351     banghart 5834:         $output .= &Apache::loncommon::continue_data_table_row();
1.451     bisitz   5835:         $output .= '<td>'.('&nbsp;' x 10).'<input name="'.$field_name.'_values" type="text" value="'.$values.'" size="80" /></td>';
1.351     banghart 5836:         $output .= &Apache::loncommon::end_data_table_row();
                   5837:         my $multiple_checked;
                   5838:         my $single_checked;
                   5839:         if ($options =~ m/onlyone/) {
1.422     bisitz   5840:             $multiple_checked = '';
1.423     bisitz   5841:             $single_checked = ' checked="checked"';
1.351     banghart 5842:         } else {
1.423     bisitz   5843:             $multiple_checked = ' checked="checked"';
1.422     bisitz   5844:             $single_checked = '';
1.351     banghart 5845:         }
1.560     damieng  5846:         $output .= &Apache::loncommon::continue_data_table_row();
                   5847:         $output .= '<td>'.('&nbsp;' x 10).'
                   5848:                     <input type="radio" name="'.$field_name.'_onlyone" value="multiple"'.$multiple_checked .' />
                   5849:                     '.&mt('Student may select multiple choices from list').'</td>';
                   5850:         $output .= &Apache::loncommon::end_data_table_row();
                   5851:         $output .= &Apache::loncommon::continue_data_table_row();
                   5852:         $output .= '<td>'.('&nbsp;' x 10).'
                   5853:                     <input type="radio" name="'.$field_name.'_onlyone"  value="single"'.$single_checked.' />
                   5854:                     '.&mt('Student may select only one choice from list').'</td>';
                   5855:         $output .= &Apache::loncommon::end_data_table_row();
1.252     banghart 5856:     }
                   5857:     return ($output);
                   5858: }
1.416     jms      5859: 
                   5860: 
1.560     damieng  5861: # UI to order portfolio metadata fields.
1.563     damieng  5862: # Currently useless because addmetafield does not work.
                   5863: #
                   5864: # @param {Apache2::RequestRec} $r - the Apache request
1.340     banghart 5865: sub order_meta_fields {
                   5866:     my ($r)=@_;
                   5867:     my $idx = 1;
                   5868:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5869:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5870:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};;
1.341     banghart 5871:     $r->print(&Apache::loncommon::start_page('Order Metadata Fields'));
1.560     damieng  5872:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5873:         {href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5874:         text=>"Add Metadata Field"});
1.560     damieng  5875:     &Apache::lonhtmlcommon::add_breadcrumb(
                   5876:         {href=>"/adm/parmset?action=setrestrictmeta",
                   5877:         text=>"Restrict Metadata"},
                   5878:         {text=>"Order Metadata"});
1.345     banghart 5879:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Order Metadata'));
1.531     raeburn  5880:     &startSettingsScreen($r,'parmset',$crstype);
1.340     banghart 5881:     if ($env{'form.storeorder'}) {
                   5882:         my $newpos = $env{'form.newpos'} - 1;
                   5883:         my $currentpos = $env{'form.currentpos'} - 1;
                   5884:         my @neworder = ();
1.548     raeburn  5885:         my @oldorder = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5886:         my $i;
1.341     banghart 5887:         if ($newpos > $currentpos) {
1.340     banghart 5888:         # moving stuff up
                   5889:             for ($i=0;$i<$currentpos;$i++) {
1.560     damieng  5890:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5891:             }
                   5892:             for ($i=$currentpos;$i<$newpos;$i++) {
1.560     damieng  5893:                 $neworder[$i]=$oldorder[$i+1];
1.340     banghart 5894:             }
                   5895:             $neworder[$newpos]=$oldorder[$currentpos];
                   5896:             for ($i=$newpos+1;$i<=$#oldorder;$i++) {
1.560     damieng  5897:                 $neworder[$i]=$oldorder[$i];
1.340     banghart 5898:             }
                   5899:         } else {
                   5900:         # moving stuff down
1.473     amueller 5901:             for ($i=0;$i<$newpos;$i++) {
                   5902:                 $neworder[$i]=$oldorder[$i];
                   5903:             }
                   5904:             $neworder[$newpos]=$oldorder[$currentpos];
                   5905:             for ($i=$newpos+1;$i<$currentpos+1;$i++) {
                   5906:                 $neworder[$i]=$oldorder[$i-1];
                   5907:             }
                   5908:             for ($i=$currentpos+1;$i<=$#oldorder;$i++) {
                   5909:                 $neworder[$i]=$oldorder[$i];
                   5910:             }
1.340     banghart 5911:         }
1.560     damieng  5912:         my $ordered_fields = join ",", @neworder;
1.343     banghart 5913:         my $put_result = &Apache::lonnet::put('environment',
1.560     damieng  5914:                         {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5915:         &Apache::lonnet::appenv({'course.'.$env{'request.course.id'}.'.metadata.addedorder' => $ordered_fields});
1.340     banghart 5916:     }
1.357     raeburn  5917:     my $fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.341     banghart 5918:     my $ordered_fields;
1.548     raeburn  5919:     my @fields_in_order = split(/,/,$env{'course.'.$env{'request.course.id'}.'.metadata.addedorder'});
1.340     banghart 5920:     if (!@fields_in_order) {
                   5921:         # no order found, pick sorted order then create metadata.addedorder key.
1.548     raeburn  5922:         foreach my $key (sort(keys(%$fields))) {
1.340     banghart 5923:             push @fields_in_order, $key;
1.341     banghart 5924:             $ordered_fields = join ",", @fields_in_order;
1.340     banghart 5925:         }
1.341     banghart 5926:         my $put_result = &Apache::lonnet::put('environment',
1.446     bisitz   5927:                             {'metadata.addedorder'=>$ordered_fields},$dom,$crs);
                   5928:     }
1.340     banghart 5929:     $r->print('<table>');
                   5930:     my $num_fields = scalar(@fields_in_order);
                   5931:     foreach my $key (@fields_in_order) {
                   5932:         $r->print('<tr><td>');
                   5933:         $r->print('<form method="post" action="">');
1.537     bisitz   5934:         $r->print('<select name="newpos" onchange="this.form.submit()">');
1.340     banghart 5935:         for (my $i = 1;$i le $num_fields;$i ++) {
                   5936:             if ($i eq $idx) {
                   5937:                 $r->print('<option value="'.$i.'"  SELECTED>('.$i.')</option>');
                   5938:             } else {
                   5939:                 $r->print('<option value="'.$i.'">'.$i.'</option>');
                   5940:             }
                   5941:         }
                   5942:         $r->print('</select></td><td>');
                   5943:         $r->print('<input type="hidden" name="currentpos" value="'.$idx.'" />');
                   5944:         $r->print('<input type="hidden" name="storeorder" value="true" />');
                   5945:         $r->print('</form>');
                   5946:         $r->print($$fields{$key}.'</td></tr>');
                   5947:         $idx ++;
                   5948:     }
                   5949:     $r->print('</table>');
1.507     www      5950:     &endSettingsScreen($r);
1.340     banghart 5951:     return 'ok';
                   5952: }
1.416     jms      5953: 
                   5954: 
1.563     damieng  5955: # Returns HTML with a Continue button redirecting to the initial portfolio metadata screen.
                   5956: # @returns {string}
1.359     banghart 5957: sub continue {
                   5958:     my $output;
                   5959:     $output .= '<form action="" method="post">';
                   5960:     $output .= '<input type="hidden" name="action" value="setrestrictmeta" />';
                   5961:     $output .= '<input type="submit" value="Continue" />';
                   5962:     return ($output);
                   5963: }
1.416     jms      5964: 
                   5965: 
1.563     damieng  5966: # UI to add a metadata field.
                   5967: # Currenly does not work because of an HTML error (the field is not visible).
                   5968: #
                   5969: # @param {Apache2::RequestRec} $r - the Apache request
1.334     banghart 5970: sub addmetafield {
                   5971:     my ($r)=@_;
1.414     droeschl 5972:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=addmetadata',
1.473     amueller 5973:         text=>"Add Metadata Field"});
1.334     banghart 5974:     $r->print(&Apache::loncommon::start_page('Add Metadata Field'));
                   5975:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Add Metadata Field'));
1.335     banghart 5976:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   5977:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  5978:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   5979:     &startSettingsScreen($r,'parmset',$crstype);
1.339     banghart 5980:     if (exists($env{'form.undelete'})) {
1.358     banghart 5981:         my @meta_fields = &Apache::loncommon::get_env_multiple('form.undeletefield');
1.339     banghart 5982:         foreach my $meta_field(@meta_fields) {
                   5983:             my $options = $env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.options'};
                   5984:             $options =~ s/deleted//;
                   5985:             $options =~ s/,,/,/;
                   5986:             my $put_result = &Apache::lonnet::put('environment',
                   5987:                                         {'metadata.'.$meta_field.'.options'=>$options},$dom,$crs);
1.446     bisitz   5988: 
1.339     banghart 5989:             $r->print('Undeleted Metadata Field <strong>'.$env{'course.'.$env{'request.course.id'}.'.metadata.'.$meta_field.'.added'}."</strong> with result ".$put_result.'<br />');
                   5990:         }
1.359     banghart 5991:         $r->print(&continue());
1.339     banghart 5992:     } elsif (exists($env{'form.fieldname'})) {
1.335     banghart 5993:         my $meta_field = $env{'form.fieldname'};
                   5994:         my $display_field = $env{'form.fieldname'};
                   5995:         $meta_field =~ s/\W/_/g;
1.338     banghart 5996:         $meta_field =~ tr/A-Z/a-z/;
1.335     banghart 5997:         my $put_result = &Apache::lonnet::put('environment',
                   5998:                             {'metadata.'.$meta_field.'.values'=>"",
                   5999:                              'metadata.'.$meta_field.'.added'=>"$display_field",
                   6000:                              'metadata.'.$meta_field.'.options'=>""},$dom,$crs);
1.359     banghart 6001:         $r->print('Added new Metadata Field <strong>'.$env{'form.fieldname'}."</strong> with result ".$put_result.'<br />');
                   6002:         $r->print(&continue());
1.335     banghart 6003:     } else {
1.357     raeburn  6004:         my $fields = &get_deleted_meta_fieldnames($env{'request.course.id'});
1.339     banghart 6005:         if ($fields) {
                   6006:             $r->print('You may undelete previously deleted fields.<br />Check those you wish to undelete and click Undelete.<br />');
                   6007:             $r->print('<form method="post" action="">');
                   6008:             foreach my $key(keys(%$fields)) {
1.581     raeburn  6009:                 $r->print('<label><input type="checkbox" name="undeletefield" value="'.$key.'" />'.$$fields{$key}.'</label><br /');
1.339     banghart 6010:             }
                   6011:             $r->print('<input type="submit" name="undelete" value="Undelete" />');
                   6012:             $r->print('</form>');
                   6013:         }
1.581     raeburn  6014:         $r->print('<hr /><strong>Or</strong> you may enter a new metadata field name.'.
                   6015:                   '<form method="post" action="/adm/parmset?action=addmetadata">');
1.335     banghart 6016:         $r->print('<input type="text" name="fieldname" /><br />');
                   6017:         $r->print('<input type="submit" value="Add Metadata Field" />');
1.581     raeburn  6018:         $r->print('</form>');
1.334     banghart 6019:     }
1.507     www      6020:     &endSettingsScreen($r);
1.334     banghart 6021: }
1.416     jms      6022: 
                   6023: 
                   6024: 
1.560     damieng  6025: # Display or save portfolio metadata.
1.563     damieng  6026: #
                   6027: # @param {Apache2::RequestRec} $r - the Apache request
1.259     banghart 6028: sub setrestrictmeta {
1.240     banghart 6029:     my ($r)=@_;
1.242     banghart 6030:     my $next_meta;
1.244     banghart 6031:     my $output;
1.245     banghart 6032:     my $item_num;
1.246     banghart 6033:     my $put_result;
1.414     droeschl 6034:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setrestrictmeta',
1.473     amueller 6035:         text=>"Restrict Metadata"});
1.280     albertel 6036:     $r->print(&Apache::loncommon::start_page('Restrict Metadata'));
1.298     albertel 6037:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Restrict Metadata'));
1.240     banghart 6038:     my $dom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6039:     my $crs = $env{'course.'.$env{'request.course.id'}.'.num'};
1.531     raeburn  6040:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
                   6041:     &startSettingsScreen($r,'parmset',$crstype);
1.259     banghart 6042:     my $key_base = $env{'course.'.$env{'request.course.id'}.'.'};
1.252     banghart 6043:     my $save_field = '';
1.259     banghart 6044:     if ($env{'form.restrictmeta'}) {
1.254     banghart 6045:         foreach my $field (sort(keys(%env))) {
1.252     banghart 6046:             if ($field=~m/^form.(.+)_(.+)$/) {
1.254     banghart 6047:                 my $options;
1.252     banghart 6048:                 my $meta_field = $1;
                   6049:                 my $meta_key = $2;
1.253     banghart 6050:                 if ($save_field ne $meta_field) {
1.252     banghart 6051:                     $save_field = $meta_field;
1.473     amueller 6052:                     if ($env{'form.'.$meta_field.'_stuadd'}) {
                   6053:                         $options.='stuadd,';
                   6054:                     }
                   6055:                     if ($env{'form.'.$meta_field.'_choices'}) {
                   6056:                         $options.='choices,';
                   6057:                     }
                   6058:                     if ($env{'form.'.$meta_field.'_onlyone'} eq 'single') {
                   6059:                         $options.='onlyone,';
                   6060:                     }
                   6061:                     if ($env{'form.'.$meta_field.'_active'}) {
                   6062:                         $options.='active,';
                   6063:                     }
                   6064:                     if ($env{'form.'.$meta_field.'_deleted'}) {
                   6065:                         $options.='deleted,';
                   6066:                     }
1.259     banghart 6067:                     my $name = $save_field;
1.560     damieng  6068:                     $put_result = &Apache::lonnet::put('environment',
                   6069:                         {'metadata.'.$meta_field.'.options'=>$options,
                   6070:                         'metadata.'.$meta_field.'.values'=>$env{'form.'.$meta_field.'_values'},
                   6071:                         },$dom,$crs);
1.252     banghart 6072:                 }
                   6073:             }
                   6074:         }
                   6075:     }
1.296     albertel 6076:     &Apache::lonnet::coursedescription($env{'request.course.id'},
1.473     amueller 6077:                        {'freshen_cache' => 1});
1.335     banghart 6078:     # Get the default metadata fields
1.258     albertel 6079:     my %metadata_fields = &Apache::lonmeta::fieldnames('portfolio');
1.335     banghart 6080:     # Now get possible added metadata fields
1.357     raeburn  6081:     my $added_metadata_fields = &get_added_meta_fieldnames($env{'request.course.id'});
1.346     banghart 6082:     my $row_alt = 1;
1.347     banghart 6083:     $output .= &Apache::loncommon::start_data_table();
1.258     albertel 6084:     foreach my $field (sort(keys(%metadata_fields))) {
1.265     banghart 6085:         if ($field ne 'courserestricted') {
1.346     banghart 6086:             $row_alt = $row_alt ? 0 : 1;
1.560     damieng  6087:             $output.= &output_row($r, $field, $metadata_fields{$field});
                   6088:         }
1.255     banghart 6089:     }
1.351     banghart 6090:     my $buttons = (<<ENDButtons);
                   6091:         <input type="submit" name="restrictmeta" value="Save" />
                   6092:         </form><br />
                   6093:         <form method="post" action="/adm/parmset?action=addmetadata" name="form1">
                   6094:         <input type="submit" name="restrictmeta" value="Add a Metadata Field" />
                   6095:         </form>
                   6096:         <br />
                   6097:         <form method="post" action="/adm/parmset?action=ordermetadata" name="form2">
                   6098:         <input type="submit" name="restrictmeta" value="Order Metadata Fields" />
                   6099: ENDButtons
1.337     banghart 6100:     my $added_flag = 1;
1.335     banghart 6101:     foreach my $field (sort(keys(%$added_metadata_fields))) {
1.346     banghart 6102:         $row_alt = $row_alt ? 0 : 1;
1.563     damieng  6103:         $output.= &output_row($r, $field, $$added_metadata_fields{$field},$added_flag, $row_alt); # FIXME: wrong parameters
1.335     banghart 6104:     }
1.347     banghart 6105:     $output .= &Apache::loncommon::end_data_table();
1.446     bisitz   6106:     $r->print(<<ENDenv);
1.259     banghart 6107:         <form method="post" action="/adm/parmset?action=setrestrictmeta" name="form">
1.244     banghart 6108:         $output
1.351     banghart 6109:         $buttons
1.340     banghart 6110:         </form>
1.244     banghart 6111: ENDenv
1.507     www      6112:     &endSettingsScreen($r);
1.280     albertel 6113:     $r->print(&Apache::loncommon::end_page());
1.240     banghart 6114:     return 'ok';
                   6115: }
1.416     jms      6116: 
                   6117: 
1.563     damieng  6118: # Returns metadata fields that have been manually added.
                   6119: #
                   6120: # @param {string} $cid - course id
                   6121: # @returns {hash reference} - hash field name -> field title (not localized)
1.335     banghart 6122: sub get_added_meta_fieldnames {
1.357     raeburn  6123:     my ($cid) = @_;
1.335     banghart 6124:     my %fields;
                   6125:     foreach my $key(%env) {
1.357     raeburn  6126:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.335     banghart 6127:             my $field_name = $1;
                   6128:             my ($display_field_name) = $env{$key};
                   6129:             $fields{$field_name} = $display_field_name;
                   6130:         }
                   6131:     }
                   6132:     return \%fields;
                   6133: }
1.416     jms      6134: 
                   6135: 
1.563     damieng  6136: # Returns metadata fields that have been manually added and deleted.
                   6137: #
                   6138: # @param {string} $cid - course id
                   6139: # @returns {hash reference} - hash field name -> field title (not localized)
1.339     banghart 6140: sub get_deleted_meta_fieldnames {
1.357     raeburn  6141:     my ($cid) = @_;
1.339     banghart 6142:     my %fields;
                   6143:     foreach my $key(%env) {
1.357     raeburn  6144:         if ($key =~ m/\Q$cid\E\.metadata\.(.+)\.added$/) {
1.339     banghart 6145:             my $field_name = $1;
                   6146:             if ($env{'course.'.$env{'request.course.id'}.'.metadata.'.$field_name.'.options'} =~ m/deleted/) {
                   6147:                 my ($display_field_name) = $env{$key};
                   6148:                 $fields{$field_name} = $display_field_name;
                   6149:             }
                   6150:         }
                   6151:     }
                   6152:     return \%fields;
                   6153: }
1.560     damieng  6154: 
                   6155: 
                   6156: ##################################################
                   6157: # PARAMETER SETTINGS DEFAULT ACTIONS
                   6158: ##################################################
                   6159: 
                   6160: # UI to change parameter setting default actions
1.563     damieng  6161: #
                   6162: # @param {Apache2::RequestRec} $r - the Apache request
1.220     www      6163: sub defaultsetter {
1.280     albertel 6164:     my ($r) = @_;
                   6165: 
1.414     droeschl 6166:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=setdefaults',
1.473     amueller 6167:         text=>"Set Defaults"});
1.531     raeburn  6168:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6169:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                   6170:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.446     bisitz   6171:     my $start_page =
1.531     raeburn  6172:         &Apache::loncommon::start_page('Parameter Setting Default Actions');
1.298     albertel 6173:     my $breadcrumbs = &Apache::lonhtmlcommon::breadcrumbs('Defaults');
1.507     www      6174:     $r->print($start_page.$breadcrumbs);
1.531     raeburn  6175:     &startSettingsScreen($r,'parmset',$crstype);
1.507     www      6176:     $r->print('<form method="post" action="/adm/parmset?action=setdefaults" name="defaultform">');
1.280     albertel 6177: 
1.221     www      6178:     my @ids=();
                   6179:     my %typep=();
                   6180:     my %keyp=();
                   6181:     my %allparms=();
                   6182:     my %allparts=();
                   6183:     my %allmaps=();
                   6184:     my %mapp=();
                   6185:     my %symbp=();
                   6186:     my %maptitles=();
                   6187:     my %uris=();
                   6188:     my %keyorder=&standardkeyorder();
                   6189:     my %defkeytype=();
                   6190: 
1.446     bisitz   6191:     &extractResourceInformation(\@ids, \%typep,\%keyp, \%allparms, \%allparts, \%allmaps,
1.473     amueller 6192:                 \%mapp, \%symbp,\%maptitles,\%uris,
                   6193:                 \%keyorder,\%defkeytype);
1.224     www      6194:     if ($env{'form.storerules'}) {
1.560     damieng  6195:         my %newrules=();
                   6196:         my @delrules=();
                   6197:         my %triggers=();
                   6198:         foreach my $key (keys(%env)) {
1.225     albertel 6199:             if ($key=~/^form\.(\w+)\_action$/) {
1.560     damieng  6200:                 my $tempkey=$1;
                   6201:                 my $action=$env{$key};
1.226     www      6202:                 if ($action) {
1.560     damieng  6203:                     $newrules{$tempkey.'_action'}=$action;
                   6204:                     if ($action ne 'default') {
                   6205:                         my ($whichaction,$whichparm)=($action=~/^(.*\_)([^\_]+)$/);
                   6206:                         $triggers{$whichparm}.=$tempkey.':';
                   6207:                     }
                   6208:                     $newrules{$tempkey.'_type'}=$defkeytype{$tempkey};
                   6209:                     if (&isdateparm($defkeytype{$tempkey})) {
                   6210:                         $newrules{$tempkey.'_days'}=$env{'form.'.$tempkey.'_days'};
                   6211:                         $newrules{$tempkey.'_hours'}=$env{'form.'.$tempkey.'_hours'};
                   6212:                         $newrules{$tempkey.'_min'}=$env{'form.'.$tempkey.'_min'};
                   6213:                         $newrules{$tempkey.'_sec'}=$env{'form.'.$tempkey.'_sec'};
                   6214:                     } else {
                   6215:                         $newrules{$tempkey.'_value'}=$env{'form.'.$tempkey.'_value'};
                   6216:                         $newrules{$tempkey.'_triggervalue'}=$env{'form.'.$tempkey.'_triggervalue'};
                   6217:                     }
                   6218:                 } else {
                   6219:                     push(@delrules,$tempkey.'_action');
                   6220:                     push(@delrules,$tempkey.'_type');
                   6221:                     push(@delrules,$tempkey.'_hours');
                   6222:                     push(@delrules,$tempkey.'_min');
                   6223:                     push(@delrules,$tempkey.'_sec');
                   6224:                     push(@delrules,$tempkey.'_value');
                   6225:                 }
1.473     amueller 6226:             }
                   6227:         }
1.560     damieng  6228:         foreach my $key (keys(%allparms)) {
                   6229:             $newrules{$key.'_triggers'}=$triggers{$key};
1.473     amueller 6230:         }
1.560     damieng  6231:         &Apache::lonnet::put('parmdefactions',\%newrules,$cdom,$cnum);
                   6232:         &Apache::lonnet::del('parmdefactions',\@delrules,$cdom,$cnum);
                   6233:         &resetrulescache();
1.224     www      6234:     }
1.227     www      6235:     my %lt=&Apache::lonlocal::texthash('days' => 'Days',
1.473     amueller 6236:                        'hours' => 'Hours',
                   6237:                        'min' => 'Minutes',
                   6238:                        'sec' => 'Seconds',
                   6239:                        'yes' => 'Yes',
                   6240:                        'no' => 'No');
1.222     www      6241:     my @standardoptions=('','default');
                   6242:     my @standarddisplay=('',&mt('Default value when manually setting'));
                   6243:     my @dateoptions=('','default');
                   6244:     my @datedisplay=('',&mt('Default value when manually setting'));
                   6245:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6246:         unless ($tempkey) { next; }
                   6247:         push @standardoptions,'when_setting_'.$tempkey;
                   6248:         push @standarddisplay,&mt('Automatically set when setting ').$tempkey;
                   6249:         if (&isdateparm($defkeytype{$tempkey})) {
                   6250:             push @dateoptions,'later_than_'.$tempkey;
                   6251:             push @datedisplay,&mt('Automatically set later than ').$tempkey;
                   6252:             push @dateoptions,'earlier_than_'.$tempkey;
                   6253:             push @datedisplay,&mt('Automatically set earlier than ').$tempkey;
                   6254:         }
1.222     www      6255:     }
1.563     damieng  6256:     $r->print(&mt('Manual setting rules apply to all interfaces.').'<br />'.
                   6257:         &mt('Automatic setting rules apply to table mode interfaces only.'));
1.318     albertel 6258:     $r->print("\n".&Apache::loncommon::start_data_table().
1.473     amueller 6259:           &Apache::loncommon::start_data_table_header_row().
                   6260:           "<th>".&mt('Rule for parameter').'</th><th>'.
                   6261:           &mt('Action').'</th><th>'.&mt('Value').'</th>'.
                   6262:           &Apache::loncommon::end_data_table_header_row());
1.221     www      6263:     foreach my $tempkey (&keysindisplayorder(\%allparms,\%keyorder)) {
1.560     damieng  6264:         unless ($tempkey) { next; }
                   6265:         $r->print("\n".&Apache::loncommon::start_data_table_row().
                   6266:             "<td>".$allparms{$tempkey}."\n<br />(".$tempkey.')</td><td>');
                   6267:         my $action=&rulescache($tempkey.'_action');
                   6268:         $r->print('<select name="'.$tempkey.'_action">');
                   6269:         if (&isdateparm($defkeytype{$tempkey})) {
                   6270:             for (my $i=0;$i<=$#dateoptions;$i++) {
                   6271:             if ($dateoptions[$i]=~/\_$tempkey$/) { next; }
                   6272:             $r->print("\n<option value='$dateoptions[$i]'".
                   6273:                 ($dateoptions[$i] eq $action?' selected="selected"':'').
                   6274:                 ">$datedisplay[$i]</option>");
                   6275:             }
                   6276:         } else {
                   6277:             for (my $i=0;$i<=$#standardoptions;$i++) {
                   6278:             if ($standardoptions[$i]=~/\_$tempkey$/) { next; }
                   6279:             $r->print("\n<option value='$standardoptions[$i]'".
                   6280:                 ($standardoptions[$i] eq $action?' selected="selected"':'').
                   6281:                 ">$standarddisplay[$i]</option>");
                   6282:             }
1.473     amueller 6283:         }
1.560     damieng  6284:         $r->print('</select>');
                   6285:         unless (&isdateparm($defkeytype{$tempkey})) {
                   6286:             $r->print("\n<br />".&mt('Triggering value(s) of other parameter (optional, comma-separated):').
                   6287:                 '<input type="text" size="20" name="'.$tempkey.'_triggervalue" value="'.&rulescache($tempkey.'_triggervalue').'" />');
1.473     amueller 6288:         }
1.560     damieng  6289:         $r->print("\n</td><td>\n");
1.222     www      6290: 
1.221     www      6291:         if (&isdateparm($defkeytype{$tempkey})) {
1.560     damieng  6292:             my $days=&rulescache($tempkey.'_days');
                   6293:             my $hours=&rulescache($tempkey.'_hours');
                   6294:             my $min=&rulescache($tempkey.'_min');
                   6295:             my $sec=&rulescache($tempkey.'_sec');
                   6296:             $r->print(<<ENDINPUTDATE);
                   6297:     <input name="$tempkey\_days" type="text" size="4" value="$days" />$lt{'days'}<br />
                   6298:     <input name="$tempkey\_hours" type="text" size="4" value="$hours" />$lt{'hours'}<br />
                   6299:     <input name="$tempkey\_min" type="text" size="4" value="$min" />$lt{'min'}<br />
                   6300:     <input name="$tempkey\_sec" type="text" size="4" value="$sec" />$lt{'sec'}
1.564     raeburn  6301: ENDINPUTDATE
1.560     damieng  6302:         } elsif ($defkeytype{$tempkey} eq 'string_yesno') {
                   6303:                 my $yeschecked='';
                   6304:                 my $nochecked='';
                   6305:                 if (&rulescache($tempkey.'_value') eq 'yes') { $yeschecked=' checked="checked"'; }
                   6306:                 if (&rulescache($tempkey.'_value') eq 'no') { $nochecked=' checked="checked"'; }
                   6307: 
                   6308:             $r->print(<<ENDYESNO);
                   6309:     <label><input type="radio" name="$tempkey\_value" value="yes"$yeschecked /> $lt{'yes'}</label><br />
                   6310:     <label><input type="radio" name="$tempkey\_value" value="no"$nochecked /> $lt{'no'}</label>
1.564     raeburn  6311: ENDYESNO
1.221     www      6312:         } else {
1.560     damieng  6313:             $r->print('<input type="text" size="20" name="'.$tempkey.'_value" value="'.&rulescache($tempkey.'_value').'" />');
                   6314:         }
1.318     albertel 6315:         $r->print('</td>'.&Apache::loncommon::end_data_table_row());
1.221     www      6316:     }
1.318     albertel 6317:     $r->print(&Apache::loncommon::end_data_table().
1.473     amueller 6318:           "\n".'<input type="submit" name="storerules" value="'.
1.507     www      6319:           &mt('Save').'" /></form>'."\n");
                   6320:     &endSettingsScreen($r);
                   6321:     $r->print(&Apache::loncommon::end_page());
1.220     www      6322:     return;
                   6323: }
1.193     albertel 6324: 
1.560     damieng  6325: ##################################################
                   6326: # PARAMETER CHANGES LOG
                   6327: ##################################################
                   6328: 
1.563     damieng  6329: # Returns some info for a parameter log entry.
                   6330: # Returned entries:
                   6331: # $realm - HTML title for the parameter level and resource
                   6332: # $section - parameter section
                   6333: # $name - parameter name
                   6334: # $part - parameter part
                   6335: # $what - $part.'.'.$name
                   6336: # $middle - resource symb ?
                   6337: # $uname - user name (same as given)
                   6338: # $udom - user domain (same as given)
                   6339: # $issection - section or group name
                   6340: # $realmdescription - title for the parameter level and resource (without using HTML)
                   6341: #
                   6342: # @param {string} $key - parameter log key
                   6343: # @param {string} $uname - user name
                   6344: # @param {string} $udom - user domain
                   6345: # @param {boolean} $typeflag - .type log entry
                   6346: # @returns {Array}
1.290     www      6347: sub components {
1.581     raeburn  6348:     my ($key,$uname,$udom,$typeflag)=@_;
1.330     albertel 6349: 
                   6350:     if ($typeflag) {
1.560     damieng  6351:         $key=~s/\.type$//;
1.290     www      6352:     }
1.330     albertel 6353: 
                   6354:     my ($middle,$part,$name)=
1.572     damieng  6355:         ($key=~/^$env{'request.course.id'}\.(?:(.+)\.)*([\w\s\-]+)\.(\w+)$/);
1.291     www      6356:     my $issection;
1.330     albertel 6357: 
1.290     www      6358:     my $section=&mt('All Students');
                   6359:     if ($middle=~/^\[(.*)\]/) {
1.560     damieng  6360:         $issection=$1;
                   6361:         $section=&mt('Group/Section').': '.$issection;
                   6362:         $middle=~s/^\[(.*)\]//;
1.290     www      6363:     }
                   6364:     $middle=~s/\.+$//;
                   6365:     $middle=~s/^\.+//;
1.291     www      6366:     if ($uname) {
1.560     damieng  6367:         $section=&mt('User').": ".&Apache::loncommon::plainname($uname,$udom);
                   6368:         $issection='';
1.291     www      6369:     }
1.316     albertel 6370:     my $realm='<span class="LC_parm_scope_all">'.&mt('All Resources').'</span>';
1.446     bisitz   6371:     my $realmdescription=&mt('all resources');
1.556     raeburn  6372:     if ($middle=~/^(.+)\_\_\_\((all|rec)\)$/) {
                   6373:         my $mapurl = $1;
                   6374:         my $maplevel = $2;
                   6375:         my $leveltitle = &mt('Folder/Map');
                   6376:         if ($maplevel eq 'rec') {
                   6377:             $leveltitle = &mt('Recursive');
                   6378:         }
1.560     damieng  6379:         $realm='<span class="LC_parm_scope_folder">'.$leveltitle.
                   6380:             ': '.&Apache::lonnet::gettitle($mapurl).' <span class="LC_parm_folder"><br />('.
                   6381:             $mapurl.')</span></span>';
                   6382:         $realmdescription=&mt('folder').' '.&Apache::lonnet::gettitle($mapurl);
                   6383:     } elsif ($middle) {
                   6384:         my ($map,$id,$url)=&Apache::lonnet::decode_symb($middle);
                   6385:         $realm='<span class="LC_parm_scope_resource">'.&mt('Resource').
                   6386:             ': '.&Apache::lonnet::gettitle($middle).' <br /><span class="LC_parm_symb">('.$url.
                   6387:             ' in '.$map.' id: '.$id.')</span></span>';
                   6388:         $realmdescription=&mt('resource').' '.&Apache::lonnet::gettitle($middle);
1.290     www      6389:     }
1.291     www      6390:     my $what=$part.'.'.$name;
1.330     albertel 6391:     return ($realm,$section,$name,$part,
1.473     amueller 6392:         $what,$middle,$uname,$udom,$issection,$realmdescription);
1.290     www      6393: }
1.293     www      6394: 
1.563     damieng  6395: my %standard_parms; # hash parameter name -> parameter title (not localized)
                   6396: my %standard_parms_types; # hash parameter name -> parameter type
1.416     jms      6397: 
1.563     damieng  6398: # Reads parameter info from packages.tab into %standard_parms.
1.328     albertel 6399: sub load_parameter_names {
1.583   ! raeburn  6400:     open(my $config,"<","$Apache::lonnet::perlvar{'lonTabDir'}/packages.tab");
1.328     albertel 6401:     while (my $configline=<$config>) {
1.560     damieng  6402:         if ($configline !~ /\S/ || $configline=~/^\#/) { next; }
                   6403:         chomp($configline);
                   6404:         my ($short,$plain)=split(/:/,$configline);
                   6405:         my (undef,$name,$type)=split(/\&/,$short,3);
                   6406:         if ($type eq 'display') {
                   6407:             $standard_parms{$name} = $plain;
1.469     raeburn  6408:         } elsif ($type eq 'type') {
1.560     damieng  6409:                 $standard_parms_types{$name} = $plain;
1.469     raeburn  6410:         }
1.328     albertel 6411:     }
                   6412:     close($config);
                   6413:     $standard_parms{'int_pos'}      = 'Positive Integer';
                   6414:     $standard_parms{'int_zero_pos'} = 'Positive Integer or Zero';
1.575     raeburn  6415:     $standard_parms{'scoreformat'}  = 'Format for display of score';
1.328     albertel 6416: }
                   6417: 
1.563     damieng  6418: # Returns a parameter title for standard parameters, the name for others.
                   6419: #
                   6420: # @param {string} $name - parameter name
                   6421: # @returns {string}
1.292     www      6422: sub standard_parameter_names {
                   6423:     my ($name)=@_;
1.328     albertel 6424:     if (!%standard_parms) {
1.560     damieng  6425:         &load_parameter_names();
1.328     albertel 6426:     }
1.292     www      6427:     if ($standard_parms{$name}) {
1.560     damieng  6428:         return $standard_parms{$name};
1.446     bisitz   6429:     } else {
1.560     damieng  6430:         return $name;
1.292     www      6431:     }
                   6432: }
1.290     www      6433: 
1.563     damieng  6434: # Returns a parameter type for standard parameters, undef for others.
                   6435: #
                   6436: # @param {string} $name - parameter name
                   6437: # @returns {string}
1.469     raeburn  6438: sub standard_parameter_types {
                   6439:     my ($name)=@_;
                   6440:     if (!%standard_parms_types) {
                   6441:         &load_parameter_names();
                   6442:     }
                   6443:     if ($standard_parms_types{$name}) {
                   6444:         return $standard_parms_types{$name};
                   6445:     }
                   6446:     return;
                   6447: }
1.309     www      6448: 
1.563     damieng  6449: # Returns a parameter level title (not localized) from the parameter level name.
                   6450: #
                   6451: # @param {string} $name - parameter level name (recognized: resourcelevel|maplevel|maplevelrecurse|courselevel)
                   6452: # @returns {string}
1.557     raeburn  6453: sub standard_parameter_levels {
                   6454:     my ($name)=@_;
                   6455:     my %levels = (
                   6456:                     'resourcelevel'   => 'a single resource',
                   6457:                     'maplevel'        => 'the enclosing map/folder', 
                   6458:                     'maplevelrecurse' => 'the enclosing map/folder (recursive into sub-folders)',
                   6459:                     'courselevel'     => 'the general (course) level',
                   6460:                  );
                   6461:     if ($levels{$name}) {
                   6462:         return $levels{$name};
                   6463:     }
                   6464:     return;
                   6465: }
                   6466: 
1.560     damieng  6467: # Display log for parameter changes, blog postings, user notification changes.
1.563     damieng  6468: #
                   6469: # @param {Apache2::RequestRec} $r - the Apache request
1.285     albertel 6470: sub parm_change_log {
1.568     raeburn  6471:     my ($r,$parm_permission)=@_;
1.531     raeburn  6472:     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6473:     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
1.569     raeburn  6474:     my $crstype = $env{'course.'.$env{'request.course.id'}.'.type'};
1.414     droeschl 6475:     &Apache::lonhtmlcommon::add_breadcrumb({href=>'/adm/parmset?action=settable',
1.473     amueller 6476:     text=>"Parameter Change Log"});
1.522     raeburn  6477:     my $js = '<script type="text/javascript">'."\n".
                   6478:              '// <![CDATA['."\n".
                   6479:              &Apache::loncommon::display_filter_js('parmslog')."\n".
                   6480:              '// ]]>'."\n".
                   6481:              '</script>'."\n";
                   6482:     $r->print(&Apache::loncommon::start_page('Parameter Change Log',$js));
1.327     albertel 6483:     $r->print(&Apache::lonhtmlcommon::breadcrumbs('Parameter Change Log'));
1.531     raeburn  6484:     &startSettingsScreen($r,'parmset',$crstype);
                   6485:     my %parmlog=&Apache::lonnet::dump('nohist_parameterlog',$cdom,$cnum);
1.311     albertel 6486: 
1.301     www      6487:     if ((keys(%parmlog))[0]=~/^error\:/) { undef(%parmlog); }
1.311     albertel 6488: 
1.522     raeburn  6489:     $r->print('<div class="LC_left_float">'.
                   6490:               '<fieldset><legend>'.&mt('Display of Changes').'</legend>'.
                   6491:               '<form action="/adm/parmset?action=parameterchangelog"
1.327     albertel 6492:                      method="post" name="parameterlog">');
1.446     bisitz   6493: 
1.311     albertel 6494:     my %saveable_parameters = ('show' => 'scalar',);
                   6495:     &Apache::loncommon::store_course_settings('parameter_log',
                   6496:                                               \%saveable_parameters);
                   6497:     &Apache::loncommon::restore_course_settings('parameter_log',
                   6498:                                                 \%saveable_parameters);
1.522     raeburn  6499:     $r->print(&Apache::loncommon::display_filter('parmslog').'&nbsp;'."\n".
                   6500:               '<input type="submit" value="'.&mt('Display').'" />'.
                   6501:               '</form></fieldset></div><br clear="all" />');
1.301     www      6502: 
1.568     raeburn  6503:     my $readonly = 1;
                   6504:     if ($parm_permission->{'edit'}) {
                   6505:         undef($readonly);
                   6506:     }
1.531     raeburn  6507:     my $courseopt=&Apache::lonnet::get_courseresdata($cnum,$cdom);
1.301     www      6508:     $r->print(&Apache::loncommon::start_data_table().&Apache::loncommon::start_data_table_header_row().
1.473     amueller 6509:           '<th>'.&mt('Time').'</th><th>'.&mt('User').'</th><th>'.&mt('Extent').'</th><th>'.&mt('Users').'</th><th>'.
1.568     raeburn  6510:           &mt('Parameter').'</th><th>'.&mt('Part').'</th><th>'.&mt('New Value').'</th>');
                   6511:     unless ($readonly) {
                   6512:         $r->print('<th>'.&mt('Announce').'</th>');
                   6513:     }
                   6514:     $r->print(&Apache::loncommon::end_data_table_header_row());
1.309     www      6515:     my $shown=0;
1.349     www      6516:     my $folder='';
                   6517:     if ($env{'form.displayfilter'} eq 'currentfolder') {
1.560     damieng  6518:         my $last='';
                   6519:         if (tie(my %hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                   6520:                 &GDBM_READER(),0640)) {
                   6521:             $last=$hash{'last_known'};
                   6522:             untie(%hash);
                   6523:         }
                   6524:         if ($last) { ($folder) = &Apache::lonnet::decode_symb($last); }
                   6525:     }
                   6526:     foreach my $id (sort {
                   6527:                 if ($parmlog{$b}{'exe_time'} ne $parmlog{$a}{'exe_time'}) {
                   6528:                     return $parmlog{$b}{'exe_time'} <=>$parmlog{$a}{'exe_time'}
                   6529:                 }
                   6530:                 my $aid = (split('00000',$a))[-1];
                   6531:                 my $bid = (split('00000',$b))[-1];
                   6532:                 return $bid<=>$aid;
1.473     amueller 6533:             } (keys(%parmlog))) {
1.294     www      6534:         my @changes=keys(%{$parmlog{$id}{'logentry'}});
1.560     damieng  6535:         my $count = 0;
                   6536:         my $time =
                   6537:             &Apache::lonlocal::locallocaltime($parmlog{$id}{'exe_time'});
                   6538:         my $plainname =
                   6539:             &Apache::loncommon::plainname($parmlog{$id}{'exe_uname'},
                   6540:                         $parmlog{$id}{'exe_udom'});
                   6541:         my $about_me_link =
                   6542:             &Apache::loncommon::aboutmewrapper($plainname,
                   6543:                             $parmlog{$id}{'exe_uname'},
                   6544:                             $parmlog{$id}{'exe_udom'});
                   6545:         my $send_msg_link='';
1.568     raeburn  6546:         if ((!$readonly) && 
                   6547:             (($parmlog{$id}{'exe_uname'} ne $env{'user.name'})
1.560     damieng  6548:             || ($parmlog{$id}{'exe_udom'} ne $env{'user.domain'}))) {
                   6549:             $send_msg_link ='<br />'.
                   6550:             &Apache::loncommon::messagewrapper(&mt('Send message'),
                   6551:                             $parmlog{$id}{'exe_uname'},
                   6552:                             $parmlog{$id}{'exe_udom'});
                   6553:         }
                   6554:         my $row_start=&Apache::loncommon::start_data_table_row();
                   6555:         my $makenewrow=0;
                   6556:         my %istype=();
                   6557:         my $output;
                   6558:         foreach my $changed (reverse(sort(@changes))) {
                   6559:                 my $value=$parmlog{$id}{'logentry'}{$changed};
                   6560:             my $typeflag = ($changed =~/\.type$/ &&
                   6561:                     !exists($parmlog{$id}{'logentry'}{$changed.'.type'}));
1.330     albertel 6562:             my ($realm,$section,$parmname,$part,$what,$middle,$uname,$udom,$issection,$realmdescription)=
1.581     raeburn  6563:                 &components($changed,$parmlog{$id}{'uname'},$parmlog{$id}{'udom'},$typeflag);
1.560     damieng  6564:             if ($env{'request.course.sec'} ne '') {
                   6565:                 next if (($issection ne '') && ($issection ne $env{'request.course.sec'}));
                   6566:                 if ($uname ne '') {
                   6567:                     my $stusection = &Apache::lonnet::getsection($uname,$udom,$env{'request.course.id'});
                   6568:                     next if (($stusection ne '-1') && ($stusection ne $env{'request.course.sec'})); 
                   6569:                 }
                   6570:             }
                   6571:             if ($env{'form.displayfilter'} eq 'currentfolder') {
                   6572:                 if ($folder) {
                   6573:                     if ($middle!~/^\Q$folder\E/) { next; }
                   6574:                 }
                   6575:             }
                   6576:             if ($typeflag) {
                   6577:                 $istype{$parmname}=$value;
                   6578:                 if (!$env{'form.includetypes'}) { next; }
                   6579:             }
                   6580:             $count++;
                   6581:             if ($makenewrow) {
                   6582:                 $output .= $row_start;
                   6583:             } else {
                   6584:                 $makenewrow=1;
                   6585:             }
1.470     raeburn  6586:             my $parmitem = &standard_parameter_names($parmname);
1.560     damieng  6587:             $output .='<td>'.$realm.'</td><td>'.$section.'</td><td>'.
                   6588:                 &mt($parmitem).'</td><td>'.
                   6589:                 ($part?&mt('Part: [_1]',$part):&mt('All Parts')).'</td><td>';
                   6590:             my $stillactive=0;
                   6591:             if ($parmlog{$id}{'delflag'}) {
                   6592:                 $output .= &mt('Deleted');
                   6593:             } else {
                   6594:                 if ($typeflag) {
1.470     raeburn  6595:                     my $parmitem = &standard_parameter_names($value); 
                   6596:                     $parmitem = &mt($parmitem);
1.560     damieng  6597:                     $output .= &mt('Type: [_1]',$parmitem);
                   6598:                 } else {
                   6599:                     my ($level,@all)=&parmval_by_symb($what,$middle,
                   6600:                         &Apache::lonnet::metadata($middle,$what),
                   6601:                         $uname,$udom,$issection,$issection,$courseopt);
1.469     raeburn  6602:                     my $showvalue = $value;
                   6603:                     if ($istype{$parmname} eq '') {
                   6604:                         my $type = &standard_parameter_types($parmname);
                   6605:                         if ($type ne '') {
                   6606:                             if (&isdateparm($type)) {
                   6607:                                 $showvalue =
                   6608:                                     &Apache::lonlocal::locallocaltime($value);
                   6609:                             }
                   6610:                         }
                   6611:                     } else {
1.560     damieng  6612:                         if (&isdateparm($istype{$parmname})) {
                   6613:                             $showvalue = &Apache::lonlocal::locallocaltime($value);
                   6614:                         }
1.469     raeburn  6615:                     }
                   6616:                     $output .= $showvalue;
1.560     damieng  6617:                     if ($value ne $all[$level]) {
                   6618:                         $output .= '<br /><span class="LC_warning">'.&mt('Not active anymore').'</span>';
                   6619:                     } else {
                   6620:                         $stillactive=1;
                   6621:                     }
                   6622:                 }
1.473     amueller 6623:             }
1.568     raeburn  6624:             $output .= '</td>';
                   6625: 
                   6626:             unless ($readonly) { 
                   6627:                 $output .= '<td>';
                   6628:                 if ($stillactive) {
                   6629:                     my $parmitem = &standard_parameter_names($parmname);
                   6630:                     $parmitem = &mt($parmitem);
                   6631:                     my $title=&mt('Changed [_1]',$parmitem);
                   6632:                     my $description=&mt('Changed [_1] for [_2] to [_3]',
                   6633:                         $parmitem,$realmdescription,
                   6634:                         (&isdateparm($istype{$parmname})?&Apache::lonlocal::locallocaltime($value):$value));
                   6635:                     if (($uname) && ($udom)) {
                   6636:                         $output .=
                   6637:                         &Apache::loncommon::messagewrapper('Notify User',
                   6638:                                                            $uname,$udom,$title,
                   6639:                                                            $description);
                   6640:                     } else {
                   6641:                         $output .=
                   6642:                             &Apache::lonrss::course_blog_link($id,$title,
                   6643:                                                               $description);
                   6644:                     }
1.560     damieng  6645:                 }
1.568     raeburn  6646:                 $output .= '</td>';
1.560     damieng  6647:             }
1.568     raeburn  6648:             $output .= &Apache::loncommon::end_data_table_row();
1.473     amueller 6649:         }
1.560     damieng  6650:         if ($env{'form.displayfilter'} eq 'containing') {
                   6651:             my $wholeentry=$about_me_link.':'.
                   6652:             $parmlog{$id}{'exe_uname'}.':'.$parmlog{$id}{'exe_udom'}.':'.
                   6653:             $output;
                   6654:             if ($wholeentry!~/\Q$env{'form.containingphrase'}\E/i) { next; }
1.473     amueller 6655:         }
1.349     www      6656:         if ($count) {
1.560     damieng  6657:             $r->print($row_start.'<td rowspan="'.$count.'">'.$time.'</td>
                   6658:                         <td rowspan="'.$count.'">'.$about_me_link.
                   6659:             '<br /><tt>'.$parmlog{$id}{'exe_uname'}.
                   6660:                         ':'.$parmlog{$id}{'exe_udom'}.'</tt>'.
                   6661:             $send_msg_link.'</td>'.$output);
                   6662:             $shown++;
                   6663:         }
                   6664:         if (!($env{'form.show'} eq &mt('all')
                   6665:             || $shown<=$env{'form.show'})) { last; }
1.286     www      6666:     }
1.301     www      6667:     $r->print(&Apache::loncommon::end_data_table());
1.507     www      6668:     &endSettingsScreen($r);
1.284     www      6669:     $r->print(&Apache::loncommon::end_page());
                   6670: }
                   6671: 
1.560     damieng  6672: ##################################################
                   6673: # MISC !
                   6674: ##################################################
                   6675: 
1.563     damieng  6676: # Stores slot information.
1.560     damieng  6677: # Used by table UI
1.563     damieng  6678: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6679: #
                   6680: # @param {string} $slot_name - slot name
                   6681: # @param {string} $cdom - course domain
                   6682: # @param {string} $cnum - course number
                   6683: # @param {string} $symb - resource symb
                   6684: # @param {string} $uname - user name
                   6685: # @param {string} $udom - user domain
                   6686: # @returns {string} - 'ok' or error name
1.437     raeburn  6687: sub update_slots {
                   6688:     my ($slot_name,$cdom,$cnum,$symb,$uname,$udom) = @_;
                   6689:     my %slot=&Apache::lonnet::get_slot($slot_name);
                   6690:     if (!keys(%slot)) {
                   6691:         return 'error: slot does not exist';
                   6692:     }
                   6693:     my $max=$slot{'maxspace'};
                   6694:     if (!defined($max)) { $max=99999; }
                   6695: 
                   6696:     my %consumed=&Apache::lonnet::dump('slot_reservations',$cdom,$cnum,
                   6697:                                        "^$slot_name\0");
                   6698:     my ($tmp)=%consumed;
                   6699:     if ($tmp=~/^error: 2 / ) {
                   6700:         return 'error: unable to determine current slot status';
                   6701:     }
                   6702:     my $last=0;
                   6703:     foreach my $key (keys(%consumed)) {
                   6704:         my $num=(split('\0',$key))[1];
                   6705:         if ($num > $last) { $last=$num; }
                   6706:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6707:             return 'ok';
                   6708:         }
                   6709:     }
                   6710: 
                   6711:     if (scalar(keys(%consumed)) >= $max) {
                   6712:         return 'error: no space left in slot';
                   6713:     }
                   6714:     my $wanted=$last+1;
                   6715: 
                   6716:     my %reservation=('name'      => $uname.':'.$udom,
                   6717:                      'timestamp' => time,
                   6718:                      'symb'      => $symb);
                   6719: 
                   6720:     my $success=&Apache::lonnet::newput('slot_reservations',
                   6721:                                         {"$slot_name\0$wanted" =>
                   6722:                                              \%reservation},
                   6723:                                         $cdom, $cnum);
1.438     raeburn  6724:     if ($success eq 'ok') {
                   6725:         my %storehash = (
                   6726:                           symb    => $symb,
                   6727:                           slot    => $slot_name,
                   6728:                           action  => 'reserve',
                   6729:                           context => 'parameter',
                   6730:                         );
1.526     raeburn  6731:         &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6732:                                    '',$uname,$udom,$cnum,$cdom);
1.438     raeburn  6733: 
1.526     raeburn  6734:         &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6735:                                    '',$uname,$udom,$uname,$udom);
1.438     raeburn  6736:     }
1.437     raeburn  6737:     return $success;
                   6738: }
                   6739: 
1.563     damieng  6740: # Deletes a slot reservation.
1.560     damieng  6741: # Used by table UI
1.563     damieng  6742: # FIXME: I don't understand how this can work when the symb is not defined (if only a map was selected)
                   6743: #
                   6744: # @param {string} $slot_name - slot name
                   6745: # @param {string} $cdom - course domain
                   6746: # @param {string} $cnum - course number
                   6747: # @param {string} $uname - user name
                   6748: # @param {string} $udom - user domain
                   6749: # @param {string} $symb - resource symb
                   6750: # @returns {string} - 'ok' or error name
1.437     raeburn  6751: sub delete_slots {
                   6752:     my ($slot_name,$cdom,$cnum,$uname,$udom,$symb) = @_;
                   6753:     my $delresult;
                   6754:     my %consumed = &Apache::lonnet::dump('slot_reservations',$cdom,
                   6755:                                          $cnum, "^$slot_name\0");
                   6756:     if (&Apache::lonnet::error(%consumed)) {
                   6757:         return 'error: unable to determine current slot status';
                   6758:     }
                   6759:     my ($tmp)=%consumed;
                   6760:     if ($tmp=~/^error: 2 /) {
                   6761:         return 'error: unable to determine current slot status';
                   6762:     }
                   6763:     foreach my $key (keys(%consumed)) {
                   6764:         if ($consumed{$key}->{'name'} eq $uname.':'.$udom) {
                   6765:             my $num=(split('\0',$key))[1];
                   6766:             my $entry = $slot_name.'\0'.$num;
                   6767:             $delresult = &Apache::lonnet::del('slot_reservations',[$entry],
                   6768:                                               $cdom,$cnum);
                   6769:             if ($delresult eq 'ok') {
                   6770:                 my %storehash = (
                   6771:                                   symb    => $symb,
                   6772:                                   slot    => $slot_name,
                   6773:                                   action  => 'release',
                   6774:                                   context => 'parameter',
                   6775:                                 );
1.526     raeburn  6776:                 &Apache::lonnet::write_log('course','slotreservationslog',\%storehash,
1.524     raeburn  6777:                                            1,$uname,$udom,$cnum,$cdom);
1.526     raeburn  6778:                 &Apache::lonnet::write_log('course',$cdom.'_'.$cnum.'_slotlog',\%storehash,
1.524     raeburn  6779:                                            1,$uname,$udom,$uname,$udom);
1.437     raeburn  6780:             }
                   6781:         }
                   6782:     }
                   6783:     return $delresult;
                   6784: }
                   6785: 
1.563     damieng  6786: # Returns true if there is a current course.
1.560     damieng  6787: # Used by handler
1.563     damieng  6788: #
                   6789: # @returns {boolean}
1.355     albertel 6790: sub check_for_course_info {
                   6791:     my $navmap = Apache::lonnavmaps::navmap->new();
                   6792:     return 1 if ($navmap);
                   6793:     return 0;
                   6794: }
                   6795: 
1.563     damieng  6796: # Returns the current course host and host LON-CAPA version.
                   6797: #
                   6798: # @returns {Array} - (course hostname, major version number, minor version number)
1.514     raeburn  6799: sub parameter_release_vars { 
1.504     raeburn  6800:    my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   6801:    my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
                   6802:    my $chostname = &Apache::lonnet::hostname($chome);
                   6803:    my ($cmajor,$cminor) = 
                   6804:        split(/\./,&Apache::lonnet::get_server_loncaparev($cdom,$chome));
                   6805:    return ($chostname,$cmajor,$cminor);
                   6806: }
                   6807: 
1.563     damieng  6808: # Checks if the course host version can handle a parameter required version,
                   6809: # and if it does, stores the release needed for the course.
                   6810: #
                   6811: # @param {string} $name - parameter name
                   6812: # @param {string} $value - parameter value
                   6813: # @param {string} $valmatch - name of the test used for checking the value
                   6814: # @param {string} $namematch - name of the test used for checking the name
                   6815: # @param {string} $needsrelease - version needed by the parameter, major.minor
                   6816: # @param {integer} $cmajor - course major version number
                   6817: # @param {integer} $cminor - course minor version number
                   6818: # @returns {boolean} - true if a newer version is needed
1.514     raeburn  6819: sub parameter_releasecheck {
1.557     raeburn  6820:     my ($name,$value,$valmatch,$namematch,$needsrelease,$cmajor,$cminor) = @_;
1.504     raeburn  6821:     my $needsnewer;
                   6822:     my ($needsmajor,$needsminor) = split(/\./,$needsrelease);
                   6823:     if (($cmajor < $needsmajor) || 
                   6824:         ($cmajor == $needsmajor && $cminor < $needsminor)) {
                   6825:         $needsnewer = 1;
1.557     raeburn  6826:     } elsif ($name) {
                   6827:         if ($valmatch) {
                   6828:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.'::'.$valmatch.':'});
                   6829:         } elsif ($value) { 
                   6830:             &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter:'.$name.':'.$value.'::'});
                   6831:         }
                   6832:     } elsif ($namematch) {
                   6833:         &Apache::lonnet::update_released_required($Apache::lonnet::needsrelease{'parameter::::'.$namematch});
1.504     raeburn  6834:     }
                   6835:     return $needsnewer;
                   6836: }
                   6837: 
1.568     raeburn  6838: sub get_permission {
                   6839:     my %permission;
                   6840:     my $allowed = 0;
                   6841:     return (\%permission,$allowed) unless ($env{'request.course.id'});
                   6842:     if ((&Apache::lonnet::allowed('opa',$env{'request.course.id'})) ||
                   6843:         (&Apache::lonnet::allowed('opa',$env{'request.course.id'}.'/'.
                   6844:                   $env{'request.course.sec'}))) {
                   6845:         %permission= (
                   6846:                        'edit'               => 1,
                   6847:                        'set'                => 1,
                   6848:                        'setoverview'        => 1,
                   6849:                        'addmetadata'        => 1,
                   6850:                        'ordermetadata'      => 1,
                   6851:                        'setrestrictmeta'    => 1,
                   6852:                        'newoverview'        => 1,
                   6853:                        'setdefaults'        => 1,
                   6854:                        'settable'           => 1,
                   6855:                        'parameterchangelog' => 1,
                   6856:                        'cleanparameters'    => 1,
                   6857:                        'dateshift1'         => 1,
                   6858:                        'dateshift2'         => 1,
                   6859:                        'helper'             => 1,
                   6860:          );
                   6861:     } elsif ((&Apache::lonnet::allowed('vpa',$env{'request.course.id'})) ||
                   6862:              (&Apache::lonnet::allowed('vpa',$env{'request.course.id'}.'/'.
                   6863:                   $env{'request.course.sec'}))) {
                   6864:         %permission = (
                   6865:                        'set'                => 1,
                   6866:                        'settable'           => 1,
                   6867:                        'newoverview'        => 1,
                   6868:                        'setoverview'        => 1,
                   6869:                        'parameterchangelog' => 1,
                   6870:                       );
                   6871:     }
                   6872:     foreach my $perm (values(%permission)) {
                   6873:         if ($perm) { $allowed=1; last; }
                   6874:     }
                   6875:     return (\%permission,$allowed);
                   6876: }
                   6877: 
1.560     damieng  6878: ##################################################
                   6879: # HANDLER
                   6880: ##################################################
                   6881: 
                   6882: # Main handler for lonparmset.
                   6883: # Sub called based on request parameters action and command:
                   6884: # no command or action: print_main_menu
                   6885: # command 'set': assessparms (direct access to table mode for a resource)
                   6886: #                (this can also be accessed simply with the symb parameter)
                   6887: # action 'setoverview': overview (display all existing parameter settings)
                   6888: # action 'addmetadata': addmetafield (called to add a portfolio metadata field)
                   6889: # action 'ordermetadata': order_meta_fields (called to order portfolio metadata fields)
                   6890: # action 'setrestrictmeta': setrestrictmeta (display or save portfolio metadata)
                   6891: # action 'newoverview': newoverview (overview mode)
                   6892: # action 'setdefaults': defaultsetter (UI to change parameter setting default actions)
                   6893: # action 'settable': assessparms (table mode)
                   6894: # action 'parameterchangelog': parm_change_log (display log for parameter changes,
                   6895: #                              blog postings, user notification changes)
                   6896: # action 'cleanparameters': clean_parameters (unused)
                   6897: # action 'dateshift1': date_shift_one (overview mode, shift all dates)
                   6898: # action 'dateshift2': date_shift_two (overview mode, shift all dates)
1.30      www      6899: sub handler {
1.43      albertel 6900:     my $r=shift;
1.30      www      6901: 
1.376     albertel 6902:     &reset_caches();
                   6903: 
1.414     droeschl 6904:     &Apache::loncommon::content_type($r,'text/html');
                   6905:     $r->send_http_header;
                   6906:     return OK if $r->header_only;
                   6907: 
1.193     albertel 6908:     &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},
1.473     amueller 6909:                         ['action','state',
1.205     www      6910:                                              'pres_marker',
                   6911:                                              'pres_value',
1.206     www      6912:                                              'pres_type',
1.506     www      6913:                                              'filter','part',
1.390     www      6914:                                              'udom','uname','symb','serial','timebase']);
1.131     www      6915: 
1.83      bowersj2 6916: 
1.193     albertel 6917:     &Apache::lonhtmlcommon::clear_breadcrumbs();
1.194     albertel 6918:     &Apache::lonhtmlcommon::add_breadcrumb({href=>"/adm/parmset",
1.507     www      6919:                         text=>"Content and Problem Settings",
1.473     amueller 6920:                         faq=>10,
                   6921:                         bug=>'Instructor Interface',
1.442     droeschl 6922:                                             help =>
                   6923:                                             'Parameter_Manager,Course_Environment,Parameter_Helper,Parameter_Overview,Table_Mode'});
1.203     www      6924: 
1.30      www      6925: # ----------------------------------------------------- Needs to be in a course
1.568     raeburn  6926:     my ($parm_permission,$allowed) = &get_permission();
1.355     albertel 6927:     my $exists = &check_for_course_info();
                   6928: 
1.568     raeburn  6929:     if ($env{'request.course.id'} && $allowed && $exists) {
1.193     albertel 6930:         #
                   6931:         # Main switch on form.action and form.state, as appropriate
                   6932:         #
                   6933:         # Check first if coming from someone else headed directly for
                   6934:         #  the table mode
1.568     raeburn  6935:         if (($parm_permission->{'set'}) && 
                   6936:             ((($env{'form.command'} eq 'set') && ($env{'form.url'})
                   6937:                 && (!$env{'form.dis'})) || ($env{'form.symb'}))) {
                   6938:             &assessparms($r,$parm_permission);
1.193     albertel 6939:         } elsif (! exists($env{'form.action'})) {
                   6940:             &print_main_menu($r,$parm_permission);
1.568     raeburn  6941:         } elsif (!$parm_permission->{$env{'form.action'}}) {
                   6942:             &print_main_menu($r,$parm_permission);
1.414     droeschl 6943:         } elsif ($env{'form.action'} eq 'setoverview') {
1.568     raeburn  6944:             &overview($r,$parm_permission);
1.560     damieng  6945:         } elsif ($env{'form.action'} eq 'addmetadata') {
                   6946:             &addmetafield($r);
                   6947:         } elsif ($env{'form.action'} eq 'ordermetadata') {
                   6948:             &order_meta_fields($r);
1.414     droeschl 6949:         } elsif ($env{'form.action'} eq 'setrestrictmeta') {
1.560     damieng  6950:             &setrestrictmeta($r);
1.414     droeschl 6951:         } elsif ($env{'form.action'} eq 'newoverview') {
1.568     raeburn  6952:             &newoverview($r,$parm_permission);
1.414     droeschl 6953:         } elsif ($env{'form.action'} eq 'setdefaults') {
1.560     damieng  6954:             &defaultsetter($r);
                   6955:         } elsif ($env{'form.action'} eq 'settable') {
1.568     raeburn  6956:             &assessparms($r,$parm_permission);
1.414     droeschl 6957:         } elsif ($env{'form.action'} eq 'parameterchangelog') {
1.568     raeburn  6958:             &parm_change_log($r,$parm_permission);
1.414     droeschl 6959:         } elsif ($env{'form.action'} eq 'cleanparameters') {
1.560     damieng  6960:             &clean_parameters($r);
1.414     droeschl 6961:         } elsif ($env{'form.action'} eq 'dateshift1') {
1.390     www      6962:             &date_shift_one($r);
1.414     droeschl 6963:         } elsif ($env{'form.action'} eq 'dateshift2') {
1.390     www      6964:             &date_shift_two($r);
1.446     bisitz   6965:         }
1.43      albertel 6966:     } else {
1.1       www      6967: # ----------------------------- Not in a course, or not allowed to modify parms
1.560     damieng  6968:         if ($exists) {
                   6969:             $env{'user.error.msg'}=
                   6970:             "/adm/parmset:opa:0:0:Cannot modify assessment parameters";
                   6971:         } else {
                   6972:             $env{'user.error.msg'}=
                   6973:             "/adm/parmset::0:1:Course environment gone, reinitialize the course";
                   6974:         }
                   6975:         return HTTP_NOT_ACCEPTABLE;
1.43      albertel 6976:     }
1.376     albertel 6977:     &reset_caches();
                   6978: 
1.43      albertel 6979:     return OK;
1.1       www      6980: }
                   6981: 
                   6982: 1;
                   6983: __END__
                   6984: 
                   6985: 

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