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

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

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