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

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

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